module SS = Set.Make (String)

type outcome = { built : string list; failed : string list }

let summary o =
  Printf.sprintf "%d built, %d failed" (List.length o.built)
    (List.length o.failed)

let timestamp () =
  let tm = Unix.localtime (Unix.gettimeofday ()) in
  Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.Unix.tm_year + 1900)
    (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
    tm.Unix.tm_sec

let log sw msg =
  let write () =
    ignore (Bos.OS.Dir.create ~path:true (Switch.state_dir sw));
    let fd =
      Unix.openfile
        (Fpath.to_string (Switch.log_file sw))
        [ O_WRONLY; O_APPEND; O_CREAT ]
        0o644
    in
    Fun.protect
      ~finally:(fun () -> Unix.close fd)
      (fun () ->
        let line = Printf.sprintf "[%s] %s\n" (timestamp ()) msg in
        ignore (Unix.write_substring fd line 0 (String.length line)))
  in
  try write () with _ -> ()

let with_lock sw f =
  Result.bind (Bos.OS.Dir.create ~path:true (Switch.state_dir sw))
  @@ fun (_ : bool) ->
  match
    Unix.openfile
      (Fpath.to_string (Switch.lock_file sw))
      [ O_WRONLY; O_CREAT ] 0o644
  with
  | exception Unix.Unix_error (e, _, _) -> Error (`Msg (Unix.error_message e))
  | fd ->
      Fun.protect
        ~finally:(fun () -> Unix.close fd)
        (fun () ->
          Unix.lockf fd Unix.F_LOCK 0;
          f ())

(* Package names are [A-Za-z0-9_+-]; refuse to delete anything else so a
   corrupt pending file can never escape the doc tree. *)
let valid_pkg_name n =
  n <> ""
  && String.for_all
       (fun c ->
         match c with
         | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' | '+' -> true
         | _ -> false)
       n

let erase_doc sw name =
  if valid_pkg_name name then
    ignore (Bos.OS.Dir.delete ~recurse:true Fpath.(Switch.odoc_dir sw / name))

(* The driver locates the switch by running `opam switch show`; make sure
   that resolves to ours even when sync is invoked with an explicit
   --prefix. *)
let driver_env sw =
  let prefix = Switch.prefix sw in
  let switch_id =
    if Fpath.basename prefix = "_opam" then
      Fpath.to_string (Fpath.parent prefix)
    else Fpath.basename prefix
  in
  let env =
    Bos.OS.Env.current () |> Result.value ~default:Astring.String.Map.empty
  in
  env
  |> Astring.String.Map.add "OPAM_SWITCH_PREFIX" (Fpath.to_string prefix)
  |> Astring.String.Map.add "OPAMSWITCH" switch_id

let run_driver sw ~driver ~env name =
  let cmd = Bos.Cmd.(driver % name % "--actions" % "all") in
  log sw (Printf.sprintf "running: %s" (Bos.Cmd.to_string cmd));
  let result =
    Bos.OS.Dir.with_current (Switch.work_dir sw)
      (fun () ->
        Bos.OS.Cmd.(run_out ~env ~err:err_run_out cmd |> out_string ~trim:true))
      ()
  in
  match result with
  | Error (`Msg m) | Ok (Error (`Msg m)) ->
      log sw (Printf.sprintf "%s: failed to run driver: %s" name m);
      Error ()
  | Ok (Ok (output, (_, status))) -> (
      if output <> "" then log sw output;
      match status with
      | `Exited 0 ->
          log sw (Printf.sprintf "%s: ok" name);
          Ok ()
      | `Exited n ->
          log sw (Printf.sprintf "%s: driver exited with %d" name n);
          Error ()
      | `Signaled n ->
          log sw (Printf.sprintf "%s: driver killed by signal %d" name n);
          Error ())

let sync ?(driver = Bos.Cmd.v "odd-driver") sw =
  with_lock sw @@ fun () ->
  let installed = SS.of_list (List.map fst (Switch.installed sw)) in
  let marked = Pending.read sw in
  let stale = List.filter (fun n -> SS.mem n installed) marked in
  (* A marker for a package that is no longer installed can only be left over
     from an install+remove in the same session (the remove hook's [rm -rf]
     normally clears it). Tidy it away. *)
  List.iter (fun n -> if not (SS.mem n installed) then erase_doc sw n) marked;
  (* Always regenerate the landing page (skipping the write when unchanged), so
     a session that only removed packages still drops them from the list. *)
  let finish outcome =
    Result.bind (Index_page.write sw) @@ fun () ->
    if outcome.built <> [] || outcome.failed <> [] then log sw (summary outcome);
    Ok outcome
  in
  match stale with
  | [] -> finish { built = []; failed = [] }
  | _ ->
      let driver_exists =
        match Bos.OS.Cmd.resolve driver with Ok _ -> true | Error _ -> false
      in
      if not driver_exists then (
        log sw
          (Printf.sprintf "driver %s not found; leaving %d package(s) pending"
             (Bos.Cmd.to_string driver) (List.length stale));
        (* Markers left intact, so the next session retries. *)
        finish { built = []; failed = stale })
      else
        Result.bind
          (Result.map
             (fun (_ : bool) -> ())
             (Bos.OS.Dir.create ~path:true (Switch.work_dir sw)))
        @@ fun () ->
        let env = driver_env sw in
        let ordered = Deps.order ~warn:(log sw) sw stale in
        let built, failed =
          List.fold_left
            (fun (built, failed) name ->
              (* Erase first (removing the marker) for a clean build; on failure
                 re-mark so the package is retried next session. *)
              erase_doc sw name;
              match run_driver sw ~driver ~env name with
              | Ok () -> (name :: built, failed)
              | Error () ->
                  ignore (Pending.mark sw name);
                  (built, name :: failed))
            ([], []) ordered
        in
        finish { built = List.rev built; failed = List.rev failed }