module M = Merge_queue
open Command

(* The fetch before the lock, the reconciliation under it. *)
module Run = M.Run.Make (M.Pull)
module Run_loop = Loop.Make (Run) (Perform_run.Make (M.Pull) (Perform_pull))

let reconcile (q : queue) context request ~wait_wall =
  Eio.Switch.run @@ fun sw ->
  let now = Clock.now q.perform.clock in
  let run = run_name q.perform.caller ~now in
  let p = { q.perform with sw; run = Some run } in
  let machine, actions =
    Run.v ~run ~mode:M.Note.Self ~command:"pull" ~wait_wall ~now
      (M.Pull.v context request)
  in
  let machine =
    Run_loop.run ~records:(Journal.batch p.journal) ~clock:p.clock p machine
      actions
  in
  match Run.ending machine with
  | Some e -> e
  | None -> raise (Defect "mq pull ended with no outcome")

let args name =
  {
    Command_land.name = Some name;
    onto = None;
    dry_run = false;
    retry = false;
    keep_branch = false;
    no_wait = false;
    wait_for = None;
    resolve = Some false;
    expedite = None;
  }

let became (q : queue) name =
  List.find_map
    (function
      | Ok (l : M.Land.landed) -> Some l.landing.landed | Error _ -> None)
    (Perform.landings q.perform name)

(* A landing that did not land again: its commits under its own name, as
   they were on this machine, unless a branch has taken it since. *)
let restore (q : queue) (r : M.Pull.replay) =
  match
    Repo.set_ref q.perform.repo (M.Ref_name.branch r.name) ~expected:None
      (Some r.was) ~reflog:"mq pull: returned"
      ~now:(Clock.now q.perform.clock)
  with
  | Ok () -> Some r.name
  | Error _ -> None

let replay q ~in_check loaded (r : M.Pull.replay) =
  match Command_land.land_branch q ~in_check (args r.name) r.name loaded with
  | M.Land.Ended o ->
      Perform.announce (M.Outcome.first_line o);
      if o.word = M.Outcome.Landed then Ok (r, o, became q r.name, None)
      else Ok (r, o, None, restore q r)
  | M.Land.Left_queued s -> Error s
  | M.Land.Yielded _ ->
      raise (Defect "a replayed landing yielded to a run's end")
  | M.Land.Offered _ ->
      raise (Defect "a replayed landing was offered to the resolver")

let replays q ~in_check loaded ?named ~remote ~pulled rs =
  let rec go acc = function
    | [] -> Error (M.Pull.summary ?named ~remote ~pulled (List.rev acc))
    | r :: rest -> (
        match replay q ~in_check loaded r with
        | Ok x -> go (x :: acc) rest
        | Error _ -> Error (M.Pull.interrupted (r :: rest)))
  in
  match go [] rs with
  | Error o when o.word = M.Outcome.Landed -> Error o
  | r -> r

let run ctx ~remote ~no_wait =
  with_queue ~writes:true ctx (fun q ->
      initialised q @@ fun ((rules, _) as loaded) ->
      let context =
        {
          M.Pull.rules;
          rules_branch = q.perform.local.rules;
          scheduler = false;
        }
      in
      let wait_wall = M.Duration.of_seconds rules.M.Rules.bounds.wait_wall in
      match reconcile q context { remote; no_wait } ~wait_wall with
      | M.Pull.Stopped o -> Error o
      | Reconciled { report; replays = []; _ } -> Ok report
      | Reconciled { report; replays = rs; remotes; pulled } ->
          replays q
            ~in_check:(Command_land.in_check ctx q)
            loaded ?named:report.detail ~remote:remotes ~pulled rs)

(* The recovery remote a selected checkpoint comes from: the one
   mq.backupRemote names, which mq push publishes checkpoints to, at the URL
   it pushes to. *)
let recovery_url (q : queue) ~remote =
  let repo = q.perform.repo in
  match Repo.config repo "mq.backupRemote" with
  | None | Some "" ->
      Error
        (refused
           "selected notes come only from the configured mq.backupRemote, and \
            none is set")
  | Some backup when Option.fold ~none:false ~some:(( <> ) backup) remote ->
      Error
        (Fmt.kstr refused
           "selected notes come only from the configured mq.backupRemote, %s"
           backup)
  | Some backup -> (
      match Repo.remote_push_url repo backup with
      | None ->
          Error
            (Fmt.kstr refused "Git has no remote.%s.url for mq.backupRemote"
               backup)
      | Some url -> Ok (backup, url))

let import_notes ctx ~remote ~writer =
  with_queue ~writes:true ctx @@ fun q ->
  let ( let* ) = Result.bind in
  let* backup, url = recovery_url q ~remote in
  let repo = q.perform.repo in
  let result =
    let* commit = Repo.checkpoint_notes repo ~url ~writer in
    (Repo.import_notes repo ~now:(Clock.now q.perform.clock) commit
      :> (int, [ Repo.remote_error | `Refused of string ]) result)
  in
  match result with
  | Ok n ->
      Ok
        (M.Report.v M.Report.Pulled backup
           ~detail:
             (Fmt.str "the check results of %d %s from writer %s" n
                (if n = 1 then "tree" else "trees")
                writer))
  | Error (`Refused why) -> Error (refused why)
  | Error (`Unreachable why | `Unsupported why | `Untrusted why) ->
      Error (unavailable why)