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)