#!/usr/bin/unfold ~/u/utop/script
-require' [eio; eio_main];;
-require' [re; fpath; ppx_memberinclude; (topcore %> files); (compiler_libs %> toplevel); ppx_typst];;
-require' [topcore_cprg; cow];;
[@@@module [%unfold "~/u/colon-options-2"]]
[@@@module "%/../oar-utils.ml" [@prefixed? "oar-"]]
[@@@module "%/../oar-init.ml"]
[@@@module "%/../oar-fsbrowse.ml"]
[@@@module "%/../oar-redirect.ml"]
open Oar_init

module Oar_kit =
  struct include Oar_kit
  module Firebase =
    struct include Firebase
    include Oar_fsbrowse.Oar_kit.Firebase
    include Oar_redirect.Oar_kit.Firebase
    end
  end

let eval phrase =
  let respbuf = Buffer.create 12 in
  let no_formatter = Format.formatter_of_buffer respbuf in
  let phrase' = Toploop.preprocess_phrase no_formatter phrase in
  ignore (Toploop.execute_phrase true no_formatter phrase')

(** [eval'] is similar to [eval] but input is string; it will
    parse the string into AST, creating a throwaway buffer. *)
let eval' code =
  let open Stdlib in
  let as_buf = Lexing.from_string code in
  let parse = !Toploop.parse_toplevel_phrase as_buf in
  eval parse

let%include (* [@in (module Oar_kit)] *)
[@in (module Oar_kit.Topdirs)]
dir_use usefile =
  let scopename = Filename.basename @@ Filename.dirname usefile in
  scope__push scopename;
  Compiler_libs__Topdirs.dir_use Format.std_formatter usefile;
  scope__pop scopename

let%include (* [@in (module Oar_kit)] *)
[@in (module Oar_kit.Topdirs)]
dir_use' usedir =
  Oar_kit.Topdirs.dir_use (usedir ^ "/.firebaserc")

(** [Oar_kit.firebase_static] *)
let%include [@in (module Oar_kit)] [@in (module Oar_kit.Firebase) [@as? static]]
firebase_static ~public_dir ~prefix ?doc ?redirect_index libname =
  let unit_name = mk_unit_name ~scope:!scope__current libname.libname_name in
  ( match StringMap.find libname.libname_name !lib_to_unit with
  | v -> failwith "trying to fulfill a library that has already been taken!"
  | exception Not_found ->
    lib_to_unit := StringMap.add libname.libname_name unit_name !lib_to_unit;
    unit_to_doc := StringMap.add unit_name (\`static, doc) !unit_to_doc
  );
  match Hashtbl.find unit_ls unit_name with
  | v -> failwith "duplicated unit name!"
  | exception Not_found ->
    Hashtbl.add unit_ls unit_name @@
    \`firebase_static (fun ?copy_public_to env ->
    let cwd = Io.Stdenv.cwd env in
    let public_dir' = remove_cwd @@ Fpath.to_string public_dir in
    (* Io.traceln "%s" public_dir'; *)
    assert (Io.Path.is_directory Io.Path.(cwd / public_dir'));
    copy_public_to |> Option.iter @@ fun (copy_public_root, process_mgr) ->
    let copy_public_root' = remove_cwd @@ Fpath.to_string copy_public_root in
    Io.Path.mkdirs ~exists_ok:true ~perm:0o700 Io.Path.(cwd / copy_public_root' / prefix);
    Io.Process.run process_mgr ["cp"; "-r";
      Io.Path.native_exn Io.Path.(cwd / public_dir');
      Io.Path.native_exn Io.Path.(cwd / copy_public_root')
    ];
    Utils.rename_lax Io.Path.rename Io.Path.(cwd / copy_public_root' / Filename.basename public_dir') Io.Path.(cwd / copy_public_root' / prefix)
  )

(** [Oar_kit.firebase_pdf] *)
let%include [@in (module Oar_kit)] [@in (module Oar_kit.Firebase) [@as? pdf]]
firebase_pdf ~srcs ?doc ?prefix libname =
  let unit_name = mk_unit_name ~scope:!scope__current libname.libname_name in
  ( match StringMap.find libname.libname_name !lib_to_unit with
  | v -> failwith "trying to fulfill a library that has already been taken!"
  | exception Not_found ->
    lib_to_unit := StringMap.add libname.libname_name unit_name !lib_to_unit;
    unit_to_doc := StringMap.add unit_name (\`pdf, doc) !unit_to_doc
  );
  match Hashtbl.find unit_ls unit_name with
  | v -> failwith "duplicated unit name!"
  | exception Not_found ->
    Hashtbl.add unit_ls unit_name @@
    \`firebase_pdf (fun ?copy_public_to env ->
    let cwd = Io.Stdenv.cwd env in
    copy_public_to |> Option.iter @@ fun (copy_public_root, process_mgr) ->
    List.iter (function
    | \`file file ->
      (* XXX(kinten) rewrite this... *)
      let file' = remove_cwd @@ Fpath.to_string file in
      let newfile' =
        let private_space = "_oar/dist" in
        let private_space = match prefix with None -> private_space | Some prefix -> private_space ^ "/" ^ prefix in
        match file' with "" -> private_space | file' -> private_space ^ "/" ^ file' in
      let newdir' = Filename.dirname newfile' in
      Io.Path.mkdirs ~exists_ok:true ~perm:0o700 Io.Path.(cwd / newdir');
      Io.Process.run process_mgr ["cp";
        Io.Path.native_exn Io.Path.(cwd / file');
        Io.Path.native_exn Io.Path.(cwd / newfile')
      ]
    ) srcs
  )

(** [Oar_kit.firebase_base] *)
let%include [@in (module Oar_kit)] [@in (module Oar_kit.Firebase) [@as? base]]
firebase_base ?(requires=[]) ~project_id name =
  let unit_name = mk_unit_name ~scope:!scope__current name in
  match Hashtbl.find unit_ls unit_name with
  | v -> failwith "duplicated unit name!"
  | exception Not_found ->
    Hashtbl.add unit_ls unit_name @@
    \`firebase_base (fun env ->
    let cwd = Io.Stdenv.cwd env
    and process_mgr = Io.Stdenv.process_mgr env
    and dist_dir' = "_oar/dist" in
    Io.Path.rmtree ~missing_ok:true Io.Path.(cwd / "_oar");
    Io.Path.mkdirs ~exists_ok:true ~perm:0o700 Io.Path.(cwd / "_oar");
    Io.Path.mkdirs ~exists_ok:true ~perm:0o700 Io.Path.(cwd / dist_dir');
    Io.Path.rmtree ~missing_ok:true Io.Path.(cwd / dist_dir');
    List.iter (fun libname ->
      let unit_name = try StringMap.find libname.libname_name !lib_to_unit
        with Not_found -> failwith "lib doesn't get handled by anyone" in
      let work = try Hashtbl.find unit_ls unit_name
        with Not_found -> failwith "unit wasn't assigned with any work" in
      match work with
      | \`firebase_fsbrowse f ->
        let copy_public_root = Fpath.v @@ Sys.getcwd () ^ "/" ^ dist_dir' in
        let process_mgr = Io.Stdenv.process_mgr env in
        let fs = Io.Stdenv.fs env in
        f ~copy_public_to:(copy_public_root, process_mgr, fs) env
      | \`firebase_pdf f
      | \`firebase_redirect f
      | \`firebase_static f ->
        let copy_public_root = Fpath.v @@ Sys.getcwd () ^ "/" ^ dist_dir' in
        let process_mgr = Io.Stdenv.process_mgr env in
        f ~copy_public_to:(copy_public_root, process_mgr) env
      | \`firebase_base _ -> failwith "base cannot require base"
    ) requires;
    Io.Path.save ~create:(\`Exclusive 0o700) Io.Path.(cwd / "_oar" / "firebase.json") begin
      Printf.sprintf {|{ "hosting": { "public": "dist" } }|}
    end;
    Io.Process.run process_mgr ~cwd:Io.Path.(cwd / "_oar") ["firebase"; "deploy"; "--project"; project_id] 
  )

(** [Oar_kit.fpath_of_string], or [~/],  *)
let%include [@in (module Oar_kit)] ( ~/ ) x =
  let subdirs = match !scope__current with [] -> "" | xs ->
    String.concat "/" (List.rev xs) ^ "/" in
  Fpath.v (Sys.getcwd () ^ "/" ^ subdirs ^ x)

(**
    @raise Not_oar when a directory doesn't have a [firebaserc]
    file, hence is not an Oar projection. *)
let eval env =
  let open Io in
  let exception Not_oar in
  let cwd = Stdenv.cwd env in
  let firebaserc = Path.(cwd / ".firebaserc") in
  if not @@ Path.is_file firebaserc then
    raise Not_oar;
  (* eval' {|#ppx "/home/kinten/u/oar/ppx-include.mls -as-ppx";;|}; *)
  Hashtbl.clear unit_ls;
  unit_to_doc := StringMap.empty;
  lib_to_unit := StringMap.empty;
  Topdirs.dir_use Format.std_formatter (Io.Path.native_exn firebaserc)

let list' env =
  let open Io in
  let stdout = Stdenv.stdout env
  and unit_ls = Hashtbl.fold (fun key value acc -> (key, value) :: acc) unit_ls [] in
  List.iter (fun (key, _) ->
    let v = StringMap.find_opt key !unit_to_doc in
    let doc = Option.value ~default:"" @@ Option.join @@ Option.map (fun (a, b) -> b) v in
    let icon = Option.value ~default:\`unknown @@ Option.map (fun (a, b) -> a) v in
    let icon_to_text = match icon with
    | \`static -> "\x1B[44m" ^ "\x1B[1;37m" ^ " S " ^ "\x1B[0m"
    | \`pdf    -> "\x1B[41m" ^ "\x1B[1;30m" ^ " P " ^ "\x1B[0m"
    | \`fsbrowse -> "\x1B[46m" ^ "\x1B[1;30m" ^ " B " ^ "\x1B[0m"
    | \`redirect -> "\x1B[42m" ^ "\x1B[1;30m" ^ " R " ^ "\x1B[0m"
    | \`unknown -> "\x1B[43m" ^ "\x1B[1;30m" ^ " ? " ^ "\x1B[0m"
    in
    Flow.copy_string begin
      icon_to_text ^ "\x1B[1;30m" ^ " " ^ key ^ "\x1B[0m" ^ " " ^ doc ^ "\n"
    end stdout
  ) unit_ls

let list () =
  Eio_main.run @@ fun env ->
  Io.traceln "how";
  eval env; list' env

let main env verb =
  match verb with
  | \`List -> eval env; list' env
  | \`Do unit_name ->
    eval env;
    let work = Hashtbl.find unit_ls unit_name in
    match work with
    | \`firebase_pdf f
    | \`firebase_static f -> f env
    | \`firebase_fsbrowse f -> f env
    | \`firebase_redirect f -> f env
    | \`firebase_base f -> f env

let main env =
  let open Colon_options_2 in
  Cmd.make ( Cmd.info "oar"
    ~doc:{%typ| Test |} ) @@
  let open Term.Syntax in
  let+ verb =
    let+ list = Arg.(value & flag & info ["list"] ~docv:"LIST"
    ~doc:{%typ| Perform a listing of units available in this repository. |})
    and+ do_ = Arg.(value & opt string "nothing" & info ["do"] ~docv:"DO"
    ~doc:{%typ| Perform an action associated with unit #DO.
      If no action is specified then defaults to 'nothing'. |})
    in if list then \`List
    else if not @@ String.equal do_ "nothing" then \`Do do_
    else failwith "do not know what to do"
  and+ drypp = Arg.(value & flag &
    info ["drypp"] ~docv:"DRYPP" ~doc:{%typ| Perform dry run
    where only file processing and transformations are done,
    without deploying to hosting service. |}) in
  main env verb

let () =
  if !Sys.interactive then () else
  let open Colon_options_2 in
  Eio_main.run @@ fun env ->
  exit @@ Cmd.eval (object end) @@ main env