pijul nest
guest [sign in]

Fork channel

Create a new channel as a copy of main.

Rename channel

Rename main to:

Delete channel

Delete main? This cannot be undone.

elpe.ml
open Grpc_lwt
open Lwt.Syntax
include Derivation

module Rust = struct
  include Rust
end

exception Error of H2.Client_connection.error

let rec is_ignored ignored dir path current =
  match ignored with
  | [] -> current
  | (negated, dir_only, h) :: t ->
      is_ignored t dir path
        (if negated && current then not (Str.string_match h path 0)
         else if (dir_only && dir) || not dir_only then
           current || Str.string_match h path 0
         else current)

let is_ignored_dir ignored path = is_ignored ignored true path false
let is_ignored_file ignored path = is_ignored ignored false path false

let rec walk_dir_rec encode f buf ignored path path_name =
  let open Ocaml_protoc_plugin in
  let* dir = Lwt_unix.opendir path in
  Lwt.finalize
    (fun () ->
      let open Elpegrpc.Elpe in
      let rec walk () =
        Lwt.catch
          (fun () ->
            let* entry = Lwt_unix.readdir dir in
            let entry : string = entry in
            if entry = ".." || entry = "." then walk ()
            else
              let path = Filename.concat path entry in
              let path_name = Filename.concat path_name entry in
              let* stat = Lwt_unix.lstat path in
              let* () =
                match stat.st_kind with
                | Unix.S_DIR ->
                    if not (is_ignored_dir ignored path_name) then (
                      let req =
                        AddPathRequest.make
                          ~request:
                            (`Directory
                               (AddPathRequest.Directory.make ~name:path_name
                                  ~permissions:0o644 ()))
                          ()
                      in
                      let enc = encode req |> Writer.contents in
                      f (Some enc);
                      walk_dir_rec encode f buf ignored path path_name)
                    else Lwt.return ()
                | Unix.S_REG ->
                    if not (is_ignored_file ignored path_name) then
                      let* file = Lwt_unix.openfile path [ O_RDONLY ] 0 in
                      let ff =
                        AddPathRequest.File.make ~name:path_name
                          ~length:stat.st_size ~permissions:0o644 ()
                      in
                      let req = AddPathRequest.make ~request:(`File ff) () in
                      let enc = encode req |> Writer.contents in
                      let () = f (Some enc) in
                      let rec read_all n =
                        let* r = Lwt_unix.read file buf 0 4096 in
                        if r != 0 then
                          let req =
                            AddPathRequest.make
                              ~request:
                                (`Contents
                                   (AddPathRequest.FileContents.make ~start:n
                                      ~content:(Bytes.sub buf 0 r) ()))
                              ()
                          in
                          let enc = encode req |> Writer.contents in
                          let () = f (Some enc) in
                          read_all (n + r)
                        else Lwt.return ()
                      in
                      read_all 0
                    else Lwt.return ()
                | _ -> Lwt.return ()
              in
              walk ())
          (function End_of_file -> Lwt.return () | e -> Lwt.fail e)
      in
      walk ())
    (fun () -> Lwt_unix.closedir dir)

let add_path connection ignored path0 =
  let open Ocaml_protoc_plugin in
  let open Elpegrpc.Elpe in
  let encode, decode = Service.make_client_functions Elpe.addPath in

  Client.call ~service:"elpe.Elpe" ~rpc:"AddPath"
    ~do_request:
      (H2_lwt_unix.Client.request connection ~error_handler:(fun _ ->
           failwith "Error"))
    ~handler:
      (Client.Rpc.client_streaming ~f:(fun f response ->
           let buf = Bytes.create 4096 in
           let* _ = walk_dir_rec encode f buf ignored path0 "" in
           f None;

           let+ decoder = response in
           match decoder with
           | Some decoder -> (
               Reader.create decoder |> decode |> function
               | Ok v -> v
               | Error e ->
                   failwith
                     (Printf.sprintf "Could not decode request: %s"
                        (Result.show_error e)))
           | None -> Elpe.Derivation.Response.make ()))
    ()

let rec read_ignore ign =
  try
    let line = input_line ign in
    let rest = read_ignore ign in
    let regexp = Str.regexp {|\(\\#\)\|\(^#\)\|\(^!\)\|\(\*\*\)\|\*|} in

    let result = ref "" in
    let i = ref 0 in
    let negated = ref false in
    let _ =
      try
        let ended = ref false in
        while not !ended do
          let next = Str.search_forward regexp line !i in
          let _ =
            if next - !i > 0 then
              result := !result ^ Str.quote (String.sub line !i (next - !i))
            else ()
          in
          let m = Str.matched_string line in
          let _ =
            match m with
            | "!" -> negated := true
            | "#" -> ended := true
            | "**" -> result := !result ^ ".*"
            | "*" -> result := !result ^ "[^/]*"
            | "\\#" -> result := !result ^ "#"
            | m -> result := !result ^ Str.quote m
          in
          i := next + String.length m
        done
      with Not_found ->
        result :=
          !result ^ Str.quote (String.sub line !i (String.length line - !i))
    in
    if String.length !result > 0 then
      let dir_only = !result.[String.length !result - 1] = '/' in
      let result =
        if dir_only then String.sub !result 0 (String.length !result - 1)
        else !result
      in
      if String.contains result '/' then
        (!negated, dir_only, Str.regexp result) :: rest
      else
        (!negated, dir_only, Str.regexp ({|\(\(.+/\)\|^\)|} ^ result)) :: rest
    else rest
  with End_of_file -> []

let local_src p =
  object
    inherit derivation
    method name = Filename.basename p
    val cached = ref None

    method! build =
      match !cached with
      | None ->
          let c =
            match !backend_conn with None -> failwith "no conn" | Some c -> c
          in
          let ignored =
            try read_ignore (open_in ".ignore") with Sys_error _ -> []
          in
          let* res = add_path c ignored p in
          let res, _ = Result.get_ok res in
          let result =
            match res with
            | `Ok r -> { destdir = r.destdir; paths = r.paths }
            | `Error e -> raise (DerivationError e)
            | _ -> assert false
          in
          cached := Some result;
          Lwt.return result
      | Some cached -> Lwt.return cached
  end

let last_built_module : derivation Lwt.t option ref = ref None
let build_lwt (spec : derivation Lwt.t) = last_built_module := Some spec
let build (spec : derivation) = last_built_module := Some (Lwt.return spec)