-mod_use "%/../l9-dep.ml";;

let ( let- ) rhs f =
  match rhs with
  | None -> ()
  | Some x -> f x

(** [L9_plumbing.Lang] is the Layer 9
  language, describing the Layer 9 system
  and points of communication with it. *)
module type Lang =
  sig type driver and route and 'a dict = (string * 'a) list

  and env = <
    (* stdin  : source_ty r; *)
    (* stdout : sink_ty r; *)
    (* stderr : sink_ty r; *)
    (* net : [`Unix | `Generic] Eio.Net.ty r; *)
    (* domain_mgr : Eio.Domain_manager.ty r; *)
    process_mgr : [\`Unix | \`Generic] Process.mgr_ty Resource.t;
    clock : float Eio.Time.clock_ty Resource.t;
    (* mono_clock : Eio.Time.Mono.ty r; *)
    fs : Fs.dir_ty Path.t;
    (* cwd : Eio.Fs.dir_ty Eio.Path.t; *)
    (* secure_random : Eio.Flow.source_ty r; *)
    (* debug : Eio.Debug.t; *)
    (* backend_id: string; *)
    writer : (* Flow.sink_ty *) [\`Unix | \`Generic ] Net.stream_socket_ty Resource.t;
    sw : Switch.t
  >

  module Route :
    sig type info
    val info : ?doc:string -> string -> info
    end

  module Driver :
    sig
    val register_route : Route.info -> (string list * string dict * env -> unit) Trx.pat_code -> unit
    end

  end

(** [L9_plumbing.Plug] is a Layer 9 module
  in a KM machine ie. located in [~/Services]
  . They are detected and dynamically
  loaded. *)
module type Plug = Lang -> sig end

module type _empty = sig end

type env = <
  process_mgr : [\`Unix | \`Generic] Process.mgr_ty Resource.t;
  clock : float Eio.Time.clock_ty Resource.t;
  fs : Fs.dir_ty Path.t;
  writer : (* Flow.sink_ty *) [\`Unix | \`Generic ] Net.stream_socket_ty Resource.t;
  sw : Switch.t
>

type 't program =
  | Make_route_info : { route_name : string; route_doc : string option } -> [ \`route_info ] program
  | Register_route  : { route_info : [ \`route_info ] program; route_pat : (string list * (string * string) list * env -> unit) Trx.pat_code } -> [ \`driver ] program

module M (Register_route : sig val make : [ `driver ] program -> unit end) : Lang =
  struct type nonrec driver = [ \`driver ] program and route = [ \`route ] program and 'a dict = (string * 'a) list and env = env

  module Route =
    struct type info = [ \`route_info ] program
    let info ?doc:route_doc route_name = Make_route_info { route_name; route_doc }
    end

  module Driver =
    struct
    let register_route route_info route_pat = Register_route.make @@ Register_route { route_info; route_pat }
    end

  end

open Eio

let rec make_mod ~fs ~process_mgr ~check infile =
  let cat infile =
    let utopk_cat = "utopk.cat" in
    let env = Unix.environment () |> Array.to_list |> (fun xs -> ["UTOPK_CODEMODE=text"] @ xs ) |> Array.of_list in
    Path.(/) fs @@ Process.parse_out ~env process_mgr
    Buf_read.line @@ utopk_cat :: (Path.native_exn infile) :: []
  and save newfilecontent =
    let newfile = Files.make_tempfile1 ~fs ~prefix:"Layer9-Plumbing-" ()
    in Path.save ~create:(\`Exclusive 0o700) newfile newfilecontent; newfile
  and eval_ newfile =
    Topdirs.dir_use (Format.get_std_formatter ()) Path.(native_exn newfile) in
  let eval_as_functor =
    cat %> Path.load %> check %> rawwrap_functor_1 (
      "Layer9", "L9_plumbing.Lang", "L9_plumbing.Plug")
    %> save %> eval_ in
  eval_as_functor infile; Option.get (!plugslot)

and make_mod_opt ~fs ~process_mgr ~check infile =
  match make_mod ~fs ~process_mgr ~check infile
  with v -> Some v | exception Invalid_argument _ -> None

and rawwrap_functor_1 (name, type_, outtype) content =
  let buf = Buffer.create 100 in
  let ( ~+ ) = Buffer.add_string buf in
  +"let () = L9_plumbing.plugslot := Some (module functor ("; +name; +" : "; +type_; +") -> struct "; +content; +" end : "; +outtype; +");;";
  Buffer.contents buf

and plugslot : (module Plug) option ref = ref None

let plugins ~fs ~process_mgr ~servicedir ~about_make_pat () =
  let pats = ref [] and aboutpats = ref [] in
  let on_register (Register_route { route_info; route_pat }) =
    let Make_route_info { route_name; route_doc } = route_info in
    pats := route_pat :: !pats;
    aboutpats := about_make_pat route_name route_doc :: !aboutpats;
    () in
  let loading = (module M(struct let make = on_register end) : Lang) in
  Fiber.List.iter (fun service ->
    if not @@ Path.is_directory Path.(servicedir / service) then () else
    let is_l9 = match Path.kind ~follow:true Path.(servicedir / service / "lib.ml") with
      \`Regular_file | \`Symbolic_link -> true | _ -> false in
    traceln "layer9: candidate '%s' is_l9 ::%b" service is_l9;
    if not is_l9 then () else
    let- (module P) = make_mod_opt ~fs ~process_mgr ~check:L9_dep.check Path.(servicedir / service / "lib.ml") in
    ignore (module P(val loading) : _empty)
  ) (Path.read_dir servicedir);
  \`pats !pats, \`aboutpats !aboutpats