let src = Logs.Src.create "monopam.git_cli" ~doc:"Git CLI operations"

module Log = (val Logs.src_log src : Logs.LOG)

type cmd_result = { exit_code : int; stdout : string; stderr : string }

type error =
  | Command_failed of string * cmd_result
  | Not_a_repo of Fpath.t
  | Dirty_worktree of Fpath.t
  | Remote_not_found of string
  | Branch_not_found of string
  | Subtree_prefix_exists of string
  | Subtree_prefix_missing of string
  | Io_error of string

let pp_error ppf = function
  | Command_failed (cmd, r) ->
      Fmt.pf ppf "Command failed: %s (exit %d)@.stdout: %s@.stderr: %s" cmd
        r.exit_code r.stdout r.stderr
  | Not_a_repo path -> Fmt.pf ppf "Not a git repository: %a" Fpath.pp path
  | Dirty_worktree path ->
      Fmt.pf ppf "Repository has uncommitted changes: %a" Fpath.pp path
  | Remote_not_found name -> Fmt.pf ppf "Remote not found: %s" name
  | Branch_not_found name -> Fmt.pf ppf "Branch not found: %s" name
  | Subtree_prefix_exists prefix ->
      Fmt.pf ppf "Subtree prefix already exists: %s" prefix
  | Subtree_prefix_missing prefix ->
      Fmt.pf ppf "Subtree prefix does not exist: %s" prefix
  | Io_error msg -> Fmt.pf ppf "I/O error: %s" msg

let run_git ~proc ~cwd args =
  let cmd = "git" :: args in
  let buf_stdout = Buffer.create 256 in
  let buf_stderr = Buffer.create 256 in
  Eio.Switch.run @@ fun sw ->
  let child =
    Eio.Process.spawn proc ~sw ~cwd
      ~stdout:(Eio.Flow.buffer_sink buf_stdout)
      ~stderr:(Eio.Flow.buffer_sink buf_stderr)
      cmd
  in
  let exit_status = Eio.Process.await child in
  let exit_code =
    match exit_status with `Exited n -> n | `Signaled n -> 128 + n
  in
  {
    exit_code;
    stdout = Buffer.contents buf_stdout |> String.trim;
    stderr = Buffer.contents buf_stderr |> String.trim;
  }

(* Retry configuration shared by all [ls_remote_exists] calls. *)
let ls_remote_retry_config =
  Retry.config ~max_retries:2 ~backoff_factor:0.3 ~backoff_max:4.0 ()

(* [git ls-remote --exit-code] returns 0 if the remote has any refs, 2 if the
   remote is reachable but empty (a freshly created repo with no branches), and
   128 if the remote is unreachable. A freshly provisioned repo counts as
   "exists". *)
let ls_remote_exists ~clock ~proc ~fs ~url =
  let cwd = Eio.Path.(fs / "/") in
  let result_ref = ref None in
  let reachable (r : cmd_result) = r.exit_code = 0 || r.exit_code = 2 in
  let should_retry r = not (reachable r) in
  let attempt () =
    let r = run_git ~proc ~cwd [ "ls-remote"; "--exit-code"; url ] in
    result_ref := Some r;
    if reachable r then Ok () else Error r
  in
  let _ =
    Retry.with_retry_result ~clock ~config:ls_remote_retry_config ~should_retry
      attempt
  in
  match !result_ref with Some r -> reachable r | None -> false

let run_git_ok ~proc ~cwd args =
  let result = run_git ~proc ~cwd args in
  if result.exit_code = 0 then Ok result.stdout
  else Error (Command_failed (String.concat " " ("git" :: args), result))

let default_branch ~proc ~fs ~url =
  let cwd = Eio.Path.(fs / "/") in
  match run_git_ok ~proc ~cwd [ "ls-remote"; "--symref"; url; "HEAD" ] with
  | Error _ -> None
  | Ok stdout -> (
      (* First line is "ref: refs/heads/<branch>\tHEAD" when HEAD is a
         symbolic ref; absent when HEAD is detached. *)
      match String.split_on_char '\n' stdout with
      | first :: _ when String.starts_with ~prefix:"ref: refs/heads/" first -> (
          let after = String.sub first 16 (String.length first - 16) in
          match String.index_opt after '\t' with
          | Some i -> Some (String.sub after 0 i)
          | None -> None)
      | _ -> None)

