monopam / lib / git.ml

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;
  }

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))

(** Helper for substring check *)
let string_contains ~needle haystack =
  let needle_len = String.length needle in
  let haystack_len = String.length haystack in
  if needle_len > haystack_len then false
  else
    let rec check i =
      if i + needle_len > haystack_len then false
      else if String.sub haystack i needle_len = needle then true
      else check (i + 1)
    in
    check 0

(** Check if an error is a retryable HTTP server error (5xx) or network error *)
let is_retryable_error result =
  let stderr = result.stderr in
  (* Common patterns for HTTP 5xx errors in git output *)
  String.length stderr > 0 &&
  (string_contains ~needle:"500" stderr ||
   string_contains ~needle:"502" stderr ||
   string_contains ~needle:"503" stderr ||
   string_contains ~needle:"504" stderr ||
   string_contains ~needle:"HTTP 5" stderr ||
   string_contains ~needle:"http 5" stderr ||
   string_contains ~needle:"Internal Server Error" stderr ||
   string_contains ~needle:"Bad Gateway" stderr ||
   string_contains ~needle:"Service Unavailable" stderr ||
   string_contains ~needle:"Gateway Timeout" stderr ||
   (* RPC failures (common git smart HTTP errors) *)
   string_contains ~needle:"RPC failed" stderr ||
   string_contains ~needle:"curl" stderr ||
   string_contains ~needle:"unexpected disconnect" stderr ||
   string_contains ~needle:"the remote end hung up" stderr ||
   string_contains ~needle:"early EOF" stderr ||
   (* Connection errors *)
   string_contains ~needle:"Connection refused" stderr ||
   string_contains ~needle:"Connection reset" stderr ||
   string_contains ~needle:"Connection timed out" stderr ||
   string_contains ~needle:"Could not resolve host" stderr ||
   string_contains ~needle:"Failed to connect" stderr ||
   string_contains ~needle:"Network is unreachable" stderr ||
   string_contains ~needle:"Temporary failure" 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 *)
      Logs.warn (fun m ->
          m "Git command failed with retryable error, retrying in %dms (%d/%d): %s"
            delay_ms (n + 1) max_retries result.stderr);
      (* 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 is_repo ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  try
    let result = run_git ~proc ~cwd [ "rev-parse"; "--git-dir" ] in
    result.exit_code = 0
  with Eio.Io _ -> false (* Directory doesn't exist or not accessible *)

let is_dirty ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  let result = run_git ~proc ~cwd [ "status"; "--porcelain" ] in
  result.exit_code = 0 && result.stdout <> ""

let current_branch ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  let result = run_git ~proc ~cwd [ "symbolic-ref"; "--short"; "HEAD" ] in
  if result.exit_code = 0 then Some result.stdout else None

let head_commit ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "rev-parse"; "HEAD" ]

let rev_parse ~proc ~fs ~rev path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "rev-parse"; rev ]

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 = Uri.to_string url in
  run_git_ok_with_retry ~proc ~cwd [ "clone"; "--branch"; branch; url_str; target_name ]
  |> 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 -> Option.value ~default:"main" (current_branch ~proc ~fs path)
  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

let checkout ~proc ~fs ~branch path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "checkout"; branch ] |> Result.map ignore

type ahead_behind = { ahead : int; behind : int }

let ahead_behind ~proc ~fs ?(remote = "origin") ?branch path =
  let cwd = path_to_eio ~fs path in
  let branch =
    match branch with
    | Some b -> b
    | None -> Option.value ~default:"HEAD" (current_branch ~proc ~fs path)
  in
  let upstream = remote ^ "/" ^ branch in
  match
    run_git_ok ~proc ~cwd
      [ "rev-list"; "--left-right"; "--count"; branch ^ "..." ^ upstream ]
  with
  | Error e -> Error e
  | Ok output -> (
      match String.split_on_char '\t' output with
      | [ ahead; behind ] ->
          Ok { ahead = int_of_string ahead; behind = int_of_string behind }
      | _ -> Ok { ahead = 0; behind = 0 })