(** Read user info from global git config (~/.gitconfig). *)
let global_git_user ~fs () =
  let path = Eio.Path.(Xdg_eio.home_dir fs / ".gitconfig") in
  match Eio.Path.load path with
  | content -> (
      let config = Git.Config.of_string content in
      let user = Git.Config.user config in
      match (user.name, user.email) with
      | Some name, Some email ->
          let date = Int64.of_float (Unix.gettimeofday ()) in
          Some (Git.User.v ~name ~email ~date ())
      | _ -> None)
  | exception Eio.Io _ -> None

(** Retryable HTTP 5xx and transient network error patterns, compiled once. Only
    matches errors where a retry is likely to succeed (server-side errors and
    mid-connection drops). Permanent failures like DNS resolution errors,
    connection refused, and unreachable networks are not retried. *)
let retryable_re =
  let open Re in
  let patterns =
    [
      "500";
      "502";
      "503";
      "504";
      "HTTP 5";
      "http 5";
      "Internal Server Error";
      "Bad Gateway";
      "Service Unavailable";
      "Gateway Timeout";
      "RPC failed";
      "unexpected disconnect";
      "the remote end hung up";
      "early EOF";
      "Connection reset";
    ]
  in
  compile (alt (List.map str patterns))

(** Check if an error is a retryable HTTP server error (5xx) or network error *)
let is_retryable_error result =
  result.stderr <> "" && Re.execp retryable_re result.stderr

(** Run a git command with retry logic for network errors. Retries up to
    [max_retries] times with exponential backoff starting at [initial_delay_ms].
*)
let run_git_ok_with_retry ~proc ~cwd ?(max_retries = 3)
    ?(initial_delay_ms = 2000) args =
  let rec attempt n delay_ms =
    let result = run_git ~proc ~cwd args in
    if result.exit_code = 0 then Ok result.stdout
    else if n < max_retries && is_retryable_error result then begin
      (* Log the retry (only with -v) *)
      Log.info (fun m ->
          m "Retrying in %dms (%d/%d)..." delay_ms (n + 1) max_retries);
      (* Sleep before retry - convert ms to seconds for Unix.sleepf *)
      Unix.sleepf (float_of_int delay_ms /. 1000.0);
      (* Exponential backoff: double the delay for next attempt *)
      attempt (n + 1) (delay_ms * 2)
    end
    else Error (Command_failed (String.concat " " ("git" :: args), result))
  in
  attempt 0 initial_delay_ms

let path_to_eio ~(fs : Eio.Fs.dir_ty Eio.Path.t) path =
  let dir, _ = fs in
  (dir, Fpath.to_string path)

let clone ~proc ~fs ~url ~branch target =
  let parent = Fpath.parent target in
  let cwd = Eio.Path.(fs / Fpath.to_string parent) in
  let target_name = Fpath.basename target in
  let url_str = url in
  let result =
    run_git_ok_with_retry ~proc ~cwd
      [ "clone"; "--branch"; branch; url_str; target_name ]
  in
  match result with
  | Ok _ -> Ok ()
  | Error (Command_failed (_, r))
    when Re.execp Re.(compile (str "Remote branch")) r.stderr
         && Re.execp Re.(compile (str "not found")) r.stderr ->
      (* Empty remote repo - init locally and add remote *)
      let target_dir = Eio.Path.(cwd / target_name) in
      (try Eio.Path.mkdir ~perm:0o755 target_dir with Eio.Io _ -> ());
      let ( let* ) = Result.bind in
      let* _ = run_git_ok ~proc ~cwd:target_dir [ "init"; "-b"; branch ] in
      (* Allow pushes to this non-bare repo (needed for subtree push) *)
      let* _ =
        run_git_ok ~proc ~cwd:target_dir
          [ "config"; "receive.denyCurrentBranch"; "updateInstead" ]
      in
      let* _ =
        run_git_ok ~proc ~cwd:target_dir [ "remote"; "add"; "origin"; url_str ]
      in
      Ok ()
  | Error e -> Error e

let ensure_receive_config ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd
    [ "config"; "receive.denyCurrentBranch"; "updateInstead" ]
  |> Result.map ignore

let clean_untracked ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "clean"; "-fd" ] |> Result.map ignore

let fetch ~proc ~fs ?(remote = "origin") path =
  let cwd = path_to_eio ~fs path in
  run_git_ok_with_retry ~proc ~cwd [ "fetch"; remote ] |> Result.map ignore

let fetch_all ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  run_git_ok_with_retry ~proc ~cwd [ "fetch"; "--all" ] |> Result.map ignore