module Subtree = struct
  let exists ~fs ~repo ~prefix =
    let path = Eio.Path.(fs / Fpath.to_string repo / prefix) in
    match Eio.Path.kind ~follow:true path with
    | `Directory -> true
    | _ -> false
    | exception _ -> false

  let add ~proc ~fs ~repo ~prefix ~url ~branch () =
    if exists ~fs ~repo ~prefix then Error (Subtree_prefix_exists prefix)
    else
      let cwd = path_to_eio ~fs repo in
      let url_str = Uri.to_string url in
      run_git_ok_with_retry ~proc ~cwd
        [ "subtree"; "add"; "--prefix"; prefix; url_str; branch; "--squash" ]
      |> Result.map ignore

  let pull ~proc ~fs ~repo ~prefix ~url ~branch () =
    if not (exists ~fs ~repo ~prefix) then Error (Subtree_prefix_missing prefix)
    else
      let cwd = path_to_eio ~fs repo in
      let url_str = Uri.to_string url in
      run_git_ok_with_retry ~proc ~cwd
        [ "subtree"; "pull"; "--prefix"; prefix; url_str; branch; "--squash" ]
      |> Result.map ignore

  let push ~proc ~fs ~repo ~prefix ~url ~branch () =
    if not (exists ~fs ~repo ~prefix) then Error (Subtree_prefix_missing prefix)
    else
      let cwd = path_to_eio ~fs repo in
      let url_str = Uri.to_string url in
      run_git_ok_with_retry ~proc ~cwd
        [ "subtree"; "push"; "--prefix"; prefix; url_str; branch ]
      |> Result.map ignore

  let split ~proc ~fs ~repo ~prefix () =
    if not (exists ~fs ~repo ~prefix) then Error (Subtree_prefix_missing prefix)
    else
      let cwd = path_to_eio ~fs repo in
      run_git_ok ~proc ~cwd [ "subtree"; "split"; "--prefix"; prefix ]
end

let init ~proc ~fs path =
  let cwd = path_to_eio ~fs (Fpath.parent path) in
  let name = Fpath.basename path in
  run_git_ok ~proc ~cwd [ "init"; name ] |> Result.map ignore

let commit_allow_empty ~proc ~fs ~message path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "commit"; "--allow-empty"; "-m"; message ]
  |> Result.map ignore

let push_remote ~proc ~fs ?(remote = "origin") ?branch path =
  let cwd = path_to_eio ~fs path in
  let branch =
    match branch with
    | Some b -> b
    | None -> Option.value ~default:"main" (current_branch ~proc ~fs path)
  in
  run_git_ok_with_retry ~proc ~cwd [ "push"; remote; branch ] |> 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

let set_push_url ~proc ~fs ?(remote = "origin") ~url path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "remote"; "set-url"; "--push"; remote; url ]
  |> Result.map ignore

let get_push_url ~proc ~fs ?(remote = "origin") path =
  let cwd = path_to_eio ~fs path in
  match run_git_ok ~proc ~cwd [ "remote"; "get-url"; "--push"; remote ] with
  | Ok url -> Some url
  | Error _ -> None

let list_remotes ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  match run_git_ok ~proc ~cwd [ "remote" ] with
  | Ok output ->
      String.split_on_char '\n' output
      |> List.filter (fun s -> String.trim s <> "")
  | Error _ -> []

let get_remote_url ~proc ~fs ~remote path =
  let cwd = path_to_eio ~fs path in
  match run_git_ok ~proc ~cwd [ "remote"; "get-url"; remote ] with
  | Ok url -> Some (String.trim url)
  | Error _ -> None

let add_remote ~proc ~fs ~name ~url path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "remote"; "add"; name; url ] |> Result.map ignore

let remove_remote ~proc ~fs ~name path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "remote"; "remove"; name ] |> Result.map ignore

let set_remote_url ~proc ~fs ~name ~url path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "remote"; "set-url"; name; url ] |> Result.map ignore

let ensure_remote ~proc ~fs ~name ~url path =
  let remotes = list_remotes ~proc ~fs path in
  if List.mem name remotes then begin
    (* Remote exists, check if URL matches *)
    match get_remote_url ~proc ~fs ~remote:name path with
    | Some existing_url when existing_url = url -> Ok ()
    | _ -> set_remote_url ~proc ~fs ~name ~url path
  end
  else add_remote ~proc ~fs ~name ~url path

type log_entry = {
  hash : string;
  author : string;
  date : string;
  subject : string;
  body : string;
}

let parse_log_entries output =
  if String.trim output = "" then []
  else
    (* Split by the record separator (NUL at end of each record) *)
    let records = String.split_on_char '\x00' output in
    (* Filter empty strings and parse each record *)
    List.filter_map
      (fun record ->
        let record = String.trim record in
        if record = "" then None
        else
          (* Each record is: hash\nauthor\ndate\nsubject\nbody *)
          match String.split_on_char '\n' record with
          | hash :: author :: date :: subject :: body_lines ->
              Some
                {
                  hash;
                  author;
                  date;
                  subject;
                  body = String.concat "\n" body_lines;
                }
          | _ -> None)
      records

let log ~proc ~fs ?since ?until ?path:(filter_path : string option) repo_path =
  let cwd = path_to_eio ~fs repo_path in
  (* Build args: use format with NUL separator between records *)
  let format_arg = "--format=%H%n%an%n%aI%n%s%n%b%x00" in
  let args = [ "log"; format_arg ] in
  let args =
    match since with Some s -> args @ [ "--since=" ^ s ] | None -> args
  in
  let args =
    match until with Some u -> args @ [ "--until=" ^ u ] | None -> args
  in
  let args =
    match filter_path with Some p -> args @ [ "--"; p ] | None -> args
  in
  match run_git_ok ~proc ~cwd args with
  | Ok output -> Ok (parse_log_entries output)
  | Error e -> Error e

let log_range ~proc ~fs ~base ~tip ?max_count repo_path =
  let cwd = path_to_eio ~fs repo_path in
  let format_arg = "--format=%H%n%an%n%aI%n%s%n%b%x00" in
  let range = Printf.sprintf "%s..%s" base tip in
  let args = [ "log"; format_arg; range ] in
  let args =
    match max_count with
    | Some n -> args @ [ "-n"; string_of_int n ]
    | None -> args
  in
  match run_git_ok ~proc ~cwd args with
  | Ok output -> Ok (parse_log_entries output)
  | Error e -> Error e

let show_patch ~proc ~fs ~commit repo_path =
  let cwd = path_to_eio ~fs repo_path in
  run_git_ok ~proc ~cwd [ "show"; "--patch"; "--stat"; commit ]

(** Parse a subtree merge/squash commit message to extract the upstream commit range.
    Messages look like: "Squashed 'prefix/' changes from abc123..def456"
    or "Squashed 'prefix/' content from commit abc123"
    Returns the end commit (most recent) if found. *)
let parse_subtree_message subject =
  (* Helper to extract hex commit hash starting at position *)
  let extract_hex s start =
    let len = String.length s in
    let rec find_end i =
      if i >= len then i
      else
        match s.[i] with '0' .. '9' | 'a' .. 'f' -> find_end (i + 1) | _ -> i
    in
    let end_pos = find_end start in
    if end_pos > start then Some (String.sub s start (end_pos - start))
    else None
  in
  (* Pattern 1: "Squashed 'prefix/' changes from abc123..def456" *)
  if String.starts_with ~prefix:"Squashed '" subject then
    match String.index_opt subject '.' with
    | Some i when i + 1 < String.length subject && subject.[i + 1] = '.' ->
        extract_hex subject (i + 2)
    | _ -> (
        (* Pattern 2: "Squashed 'prefix/' content from commit abc123" *)
        match String.split_on_char ' ' subject |> List.rev with
        | last :: "commit" :: "from" :: _ -> extract_hex last 0
        | _ -> None) (* Pattern 3: "Add 'prefix/' from commit abc123" *)
  else if String.starts_with ~prefix:"Add '" subject then
    match String.split_on_char ' ' subject |> List.rev with
    | last :: "commit" :: "from" :: _ -> extract_hex last 0
    | _ -> None
  else None

(** Find the last subtree-related commit for a given prefix. Searches git log
    for commits with subtree merge/squash messages. *)
let subtree_last_upstream_commit ~proc ~fs ~repo ~prefix () =
  let cwd = path_to_eio ~fs repo in
  (* Search for subtree-related commits - don't use path filter as it can miss merge commits *)
  let grep_pattern = Printf.sprintf "^Squashed '%s/'" prefix in
  match
    run_git_ok ~proc ~cwd [ "log"; "--oneline"; "-1"; "--grep"; grep_pattern ]
  with
  | Error _ -> None
  | Ok "" -> (
      (* Try alternate pattern: Add 'prefix/' from commit *)
      let add_pattern = Printf.sprintf "^Add '%s/'" prefix in
      match
        run_git_ok ~proc ~cwd
          [ "log"; "--oneline"; "-1"; "--grep"; add_pattern ]
      with
      | Error _ -> None
      | Ok "" -> None
      | Ok line -> (
          (* line is "abc1234 Add 'prefix/' from commit ..." *)
          let hash = String.sub line 0 (min 7 (String.length line)) in
          (* Get the full commit message to parse *)
          match run_git_ok ~proc ~cwd [ "log"; "-1"; "--format=%s"; hash ] with
          | Error _ -> None
          | Ok subject -> parse_subtree_message subject))
  | Ok line -> (
      let hash = String.sub line 0 (min 7 (String.length line)) in
      match run_git_ok ~proc ~cwd [ "log"; "-1"; "--format=%s"; hash ] with
      | Error _ -> None
      | Ok subject -> parse_subtree_message subject)

(** Check if commit1 is an ancestor of commit2. *)
let is_ancestor ~proc ~fs ~repo ~commit1 ~commit2 () =
  let cwd = path_to_eio ~fs repo in
  let result =
    run_git ~proc ~cwd [ "merge-base"; "--is-ancestor"; commit1; commit2 ]
  in
  result.exit_code = 0

(** Find the merge-base (common ancestor) of two commits. *)
let merge_base ~proc ~fs ~repo ~commit1 ~commit2 () =
  let cwd = path_to_eio ~fs repo in
  run_git_ok ~proc ~cwd [ "merge-base"; commit1; commit2 ]

(** Count commits between two commits (exclusive of base, inclusive of head). *)
let count_commits_between ~proc ~fs ~repo ~base ~head () =
  let cwd = path_to_eio ~fs repo in
  match run_git_ok ~proc ~cwd [ "rev-list"; "--count"; base ^ ".." ^ head ] with
  | Error _ -> 0
  | Ok s -> ( try int_of_string (String.trim s) with _ -> 0)

(** {1 Worktree Operations} *)

module Worktree = struct
  type entry = {
    path : Fpath.t;
    head : string;
    branch : string option;
  }

  let add ~proc ~fs ~repo ~path ~branch () =
    let cwd = path_to_eio ~fs repo in
    let path_str = Fpath.to_string path in
    run_git_ok ~proc ~cwd
      [ "worktree"; "add"; "-b"; branch; path_str ]
    |> Result.map ignore

  let remove ~proc ~fs ~repo ~path ~force () =
    let cwd = path_to_eio ~fs repo in
    let path_str = Fpath.to_string path in
    let args =
      if force then [ "worktree"; "remove"; "--force"; path_str ]
      else [ "worktree"; "remove"; path_str ]
    in
    run_git_ok ~proc ~cwd args |> Result.map ignore

  let list ~proc ~fs repo =
    let cwd = path_to_eio ~fs repo in
    match run_git_ok ~proc ~cwd [ "worktree"; "list"; "--porcelain" ] with
    | Error _ -> []
    | Ok output ->
        if String.trim output = "" then []
        else
          (* Parse porcelain output: blocks separated by blank lines
             Each block has:
               worktree /path/to/worktree
               HEAD abc123...
               branch refs/heads/branchname (or detached) *)
          let lines = String.split_on_char '\n' output in
          let rec parse_entries acc current_path current_head current_branch = function
            | [] ->
                (* Finalize last entry if we have one *)
                (match current_path, current_head with
                | Some p, Some h ->
                    let entry = { path = p; head = h; branch = current_branch } in
                    List.rev (entry :: acc)
                | _ -> List.rev acc)
            | "" :: rest ->
                (* End of entry block *)
                (match current_path, current_head with
                | Some p, Some h ->
                    let entry = { path = p; head = h; branch = current_branch } in
                    parse_entries (entry :: acc) None None None rest
                | _ -> parse_entries acc None None None rest)
            | line :: rest ->
                if String.starts_with ~prefix:"worktree " line then
                  let path_str = String.sub line 9 (String.length line - 9) in
                  (match Fpath.of_string path_str with
                  | Ok p -> parse_entries acc (Some p) current_head current_branch rest
                  | Error _ -> parse_entries acc current_path current_head current_branch rest)
                else if String.starts_with ~prefix:"HEAD " line then
                  let head = String.sub line 5 (String.length line - 5) in
                  parse_entries acc current_path (Some head) current_branch rest
                else if String.starts_with ~prefix:"branch " line then
                  let branch_ref = String.sub line 7 (String.length line - 7) in
                  (* Extract branch name from refs/heads/... *)
                  let branch =
                    if String.starts_with ~prefix:"refs/heads/" branch_ref then
                      Some (String.sub branch_ref 11 (String.length branch_ref - 11))
                    else
                      Some branch_ref
                  in
                  parse_entries acc current_path current_head branch rest
                else if line = "detached" then
                  parse_entries acc current_path current_head None rest
                else
                  parse_entries acc current_path current_head current_branch rest
          in
          parse_entries [] None None None lines

  let exists ~proc ~fs ~repo ~path =
    let worktrees = list ~proc ~fs repo in
    List.exists (fun e -> Fpath.equal e.path path) worktrees
end

let cherry_pick ~proc ~fs ~commit path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "cherry-pick"; commit ] |> Result.map ignore

let merge ~proc ~fs ~ref_name ?(ff_only=false) path =
  let cwd = path_to_eio ~fs path in
  let args = ["merge"] @ (if ff_only then ["--ff-only"] else []) @ [ref_name] in
  run_git_ok ~proc ~cwd args |> Result.map ignore

(** {1 Diff Operations} *)

let diff_trees ~proc ~fs ~source ~target =
  (* Use git diff --no-index to compare two directory trees.
     This works even if neither directory is a git repo.
     Exit code 0 = no diff, exit code 1 = diff found, other = error *)
  let cwd = path_to_eio ~fs (Fpath.v ".") in
  let source_str = Fpath.to_string source in
  let target_str = Fpath.to_string target in
  let result =
    run_git ~proc ~cwd
      [
        "diff";
        "--no-index";
        "--binary";
        (* Handle binary files *)
        "--no-color";
        target_str;
        (* old = checkout *)
        source_str (* new = monorepo subtree *);
      ]
  in
  match result.exit_code with
  | 0 ->
      (* No differences *)
      Ok ""
  | 1 ->
      (* Differences found - this is success for diff *)
      Ok result.stdout
  | _ ->
      (* Actual error *)
      Error
        (Command_failed
           (String.concat " " [ "git"; "diff"; "--no-index" ], result))

let apply_diff ~proc ~fs ~cwd ~diff =
  if String.length diff = 0 then Ok ()
  else
    let cwd_eio = path_to_eio ~fs cwd in
    (* Apply the diff using git apply.
       We need to handle the path rewriting since git diff --no-index
       uses absolute or relative paths as prefixes. *)
    let cmd = [ "apply"; "--binary"; "-p1"; "-" ] 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:cwd_eio
        ~stdin:(Eio.Flow.string_source diff)
        ~stdout:(Eio.Flow.buffer_sink buf_stdout)
        ~stderr:(Eio.Flow.buffer_sink buf_stderr)
        ("git" :: cmd)
    in
    let exit_status = Eio.Process.await child in
    match exit_status with
    | `Exited 0 -> Ok ()
    | `Exited n | `Signaled n ->
        Error
          (Command_failed
             ( String.concat " " ("git" :: cmd),
               {
                 exit_code = n;
                 stdout = Buffer.contents buf_stdout;
                 stderr = Buffer.contents buf_stderr;
               } ))

let add_all ~proc ~fs path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "add"; "-A" ] |> Result.map ignore

let commit ~proc ~fs ~message path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "commit"; "-m"; message ] |> Result.map ignore

let rm ~proc ~fs ~recursive path target =
  let cwd = path_to_eio ~fs path in
  let args = if recursive then [ "rm"; "-r"; target ] else [ "rm"; target ] in
  run_git_ok ~proc ~cwd args |> Result.map ignore

let config ~proc ~fs ~key ~value path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "config"; key; value ] |> Result.map ignore

let has_subtree_history ~proc ~fs ~repo ~prefix () =
  (* Check if there's subtree commit history for this prefix.
     Returns true if we can find a subtree-related commit message. *)
  subtree_last_upstream_commit ~proc ~fs ~repo ~prefix () |> Option.is_some

let branch_rename ~proc ~fs ~new_name path =
  let cwd = path_to_eio ~fs path in
  run_git_ok ~proc ~cwd [ "branch"; "-M"; new_name ] |> Result.map ignore