let merge_ff ~proc ~fs ?(remote = "origin") ?branch path =
  let cwd = path_to_eio ~fs path in
  let branch =
    match branch with
    | Some b -> b
    | None ->
        let result = run_git ~proc ~cwd [ "symbolic-ref"; "--short"; "HEAD" ] in
        if result.exit_code = 0 then result.stdout else "main"
  in
  let upstream = remote ^ "/" ^ branch in
  run_git_ok ~proc ~cwd [ "merge"; "--ff-only"; upstream ] |> Result.map ignore

let pull ~proc ~fs ?(remote = "origin") ?branch path =
  let cwd = path_to_eio ~fs path in
  let args =
    match branch with
    | Some b -> [ "pull"; remote; b ]
    | None -> [ "pull"; remote ]
  in
  run_git_ok_with_retry ~proc ~cwd args |> Result.map ignore

let fetch_and_reset ~proc ~fs ?(remote = "origin") ~branch path =
  let cwd = path_to_eio ~fs path in
  match run_git_ok_with_retry ~proc ~cwd [ "fetch"; remote ] with
  | Error e -> Error e
  | Ok _ ->
      let upstream = remote ^ "/" ^ branch in
      run_git_ok ~proc ~cwd [ "reset"; "--hard"; upstream ] |> Result.map ignore

(** Open a local git repository, detecting whether it's bare or not. A bare repo
    has [HEAD] / [refs/] / [objects/] directly under [path]; a regular one has
    them under [path/.git/]. *)
let open_local ~sw ~fs path =
  let dotgit = Eio.Path.(fs / Fpath.to_string path / ".git") in
  match Eio.Path.kind ~follow:true dotgit with
  | `Directory -> Git.Repository.open_repo ~sw ~fs path
  | _ | (exception _) -> Git.Repository.open_bare ~sw ~fs path

(* Fetch from URL and return the commit hash for the branch.

   For file:// URLs (and bare local paths) this uses the native
   [Git.Fetch.local] which copies objects directly between the two
   on-disk repos — no [git] subprocess, no zlib re-compression of pack
   contents, fully cancellable via the Eio switch. The native path covers
   the entire monopam test suite and the daily-driver local-checkout flow
   (under [src/]). HTTP/SSH URLs still go through [git fetch]. *)
let fetch_url ~sw ~proc ~fs ~repo ~url ~branch () =
  match Git.Fetch.parse_url url with
  | `File src_path -> (
      let src_fpath =
        match Fpath.of_string src_path with
        | Ok p -> p
        | Error (`Msg m) ->
            failwith ("fetch_url: bad path " ^ src_path ^ ": " ^ m)
      in
      try
        let src_repo = open_local ~sw ~fs src_fpath in
        let dst_repo = open_local ~sw ~fs repo in
        match Git.Fetch.local ~src:src_repo ~dst:dst_repo ~ref_name:branch with
        | Ok hash -> Ok (Git.Hash.to_hex hash)
        | Error (`Msg msg) -> Error (Io_error msg)
      with e -> Error (Io_error (Printexc.to_string e)))
  | `Other _ -> (
      let cwd = path_to_eio ~fs repo in
      let url_str = url in
      match run_git_ok_with_retry ~proc ~cwd [ "fetch"; url_str; branch ] with
      | Error e -> Error e
      | Ok _ -> (
          match run_git_ok ~proc ~cwd [ "rev-parse"; "FETCH_HEAD" ] with
          | Error e -> Error e
          | Ok hash -> Ok (String.trim hash)))

let push_refspec ~proc ~fs ~repo ~url ~refspec ?(force = false) () =
  let cwd = path_to_eio ~fs repo in
  let url_str = url in
  let args =
    [ "push" ] @ (if force then [ "--force" ] else []) @ [ url_str; refspec ]
  in
  Log.debug (fun m -> m "push_refspec: git %s" (String.concat " " args));
  run_git_ok_with_retry ~proc ~cwd args |> Result.map ignore

let push_remote ~proc ~fs ?(remote = "origin") ?branch ?(force = false) path =
  let cwd = path_to_eio ~fs path in
  let branch =
    match branch with
    | Some b -> b
    | None ->
        let result = run_git ~proc ~cwd [ "symbolic-ref"; "--short"; "HEAD" ] in
        if result.exit_code = 0 then result.stdout else "main"
  in
  let args =
    [ "push" ] @ (if force then [ "--force" ] else []) @ [ remote; branch ]
  in
  run_git_ok_with_retry ~proc ~cwd args |> Result.map ignore

let push_ref ~proc ~fs ~repo ~target ~ref_spec () =
  let cwd = path_to_eio ~fs repo in
  run_git_ok ~proc ~cwd [ "push"; target; ref_spec ] |> Result.map ignore