test(ocaml-git): add unit and fuzz tests for Git.Tree.add deduplication

Add a unit test that catches the duplicate-entry bug (add same name twice
should replace, not accumulate). Add a Crowbar model-based fuzz suite that
applies random Add/Remove sequences to both Git.Tree.t and a Map reference,
checking no-duplicates, sorted-order, and model-agreement invariants after
every step. The roundtrip-after-ops test also exercises serialization across
arbitrary op sequences.

.gitignore

···
+_build/
+*.install

.ocamlformat

···
+version=0.28.1

LICENSE.md

···
+## ISC License
+
+Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+Permission to use, copy, modify, and distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+---
+
+This library is derived from:
+
+- [ocaml-git](https://github.com/mirage/ocaml-git) - Git format and protocol in pure OCaml
+  Copyright (c) 2013-2017 Thomas Gazagnaire, Romain Calascibetta
+  ISC License
+
+- [carton](https://github.com/robur-coop/carton) - PACKv2 file implementation
+  Copyright (c) 2020-2024 Romain Calascibetta
+  ISC License

README.md

···
+# git
+
+Git object format implementation in pure OCaml.
+
+## Overview
+
+Type-safe encoding and decoding of Git objects: blobs, trees, commits, tags,
+and references. Minimal dependencies with streaming I/O via bytesrw.
+
+## Features
+
+- All Git object types: blob, tree, commit, tag
+- Reference handling (branches, tags, HEAD)
+- Pack file support
+- SHA-1 hashing with digestif
+- Streaming I/O with bytesrw
+
+## Installation
+
+```
+opam install git
+```
+
+## Usage
+
+```ocaml
+open Git
+
+(* Create a blob *)
+let blob = Blob.of_string "Hello, World!\n"
+let blob_hash = Blob.digest blob
+
+(* Create a tree entry *)
+let entry = Tree.entry ~perm:`Normal ~name:"hello.txt" blob_hash
+let tree = Tree.v [ entry ]
+let tree_hash = Tree.digest tree
+
+(* Create a commit *)
+let author = User.v ~name:"Alice" ~email:"[e-mail]" ()
+let commit = Commit.v
+  ~tree:tree_hash
+  ~author
+  ~committer:author
+  (Some "Initial commit")
+```
+
+## Credits
+
+This is a simplified rewrite derived from:
+
+- [ocaml-git](https://github.com/mirage/ocaml-git) - Git format and protocol
+  in pure OCaml by Thomas Gazagnaire and Romain Calascibetta
+- [carton](https://github.com/robur-coop/carton) - PACKv2 file implementation
+  by Romain Calascibetta
+
+## Licence
+
+ISC License. See [LICENSE.md](LICENSE.md) for details.

bench/dune

···
+(executable
+ (name pack_bench)
+ (libraries git memtrace))

bench/pack_bench.ml

···
+(* Benchmark for pack fold - run with MEMTRACE=pack.ctf to profile *)
+
+let () = Memtrace.trace_if_requested ()
+
+let pack_file =
+  let ic = open_in_bin "../test/pack-testzone-0.pack" in
+  let len = in_channel_length ic in
+  let data = really_input_string ic len in
+  close_in ic;
+  data
+
+let () =
+  match Git.Pack.of_string pack_file with
+  | Error (`Msg m) -> failwith m
+  | Ok pack ->
+      (* Run fold multiple times to get meaningful profile data *)
+      for _ = 1 to 100 do
+        let _ =
+          Git.Pack.fold
+            (fun ~offset:_ ~kind:_ ~data acc -> acc + String.length data)
+            0 pack
+        in
+        ()
+      done;
+      Fmt.pr "Done: folded %d objects x 100 iterations\n%!"
+        (Git.Pack.count pack)

bin/dune

···
+(executable
+ (name git_mono)
+ (public_name git-mono)
+ (libraries git eio_posix cmdliner vlog tty memtrace monopam-info))

bin/git_mono.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+open Cmdliner
+
+let setup =
+  Term.(const (fun () () -> ()) $ Vlog.setup "git-mono" $ Memtrace.term)
+
+let src = Logs.Src.create "git-mono" ~doc:"git-mono CLI"
+
+module Log = (val Logs.src_log src : Logs.LOG)
+
+(** {1 Common options} *)
+
+let repo_path =
+  let doc = "Path to the git repository. Defaults to the current directory." in
+  Arg.(value & opt dir "." & info [ "C" ] ~docv:"DIR" ~doc)
+
+(** {1 Output helpers} *)
+
+let pp_error ppf msg =
+  Fmt.pf ppf "%a %s@."
+    Tty.(Style.styled Style.(fg Color.red) Fmt.string)
+    "error:" msg
+
+(** {1 Split command} *)
+
+let split_prefix =
+  let doc =
+    "Subtree prefix to split. This is the subdirectory whose history will be \
+     extracted into a standalone commit chain."
+  in
+  Arg.(required & pos 0 (some string) None & info [] ~docv:"PREFIX" ~doc)
+
+let split_rev =
+  let doc =
+    "Revision to split from. Defaults to HEAD. Can be a branch name, tag, or \
+     commit hash."
+  in
+  Arg.(value & opt string "HEAD" & info [ "r"; "rev" ] ~docv:"REV" ~doc)
+
+let resolve_rev repo rev =
+  if rev = "HEAD" then Git.Repository.read_ref repo "HEAD"
+  else
+    match Git.Repository.read_ref repo ("refs/heads/" ^ rev) with
+    | Some h -> Some h
+    | None -> (
+        try Some (Git.Hash.of_hex rev)
+        with Invalid_argument _ ->
+          Git.Repository.read_ref repo ("refs/tags/" ^ rev))
+
+let split ~repo_path ~prefix ~rev () =
+  Eio_posix.run @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
+  let repo = Git.Repository.open_repo ~fs (Fpath.v repo_path) in
+  match resolve_rev repo rev with
+  | None ->
+      pp_error Fmt.stderr (Fmt.str "Could not resolve revision '%s'." rev);
+      `Error (false, Fmt.str "could not resolve revision '%s'" rev)
+  | Some head_hash -> (
+      Log.info (fun m ->
+          m "Splitting prefix '%s' from %a" prefix Git.Hash.pp head_hash);
+      match Git.Subtree.split repo ~prefix ~head:head_hash () with
+      | Error (`Msg msg) ->
+          pp_error Fmt.stderr msg;
+          `Error (false, msg)
+      | Ok None ->
+          Log.warn (fun m -> m "No commits touch prefix '%s'." prefix);
+          `Ok ()
+      | Ok (Some hash) ->
+          Fmt.pr "%s@." (Git.Hash.to_hex hash);
+          `Ok ())
+
+let split_term =
+  Term.(
+    ret
+      (const (fun () repo_path prefix rev -> split ~repo_path ~prefix ~rev ())
+      $ setup $ repo_path $ split_prefix $ split_rev))
+
+(** {1 Verify command} *)
+
+let verify ~repo_path ~prefix () =
+  Eio_posix.run @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
+  let repo = Git.Repository.open_repo ~fs (Fpath.v repo_path) in
+  let checked, errors = Git.Subtree.verify repo ~prefix () in
+  Fmt.pr "Checked %d cache entries@." checked;
+  match errors with
+  | [] ->
+      Fmt.pr "%a cache is valid@."
+        Tty.(Style.styled Style.(fg Color.green) Fmt.string)
+        "✓";
+      `Ok ()
+  | errs ->
+      Fmt.pr "%a Found %d errors:@."
+        Tty.(Style.styled Style.(fg Color.red) Fmt.string)
+        "✗" (List.length errs);
+      List.iter
+        (fun Git.Subtree.{ original; split; reason } ->
+          let short h = String.sub (Git.Hash.to_hex h) 0 7 in
+          Fmt.pr "  %s -> %s: %s@." (short original) (short split) reason)
+        errs;
+      `Error (false, "cache validation failed")
+
+let verify_term =
+  Term.(
+    ret
+      (const (fun () repo_path prefix -> verify ~repo_path ~prefix ())
+      $ setup $ repo_path $ split_prefix))
+
+let verify_cmd =
+  let info =
+    Cmd.info "verify" ~doc:"Verify subtree cache integrity"
+      ~man:
+        [
+          `S Manpage.s_description;
+          `P
+            "Validate the cached mappings for a subtree prefix. Checks that \
+             split commits have correct trees and that subtree merge commits \
+             preserve mainline parents.";
+          `S Manpage.s_examples;
+          `P "Verify the cache for $(b,monopam):";
+          `Pre "  $(tname) monopam";
+        ]
+  in
+  Cmd.v info verify_term
+
+(** {1 Check command} *)
+
+let check_prefix =
+  let doc =
+    "Package prefix to check. Commits with git-subtree-dir for other prefixes \
+     are flagged as issues."
+  in
+  Arg.(required & pos 0 (some string) None & info [] ~docv:"PREFIX" ~doc)
+
+let check ~repo_path ~prefix () =
+  Eio_posix.run @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
+  let repo = Git.Repository.open_repo ~fs (Fpath.v repo_path) in
+  match Git.Repository.head repo with
+  | None ->
+      pp_error Fmt.stderr "No HEAD found.";
+      `Error (false, "no HEAD")
+  | Some head_hash -> (
+      let checked, issues = Git.Subtree.check repo ~prefix ~head:head_hash () in
+      Fmt.pr "Checked %d commits@." checked;
+      match issues with
+      | [] ->
+          Fmt.pr "%a no unrelated merge commits found@."
+            Tty.(Style.styled Style.(fg Color.green) Fmt.string)
+            "✓";
+          `Ok ()
+      | _ ->
+          Fmt.pr "%a Found %d unrelated merge commits:@."
+            Tty.(Style.styled Style.(fg Color.red) Fmt.string)
+            "✗" (List.length issues);
+          List.iter
+            (fun Git.Subtree.{ commit; message; subtree_dir } ->
+              let short = String.sub (Git.Hash.to_hex commit) 0 7 in
+              let dir = Option.value subtree_dir ~default:"?" in
+              let msg_line =
+                match String.index_opt message '\n' with
+                | Some i -> String.sub message 0 i
+                | None -> message
+              in
+              Fmt.pr "  %s [%s] %s@." short dir msg_line)
+            issues;
+          `Error (false, "found unrelated merge commits"))
+
+let check_term =
+  Term.(
+    ret
+      (const (fun () repo_path prefix -> check ~repo_path ~prefix ())
+      $ setup $ repo_path $ check_prefix))
+
+let check_cmd =
+  let info =
+    Cmd.info "check" ~doc:"Detect unrelated subtree merge commits"
+      ~man:
+        [
+          `S Manpage.s_description;
+          `P
+            "Scan commit history and detect subtree merge commits that are \
+             unrelated to the specified prefix. These commits have \
+             git-subtree-dir metadata for a different package and typically \
+             indicate polluted history from earlier syncs.";
+          `S Manpage.s_examples;
+          `P "Check monopam history for pollution:";
+          `Pre "  $(tname) monopam";
+        ]
+  in
+  Cmd.v info check_term
+
+(** {1 Fix command} *)
+
+let fix ~repo_path ~prefix () =
+  Eio_posix.run @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
+  let repo = Git.Repository.open_repo ~fs (Fpath.v repo_path) in
+  match Git.Repository.head repo with
+  | None ->
+      pp_error Fmt.stderr "No HEAD found.";
+      `Error (false, "no HEAD")
+  | Some head_hash -> (
+      Log.info (fun m ->
+          m "Fixing history for prefix '%s' from %a" prefix Git.Hash.pp
+            head_hash);
+      match Git.Subtree.fix repo ~prefix ~head:head_hash () with
+      | Error (`Msg msg) ->
+          pp_error Fmt.stderr msg;
+          `Error (false, msg)
+      | Ok None ->
+          Log.warn (fun m -> m "No commits remain after filtering.");
+          `Ok ()
+      | Ok (Some new_hash) ->
+          Fmt.pr "%s@." (Git.Hash.to_hex new_hash);
+          `Ok ())
+
+let fix_term =
+  Term.(
+    ret
+      (const (fun () repo_path prefix -> fix ~repo_path ~prefix ())
+      $ setup $ repo_path $ check_prefix))
+
+let fix_cmd =
+  let info =
+    Cmd.info "fix" ~doc:"Remove unrelated subtree merge commits from history"
+      ~man:
+        [
+          `S Manpage.s_description;
+          `P
+            "Rewrite commit history to remove unrelated subtree merge commits. \
+             These are commits with git-subtree-dir metadata for a different \
+             package where the tree is unchanged from the first parent.";
+          `P
+            "This creates new commit objects - the original commits remain in \
+             the repository. Use the output hash to update refs as needed.";
+          `S Manpage.s_examples;
+          `P "Fix monopam history and update HEAD:";
+          `Pre "  git update-ref HEAD $(git-mono fix monopam)";
+          `P "Fix and force push to origin:";
+          `Pre "  git push -f origin $(git-mono fix monopam):main";
+        ]
+  in
+  Cmd.v info fix_term
+
+let split_cmd =
+  let info =
+    Cmd.info "split" ~doc:"Extract subtree history into standalone commits"
+      ~man:
+        [
+          `S Manpage.s_description;
+          `P
+            "Extract the history of a subdirectory into a standalone commit \
+             chain. Each commit that touches the prefix is rewritten so the \
+             subtree becomes the root tree, preserving author, committer, and \
+             message.";
+          `P
+            "This is a fast, native replacement for $(b,git subtree split), \
+             avoiding the per-commit subprocess overhead of the shell script.";
+          `P
+            "A persistent cache is stored in $(b,.git/subtree-cache/<prefix>). \
+             Subsequent runs only process new commits, making incremental \
+             splits near-instantaneous.";
+          `S Manpage.s_examples;
+          `P "Split the $(b,ocaml-git) subdirectory:";
+          `Pre "  $(tname) ocaml-git";
+          `P "Split from a specific branch:";
+          `Pre "  $(tname) --rev feature-branch ocaml-git";
+          `P "Use in a push workflow (equivalent to $(b,git subtree push)):";
+          `Pre "  git push <remote> \\$(git-mono split lib):refs/heads/main";
+          `S "COMPLEXITY";
+          `P
+            "Let $(i,n) be the number of commits, $(i,d) the prefix depth, and \
+             $(i,k) the max parents per commit.";
+          `P
+            "First run: O($(i,n) x ($(i,d) + $(i,k))). Cached run: O(1). \
+             Incremental ($(i,m) new commits): O($(i,m) x ($(i,d) + $(i,k))).";
+        ]
+  in
+  Cmd.v info split_term
+
+(** {1 Main command} *)
+
+let main_cmd =
+  let info =
+    Cmd.info "git-mono" ~version:Monopam_info.version
+      ~doc:"Fast git operations for monorepos"
+      ~man:
+        [
+          `S Manpage.s_description;
+          `P
+            "$(iname) provides fast, native implementations of git operations \
+             commonly used in monorepo workflows. It reads git objects \
+             directly, bypassing the overhead of subprocess spawning.";
+          `S "SEE ALSO";
+          `P "$(b,git-subtree)(1), $(b,monopam)(1)";
+        ]
+  in
+  Cmd.group info [ split_cmd; verify_cmd; check_cmd; fix_cmd ]
+
+let () = exit (Cmd.eval main_cmd)

dune-project

···
+(lang dune 3.21)
+(name git)
+(version 4.0.0)
+(formatting (enabled_for ocaml))
+
+(generate_opam_files true)
+
+(license ISC)
+(maintainers "Thomas Gazagnaire <[e-mail]>")
+(authors
+  "Thomas Gazagnaire <[e-mail]>"
+  "Romain Calascibetta <[e-mail]>")
+(source (tangled gazagnaire.org/ocaml-git))
+(documentation https://mirage.github.io/ocaml-git/)
+
+(package
+ (name git)
+ (synopsis "Git format in pure OCaml")
+ (description "
+Pure OCaml implementation of Git object formats: blobs, trees, commits,
+tags, and references. Provides type-safe encoding and decoding of all
+Git objects.
+
+This is a simplified rewrite derived from mirage/ocaml-git and
+robur-coop/carton, with minimal dependencies.")
+ (depends
+  (ocaml (>= 5.1.0))
+  (bytesrw (>= 0.1.0))
+  conf-zlib
+  (digestif (>= 1.2.0))
+  (eio (>= 1.0))
+  (eio_posix (>= 1.0))
+  (fmt (>= 0.9.0))
+  (fpath (>= 0.7.0))
+  (cmdliner (>= 1.3.0))
+  (logs (>= 0.7.0))
+  (vlog (>= 0.1))
+  (tty (>= 0.1))
+  (memtrace (>= 0.2))
+  monopam-info
+  (ptime (>= 1.0.0))
+  (requests (>= 0.1.0))
+  (uri (>= 4.0.0))
+  (alcotest (and :with-test (>= 1.7.0)))))

fuzz/dune

···
+(executable
+ (name fuzz)
+ (modules fuzz fuzz_index fuzz_config fuzz_tree)
+ (libraries git crowbar))
+
+(executable
+ (name gen_corpus)
+ (modules gen_corpus)
+ (libraries unix))
+
+(rule
+ (alias runtest)
+ (enabled_if (<> %{profile} afl))
+ (deps fuzz.exe)
+ (action
+  (run %{exe:fuzz.exe})))
+
+(rule
+ (alias fuzz)
+ (enabled_if
+  (= %{profile} afl))
+ (deps
+  (source_tree corpus)
+  fuzz.exe
+  gen_corpus.exe)
+ (action
+  (echo "AFL fuzzer built: %{exe:fuzz.exe}\n")))

fuzz/fuzz.ml

···
+let () =
+  Crowbar.run "git" [ Fuzz_config.suite; Fuzz_index.suite; Fuzz_tree.suite ]

fuzz/fuzz_config.ml

···
+(** Fuzz tests for Git config parsing. *)
+
+open Crowbar
+
+let truncate ?(max_len = 4096) buf =
+  if String.length buf > max_len then String.sub buf 0 max_len else buf
+
+(** Parse - must not crash on arbitrary input. *)
+let test_parse_crash_safety buf =
+  let buf = truncate buf in
+  let _ = Git.Config.of_string buf in
+  ()
+
+(** Roundtrip - parsed config must serialize and re-parse. *)
+let test_roundtrip buf =
+  let buf = truncate buf in
+  let config = Git.Config.of_string buf in
+  let serialized = Git.Config.to_string config in
+  let reparsed = Git.Config.of_string serialized in
+  let orig_sections = Git.Config.all_sections config in
+  let reparsed_sections = Git.Config.all_sections reparsed in
+  if List.length orig_sections <> List.length reparsed_sections then
+    fail "section count mismatch after roundtrip"
+
+(** Set/get consistency - value must be retrievable after set. *)
+let test_set_get sec_buf key_buf value_buf =
+  (* Sanitize section name to be valid *)
+  let sec_name = truncate ~max_len:32 sec_buf in
+  let sec_name =
+    String.map
+      (fun c ->
+        if (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') then c else 'x')
+      sec_name
+  in
+  let sec_name = if String.length sec_name = 0 then "core" else sec_name in
+  (* Sanitize key name *)
+  let key = truncate ~max_len:32 key_buf in
+  let key =
+    String.map
+      (fun c ->
+        if
+          (c >= 'a' && c <= 'z')
+          || (c >= 'A' && c <= 'Z')
+          || (c >= '0' && c <= '9')
+        then c
+        else 'x')
+      key
+  in
+  let key = if String.length key = 0 then "key" else key in
+  (* Sanitize value (no newlines) *)
+  let value = truncate ~max_len:256 value_buf in
+  let value = String.map (fun c -> if c = '\n' then ' ' else c) value in
+  let section = Git.Config.section sec_name in
+  let config = Git.Config.set Git.Config.empty ~section ~key ~value in
+  match Git.Config.find config section key with
+  | None -> fail "key not found after set"
+  | Some v ->
+      let v = String.trim v in
+      let value = String.trim value in
+      if v <> value then failf "value mismatch: got '%s', expected '%s'" v value
+
+(** Unset - value must not be retrievable after unset. *)
+let test_unset sec_buf key_buf =
+  let sec_name = truncate ~max_len:32 sec_buf in
+  let sec_name =
+    String.map
+      (fun c ->
+        if (c >= 'a' && c <= 'z') || (c >= '0' && c <= '9') then c else 'x')
+      sec_name
+  in
+  let sec_name = if String.length sec_name = 0 then "core" else sec_name in
+  let key = truncate ~max_len:32 key_buf in
+  let key = String.map (fun c -> if c >= 'a' && c <= 'z' then c else 'x') key in
+  let key = if String.length key = 0 then "key" else key in
+  let section = Git.Config.section sec_name in
+  let config = Git.Config.set Git.Config.empty ~section ~key ~value:"test" in
+  let config = Git.Config.unset config ~section ~key in
+  if Option.is_some (Git.Config.find config section key) then
+    fail "key still present after unset"
+
+(** Boolean parsing - true/false/yes/no/on/off/1/0 all work. *)
+let test_bool_values n =
+  let values = [| "true"; "false"; "yes"; "no"; "on"; "off"; "1"; "0" |] in
+  let expected = [| true; false; true; false; true; false; true; false |] in
+  let idx = n mod 8 in
+  let value = values.(idx) in
+  let section = Git.Config.section "test" in
+  let config = Git.Config.set Git.Config.empty ~section ~key:"flag" ~value in
+  match Git.Config.bool config section "flag" with
+  | None -> fail "failed to parse boolean"
+  | Some parsed ->
+      if parsed <> expected.(idx) then
+        failf "boolean mismatch for '%s': got %b, expected %b" value parsed
+          expected.(idx)
+
+(** Integer parsing - valid integers parse correctly. *)
+let test_int_values n =
+  let section = Git.Config.section "test" in
+  let value = string_of_int n in
+  let config = Git.Config.set Git.Config.empty ~section ~key:"count" ~value in
+  match Git.Config.int config section "count" with
+  | None -> fail "failed to parse integer"
+  | Some parsed ->
+      if parsed <> n then failf "integer mismatch: got %d, expected %d" parsed n
+
+(** Add supports multi-valued keys. *)
+let test_multivalue n =
+  let section = Git.Config.section "test" in
+  let count = (n mod 5) + 1 in
+  let config =
+    List.fold_left
+      (fun cfg i ->
+        Git.Config.add cfg ~section ~key:"item" ~value:(string_of_int i))
+      Git.Config.empty (List.init count Fun.id)
+  in
+  let all = Git.Config.all config section "item" in
+  if List.length all <> count then
+    failf "multivalue count mismatch: got %d, expected %d" (List.length all)
+      count
+
+(** Section with subsection. *)
+let test_subsection name_buf sub_buf =
+  let name = truncate ~max_len:32 name_buf in
+  let name =
+    String.map (fun c -> if c >= 'a' && c <= 'z' then c else 'x') name
+  in
+  let name = if String.length name = 0 then "remote" else name in
+  let sub = truncate ~max_len:32 sub_buf in
+  let sub =
+    String.map (fun c -> if c = '"' || c = '\\' || c = '\n' then '_' else c) sub
+  in
+  let sub = if String.length sub = 0 then "origin" else sub in
+  let section = Git.Config.section_sub name sub in
+  let config =
+    Git.Config.set Git.Config.empty ~section ~key:"url"
+      ~value:"https://example.com"
+  in
+  match Git.Config.find config section "url" with
+  | None -> fail "key not found in subsection"
+  | Some v ->
+      if v <> "https://example.com" then fail "value mismatch in subsection"
+
+(** Get remotes from config. *)
+let test_get_remotes () =
+  let config_content =
+    {|[remote "origin"]
+	url = https://github.com/user/repo.git
+[remote "upstream"]
+	url = https://github.com/other/repo.git
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let remotes = Git.Config.remotes config in
+  if List.length remotes <> 2 then
+    failf "expected 2 remotes, got %d" (List.length remotes)
+
+(** Get branches from config. *)
+let test_get_branches () =
+  let config_content =
+    {|[branch "main"]
+	remote = origin
+	merge = refs/heads/main
+[branch "feature"]
+	remote = upstream
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let branches = Git.Config.branches config in
+  if List.length branches <> 2 then
+    failf "expected 2 branches, got %d" (List.length branches)
+
+let suite =
+  ( "config",
+    [
+      test_case "parse crash safety" [ bytes ] test_parse_crash_safety;
+      test_case "roundtrip" [ bytes ] test_roundtrip;
+      test_case "set/get" [ bytes; bytes; bytes ] test_set_get;
+      test_case "unset" [ bytes; bytes ] test_unset;
+      test_case "bool values" [ uint8 ] test_bool_values;
+      test_case "int values" [ int ] test_int_values;
+      test_case "multivalue" [ uint8 ] test_multivalue;
+      test_case "subsection" [ bytes; bytes ] test_subsection;
+      test_case "get_remotes" [ const () ] test_get_remotes;
+      test_case "get_branches" [ const () ] test_get_branches;
+    ] )

fuzz/fuzz_config.mli

···
+(** Fuzz tests for {\!Config}. *)
+
+val suite : string * Crowbar.test_case list
+(** Test suite. *)

fuzz/fuzz_index.ml

···
+(** Fuzz tests for Git index parsing. *)
+
+open Crowbar
+
+let truncate ?(max_len = 4096) buf =
+  if String.length buf > max_len then String.sub buf 0 max_len else buf
+
+(** Parse - must not crash on arbitrary input. *)
+let test_parse_crash_safety buf =
+  let buf = truncate buf in
+  let _ = Git.Index.of_string buf in
+  ()
+
+(** Roundtrip - valid values must round-trip. *)
+let test_roundtrip buf =
+  let buf = truncate buf in
+  match Git.Index.of_string buf with
+  | Error _ -> () (* Invalid input is fine *)
+  | Ok original -> (
+      let encoded = Git.Index.to_string original in
+      match Git.Index.of_string encoded with
+      | Error _ -> fail "re-parse failed after serialization"
+      | Ok decoded ->
+          let orig_entries = Git.Index.entries original in
+          let decoded_entries = Git.Index.entries decoded in
+          if List.length orig_entries <> List.length decoded_entries then
+            fail "entry count mismatch after roundtrip")
+
+(** Add/find consistency - entry must be findable after add. *)
+let test_add_find name_buf hash_buf =
+  let name = truncate ~max_len:256 name_buf in
+  let name =
+    if String.length name = 0 then "file.txt"
+    else String.map (fun c -> if c = '\x00' || c = '/' then '_' else c) name
+  in
+  let hash_buf =
+    if String.length hash_buf < 20 then
+      hash_buf ^ String.make (20 - String.length hash_buf) '\x00'
+    else String.sub hash_buf 0 20
+  in
+  let hash = Git.Hash.of_raw_string hash_buf in
+  let entry : Git.Index.entry =
+    {
+      ctime_s = 0l;
+      ctime_ns = 0l;
+      mtime_s = 0l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Regular;
+      uid = 0l;
+      gid = 0l;
+      size = 0l;
+      hash;
+      flags = 0;
+      name;
+    }
+  in
+  let idx = Git.Index.add Git.Index.empty entry in
+  match Git.Index.find idx name with
+  | None -> fail "entry not found after add"
+  | Some found -> if found.name <> name then fail "name mismatch after find"
+
+(** Remove - entry must not be findable after remove. *)
+let test_remove name_buf =
+  let name = truncate ~max_len:256 name_buf in
+  let name =
+    if String.length name = 0 then "file.txt"
+    else String.map (fun c -> if c = '\x00' || c = '/' then '_' else c) name
+  in
+  let hash = Git.Hash.of_raw_string (String.make 20 '\x00') in
+  let entry : Git.Index.entry =
+    {
+      ctime_s = 0l;
+      ctime_ns = 0l;
+      mtime_s = 0l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Regular;
+      uid = 0l;
+      gid = 0l;
+      size = 0l;
+      hash;
+      flags = 0;
+      name;
+    }
+  in
+  let idx = Git.Index.add Git.Index.empty entry in
+  let idx = Git.Index.remove idx name in
+  if Git.Index.mem idx name then fail "entry still present after remove"
+
+(** Entries are sorted by path. *)
+let test_sorted n =
+  let make_entry name =
+    let hash = Git.Hash.of_raw_string (String.make 20 '\x00') in
+    ({
+       ctime_s = 0l;
+       ctime_ns = 0l;
+       mtime_s = 0l;
+       mtime_ns = 0l;
+       dev = 0l;
+       ino = 0l;
+       mode = Git.Index.Regular;
+       uid = 0l;
+       gid = 0l;
+       size = 0l;
+       hash;
+       flags = 0;
+       name;
+     }
+      : Git.Index.entry)
+  in
+  let names =
+    List.init ((n mod 10) + 1) (fun i -> Fmt.str "file%03d.txt" (9 - i))
+  in
+  let idx =
+    List.fold_left
+      (fun idx name -> Git.Index.add idx (make_entry name))
+      Git.Index.empty names
+  in
+  let result_names =
+    List.map (fun (e : Git.Index.entry) -> e.name) (Git.Index.entries idx)
+  in
+  let sorted_names = List.sort String.compare result_names in
+  if result_names <> sorted_names then fail "entries not sorted"
+
+(** Clear removes all entries. *)
+let test_clear () =
+  let hash = Git.Hash.of_raw_string (String.make 20 '\x00') in
+  let entry : Git.Index.entry =
+    {
+      ctime_s = 0l;
+      ctime_ns = 0l;
+      mtime_s = 0l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Regular;
+      uid = 0l;
+      gid = 0l;
+      size = 0l;
+      hash;
+      flags = 0;
+      name = "test.txt";
+    }
+  in
+  let idx = Git.Index.add Git.Index.empty entry in
+  let idx = Git.Index.clear idx in
+  if List.length (Git.Index.entries idx) <> 0 then
+    fail "clear didn't remove entries"
+
+let suite =
+  ( "index",
+    [
+      test_case "parse crash safety" [ bytes ] test_parse_crash_safety;
+      test_case "roundtrip" [ bytes ] test_roundtrip;
+      test_case "add/find" [ bytes; bytes ] test_add_find;
+      test_case "remove" [ bytes ] test_remove;
+      test_case "sorted" [ uint8 ] test_sorted;
+      test_case "clear" [ const () ] test_clear;
+    ] )

fuzz/fuzz_index.mli

···
+(** Fuzz tests for {\!Index}. *)
+
+val suite : string * Crowbar.test_case list
+(** Test suite. *)

fuzz/fuzz_tree.ml

···
+(** Fuzz tests for Git tree operations.
+
+    Uses a model-based approach: a [Map.Make(String)] acts as the reference
+    implementation. A random sequence of [Add] and [Remove] operations is
+    applied to both the real [Git.Tree.t] and the model; invariants are checked
+    after every step. *)
+
+open Crowbar
+
+(* A small name pool maximises repeated-name collisions, exercising the
+   deduplication path that was missing before the [add] fix. *)
+let small_names = [| "a"; "b"; "c"; "d"; "e"; "ab"; "foo"; "bar" |]
+
+let sanitize_name s =
+  if String.length s = 0 then "x"
+  else
+    let s = String.sub s 0 (min 32 (String.length s)) in
+    String.map (fun c -> if Char.code c = 0 then 'x' else c) s
+
+let gen_name =
+  choose
+    [
+      map [ uint8 ] (fun i -> small_names.(i mod Array.length small_names));
+      map [ bytes ] (fun s -> sanitize_name s);
+    ]
+
+let gen_hash =
+  map [ bytes ] (fun s ->
+      let len = String.length s in
+      let raw =
+        if len >= 20 then String.sub s 0 20
+        else s ^ String.make (20 - len) '\x00'
+      in
+      Git.Hash.of_raw_string raw)
+
+type op = Add of string * Git.Hash.t | Remove of string
+
+let gen_op =
+  choose
+    [
+      map [ gen_name; gen_hash ] (fun name hash -> Add (name, hash));
+      map [ gen_name ] (fun name -> Remove name);
+    ]
+
+(* Reference model *)
+module Ref = Map.Make (String)
+
+let apply_op_ref ref = function
+  | Add (name, hash) -> Ref.add name hash ref
+  | Remove name -> Ref.remove name ref
+
+let apply_op_tree tree = function
+  | Add (name, hash) ->
+      Git.Tree.add (Git.Tree.entry ~perm:`Normal ~name hash) tree
+  | Remove name -> Git.Tree.remove ~name tree
+
+let check_invariants tree ref_map =
+  let entries = Git.Tree.to_list tree in
+  let names = List.map (fun (e : Git.Tree.entry) -> e.name) entries in
+  (* No duplicate names *)
+  let unique = List.sort_uniq String.compare names in
+  if List.length names <> List.length unique then
+    fail "duplicate names in to_list";
+  (* Names are sorted *)
+  if names <> List.sort String.compare names then fail "entries not sorted";
+  (* Size matches model *)
+  if List.length entries <> Ref.cardinal ref_map then
+    fail
+      (Fmt.str "size mismatch: tree=%d model=%d" (List.length entries)
+         (Ref.cardinal ref_map));
+  (* Every tree entry agrees with model *)
+  List.iter
+    (fun (e : Git.Tree.entry) ->
+      match Ref.find_opt e.name ref_map with
+      | None -> fail (Fmt.str "entry %S in tree but absent from model" e.name)
+      | Some h ->
+          if not (Git.Hash.equal e.hash h) then
+            fail (Fmt.str "hash mismatch for entry %S" e.name))
+    entries
+
+(** Apply ops to tree and model simultaneously, checking invariants at each
+    step. *)
+let test_ops_agree ops =
+  ignore
+    (List.fold_left
+       (fun (tree, ref_map) op ->
+         let tree = apply_op_tree tree op in
+         let ref_map = apply_op_ref ref_map op in
+         check_invariants tree ref_map;
+         (tree, ref_map))
+       (Git.Tree.empty, Ref.empty)
+       ops)
+
+(** After any sequence of ops, the tree must round-trip through the git binary
+    format with the same entry count. *)
+let test_roundtrip_after_ops ops =
+  let tree = List.fold_left apply_op_tree Git.Tree.empty ops in
+  let s = Git.Tree.to_string tree in
+  match Git.Tree.of_string s with
+  | Error (`Msg m) -> fail (Fmt.str "roundtrip parse failed: %s" m)
+  | Ok tree' ->
+      let n = List.length (Git.Tree.to_list tree) in
+      let n' = List.length (Git.Tree.to_list tree') in
+      if n <> n' then
+        fail (Fmt.str "roundtrip entry count: before=%d after=%d" n n')
+
+let suite =
+  ( "tree",
+    [
+      test_case "ops agree with model" [ list gen_op ] test_ops_agree;
+      test_case "roundtrip after ops" [ list gen_op ] test_roundtrip_after_ops;
+    ] )

fuzz/gen_corpus.ml

···
+(** Generate seed corpus for fuzz testing. *)
+
+let () =
+  (try Unix.mkdir "corpus" 0o755
+   with Unix.Unix_error (Unix.EEXIST, _, _) -> ());
+  let write name data =
+    let oc = open_out_bin (Filename.concat "corpus" name) in
+    output_string oc data;
+    close_out oc
+  in
+  write "seed_000" "";
+  write "seed_001" "\x00\x00\x00\x00";
+  write "seed_002" "DIRC\x00\x00\x00\x02";
+  write "seed_003" "[core]\n\tbare = false\n";
+  write "seed_004" "blob 5\x00hello";
+  write "seed_005" (String.make 20 '\xab');
+  write "seed_006" "tree 0\x00"

git.opam

···
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+version: "4.0.0"
+synopsis: "Git format in pure OCaml"
+description: """
+
+Pure OCaml implementation of Git object formats: blobs, trees, commits,
+tags, and references. Provides type-safe encoding and decoding of all
+Git objects.
+
+This is a simplified rewrite derived from mirage/ocaml-git and
+robur-coop/carton, with minimal dependencies."""
+maintainer: ["Thomas Gazagnaire <[e-mail]>"]
+authors: [
+  "Thomas Gazagnaire <[e-mail]>"
+  "Romain Calascibetta <[e-mail]>"
+]
+license: "ISC"
+homepage: "https://tangled.org/gazagnaire.org/ocaml-git"
+doc: "https://mirage.github.io/ocaml-git/"
+bug-reports: "https://tangled.org/gazagnaire.org/ocaml-git/issues"
+depends: [
+  "dune" {>= "3.21"}
+  "ocaml" {>= "5.1.0"}
+  "bytesrw" {>= "0.1.0"}
+  "conf-zlib"
+  "digestif" {>= "1.2.0"}
+  "eio" {>= "1.0"}
+  "eio_posix" {>= "1.0"}
+  "fmt" {>= "0.9.0"}
+  "fpath" {>= "0.7.0"}
+  "cmdliner" {>= "1.3.0"}
+  "logs" {>= "0.7.0"}
+  "vlog" {>= "0.1"}
+  "tty" {>= "0.1"}
+  "memtrace" {>= "0.2"}
+  "monopam-info"
+  "ptime" {>= "1.0.0"}
+  "requests" {>= "0.1.0"}
+  "uri" {>= "4.0.0"}
+  "alcotest" {with-test & >= "1.7.0"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://tangled.org/gazagnaire.org/ocaml-git"
+x-maintenance-intent: ["(latest)"]

lib/blob.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git blob objects (file contents). *)
+
+type t = string
+
+let of_string s = s
+let to_string t = t
+let length t = String.length t
+let pp ppf t = Fmt.string ppf t
+let equal = String.equal
+let compare = String.compare
+let hash = Hashtbl.hash
+let digest t = Hash.digest_string ~kind:`Blob t
+
+module Set = Set.Make (String)
+module Map = Map.Make (String)

lib/blob.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git blob objects (file contents). *)
+
+type t
+(** The type of blobs. *)
+
+val of_string : string -> t
+(** Create a blob from a string. *)
+
+val to_string : t -> string
+(** Get the blob contents as a string. *)
+
+val length : t -> int
+(** The length of the blob in bytes. *)
+
+val pp : t Fmt.t
+(** Pretty-print a blob. *)
+
+val equal : t -> t -> bool
+(** Equality on blobs. *)
+
+val compare : t -> t -> int
+(** Total ordering on blobs. *)
+
+val hash : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val digest : t -> Hash.t
+(** Compute the git hash of a blob. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/commit.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git commit objects. *)
+
+type t = {
+  tree : Hash.t;
+  parents : Hash.t list;
+  author : User.t;
+  committer : User.t;
+  extra : (string * string list) list;
+  message : string option;
+}
+
+let v ~tree ~author ~committer ?(parents = []) ?(extra = []) message =
+  { tree; parents; author; committer; extra; message }
+
+let tree t = t.tree
+let parents t = t.parents
+let author t = t.author
+let committer t = t.committer
+let message t = t.message
+let extra t = t.extra
+
+let pp ppf t =
+  Fmt.pf ppf "@[<v>tree %a@," Hash.pp t.tree;
+  List.iter (fun p -> Fmt.pf ppf "parent %a@," Hash.pp p) t.parents;
+  Fmt.pf ppf "author %a@," User.pp t.author;
+  Fmt.pf ppf "committer %a@," User.pp t.committer;
+  List.iter
+    (fun (k, vs) -> List.iter (fun v -> Fmt.pf ppf "%s %s@," k v) vs)
+    t.extra;
+  (match t.message with Some msg -> Fmt.pf ppf "@,%s" msg | None -> ());
+  Fmt.pf ppf "@]"
+
+let equal a b =
+  Hash.equal a.tree b.tree
+  && List.equal Hash.equal a.parents b.parents
+  && User.equal a.author b.author
+  && User.equal a.committer b.committer
+
+let compare a b =
+  match Hash.compare a.tree b.tree with
+  | 0 -> (
+      match List.compare Hash.compare a.parents b.parents with
+      | 0 -> User.compare a.author b.author
+      | n -> n)
+  | n -> n
+
+let hash t = Hashtbl.hash t
+
+let compare_by_date a b =
+  Int64.compare (User.date a.author) (User.date b.author)
+
+(** Encode commit to git format. *)
+let to_string t =
+  let buf = Buffer.create 512 in
+  Buffer.add_string buf "tree ";
+  Buffer.add_string buf (Hash.to_hex t.tree);
+  Buffer.add_char buf '\n';
+  List.iter
+    (fun p ->
+      Buffer.add_string buf "parent ";
+      Buffer.add_string buf (Hash.to_hex p);
+      Buffer.add_char buf '\n')
+    t.parents;
+  Buffer.add_string buf "author ";
+  Buffer.add_string buf (User.to_string t.author);
+  Buffer.add_char buf '\n';
+  Buffer.add_string buf "committer ";
+  Buffer.add_string buf (User.to_string t.committer);
+  Buffer.add_char buf '\n';
+  List.iter
+    (fun (key, values) ->
+      List.iter
+        (fun value ->
+          Buffer.add_string buf key;
+          Buffer.add_char buf ' ';
+          Buffer.add_string buf value;
+          Buffer.add_char buf '\n')
+        values)
+    t.extra;
+  (match t.message with
+  | Some msg ->
+      Buffer.add_char buf '\n';
+      Buffer.add_string buf msg
+  | None -> ());
+  Buffer.contents buf
+
+(** Parse a single header line. *)
+let parse_header line =
+  match String.index_opt line ' ' with
+  | None -> None
+  | Some pos ->
+      let key = String.sub line 0 pos in
+      let value = String.sub line (pos + 1) (String.length line - pos - 1) in
+      Some (key, value)
+
+(** Parse commit from git format. *)
+let of_string s =
+  let lines = String.split_on_char '\n' s in
+  let rec parse_headers acc tree parents author committer extra = function
+    | [] -> Error (`Msg "Unexpected end of commit")
+    | "" :: rest -> (
+        (* Empty line marks start of message *)
+        let message =
+          match rest with [] -> None | _ -> Some (String.concat "\n" rest)
+        in
+        match (tree, author, committer) with
+        | Some tree, Some author, Some committer ->
+            Ok
+              {
+                tree;
+                parents = List.rev parents;
+                author;
+                committer;
+                extra = List.rev extra;
+                message;
+              }
+        | None, _, _ -> Error (`Msg "Missing tree in commit")
+        | _, None, _ -> Error (`Msg "Missing author in commit")
+        | _, _, None -> Error (`Msg "Missing committer in commit"))
+    | line :: rest -> (
+        match parse_header line with
+        | None -> Error (`Msg ("Invalid header line: " ^ line))
+        | Some ("tree", hex) ->
+            let tree = Hash.of_hex hex in
+            parse_headers acc (Some tree) parents author committer extra rest
+        | Some ("parent", hex) ->
+            let parent = Hash.of_hex hex in
+            parse_headers acc tree (parent :: parents) author committer extra
+              rest
+        | Some ("author", user_str) -> (
+            match User.of_string user_str with
+            | Ok user ->
+                parse_headers acc tree parents (Some user) committer extra rest
+            | Error _ as e -> e)
+        | Some ("committer", user_str) -> (
+            match User.of_string user_str with
+            | Ok user ->
+                parse_headers acc tree parents author (Some user) extra rest
+            | Error _ as e -> e)
+        | Some (key, value) ->
+            (* Handle extra headers like gpgsig *)
+            let extra =
+              match List.assoc_opt key extra with
+              | Some values ->
+                  (key, values @ [ value ]) :: List.remove_assoc key extra
+              | None -> (key, [ value ]) :: extra
+            in
+            parse_headers acc tree parents author committer extra rest)
+  in
+  parse_headers [] None [] None None [] lines
+
+let of_string_exn s =
+  match of_string s with Ok t -> t | Error (`Msg m) -> failwith m
+
+(** {1 Reader-based parsing}
+
+    Parse directly from a {!Bytesrw.Bytes.Reader.t} without materialising the
+    full object into a string. The reader must be positioned at the start of the
+    commit body (after the loose-object header, if any). *)
+
+module Reader = Bytesrw.Bytes.Reader
+module Slice = Bytesrw.Bytes.Slice
+
+(** Read until [delim] from a reader. Returns the bytes before the delimiter;
+    the delimiter is consumed. *)
+let read_until reader delim =
+  let buf = Buffer.create 128 in
+  let rec loop () =
+    match Reader.read reader with
+    | slice when Slice.is_eod slice ->
+        if Buffer.length buf = 0 then None else Some (Buffer.contents buf)
+    | slice ->
+        let bytes = Slice.bytes slice in
+        let first = Slice.first slice in
+        let len = Slice.length slice in
+        let rec scan i =
+          if i >= first + len then begin
+            Buffer.add_subbytes buf bytes first len;
+            loop ()
+          end
+          else if Char.code delim = Bytes.get_uint8 bytes i then begin
+            Buffer.add_subbytes buf bytes first (i - first);
+            (* Push back the remaining bytes after the delimiter *)
+            let rest_off = i + 1 in
+            let rest_len = first + len - rest_off in
+            if rest_len > 0 then
+              Reader.push_back reader
+                (Slice.make bytes ~first:rest_off ~length:rest_len);
+            Some (Buffer.contents buf)
+          end
+          else scan (i + 1)
+        in
+        scan first
+  in
+  loop ()
+
+(** Read all remaining bytes from a reader. *)
+let read_rest reader =
+  let buf = Buffer.create 256 in
+  Reader.add_to_buffer buf reader;
+  if Buffer.length buf = 0 then None else Some (Buffer.contents buf)
+
+let of_reader reader =
+  let rec parse_headers tree parents author committer extra =
+    match read_until reader '\n' with
+    | None -> Error (`Msg "Unexpected end of commit")
+    | Some "" -> (
+        (* Empty line marks start of message *)
+        let message = read_rest reader in
+        match (tree, author, committer) with
+        | Some tree, Some author, Some committer ->
+            Ok
+              {
+                tree;
+                parents = List.rev parents;
+                author;
+                committer;
+                extra = List.rev extra;
+                message;
+              }
+        | None, _, _ -> Error (`Msg "Missing tree in commit")
+        | _, None, _ -> Error (`Msg "Missing author in commit")
+        | _, _, None -> Error (`Msg "Missing committer in commit"))
+    | Some line -> (
+        match parse_header line with
+        | None -> Error (`Msg ("Invalid header line: " ^ line))
+        | Some ("tree", hex) ->
+            let tree = Hash.of_hex hex in
+            parse_headers (Some tree) parents author committer extra
+        | Some ("parent", hex) ->
+            let parent = Hash.of_hex hex in
+            parse_headers tree (parent :: parents) author committer extra
+        | Some ("author", user_str) -> (
+            match User.of_string user_str with
+            | Ok user -> parse_headers tree parents (Some user) committer extra
+            | Error _ as e -> e)
+        | Some ("committer", user_str) -> (
+            match User.of_string user_str with
+            | Ok user -> parse_headers tree parents author (Some user) extra
+            | Error _ as e -> e)
+        | Some (key, value) ->
+            let extra =
+              match List.assoc_opt key extra with
+              | Some values ->
+                  (key, values @ [ value ]) :: List.remove_assoc key extra
+              | None -> (key, [ value ]) :: extra
+            in
+            parse_headers tree parents author committer extra)
+  in
+  parse_headers None [] None None []
+
+let digest t =
+  let s = to_string t in
+  Hash.digest_string ~kind:`Commit s
+
+module Set = Set.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)
+
+module Map = Map.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)

lib/commit.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git commit objects. *)
+
+type t
+(** The type of commits. *)
+
+val v :
+  tree:Hash.t ->
+  author:User.t ->
+  committer:User.t ->
+  ?parents:Hash.t list ->
+  ?extra:(string * string list) list ->
+  string option ->
+  t
+(** Create a commit. *)
+
+val tree : t -> Hash.t
+(** The tree hash. *)
+
+val parents : t -> Hash.t list
+(** The parent commit hashes. *)
+
+val author : t -> User.t
+(** The author. *)
+
+val committer : t -> User.t
+(** The committer. *)
+
+val message : t -> string option
+(** The commit message. *)
+
+val extra : t -> (string * string list) list
+(** Extra headers (e.g., gpgsig). *)
+
+val pp : t Fmt.t
+(** Pretty-print a commit. *)
+
+val equal : t -> t -> bool
+(** Equality on commits. *)
+
+val compare : t -> t -> int
+(** Total ordering on commits. *)
+
+val compare_by_date : t -> t -> int
+(** Compare commits by author date. *)
+
+val hash : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val to_string : t -> string
+(** Encode to git format. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse from git format. *)
+
+val of_string_exn : string -> t
+(** [of_string_exn s] is like {!of_string} but raises on error. *)
+
+val of_reader : Bytesrw.Bytes.Reader.t -> (t, [ `Msg of string ]) result
+(** Parse a commit directly from a {!Bytesrw.Bytes.Reader.t} without
+    materialising the full object into a string. The reader must be positioned
+    at the start of the commit body (after the loose-object header, if any). *)
+
+val digest : t -> Hash.t
+(** Compute the git hash of a commit. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/config.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2025 Anil Madhavapeddy <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Declarative git config file parser.
+
+    Provides typed access to git config files (.git/config) using a declarative
+    codec approach. Define expected sections and keys with types, then decode
+    configs into OCaml records. *)
+
+(** {1 Value Codecs}
+
+    Codecs define how to decode/encode individual config values. *)
+
+type 'a codec = {
+  decode : string -> 'a option;
+  encode : 'a -> string;
+  kind : string;
+}
+
+let string_codec = { decode = Option.some; encode = Fun.id; kind = "string" }
+
+let int_codec =
+  { decode = int_of_string_opt; encode = string_of_int; kind = "integer" }
+
+let bool_codec =
+  let decode s =
+    match String.lowercase_ascii s with
+    | "true" | "yes" | "on" | "1" -> Some true
+    | "false" | "no" | "off" | "0" | "" -> Some false
+    | _ -> None
+  in
+  let encode b = if b then "true" else "false" in
+  { decode; encode; kind = "boolean" }
+
+(** {1 Low-Level Representation}
+
+    Internal representation of parsed config files. *)
+
+type section = { name : string; subsection : string option }
+type entry = { section : section; key : string; value : string }
+type t = entry list
+
+let pp ppf t =
+  let pp_entry ppf e =
+    match e.section.subsection with
+    | None -> Fmt.pf ppf "%s.%s=%s" e.section.name e.key e.value
+    | Some sub -> Fmt.pf ppf "%s.%s.%s=%s" e.section.name sub e.key e.value
+  in
+  Fmt.pf ppf "@[<v>%a@]" Fmt.(list ~sep:cut pp_entry) t
+
+(** {1 String Utilities} *)
+
+let lstrip s =
+  let len = String.length s in
+  let rec find_start i =
+    if i >= len then len
+    else match s.[i] with ' ' | '\t' -> find_start (i + 1) | _ -> i
+  in
+  let start = find_start 0 in
+  if start = 0 then s else String.sub s start (len - start)
+
+let rstrip s =
+  let rec find_end i =
+    if i < 0 then -1
+    else
+      match s.[i] with ' ' | '\t' | '\r' | '\n' -> find_end (i - 1) | _ -> i
+  in
+  let end_pos = find_end (String.length s - 1) in
+  if end_pos = String.length s - 1 then s else String.sub s 0 (end_pos + 1)
+
+let strip s = lstrip (rstrip s)
+let lowercase = String.lowercase_ascii
+
+(** {1 Parsing} *)
+
+(** Unescape a string, handling backslash escape sequences. *)
+let unescape_string s =
+  let buf = Buffer.create (String.length s) in
+  let rec loop i =
+    if i >= String.length s then Buffer.contents buf
+    else if s.[i] = '\\' && i + 1 < String.length s then begin
+      (match s.[i + 1] with
+      | '\\' -> Buffer.add_char buf '\\'
+      | '"' -> Buffer.add_char buf '"'
+      | 'n' -> Buffer.add_char buf '\n'
+      | 't' -> Buffer.add_char buf '\t'
+      | c ->
+          Buffer.add_char buf '\\';
+          Buffer.add_char buf c);
+      loop (i + 2)
+    end
+    else begin
+      Buffer.add_char buf s.[i];
+      loop (i + 1)
+    end
+  in
+  loop 0
+
+(** Find closing quote, skipping escaped quotes. Returns position or None. *)
+let closing_quote s =
+  let rec find i =
+    if i >= String.length s then None
+    else if s.[i] = '"' then Some i
+    else if s.[i] = '\\' && i + 1 < String.length s then find (i + 2)
+    else find (i + 1)
+  in
+  find 0
+
+let parse_section_header line =
+  let trimmed = strip line in
+  let len = String.length trimmed in
+  if len < 2 || trimmed.[0] <> '[' || trimmed.[len - 1] <> ']' then None
+  else
+    let content = String.sub trimmed 1 (len - 2) in
+    match String.index_opt content '"' with
+    | None ->
+        let name = strip content in
+        if String.length name = 0 then None
+        else Some { name = lowercase name; subsection = None }
+    | Some quote_start -> (
+        let name = String.sub content 0 quote_start |> strip |> lowercase in
+        if String.length name = 0 then None
+        else
+          let rest =
+            String.sub content (quote_start + 1)
+              (String.length content - quote_start - 1)
+          in
+          match closing_quote rest with
+          | None -> None
+          | Some close_pos ->
+              let subsection = String.sub rest 0 close_pos in
+              Some { name; subsection = Some (unescape_string subsection) })
+
+let strip_inline_comment s =
+  (* Strip inline comments (#, ;) from unquoted values *)
+  let rec find_comment i in_quote =
+    if i >= String.length s then String.length s
+    else
+      match s.[i] with
+      | '"' -> find_comment (i + 1) (not in_quote)
+      | '\\' when i + 1 < String.length s -> find_comment (i + 2) in_quote
+      | ('#' | ';') when not in_quote -> i
+      | _ -> find_comment (i + 1) in_quote
+  in
+  let comment_pos = find_comment 0 false in
+  if comment_pos = String.length s then s
+  else String.sub s 0 comment_pos |> rstrip
+
+let parse_key_value line =
+  let trimmed = strip line in
+  match String.index_opt trimmed '=' with
+  | None ->
+      if String.length trimmed > 0 then Some (lowercase trimmed, "true")
+      else None
+  | Some eq_pos ->
+      let key = String.sub trimmed 0 eq_pos |> strip |> lowercase in
+      let raw_value =
+        String.sub trimmed (eq_pos + 1) (String.length trimmed - eq_pos - 1)
+        |> lstrip |> strip_inline_comment
+      in
+      let value =
+        let len = String.length raw_value in
+        if len >= 2 && raw_value.[0] = '"' && raw_value.[len - 1] = '"' then
+          unescape_string (String.sub raw_value 1 (len - 2))
+        else raw_value
+      in
+      if String.length key > 0 then Some (key, value) else None
+
+let is_comment_line line =
+  let trimmed = lstrip line in
+  String.length trimmed = 0
+  || (String.length trimmed > 0 && (trimmed.[0] = '#' || trimmed.[0] = ';'))
+
+let of_string content =
+  let lines = String.split_on_char '\n' content in
+  let rec parse current_section acc = function
+    | [] -> List.rev acc
+    | line :: rest -> (
+        let line, rest =
+          if String.length line > 0 && line.[String.length line - 1] = '\\' then
+            let base = String.sub line 0 (String.length line - 1) in
+            match rest with
+            | [] -> (base, [])
+            | next :: more -> (base ^ strip next, more)
+          else (line, rest)
+        in
+        if is_comment_line line then parse current_section acc rest
+        else
+          match parse_section_header line with
+          | Some section -> parse (Some section) acc rest
+          | None -> (
+              match (current_section, parse_key_value line) with
+              | Some section, Some (key, value) ->
+                  let entry = { section; key; value } in
+                  parse current_section (entry :: acc) rest
+              | _ -> parse current_section acc rest))
+  in
+  parse None [] lines
+
+(** {1 Querying} *)
+
+let find t (section : section) key =
+  let key = lowercase key in
+  List.find_map
+    (fun e ->
+      if
+        e.section.name = section.name
+        && e.section.subsection = section.subsection
+        && e.key = key
+      then Some e.value
+      else None)
+    t
+
+let all t (section : section) key =
+  let key = lowercase key in
+  List.filter_map
+    (fun e ->
+      if
+        e.section.name = section.name
+        && e.section.subsection = section.subsection
+        && e.key = key
+      then Some e.value
+      else None)
+    t
+
+let bool t (section : section) key =
+  match find t section key with None -> None | Some v -> bool_codec.decode v
+
+let int t (section : section) key =
+  match find t section key with None -> None | Some v -> int_codec.decode v
+
+let all_sections t =
+  let seen = Hashtbl.create 16 in
+  List.filter_map
+    (fun e ->
+      let key = (e.section.name, e.section.subsection) in
+      if Hashtbl.mem seen key then None
+      else begin
+        Hashtbl.add seen key ();
+        Some e.section
+      end)
+    t
+
+let sections t name =
+  let name = lowercase name in
+  List.filter (fun s -> s.name = name) (all_sections t)
+
+(** {1 Typed Section Schemas}
+
+    Define expected section structure declaratively. *)
+
+type remote = {
+  name : string;
+  url : string option;
+  push_url : string option;
+  fetch : string list;
+}
+(** Remote configuration schema *)
+
+let remote_of_section t section =
+  match section.subsection with
+  | None -> None
+  | Some name ->
+      Some
+        {
+          name;
+          url = find t section "url";
+          push_url = find t section "pushurl";
+          fetch = all t section "fetch";
+        }
+
+let remotes t = sections t "remote" |> List.filter_map (remote_of_section t)
+let remote t name = List.find_opt (fun r -> r.name = name) (remotes t)
+
+type branch = {
+  name : string;
+  remote : string option;
+  merge : string option;
+  rebase : bool option;
+}
+(** Branch configuration schema *)
+
+let branch_of_section t section =
+  match section.subsection with
+  | None -> None
+  | Some name ->
+      Some
+        {
+          name;
+          remote = find t section "remote";
+          merge = find t section "merge";
+          rebase = bool t section "rebase";
+        }
+
+let branches t = sections t "branch" |> List.filter_map (branch_of_section t)
+let branch t name = List.find_opt (fun b -> b.name = name) (branches t)
+
+type core = {
+  bare : bool;
+  filemode : bool;
+  ignorecase : bool;
+  repositoryformatversion : int;
+}
+(** Core configuration schema *)
+
+let core_defaults =
+  {
+    bare = false;
+    filemode = true;
+    ignorecase = false;
+    repositoryformatversion = 0;
+  }
+
+let core t =
+  let section = { name = "core"; subsection = None } in
+  {
+    bare = Option.value ~default:core_defaults.bare (bool t section "bare");
+    filemode =
+      Option.value ~default:core_defaults.filemode (bool t section "filemode");
+    ignorecase =
+      Option.value ~default:core_defaults.ignorecase
+        (bool t section "ignorecase");
+    repositoryformatversion =
+      Option.value ~default:core_defaults.repositoryformatversion
+        (int t section "repositoryformatversion");
+  }
+
+type user_config = { name : string option; email : string option }
+(** User configuration schema *)
+
+let user t =
+  let section = { name = "user"; subsection = None } in
+  { name = find t section "name"; email = find t section "email" }
+
+(** {1 Serialization} *)
+
+let escape_subsection s =
+  let buf = Buffer.create (String.length s) in
+  String.iter
+    (fun c ->
+      match c with
+      | '\\' -> Buffer.add_string buf "\\\\"
+      | '"' -> Buffer.add_string buf "\\\""
+      | '\n' -> Buffer.add_string buf "\\n"
+      | '\t' -> Buffer.add_string buf "\\t"
+      | c -> Buffer.add_char buf c)
+    s;
+  Buffer.contents buf
+
+let escape_value s =
+  let needs_quoting =
+    String.length s = 0
+    || s.[0] = ' '
+    || s.[String.length s - 1] = ' '
+    || String.contains s '#' || String.contains s ';' || String.contains s '"'
+    || String.contains s '\n'
+  in
+  if not needs_quoting then s
+  else
+    let buf = Buffer.create (String.length s + 2) in
+    Buffer.add_char buf '"';
+    String.iter
+      (fun c ->
+        match c with
+        | '\\' -> Buffer.add_string buf "\\\\"
+        | '"' -> Buffer.add_string buf "\\\""
+        | '\n' -> Buffer.add_string buf "\\n"
+        | '\t' -> Buffer.add_string buf "\\t"
+        | c -> Buffer.add_char buf c)
+      s;
+    Buffer.add_char buf '"';
+    Buffer.contents buf
+
+let section_to_string section =
+  match section.subsection with
+  | None -> Fmt.str "[%s]" section.name
+  | Some sub -> Fmt.str "[%s \"%s\"]" section.name (escape_subsection sub)
+
+let to_string t =
+  let buf = Buffer.create 256 in
+  let current_section = ref None in
+  List.iter
+    (fun entry ->
+      let section_key = (entry.section.name, entry.section.subsection) in
+      if !current_section <> Some section_key then begin
+        if !current_section <> None then Buffer.add_char buf '\n';
+        Buffer.add_string buf (section_to_string entry.section);
+        Buffer.add_char buf '\n';
+        current_section := Some section_key
+      end;
+      Buffer.add_char buf '\t';
+      Buffer.add_string buf entry.key;
+      Buffer.add_string buf " = ";
+      Buffer.add_string buf (escape_value entry.value);
+      Buffer.add_char buf '\n')
+    t;
+  Buffer.contents buf
+
+(** {1 Building} *)
+
+let empty = []
+let section name = { name = lowercase name; subsection = None }
+
+let section_sub name subsection =
+  { name = lowercase name; subsection = Some subsection }
+
+let add t ~(section : section) ~key ~value =
+  let key = lowercase key in
+  t @ [ { section; key; value } ]
+
+let set t ~(section : section) ~key ~value =
+  let key = lowercase key in
+  let found = ref false in
+  let result =
+    List.filter_map
+      (fun e ->
+        if
+          e.section.name = section.name
+          && e.section.subsection = section.subsection
+          && e.key = key
+        then begin
+          if !found then None
+          else begin
+            found := true;
+            Some { e with value }
+          end
+        end
+        else Some e)
+      t
+  in
+  if !found then result else add result ~section ~key ~value
+
+let unset t ~(section : section) ~key =
+  let key = lowercase key in
+  List.filter
+    (fun e ->
+      not
+        (e.section.name = section.name
+        && e.section.subsection = section.subsection
+        && e.key = key))
+    t
+
+let unset_all t ~(section : section) ~key = unset t ~section ~key
+
+(** {1 Typed Building}
+
+    Build configs from typed records. *)
+
+let of_remote (r : remote) =
+  let section = section_sub "remote" r.name in
+  let entries = [] in
+  let entries =
+    match r.url with
+    | Some url -> { section; key = "url"; value = url } :: entries
+    | None -> entries
+  in
+  let entries =
+    match r.push_url with
+    | Some url -> { section; key = "pushurl"; value = url } :: entries
+    | None -> entries
+  in
+  let entries =
+    List.fold_left
+      (fun acc refspec -> { section; key = "fetch"; value = refspec } :: acc)
+      entries r.fetch
+  in
+  List.rev entries
+
+let of_branch (b : branch) =
+  let section = section_sub "branch" b.name in
+  let entries = [] in
+  let entries =
+    match b.remote with
+    | Some remote -> { section; key = "remote"; value = remote } :: entries
+    | None -> entries
+  in
+  let entries =
+    match b.merge with
+    | Some merge -> { section; key = "merge"; value = merge } :: entries
+    | None -> entries
+  in
+  let entries =
+    match b.rebase with
+    | Some rebase ->
+        { section; key = "rebase"; value = bool_codec.encode rebase } :: entries
+    | None -> entries
+  in
+  List.rev entries
+
+let of_core (c : core) =
+  let section = section "core" in
+  [
+    {
+      section;
+      key = "repositoryformatversion";
+      value = string_of_int c.repositoryformatversion;
+    };
+    { section; key = "filemode"; value = bool_codec.encode c.filemode };
+    { section; key = "bare"; value = bool_codec.encode c.bare };
+    { section; key = "ignorecase"; value = bool_codec.encode c.ignorecase };
+  ]
+
+let of_user (u : user_config) =
+  let section = section "user" in
+  let entries = [] in
+  let entries =
+    match u.name with
+    | Some name -> { section; key = "name"; value = name } :: entries
+    | None -> entries
+  in
+  let entries =
+    match u.email with
+    | Some email -> { section; key = "email"; value = email } :: entries
+    | None -> entries
+  in
+  List.rev entries

lib/config.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2025 Anil Madhavapeddy <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Declarative git config file parser.
+
+    Parses git config files (.git/config) following git's INI-like format:
+
+    {@ini[
+      [core]
+          bare = false
+          filemode = true
+
+      [remote "origin"]
+          url = https://github.com/user/repo.git
+          fetch = +refs/heads/*:refs/remotes/origin/*
+
+      [branch "main"]
+          remote = origin
+          merge = refs/heads/main
+    ]}
+
+    Features:
+    - Sections: [[name]] or [[name "subsection"]]
+    - Case-insensitive keys, case-sensitive subsections
+    - Multi-valued keys (e.g., [fetch])
+    - Comments with [#] or [;]
+    - Boolean values: [true], [yes], [on], [1] / [false], [no], [off], [0] *)
+
+(** {1 Value Codecs}
+
+    Codecs define how to decode/encode individual config values. *)
+
+type 'a codec = {
+  decode : string -> 'a option;
+  encode : 'a -> string;
+  kind : string;
+}
+(** A bidirectional codec for config values. *)
+
+val string_codec : string codec
+(** String values (identity). *)
+
+val int_codec : int codec
+(** Integer values. *)
+
+val bool_codec : bool codec
+(** [bool_codec] handles boolean values: [true/yes/on/1] and [false/no/off/0].
+*)
+
+(** {1 Types} *)
+
+type section = {
+  name : string;  (** Section name (lowercase) *)
+  subsection : string option;  (** Optional subsection (preserves case) *)
+}
+(** A config section identifier. *)
+
+type entry = {
+  section : section;
+  key : string;  (** Key name (lowercase) *)
+  value : string;
+}
+(** A single config entry. *)
+
+type t = entry list
+(** A parsed git config file. Entries are in file order. *)
+
+val pp : t Fmt.t
+(** [pp] pretty-prints a config as key=value lines. *)
+
+(** {1 Parsing} *)
+
+val of_string : string -> t
+(** [of_string content] parses git config content. *)
+
+val to_string : t -> string
+(** [to_string t] serializes the config to a string. *)
+
+(** {1 Querying} *)
+
+val find : t -> section -> string -> string option
+(** [find t section key] returns the first value for [key] in [section]. *)
+
+val all : t -> section -> string -> string list
+(** [all t section key] returns all values for [key] in [section]. Useful for
+    multi-valued keys like [fetch]. *)
+
+val bool : t -> section -> string -> bool option
+(** [bool t section key] parses a boolean value. *)
+
+val int : t -> section -> string -> int option
+(** [int t section key] parses an integer value. *)
+
+val all_sections : t -> section list
+(** [all_sections t] returns all unique sections in order of first appearance.
+*)
+
+val sections : t -> string -> section list
+(** [sections t name] returns all sections with the given name. For example,
+    [sections t "remote"] returns all remote sections. *)
+
+(** {1 Section Constructors} *)
+
+val section : string -> section
+(** [section name] creates a simple section without subsection. *)
+
+val section_sub : string -> string -> section
+(** [section_sub name subsection] creates a section with subsection. *)
+
+(** {1 Remotes}
+
+    Typed access to remote configuration. *)
+
+type remote = {
+  name : string;  (** Remote name (e.g., "origin") *)
+  url : string option;  (** Fetch URL *)
+  push_url : string option;  (** Push URL (if different from url) *)
+  fetch : string list;  (** Fetch refspecs *)
+}
+(** A git remote configuration. *)
+
+val remotes : t -> remote list
+(** [remotes t] returns all configured remotes. *)
+
+val remote : t -> string -> remote option
+(** [remote t name] returns the remote with the given name. *)
+
+val of_remote : remote -> entry list
+(** [of_remote r] creates config entries from a remote. *)
+
+(** {1 Branches}
+
+    Typed access to branch configuration. *)
+
+type branch = {
+  name : string;  (** Branch name *)
+  remote : string option;  (** Tracking remote *)
+  merge : string option;  (** Tracking ref *)
+  rebase : bool option;  (** Rebase on pull *)
+}
+(** A git branch configuration. *)
+
+val branches : t -> branch list
+(** [branches t] returns all configured branches. *)
+
+val branch : t -> string -> branch option
+(** [branch t name] returns the branch with the given name. *)
+
+val of_branch : branch -> entry list
+(** [of_branch b] creates config entries from a branch. *)
+
+(** {1 Core Config}
+
+    Typed access to core repository configuration. *)
+
+type core = {
+  bare : bool;
+  filemode : bool;
+  ignorecase : bool;
+  repositoryformatversion : int;
+}
+(** Core repository configuration. *)
+
+val core_defaults : core
+(** Default core configuration values. *)
+
+val core : t -> core
+(** [core t] returns core configuration with defaults for missing values. *)
+
+val of_core : core -> entry list
+(** [of_core c] creates config entries from core config. *)
+
+(** {1 User Config}
+
+    Typed access to user identity configuration. *)
+
+type user_config = { name : string option; email : string option }
+(** User identity configuration. *)
+
+val user : t -> user_config
+(** [user t] returns user configuration. *)
+
+val of_user : user_config -> entry list
+(** [of_user u] creates config entries from user config. *)
+
+(** {1 Building} *)
+
+val empty : t
+(** [empty] is an empty config. *)
+
+val add : t -> section:section -> key:string -> value:string -> t
+(** [add t ~section ~key ~value] adds an entry. Allows duplicates. *)
+
+val set : t -> section:section -> key:string -> value:string -> t
+(** [set t ~section ~key ~value] sets a value, replacing any existing. *)
+
+val unset : t -> section:section -> key:string -> t
+(** [unset t ~section ~key] removes the first matching entry. *)
+
+val unset_all : t -> section:section -> key:string -> t
+(** [unset_all t ~section ~key] removes all matching entries. *)

lib/diff.ml

···
+(** Tree and commit diff operations. *)
+
+type change =
+  | Added of { path : string; hash : Hash.t; perm : Tree.perm }
+  | Removed of { path : string; hash : Hash.t; perm : Tree.perm }
+  | Modified of {
+      path : string;
+      old_hash : Hash.t;
+      new_hash : Hash.t;
+      old_perm : Tree.perm;
+      new_perm : Tree.perm;
+    }
+
+type t = change list
+type stats = { additions : int; deletions : int; modifications : int }
+
+let change_path = function
+  | Added { path; _ } | Removed { path; _ } | Modified { path; _ } -> path
+
+let compare_by_path c1 c2 = String.compare (change_path c1) (change_path c2)
+let path prefix name = if prefix = "" then name else prefix ^ "/" ^ name
+
+(** Read a tree from the repository, returning empty list if not found. *)
+let read_tree repo hash =
+  match Repository.read repo hash with
+  | Ok (Value.Tree tree) -> Ok (Tree.to_list tree)
+  | Ok _ -> Error (`Msg "expected tree object")
+  | Error e -> Error e
+
+(** Check if an entry is a directory (tree). *)
+let is_dir (entry : Tree.entry) = entry.perm = `Dir
+
+(** Recursively collect all entries in a tree as Added changes. *)
+let rec collect_added repo prefix entries acc =
+  List.fold_left
+    (fun acc (entry : Tree.entry) ->
+      match acc with
+      | Error _ -> acc
+      | Ok changes ->
+          let path = path prefix entry.name in
+          if is_dir entry then
+            (* Recurse into subdirectory *)
+            match read_tree repo entry.hash with
+            | Error e -> Error e
+            | Ok sub_entries -> collect_added repo path sub_entries (Ok changes)
+          else
+            Ok (Added { path; hash = entry.hash; perm = entry.perm } :: changes))
+    acc entries
+
+(** Recursively collect all entries in a tree as Removed changes. *)
+let rec collect_removed repo prefix entries acc =
+  List.fold_left
+    (fun acc (entry : Tree.entry) ->
+      match acc with
+      | Error _ -> acc
+      | Ok changes ->
+          let path = path prefix entry.name in
+          if is_dir entry then
+            match read_tree repo entry.hash with
+            | Error e -> Error e
+            | Ok sub_entries ->
+                collect_removed repo path sub_entries (Ok changes)
+          else
+            Ok
+              (Removed { path; hash = entry.hash; perm = entry.perm } :: changes))
+    acc entries
+
+(** Process a single added entry (file or directory). *)
+let process_added_entry repo prefix (entry : Tree.entry) changes =
+  let path = path prefix entry.name in
+  if is_dir entry then
+    match read_tree repo entry.hash with
+    | Error e -> Error e
+    | Ok sub -> collect_added repo path sub (Ok changes)
+  else Ok (Added { path; hash = entry.hash; perm = entry.perm } :: changes)
+
+(** Process a single removed entry (file or directory). *)
+let process_removed_entry repo prefix (entry : Tree.entry) changes =
+  let path = path prefix entry.name in
+  if is_dir entry then
+    match read_tree repo entry.hash with
+    | Error e -> Error e
+    | Ok sub -> collect_removed repo path sub (Ok changes)
+  else Ok (Removed { path; hash = entry.hash; perm = entry.perm } :: changes)
+
+(** Handle entries with same name but different content/type. *)
+let rec process_matched_entries repo prefix old_e new_e changes walk_fn =
+  let path = path prefix old_e.Tree.name in
+  match (is_dir old_e, is_dir new_e) with
+  | true, true -> (
+      (* Both directories, recurse *)
+      match (read_tree repo old_e.hash, read_tree repo new_e.hash) with
+      | Ok old_entries', Ok new_entries' ->
+          walk_fn repo path old_entries' new_entries' (Ok changes)
+      | Error e, _ | _, Error e -> Error e)
+  | false, false ->
+      (* Both files, content changed *)
+      Ok
+        (Modified
+           {
+             path;
+             old_hash = old_e.hash;
+             new_hash = new_e.hash;
+             old_perm = old_e.perm;
+             new_perm = new_e.perm;
+           }
+        :: changes)
+  | true, false -> (
+      (* Dir became file: remove dir contents, add file *)
+      match read_tree repo old_e.hash with
+      | Error e -> Error e
+      | Ok sub -> (
+          match collect_removed repo path sub (Ok changes) with
+          | Error e -> Error e
+          | Ok changes' ->
+              Ok
+                (Added { path; hash = new_e.hash; perm = new_e.perm }
+                :: changes')))
+  | false, true -> (
+      (* File became dir: remove file, add dir contents *)
+      let change = Removed { path; hash = old_e.hash; perm = old_e.perm } in
+      match read_tree repo new_e.hash with
+      | Error e -> Error e
+      | Ok sub -> collect_added repo path sub (Ok (change :: changes)))
+
+(** Merge-walk two sorted entry lists and compute differences. *)
+and walk_trees repo prefix old_entries new_entries acc =
+  match (old_entries, new_entries, acc) with
+  | _, _, Error _ -> acc
+  | [], [], Ok changes -> Ok changes
+  | [], new_e :: rest, Ok changes -> (
+      match process_added_entry repo prefix new_e changes with
+      | Error e -> Error e
+      | Ok changes' -> walk_trees repo prefix [] rest (Ok changes'))
+  | old_e :: rest, [], Ok changes -> (
+      match process_removed_entry repo prefix old_e changes with
+      | Error e -> Error e
+      | Ok changes' -> walk_trees repo prefix rest [] (Ok changes'))
+  | old_e :: old_rest, new_e :: new_rest, Ok changes -> (
+      let cmp = String.compare old_e.Tree.name new_e.Tree.name in
+      if cmp < 0 then
+        match process_removed_entry repo prefix old_e changes with
+        | Error e -> Error e
+        | Ok changes' ->
+            walk_trees repo prefix old_rest new_entries (Ok changes')
+      else if cmp > 0 then
+        match process_added_entry repo prefix new_e changes with
+        | Error e -> Error e
+        | Ok changes' ->
+            walk_trees repo prefix old_entries new_rest (Ok changes')
+      else if Hash.equal old_e.hash new_e.hash && old_e.perm = new_e.perm then
+        walk_trees repo prefix old_rest new_rest acc
+      else
+        match
+          process_matched_entries repo prefix old_e new_e changes walk_trees
+        with
+        | Error e -> Error e
+        | Ok changes' -> walk_trees repo prefix old_rest new_rest (Ok changes'))
+
+let trees repo ~old_tree ~new_tree =
+  let old_entries = read_tree repo old_tree in
+  let new_entries = read_tree repo new_tree in
+  match (old_entries, new_entries) with
+  | Error e, _ | _, Error e -> Error e
+  | Ok old_e, Ok new_e -> (
+      match walk_trees repo "" old_e new_e (Ok []) with
+      | Error e -> Error e
+      | Ok changes -> Ok (List.sort compare_by_path changes))
+
+let commits repo ~old_commit ~new_commit =
+  let read_commit_tree hash =
+    match Repository.read repo hash with
+    | Ok (Value.Commit commit) -> Ok (Commit.tree commit)
+    | Ok _ -> Error (`Msg "expected commit object")
+    | Error e -> Error e
+  in
+  match (read_commit_tree old_commit, read_commit_tree new_commit) with
+  | Error e, _ | _, Error e -> Error e
+  | Ok old_tree, Ok new_tree -> trees repo ~old_tree ~new_tree
+
+let tree_to_empty repo tree =
+  match read_tree repo tree with
+  | Error e -> Error e
+  | Ok entries -> (
+      match collect_added repo "" entries (Ok []) with
+      | Error e -> Error e
+      | Ok changes -> Ok (List.sort compare_by_path changes))
+
+let empty_to_tree repo tree =
+  match read_tree repo tree with
+  | Error e -> Error e
+  | Ok entries -> (
+      match collect_removed repo "" entries (Ok []) with
+      | Error e -> Error e
+      | Ok changes -> Ok (List.sort compare_by_path changes))
+
+let filter_by_path ~prefix diff =
+  let prefix_len = String.length prefix in
+  List.filter
+    (fun change ->
+      let path = change_path change in
+      String.length path >= prefix_len
+      && String.sub path 0 prefix_len = prefix
+      && (String.length path = prefix_len || path.[prefix_len] = '/'))
+    diff
+
+let stats diff =
+  List.fold_left
+    (fun acc change ->
+      match change with
+      | Added _ -> { acc with additions = acc.additions + 1 }
+      | Removed _ -> { acc with deletions = acc.deletions + 1 }
+      | Modified _ -> { acc with modifications = acc.modifications + 1 })
+    { additions = 0; deletions = 0; modifications = 0 }
+    diff
+
+let pp_change ppf change =
+  match change with
+  | Added { path; _ } -> Fmt.pf ppf "A %s" path
+  | Removed { path; _ } -> Fmt.pf ppf "D %s" path
+  | Modified { path; _ } -> Fmt.pf ppf "M %s" path
+
+let pp ppf diff = Fmt.pf ppf "@[<v>%a@]" Fmt.(list ~sep:cut pp_change) diff
+
+let pp_stats ppf stats =
+  Fmt.pf ppf "%d additions, %d deletions, %d modifications" stats.additions
+    stats.deletions stats.modifications

lib/diff.mli

···
+(** Tree and commit diff operations.
+
+    This module provides functionality to compare trees and commits, producing a
+    list of changes between them. *)
+
+(** {1 Types} *)
+
+(** A single change in a diff. *)
+type change =
+  | Added of { path : string; hash : Hash.t; perm : Tree.perm }
+      (** File or directory added *)
+  | Removed of { path : string; hash : Hash.t; perm : Tree.perm }
+      (** File or directory removed *)
+  | Modified of {
+      path : string;
+      old_hash : Hash.t;
+      new_hash : Hash.t;
+      old_perm : Tree.perm;
+      new_perm : Tree.perm;
+    }  (** File content changed (and optionally permissions) *)
+
+type t = change list
+(** A diff is a list of changes. *)
+
+(** {1 Diff Operations} *)
+
+val trees :
+  Repository.t ->
+  old_tree:Hash.t ->
+  new_tree:Hash.t ->
+  (t, [ `Msg of string ]) result
+(** [trees repo ~old_tree ~new_tree] computes the difference between two trees.
+
+    Returns a list of changes needed to transform [old_tree] into [new_tree].
+    The changes are returned in lexicographical order by path. *)
+
+val commits :
+  Repository.t ->
+  old_commit:Hash.t ->
+  new_commit:Hash.t ->
+  (t, [ `Msg of string ]) result
+(** [commits repo ~old_commit ~new_commit] computes the difference between two
+    commits by comparing their trees. *)
+
+val tree_to_empty : Repository.t -> Hash.t -> (t, [ `Msg of string ]) result
+(** [tree_to_empty repo tree] returns all entries in the tree as [Added]
+    changes. Useful for showing the initial commit. *)
+
+val empty_to_tree : Repository.t -> Hash.t -> (t, [ `Msg of string ]) result
+(** [empty_to_tree repo tree] returns all entries in the tree as [Removed]
+    changes. *)
+
+(** {1 Filtering} *)
+
+val filter_by_path : prefix:string -> t -> t
+(** [filter_by_path ~prefix diff] returns only changes under the given path
+    prefix. *)
+
+(** {1 Statistics} *)
+
+type stats = {
+  additions : int;  (** Number of files added *)
+  deletions : int;  (** Number of files removed *)
+  modifications : int;  (** Number of files modified *)
+}
+(** Summary statistics for a diff. *)
+
+val stats : t -> stats
+(** [stats diff] computes summary statistics for the diff. *)
+
+(** {1 Pretty Printing} *)
+
+val pp_change : change Fmt.t
+(** [pp_change] formats a single change. *)
+
+val pp : t Fmt.t
+(** [pp] formats a diff as a list of changes. *)
+
+val pp_stats : stats Fmt.t
+(** [pp_stats] formats diff statistics. *)

lib/dune

···
+(library
+ (name git)
+ (public_name git)
+ (libraries bytesrw bytesrw.zlib digestif eio fmt fpath ptime requests uri))

lib/git.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git object format implementation in pure OCaml.
+
+    This library provides type-safe encoding and decoding of Git objects: blobs,
+    trees, commits, and tags. It is derived from mirage/ocaml-git and
+    robur-coop/carton, simplified for Eio-native usage. *)
+
+module Hash = Hash
+module User = User
+module Blob = Blob
+module Tree = Tree
+module Commit = Commit
+module Tag = Tag
+module Value = Value
+module Reference = Reference
+module Pack = Pack
+module Pack_index = Pack_index
+module Repository = Repository
+module Rev_list = Rev_list
+module Subtree = Subtree
+module Config = Config
+module Index = Index
+module Remote = Remote
+module Diff = Diff
+module Worktree = Worktree

lib/git.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git object format implementation in pure OCaml.
+
+    This library provides type-safe encoding and decoding of Git objects: blobs,
+    trees, commits, and tags. It is derived from
+    {{:https://github.com/mirage/ocaml-git}mirage/ocaml-git} and
+    {{:https://github.com/robur-coop/carton}robur-coop/carton}.
+
+    {1 Object types}
+
+    Git stores four types of objects:
+    - {!Blob}: File contents
+    - {!Tree}: Directory listings (entries with mode, name, and hash)
+    - {!Commit}: Snapshots with metadata (tree, parents, author, committer,
+      message)
+    - {!Tag}: Named references to objects with optional signature
+
+    {1 Example}
+
+    {[
+      (* Create a blob *)
+      let blob = Git.Blob.of_string "Hello, World!\n"
+      let blob_hash = Git.Blob.digest blob
+
+      (* Create a tree entry *)
+      let entry = Git.Tree.entry ~perm:`Normal ~name:"hello.txt" blob_hash
+      let tree = Git.Tree.v [ entry ]
+      let tree_hash = Git.Tree.digest tree
+
+      (* Create a commit *)
+      let author = Git.User.v ~name:"Alice" ~email:"[e-mail]" ()
+
+      let commit =
+        Git.Commit.v ~tree:tree_hash ~author ~committer:author
+          (Some "Initial commit")
+
+      let commit_hash = Git.Commit.digest commit
+    ]} *)
+
+module Hash = Hash
+(** Git object hashes (SHA-1). *)
+
+module User = User
+(** Git user information (author/committer). *)
+
+module Blob = Blob
+(** Git blob objects (file contents). *)
+
+module Tree = Tree
+(** Git tree objects (directory listings). *)
+
+module Commit = Commit
+(** Git commit objects. *)
+
+module Tag = Tag
+(** Git tag objects. *)
+
+module Value = Value
+(** Git values (union of all object types). *)
+
+module Reference = Reference
+(** Git references (branches, tags, HEAD). *)
+
+module Pack = Pack
+(** Git pack files (compressed object storage). *)
+
+module Pack_index = Pack_index
+(** Git pack index files (fast object lookup). *)
+
+module Repository = Repository
+(** Git repository access (loose objects + pack files). *)
+
+module Rev_list = Rev_list
+(** Commit graph traversal and topological ordering. *)
+
+module Subtree = Subtree
+(** Fast subtree split with persistent caching. *)
+
+module Config = Config
+(** Git config file parsing (.git/config). *)
+
+module Index = Index
+(** Git index (staging area) operations. *)
+
+module Remote = Remote
+(** Git remote queries via smart HTTP protocol. *)
+
+module Diff = Diff
+(** Git diff operations. *)
+
+module Worktree = Worktree
+(** Git worktree operations. *)

lib/hash.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git object hashes (SHA-1 or SHA-256). *)
+
+type t = Digestif.SHA1.t
+
+let digest_size = Digestif.SHA1.digest_size
+let pp = Digestif.SHA1.pp
+let equal = Digestif.SHA1.equal
+let compare = Digestif.SHA1.unsafe_compare
+
+let of_raw_string s =
+  if String.length s <> digest_size then
+    invalid_arg "Hash.of_raw_string: invalid length";
+  Digestif.SHA1.of_raw_string s
+
+let to_raw_string = Digestif.SHA1.to_raw_string
+let of_hex s = Digestif.SHA1.of_hex s
+let to_hex t = Digestif.SHA1.to_hex t
+
+let null =
+  let s = String.make digest_size '\x00' in
+  of_raw_string s
+
+let v t = Hashtbl.hash (to_raw_string t)
+
+module Set = Set.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)
+
+module Map = Map.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)
+
+(** Compute the hash of a git object. *)
+let digest ~kind ~length contents =
+  let kind_str =
+    match kind with
+    | `Blob -> "blob"
+    | `Tree -> "tree"
+    | `Commit -> "commit"
+    | `Tag -> "tag"
+  in
+  let header = Fmt.str "%s %d\x00" kind_str length in
+  let ctx = Digestif.SHA1.empty in
+  let ctx = Digestif.SHA1.feed_string ctx header in
+  let ctx = Digestif.SHA1.feed_string ctx contents in
+  Digestif.SHA1.get ctx
+
+let digest_string ~kind s = digest ~kind ~length:(String.length s) s

lib/hash.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git object hashes (SHA-1). *)
+
+type t
+(** The type of hashes. *)
+
+val digest_size : int
+(** The size of a hash in bytes (20 for SHA-1). *)
+
+val pp : t Fmt.t
+(** Pretty-print a hash in hex format. *)
+
+val equal : t -> t -> bool
+(** Equality on hashes. *)
+
+val compare : t -> t -> int
+(** Total ordering on hashes. *)
+
+val v : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val of_raw_string : string -> t
+(** [of_raw_string s] parses a hash from its raw binary form.
+    @raise Invalid_argument if [s] has wrong length. *)
+
+val to_raw_string : t -> string
+(** [to_raw_string h] returns the raw binary form of [h]. *)
+
+val of_hex : string -> t
+(** [of_hex s] parses a hash from its hexadecimal representation.
+    @raise Invalid_argument if [s] is not valid hex. *)
+
+val to_hex : t -> string
+(** [to_hex h] returns the hexadecimal representation of [h]. *)
+
+val null : t
+(** The null hash (all zeros). *)
+
+val digest :
+  kind:[< `Blob | `Commit | `Tag | `Tree ] -> length:int -> string -> t
+(** [digest ~kind ~length content] computes the git hash of an object. *)
+
+val digest_string : kind:[< `Blob | `Commit | `Tag | `Tree ] -> string -> t
+(** [digest_string ~kind s] computes the git hash of a string. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/index.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git index (staging area) operations.
+
+    Binary format:
+    - 4-byte signature "DIRC"
+    - 4-byte version (2, 3, or 4)
+    - 32-bit number of entries
+    - Index entries (sorted by path)
+    - Extensions (optional)
+    - 20-byte SHA-1 checksum *)
+
+type mode = Regular | Executable | Symlink | Gitlink
+
+type entry = {
+  ctime_s : int32;
+  ctime_ns : int32;
+  mtime_s : int32;
+  mtime_ns : int32;
+  dev : int32;
+  ino : int32;
+  mode : mode;
+  uid : int32;
+  gid : int32;
+  size : int32;
+  hash : Hash.t;
+  flags : int;
+  name : string;
+}
+
+type t = { version : int; entries : entry list }
+
+let err_unsupported_version v =
+  Error (`Msg (Fmt.str "unsupported index version %d" v))
+
+let pp ppf t =
+  Fmt.pf ppf "@[<v>index v%d (%d entries)@]" t.version (List.length t.entries)
+
+let empty = { version = 2; entries = [] }
+
+(** {1 Binary reading helpers} *)
+
+let int32_be s off =
+  let b0 = Char.code s.[off] in
+  let b1 = Char.code s.[off + 1] in
+  let b2 = Char.code s.[off + 2] in
+  let b3 = Char.code s.[off + 3] in
+  Int32.of_int ((b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3)
+
+let int16_be s off =
+  let b0 = Char.code s.[off] in
+  let b1 = Char.code s.[off + 1] in
+  (b0 lsl 8) lor b1
+
+(** {1 Binary writing helpers} *)
+
+let put_int32_be buf n =
+  Buffer.add_char buf
+    (Char.chr (Int32.to_int (Int32.shift_right_logical n 24) land 0xff));
+  Buffer.add_char buf
+    (Char.chr (Int32.to_int (Int32.shift_right_logical n 16) land 0xff));
+  Buffer.add_char buf
+    (Char.chr (Int32.to_int (Int32.shift_right_logical n 8) land 0xff));
+  Buffer.add_char buf (Char.chr (Int32.to_int n land 0xff))
+
+let put_int16_be buf n =
+  Buffer.add_char buf (Char.chr ((n lsr 8) land 0xff));
+  Buffer.add_char buf (Char.chr (n land 0xff))
+
+(** {1 Mode encoding} *)
+
+let mode_of_int = function
+  | 0o100644 -> Regular
+  | 0o100755 -> Executable
+  | 0o120000 -> Symlink
+  | 0o160000 -> Gitlink
+  | _ -> Regular (* Default to regular for unknown modes *)
+
+let int_of_mode = function
+  | Regular -> 0o100644
+  | Executable -> 0o100755
+  | Symlink -> 0o120000
+  | Gitlink -> 0o160000
+
+(** {1 Parsing} *)
+
+(** Find NUL terminator in string starting at given offset. *)
+let nul s start =
+  let rec loop i =
+    if i >= String.length s then String.length s
+    else if s.[i] = '\x00' then i
+    else loop (i + 1)
+  in
+  loop start
+
+(** Calculate padded entry length (8-byte boundary). *)
+let padded_entry_len off nul_pos = ((nul_pos - off + 1 + 7) / 8 * 8) + off
+
+let parse_entry s off version =
+  if off + 62 > String.length s then Error (`Msg "truncated entry")
+  else
+    let ctime_s = int32_be s off in
+    let ctime_ns = int32_be s (off + 4) in
+    let mtime_s = int32_be s (off + 8) in
+    let mtime_ns = int32_be s (off + 12) in
+    let dev = int32_be s (off + 16) in
+    let ino = int32_be s (off + 20) in
+    let mode = mode_of_int (Int32.to_int (int32_be s (off + 24))) in
+    let uid = int32_be s (off + 28) in
+    let gid = int32_be s (off + 32) in
+    let size = int32_be s (off + 36) in
+    let hash = Hash.of_raw_string (String.sub s (off + 40) 20) in
+    let flags = int16_be s (off + 60) in
+    let base_off = off + 62 in
+    (* Version 3+ has extended flags *)
+    let base_off =
+      if version >= 3 && flags land 0x4000 <> 0 then base_off + 2 else base_off
+    in
+    let nul_pos = nul s base_off in
+    let name = String.sub s base_off (nul_pos - base_off) in
+    let next_off = padded_entry_len off nul_pos in
+    Ok
+      ( {
+          ctime_s;
+          ctime_ns;
+          mtime_s;
+          mtime_ns;
+          dev;
+          ino;
+          mode;
+          uid;
+          gid;
+          size;
+          hash;
+          flags;
+          name;
+        },
+        next_off )
+
+let of_string s =
+  let len = String.length s in
+  if len < 12 then Error (`Msg "index too short")
+  else if String.sub s 0 4 <> "DIRC" then Error (`Msg "invalid index signature")
+  else
+    let version = Int32.to_int (int32_be s 4) in
+    if version < 2 || version > 4 then err_unsupported_version version
+    else
+      let num_entries = Int32.to_int (int32_be s 8) in
+      let rec parse_entries acc off remaining =
+        if remaining = 0 then Ok (List.rev acc, off)
+        else
+          match parse_entry s off version with
+          | Error e -> Error e
+          | Ok (entry, next_off) ->
+              parse_entries (entry :: acc) next_off (remaining - 1)
+      in
+      match parse_entries [] 12 num_entries with
+      | Error e -> Error e
+      | Ok (entries, _off) ->
+          (* Skip extensions and checksum validation for now *)
+          Ok { version; entries }
+
+(** {1 Serialization} *)
+
+let serialize_entry buf entry =
+  put_int32_be buf entry.ctime_s;
+  put_int32_be buf entry.ctime_ns;
+  put_int32_be buf entry.mtime_s;
+  put_int32_be buf entry.mtime_ns;
+  put_int32_be buf entry.dev;
+  put_int32_be buf entry.ino;
+  put_int32_be buf (Int32.of_int (int_of_mode entry.mode));
+  put_int32_be buf entry.uid;
+  put_int32_be buf entry.gid;
+  put_int32_be buf entry.size;
+  Buffer.add_string buf (Hash.to_raw_string entry.hash);
+  (* Flags: stage (bits 12-13) and name length (bits 0-11) *)
+  let name_len = min 0xfff (String.length entry.name) in
+  let flags = entry.flags land 0x3000 lor name_len in
+  put_int16_be buf flags;
+  Buffer.add_string buf entry.name;
+  Buffer.add_char buf '\x00';
+  (* Pad to 8-byte boundary *)
+  let entry_len = 62 + String.length entry.name + 1 in
+  let padding = ((entry_len + 7) / 8 * 8) - entry_len in
+  for _ = 1 to padding do
+    Buffer.add_char buf '\x00'
+  done
+
+let to_string t =
+  let buf = Buffer.create 4096 in
+  Buffer.add_string buf "DIRC";
+  put_int32_be buf (Int32.of_int t.version);
+  put_int32_be buf (Int32.of_int (List.length t.entries));
+  List.iter (serialize_entry buf) t.entries;
+  (* Compute and add SHA-1 checksum *)
+  let content = Buffer.contents buf in
+  let checksum = Digestif.SHA1.digest_string content in
+  let checksum_raw = Digestif.SHA1.to_raw_string checksum in
+  Buffer.add_string buf checksum_raw;
+  Buffer.contents buf
+
+(** {1 Entry access} *)
+
+let entries t = t.entries
+let find t path = List.find_opt (fun e -> e.name = path) t.entries
+let mem t path = List.exists (fun e -> e.name = path) t.entries
+
+(** {1 Index modification} *)
+
+let add t entry =
+  let entries = List.filter (fun e -> e.name <> entry.name) t.entries in
+  let entries = entry :: entries in
+  (* Keep entries sorted by path *)
+  let entries = List.sort (fun a b -> String.compare a.name b.name) entries in
+  { t with entries }
+
+let remove t path =
+  let entries = List.filter (fun e -> e.name <> path) t.entries in
+  { t with entries }
+
+let remove_prefix t prefix =
+  (* Remove all entries whose path starts with prefix/ or equals prefix *)
+  let prefix_slash = prefix ^ "/" in
+  let entries =
+    List.filter
+      (fun e ->
+        e.name <> prefix && not (String.starts_with ~prefix:prefix_slash e.name))
+      t.entries
+  in
+  { t with entries }
+
+let clear t = { t with entries = [] }
+
+(** {1 Working with files} *)
+
+let entry_of_file ~fs ~root ~path ~hash =
+  let full_path = Eio.Path.(fs / root / path) in
+  let stat =
+    try Some (Eio.Path.stat ~follow:false full_path)
+    with Eio.Io _ | Unix.Unix_error _ -> None
+  in
+  match stat with
+  | None ->
+      (* File doesn't exist, create minimal entry *)
+      {
+        ctime_s = 0l;
+        ctime_ns = 0l;
+        mtime_s = 0l;
+        mtime_ns = 0l;
+        dev = 0l;
+        ino = 0l;
+        mode = Regular;
+        uid = 0l;
+        gid = 0l;
+        size = 0l;
+        hash;
+        flags = 0;
+        name = path;
+      }
+  | Some stat ->
+      let mode =
+        if stat.kind = `Regular_file then
+          (* Check if executable - simplified, assume regular *)
+          Regular
+        else if stat.kind = `Symbolic_link then Symlink
+        else Regular
+      in
+      let mtime_s = Int64.to_int32 (Int64.of_float stat.mtime) in
+      let mtime_ns =
+        Int32.of_float ((stat.mtime -. Float.floor stat.mtime) *. 1e9)
+      in
+      {
+        ctime_s = mtime_s;
+        (* Use mtime for ctime as Eio doesn't provide ctime *)
+        ctime_ns = mtime_ns;
+        mtime_s;
+        mtime_ns;
+        dev = Int64.to_int32 stat.dev;
+        ino = Int64.to_int32 stat.ino;
+        mode;
+        uid = Int64.to_int32 stat.uid;
+        gid = Int64.to_int32 stat.gid;
+        size = Int32.of_int (Optint.Int63.to_int stat.size);
+        hash;
+        flags = 0;
+        name = path;
+      }
+
+(** {1 Tree building} *)
+
+module String_map = Map.Make (String)
+
+type tree_node =
+  | Blob of Hash.t * Tree.perm
+  | Subtree of tree_node String_map.t
+
+let to_tree ~write_tree ~write_blob:_ t =
+  (* Build a tree structure from flat index entries *)
+  let root = ref String_map.empty in
+  List.iter
+    (fun entry ->
+      let parts = String.split_on_char '/' entry.name in
+      let rec insert node parts =
+        match parts with
+        | [] -> node
+        | [ filename ] ->
+            let perm =
+              match entry.mode with
+              | Regular -> `Normal
+              | Executable -> `Exec
+              | Symlink -> `Link
+              | Gitlink -> `Commit
+            in
+            String_map.add filename (Blob (entry.hash, perm)) node
+        | dir :: rest ->
+            let subtree =
+              match String_map.find_opt dir node with
+              | Some (Subtree m) -> m
+              | _ -> String_map.empty
+            in
+            let subtree = insert subtree rest in
+            String_map.add dir (Subtree subtree) node
+      in
+      root := insert !root parts)
+    t.entries;
+  (* Convert tree_node to Git trees, bottom-up *)
+  let rec build_tree node =
+    let entries =
+      String_map.fold
+        (fun name child acc ->
+          match child with
+          | Blob (hash, perm) -> Tree.entry ~perm ~name hash :: acc
+          | Subtree submap ->
+              let subtree_hash = build_tree submap in
+              Tree.entry ~perm:`Dir ~name subtree_hash :: acc)
+        node []
+    in
+    let tree = Tree.v (List.rev entries) in
+    write_tree tree
+  in
+  build_tree !root

lib/index.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git index (staging area) operations.
+
+    The index file (.git/index) is a binary format that represents the staging
+    area - files that will be included in the next commit. *)
+
+(** {1 Types} *)
+
+type mode = Regular | Executable | Symlink | Gitlink  (** Submodule *)
+
+type entry = {
+  ctime_s : int32;
+  ctime_ns : int32;
+  mtime_s : int32;
+  mtime_ns : int32;
+  dev : int32;
+  ino : int32;
+  mode : mode;
+  uid : int32;
+  gid : int32;
+  size : int32;
+  hash : Hash.t;
+  flags : int;  (** Stage and other flags *)
+  name : string;
+}
+(** An index entry representing a staged file. *)
+
+type t
+(** The index (staging area). *)
+
+val pp : t Fmt.t
+(** [pp] pretty-prints an index summary. *)
+
+(** {1 Parsing and serialization} *)
+
+val empty : t
+(** Empty index. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse index file content. *)
+
+val to_string : t -> string
+(** Serialize index to binary format. *)
+
+(** {1 Entry access} *)
+
+val entries : t -> entry list
+(** [entries t] returns all entries sorted by path. *)
+
+val find : t -> string -> entry option
+(** [find t path] returns the entry for [path]. *)
+
+val mem : t -> string -> bool
+(** [mem t path] returns true if [path] is in the index. *)
+
+(** {1 Index modification} *)
+
+val add : t -> entry -> t
+(** [add t entry] adds or updates an entry. *)
+
+val remove : t -> string -> t
+(** [remove t path] removes the entry for [path]. *)
+
+val remove_prefix : t -> string -> t
+(** [remove_prefix t prefix] removes all entries under [prefix]. *)
+
+val clear : t -> t
+(** [clear t] removes all entries. *)
+
+(** {1 Working with files} *)
+
+val entry_of_file :
+  fs:Eio.Fs.dir_ty Eio.Path.t ->
+  root:string ->
+  path:string ->
+  hash:Hash.t ->
+  entry
+(** [entry_of_file ~fs ~root ~path ~hash] creates an index entry from a file.
+    [path] is relative to [root]. *)
+
+(** {1 Tree building} *)
+
+val to_tree :
+  write_tree:(Tree.t -> Hash.t) -> write_blob:(string -> Hash.t) -> t -> Hash.t
+(** [to_tree ~write_tree ~write_blob t] builds a tree from the index and returns
+    the root tree hash. *)

lib/pack.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git pack file support.
+
+    Pack files store multiple git objects in a compressed format with delta
+    encoding for efficient storage. *)
+
+module Reader = Bytesrw.Bytes.Reader
+module Slice = Bytesrw.Bytes.Slice
+
+(** {1 Error helpers} *)
+
+let err_invalid_obj_type n =
+  Error (`Msg (Fmt.str "Invalid pack object type: %d" n))
+
+let err_unsupported_version v =
+  Error (`Msg (Fmt.str "Unsupported pack version: %d" v))
+
+(** {1 Pack file format}
+
+    Pack file structure:
+    - Header: "PACK" (4 bytes) + version (4 bytes, big-endian) + count (4 bytes)
+    - Objects: variable-length entries
+    - Footer: SHA-1 checksum (20 bytes) *)
+
+(** Object types in pack files. *)
+type obj_type =
+  | Commit
+  | Tree
+  | Blob
+  | Tag
+  | Ofs_delta  (** Delta relative to offset in same pack *)
+  | Ref_delta  (** Delta relative to object by hash *)
+
+let obj_type_to_int = function
+  | Commit -> 1
+  | Tree -> 2
+  | Blob -> 3
+  | Tag -> 4
+  | Ofs_delta -> 6
+  | Ref_delta -> 7
+
+let obj_type_of_int = function
+  | 1 -> Ok Commit
+  | 2 -> Ok Tree
+  | 3 -> Ok Blob
+  | 4 -> Ok Tag
+  | 6 -> Ok Ofs_delta
+  | 7 -> Ok Ref_delta
+  | n -> err_invalid_obj_type n
+
+let pp_obj_type ppf = function
+  | Commit -> Fmt.string ppf "commit"
+  | Tree -> Fmt.string ppf "tree"
+  | Blob -> Fmt.string ppf "blob"
+  | Tag -> Fmt.string ppf "tag"
+  | Ofs_delta -> Fmt.string ppf "ofs-delta"
+  | Ref_delta -> Fmt.string ppf "ref-delta"
+
+type header = { version : int; count : int }
+(** Pack file header. *)
+
+let pp_header ppf h =
+  Fmt.pf ppf "{ version = %d; count = %d }" h.version h.count
+
+type entry_header = {
+  obj_type : obj_type;
+  size : int;  (** Uncompressed size *)
+}
+(** Entry header in pack file. *)
+
+(** {1 Reading pack files} *)
+
+(** Read big-endian 32-bit integer from string at offset. *)
+let int32_be s off =
+  let b0 = Char.code s.[off] in
+  let b1 = Char.code s.[off + 1] in
+  let b2 = Char.code s.[off + 2] in
+  let b3 = Char.code s.[off + 3] in
+  (b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3
+
+(** {1 Zlib decompression using bytesrw.zlib}
+
+    We use bytesrw.zlib with [~leftover:true] to handle concatenated zlib
+    streams in pack files. This positions the reader after each stream ends. *)
+
+(** Create a reader that serves bytes from [data] starting at [first]. Uses
+    {!Bytes.unsafe_of_string} to avoid copying the string. *)
+let reader_of_string_at ~first data =
+  let bytes = Bytes.unsafe_of_string data in
+  let length = String.length data - first in
+  let pos = ref 0 in
+  let slice_length = min length (64 * 1024) in
+  let read () =
+    if !pos >= length then Slice.eod
+    else
+      let len = min slice_length (length - !pos) in
+      let s = Slice.make bytes ~first:(first + !pos) ~length:len in
+      pos := !pos + len;
+      s
+  in
+  Reader.make ~slice_length read
+
+(** Shared buffer for decompression output. Avoids allocating a new {!Buffer.t}
+    per inflate call -- [Buffer.clear] resets the length without freeing the
+    backing storage, so after the first large decompression the buffer never
+    reallocates. *)
+let inflate_buf = Buffer.create (64 * 1024)
+
+(** Decompress zlib-compressed data starting at [first] in [data]. Returns
+    (decompressed_data, bytes_consumed). Zero-copy on input: reads directly from
+    the string via {!reader_of_string_at}. Reuses a shared output buffer to
+    avoid per-call allocation. *)
+let inflate_with_consumed ?(first = 0) data =
+  try
+    let base_reader = reader_of_string_at ~first data in
+    let decompressed =
+      Bytesrw_zlib.Zlib.decompress_reads ~leftover:true () base_reader
+    in
+    Buffer.clear inflate_buf;
+    Reader.add_to_buffer inflate_buf decompressed;
+    let output = Buffer.contents inflate_buf in
+    Ok (output, Reader.pos base_reader)
+  with exn ->
+    Error
+      (`Msg (Fmt.str "zlib decompression error: %s" (Printexc.to_string exn)))
+
+(** Decompress zlib-compressed data starting at [first] in [data]. *)
+let inflate ?first data =
+  match inflate_with_consumed ?first data with
+  | Ok (output, _consumed) -> Ok output
+  | Error e -> Error e
+
+(** {1 Delta decoding}
+
+    Delta format:
+    - Source size (varint)
+    - Target size (varint)
+    - Commands: COPY or INSERT *)
+
+(** Read a variable-length integer from a string at given offset. Returns
+    (value, new_offset). *)
+let read_varint_from_string s off =
+  let rec loop value shift off =
+    if off >= String.length s then (value, off)
+    else
+      let b = Char.code s.[off] in
+      let value = value lor ((b land 0x7F) lsl shift) in
+      if b land 0x80 = 0 then (value, off + 1)
+      else loop value (shift + 7) (off + 1)
+  in
+  loop 0 0 off
+
+(** Parse copy offset from delta command byte and data. Returns (offset,
+    next_pos). *)
+let parse_copy_offset delta cmd off =
+  let read_if mask shift off acc =
+    if cmd land mask <> 0 then
+      (acc lor (Char.code delta.[off] lsl shift), off + 1)
+    else (acc, off)
+  in
+  let offset, off = read_if 0x01 0 off 0 in
+  let offset, off = read_if 0x02 8 off offset in
+  let offset, off = read_if 0x04 16 off offset in
+  let offset, off = read_if 0x08 24 off offset in
+  (offset, off)
+
+(** Parse copy size from delta command byte and data. Returns (size, next_pos).
+*)
+let parse_copy_size delta cmd off =
+  let read_if mask shift off acc =
+    if cmd land mask <> 0 then
+      (acc lor (Char.code delta.[off] lsl shift), off + 1)
+    else (acc, off)
+  in
+  let size, off = read_if 0x10 0 off 0 in
+  let size, off = read_if 0x20 8 off size in
+  let size, off = read_if 0x40 16 off size in
+  (* Size of 0 means 0x10000 *)
+  let size = if size = 0 then 0x10000 else size in
+  (size, off)
+
+(** Apply delta to source to produce target. *)
+let apply_delta ~source ~delta =
+  let delta_len = String.length delta in
+  if delta_len < 2 then Error (`Msg "Delta too short")
+  else
+    let source_size, off = read_varint_from_string delta 0 in
+    if source_size <> String.length source then
+      Error
+        (`Msg
+           (Fmt.str "Delta source size mismatch: expected %d, got %d"
+              source_size (String.length source)))
+    else
+      let target_size, off = read_varint_from_string delta off in
+      let target = Buffer.create target_size in
+      let rec apply off =
+        if off >= delta_len then
+          if Buffer.length target = target_size then Ok (Buffer.contents target)
+          else
+            Error
+              (`Msg
+                 (Fmt.str "Delta target size mismatch: expected %d, got %d"
+                    target_size (Buffer.length target)))
+        else
+          let cmd = Char.code delta.[off] in
+          if cmd = 0 then Error (`Msg "Invalid delta command: 0")
+          else if cmd land 0x80 <> 0 then begin
+            (* COPY command *)
+            let copy_offset, off = parse_copy_offset delta cmd (off + 1) in
+            let copy_size, off = parse_copy_size delta cmd off in
+            Buffer.add_substring target source copy_offset copy_size;
+            apply off
+          end
+          else begin
+            (* INSERT command - cmd is the number of literal bytes *)
+            Buffer.add_substring target delta (off + 1) cmd;
+            apply (off + 1 + cmd)
+          end
+      in
+      apply off
+
+(** Object kind (base types only). *)
+let kind_of_obj_type = function
+  | Commit -> `Commit
+  | Tree -> `Tree
+  | Blob -> `Blob
+  | Tag -> `Tag
+  | Ofs_delta | Ref_delta -> assert false (* Not base types *)
+
+(** {1 Pack reading with random access} *)
+
+type t = {
+  header : header;
+  data : string;  (** Full pack file data for random access *)
+}
+(** A pack file opened for reading. *)
+
+(** Open a pack file from a string. *)
+let of_string data =
+  if String.length data < 12 then Error (`Msg "Pack file too short")
+  else
+    let magic = String.sub data 0 4 in
+    if magic <> "PACK" then Error (`Msg "Invalid pack file: bad magic")
+    else
+      let version = int32_be data 4 in
+      if version <> 2 && version <> 3 then err_unsupported_version version
+      else
+        let count = int32_be data 8 in
+        Ok { header = { version; count }; data }
+
+(** Read entry header at given offset. Returns (header, data_offset). *)
+let read_entry_header_at t offset =
+  let open Result.Syntax in
+  if offset >= String.length t.data then Error (`Msg "Offset beyond pack file")
+  else
+    let first = Char.code t.data.[offset] in
+    let type_bits = (first lsr 4) land 0x07 in
+    let* obj_type = obj_type_of_int type_bits in
+    let size = first land 0x0F in
+    let continue = first land 0x80 <> 0 in
+    if not continue then Ok ({ obj_type; size }, offset + 1)
+    else
+      let rec loop size shift off =
+        let b = Char.code t.data.[off] in
+        let size = size lor ((b land 0x7F) lsl shift) in
+        if b land 0x80 = 0 then Ok (size, off + 1)
+        else loop size (shift + 7) (off + 1)
+      in
+      let* size, data_off = loop size 4 (offset + 1) in
+      Ok ({ obj_type; size }, data_off)
+
+(** Read OFS_DELTA offset at given position. Returns (offset, next_pos). *)
+let read_ofs_offset_at t pos =
+  let first = Char.code t.data.[pos] in
+  let offset = first land 0x7F in
+  if first land 0x80 = 0 then (offset, pos + 1)
+  else
+    let rec loop offset pos =
+      let b = Char.code t.data.[pos] in
+      let offset = ((offset + 1) lsl 7) lor (b land 0x7F) in
+      if b land 0x80 = 0 then (offset, pos + 1) else loop offset (pos + 1)
+    in
+    loop offset (pos + 1)
+
+(** Find the base type by following delta chain. *)
+let rec base_type t off =
+  let open Result.Syntax in
+  let* h, doff = read_entry_header_at t off in
+  match h.obj_type with
+  | Commit | Tree | Blob | Tag -> Ok (kind_of_obj_type h.obj_type)
+  | Ofs_delta ->
+      let rel, _ = read_ofs_offset_at t doff in
+      base_type t (off - rel)
+  | Ref_delta -> Error (`Msg "REF_DELTA in delta chain not supported yet")
+
+(** Read an object at the given offset, resolving deltas. Returns (kind, data).
+*)
+let rec read_object_at t offset =
+  let open Result.Syntax in
+  let* header, data_off = read_entry_header_at t offset in
+  match header.obj_type with
+  | Commit | Tree | Blob | Tag ->
+      let* data = inflate ~first:data_off t.data in
+      Ok (kind_of_obj_type header.obj_type, data)
+  | Ofs_delta ->
+      let rel_offset, delta_off = read_ofs_offset_at t data_off in
+      let source_offset = offset - rel_offset in
+      let* _kind, source = read_object_at t source_offset in
+      let* delta = inflate ~first:delta_off t.data in
+      let* target = apply_delta ~source ~delta in
+      let* kind = base_type t source_offset in
+      Ok (kind, target)
+  | Ref_delta ->
+      (* REF_DELTA requires an index to resolve *)
+      Error (`Msg "REF_DELTA requires pack index for resolution")
+
+(** Read an object at the given offset, also returning the offset of the next
+    entry. This avoids re-decompressing just to find the next position. *)
+let read_object_at_with_next t offset =
+  let open Result.Syntax in
+  let* header, data_off = read_entry_header_at t offset in
+  match header.obj_type with
+  | Commit | Tree | Blob | Tag ->
+      let* data, consumed = inflate_with_consumed ~first:data_off t.data in
+      Ok (kind_of_obj_type header.obj_type, data, data_off + consumed)
+  | Ofs_delta ->
+      let rel_offset, delta_off = read_ofs_offset_at t data_off in
+      let source_offset = offset - rel_offset in
+      let* _kind, source = read_object_at t source_offset in
+      let* delta, consumed = inflate_with_consumed ~first:delta_off t.data in
+      let* target = apply_delta ~source ~delta in
+      let* kind = base_type t source_offset in
+      Ok (kind, target, delta_off + consumed)
+  | Ref_delta ->
+      (* REF_DELTA requires an index to resolve *)
+      Error (`Msg "REF_DELTA requires pack index for resolution")
+
+(** Get the number of objects in the pack. *)
+let count t = t.header.count
+
+(** Get the pack version. *)
+let version t = t.header.version
+
+(** {1 Iterating over pack entries} *)
+
+type 'a entry_handler =
+  offset:int ->
+  kind:[ `Commit | `Tree | `Blob | `Tag ] ->
+  data:string ->
+  'a ->
+  'a
+(** Callback type for pack iteration. *)
+
+(** Iterate over all objects in a pack file. Each object is decompressed exactly
+    once; the next entry offset is tracked during decompression. *)
+let fold f acc t =
+  let rec loop acc offset n =
+    if n >= t.header.count then Ok acc
+    else
+      match read_object_at_with_next t offset with
+      | Error e -> Error e
+      | Ok (kind, data, next_offset) ->
+          let acc = f ~offset ~kind ~data acc in
+          loop acc next_offset (n + 1)
+  in
+  loop acc 12 0 (* Start after 12-byte header *)

lib/pack.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git pack file support.
+
+    Pack files store multiple git objects in a compressed format with delta
+    encoding for efficient storage.
+
+    {2 Pack file format}
+
+    A pack file consists of:
+    - Header: "PACK" magic (4 bytes) + version (4 bytes) + object count (4
+      bytes)
+    - Objects: Variable-length entries, each with type/size header and
+      zlib-compressed data
+    - Footer: SHA-1 checksum of the entire file (20 bytes)
+
+    Objects can be stored as:
+    - Base objects: Full zlib-compressed content (commit, tree, blob, tag)
+    - Delta objects: Patches relative to other objects (OFS_DELTA, REF_DELTA) *)
+
+(** {1 Types} *)
+
+(** Object types in pack files. *)
+type obj_type =
+  | Commit
+  | Tree
+  | Blob
+  | Tag
+  | Ofs_delta  (** Delta relative to offset in same pack *)
+  | Ref_delta  (** Delta relative to object by hash *)
+
+val obj_type_of_int : int -> (obj_type, [ `Msg of string ]) result
+
+val obj_type_to_int : obj_type -> int
+(** [obj_type_to_int t] converts the object type [t] to its pack file integer
+    representation (e.g. [Commit] is [1], [Tree] is [2], [Blob] is [3], [Tag] is
+    [4], [Ofs_delta] is [6], [Ref_delta] is [7]). *)
+
+val pp_obj_type : obj_type Fmt.t
+(** [pp_obj_type] is a pretty-printer for {!type-obj_type} values, printing
+    lowercase names such as ["commit"], ["tree"], ["blob"], ["tag"],
+    ["ofs-delta"], and ["ref-delta"]. *)
+
+type header = { version : int; count : int }
+(** Pack file header. *)
+
+val pp_header : header Fmt.t
+
+type entry_header = {
+  obj_type : obj_type;
+  size : int;  (** Uncompressed size *)
+}
+(** Entry header in pack file. *)
+
+(** {1 Pack file operations} *)
+
+type t
+(** A pack file opened for reading. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Open a pack file from a string containing the full pack data. *)
+
+val count : t -> int
+(** Get the number of objects in the pack. *)
+
+val version : t -> int
+(** Get the pack version (2 or 3). *)
+
+val read_object_at :
+  t ->
+  int ->
+  ([ `Commit | `Tree | `Blob | `Tag ] * string, [ `Msg of string ]) result
+(** Read an object at the given byte offset, resolving delta chains. Returns the
+    object kind and uncompressed data. *)
+
+(** {1 Iteration} *)
+
+type 'a entry_handler =
+  offset:int ->
+  kind:[ `Commit | `Tree | `Blob | `Tag ] ->
+  data:string ->
+  'a ->
+  'a
+(** Callback for iterating over pack entries. *)
+
+val fold : 'a entry_handler -> 'a -> t -> ('a, [ `Msg of string ]) result
+(** Iterate over all objects in the pack file. *)
+
+(** {1 Delta operations} *)
+
+val apply_delta :
+  source:string -> delta:string -> (string, [ `Msg of string ]) result
+(** Apply a delta patch to a source object to produce the target object. The
+    delta format consists of:
+    - Source size (varint)
+    - Target size (varint)
+    - Commands: COPY (from source) or INSERT (literal bytes) *)
+
+(** {1 Low-level operations} *)
+
+val inflate : ?first:int -> string -> (string, [ `Msg of string ]) result
+(** [inflate ?first s] decompresses zlib-compressed data starting at offset
+    [first] (default [0]). Uses a zero-copy slice view to avoid copying the
+    string tail. *)
+
+val read_entry_header_at :
+  t -> int -> (entry_header * int, [ `Msg of string ]) result
+(** Read entry header at offset. Returns (header, data_offset). *)

lib/pack_index.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git pack index (.idx) file support.
+
+    Pack index files provide fast lookup of objects in pack files by their hash.
+    This module supports version 2 of the pack index format. *)
+
+(** {1 Pack index format (version 2)}
+
+    - Header: 4-byte magic (0xff 't' 'O' 'c') + 4-byte version (2)
+    - Fan-out table: 256 × 4-byte cumulative counts
+    - Object hashes: N × 20-byte SHA-1 hashes (sorted)
+    - CRC32 values: N × 4-byte CRCs
+    - Pack offsets: N × 4-byte offsets (MSB=1 means use large offset table)
+    - Large offsets: 8-byte offsets for objects at positions >= 2^31
+    - Pack checksum: 20 bytes
+    - Index checksum: 20 bytes *)
+
+type t = {
+  count : int;  (** Number of objects in the pack *)
+  fanout : int array;  (** Fan-out table (256 entries) *)
+  hashes : string;  (** Raw hash data (count * 20 bytes) *)
+  crcs : string;  (** CRC32 data (count * 4 bytes) *)
+  offsets : string;  (** Offset data (count * 4 bytes) *)
+  large_offsets : string;  (** Large offset table *)
+  pack_checksum : Hash.t;  (** Checksum of the pack file *)
+  index_checksum : Hash.t;  (** Checksum of the index file *)
+}
+(** A parsed pack index. *)
+
+let err_unsupported_version v =
+  Error (`Msg (Fmt.str "Unsupported pack index version: %d" v))
+
+(** Read big-endian 32-bit integer from string at offset. *)
+let int32_be s off =
+  let b0 = Char.code s.[off] in
+  let b1 = Char.code s.[off + 1] in
+  let b2 = Char.code s.[off + 2] in
+  let b3 = Char.code s.[off + 3] in
+  (b0 lsl 24) lor (b1 lsl 16) lor (b2 lsl 8) lor b3
+
+(** Read big-endian 64-bit integer from string at offset. *)
+let int64_be s off =
+  let b0 = Int64.of_int (Char.code s.[off]) in
+  let b1 = Int64.of_int (Char.code s.[off + 1]) in
+  let b2 = Int64.of_int (Char.code s.[off + 2]) in
+  let b3 = Int64.of_int (Char.code s.[off + 3]) in
+  let b4 = Int64.of_int (Char.code s.[off + 4]) in
+  let b5 = Int64.of_int (Char.code s.[off + 5]) in
+  let b6 = Int64.of_int (Char.code s.[off + 6]) in
+  let b7 = Int64.of_int (Char.code s.[off + 7]) in
+  Int64.(
+    logor (shift_left b0 56)
+      (logor (shift_left b1 48)
+         (logor (shift_left b2 40)
+            (logor (shift_left b3 32)
+               (logor (shift_left b4 24)
+                  (logor (shift_left b5 16) (logor (shift_left b6 8) b7)))))))
+
+let magic = "\xff\x74\x4f\x63"
+
+(** Read fan-out table from pack index data. *)
+let read_fanout data =
+  let fanout = Array.make 256 0 in
+  for i = 0 to 255 do
+    fanout.(i) <- int32_be data (8 + (i * 4))
+  done;
+  fanout
+
+(** Extract pack index sections from data. *)
+let extract_sections data len count =
+  let hashes_off = 8 + 1024 in
+  let crcs_off = hashes_off + (count * 20) in
+  let offsets_off = crcs_off + (count * 4) in
+  let large_off = offsets_off + (count * 4) in
+  let pack_checksum_off = len - 40 in
+  let min_size = large_off + 40 in
+  if len < min_size then Error (`Msg "Pack index file truncated")
+  else
+    Ok
+      ( String.sub data hashes_off (count * 20),
+        String.sub data crcs_off (count * 4),
+        String.sub data offsets_off (count * 4),
+        String.sub data large_off (pack_checksum_off - large_off),
+        Hash.of_raw_string (String.sub data pack_checksum_off 20),
+        Hash.of_raw_string (String.sub data (len - 20) 20) )
+
+(** Parse a pack index from a string. *)
+let of_string data =
+  let len = String.length data in
+  if len < 1072 then Error (`Msg "Pack index file too short")
+  else if String.sub data 0 4 <> magic then
+    Error (`Msg "Invalid pack index: bad magic")
+  else
+    let version = int32_be data 4 in
+    if version <> 2 then err_unsupported_version version
+    else
+      let fanout = read_fanout data in
+      let count = fanout.(255) in
+      match extract_sections data len count with
+      | Error e -> Error e
+      | Ok (hashes, crcs, offsets, large_offsets, pack_checksum, index_checksum)
+        ->
+          Ok
+            {
+              count;
+              fanout;
+              hashes;
+              crcs;
+              offsets;
+              large_offsets;
+              pack_checksum;
+              index_checksum;
+            }
+
+(** Get the number of objects in the index. *)
+let count t = t.count
+
+(** Get the hash at the given index (0-based). *)
+let hash_at t i =
+  if i < 0 || i >= t.count then invalid_arg "Pack_index.hash_at: out of bounds";
+  Hash.of_raw_string (String.sub t.hashes (i * 20) 20)
+
+(** Get the CRC32 at the given index. *)
+let crc_at t i =
+  if i < 0 || i >= t.count then invalid_arg "Pack_index.crc_at: out of bounds";
+  int32_be t.crcs (i * 4)
+
+(** Get the pack file offset for the object at the given index. *)
+let offset_at t i =
+  if i < 0 || i >= t.count then
+    invalid_arg "Pack_index.offset_at: out of bounds";
+  let off = int32_be t.offsets (i * 4) in
+  if off land 0x80000000 <> 0 then begin
+    (* MSB set: look up in large offset table *)
+    let large_idx = off land 0x7FFFFFFF in
+    Int64.to_int (int64_be t.large_offsets (large_idx * 8))
+  end
+  else off
+
+(** Find the index of an object by its hash using binary search. Returns None if
+    not found. *)
+let index t hash =
+  let hash_raw = Hash.to_raw_string hash in
+  let first_byte = Char.code hash_raw.[0] in
+  (* Use fan-out to narrow search range *)
+  let lo = if first_byte = 0 then 0 else t.fanout.(first_byte - 1) in
+  let hi = t.fanout.(first_byte) - 1 in
+  (* Binary search within range *)
+  let rec search lo hi =
+    if lo > hi then None
+    else
+      let mid = lo + ((hi - lo) / 2) in
+      let mid_hash = String.sub t.hashes (mid * 20) 20 in
+      let cmp = String.compare hash_raw mid_hash in
+      if cmp = 0 then Some mid
+      else if cmp < 0 then search lo (mid - 1)
+      else search (mid + 1) hi
+  in
+  search lo hi
+
+(** Find the pack file offset for an object by its hash. Returns None if not
+    found. *)
+let find t hash =
+  match index t hash with None -> None | Some i -> Some (offset_at t i)
+
+(** Get the pack file checksum. *)
+let pack_checksum t = t.pack_checksum
+
+(** Get the index file checksum. *)
+let index_checksum t = t.index_checksum
+
+(** Iterate over all entries in the index. *)
+let iter f t =
+  for i = 0 to t.count - 1 do
+    let hash = hash_at t i in
+    let offset = offset_at t i in
+    let crc = crc_at t i in
+    f ~hash ~offset ~crc
+  done
+
+(** Fold over all entries in the index. *)
+let fold f acc t =
+  let acc = ref acc in
+  for i = 0 to t.count - 1 do
+    let hash = hash_at t i in
+    let offset = offset_at t i in
+    let crc = crc_at t i in
+    acc := f ~hash ~offset ~crc !acc
+  done;
+  !acc

lib/pack_index.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git pack index (.idx) file support.
+
+    Pack index files provide fast lookup of objects in pack files by their hash.
+    This module supports version 2 of the pack index format. *)
+
+type t
+(** A parsed pack index. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse a pack index from a string. *)
+
+val count : t -> int
+(** Get the number of objects in the index. *)
+
+val hash_at : t -> int -> Hash.t
+(** [hash_at t i] returns the hash at index [i] (0-based).
+    @raise Invalid_argument if [i] is out of bounds. *)
+
+val crc_at : t -> int -> int
+(** [crc_at t i] returns the CRC32 at index [i].
+    @raise Invalid_argument if [i] is out of bounds. *)
+
+val offset_at : t -> int -> int
+(** [offset_at t i] returns the pack file offset for index [i].
+    @raise Invalid_argument if [i] is out of bounds. *)
+
+val index : t -> Hash.t -> int option
+(** [index t hash] finds the index of an object by its hash using binary search.
+    Returns [None] if not found. *)
+
+val find : t -> Hash.t -> int option
+(** [find t hash] finds the pack file offset for an object by its hash. Returns
+    [None] if not found. *)
+
+val pack_checksum : t -> Hash.t
+(** Get the pack file checksum stored in the index. *)
+
+val index_checksum : t -> Hash.t
+(** Get the index file checksum. *)
+
+val iter : (hash:Hash.t -> offset:int -> crc:int -> unit) -> t -> unit
+(** Iterate over all entries in the index. *)
+
+val fold : (hash:Hash.t -> offset:int -> crc:int -> 'a -> 'a) -> 'a -> t -> 'a
+(** Fold over all entries in the index. *)

lib/reference.ml

···
+(* Copyright (c) 2015 Daniel C. Bünzli
+   Copyright (c) 2020-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git references (branches, tags, HEAD). *)
+
+type t = string
+
+let head = "HEAD"
+let master = "refs/heads/master"
+let main = "refs/heads/main"
+
+let of_string s =
+  if String.length s = 0 then Error (`Msg "Empty reference")
+  else if String.contains s '\x00' then
+    Error (`Msg "Reference contains null byte")
+  else if s.[0] = '/' then Error (`Msg "Absolute reference not allowed")
+  else
+    (* Collapse consecutive slashes *)
+    let buf = Buffer.create (String.length s) in
+    let last_was_slash = ref false in
+    String.iter
+      (fun c ->
+        if c = '/' then (
+          if not !last_was_slash then Buffer.add_char buf c;
+          last_was_slash := true)
+        else (
+          Buffer.add_char buf c;
+          last_was_slash := false))
+      s;
+    Ok (Buffer.contents buf)
+
+let of_string_exn s =
+  match of_string s with Ok r -> r | Error (`Msg m) -> invalid_arg m
+
+let v = of_string_exn
+let to_string t = t
+let pp ppf t = Fmt.string ppf t
+let equal = String.equal
+let compare = String.compare
+let hash = Hashtbl.hash
+
+let segs t =
+  String.split_on_char '/' t |> List.filter (fun s -> String.length s > 0)
+
+let ( / ) t seg =
+  if String.contains seg '\x00' || String.contains seg '/' then
+    invalid_arg "Invalid segment";
+  if t.[String.length t - 1] = '/' then t ^ seg else t ^ "/" ^ seg
+
+let ( // ) t1 t2 =
+  if t2.[0] = '/' then t2
+  else if t1.[String.length t1 - 1] = '/' then t1 ^ t2
+  else t1 ^ "/" ^ t2
+
+(** Reference contents: either a direct hash or a symbolic reference. *)
+type contents = Hash of Hash.t | Ref of t
+
+let contents_equal a b =
+  match (a, b) with
+  | Hash a, Hash b -> Hash.equal a b
+  | Ref a, Ref b -> equal a b
+  | _ -> false
+
+let contents_compare a b =
+  match (a, b) with
+  | Hash a, Hash b -> Hash.compare a b
+  | Ref a, Ref b -> compare a b
+  | Hash _, Ref _ -> -1
+  | Ref _, Hash _ -> 1
+
+let pp_contents ppf = function
+  | Hash h -> Hash.pp ppf h
+  | Ref r -> Fmt.pf ppf "ref: %s" r
+
+(** Parse reference file contents. *)
+let contents_of_string s =
+  let s = String.trim s in
+  if String.length s = 0 then Error (`Msg "Empty reference contents")
+  else if String.length s >= 5 && String.sub s 0 5 = "ref: " then
+    let ref_path = String.sub s 5 (String.length s - 5) in
+    Result.map (fun r -> Ref r) (of_string ref_path)
+  else
+    (* Try to parse as a hex hash *)
+    try Ok (Hash (Hash.of_hex s))
+    with Invalid_argument _ ->
+      Error (`Msg ("Invalid reference contents: " ^ s))
+
+let contents_of_string_exn s =
+  match contents_of_string s with Ok c -> c | Error (`Msg m) -> failwith m
+
+(** Encode reference contents. *)
+let contents_to_string = function
+  | Hash h -> Hash.to_hex h ^ "\n"
+  | Ref r -> "ref: " ^ r ^ "\n"
+
+module Set = Set.Make (String)
+module Map = Map.Make (String)

lib/reference.mli

···
+(* Copyright (c) 2015 Daniel C. Bünzli
+   Copyright (c) 2020-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git references (branches, tags, HEAD). *)
+
+type t
+(** The type of references. *)
+
+val head : t
+(** The HEAD reference. *)
+
+val master : t
+(** The refs/heads/master reference. *)
+
+val main : t
+(** The refs/heads/main reference. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse a reference from a string. *)
+
+val of_string_exn : string -> t
+(** [of_string_exn s] is like {!of_string} but raises on error. *)
+
+val v : string -> t
+(** [v s] is an alias for {!of_string_exn}. *)
+
+val to_string : t -> string
+(** Convert a reference to a string. *)
+
+val pp : t Fmt.t
+(** Pretty-print a reference. *)
+
+val equal : t -> t -> bool
+(** Equality on references. *)
+
+val compare : t -> t -> int
+(** Total ordering on references. *)
+
+val hash : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val segs : t -> string list
+(** Split a reference into path segments. *)
+
+val ( / ) : t -> string -> t
+(** [t / seg] appends a segment to a reference.
+    @raise Invalid_argument if segment contains null or slash. *)
+
+val ( // ) : t -> t -> t
+(** [t1 // t2] appends two references. *)
+
+(** {1 Reference contents} *)
+
+type contents =
+  | Hash of Hash.t
+  | Ref of t
+      (** Reference contents: either a direct hash or a symbolic reference. *)
+
+val contents_equal : contents -> contents -> bool
+(** Equality on reference contents. *)
+
+val contents_compare : contents -> contents -> int
+(** Total ordering on reference contents. *)
+
+val pp_contents : contents Fmt.t
+(** Pretty-print reference contents. *)
+
+val contents_of_string : string -> (contents, [ `Msg of string ]) result
+(** Parse reference file contents. *)
+
+val contents_of_string_exn : string -> contents
+(** [contents_of_string_exn s] is like {!contents_of_string} but raises on
+    error. *)
+
+val contents_to_string : contents -> string
+(** Encode reference contents for writing to file. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/remote.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git smart HTTP protocol implementation for remote queries.
+
+    This implements the git smart HTTP protocol for lightweight remote
+    operations like ls-remote without cloning or fetching.
+
+    Reference: https://git-scm.com/docs/http-protocol *)
+
+type ref_entry = { ref_name : string; hash : Hash.t }
+
+(* Parse a pkt-line length (4 hex digits) *)
+let parse_pkt_len s offset =
+  if offset + 4 > String.length s then None
+  else
+    let hex = String.sub s offset 4 in
+    try Some (int_of_string ("0x" ^ hex)) with Failure _ -> None
+
+(* Parse pkt-line formatted data.
+   Format: 4 hex digits length + content, or "0000" for flush packet *)
+let parse_pkt_lines data =
+  let len = String.length data in
+  let rec parse acc offset =
+    if offset >= len then List.rev acc
+    else
+      match parse_pkt_len data offset with
+      | None -> List.rev acc
+      | Some 0 -> parse acc (offset + 4) (* flush packet *)
+      | Some pkt_len when pkt_len <= 4 -> List.rev acc
+      | Some pkt_len ->
+          let content_len = pkt_len - 4 in
+          if offset + 4 + content_len > len then List.rev acc
+          else
+            let content = String.sub data (offset + 4) content_len in
+            (* Strip trailing newline if present *)
+            let content =
+              if
+                String.length content > 0
+                && content.[String.length content - 1] = '\n'
+              then String.sub content 0 (String.length content - 1)
+              else content
+            in
+            parse (content :: acc) (offset + pkt_len)
+  in
+  parse [] 0
+
+(* Parse a ref line: "sha1 refname\0capabilities" or "sha1 refname" *)
+let parse_ref_line line =
+  (* Skip service announcement lines *)
+  if String.length line = 0 || line.[0] = '#' then None
+  else
+    (* Split on space to get hash and ref *)
+    match String.index_opt line ' ' with
+    | None -> None
+    | Some i ->
+        let hash_str = String.sub line 0 i in
+        let rest = String.sub line (i + 1) (String.length line - i - 1) in
+        (* Strip capabilities after NUL if present *)
+        let ref_name =
+          match String.index_opt rest '\x00' with
+          | Some j -> String.sub rest 0 j
+          | None -> rest
+        in
+        if String.length hash_str = 40 then
+          try Some { ref_name; hash = Hash.of_hex hash_str }
+          with Invalid_argument _ -> None
+        else None
+
+let git_headers =
+  Requests.Headers.empty
+  |> Requests.Headers.set_string "User-Agent" "ocaml-git/4.0"
+  |> Requests.Headers.set_string "Accept"
+       "application/x-git-upload-pack-advertisement"
+
+let normalize_url url =
+  let s = Uri.to_string url in
+  if String.length s > 0 && s.[String.length s - 1] = '/' then
+    String.sub s 0 (String.length s - 1)
+  else s
+
+(** Query remote refs using git smart HTTP protocol. Pass an existing [session]
+    to reuse TLS connection and avoid cert reload. *)
+let ls_remote ?session ~sw ~env url =
+  let url_str = normalize_url url in
+  let info_refs_url = url_str ^ "/info/refs?service=git-upload-pack" in
+  try
+    let session =
+      match session with Some s -> s | None -> Requests.v ~sw env
+    in
+    let resp = Requests.get session ~headers:git_headers info_refs_url in
+    if not (Requests.Response.ok resp) then None
+    else
+      let body = Requests.Response.text resp in
+      let lines = parse_pkt_lines body in
+      let refs = List.filter_map parse_ref_line lines in
+      Some refs
+  with Eio.Io _ | Failure _ -> None
+
+(** Get the HEAD ref for a specific branch. Pass an existing [session] to reuse
+    TLS connection. *)
+let head ?session ~sw ~env url ~branch =
+  match ls_remote ?session ~sw ~env url with
+  | None -> None
+  | Some refs ->
+      let ref_name = "refs/heads/" ^ branch in
+      List.find_map
+        (fun r -> if r.ref_name = ref_name then Some r.hash else None)
+        refs
+
+(** Check if a remote ref matches a local hash. Pass an existing [session] to
+    reuse TLS connection. *)
+let matches_local ?session ~sw ~env url ~branch ~local_hash =
+  match head ?session ~sw ~env url ~branch with
+  | None -> false
+  | Some remote_hash -> Hash.equal remote_hash local_hash

lib/remote.mli

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git smart HTTP protocol for remote queries.
+
+    This module implements lightweight remote queries using the git smart HTTP
+    protocol, avoiding the need to clone or fetch to check remote refs.
+
+    Reference: {{:https://git-scm.com/docs/http-protocol}Git HTTP Protocol}
+
+    {2 Example}
+
+    {[
+      Eio_main.run @@ fun env ->
+      Eio.Switch.run @@ fun sw ->
+      let url = Uri.of_string "https://github.com/ocaml/ocaml.git" in
+      match Git.Remote.head ~sw ~env url ~branch:"trunk" with
+      | Some hash -> Format.printf "HEAD: %a@." Git.Hash.pp hash
+      | None -> Format.printf "Branch not found or remote unreachable@."
+    ]} *)
+
+type ref_entry = {
+  ref_name : string;  (** Full ref name (e.g., "refs/heads/main") *)
+  hash : Hash.t;  (** Commit hash the ref points to *)
+}
+(** A remote reference entry. *)
+
+val ls_remote :
+  ?session:Requests.t ->
+  sw:Eio.Switch.t ->
+  env:
+    < clock : _ Eio.Time.clock
+    ; net : _ Eio.Net.t
+    ; fs : Eio.Fs.dir_ty Eio.Path.t
+    ; .. > ->
+  Uri.t ->
+  ref_entry list option
+(** [ls_remote ?session ~sw ~env url] queries the remote for all refs.
+
+    Returns [Some refs] where [refs] is a list of ref entries, or [None] if the
+    query failed (network error, invalid URL, etc.).
+
+    Pass an existing [session] to reuse TLS connection and avoid reloading CA
+    certificates (which can be slow on macOS).
+
+    This uses the git smart HTTP protocol to query the remote without
+    downloading any objects, making it very fast for checking if updates are
+    available. *)
+
+val head :
+  ?session:Requests.t ->
+  sw:Eio.Switch.t ->
+  env:
+    < clock : _ Eio.Time.clock
+    ; net : _ Eio.Net.t
+    ; fs : Eio.Fs.dir_ty Eio.Path.t
+    ; .. > ->
+  Uri.t ->
+  branch:string ->
+  Hash.t option
+(** [head ?session ~sw ~env url ~branch] returns the commit hash of the
+    specified branch on the remote.
+
+    Returns [None] if the branch doesn't exist or the remote is unreachable.
+
+    Pass an existing [session] to reuse TLS connection and avoid reloading CA
+    certificates.
+
+    This is much faster than [git fetch] as it only queries ref information
+    without downloading any objects. *)
+
+val matches_local :
+  ?session:Requests.t ->
+  sw:Eio.Switch.t ->
+  env:
+    < clock : _ Eio.Time.clock
+    ; net : _ Eio.Net.t
+    ; fs : Eio.Fs.dir_ty Eio.Path.t
+    ; .. > ->
+  Uri.t ->
+  branch:string ->
+  local_hash:Hash.t ->
+  bool
+(** [matches_local ?session ~sw ~env url ~branch ~local_hash] returns [true] if
+    the remote branch points to the same commit as [local_hash].
+
+    Returns [false] if the remote is unreachable or the hashes differ.
+
+    Pass an existing [session] to reuse TLS connection and avoid reloading CA
+    certificates.
+
+    This is useful to determine if a fetch is needed - if the remote matches the
+    local tracking branch, no fetch is necessary. *)

lib/repository.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git repository access.
+
+    High-level operations on Git repositories, handling both loose objects and
+    pack files transparently. *)
+
+module Reader = Bytesrw.Bytes.Reader
+
+(** {1 Zlib compression for loose objects} *)
+
+let zlib_compress data =
+  let reader = Reader.of_string data in
+  let compressed = Bytesrw_zlib.Zlib.compress_reads () reader in
+  Reader.to_string compressed
+
+(** {1 Pack file cache} *)
+
+type pack_entry = { pack : Pack.t; index : Pack_index.t }
+
+(** {1 Repository type} *)
+
+type t = {
+  fs : Eio.Fs.dir_ty Eio.Path.t;
+  git_dir : string;
+  packs : pack_entry list Lazy.t;
+}
+
+let pp ppf t = Fmt.pf ppf "<git-repo %s>" t.git_dir
+
+let err_branch_not_found name =
+  Error (`Msg (Fmt.str "branch %s does not exist" name))
+
+let err_unresolved_ref r = Error (`Msg (Fmt.str "cannot resolve ref: %s" r))
+
+let err_remote_exists name =
+  Error (`Msg (Fmt.str "remote %s already exists" name))
+
+let err_remote_not_found name =
+  Error (`Msg (Fmt.str "remote %s does not exist" name))
+
+let err_ref_not_found r = Error (`Msg (Fmt.str "ref %s not found" r))
+
+let err_prefix_not_found p =
+  Error (`Msg (Fmt.str "prefix %s not found in tree" p))
+
+(** {1 Path helpers} *)
+
+let loose_object_path git_dir hash =
+  let hex = Hash.to_hex hash in
+  let dir = String.sub hex 0 2 in
+  let file = String.sub hex 2 (String.length hex - 2) in
+  Filename.concat git_dir (Filename.concat "objects" (Filename.concat dir file))
+
+let pack_dir git_dir = Filename.concat git_dir "objects/pack"
+
+(** {1 Pack loading} *)
+
+let load_packs ~fs git_dir =
+  let dir = pack_dir git_dir in
+  let pack_path = Eio.Path.(fs / dir) in
+  try
+    let entries = Eio.Path.read_dir pack_path in
+    let idx_files =
+      List.filter (fun e -> Filename.check_suffix e ".idx") entries
+    in
+    List.filter_map
+      (fun idx_file ->
+        let pack_file = Filename.chop_suffix idx_file ".idx" ^ ".pack" in
+        try
+          let idx_path = Eio.Path.(pack_path / idx_file) in
+          let pack_file_path = Eio.Path.(pack_path / pack_file) in
+          let idx_data = Eio.Path.load idx_path in
+          let pack_data = Eio.Path.load pack_file_path in
+          match (Pack_index.of_string idx_data, Pack.of_string pack_data) with
+          | Ok index, Ok pack -> Some { pack; index }
+          | _ -> None
+        with Eio.Io _ -> None)
+      idx_files
+  with Eio.Io _ -> []
+
+(** {1 Repository operations} *)
+
+let open_repo ~fs path =
+  let path_str = Fpath.to_string path in
+  let git_dir = Filename.concat path_str ".git" in
+  let packs = lazy (load_packs ~fs:Eio.Path.(fs / "") git_dir) in
+  { fs; git_dir; packs }
+
+let open_bare ~fs path =
+  let path_str = Fpath.to_string path in
+  let packs = lazy (load_packs ~fs:Eio.Path.(fs / "") path_str) in
+  { fs; git_dir = path_str; packs }
+
+(** {1 Object reading} *)
+
+let read_loose t hash =
+  let path = loose_object_path t.git_dir hash in
+  let full_path = Eio.Path.(t.fs / path) in
+  try
+    let compressed = Eio.Path.load full_path in
+    let reader = Reader.of_string compressed in
+    let decompressed = Bytesrw_zlib.Zlib.decompress_reads () reader in
+    Value.read decompressed
+  with Eio.Io _ -> Error (`Msg "object not found")
+
+let read_from_packs packs hash =
+  let rec try_packs = function
+    | [] -> None
+    | entry :: rest -> (
+        match Pack_index.find entry.index hash with
+        | None -> try_packs rest
+        | Some offset -> (
+            match Pack.read_object_at entry.pack offset with
+            | Ok (kind, data) -> Some (kind, data)
+            | Error _ -> try_packs rest))
+  in
+  try_packs packs
+
+let read t hash =
+  match read_loose t hash with
+  | Ok value -> Ok value
+  | Error _ -> (
+      match read_from_packs (Lazy.force t.packs) hash with
+      | Some (kind, data) ->
+          let reader = Reader.of_string data in
+          Value.of_reader ~kind reader
+      | None -> Error (`Msg "object not found"))
+
+let exists t hash =
+  let path = loose_object_path t.git_dir hash in
+  let full_path = Eio.Path.(t.fs / path) in
+  Eio.Path.is_file full_path
+  || Option.is_some (read_from_packs (Lazy.force t.packs) hash)
+
+(** {1 Object writing} *)
+
+let write t value =
+  let hash = Value.digest value in
+  let path = loose_object_path t.git_dir hash in
+  let full_path = Eio.Path.(t.fs / path) in
+  (* Skip if object already exists *)
+  if not (Eio.Path.is_file full_path) then begin
+    (* Create directory if needed *)
+    let dir = Filename.dirname path in
+    let dir_path = Eio.Path.(t.fs / dir) in
+    (try Eio.Path.mkdir ~perm:0o755 dir_path with Eio.Io _ -> ());
+    (* Write compressed object *)
+    let data = Value.to_string value in
+    let compressed = zlib_compress data in
+    Eio.Path.save ~create:(`Or_truncate 0o444) full_path compressed
+  end;
+  hash
+
+let write_blob t data = write t (Value.blob (Blob.of_string data))
+let write_tree t tree = write t (Value.tree tree)
+let write_commit t commit = write t (Value.commit commit)
+let write_tag t tag = write t (Value.tag tag)
+
+(** {1 Reference operations} *)
+
+let read_ref t name =
+  let path = Filename.concat t.git_dir name in
+  let full_path = Eio.Path.(t.fs / path) in
+  try
+    let content = Eio.Path.load full_path in
+    let content = String.trim content in
+    (* Check for symbolic ref *)
+    if String.length content > 5 && String.sub content 0 5 = "ref: " then
+      let target = String.sub content 5 (String.length content - 5) in
+      let target_path = Eio.Path.(t.fs / Filename.concat t.git_dir target) in
+      try
+        let target_content = Eio.Path.load target_path in
+        Some (Hash.of_hex (String.trim target_content))
+      with Eio.Io _ | Invalid_argument _ -> None
+    else Some (Hash.of_hex content)
+  with Eio.Io _ | Invalid_argument _ -> None
+
+let write_ref t name hash =
+  let path = Filename.concat t.git_dir name in
+  let full_path = Eio.Path.(t.fs / path) in
+  let dir = Filename.dirname path in
+  let dir_path = Eio.Path.(t.fs / dir) in
+  (try Eio.Path.mkdir ~perm:0o755 dir_path with Eio.Io _ -> ());
+  let content = Hash.to_hex hash ^ "\n" in
+  Eio.Path.save ~create:(`Or_truncate 0o644) full_path content
+
+let delete_ref t name =
+  let path = Filename.concat t.git_dir name in
+  let full_path = Eio.Path.(t.fs / path) in
+  try Eio.Path.unlink full_path with Eio.Io _ -> ()
+
+let list_refs t =
+  let refs_dir = Filename.concat t.git_dir "refs" in
+  let refs_path = Eio.Path.(t.fs / refs_dir) in
+  let rec collect_refs path prefix acc =
+    try
+      let entries = Eio.Path.read_dir path in
+      List.fold_left
+        (fun acc entry ->
+          let entry_path = Eio.Path.(path / entry) in
+          let ref_name = if prefix = "" then entry else prefix ^ "/" ^ entry in
+          if Eio.Path.is_directory entry_path then
+            collect_refs entry_path ref_name acc
+          else ("refs/" ^ ref_name) :: acc)
+        acc entries
+    with Eio.Io _ -> acc
+  in
+  collect_refs refs_path "" []
+
+(** {1 Repository initialization} *)
+
+let git_dir t = Fpath.v t.git_dir
+let fs t = t.fs
+
+(** {1 Repository queries} *)
+
+let is_repo ~fs path =
+  let path_str = Fpath.to_string path in
+  let git_path = Eio.Path.(fs / path_str / ".git") in
+  try Eio.Path.is_directory git_path with Eio.Io _ -> false
+
+let head t = read_ref t "HEAD"
+
+let current_branch t =
+  let path = Filename.concat t.git_dir "HEAD" in
+  let full_path = Eio.Path.(t.fs / path) in
+  try
+    let content = String.trim (Eio.Path.load full_path) in
+    if
+      String.length content > 16 && String.sub content 0 16 = "ref: refs/heads/"
+    then Some (String.sub content 16 (String.length content - 16))
+    else None (* detached HEAD *)
+  with Eio.Io _ -> None
+
+let rename_branch t ~new_name =
+  match current_branch t with
+  | None -> Error (`Msg "cannot rename branch in detached HEAD state")
+  | Some old_name -> (
+      let old_ref = "refs/heads/" ^ old_name in
+      let new_ref = "refs/heads/" ^ new_name in
+      match read_ref t old_ref with
+      | None -> err_branch_not_found old_name
+      | Some hash ->
+          (* Write the new ref *)
+          write_ref t new_ref hash;
+          (* Delete the old ref *)
+          delete_ref t old_ref;
+          (* Update HEAD to point to new branch *)
+          let head_path = Filename.concat t.git_dir "HEAD" in
+          let full_path = Eio.Path.(t.fs / head_path) in
+          Eio.Path.save ~create:(`Or_truncate 0o644) full_path
+            ("ref: " ^ new_ref ^ "\n");
+          Ok ())
+
+let advance_head t commit_hash =
+  match current_branch t with
+  | Some branch -> write_ref t ("refs/heads/" ^ branch) commit_hash
+  | None ->
+      (* Detached HEAD - update HEAD directly *)
+      let head_path = Filename.concat t.git_dir "HEAD" in
+      let full_path = Eio.Path.(t.fs / head_path) in
+      Eio.Path.save ~create:(`Or_truncate 0o644) full_path
+        (Hash.to_hex commit_hash ^ "\n")
+
+(** {1 Log operations} *)
+
+type log_entry = {
+  hash : string;
+  author : string;
+  date : string;
+  subject : string;
+  body : string;
+}
+
+let format_date timestamp tz_opt =
+  (* Format timestamp as ISO 8601 using ptime *)
+  let tz_offset_s =
+    match tz_opt with
+    | Some tz ->
+        let sign = match tz.User.sign with `Plus -> 1 | `Minus -> -1 in
+        sign * ((tz.hours * 3600) + (tz.minutes * 60))
+    | None -> 0
+  in
+  let span = Ptime.Span.of_int_s (Int64.to_int timestamp) in
+  match Ptime.of_span span with
+  | Some t ->
+      let tz_str =
+        match tz_opt with
+        | Some tz ->
+            let sign = match tz.User.sign with `Plus -> "+" | `Minus -> "-" in
+            Fmt.str "%s%02d%02d" sign tz.hours tz.minutes
+        | None -> "+0000"
+      in
+      let (y, m, d), ((hh, mm, ss), _) = Ptime.to_date_time ~tz_offset_s t in
+      Fmt.str "%04d-%02d-%02dT%02d:%02d:%02d%s" y m d hh mm ss tz_str
+  | None -> "1970-01-01T00:00:00+0000"
+
+let commit_to_log_entry hash commit =
+  let author = Commit.author commit in
+  let message = Option.value ~default:"" (Commit.message commit) in
+  let subject, body =
+    match String.index_opt message '\n' with
+    | None -> (String.trim message, "")
+    | Some i ->
+        let subj = String.sub message 0 i |> String.trim in
+        let rest = String.sub message (i + 1) (String.length message - i - 1) in
+        (subj, String.trim rest)
+  in
+  {
+    hash = Hash.to_hex hash;
+    author = User.name author;
+    date = format_date (User.date author) (User.tz_offset author);
+    subject;
+    body;
+  }
+
+let log t ?(max_count = max_int) head =
+  (* Walk backwards from head, collecting log entries *)
+  let visited = Hashtbl.create 256 in
+  let result = ref [] in
+  let count = ref 0 in
+  let queue = Queue.create () in
+  Queue.push head queue;
+  while (not (Queue.is_empty queue)) && !count < max_count do
+    let h = Queue.pop queue in
+    if not (Hashtbl.mem visited h) then begin
+      Hashtbl.replace visited h ();
+      match read t h with
+      | Ok (Value.Commit commit) ->
+          result := commit_to_log_entry h commit :: !result;
+          incr count;
+          (* Add parents to queue (reverse to maintain order) *)
+          List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+      | _ -> ()
+    end
+  done;
+  List.rev !result
+
+(** Check if a commit modifies files under a given path prefix. Compares the
+    tree at path between this commit and its first parent. *)
+let commit_touches_path t commit ~path =
+  let tree = Commit.tree commit in
+  let parents = Commit.parents commit in
+  let get_entry_hash tree_hash =
+    if path = "" then Some tree_hash
+    else
+      let parts = String.split_on_char '/' path |> List.filter (( <> ) "") in
+      let rec find hash = function
+        | [] -> Some hash
+        | name :: rest -> (
+            match read t hash with
+            | Ok (Value.Tree tree) -> (
+                let entries = Tree.to_list tree in
+                match
+                  List.find_opt (fun (e : Tree.entry) -> e.name = name) entries
+                with
+                | Some e -> find e.hash rest
+                | None -> None)
+            | _ -> None)
+      in
+      find tree_hash parts
+  in
+  match parents with
+  | [] ->
+      (* Initial commit matches only if path exists in the tree *)
+      Option.is_some (get_entry_hash tree)
+  | parent :: _ -> (
+      match read t parent with
+      | Ok (Value.Commit parent_commit) ->
+          let my_entry = get_entry_hash tree in
+          let parent_entry = get_entry_hash (Commit.tree parent_commit) in
+          my_entry <> parent_entry
+      | _ -> true)
+
+let log_filtered t ?(max_count = max_int) ?since ?until ?path head =
+  (* Walk backwards from head, collecting log entries with optional filters *)
+  let visited = Hashtbl.create 256 in
+  let result = ref [] in
+  let count = ref 0 in
+  let queue = Queue.create () in
+  Queue.push head queue;
+  while (not (Queue.is_empty queue)) && !count < max_count do
+    let h = Queue.pop queue in
+    if not (Hashtbl.mem visited h) then begin
+      Hashtbl.replace visited h ();
+      match read t h with
+      | Ok (Value.Commit commit) ->
+          let timestamp = User.date (Commit.author commit) in
+          (* Check date filters *)
+          let after_since =
+            match since with Some s -> timestamp >= s | None -> true
+          in
+          let before_until =
+            match until with Some u -> timestamp <= u | None -> true
+          in
+          (* Check path filter *)
+          let matches_path =
+            match path with
+            | Some p -> commit_touches_path t commit ~path:p
+            | None -> true
+          in
+          (* If before since, stop traversing (commits are in reverse chrono order) *)
+          if not after_since then Queue.clear queue
+          else begin
+            if before_until && matches_path then begin
+              result := commit_to_log_entry h commit :: !result;
+              incr count
+            end;
+            List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+          end
+      | _ -> ()
+    end
+  done;
+  List.rev !result
+
+let resolve_ref t name =
+  (* Try various ref formats to resolve a name to a hash *)
+  if name = "HEAD" then read_ref t "HEAD"
+  else if String.starts_with ~prefix:"refs/" name then read_ref t name
+  else
+    (* Try as remote ref first (e.g., "origin/main" -> "refs/remotes/origin/main") *)
+    match read_ref t ("refs/remotes/" ^ name) with
+    | Some _ as result -> result
+    | None -> (
+        (* Try as local branch *)
+        match read_ref t ("refs/heads/" ^ name) with
+        | Some _ as result -> result
+        | None ->
+            (* Try as tag *)
+            read_ref t ("refs/tags/" ^ name))
+
+let log_range t ~base ~head ?(max_count = max_int) () =
+  (* Get commits reachable from head but not from base *)
+  let base_ancestors = Hashtbl.create 256 in
+  (* First collect all ancestors of base *)
+  let queue = Queue.create () in
+  Queue.push base queue;
+  while not (Queue.is_empty queue) do
+    let h = Queue.pop queue in
+    if not (Hashtbl.mem base_ancestors h) then begin
+      Hashtbl.replace base_ancestors h ();
+      match read t h with
+      | Ok (Value.Commit commit) ->
+          List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+      | _ -> ()
+    end
+  done;
+  (* Then collect commits from head not in base_ancestors *)
+  let visited = Hashtbl.create 256 in
+  let result = ref [] in
+  let count = ref 0 in
+  Queue.push head queue;
+  while (not (Queue.is_empty queue)) && !count < max_count do
+    let h = Queue.pop queue in
+    if (not (Hashtbl.mem visited h)) && not (Hashtbl.mem base_ancestors h) then begin
+      Hashtbl.replace visited h ();
+      match read t h with
+      | Ok (Value.Commit commit) ->
+          result := commit_to_log_entry h commit :: !result;
+          incr count;
+          List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+      | _ -> ()
+    end
+  done;
+  List.rev !result
+
+let log_range_refs t ~base ~tip ?(max_count = max_int) () =
+  match (resolve_ref t base, resolve_ref t tip) with
+  | Some base_hash, Some tip_hash ->
+      Ok (log_range t ~base:base_hash ~head:tip_hash ~max_count ())
+  | None, _ -> err_unresolved_ref base
+  | _, None -> err_unresolved_ref tip
+
+let is_ancestor t ~ancestor ~descendant =
+  (* Check if ancestor is reachable from descendant by BFS *)
+  if Hash.equal ancestor descendant then true
+  else
+    let visited = Hashtbl.create 256 in
+    let queue = Queue.create () in
+    Queue.push descendant queue;
+    let found = ref false in
+    while (not (Queue.is_empty queue)) && not !found do
+      let h = Queue.pop queue in
+      if Hash.equal h ancestor then found := true
+      else if not (Hashtbl.mem visited h) then begin
+        Hashtbl.replace visited h ();
+        match read t h with
+        | Ok (Value.Commit commit) ->
+            List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+        | _ -> ()
+      end
+    done;
+    !found
+
+let count_commits_between t ~base ~head =
+  List.length (log_range t ~base ~head ())
+
+let merge_base t commit1 commit2 =
+  (* Find common ancestor by collecting ancestors of both and finding
+     the most recent common one. Simple BFS-based approach. *)
+  let ancestors1 = Hashtbl.create 256 in
+  let ancestors2 = Hashtbl.create 256 in
+  let queue1 = Queue.create () in
+  let queue2 = Queue.create () in
+  Queue.push commit1 queue1;
+  Queue.push commit2 queue2;
+  let result = ref None in
+  (* Alternate BFS from both sides until we find a common ancestor *)
+  while
+    !result = None && not (Queue.is_empty queue1 && Queue.is_empty queue2)
+  do
+    (* Process one step from queue1 *)
+    if !result = None && not (Queue.is_empty queue1) then begin
+      let h = Queue.pop queue1 in
+      if not (Hashtbl.mem ancestors1 h) then begin
+        Hashtbl.replace ancestors1 h ();
+        if Hashtbl.mem ancestors2 h then result := Some h
+        else
+          match read t h with
+          | Ok (Value.Commit commit) ->
+              List.iter (fun p -> Queue.push p queue1) (Commit.parents commit)
+          | _ -> ()
+      end
+    end;
+    (* Process one step from queue2 *)
+    if !result = None && not (Queue.is_empty queue2) then begin
+      let h = Queue.pop queue2 in
+      if not (Hashtbl.mem ancestors2 h) then begin
+        Hashtbl.replace ancestors2 h ();
+        if Hashtbl.mem ancestors1 h then result := Some h
+        else
+          match read t h with
+          | Ok (Value.Commit commit) ->
+              List.iter (fun p -> Queue.push p queue2) (Commit.parents commit)
+          | _ -> ()
+      end
+    end
+  done;
+  !result
+
+(** {1 Repository initialization} *)
+
+let init ~fs path =
+  let path_str = Fpath.to_string path in
+  let git_dir = Filename.concat path_str ".git" in
+  let git_path = Eio.Path.(fs / git_dir) in
+  (* Create .git structure — mkdirs handles missing parent directories *)
+  Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 git_path;
+  Eio.Path.mkdir ~perm:0o755 Eio.Path.(git_path / "objects");
+  Eio.Path.mkdir ~perm:0o755 Eio.Path.(git_path / "refs");
+  Eio.Path.mkdir ~perm:0o755 Eio.Path.(git_path / "refs" / "heads");
+  (* Write HEAD *)
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(git_path / "HEAD")
+    "ref: refs/heads/main\n";
+  open_repo ~fs path
+
+(** {1 Config operations} *)
+
+let read_config t =
+  let path = Filename.concat t.git_dir "config" in
+  let full_path = Eio.Path.(t.fs / path) in
+  try
+    let content = Eio.Path.load full_path in
+    Some (Config.of_string content)
+  with Eio.Io _ -> None
+
+let write_config t config =
+  let path = Filename.concat t.git_dir "config" in
+  let full_path = Eio.Path.(t.fs / path) in
+  let content = Config.to_string config in
+  Eio.Path.save ~create:(`Or_truncate 0o644) full_path content
+
+let list_remotes t =
+  match read_config t with
+  | Some config ->
+      List.map (fun (r : Config.remote) -> r.name) (Config.remotes config)
+  | None -> []
+
+let remote t name =
+  match read_config t with
+  | Some config -> Config.remote config name
+  | None -> None
+
+let remote_url t name =
+  match remote t name with Some r -> r.Config.url | None -> None
+
+let push_url t name =
+  match remote t name with
+  | Some r -> (
+      match r.Config.push_url with Some url -> Some url | None -> r.Config.url)
+  | None -> None
+
+let add_remote t ~name ~url ?push_url ?(fetch = []) () =
+  let config = match read_config t with Some c -> c | None -> Config.empty in
+  (* Check if remote already exists *)
+  if Option.is_some (Config.remote config name) then err_remote_exists name
+  else
+    let fetch =
+      if fetch = [] then [ Fmt.str "+refs/heads/*:refs/remotes/%s/*" name ]
+      else fetch
+    in
+    let remote : Config.remote = { name; url = Some url; push_url; fetch } in
+    let entries = Config.of_remote remote in
+    let new_config = List.fold_left (fun c e -> c @ [ e ]) config entries in
+    write_config t new_config;
+    Ok ()
+
+let remove_remote t name =
+  match read_config t with
+  | None -> Error (`Msg "no config file")
+  | Some config ->
+      if Option.is_none (Config.remote config name) then
+        err_remote_not_found name
+      else
+        let section = Config.section_sub "remote" name in
+        (* Remove all entries for this remote section *)
+        let new_config =
+          List.filter
+            (fun (e : Config.entry) ->
+              not
+                (e.section.name = section.name
+                && e.section.subsection = section.subsection))
+            config
+        in
+        write_config t new_config;
+        Ok ()
+
+let set_remote_url t ~name ~url =
+  match read_config t with
+  | None -> Error (`Msg "no config file")
+  | Some config ->
+      let section = Config.section_sub "remote" name in
+      (* Update the url entry for this remote *)
+      let new_config =
+        List.map
+          (fun (e : Config.entry) ->
+            if
+              e.section.name = section.name
+              && e.section.subsection = section.subsection
+              && e.key = "url"
+            then { e with value = url }
+            else e)
+          config
+      in
+      write_config t new_config;
+      Ok ()
+
+let set_push_url t ~name ~url =
+  match read_config t with
+  | None -> Error (`Msg "no config file")
+  | Some config ->
+      let section = Config.section_sub "remote" name in
+      (* Check if remote exists *)
+      let remote_exists =
+        List.exists
+          (fun (e : Config.entry) ->
+            e.section.name = section.name
+            && e.section.subsection = section.subsection)
+          config
+      in
+      if not remote_exists then err_remote_not_found name
+      else
+        (* Check if pushurl already exists *)
+        let has_pushurl =
+          List.exists
+            (fun (e : Config.entry) ->
+              e.section.name = section.name
+              && e.section.subsection = section.subsection
+              && e.key = "pushurl")
+            config
+        in
+        let new_config =
+          if has_pushurl then
+            (* Update existing pushurl *)
+            List.map
+              (fun (e : Config.entry) ->
+                if
+                  e.section.name = section.name
+                  && e.section.subsection = section.subsection
+                  && e.key = "pushurl"
+                then { e with value = url }
+                else e)
+              config
+          else
+            (* Add pushurl after url entry *)
+            List.fold_right
+              (fun (e : Config.entry) acc ->
+                if
+                  e.section.name = section.name
+                  && e.section.subsection = section.subsection
+                  && e.key = "url"
+                then e :: { e with key = "pushurl"; value = url } :: acc
+                else e :: acc)
+              config []
+        in
+        write_config t new_config;
+        Ok ()
+
+let ensure_remote t ~name ~url =
+  match remote_url t name with
+  | Some existing_url when existing_url = url -> Ok ()
+  | Some _ -> set_remote_url t ~name ~url
+  | None -> add_remote t ~name ~url ()
+
+(** {1 Index operations} *)
+
+let read_index t =
+  let path = Filename.concat t.git_dir "index" in
+  let full_path = Eio.Path.(t.fs / path) in
+  try
+    let content = Eio.Path.load full_path in
+    Index.of_string content
+  with Eio.Io _ -> Ok Index.empty
+
+let write_index t index =
+  let path = Filename.concat t.git_dir "index" in
+  let full_path = Eio.Path.(t.fs / path) in
+  let content = Index.to_string index in
+  Eio.Path.save ~create:(`Or_truncate 0o644) full_path content
+
+let work_dir_of t =
+  if
+    String.length t.git_dir > 5
+    && String.sub t.git_dir (String.length t.git_dir - 5) 5 = "/.git"
+  then String.sub t.git_dir 0 (String.length t.git_dir - 5)
+  else Filename.dirname t.git_dir
+
+let add_to_index t paths =
+  let result = read_index t in
+  match result with
+  | Error e -> Error e
+  | Ok index ->
+      let work_dir = work_dir_of t in
+      let index =
+        List.fold_left
+          (fun idx path ->
+            let full_path = Eio.Path.(t.fs / work_dir / path) in
+            try
+              let content = Eio.Path.load full_path in
+              let hash = write_blob t content in
+              let entry =
+                Index.entry_of_file ~fs:t.fs ~root:work_dir ~path ~hash
+              in
+              Index.add idx entry
+            with Eio.Io _ -> idx (* Skip files that don't exist *))
+          index paths
+      in
+      write_index t index;
+      Ok ()
+
+let remove_from_index t prefix =
+  match read_index t with
+  | Error e -> Error e
+  | Ok index ->
+      let index = Index.remove_prefix index prefix in
+      write_index t index;
+      Ok ()
+
+let add_all t =
+  let work_dir = work_dir_of t in
+  (* Recursively collect all files in working directory *)
+  let rec collect_files dir prefix acc =
+    let full_dir = Eio.Path.(t.fs / dir) in
+    try
+      let entries = Eio.Path.read_dir full_dir in
+      List.fold_left
+        (fun acc name ->
+          if name = ".git" then acc
+          else
+            let path = if prefix = "" then name else prefix ^ "/" ^ name in
+            let full_path = Eio.Path.(full_dir / name) in
+            match Eio.Path.kind ~follow:false full_path with
+            | `Directory -> collect_files (dir ^ "/" ^ name) path acc
+            | `Regular_file -> path :: acc
+            | _ -> acc)
+        acc entries
+    with Eio.Io _ -> acc
+  in
+  let files = collect_files work_dir "" [] in
+  (* Read current index *)
+  match read_index t with
+  | Error e -> Error e
+  | Ok index ->
+      (* Build new index: add/update all files, track which paths we've seen *)
+      let seen = Hashtbl.create 256 in
+      let new_index =
+        List.fold_left
+          (fun idx path ->
+            Hashtbl.replace seen path ();
+            let full_path = Eio.Path.(t.fs / work_dir / path) in
+            try
+              let content = Eio.Path.load full_path in
+              let hash = write_blob t content in
+              let entry =
+                Index.entry_of_file ~fs:t.fs ~root:work_dir ~path ~hash
+              in
+              Index.add idx entry
+            with Eio.Io _ -> idx)
+          index files
+      in
+      (* Remove entries for files that no longer exist *)
+      let final_index =
+        List.fold_left
+          (fun idx (entry : Index.entry) ->
+            if Hashtbl.mem seen entry.name then idx
+            else Index.remove idx entry.name)
+          new_index (Index.entries new_index)
+      in
+      write_index t final_index;
+      Ok ()
+
+let commit_index t ~author ~committer ?message () =
+  match read_index t with
+  | Error e -> Error e
+  | Ok index when List.length (Index.entries index) = 0 ->
+      Error (`Msg "nothing to commit (empty index)")
+  | Ok index ->
+      (* Build tree from index *)
+      let tree_hash =
+        Index.to_tree ~write_tree:(write_tree t) ~write_blob:(write_blob t)
+          index
+      in
+      (* Get parent commit *)
+      let parents = match head t with None -> [] | Some h -> [ h ] in
+      (* Create commit *)
+      let commit =
+        Commit.v ~tree:tree_hash ~author ~committer ~parents message
+      in
+      let commit_hash = write_commit t commit in
+      (* Update HEAD (or the branch it points to) *)
+      advance_head t commit_hash;
+      Ok commit_hash
+
+let commit t ~message =
+  (* Get user info from config *)
+  match read_config t with
+  | None -> Error (`Msg "no git config found")
+  | Some config -> (
+      let user_config = Config.user config in
+      match (user_config.name, user_config.email) with
+      | None, _ -> Error (`Msg "user.name not set in git config")
+      | _, None -> Error (`Msg "user.email not set in git config")
+      | Some name, Some email ->
+          let date = Int64.of_float (Unix.gettimeofday ()) in
+          let user = User.v ~name ~email ~date () in
+          commit_index t ~author:user ~committer:user ~message ())
+
+let rm t ~recursive path =
+  let work_dir = work_dir_of t in
+  (* Remove from index *)
+  (match read_index t with
+  | Error _ -> ()
+  | Ok index ->
+      let new_index =
+        if recursive then
+          (* Remove all entries under this path *)
+          let prefix = if path = "" then "" else path ^ "/" in
+          List.fold_left
+            (fun idx (entry : Index.entry) ->
+              if entry.name = path || String.starts_with ~prefix entry.name then
+                Index.remove idx entry.name
+              else idx)
+            index (Index.entries index)
+        else Index.remove index path
+      in
+      write_index t new_index);
+  (* Remove from working tree *)
+  let full_path = Eio.Path.(t.fs / work_dir / path) in
+  (try
+     if recursive then
+       let rec remove_recursive p =
+         match Eio.Path.kind ~follow:false p with
+         | `Directory ->
+             let entries = Eio.Path.read_dir p in
+             List.iter
+               (fun name -> remove_recursive Eio.Path.(p / name))
+               entries;
+             Eio.Path.rmdir p
+         | _ -> Eio.Path.unlink p
+       in
+       remove_recursive full_path
+     else Eio.Path.unlink full_path
+   with Eio.Io _ -> ());
+  Ok ()
+
+(** {1 Checkout operations} *)
+
+let rec checkout_tree t ~work_dir ~prefix tree_hash =
+  match read t tree_hash with
+  | Error e -> Error e
+  | Ok (Value.Tree tree) ->
+      let entries = Tree.to_list tree in
+      let rec process_entries = function
+        | [] -> Ok ()
+        | (entry : Tree.entry) :: rest -> (
+            let path =
+              if prefix = "" then entry.name else prefix ^ "/" ^ entry.name
+            in
+            let full_path = Eio.Path.(t.fs / work_dir / path) in
+            match entry.perm with
+            | `Dir -> (
+                (* Create directory and recurse *)
+                (try Eio.Path.mkdir ~perm:0o755 full_path with Eio.Io _ -> ());
+                match checkout_tree t ~work_dir ~prefix:path entry.hash with
+                | Error e -> Error e
+                | Ok () -> process_entries rest)
+            | `Normal | `Everybody | `Exec -> (
+                (* Write file *)
+                match read t entry.hash with
+                | Error e -> Error e
+                | Ok (Value.Blob blob) ->
+                    let perm =
+                      match entry.perm with `Exec -> 0o755 | _ -> 0o644
+                    in
+                    let dir = Filename.dirname path in
+                    if dir <> "." && dir <> "" then begin
+                      let dir_path = Eio.Path.(t.fs / work_dir / dir) in
+                      try Eio.Path.mkdir ~perm:0o755 dir_path
+                      with Eio.Io _ -> ()
+                    end;
+                    Eio.Path.save ~create:(`Or_truncate perm) full_path
+                      (Blob.to_string blob);
+                    process_entries rest
+                | Ok _ -> Error (`Msg "expected blob"))
+            | `Link -> (
+                (* Create symlink *)
+                match read t entry.hash with
+                | Error e -> Error e
+                | Ok (Value.Blob blob) -> (
+                    let target = Blob.to_string blob in
+                    (try Eio.Path.unlink full_path with Eio.Io _ -> ());
+                    try
+                      Eio.Path.symlink ~link_to:target full_path;
+                      process_entries rest
+                    with Eio.Io _ -> Error (`Msg "failed to create symlink"))
+                | Ok _ -> Error (`Msg "expected blob for symlink"))
+            | `Commit ->
+                (* Submodule - skip for now *)
+                process_entries rest)
+      in
+      process_entries entries
+  | Ok _ -> Error (`Msg "expected tree")
+
+let checkout t commit_hash =
+  let work_dir = work_dir_of t in
+  match read t commit_hash with
+  | Error e -> Error e
+  | Ok (Value.Commit commit) ->
+      let tree_hash = Commit.tree commit in
+      checkout_tree t ~work_dir ~prefix:"" tree_hash
+  | Ok _ -> Error (`Msg "expected commit")
+
+let checkout_prefix t commit_hash ~prefix =
+  let work_dir = work_dir_of t in
+  match read t commit_hash with
+  | Error e -> Error e
+  | Ok (Value.Commit commit) -> (
+      let tree_hash = Commit.tree commit in
+      (* Walk tree to find subtree at prefix (inlined from Subtree.tree_at_prefix
+         to avoid circular dependency) *)
+      let segments =
+        String.split_on_char '/' prefix |> List.filter (fun s -> s <> "")
+      in
+      let rec walk hash = function
+        | [] -> Some hash
+        | seg :: rest -> (
+            match read t hash with
+            | Ok (Value.Tree tree) -> (
+                match Tree.find ~name:seg tree with
+                | Some entry when entry.perm = `Dir -> walk entry.hash rest
+                | _ -> None)
+            | _ -> None)
+      in
+      match walk tree_hash segments with
+      | None -> err_prefix_not_found prefix
+      | Some sub_tree_hash ->
+          let dir_path = Eio.Path.(t.fs / work_dir / prefix) in
+          (try Eio.Path.mkdir ~perm:0o755 dir_path with Eio.Io _ -> ());
+          checkout_tree t ~work_dir ~prefix sub_tree_hash)
+  | Ok _ -> Error (`Msg "expected commit")
+
+let checkout_ref t ref_name =
+  match read_ref t ref_name with
+  | None -> err_ref_not_found ref_name
+  | Some hash -> checkout t hash
+
+(** {1 Dirty check} *)
+
+let is_dirty t =
+  (* A repo is dirty if there are uncommitted changes.
+     We check:
+     1. If there are untracked files in the working directory
+     2. If the index differs from HEAD
+     3. If the working tree differs from the index
+     For now, use a simpler heuristic: check if HEAD exists and matches current tree. *)
+  match head t with
+  | None -> false (* No commits yet = empty, not dirty *)
+  | Some head_hash -> (
+      match read t head_hash with
+      | Ok (Value.Commit commit) ->
+          (* TODO: Compare tree with working directory *)
+          (* For now, always return false as we can't properly check without index support *)
+          ignore (Commit.tree commit);
+          false
+      | _ -> true)
+
+(** {1 Ahead/behind computation} *)
+
+type ahead_behind = { ahead : int; behind : int }
+
+let ahead_behind t ?(remote = "origin") ?(branch = "main") () =
+  match head t with
+  | None -> None
+  | Some local_head -> (
+      let remote_ref = "refs/remotes/" ^ remote ^ "/" ^ branch in
+      match read_ref t remote_ref with
+      | None -> None
+      | Some remote_head ->
+          if Hash.equal local_head remote_head then
+            Some { ahead = 0; behind = 0 }
+          else
+            let ahead =
+              List.length (log_range t ~base:remote_head ~head:local_head ())
+            in
+            let behind =
+              List.length (log_range t ~base:local_head ~head:remote_head ())
+            in
+            Some { ahead; behind })
+
+(** {1 Tree hash lookup} *)
+
+let tree_hash_at_path t ~rev ~path =
+  (* Resolve ref to commit *)
+  let ref_name = if rev = "HEAD" then "HEAD" else "refs/heads/" ^ rev in
+  match read_ref t ref_name with
+  | None -> None
+  | Some commit_hash -> (
+      match read t commit_hash with
+      | Ok (Value.Commit c) ->
+          let tree_hash = Commit.tree c in
+          if path = "" then Some tree_hash
+          else
+            (* Navigate into the path *)
+            let rec find_in_tree hash path_parts =
+              match read t hash with
+              | Ok (Value.Tree tree) -> (
+                  match path_parts with
+                  | [] -> Some hash
+                  | dir :: rest -> (
+                      let entries = Tree.to_list tree in
+                      match
+                        List.find_opt
+                          (fun (e : Tree.entry) -> e.name = dir)
+                          entries
+                      with
+                      | Some e -> find_in_tree e.hash rest
+                      | None -> None))
+              | _ -> None
+            in
+            let path_parts =
+              String.split_on_char '/' path |> List.filter (fun s -> s <> "")
+            in
+            find_in_tree tree_hash path_parts
+      | _ -> None)
+
+(** {1 Subtree operations} *)
+
+(** Parse a subtree merge/squash commit message to extract the upstream commit.
+    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)
+  else if String.starts_with ~prefix:"Add '" subject then
+    (* Pattern 3: "Add 'prefix/' from commit abc123" *)
+    match String.split_on_char ' ' subject |> List.rev with
+    | last :: "commit" :: "from" :: _ -> extract_hex last 0
+    | _ -> None
+  else None
+
+let subtree_last_upstream_commit t ~prefix =
+  (* Search through commits for subtree-related messages *)
+  match head t with
+  | None -> None
+  | Some head_hash ->
+      let squash_pattern = Fmt.str "Squashed '%s/'" prefix in
+      let add_pattern = Fmt.str "Add '%s/'" prefix in
+      (* Walk commits looking for matching message *)
+      let visited = Hashtbl.create 256 in
+      let queue = Queue.create () in
+      Queue.push head_hash queue;
+      let result = ref None in
+      while !result = None && not (Queue.is_empty queue) do
+        let h = Queue.pop queue in
+        if not (Hashtbl.mem visited h) then begin
+          Hashtbl.replace visited h ();
+          match read t h with
+          | Ok (Value.Commit commit) ->
+              let subject =
+                match Commit.message commit with
+                | Some msg -> (
+                    match String.index_opt msg '\n' with
+                    | Some i -> String.sub msg 0 i
+                    | None -> msg)
+                | None -> ""
+              in
+              if
+                String.starts_with ~prefix:squash_pattern subject
+                || String.starts_with ~prefix:add_pattern subject
+              then result := parse_subtree_message subject
+              else
+                List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+          | _ -> ()
+        end
+      done;
+      !result
+
+let has_subtree_history t ~prefix =
+  subtree_last_upstream_commit t ~prefix |> Option.is_some
+
+(** {1 Patch operations} *)
+
+(* Inline tree diff types and functions to avoid cycle with Diff module *)
+type file_change =
+  | Added of { path : string; hash : Hash.t }
+  | Removed of { path : string; hash : Hash.t }
+  | Modified of { path : string; old_hash : Hash.t; new_hash : Hash.t }
+
+let change_path = function
+  | Added { path; _ } | Removed { path; _ } | Modified { path; _ } -> path
+
+let compare_changes c1 c2 = String.compare (change_path c1) (change_path c2)
+
+let rec collect_tree_entries t prefix tree_hash =
+  match read t tree_hash with
+  | Error _ -> []
+  | Ok (Value.Tree tree) ->
+      List.concat_map
+        (fun (e : Tree.entry) ->
+          let path = if prefix = "" then e.name else prefix ^ "/" ^ e.name in
+          if e.perm = `Dir then collect_tree_entries t path e.hash
+          else [ (path, e.hash) ])
+        (Tree.to_list tree)
+  | Ok _ -> []
+
+let diff_trees_simple t ~old_tree ~new_tree =
+  let old_files = collect_tree_entries t "" old_tree in
+  let new_files = collect_tree_entries t "" new_tree in
+  let old_map = List.to_seq old_files |> Hashtbl.of_seq in
+  let new_map = List.to_seq new_files |> Hashtbl.of_seq in
+  let changes = ref [] in
+  (* Find removed and modified *)
+  Hashtbl.iter
+    (fun path old_hash ->
+      match Hashtbl.find_opt new_map path with
+      | None -> changes := Removed { path; hash = old_hash } :: !changes
+      | Some new_hash ->
+          if not (Hash.equal old_hash new_hash) then
+            changes := Modified { path; old_hash; new_hash } :: !changes)
+    old_map;
+  (* Find added *)
+  Hashtbl.iter
+    (fun path hash ->
+      if not (Hashtbl.mem old_map path) then
+        changes := Added { path; hash } :: !changes)
+    new_map;
+  List.sort compare_changes !changes
+
+let diff_tree_to_empty_simple t tree_hash =
+  collect_tree_entries t "" tree_hash
+  |> List.map (fun (path, hash) -> Added { path; hash })
+  |> List.sort compare_changes
+
+(** Compute unified diff between two strings *)
+let unified_diff ~old_content ~new_content ~old_path ~new_path =
+  let old_lines = String.split_on_char '\n' old_content in
+  let new_lines = String.split_on_char '\n' new_content in
+  let n = List.length old_lines in
+  let m = List.length new_lines in
+  if n = 0 && m = 0 then ""
+  else
+    let old_arr = Array.of_list old_lines in
+    let new_arr = Array.of_list new_lines in
+    let buf = Buffer.create 1024 in
+    Buffer.add_string buf (Fmt.str "diff --git a/%s b/%s\n" old_path new_path);
+    Buffer.add_string buf (Fmt.str "--- a/%s\n" old_path);
+    Buffer.add_string buf (Fmt.str "+++ b/%s\n" new_path);
+    (* Simple diff: show all old as removed, all new as added *)
+    if n > 0 || m > 0 then begin
+      Buffer.add_string buf (Fmt.str "@@ -%d,%d +%d,%d @@\n" 1 n 1 m);
+      for i = 0 to n - 1 do
+        Buffer.add_string buf "-";
+        Buffer.add_string buf old_arr.(i);
+        Buffer.add_char buf '\n'
+      done;
+      for i = 0 to m - 1 do
+        Buffer.add_string buf "+";
+        Buffer.add_string buf new_arr.(i);
+        Buffer.add_char buf '\n'
+      done
+    end;
+    Buffer.contents buf
+
+let format_patch_header buf c commit =
+  Buffer.add_string buf (Fmt.str "commit %s\n" commit);
+  Buffer.add_string buf
+    (Fmt.str "Author: %s\n" (User.to_string (Commit.author c)));
+  Buffer.add_string buf (Fmt.str "Date:   %Ld\n" (User.date (Commit.author c)));
+  Buffer.add_char buf '\n';
+  (match Commit.message c with
+  | Some msg ->
+      String.split_on_char '\n' msg
+      |> List.iter (fun line ->
+          Buffer.add_string buf "    ";
+          Buffer.add_string buf line;
+          Buffer.add_char buf '\n')
+  | None -> ());
+  Buffer.add_char buf '\n'
+
+let format_stat_line buf change =
+  match change with
+  | Added { path; _ } -> Buffer.add_string buf (Fmt.str " %s | new file\n" path)
+  | Removed { path; _ } ->
+      Buffer.add_string buf (Fmt.str " %s | deleted\n" path)
+  | Modified { path; _ } ->
+      Buffer.add_string buf (Fmt.str " %s | modified\n" path)
+
+let format_change_diff t buf change =
+  match change with
+  | Added { path; hash } -> (
+      match read t hash with
+      | Ok (Value.Blob blob) ->
+          let diff =
+            unified_diff ~old_content:"" ~new_content:(Blob.to_string blob)
+              ~old_path:path ~new_path:path
+          in
+          Buffer.add_string buf diff
+      | _ -> ())
+  | Removed { path; hash } -> (
+      match read t hash with
+      | Ok (Value.Blob blob) ->
+          let diff =
+            unified_diff ~old_content:(Blob.to_string blob) ~new_content:""
+              ~old_path:path ~new_path:path
+          in
+          Buffer.add_string buf diff
+      | _ -> ())
+  | Modified { path; old_hash; new_hash } -> (
+      match (read t old_hash, read t new_hash) with
+      | Ok (Value.Blob old_b), Ok (Value.Blob new_b) ->
+          let diff =
+            unified_diff ~old_content:(Blob.to_string old_b)
+              ~new_content:(Blob.to_string new_b) ~old_path:path ~new_path:path
+          in
+          Buffer.add_string buf diff
+      | _ -> ())
+
+let show_patch t ~commit =
+  match read t (Hash.of_hex commit) with
+  | Error e -> Error e
+  | Ok (Value.Commit c) ->
+      let buf = Buffer.create 4096 in
+      format_patch_header buf c commit;
+      let parent_tree =
+        match Commit.parents c with
+        | [] -> None
+        | p :: _ -> (
+            match read t p with
+            | Ok (Value.Commit pc) -> Some (Commit.tree pc)
+            | _ -> None)
+      in
+      let new_tree = Commit.tree c in
+      let changes =
+        match parent_tree with
+        | Some old_tree -> diff_trees_simple t ~old_tree ~new_tree
+        | None -> diff_tree_to_empty_simple t new_tree
+      in
+      List.iter (format_stat_line buf) changes;
+      Buffer.add_char buf '\n';
+      List.iter (format_change_diff t buf) changes;
+      Ok (Buffer.contents buf)
+  | Ok _ -> Error (`Msg "not a commit")
+
+(** {1 Cherry-pick operations} *)
+
+let mkdir_p t work_dir path =
+  let rec aux p =
+    let parent = Filename.dirname p in
+    if parent <> "." && parent <> "" then aux parent;
+    let full = Eio.Path.(t.fs / work_dir / p) in
+    try Eio.Path.mkdir ~perm:0o755 full with Eio.Io _ -> ()
+  in
+  aux path
+
+let apply_change t work_dir change =
+  match change with
+  | Added { path; hash } -> (
+      match read t hash with
+      | Ok (Value.Blob blob) ->
+          let full_path = Eio.Path.(t.fs / work_dir / path) in
+          let dir = Filename.dirname path in
+          if dir <> "." && dir <> "" then mkdir_p t work_dir dir;
+          Eio.Path.save ~create:(`Or_truncate 0o644) full_path
+            (Blob.to_string blob);
+          Ok ()
+      | _ -> Error (`Msg ("cannot read blob: " ^ path)))
+  | Removed { path; _ } ->
+      let full_path = Eio.Path.(t.fs / work_dir / path) in
+      (try Eio.Path.unlink full_path with Eio.Io _ -> ());
+      Ok ()
+  | Modified { path; new_hash; _ } -> (
+      match read t new_hash with
+      | Ok (Value.Blob blob) ->
+          let full_path = Eio.Path.(t.fs / work_dir / path) in
+          Eio.Path.save ~create:(`Or_truncate 0o644) full_path
+            (Blob.to_string blob);
+          Ok ()
+      | _ -> Error (`Msg ("cannot read blob: " ^ path)))
+
+let cherry_pick t ~commit:commit_hash =
+  match read t (Hash.of_hex commit_hash) with
+  | Error e -> Error e
+  | Ok (Value.Commit c) -> (
+      let parent_tree =
+        match Commit.parents c with
+        | [] -> None
+        | p :: _ -> (
+            match read t p with
+            | Ok (Value.Commit pc) -> Some (Commit.tree pc)
+            | _ -> None)
+      in
+      let changes =
+        match parent_tree with
+        | Some old_tree ->
+            diff_trees_simple t ~old_tree ~new_tree:(Commit.tree c)
+        | None -> diff_tree_to_empty_simple t (Commit.tree c)
+      in
+      let work_dir = work_dir_of t in
+      let rec apply_all = function
+        | [] -> Ok ()
+        | change :: rest -> (
+            match apply_change t work_dir change with
+            | Error e -> Error e
+            | Ok () -> apply_all rest)
+      in
+      match apply_all changes with
+      | Error e -> Error e
+      | Ok () -> (
+          match add_all t with
+          | Error e -> Error e
+          | Ok () ->
+              let message =
+                match Commit.message c with Some m -> m | None -> ""
+              in
+              commit t ~message))
+  | Ok _ -> Error (`Msg "not a commit")
+
+(** {1 Merge operations} *)
+
+let merge t ~ref_name ~ff_only =
+  (* Resolve the ref to merge *)
+  match resolve_ref t ref_name with
+  | None -> Error (`Msg ("cannot resolve ref: " ^ ref_name))
+  | Some their_hash -> (
+      match head t with
+      | None -> Error (`Msg "no HEAD")
+      | Some our_hash ->
+          if Hash.equal our_hash their_hash then Ok () (* Already up to date *)
+          else
+            (* Check if fast-forward is possible *)
+            let can_ff =
+              is_ancestor t ~ancestor:our_hash ~descendant:their_hash
+            in
+            if can_ff then begin
+              (* Fast-forward: just update HEAD *)
+              advance_head t their_hash;
+              (* Checkout the new tree *)
+              match checkout t their_hash with
+              | Error e -> Error e
+              | Ok () -> Ok ()
+            end
+            else if ff_only then
+              Error (`Msg "not a fast-forward and --ff-only specified")
+            else
+              (* Real merge needed - not implemented yet *)
+              Error (`Msg "non-fast-forward merge not yet implemented"))
+
+(** {1 Worktree operations} *)
+
+let worktree t = Worktree.v ~fs:t.fs ~git_dir:t.git_dir

lib/repository.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git repository access.
+
+    High-level operations on Git repositories, handling both loose objects and
+    pack files transparently. *)
+
+type t
+(** A Git repository. *)
+
+val pp : t Fmt.t
+(** [pp] pretty-prints a repository. *)
+
+(** {1 Opening repositories} *)
+
+val open_repo : fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> t
+(** [open_repo ~fs path] opens the Git repository at [path] (expects a .git
+    subdirectory). *)
+
+val open_bare : fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> t
+(** [open_bare ~fs path] opens a bare Git repository at [path]. *)
+
+val init : fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> t
+(** [init ~fs path] creates a new Git repository at [path]. *)
+
+(** {1 Object reading} *)
+
+val read : t -> Hash.t -> (Value.t, [ `Msg of string ]) result
+(** [read t hash] reads an object from the repository. Checks loose objects
+    first, then pack files. *)
+
+val exists : t -> Hash.t -> bool
+(** [exists t hash] checks if an object exists in the repository. *)
+
+(** {1 Object writing} *)
+
+val write : t -> Value.t -> Hash.t
+(** [write t value] writes an object to the repository as a loose object.
+    Returns the hash. *)
+
+val write_blob : t -> string -> Hash.t
+(** [write_blob t data] writes a blob with the given content. *)
+
+val write_tree : t -> Tree.t -> Hash.t
+(** [write_tree t tree] writes a tree object. *)
+
+val write_commit : t -> Commit.t -> Hash.t
+(** [write_commit t commit] writes a commit object. *)
+
+val write_tag : t -> Tag.t -> Hash.t
+(** [write_tag t tag] writes a tag object. *)
+
+(** {1 Reference operations} *)
+
+val read_ref : t -> string -> Hash.t option
+(** [read_ref t name] reads a reference. Follows symbolic refs. *)
+
+val write_ref : t -> string -> Hash.t -> unit
+(** [write_ref t name hash] writes a reference. *)
+
+val delete_ref : t -> string -> unit
+(** [delete_ref t name] deletes a reference. *)
+
+val list_refs : t -> string list
+(** [list_refs t] lists all references in the repository. *)
+
+(** {1 Repository internals} *)
+
+val git_dir : t -> Fpath.t
+(** [git_dir t] returns the path to the .git directory. *)
+
+val fs : t -> Eio.Fs.dir_ty Eio.Path.t
+(** [fs t] returns the filesystem capability associated with the repository. *)
+
+(** {1 Repository queries} *)
+
+val is_repo : fs:Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> bool
+(** [is_repo ~fs path] returns true if [path] is a Git repository (has a .git
+    subdirectory). *)
+
+val head : t -> Hash.t option
+(** [head t] returns the commit hash pointed to by HEAD. *)
+
+val current_branch : t -> string option
+(** [current_branch t] returns the current branch name, or [None] if in detached
+    HEAD state. *)
+
+val rename_branch : t -> new_name:string -> (unit, [ `Msg of string ]) result
+(** [rename_branch t ~new_name] renames the current branch to [new_name].
+    Returns [Error] if in detached HEAD state. *)
+
+val advance_head : t -> Hash.t -> unit
+(** [advance_head t hash] updates HEAD to point to [hash]. If HEAD points to a
+    branch, updates the branch ref. If in detached HEAD state, updates HEAD
+    directly. *)
+
+(** {1 Log operations} *)
+
+type log_entry = {
+  hash : string;
+  author : string;
+  date : string;
+  subject : string;
+  body : string;
+}
+(** A commit log entry. *)
+
+val log : t -> ?max_count:int -> Hash.t -> log_entry list
+(** [log t ?max_count head] returns commits reachable from [head], most recent
+    first. *)
+
+val log_filtered :
+  t ->
+  ?max_count:int ->
+  ?since:int64 ->
+  ?until:int64 ->
+  ?path:string ->
+  Hash.t ->
+  log_entry list
+(** [log_filtered t ?max_count ?since ?until ?path head] returns commits
+    reachable from [head] with optional filters.
+
+    @param since Only include commits after this Unix timestamp.
+    @param until Only include commits before this Unix timestamp.
+    @param path Only include commits that modify files under this path. *)
+
+val log_range :
+  t -> base:Hash.t -> head:Hash.t -> ?max_count:int -> unit -> log_entry list
+(** [log_range t ~base ~head ?max_count ()] returns commits reachable from
+    [head] but not from [base]. *)
+
+val resolve_ref : t -> string -> Hash.t option
+(** [resolve_ref t name] resolves a ref name to a hash. Handles:
+    - "HEAD" - reads HEAD directly.
+    - "refs/..." - reads the full ref path.
+    - "origin/main" - tries refs/remotes/origin/main.
+    - "main" - tries refs/heads/main, then refs/remotes/origin/main, then
+      refs/tags/main. *)
+
+val log_range_refs :
+  t ->
+  base:string ->
+  tip:string ->
+  ?max_count:int ->
+  unit ->
+  (log_entry list, [ `Msg of string ]) result
+(** [log_range_refs t ~base ~tip ?max_count ()] returns commits reachable from
+    [tip] but not from [base], where [base] and [tip] are ref names (e.g.,
+    "HEAD", "origin/main"). Returns [Error] if refs cannot be resolved. *)
+
+val is_ancestor : t -> ancestor:Hash.t -> descendant:Hash.t -> bool
+(** [is_ancestor t ~ancestor ~descendant] returns true if [ancestor] is an
+    ancestor of [descendant]. *)
+
+val count_commits_between : t -> base:Hash.t -> head:Hash.t -> int
+(** [count_commits_between t ~base ~head] returns the number of commits
+    reachable from [head] but not from [base]. *)
+
+val merge_base : t -> Hash.t -> Hash.t -> Hash.t option
+(** [merge_base t commit1 commit2] returns the best common ancestor of the two
+    commits, or [None] if they have no common ancestor. *)
+
+(** {1 Config operations} *)
+
+val read_config : t -> Config.t option
+(** [read_config t] reads the repository's config file. *)
+
+val write_config : t -> Config.t -> unit
+(** [write_config t config] writes the config file. *)
+
+val list_remotes : t -> string list
+(** [list_remotes t] returns the names of all configured remotes. *)
+
+val remote : t -> string -> Config.remote option
+(** [remote t name] returns the remote configuration. *)
+
+val remote_url : t -> string -> string option
+(** [remote_url t name] returns the URL for the named remote. *)
+
+val push_url : t -> string -> string option
+(** [push_url t name] returns the push URL for the named remote, falling back to
+    the regular URL if no push URL is set. *)
+
+val add_remote :
+  t ->
+  name:string ->
+  url:string ->
+  ?push_url:string ->
+  ?fetch:string list ->
+  unit ->
+  (unit, [ `Msg of string ]) result
+(** [add_remote t ~name ~url ?push_url ?fetch ()] adds a new remote. If [fetch]
+    is not provided, defaults to [+refs/heads/*:refs/remotes/<name>/*]. Returns
+    [Error] if the remote already exists. *)
+
+val remove_remote : t -> string -> (unit, [ `Msg of string ]) result
+(** [remove_remote t name] removes the named remote. Returns [Error] if the
+    remote doesn't exist. *)
+
+val set_remote_url :
+  t -> name:string -> url:string -> (unit, [ `Msg of string ]) result
+(** [set_remote_url t ~name ~url] updates the URL for an existing remote. *)
+
+val set_push_url :
+  t -> name:string -> url:string -> (unit, [ `Msg of string ]) result
+(** [set_push_url t ~name ~url] sets the push URL for an existing remote. *)
+
+val ensure_remote :
+  t -> name:string -> url:string -> (unit, [ `Msg of string ]) result
+(** [ensure_remote t ~name ~url] ensures a remote exists with the given URL.
+    Adds the remote if it doesn't exist, updates the URL if it differs. *)
+
+(** {1 Index operations} *)
+
+val read_index : t -> (Index.t, [ `Msg of string ]) result
+(** [read_index t] reads the index file. Returns empty index if none exists. *)
+
+val write_index : t -> Index.t -> unit
+(** [write_index t index] writes the index file. *)
+
+val add_to_index : t -> string list -> (unit, [ `Msg of string ]) result
+(** [add_to_index t paths] adds files to the index. Paths are relative to the
+    working directory. *)
+
+val remove_from_index : t -> string -> (unit, [ `Msg of string ]) result
+(** [remove_from_index t prefix] removes all entries under [prefix] from the
+    index. *)
+
+val add_all : t -> (unit, [ `Msg of string ]) result
+(** [add_all t] stages all changes in the working directory (equivalent to
+    [git add -A]). Adds new and modified files, removes deleted files. *)
+
+val commit : t -> message:string -> (Hash.t, [ `Msg of string ]) result
+(** [commit t ~message] creates a commit from the current index using the
+    author/committer from git config. Returns the commit hash. *)
+
+val rm : t -> recursive:bool -> string -> (unit, [ `Msg of string ]) result
+(** [rm t ~recursive path] removes [path] from the index and working tree. If
+    [recursive] is true, removes all entries under [path]. *)
+
+val commit_index :
+  t ->
+  author:User.t ->
+  committer:User.t ->
+  ?message:string ->
+  unit ->
+  (Hash.t, [ `Msg of string ]) result
+(** [commit_index t ~author ~committer ?message ()] creates a commit from the
+    current index and updates HEAD. Returns the commit hash. *)
+
+(** {1 Checkout operations} *)
+
+val checkout : t -> Hash.t -> (unit, [ `Msg of string ]) result
+(** [checkout t commit_hash] checks out the tree from the given commit to the
+    working directory. *)
+
+val checkout_prefix :
+  t -> Hash.t -> prefix:string -> (unit, [ `Msg of string ]) result
+(** [checkout_prefix t commit_hash ~prefix] checks out only the files under
+    [prefix] from the given commit to the working directory. *)
+
+val checkout_ref : t -> string -> (unit, [ `Msg of string ]) result
+(** [checkout_ref t ref_name] checks out the tree from the named ref. *)
+
+(** {1 Working tree status} *)
+
+val is_dirty : t -> bool
+(** [is_dirty t] returns [true] if the repository has uncommitted changes. Note:
+    This is a simplified implementation that may not detect all dirty states. *)
+
+(** {1 Ahead/behind computation} *)
+
+type ahead_behind = { ahead : int; behind : int }
+(** Commits ahead/behind relative to a remote branch. *)
+
+val ahead_behind :
+  t -> ?remote:string -> ?branch:string -> unit -> ahead_behind option
+(** [ahead_behind t ?remote ?branch ()] computes how many commits the local HEAD
+    is ahead/behind the remote tracking branch. Returns [None] if HEAD doesn't
+    exist.
+    @param remote Remote name (default: "origin").
+    @param branch Branch name (default: "main"). *)
+
+(** {1 Tree hash lookup} *)
+
+val tree_hash_at_path : t -> rev:string -> path:string -> Hash.t option
+(** [tree_hash_at_path t ~rev ~path] returns the tree hash at [path] within the
+    tree of [rev]. If [path] is empty, returns the root tree hash.
+    @param rev Reference name (e.g., "HEAD", "main").
+    @param path Path within the tree (e.g., "src/lib"). *)
+
+(** {1 Subtree operations} *)
+
+val subtree_last_upstream_commit : t -> prefix:string -> string option
+(** [subtree_last_upstream_commit t ~prefix] finds the upstream commit SHA that
+    the subtree was last synced from.
+
+    Searches commit history for the most recent subtree merge/squash commit for
+    the given prefix and extracts the upstream commit reference.
+
+    @param prefix Subtree directory name (e.g., "ocaml-bytesrw"). *)
+
+val has_subtree_history : t -> prefix:string -> bool
+(** [has_subtree_history t ~prefix] returns true if the prefix has subtree
+    commit history (i.e., was added via git subtree add). Returns false for
+    fresh local packages that were never part of a subtree. *)
+
+(** {1 Patch operations} *)
+
+val show_patch : t -> commit:string -> (string, [ `Msg of string ]) result
+(** [show_patch t ~commit] returns the patch for [commit] as a string, including
+    commit info, stat summary, and unified diffs. *)
+
+(** {1 Cherry-pick operations} *)
+
+val cherry_pick : t -> commit:string -> (Hash.t, [ `Msg of string ]) result
+(** [cherry_pick t ~commit] applies the changes from [commit] to the current
+    HEAD and creates a new commit with the same message. Returns the new commit
+    hash. *)
+
+(** {1 Merge operations} *)
+
+val merge :
+  t -> ref_name:string -> ff_only:bool -> (unit, [ `Msg of string ]) result
+(** [merge t ~ref_name ~ff_only] merges [ref_name] into the current HEAD. If
+    [ff_only] is true, only fast-forward merges are allowed. Currently only
+    fast-forward merges are implemented. *)
+
+(** {1 Worktree operations} *)
+
+val worktree : t -> Worktree.t
+(** [worktree t] returns a worktree manager for the repository. *)

lib/rev_list.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+type commit_info = { hash : Hash.t; parents : Hash.t list }
+
+(** Compute in-degrees for all commits in the graph. *)
+let compute_in_degrees graph =
+  let in_degree = Hashtbl.create (Hashtbl.length graph) in
+  Hashtbl.iter (fun h _ -> Hashtbl.replace in_degree h 0) graph;
+  Hashtbl.iter
+    (fun _ parents ->
+      List.iter
+        (fun p ->
+          if Hashtbl.mem graph p then
+            let d = Hashtbl.find in_degree p in
+            Hashtbl.replace in_degree p (d + 1))
+        parents)
+    graph;
+  in_degree
+
+(** Run Kahn's algorithm on graph with computed in-degrees. *)
+let kahn_sort graph in_degree =
+  let roots = Queue.create () in
+  Hashtbl.iter (fun h d -> if d = 0 then Queue.push h roots) in_degree;
+  let result = ref [] in
+  while not (Queue.is_empty roots) do
+    let h = Queue.pop roots in
+    let parents =
+      match Hashtbl.find_opt graph h with Some p -> p | None -> []
+    in
+    result := { hash = h; parents } :: !result;
+    List.iter
+      (fun p ->
+        if Hashtbl.mem graph p then begin
+          let d = Hashtbl.find in_degree p - 1 in
+          Hashtbl.replace in_degree p d;
+          if d = 0 then Queue.push p roots
+        end)
+      parents
+  done;
+  !result
+
+let topo_sort_reverse repo head ~stop =
+  let visited = Hashtbl.create 256 in
+  let graph = Hashtbl.create 256 in
+  let error = ref None in
+  let queue = Queue.create () in
+  Queue.push head queue;
+  while (not (Queue.is_empty queue)) && Option.is_none !error do
+    let h = Queue.pop queue in
+    if not (Hashtbl.mem visited h || stop h) then begin
+      Hashtbl.replace visited h ();
+      match Repository.read repo h with
+      | Ok (Value.Commit commit) ->
+          let parents = Commit.parents commit in
+          Hashtbl.replace graph h parents;
+          List.iter (fun p -> Queue.push p queue) parents
+      | Ok _ -> error := Some (`Msg (Fmt.str "%a is not a commit" Hash.pp h))
+      | Error e -> error := Some e
+    end
+  done;
+  match !error with
+  | Some e -> Error e
+  | None ->
+      let in_degree = compute_in_degrees graph in
+      Ok (kahn_sort graph in_degree)
+
+(** {1 Commit graph queries} *)
+
+let is_ancestor repo ~ancestor ~descendant =
+  (* Check if [ancestor] is reachable from [descendant] via parent traversal *)
+  if Hash.equal ancestor descendant then true
+  else
+    let visited = Hashtbl.create 256 in
+    let queue = Queue.create () in
+    Queue.push descendant queue;
+    let found = ref false in
+    while (not (Queue.is_empty queue)) && not !found do
+      let h = Queue.pop queue in
+      if Hash.equal h ancestor then found := true
+      else if not (Hashtbl.mem visited h) then begin
+        Hashtbl.replace visited h ();
+        match Repository.read repo h with
+        | Ok (Value.Commit commit) ->
+            List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+        | _ -> ()
+      end
+    done;
+    !found
+
+(** Expand one step from queue, checking for intersection with other visited
+    set. Returns Some hash if intersection found, None otherwise. *)
+let expand_bfs repo queue visited other_visited =
+  if Queue.is_empty queue then None
+  else
+    let h = Queue.pop queue in
+    if Hashtbl.mem other_visited h then Some h
+    else
+      match Repository.read repo h with
+      | Ok (Value.Commit commit) ->
+          List.fold_left
+            (fun acc p ->
+              match acc with
+              | Some _ -> acc
+              | None ->
+                  if not (Hashtbl.mem visited p) then begin
+                    Hashtbl.replace visited p ();
+                    if Hashtbl.mem other_visited p then Some p
+                    else begin
+                      Queue.push p queue;
+                      None
+                    end
+                  end
+                  else None)
+            None (Commit.parents commit)
+      | _ -> None
+
+let merge_base repo commit1 commit2 =
+  let visited1 = Hashtbl.create 256 in
+  let visited2 = Hashtbl.create 256 in
+  let queue1 = Queue.create () in
+  let queue2 = Queue.create () in
+  Queue.push commit1 queue1;
+  Queue.push commit2 queue2;
+  Hashtbl.replace visited1 commit1 ();
+  Hashtbl.replace visited2 commit2 ();
+  let result = ref None in
+  while
+    Option.is_none !result
+    && not (Queue.is_empty queue1 && Queue.is_empty queue2)
+  do
+    (match expand_bfs repo queue1 visited1 visited2 with
+    | Some h -> result := Some h
+    | None -> ());
+    if Option.is_none !result then
+      match expand_bfs repo queue2 visited2 visited1 with
+      | Some h -> result := Some h
+      | None -> ()
+  done;
+  !result
+
+let count_commits_between repo ~base ~head =
+  (* Count commits reachable from head but not from base *)
+  if Hash.equal base head then 0
+  else
+    let base_ancestors = Hashtbl.create 256 in
+    (* First, collect all ancestors of base *)
+    let queue = Queue.create () in
+    Queue.push base queue;
+    while not (Queue.is_empty queue) do
+      let h = Queue.pop queue in
+      if not (Hashtbl.mem base_ancestors h) then begin
+        Hashtbl.replace base_ancestors h ();
+        match Repository.read repo h with
+        | Ok (Value.Commit commit) ->
+            List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+        | _ -> ()
+      end
+    done;
+    (* Then count commits from head not in base_ancestors *)
+    let count = ref 0 in
+    let visited = Hashtbl.create 256 in
+    Queue.push head queue;
+    while not (Queue.is_empty queue) do
+      let h = Queue.pop queue in
+      if (not (Hashtbl.mem visited h)) && not (Hashtbl.mem base_ancestors h)
+      then begin
+        Hashtbl.replace visited h ();
+        incr count;
+        match Repository.read repo h with
+        | Ok (Value.Commit commit) ->
+            List.iter (fun p -> Queue.push p queue) (Commit.parents commit)
+        | _ -> ()
+      end
+    done;
+    !count
+
+type ahead_behind = { ahead : int; behind : int }
+
+let ahead_behind repo ~local ~remote =
+  (* Find how many commits local is ahead/behind remote *)
+  match merge_base repo local remote with
+  | None -> { ahead = 0; behind = 0 } (* No common ancestor *)
+  | Some base ->
+      let ahead = count_commits_between repo ~base ~head:local in
+      let behind = count_commits_between repo ~base ~head:remote in
+      { ahead; behind }

lib/rev_list.mli

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Commit graph traversal and topological ordering.
+
+    Implements the equivalent of [git rev-list --topo-order --reverse] by
+    reading commit objects directly from the repository.
+
+    {b Complexity.} Let [n] be the number of commits reachable from [head] (not
+    stopped by the predicate), [e] the total number of parent edges (bounded by
+    [k * n] where [k] is the max parents per commit, typically [k <= 2]).
+
+    - {b BFS traversal:} [O(n)] commit reads, [O(n)] hash table operations.
+    - {b Topological sort:} [O(n + e)] via Kahn's algorithm.
+    - {b Space:} [O(n + e)] for the in-memory graph. *)
+
+type commit_info = {
+  hash : Hash.t;  (** The commit hash. *)
+  parents : Hash.t list;  (** Parent commit hashes. *)
+}
+(** A commit with its parent references. *)
+
+val topo_sort_reverse :
+  Repository.t ->
+  Hash.t ->
+  stop:(Hash.t -> bool) ->
+  (commit_info list, [ `Msg of string ]) result
+(** [topo_sort_reverse repo head ~stop] returns commits reachable from [head] in
+    reverse topological order (ancestors first, [head] last).
+
+    Traversal stops at commits where [stop hash] returns true; those commits are
+    not included in the result. This allows skipping already-processed history
+    when a cache is available.
+
+    {b Time:} [O(n + e)] where [n] is the number of visited commits and [e] the
+    number of parent edges. {b Space:} [O(n + e)]. *)
+
+(** {1 Commit graph queries} *)
+
+val is_ancestor : Repository.t -> ancestor:Hash.t -> descendant:Hash.t -> bool
+(** [is_ancestor repo ~ancestor ~descendant] returns true if [ancestor] is
+    reachable from [descendant] by following parent links. *)
+
+val merge_base : Repository.t -> Hash.t -> Hash.t -> Hash.t option
+(** [merge_base repo commit1 commit2] finds the best common ancestor of two
+    commits using bidirectional BFS. Returns [None] if no common ancestor. *)
+
+val count_commits_between : Repository.t -> base:Hash.t -> head:Hash.t -> int
+(** [count_commits_between repo ~base ~head] returns the number of commits
+    reachable from [head] but not from [base]. *)
+
+type ahead_behind = { ahead : int; behind : int }
+(** Commit count comparison between local and remote refs. *)
+
+val ahead_behind : Repository.t -> local:Hash.t -> remote:Hash.t -> ahead_behind
+(** [ahead_behind repo ~local ~remote] computes how many commits [local] is
+    ahead/behind [remote]. *)

lib/subtree.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let src = Logs.Src.create "git.subtree" ~doc:"Git subtree operations"
+
+module L = (val Logs.src_log src : Logs.LOG)
+
+(** {1 Persistent cache} *)
+
+module Cache = struct
+  type t = { tbl : (Hash.t, Hash.t) Hashtbl.t }
+
+  let empty () = { tbl = Hashtbl.create 256 }
+  let find t h = Hashtbl.find_opt t.tbl h
+  let add t old_hash new_hash = Hashtbl.replace t.tbl old_hash new_hash
+  let mem t h = Hashtbl.mem t.tbl h
+
+  let cache_dir_name prefix =
+    (* Normalize prefix to a flat filename for cache storage. *)
+    let s = String.map (fun c -> if c = '/' then '_' else c) prefix in
+    (* Avoid "." as a filename (would conflict with the directory itself). *)
+    if s = "." || s = ".." then "_root_" else s
+
+  let load repo ~prefix =
+    let t = empty () in
+    let git_dir = Fpath.to_string (Repository.git_dir repo) in
+    let fs = Repository.fs repo in
+    let dir = cache_dir_name prefix in
+    let path = Eio.Path.(fs / git_dir / "subtree-cache" / dir) in
+    (try
+       let data = Eio.Path.load path in
+       let lines = String.split_on_char '\n' data in
+       List.iter
+         (fun line ->
+           if String.length line >= 81 then begin
+             (* Format: <40-hex-old> <40-hex-new> *)
+             let old_hex = String.sub line 0 40 in
+             let new_hex = String.sub line 41 40 in
+             Hashtbl.replace t.tbl (Hash.of_hex old_hex) (Hash.of_hex new_hex)
+           end)
+         lines
+     with Eio.Io _ | Invalid_argument _ -> ());
+    t
+
+  let save repo ~prefix t =
+    let git_dir = Fpath.to_string (Repository.git_dir repo) in
+    let fs = Repository.fs repo in
+    let dir = cache_dir_name prefix in
+    let cache_dir = Eio.Path.(fs / git_dir / "subtree-cache") in
+    (try Eio.Path.mkdir ~perm:0o755 cache_dir with Eio.Io _ -> ());
+    let path = Eio.Path.(cache_dir / dir) in
+    let buf = Buffer.create (Hashtbl.length t.tbl * 82) in
+    Hashtbl.iter
+      (fun old_hash new_hash ->
+        Buffer.add_string buf (Hash.to_hex old_hash);
+        Buffer.add_char buf ' ';
+        Buffer.add_string buf (Hash.to_hex new_hash);
+        Buffer.add_char buf '\n')
+      t.tbl;
+    Eio.Path.save ~create:(`Or_truncate 0o644) path (Buffer.contents buf)
+
+  let iter t f = Hashtbl.iter f t.tbl
+  let length t = Hashtbl.length t.tbl
+
+  let clear repo ~prefix =
+    let git_dir = Fpath.to_string (Repository.git_dir repo) in
+    let fs = Repository.fs repo in
+    let dir = cache_dir_name prefix in
+    let path = Eio.Path.(fs / git_dir / "subtree-cache" / dir) in
+    try Eio.Path.unlink path with Eio.Io _ -> ()
+end
+
+(** {1 Tree operations} *)
+
+let tree_at_prefix repo tree_hash prefix =
+  (* Split prefix into path segments. O(d) where d = depth. *)
+  let segments =
+    String.split_on_char '/' prefix |> List.filter (fun s -> s <> "")
+  in
+  (* Walk the tree path, reading one tree object per segment.
+     Each Tree.find is O(e) where e = number of entries (linear scan). *)
+  let rec walk hash = function
+    | [] -> Some hash
+    | seg :: rest -> (
+        match Repository.read repo hash with
+        | Ok (Value.Tree tree) -> (
+            match Tree.find ~name:seg tree with
+            | Some entry when entry.perm = `Dir -> walk entry.hash rest
+            | _ -> None)
+        | _ -> None)
+  in
+  walk tree_hash segments
+
+(** {1 Split} *)
+
+(** Extract a metadata value from commit message. Looks for "<key>: <value>"
+    pattern in the message lines. *)
+let extract_metadata key message =
+  match message with
+  | None -> None
+  | Some msg ->
+      let prefix = key ^ ": " in
+      let prefix_len = String.length prefix in
+      let rec find_in_lines = function
+        | [] -> None
+        | line :: rest ->
+            let line = String.trim line in
+            if
+              String.length line > prefix_len
+              && String.sub line 0 prefix_len = prefix
+            then
+              Some
+                (String.sub line prefix_len (String.length line - prefix_len))
+            else find_in_lines rest
+      in
+      find_in_lines (String.split_on_char '\n' msg)
+
+(** Extract subtree directory from commit message if present. *)
+let extract_subtree_dir message = extract_metadata "git-subtree-dir" message
+
+(** Check if subtree is unchanged from first parent (copy_or_skip optimization).
+    For merge commits, skip if the subtree didn't change from the first parent -
+    this filters out unrelated cross-package merges from the history. *)
+let should_skip_commit repo new_parents sub_hash =
+  match new_parents with
+  | first_parent :: _ -> (
+      match Repository.read repo first_parent with
+      | Ok (Value.Commit pc) ->
+          let dominated = Hash.equal sub_hash (Commit.tree pc) in
+          if not dominated then
+            L.debug (fun m ->
+                m "not skipping: sub=%s parent_tree=%s" (Hash.to_hex sub_hash)
+                  (Hash.to_hex (Commit.tree pc)));
+          dominated
+      | Ok _ ->
+          L.debug (fun m -> m "not skipping: not a commit");
+          false
+      | Error _ ->
+          L.debug (fun m -> m "not skipping: read error");
+          false)
+  | [] -> false
+
+(** Process a single commit for split operation. *)
+let process_split_commit repo cache prefix { Rev_list.hash; parents } =
+  match Repository.read repo hash with
+  | Error _ -> Cache.add cache hash Hash.null
+  | Ok (Value.Commit commit) -> (
+      let tree_hash = Commit.tree commit in
+      match tree_at_prefix repo tree_hash prefix with
+      | None -> Cache.add cache hash Hash.null
+      | Some sub_hash ->
+          (* Map all parents through cache *)
+          let new_parents =
+            List.filter_map
+              (fun p ->
+                match Cache.find cache p with
+                | Some h when not (Hash.equal h Hash.null) -> Some h
+                | _ -> None)
+              parents
+          in
+          if should_skip_commit repo new_parents sub_hash then
+            Cache.add cache hash (List.hd new_parents)
+          else
+            let new_commit =
+              Commit.v ~tree:sub_hash ~author:(Commit.author commit)
+                ~committer:(Commit.committer commit) ~parents:new_parents
+                ~extra:(Commit.extra commit) (Commit.message commit)
+            in
+            Cache.add cache hash (Repository.write_commit repo new_commit))
+  | _ -> Cache.add cache hash Hash.null
+
+let split repo ~prefix ~head () =
+  let cache = Cache.load repo ~prefix in
+  match Cache.find cache head with
+  | Some h -> Ok (if Hash.equal h Hash.null then None else Some h)
+  | None -> (
+      match Rev_list.topo_sort_reverse repo head ~stop:(Cache.mem cache) with
+      | Error e -> Error e
+      | Ok commits ->
+          List.iter (process_split_commit repo cache prefix) commits;
+          Cache.save repo ~prefix cache;
+          Ok
+            (match Cache.find cache head with
+            | Some h when Hash.equal h Hash.null -> None
+            | other -> other))
+
+type verify_error = { original : Hash.t; split : Hash.t; reason : string }
+
+let verify repo ~prefix () =
+  let cache = Cache.load repo ~prefix in
+  let errors = ref [] in
+  let checked = ref 0 in
+  Cache.iter cache (fun orig split ->
+      incr checked;
+      if not (Hash.equal split Hash.null) then
+        match (Repository.read repo orig, Repository.read repo split) with
+        | Ok (Value.Commit orig_c), Ok (Value.Commit split_c) -> (
+            (* Check tree matches subtree at prefix *)
+            match tree_at_prefix repo (Commit.tree orig_c) prefix with
+            | None ->
+                errors :=
+                  {
+                    original = orig;
+                    split;
+                    reason = "original has no subtree at prefix";
+                  }
+                  :: !errors
+            | Some expected_tree ->
+                if not (Hash.equal expected_tree (Commit.tree split_c)) then begin
+                  let short h = String.sub (Hash.to_hex h) 0 7 in
+                  errors :=
+                    {
+                      original = orig;
+                      split;
+                      reason =
+                        Fmt.str "tree mismatch: expected %s, got %s"
+                          (short expected_tree)
+                          (short (Commit.tree split_c));
+                    }
+                    :: !errors
+                end)
+        | Error _, _ ->
+            errors :=
+              { original = orig; split; reason = "cannot read original commit" }
+              :: !errors
+        | _, Error _ ->
+            errors :=
+              { original = orig; split; reason = "cannot read split commit" }
+              :: !errors
+        | _ -> ());
+  (!checked, List.rev !errors)
+
+(** {1 Add} *)
+
+let insert_tree_at_prefix repo base_tree_hash prefix subtree_hash =
+  (* Split prefix into path segments. *)
+  let segments =
+    String.split_on_char '/' prefix |> List.filter (fun s -> s <> "")
+  in
+  (* Recursively build trees from the deepest level up.
+     For each level, we need to either modify an existing tree or create a new one. *)
+  let rec build_trees current_tree_hash = function
+    | [] ->
+        (* No more segments - replace with subtree *)
+        Ok subtree_hash
+    | [ name ] -> (
+        (* Last segment - insert subtree here *)
+        match Repository.read repo current_tree_hash with
+        | Error e -> Error e
+        | Ok (Value.Tree tree) ->
+            let new_tree =
+              tree |> Tree.remove ~name
+              |> Tree.add (Tree.entry ~perm:`Dir ~name subtree_hash)
+            in
+            Ok (Repository.write_tree repo new_tree)
+        | _ -> Error (`Msg "Expected tree object"))
+    | name :: rest -> (
+        (* Intermediate segment - descend or create *)
+        match Repository.read repo current_tree_hash with
+        | Error e -> Error e
+        | Ok (Value.Tree tree) -> (
+            let existing_entry = Tree.find ~name tree in
+            let child_hash =
+              match existing_entry with
+              | Some entry when entry.perm = `Dir -> entry.hash
+              | _ ->
+                  (* No existing dir or not a dir - use empty tree *)
+                  Repository.write_tree repo Tree.empty
+            in
+            match build_trees child_hash rest with
+            | Error e -> Error e
+            | Ok new_child_hash ->
+                let new_tree =
+                  tree |> Tree.remove ~name
+                  |> Tree.add (Tree.entry ~perm:`Dir ~name new_child_hash)
+                in
+                Ok (Repository.write_tree repo new_tree))
+        | _ -> Error (`Msg "Expected tree object"))
+  in
+  match segments with
+  | [] ->
+      (* Empty prefix means replace root tree entirely *)
+      Ok subtree_hash
+  | _ -> build_trees base_tree_hash segments
+
+(** Build a nested tree structure from a list of path segments. *)
+let build_nested_tree repo remote_tree segments =
+  let rec build = function
+    | [] -> remote_tree
+    | [ name ] ->
+        Repository.write_tree repo
+          (Tree.v [ Tree.entry ~perm:`Dir ~name remote_tree ])
+    | name :: rest ->
+        let child = build rest in
+        Repository.write_tree repo
+          (Tree.v [ Tree.entry ~perm:`Dir ~name child ])
+  in
+  build segments
+
+(** Default message for add/merge operations. *)
+let default_add_message op prefix commit =
+  Fmt.str "%s '%s' from commit %s\n" op prefix (Hash.to_hex commit)
+
+let add repo ~prefix ~commit ~author ~committer ?message () =
+  match Repository.read repo commit with
+  | Error e -> Error e
+  | Ok (Value.Commit remote_commit) -> (
+      let remote_tree = Commit.tree remote_commit in
+      let msg =
+        Option.value message ~default:(default_add_message "Add" prefix commit)
+      in
+      match Repository.head repo with
+      | None ->
+          let segments =
+            String.split_on_char '/' prefix |> List.filter (( <> ) "")
+          in
+          let root_tree = build_nested_tree repo remote_tree segments in
+          let new_commit =
+            Commit.v ~tree:root_tree ~author ~committer ~parents:[ commit ]
+              (Some msg)
+          in
+          let new_hash = Repository.write_commit repo new_commit in
+          Repository.advance_head repo new_hash;
+          Ok new_hash
+      | Some head_hash -> (
+          match Repository.read repo head_hash with
+          | Error e -> Error e
+          | Ok (Value.Commit head_commit) -> (
+              match
+                insert_tree_at_prefix repo (Commit.tree head_commit) prefix
+                  remote_tree
+              with
+              | Error e -> Error e
+              | Ok new_tree ->
+                  let new_commit =
+                    Commit.v ~tree:new_tree ~author ~committer
+                      ~parents:[ head_hash; commit ] (Some msg)
+                  in
+                  let new_hash = Repository.write_commit repo new_commit in
+                  Repository.advance_head repo new_hash;
+                  Ok new_hash)
+          | _ -> Error (`Msg "HEAD does not point to a commit")))
+  | _ -> Error (`Msg "Not a commit object")
+
+let merge repo ~prefix ~commit ~author ~committer ?message () =
+  (* Get the tree from the commit we're merging *)
+  match Repository.read repo commit with
+  | Error e -> Error e
+  | Ok (Value.Commit remote_commit) -> (
+      let remote_tree = Commit.tree remote_commit in
+      (* Get current HEAD *)
+      match Repository.head repo with
+      | None -> Error (`Msg "No HEAD - use add for initial subtree")
+      | Some head_hash -> (
+          match Repository.read repo head_hash with
+          | Error e -> Error e
+          | Ok (Value.Commit head_commit) -> (
+              let base_tree = Commit.tree head_commit in
+              (* Check that subtree exists at prefix *)
+              match tree_at_prefix repo base_tree prefix with
+              | None -> Error (`Msg ("Subtree not found at prefix: " ^ prefix))
+              | Some _ -> (
+                  (* Replace the subtree at prefix with the remote tree *)
+                  match
+                    insert_tree_at_prefix repo base_tree prefix remote_tree
+                  with
+                  | Error e -> Error e
+                  | Ok new_tree ->
+                      let message =
+                        match message with
+                        | Some m -> m
+                        | None ->
+                            Fmt.str "Merge '%s' from commit %s\n" prefix
+                              (Hash.to_hex commit)
+                      in
+                      (* Create merge commit with two parents *)
+                      let new_commit =
+                        Commit.v ~tree:new_tree ~author ~committer
+                          ~parents:[ head_hash; commit ] (Some message)
+                      in
+                      let new_hash = Repository.write_commit repo new_commit in
+                      Repository.advance_head repo new_hash;
+                      Ok new_hash))
+          | _ -> Error (`Msg "HEAD does not point to a commit")))
+  | _ -> Error (`Msg "Not a commit object")
+
+(** {1 Check and Fix} *)
+
+type issue = { commit : Hash.t; message : string; subtree_dir : string option }
+
+(** Check if a commit message indicates a subtree merge for a different package.
+*)
+let is_unrelated_merge ~prefix message =
+  match extract_subtree_dir message with
+  | None -> None (* Not a subtree merge *)
+  | Some dir ->
+      if
+        String.equal dir prefix
+        || String.starts_with ~prefix:(prefix ^ "/") dir
+        || String.starts_with ~prefix:(dir ^ "/") prefix
+      then None (* Related to our prefix *)
+      else Some dir
+
+let check repo ~prefix ~head () =
+  let issues = ref [] in
+  let checked = ref 0 in
+  (* Walk the commit history *)
+  let rec walk visited hash =
+    if Hash.equal hash Hash.null || Hashtbl.mem visited hash then ()
+    else begin
+      Hashtbl.add visited hash ();
+      match Repository.read repo hash with
+      | Ok (Value.Commit commit) ->
+          incr checked;
+          let message = Commit.message commit in
+          (* Check if this is an unrelated subtree merge *)
+          (match message with
+          | Some msg -> (
+              match is_unrelated_merge ~prefix message with
+              | Some dir ->
+                  issues :=
+                    { commit = hash; message = msg; subtree_dir = Some dir }
+                    :: !issues
+              | None -> ())
+          | None -> ());
+          (* Continue walking parents *)
+          List.iter (walk visited) (Commit.parents commit)
+      | _ -> ()
+    end
+  in
+  let visited = Hashtbl.create 1024 in
+  walk visited head;
+  (!checked, List.rev !issues)
+
+(** Process a single commit for fix rewriting. Determines if the commit is a
+    self-merge, unrelated merge, or regular commit, and either skips it or
+    rewrites it with remapped parents. *)
+let rewrite_commit repo ~prefix ~cache commit hash parents =
+  let message = Commit.message commit in
+  let tree = Commit.tree commit in
+  (* Get remapped parents, filtering out null hashes *)
+  let new_parents =
+    List.filter_map
+      (fun p ->
+        match Hashtbl.find_opt cache p with
+        | Some h when not (Hash.equal h Hash.null) -> Some h
+        | _ -> None)
+      parents
+  in
+  (* Check subtree merge type *)
+  let subtree_dir = extract_subtree_dir message in
+  let is_unrelated =
+    match subtree_dir with
+    | None -> false
+    | Some dir ->
+        not
+          (String.equal dir prefix
+          || String.starts_with ~prefix:(prefix ^ "/") dir
+          || String.starts_with ~prefix:(dir ^ "/") prefix)
+  in
+  let is_self_merge =
+    match subtree_dir with
+    | None -> false
+    | Some dir ->
+        String.equal dir prefix
+        || String.starts_with ~prefix:(prefix ^ "/") dir
+        || String.starts_with ~prefix:(dir ^ "/") prefix
+  in
+  (* Determine action:
+     - Self-merges: skip if tree unchanged from first parent (linearize)
+     - Unrelated merges: skip if tree unchanged from first parent
+     - Otherwise: keep the commit with remapped parents *)
+  let action =
+    if is_self_merge || is_unrelated then
+      (* Skip if tree unchanged from first parent *)
+      match new_parents with
+      | first :: _ -> (
+          match Repository.read repo first with
+          | Ok (Value.Commit pc) when Hash.equal tree (Commit.tree pc) ->
+              `Skip_to first
+          | _ -> `Keep)
+      | [] -> `Keep
+    else `Keep
+  in
+  match action with
+  | `Skip_to parent -> Hashtbl.add cache hash parent
+  | `Keep ->
+      let new_commit =
+        Commit.v ~tree ~author:(Commit.author commit)
+          ~committer:(Commit.committer commit) ~parents:new_parents
+          ~extra:(Commit.extra commit) message
+      in
+      Hashtbl.add cache hash (Repository.write_commit repo new_commit)
+
+let fix repo ~prefix ~head () =
+  (* Rewrite history, removing subtree merge commits:
+     1. Unrelated merges (git-subtree-dir for a different prefix) - skip if tree
+        unchanged from first parent
+     2. Self-merges (git-subtree-dir matches our prefix) - follow mainline parent
+        to linearize history *)
+  let cache = Hashtbl.create 1024 in
+  (* Process commits in reverse topological order *)
+  match Rev_list.topo_sort_reverse repo head ~stop:(fun _ -> false) with
+  | Error e -> Error e
+  | Ok commits ->
+      List.iter
+        (fun { Rev_list.hash; parents } ->
+          match Repository.read repo hash with
+          | Ok (Value.Commit commit) ->
+              rewrite_commit repo ~prefix ~cache commit hash parents
+          | Ok (Value.Blob _ | Value.Tree _ | Value.Tag _) ->
+              Hashtbl.add cache hash Hash.null
+          | Error _ -> Hashtbl.add cache hash Hash.null)
+        commits;
+      Ok (Hashtbl.find_opt cache head)
+
+type mono_issue = {
+  mono_commit : Hash.t;
+  mono_message : string;
+  is_empty : bool;
+}
+
+let check_mono repo ~head () =
+  match Rev_list.topo_sort_reverse repo head ~stop:(fun _ -> false) with
+  | Error _ -> (0, [])
+  | Ok commits ->
+      let issues = ref [] in
+      let count = ref 0 in
+      List.iter
+        (fun { Rev_list.hash; parents } ->
+          incr count;
+          match Repository.read repo hash with
+          | Ok (Value.Commit commit) ->
+              let message = Option.value ~default:"" (Commit.message commit) in
+              let tree = Commit.tree commit in
+              let is_empty =
+                match parents with
+                | first :: _ -> (
+                    match Repository.read repo first with
+                    | Ok (Value.Commit pc) -> Hash.equal tree (Commit.tree pc)
+                    | _ -> false)
+                | [] -> false
+              in
+              if is_empty then
+                issues :=
+                  { mono_commit = hash; mono_message = message; is_empty }
+                  :: !issues
+          | _ -> ())
+        commits;
+      (!count, List.rev !issues)
+
+let fix_mono repo ~head () =
+  (* Rewrite history, removing all empty commits. *)
+  let cache = Hashtbl.create 1024 in
+  match Rev_list.topo_sort_reverse repo head ~stop:(fun _ -> false) with
+  | Error e -> Error e
+  | Ok commits ->
+      List.iter
+        (fun { Rev_list.hash; parents } ->
+          match Repository.read repo hash with
+          | Ok (Value.Commit commit) ->
+              let message = Commit.message commit in
+              let tree = Commit.tree commit in
+              (* Get remapped parents, filtering out null hashes *)
+              let new_parents =
+                List.filter_map
+                  (fun p ->
+                    match Hashtbl.find_opt cache p with
+                    | Some h when not (Hash.equal h Hash.null) -> Some h
+                    | None -> Some p (* Parent not in cache, keep original *)
+                    | _ -> None)
+                  parents
+              in
+              (* Check if this is an empty commit (tree unchanged from first parent) *)
+              let is_empty =
+                match new_parents with
+                | first :: _ -> (
+                    match Repository.read repo first with
+                    | Ok (Value.Commit pc) -> Hash.equal tree (Commit.tree pc)
+                    | _ -> false)
+                | [] -> false
+              in
+              if is_empty then
+                (* Skip to first parent *)
+                match new_parents with
+                | first :: _ -> Hashtbl.add cache hash first
+                | [] -> Hashtbl.add cache hash Hash.null
+              else
+                (* Keep the commit with remapped parents *)
+                let new_commit =
+                  Commit.v ~tree ~author:(Commit.author commit)
+                    ~committer:(Commit.committer commit) ~parents:new_parents
+                    ~extra:(Commit.extra commit) message
+                in
+                Hashtbl.add cache hash (Repository.write_commit repo new_commit)
+          | Ok (Value.Blob _ | Value.Tree _ | Value.Tag _) ->
+              Hashtbl.add cache hash Hash.null
+          | Error _ -> Hashtbl.add cache hash Hash.null)
+        commits;
+      Ok (Hashtbl.find_opt cache head)

lib/subtree.mli

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Fast subtree split for git repositories.
+
+    Implements the [git subtree split] algorithm natively in OCaml, avoiding the
+    per-commit subprocess overhead of the shell script implementation. Uses
+    persistent caching for incremental performance.
+
+    {b Complexity analysis.} Let [n] be the number of commits reachable from
+    HEAD, [c] the number of commits already in the cache, and [d] the depth of
+    the prefix path (number of [/]-separated segments). Let [k] be the maximum
+    number of parents per commit (usually [k <= 2]).
+
+    - {b First run:} [O((n - c) * (d + k))] object reads, [O((n - c) * k)] hash
+      comparisons, [O(n - c)] commit writes (worst case).
+    - {b Cached run:} [O(1)] — cache lookup for HEAD returns immediately.
+    - {b Topological sort:} [O(n - c)] using Kahn's algorithm with BFS
+      traversal.
+    - {b Cache I/O:} [O(n)] for load/save (linear scan of the cache file).
+    - {b Space:} [O(n)] for the commit graph and cache in memory. *)
+
+(** {1 Persistent cache} *)
+
+module Cache : sig
+  type t
+  (** A cache mapping original commit hashes to their split counterparts.
+
+      Invariant: if [find t h = Some h'], then [h'] is the split commit for [h]
+      and the entire ancestry of [h] is also cached. The sentinel value
+      [Hash.null] means "this commit has no content at the prefix". *)
+
+  val empty : unit -> t
+  (** [empty ()] creates an empty cache. [O(1)]. *)
+
+  val load : Repository.t -> prefix:string -> t
+  (** [load repo ~prefix] loads the cache for [prefix] from
+      [.git/subtree-cache/<prefix>]. Returns an empty cache if the file does not
+      exist. [O(n)] where [n] is the number of cached entries. *)
+
+  val save : Repository.t -> prefix:string -> t -> unit
+  (** [save repo ~prefix t] persists the cache to disk. [O(n)]. *)
+
+  val find : t -> Hash.t -> Hash.t option
+  (** [find t h] returns the cached split hash for [h], or [None]. [O(1)]
+      amortized (hash table lookup). *)
+
+  val add : t -> Hash.t -> Hash.t -> unit
+  (** [add t old_hash new_hash] records a mapping. [O(1)] amortized. *)
+
+  val mem : t -> Hash.t -> bool
+  (** [mem t h] returns [true] if [h] has a cached mapping. [O(1)] amortized. *)
+
+  val iter : t -> (Hash.t -> Hash.t -> unit) -> unit
+  (** [iter t f] applies [f] to each mapping in the cache. *)
+
+  val length : t -> int
+  (** [length t] returns the number of entries in the cache. *)
+
+  val clear : Repository.t -> prefix:string -> unit
+  (** [clear repo ~prefix] removes the cache file for [prefix]. *)
+end
+
+(** {1 Tree operations} *)
+
+val tree_at_prefix : Repository.t -> Hash.t -> string -> Hash.t option
+(** [tree_at_prefix repo tree_hash prefix] resolves the tree object at [prefix]
+    within the tree [tree_hash]. The prefix is [/]-separated (e.g.,
+    ["src/lib"]).
+
+    [O(d)] object reads where [d] is the depth of the prefix path. Each read is
+    [O(e)] where [e] is the number of entries in the tree (binary search within
+    the sorted entry list). *)
+
+(** {1 Split} *)
+
+val split :
+  Repository.t ->
+  prefix:string ->
+  head:Hash.t ->
+  unit ->
+  (Hash.t option, [ `Msg of string ]) result
+(** [split repo ~prefix ~head ()] extracts the history of [prefix] into a
+    standalone commit chain. Each commit that touches [prefix] is rewritten so
+    that the subtree at [prefix] becomes the root tree, preserving author,
+    committer, message, and extra headers.
+
+    Returns [Ok (Some hash)] with the new head, or [Ok None] if no commit
+    touches the prefix.
+
+    Uses a persistent cache stored in [.git/subtree-cache/<prefix>]:
+    - On a full cache hit (HEAD already cached): [O(1)].
+    - On a cold cache: [O(n * (d + k))] where [n] = commit count, [d] = prefix
+      depth, [k] = max parents per commit.
+    - Incremental (m new commits since last split): [O(m * (d + k))].
+
+    The resulting commit hashes are compatible with [git subtree split]: the
+    same tree objects are reused, and commit metadata is preserved verbatim, so
+    identical inputs produce identical SHA-1s. *)
+
+type verify_error = {
+  original : Hash.t;  (** The original monorepo commit. *)
+  split : Hash.t;  (** The split commit in the cache. *)
+  reason : string;  (** Description of the validation failure. *)
+}
+(** Verification error details. *)
+
+val verify : Repository.t -> prefix:string -> unit -> int * verify_error list
+(** [verify repo ~prefix ()] validates the cache for [prefix].
+
+    Returns [(checked, errors)] where [checked] is the number of cache entries
+    examined and [errors] contains any validation failures found.
+
+    Checks performed:
+    - Split commit tree matches the subtree at [prefix] in the original
+    - Subtree merge commits include the mainline as a parent
+
+    This is a lightweight O(n) check where n is the cache size. *)
+
+(** {1 Add} *)
+
+val add :
+  Repository.t ->
+  prefix:string ->
+  commit:Hash.t ->
+  author:User.t ->
+  committer:User.t ->
+  ?message:string ->
+  unit ->
+  (Hash.t, [ `Msg of string ]) result
+(** [add repo ~prefix ~commit ~author ~committer ?message ()] incorporates the
+    tree from [commit] at [prefix] in the current repository, creating a merge
+    commit.
+
+    If [message] is not provided, a default message is generated.
+
+    The resulting commit has two parents: the current HEAD and [commit]. This
+    preserves the history of the added subtree for future [split] operations.
+
+    Returns [Ok hash] with the new commit hash, or [Error] if something goes
+    wrong (e.g., [commit] is not a valid commit object).
+
+    If the repository has no HEAD (empty repository), creates an initial commit
+    with the subtree at [prefix] and [commit] as the sole parent. *)
+
+val merge :
+  Repository.t ->
+  prefix:string ->
+  commit:Hash.t ->
+  author:User.t ->
+  committer:User.t ->
+  ?message:string ->
+  unit ->
+  (Hash.t, [ `Msg of string ]) result
+(** [merge repo ~prefix ~commit ~author ~committer ?message ()] merges updates
+    from [commit] into an existing subtree at [prefix].
+
+    This is the native equivalent of [git subtree pull]. The subtree at [prefix]
+    is replaced with the tree from [commit], and a merge commit is created with
+    the current HEAD and [commit] as parents.
+
+    Returns [Error] if the subtree doesn't exist at [prefix] (use [add] for new
+    subtrees). *)
+
+(** {1 Check and Fix} *)
+
+type issue = {
+  commit : Hash.t;  (** The problematic commit. *)
+  message : string;  (** The commit message. *)
+  subtree_dir : string option;  (** The git-subtree-dir if present. *)
+}
+(** Issue found during history check. *)
+
+val check :
+  Repository.t -> prefix:string -> head:Hash.t -> unit -> int * issue list
+(** [check repo ~prefix ~head ()] scans the commit history reachable from [head]
+    and detects unrelated subtree merge commits.
+
+    A commit is considered unrelated if it has a [git-subtree-dir] metadata that
+    doesn't match [prefix].
+
+    Returns [(checked, issues)] where [checked] is the number of commits
+    examined and [issues] contains the problematic commits. *)
+
+val fix :
+  Repository.t ->
+  prefix:string ->
+  head:Hash.t ->
+  unit ->
+  (Hash.t option, [ `Msg of string ]) result
+(** [fix repo ~prefix ~head ()] rewrites the commit history reachable from
+    [head], removing unrelated subtree merge commits.
+
+    A commit is removed if:
+    - It has a [git-subtree-dir] metadata for a different prefix
+    - Its tree is unchanged from its first parent (no actual changes)
+
+    Returns [Ok (Some new_head)] with the rewritten head, or [Ok None] if the
+    history is empty after filtering. *)
+
+(** {1 Empty commit cleanup} *)
+
+type mono_issue = {
+  mono_commit : Hash.t;  (** The empty commit. *)
+  mono_message : string;  (** The commit message. *)
+  is_empty : bool;  (** Always true (kept for consistency). *)
+}
+(** Empty commit found during history check. *)
+
+val check_mono : Repository.t -> head:Hash.t -> unit -> int * mono_issue list
+(** [check_mono repo ~head ()] scans the commit history reachable from [head]
+    and detects empty commits.
+
+    A commit is considered empty if its tree is identical to its first parent's
+    tree (no actual file changes).
+
+    Returns [(checked, issues)] where [checked] is the number of commits
+    examined and [issues] contains the empty commits. *)
+
+val fix_mono :
+  Repository.t ->
+  head:Hash.t ->
+  unit ->
+  (Hash.t option, [ `Msg of string ]) result
+(** [fix_mono repo ~head ()] rewrites the commit history reachable from [head],
+    removing all empty commits.
+
+    A commit is removed if its tree is unchanged from its first parent (no
+    actual file changes). The commit is replaced by its first parent in the
+    history.
+
+    Returns [Ok (Some new_head)] with the rewritten head, or [Ok None] if the
+    history is empty after filtering. *)

lib/tag.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git tag objects. *)
+
+type kind = Blob | Commit | Tag | Tree
+
+let kind_to_string = function
+  | Blob -> "blob"
+  | Commit -> "commit"
+  | Tag -> "tag"
+  | Tree -> "tree"
+
+let kind_of_string = function
+  | "blob" -> Ok Blob
+  | "commit" -> Ok Commit
+  | "tag" -> Ok Tag
+  | "tree" -> Ok Tree
+  | s -> Error (`Msg ("Invalid tag kind: " ^ s))
+
+let kind_of_string_exn s =
+  match kind_of_string s with Ok k -> k | Error (`Msg m) -> invalid_arg m
+
+type t = {
+  obj : Hash.t;
+  kind : kind;
+  tag : string;
+  tagger : User.t option;
+  message : string option;
+}
+
+let v obj kind ?tagger ~tag message = { obj; kind; tag; tagger; message }
+let obj t = t.obj
+let kind t = t.kind
+let name t = t.tag
+let tagger t = t.tagger
+let message t = t.message
+
+let pp ppf t =
+  Fmt.pf ppf "@[<v>object %a@," Hash.pp t.obj;
+  Fmt.pf ppf "type %s@," (kind_to_string t.kind);
+  Fmt.pf ppf "tag %s@," t.tag;
+  (match t.tagger with
+  | Some tagger -> Fmt.pf ppf "tagger %a@," User.pp tagger
+  | None -> ());
+  (match t.message with Some msg -> Fmt.pf ppf "@,%s" msg | None -> ());
+  Fmt.pf ppf "@]"
+
+let equal a b =
+  Hash.equal a.obj b.obj && a.kind = b.kind && String.equal a.tag b.tag
+
+let compare a b =
+  match Hash.compare a.obj b.obj with
+  | 0 -> (
+      match Stdlib.compare a.kind b.kind with
+      | 0 -> String.compare a.tag b.tag
+      | n -> n)
+  | n -> n
+
+let hash t = Hashtbl.hash t
+
+(** Encode tag to git format. *)
+let to_string t =
+  let buf = Buffer.create 256 in
+  Buffer.add_string buf "object ";
+  Buffer.add_string buf (Hash.to_hex t.obj);
+  Buffer.add_char buf '\n';
+  Buffer.add_string buf "type ";
+  Buffer.add_string buf (kind_to_string t.kind);
+  Buffer.add_char buf '\n';
+  Buffer.add_string buf "tag ";
+  Buffer.add_string buf t.tag;
+  Buffer.add_char buf '\n';
+  (match t.tagger with
+  | Some tagger ->
+      Buffer.add_string buf "tagger ";
+      Buffer.add_string buf (User.to_string tagger);
+      Buffer.add_char buf '\n'
+  | None -> ());
+  (match t.message with
+  | Some msg ->
+      Buffer.add_char buf '\n';
+      Buffer.add_string buf msg
+  | None -> ());
+  Buffer.contents buf
+
+(** Parse a single header line. *)
+let parse_header line =
+  match String.index_opt line ' ' with
+  | None -> None
+  | Some pos ->
+      let key = String.sub line 0 pos in
+      let value = String.sub line (pos + 1) (String.length line - pos - 1) in
+      Some (key, value)
+
+(** Parse tag from git format. *)
+let of_string s =
+  let lines = String.split_on_char '\n' s in
+  let rec parse_headers obj kind tag tagger = function
+    | [] -> (
+        (* No message *)
+        match (obj, kind, tag) with
+        | Some obj, Some kind, Some tag ->
+            Ok { obj; kind; tag; tagger; message = None }
+        | None, _, _ -> Error (`Msg "Missing object in tag")
+        | _, None, _ -> Error (`Msg "Missing type in tag")
+        | _, _, None -> Error (`Msg "Missing tag name in tag"))
+    | "" :: rest -> (
+        (* Empty line marks start of message *)
+        let message =
+          match rest with [] -> None | _ -> Some (String.concat "\n" rest)
+        in
+        match (obj, kind, tag) with
+        | Some obj, Some kind, Some tag ->
+            Ok { obj; kind; tag; tagger; message }
+        | None, _, _ -> Error (`Msg "Missing object in tag")
+        | _, None, _ -> Error (`Msg "Missing type in tag")
+        | _, _, None -> Error (`Msg "Missing tag name in tag"))
+    | line :: rest -> (
+        match parse_header line with
+        | None -> Error (`Msg ("Invalid header line: " ^ line))
+        | Some ("object", hex) ->
+            let obj = Hash.of_hex hex in
+            parse_headers (Some obj) kind tag tagger rest
+        | Some ("type", type_str) -> (
+            match kind_of_string type_str with
+            | Ok k -> parse_headers obj (Some k) tag tagger rest
+            | Error _ as e -> e)
+        | Some ("tag", tag_name) ->
+            parse_headers obj kind (Some tag_name) tagger rest
+        | Some ("tagger", user_str) -> (
+            match User.of_string user_str with
+            | Ok user -> parse_headers obj kind tag (Some user) rest
+            | Error _ as e -> e)
+        | Some (_key, _value) ->
+            (* Skip unknown headers *)
+            parse_headers obj kind tag tagger rest)
+  in
+  parse_headers None None None None lines
+
+let of_string_exn s =
+  match of_string s with Ok t -> t | Error (`Msg m) -> failwith m
+
+let digest t =
+  let s = to_string t in
+  Hash.digest_string ~kind:`Tag s
+
+module Set = Set.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)
+
+module Map = Map.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)

lib/tag.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git tag objects. *)
+
+type kind =
+  | Blob
+  | Commit
+  | Tag
+  | Tree  (** The kind of object being tagged. *)
+
+val kind_to_string : kind -> string
+(** Convert kind to string. *)
+
+val kind_of_string : string -> (kind, [ `Msg of string ]) result
+(** Parse kind from string. *)
+
+val kind_of_string_exn : string -> kind
+(** [kind_of_string_exn s] is like {!kind_of_string} but raises on error. *)
+
+type t
+(** The type of tags. *)
+
+val v : Hash.t -> kind -> ?tagger:User.t -> tag:string -> string option -> t
+(** Create a tag. *)
+
+val obj : t -> Hash.t
+(** The tagged object hash. *)
+
+val kind : t -> kind
+(** The kind of tagged object. *)
+
+val name : t -> string
+(** The tag name. *)
+
+val tagger : t -> User.t option
+(** The tagger (may be absent). *)
+
+val message : t -> string option
+(** The tag message. *)
+
+val pp : t Fmt.t
+(** Pretty-print a tag. *)
+
+val equal : t -> t -> bool
+(** Equality on tags. *)
+
+val compare : t -> t -> int
+(** Total ordering on tags. *)
+
+val hash : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val to_string : t -> string
+(** Encode to git format. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse from git format. *)
+
+val of_string_exn : string -> t
+(** [of_string_exn s] is like {!of_string} but raises on error. *)
+
+val digest : t -> Hash.t
+(** Compute the git hash of a tag. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/tree.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git tree objects (directory listings). *)
+
+type perm = [ `Normal | `Everybody | `Exec | `Link | `Dir | `Commit ]
+(** File permissions in a tree entry. *)
+
+val perm_to_string : perm -> string
+(** Convert permission to git octal format. *)
+
+val perm_of_string : string -> (perm, [ `Msg of string ]) result
+(** Parse permission from git octal format. *)
+
+val perm_of_string_exn : string -> perm
+(** [perm_of_string_exn s] is like {!perm_of_string} but raises on error. *)
+
+type entry = { perm : perm; name : string; hash : Hash.t }
+(** A tree entry: permission, name, and hash of the object. *)
+
+val entry : perm:perm -> name:string -> Hash.t -> entry
+(** Create a tree entry.
+    @raise Invalid_argument if name contains null byte. *)
+
+val pp_entry : entry Fmt.t
+(** Pretty-print a tree entry. *)
+
+type t
+(** The type of trees. *)
+
+val empty : t
+(** The empty tree. *)
+
+val is_empty : t -> bool
+(** Test if a tree is empty. *)
+
+val v : entry list -> t
+(** Create a tree from a list of entries (sorted automatically). *)
+
+val add : entry -> t -> t
+(** Add an entry to a tree. *)
+
+val remove : name:string -> t -> t
+(** Remove an entry by name. *)
+
+val find : name:string -> t -> entry option
+(** Find an entry by name. *)
+
+val to_list : t -> entry list
+(** Get the list of entries. *)
+
+val of_list : entry list -> t
+(** Create a tree from a list of entries. *)
+
+val hashes : t -> Hash.t list
+(** Get all hashes in the tree. *)
+
+val iter : (entry -> unit) -> t -> unit
+(** Iterate over entries. *)
+
+val pp : t Fmt.t
+(** Pretty-print a tree. *)
+
+val equal : t -> t -> bool
+(** Equality on trees. *)
+
+val compare : t -> t -> int
+(** Total ordering on trees. *)
+
+val hash : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val to_string : t -> string
+(** Encode to git binary format. *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse from git binary format. *)
+
+val of_string_exn : string -> t
+(** [of_string_exn s] is like {!of_string} but raises on error. *)
+
+val of_reader : Bytesrw.Bytes.Reader.t -> (t, [ `Msg of string ]) result
+(** Parse a tree directly from a {!Bytesrw.Bytes.Reader.t} without materialising
+    the full object into a string. The reader must be positioned at the start of
+    the tree body (after the loose-object header, if any). *)
+
+val digest : t -> Hash.t
+(** Compute the git hash of a tree. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/user.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git user information (author/committer). *)
+
+type tz_offset = { sign : [ `Plus | `Minus ]; hours : int; minutes : int }
+type t = { name : string; email : string; date : int64 * tz_offset option }
+
+let v ~name ~email ~date ?tz_offset () =
+  { name; email; date = (date, tz_offset) }
+
+let name t = t.name
+let email t = t.email
+let date t = fst t.date
+let tz_offset t = snd t.date
+
+let pp_tz_offset ppf { sign; hours; minutes } =
+  let sign_char = match sign with `Plus -> '+' | `Minus -> '-' in
+  Fmt.pf ppf "%c%02d%02d" sign_char hours minutes
+
+let pp ppf t =
+  Fmt.pf ppf "%s <%s> %Ld" t.name t.email (fst t.date);
+  match snd t.date with
+  | Some tz -> Fmt.pf ppf " %a" pp_tz_offset tz
+  | None -> Fmt.pf ppf " +0000"
+
+let equal a b =
+  String.equal a.name b.name
+  && String.equal a.email b.email
+  && Int64.equal (fst a.date) (fst b.date)
+
+let compare a b =
+  match String.compare a.name b.name with
+  | 0 -> (
+      match String.compare a.email b.email with
+      | 0 -> Int64.compare (fst a.date) (fst b.date)
+      | n -> n)
+  | n -> n
+
+(** Encode user to git format: "Name <email> timestamp timezone" *)
+let to_string t =
+  let tz_str =
+    match snd t.date with
+    | Some { sign; hours; minutes } ->
+        let sign_char = match sign with `Plus -> '+' | `Minus -> '-' in
+        Fmt.str "%c%02d%02d" sign_char hours minutes
+    | None -> "+0000"
+  in
+  Fmt.str "%s <%s> %Ld %s" t.name t.email (fst t.date) tz_str
+
+(** Parse user from git format. *)
+let of_string s =
+  (* Format: "Name <email> timestamp timezone" *)
+  match String.rindex_opt s '<' with
+  | None -> Error (`Msg ("Invalid user format: " ^ s))
+  | Some lt_pos -> (
+      match String.index_from_opt s lt_pos '>' with
+      | None -> Error (`Msg ("Invalid user format: " ^ s))
+      | Some gt_pos -> (
+          let name = String.trim (String.sub s 0 lt_pos) in
+          let email = String.sub s (lt_pos + 1) (gt_pos - lt_pos - 1) in
+          let rest = String.sub s (gt_pos + 2) (String.length s - gt_pos - 2) in
+          let parts = String.split_on_char ' ' rest in
+          match parts with
+          | [ timestamp; tz ] -> (
+              match Int64.of_string_opt timestamp with
+              | None -> Error (`Msg ("Invalid timestamp: " ^ timestamp))
+              | Some ts ->
+                  let tz_offset =
+                    if String.length tz >= 5 then
+                      let sign =
+                        match tz.[0] with
+                        | '+' -> `Plus
+                        | '-' -> `Minus
+                        | _ -> `Plus
+                      in
+                      let hours =
+                        int_of_string_opt (String.sub tz 1 2)
+                        |> Option.value ~default:0
+                      in
+                      let minutes =
+                        int_of_string_opt (String.sub tz 3 2)
+                        |> Option.value ~default:0
+                      in
+                      Some { sign; hours; minutes }
+                    else None
+                  in
+                  Ok { name; email; date = (ts, tz_offset) })
+          | _ -> Error (`Msg ("Invalid user date format: " ^ rest))))

lib/user.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git user information (author/committer). *)
+
+type tz_offset = { sign : [ `Plus | `Minus ]; hours : int; minutes : int }
+(** Timezone offset. *)
+
+type t
+(** The type of users. *)
+
+val v :
+  name:string -> email:string -> date:int64 -> ?tz_offset:tz_offset -> unit -> t
+(** [v ~name ~email ~date ?tz_offset ()] creates a user. [date] is a Unix
+    timestamp (seconds since epoch). *)
+
+val name : t -> string
+(** The user's name. *)
+
+val email : t -> string
+(** The user's email. *)
+
+val date : t -> int64
+(** The timestamp (Unix epoch). *)
+
+val tz_offset : t -> tz_offset option
+(** The timezone offset. *)
+
+val pp : t Fmt.t
+(** Pretty-print a user. *)
+
+val equal : t -> t -> bool
+(** Equality on users. *)
+
+val compare : t -> t -> int
+(** Total ordering on users. *)
+
+val to_string : t -> string
+(** Encode to git format: "Name <email> timestamp timezone". *)
+
+val of_string : string -> (t, [ `Msg of string ]) result
+(** Parse from git format. *)

lib/value.ml

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git values (union of all object types). *)
+
+module Reader = Bytesrw.Bytes.Reader
+module Writer = Bytesrw.Bytes.Writer
+module Slice = Bytesrw.Bytes.Slice
+
+type t = Blob of Blob.t | Commit of Commit.t | Tree of Tree.t | Tag of Tag.t
+
+let blob b = Blob b
+let commit c = Commit c
+let tree t = Tree t
+let tag t = Tag t
+
+let kind = function
+  | Blob _ -> `Blob
+  | Commit _ -> `Commit
+  | Tree _ -> `Tree
+  | Tag _ -> `Tag
+
+let pp ppf = function
+  | Blob b -> Fmt.pf ppf "(Blob %a)" Blob.pp b
+  | Commit c -> Fmt.pf ppf "(Commit %a)" Commit.pp c
+  | Tree t -> Fmt.pf ppf "(Tree %a)" Tree.pp t
+  | Tag t -> Fmt.pf ppf "(Tag %a)" Tag.pp t
+
+let equal a b =
+  match (a, b) with
+  | Blob a, Blob b -> Blob.equal a b
+  | Commit a, Commit b -> Commit.equal a b
+  | Tree a, Tree b -> Tree.equal a b
+  | Tag a, Tag b -> Tag.equal a b
+  | _ -> false
+
+let compare a b =
+  match (a, b) with
+  | Blob a, Blob b -> Blob.compare a b
+  | Commit a, Commit b -> Commit.compare a b
+  | Tree a, Tree b -> Tree.compare a b
+  | Tag a, Tag b -> Tag.compare a b
+  | Blob _, _ -> -1
+  | _, Blob _ -> 1
+  | Commit _, _ -> -1
+  | _, Commit _ -> 1
+  | Tree _, _ -> -1
+  | _, Tree _ -> 1
+
+let hash = function
+  | Blob b -> Blob.hash b
+  | Commit c -> Commit.hash c
+  | Tree t -> Tree.hash t
+  | Tag t -> Tag.hash t
+
+let digest = function
+  | Blob b -> Blob.digest b
+  | Commit c -> Commit.digest c
+  | Tree t -> Tree.digest t
+  | Tag t -> Tag.digest t
+
+(** Get the raw content of a value (without header). *)
+let to_string_without_header = function
+  | Blob b -> Blob.to_string b
+  | Commit c -> Commit.to_string c
+  | Tree t -> Tree.to_string t
+  | Tag t -> Tag.to_string t
+
+let length v = String.length (to_string_without_header v)
+
+(** Get the raw content of a value with git header. Format: "type
+    length\x00content" *)
+let to_string v =
+  let content = to_string_without_header v in
+  let kind_str =
+    match kind v with
+    | `Blob -> "blob"
+    | `Commit -> "commit"
+    | `Tree -> "tree"
+    | `Tag -> "tag"
+  in
+  Fmt.str "%s %d\x00%s" kind_str (String.length content) content
+
+(** Parse a value from raw content (without header). *)
+let of_string ~kind content =
+  match kind with
+  | `Blob -> Ok (Blob (Blob.of_string content))
+  | `Commit -> Result.map commit (Commit.of_string content)
+  | `Tree -> Result.map tree (Tree.of_string content)
+  | `Tag -> Result.map tag (Tag.of_string content)
+
+let of_string_exn ~kind content =
+  match of_string ~kind content with Ok v -> v | Error (`Msg m) -> failwith m
+
+(** Parse a value from raw content with git header. *)
+let of_string_with_header s =
+  (* Find the space after type *)
+  match String.index_opt s ' ' with
+  | None -> Error (`Msg "Invalid git object: missing space after type")
+  | Some sp_pos -> (
+      let type_str = String.sub s 0 sp_pos in
+      (* Find the null byte after length *)
+      match String.index_from_opt s (sp_pos + 1) '\x00' with
+      | None -> Error (`Msg "Invalid git object: missing null after length")
+      | Some null_pos -> (
+          let length_str = String.sub s (sp_pos + 1) (null_pos - sp_pos - 1) in
+          let content_start = null_pos + 1 in
+          let content =
+            String.sub s content_start (String.length s - content_start)
+          in
+          (* Verify length *)
+          match int_of_string_opt length_str with
+          | None -> Error (`Msg ("Invalid length: " ^ length_str))
+          | Some expected_len ->
+              if String.length content <> expected_len then
+                Error
+                  (`Msg
+                     (Fmt.str "Length mismatch: expected %d, got %d"
+                        expected_len (String.length content)))
+              else
+                let kind =
+                  match type_str with
+                  | "blob" -> Ok `Blob
+                  | "commit" -> Ok `Commit
+                  | "tree" -> Ok `Tree
+                  | "tag" -> Ok `Tag
+                  | _ -> Error (`Msg ("Unknown object type: " ^ type_str))
+                in
+                Result.bind kind (fun kind -> of_string ~kind content)))
+
+let of_string_with_header_exn s =
+  match of_string_with_header s with Ok v -> v | Error (`Msg m) -> failwith m
+
+(** {1 Bytesrw support} *)
+
+(** Read until a specific byte is found *)
+let read_until reader byte =
+  let buf = Buffer.create 64 in
+  let rec loop () =
+    match Reader.read reader with
+    | slice when Slice.is_eod slice -> Error (`Msg "unexpected end of data")
+    | slice -> (
+        let str = Slice.to_string slice in
+        match String.index_opt str byte with
+        | Some pos ->
+            Buffer.add_substring buf str 0 pos;
+            if pos + 1 < String.length str then begin
+              let leftover =
+                String.sub str (pos + 1) (String.length str - pos - 1)
+              in
+              Reader.push_back reader (Slice.of_string leftover)
+            end;
+            Ok (Buffer.contents buf)
+        | None ->
+            Buffer.add_string buf str;
+            loop ())
+  in
+  loop ()
+
+(** Read a git object from a reader. Returns (kind, length, content). *)
+let read_header reader =
+  let open Result.Syntax in
+  let* type_str = read_until reader ' ' in
+  let* length_str = read_until reader '\x00' in
+  let* kind =
+    match type_str with
+    | "blob" -> Ok `Blob
+    | "commit" -> Ok `Commit
+    | "tree" -> Ok `Tree
+    | "tag" -> Ok `Tag
+    | _ -> Error (`Msg ("Unknown object type: " ^ type_str))
+  in
+  let* length =
+    match int_of_string_opt length_str with
+    | Some n -> Ok n
+    | None -> Error (`Msg ("Invalid length: " ^ length_str))
+  in
+  Ok (kind, length)
+
+(** Parse from a reader, dispatching to reader-based parsers for commit and tree
+    to avoid materialising the full content string. Blobs and tags still go
+    through [of_string] (blobs are opaque bytes; tags are rare). *)
+let of_reader ~kind reader =
+  match kind with
+  | `Commit -> Result.map commit (Commit.of_reader reader)
+  | `Tree -> Result.map tree (Tree.of_reader reader)
+  | `Blob ->
+      let content = Reader.to_string reader in
+      Ok (Blob (Blob.of_string content))
+  | `Tag ->
+      let content = Reader.to_string reader in
+      Result.map tag (Tag.of_string content)
+
+(** Read a git object from a bytesrw reader. *)
+let read reader =
+  let open Result.Syntax in
+  let* kind, _length = read_header reader in
+  of_reader ~kind reader
+
+(** Write a git object to a bytesrw writer. *)
+let write writer v =
+  let content = to_string_without_header v in
+  let kind_str =
+    match kind v with
+    | `Blob -> "blob"
+    | `Commit -> "commit"
+    | `Tree -> "tree"
+    | `Tag -> "tag"
+  in
+  let header = Fmt.str "%s %d\x00" kind_str (String.length content) in
+  Writer.write writer (Slice.of_string header);
+  Writer.write writer (Slice.of_string content)
+
+(** Write only the content (without header) to a bytesrw writer. *)
+let write_content writer v =
+  let content = to_string_without_header v in
+  Writer.write writer (Slice.of_string content)
+
+module Set = Set.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)
+
+module Map = Map.Make (struct
+  type nonrec t = t
+
+  let compare = compare
+end)

lib/value.mli

···
+(* Copyright (c) 2013-2017 Thomas Gazagnaire <[e-mail]>
+   Copyright (c) 2017-2024 Romain Calascibetta <[e-mail]>
+   Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git values (union of all object types). *)
+
+type t =
+  | Blob of Blob.t
+  | Commit of Commit.t
+  | Tree of Tree.t
+  | Tag of Tag.t  (** The type of git values. *)
+
+val blob : Blob.t -> t
+(** Create a blob value. *)
+
+val commit : Commit.t -> t
+(** Create a commit value. *)
+
+val tree : Tree.t -> t
+(** Create a tree value. *)
+
+val tag : Tag.t -> t
+(** Create a tag value. *)
+
+val kind : t -> [ `Blob | `Commit | `Tree | `Tag ]
+(** Get the kind of a value. *)
+
+val pp : t Fmt.t
+(** Pretty-print a value. *)
+
+val equal : t -> t -> bool
+(** Equality on values. *)
+
+val compare : t -> t -> int
+(** Total ordering on values. *)
+
+val hash : t -> int
+(** Hash function for use with Hashtbl. *)
+
+val digest : t -> Hash.t
+(** Compute the git hash of a value. *)
+
+val length : t -> int
+(** The length of the value content (without header). *)
+
+val to_string_without_header : t -> string
+(** Encode to git format without the header. *)
+
+val to_string : t -> string
+(** Encode to git format with header ("type length\x00content"). *)
+
+val of_string :
+  kind:[ `Blob | `Commit | `Tree | `Tag ] ->
+  string ->
+  (t, [ `Msg of string ]) result
+(** Parse from git format (content only, no header). *)
+
+val of_string_exn : kind:[ `Blob | `Commit | `Tree | `Tag ] -> string -> t
+(** [of_string_exn ~kind s] is like {!of_string} but raises on error. *)
+
+val of_string_with_header : string -> (t, [ `Msg of string ]) result
+(** Parse from git format with header. *)
+
+val of_string_with_header_exn : string -> t
+(** [of_string_with_header_exn s] is like {!of_string_with_header} but raises on
+    error. *)
+
+(** {1 Bytesrw support} *)
+
+module Reader = Bytesrw.Bytes.Reader
+module Writer = Bytesrw.Bytes.Writer
+module Slice = Bytesrw.Bytes.Slice
+
+val read_header :
+  Reader.t ->
+  ([ `Blob | `Commit | `Tree | `Tag ] * int, [ `Msg of string ]) result
+(** Read a git object header from a reader. Returns the kind and content length.
+*)
+
+val of_reader :
+  kind:[ `Blob | `Commit | `Tree | `Tag ] ->
+  Reader.t ->
+  (t, [ `Msg of string ]) result
+(** [of_reader ~kind r] parses a value directly from a reader positioned at the
+    start of the object body. Commits and trees are parsed without materialising
+    the full content string; blobs and tags still go through {!of_string}. *)
+
+val read : Reader.t -> (t, [ `Msg of string ]) result
+(** Read a git object from a bytesrw reader (parses the header then the body).
+*)
+
+val write : Writer.t -> t -> unit
+(** Write a git object to a bytesrw writer (with header). *)
+
+val write_content : Writer.t -> t -> unit
+(** Write only the content (without header) to a bytesrw writer. *)
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t

lib/worktree.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+type entry = { path : Fpath.t; head : Hash.t; branch : string option }
+type t = { fs : Eio.Fs.dir_ty Eio.Path.t; git_dir : string }
+
+let v ~fs ~git_dir = { fs; git_dir }
+
+let err_worktree_not_found path =
+  Error (`Msg (Fmt.str "worktree '%a' not found" Fpath.pp path))
+
+(* Get the main worktree path from .git directory *)
+let main_worktree_path t =
+  (* .git dir is like /path/to/repo/.git, so parent is the worktree *)
+  if
+    String.length t.git_dir > 5
+    && String.sub t.git_dir (String.length t.git_dir - 5) 5 = "/.git"
+  then String.sub t.git_dir 0 (String.length t.git_dir - 5)
+  else Filename.dirname t.git_dir
+
+(* Get worktree name from path *)
+let name path = Fpath.basename path
+
+(* Parse HEAD file to get branch name *)
+let parse_head_file content =
+  let content = String.trim content in
+  if String.length content > 16 && String.sub content 0 16 = "ref: refs/heads/"
+  then Some (String.sub content 16 (String.length content - 16))
+  else None
+
+(* Read linked worktree entry from .git/worktrees/<name> *)
+let read_worktree_entry t name =
+  let wt_git_dir = Filename.concat t.git_dir ("worktrees/" ^ name) in
+  let gitdir_path = Eio.Path.(t.fs / wt_git_dir / "gitdir") in
+  let head_path = Eio.Path.(t.fs / wt_git_dir / "HEAD") in
+  try
+    let gitdir_content = String.trim (Eio.Path.load gitdir_path) in
+    (* gitdir contains path to the worktree's .git file, the worktree is the parent *)
+    let wt_path =
+      if Filename.check_suffix gitdir_content "/.git" then
+        String.sub gitdir_content 0 (String.length gitdir_content - 5)
+      else Filename.dirname gitdir_content
+    in
+    let head_content = Eio.Path.load head_path in
+    let branch = parse_head_file head_content in
+    let head_hash =
+      match branch with
+      | Some b -> (
+          (* Read from the shared refs *)
+          let ref_path = Eio.Path.(t.fs / t.git_dir / "refs" / "heads" / b) in
+          try
+            let hash_str = String.trim (Eio.Path.load ref_path) in
+            Hash.of_hex hash_str
+          with Eio.Io _ | Invalid_argument _ ->
+            (* Fallback: parse HEAD as direct hash *)
+            Hash.of_hex (String.trim head_content))
+      | None -> Hash.of_hex (String.trim head_content)
+    in
+    match Fpath.of_string wt_path with
+    | Ok path -> Some { path; head = head_hash; branch }
+    | Error _ -> None
+  with Eio.Io _ | Invalid_argument _ -> None
+
+let list t ~head ~current_branch =
+  (* First, add the main worktree *)
+  let main_path = main_worktree_path t in
+  let main_entry =
+    match Fpath.of_string main_path with
+    | Ok path ->
+        (* For the main worktree, use a zero hash if HEAD doesn't exist yet *)
+        let head_hash =
+          match head with
+          | Some h -> h
+          | None -> Hash.of_hex (String.make 40 '0')
+        in
+        Some { path; head = head_hash; branch = current_branch }
+    | Error _ -> None
+  in
+  (* Then list linked worktrees from .git/worktrees/ *)
+  let worktrees_dir = Filename.concat t.git_dir "worktrees" in
+  let worktrees_path = Eio.Path.(t.fs / worktrees_dir) in
+  let linked_entries =
+    try
+      let entries = Eio.Path.read_dir worktrees_path in
+      List.filter_map (read_worktree_entry t) entries
+    with Eio.Io _ -> []
+  in
+  match main_entry with Some e -> e :: linked_entries | None -> linked_entries
+
+let exists t ~path =
+  (* We need to get head and current_branch, but for exists check we can pass None *)
+  let worktrees = list t ~head:None ~current_branch:None in
+  List.exists (fun e -> Fpath.equal e.path path) worktrees
+
+let write_ref t name hash =
+  let path = Filename.concat t.git_dir name in
+  let full_path = Eio.Path.(t.fs / path) in
+  let dir = Filename.dirname path in
+  let dir_path = Eio.Path.(t.fs / dir) in
+  (try Eio.Path.mkdir ~perm:0o755 dir_path with Eio.Io _ -> ());
+  let content = Hash.to_hex hash ^ "\n" in
+  Eio.Path.save ~create:(`Or_truncate 0o644) full_path content
+
+let add t ~head ~path ~branch =
+  let name = name path in
+  let wt_git_dir = Filename.concat t.git_dir ("worktrees/" ^ name) in
+  let wt_git_dir_path = Eio.Path.(t.fs / wt_git_dir) in
+  let wt_path_str = Fpath.to_string path in
+  let wt_path = Eio.Path.(t.fs / wt_path_str) in
+  (* Create the worktree directory *)
+  (try Eio.Path.mkdirs ~perm:0o755 wt_path with Eio.Io _ -> ());
+  (* Create .git/worktrees/<name> directory *)
+  (try Eio.Path.mkdirs ~perm:0o755 wt_git_dir_path with Eio.Io _ -> ());
+  (* Write gitdir file (path to the worktree's .git file) *)
+  let gitdir_content = wt_path_str ^ "/.git\n" in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(wt_git_dir_path / "gitdir")
+    gitdir_content;
+  (* Write HEAD file (pointing to the new branch) *)
+  let head_content = "ref: refs/heads/" ^ branch ^ "\n" in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(wt_git_dir_path / "HEAD")
+    head_content;
+  (* Write commondir file (relative path to main .git) *)
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(wt_git_dir_path / "commondir")
+    "..\n";
+  (* Create the branch in the main repo *)
+  write_ref t ("refs/heads/" ^ branch) head;
+  (* Write .git file in the worktree *)
+  let git_file_content = "gitdir: " ^ wt_git_dir ^ "\n" in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(wt_path / ".git")
+    git_file_content;
+  Ok ()
+
+let remove t ~path ~force =
+  if not (exists t ~path) then err_worktree_not_found path
+  else
+    let name = name path in
+    let wt_git_dir = Filename.concat t.git_dir ("worktrees/" ^ name) in
+    let wt_git_dir_path = Eio.Path.(t.fs / wt_git_dir) in
+    let wt_path_str = Fpath.to_string path in
+    let wt_path = Eio.Path.(t.fs / wt_path_str) in
+    (* Check if worktree is the main worktree *)
+    if String.equal (main_worktree_path t) wt_path_str then
+      Error (`Msg "cannot remove main worktree")
+    else begin
+      (* TODO: Check for uncommitted changes if not force *)
+      ignore force;
+      (* Remove the .git/worktrees/<name> directory *)
+      let rec remove_dir path =
+        try
+          let entries = Eio.Path.read_dir path in
+          List.iter
+            (fun entry ->
+              let entry_path = Eio.Path.(path / entry) in
+              if Eio.Path.is_directory entry_path then remove_dir entry_path
+              else Eio.Path.unlink entry_path)
+            entries;
+          Eio.Path.rmdir path
+        with Eio.Io _ -> ()
+      in
+      remove_dir wt_git_dir_path;
+      (* Remove the worktree directory *)
+      remove_dir wt_path;
+      Ok ()
+    end

lib/worktree.mli

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(** Git worktree operations.
+
+    This module provides operations for managing git worktrees - separate
+    working directories that share the same git repository. *)
+
+type entry = {
+  path : Fpath.t;  (** Absolute path to the worktree *)
+  head : Hash.t;  (** HEAD commit hash *)
+  branch : string option;  (** Branch name if not detached *)
+}
+(** A git worktree entry. *)
+
+(** {1 Low-level interface}
+
+    These functions operate on the raw git directory structure. *)
+
+type t
+(** A worktree manager. *)
+
+val v : fs:Eio.Fs.dir_ty Eio.Path.t -> git_dir:string -> t
+(** [v ~fs ~git_dir] creates a worktree manager. *)
+
+val add :
+  t ->
+  head:Hash.t ->
+  path:Fpath.t ->
+  branch:string ->
+  (unit, [ `Msg of string ]) result
+(** [add t ~head ~path ~branch] creates a new worktree at [path] with a new
+    branch [branch] starting at [head]. *)
+
+val remove :
+  t -> path:Fpath.t -> force:bool -> (unit, [ `Msg of string ]) result
+(** [remove t ~path ~force] removes a worktree at [path]. *)
+
+val list : t -> head:Hash.t option -> current_branch:string option -> entry list
+(** [list t ~head ~current_branch] returns all worktrees. *)
+
+val exists : t -> path:Fpath.t -> bool
+(** [exists t ~path] returns true if a worktree exists at [path]. *)

test/dune

···
+(test
+ (name test)
+ (libraries git test_helpers alcotest bytesrw bytesrw.zlib eio_main)
+ (deps pack-testzone-0.pack pack-testzone-0.idx))
+
+(cram
+ (deps %{bin:git-mono}))

test/helpers/dune

···
+(library
+ (name test_helpers)
+ (libraries git alcotest eio eio_main fpath))

test/helpers/test_helpers.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Alcotest.testable Git.Hash.pp Git.Hash.equal
+
+let with_temp_repo f =
+  Eio_main.run @@ fun env ->
+  let fs = Eio.Stdenv.fs env in
+  let tmp_dir_str = Filename.temp_dir "git_test" "" in
+  let tmp_dir = Fpath.v tmp_dir_str in
+  Fun.protect
+    ~finally:(fun () -> ignore (Sys.command ("rm -rf " ^ tmp_dir_str)))
+    (fun () -> f fs tmp_dir)
+
+let commit ~repo ~tree ~parents ~message =
+  let author = Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:0L () in
+  let commit =
+    Git.Commit.v ~tree ~author ~committer:author ~parents (Some message)
+  in
+  Git.Repository.write_commit repo commit

test/helpers/test_helpers.mli

···
+(** Shared test utilities. *)
+
+val hash : Git.Hash.t Alcotest.testable
+
+val with_temp_repo : (Eio.Fs.dir_ty Eio.Path.t -> Fpath.t -> 'a) -> 'a
+(** [with_temp_repo f] creates a temporary git repository and calls
+    [f dir repo_path] with the Eio directory and Fpath to the repo. The
+    temporary directory is cleaned up after [f] returns. *)
+
+val commit :
+  repo:Git.Repository.t ->
+  tree:Git.Hash.t ->
+  parents:Git.Hash.t list ->
+  message:string ->
+  Git.Hash.t
+(** [commit ~repo ~tree ~parents ~message] creates a new commit object in [repo]
+    with the given [tree], [parents], and [message], and returns its hash. *)

test/split.t

···
+git-mono split tests
+=====================
+
+Setup: configure git and disable colors
+
+  $ export NO_COLOR=1
+  $ export GIT_AUTHOR_NAME="Test User"
+  $ export GIT_AUTHOR_EMAIL="[e-mail]"
+  $ export GIT_AUTHOR_DATE="2025-01-01T00:00:00+00:00"
+  $ export GIT_COMMITTER_NAME="Test User"
+  $ export GIT_COMMITTER_EMAIL="[e-mail]"
+  $ export GIT_COMMITTER_DATE="2025-01-01T00:00:00+00:00"
+
+Help and version
+-----------------
+
+  $ git-mono --version
+  4.0.0
+
+Error: missing PREFIX argument
+-------------------------------
+
+  $ git-mono split 2>&1
+  Usage: git-mono split [--help] [OPTION]… PREFIX
+  git-mono: required argument PREFIX is missing
+  [124]
+
+Error: not a git repository
+----------------------------
+
+  $ mkdir empty && cd empty
+  $ git-mono split lib 2>&1
+  error: Could not resolve revision 'HEAD'.
+  git-mono: could not resolve revision 'HEAD'
+  [124]
+  $ cd ..
+
+Single commit with prefix
+--------------------------
+
+  $ mkdir repo1 && cd repo1
+  $ git init -q
+  $ mkdir lib
+  $ echo "hello" > lib/foo.ml
+  $ git add . && git commit -q -m "add lib/foo.ml"
+  $ HASH=$(git-mono split lib)
+  $ test -n "$HASH" && echo "got hash"
+  got hash
+
+Verify the split commit has lib/ contents at root
+
+  $ git ls-tree "$HASH" --name-only
+  foo.ml
+  $ git show "$HASH:foo.ml"
+  hello
+  $ cd ..
+
+Linear history
+--------------
+
+  $ mkdir repo2 && cd repo2
+  $ git init -q
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "first"
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "second"
+  $ echo "v3" > lib/a.ml
+  $ git add . && git commit -q -m "third"
+  $ HASH=$(git-mono split lib)
+
+The split commit chain should have 3 commits
+
+  $ git rev-list "$HASH" | wc -l | tr -d ' '
+  3
+
+Each split commit message matches the original
+
+  $ git log --format="%s" "$HASH"
+  third
+  second
+  first
+
+The latest tree should have a.ml with content "v3"
+
+  $ git show "$HASH:a.ml"
+  v3
+  $ cd ..
+
+No commits touch prefix
+------------------------
+
+  $ mkdir repo3 && cd repo3
+  $ git init -q
+  $ echo "root" > README.md
+  $ git add . && git commit -q -m "root only"
+  $ git-mono split nonexistent 2>&1
+  git-mono: [WARNING] No commits touch prefix 'nonexistent'.
+  $ cd ..
+
+Cache: second run returns same hash
+-------------------------------------
+
+  $ mkdir repo4 && cd repo4
+  $ git init -q
+  $ mkdir lib
+  $ echo "cached" > lib/x.ml
+  $ git add . && git commit -q -m "initial"
+  $ HASH1=$(git-mono split lib)
+  $ HASH2=$(git-mono split lib)
+  $ test "$HASH1" = "$HASH2" && echo "cache hit: same hash"
+  cache hit: same hash
+
+Verify cache file exists
+
+  $ test -f .git/subtree-cache/lib && echo "cache file exists"
+  cache file exists
+  $ cd ..
+
+Incremental split
+-----------------
+
+  $ mkdir repo5 && cd repo5
+  $ git init -q
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "first"
+  $ HASH1=$(git-mono split lib)
+
+Add another commit
+
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "second"
+  $ HASH2=$(git-mono split lib)
+
+Hashes differ
+
+  $ test "$HASH1" != "$HASH2" && echo "hashes differ"
+  hashes differ
+
+New split has 2 commits, not 1
+
+  $ git rev-list "$HASH2" | wc -l | tr -d ' '
+  2
+
+The parent of the new split head is the old split head
+
+  $ PARENT=$(git rev-parse "$HASH2^")
+  $ test "$PARENT" = "$HASH1" && echo "parent matches"
+  parent matches
+  $ cd ..
+
+Merge commits
+-------------
+
+  $ mkdir repo6 && cd repo6
+  $ git init -q
+  $ mkdir lib
+  $ echo "base" > lib/a.ml
+  $ git add . && git commit -q -m "base"
+
+Create a branch and make changes
+
+  $ git checkout -q -b feature
+  $ echo "feature" > lib/b.ml
+  $ git add . && git commit -q -m "add b.ml on feature"
+
+Go back to main and make a different change
+
+  $ git checkout -q main 2>/dev/null || git checkout -q master
+  $ echo "main" > lib/c.ml
+  $ git add . && git commit -q -m "add c.ml on main"
+
+Merge
+
+  $ git merge -q --no-edit feature
+
+Split should produce commits with merge parents
+
+  $ HASH=$(git-mono split lib)
+  $ git rev-list "$HASH" | wc -l | tr -d ' '
+  4
+
+The head commit should be a merge (2 parents)
+
+  $ git cat-file -p "$HASH" | grep "^parent" | wc -l | tr -d ' '
+  2
+  $ cd ..
+
+Nested prefix
+--------------
+
+  $ mkdir repo7 && cd repo7
+  $ git init -q
+  $ mkdir -p src/lib
+  $ echo "deep" > src/lib/deep.ml
+  $ git add . && git commit -q -m "nested"
+  $ HASH=$(git-mono split src/lib)
+  $ git ls-tree "$HASH" --name-only
+  deep.ml
+  $ cd ..
+
+Commits that don't touch the prefix are skipped
+-------------------------------------------------
+
+  $ mkdir repo8 && cd repo8
+  $ git init -q
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "touch lib"
+  $ echo "unrelated" > README.md
+  $ git add . && git commit -q -m "touch root only"
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "touch lib again"
+  $ HASH=$(git-mono split lib)
+
+Only 2 split commits (the one touching root only is squashed since subtree didn't change)
+
+  $ git rev-list "$HASH" | wc -l | tr -d ' '
+  2
+
+Messages are preserved from the commits that touch lib
+
+  $ git log --format="%s" "$HASH"
+  touch lib again
+  touch lib
+  $ cd ..
+
+Split from a specific revision
+-------------------------------
+
+  $ mkdir repo9 && cd repo9
+  $ git init -q
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "first"
+  $ FIRST=$(git rev-parse HEAD)
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "second"
+  $ HASH_HEAD=$(git-mono split lib)
+  $ HASH_FIRST=$(git-mono split --rev "$FIRST" lib)
+
+The rev-specific split should have fewer commits
+
+  $ git rev-list "$HASH_FIRST" | wc -l | tr -d ' '
+  1
+  $ git rev-list "$HASH_HEAD" | wc -l | tr -d ' '
+  2
+  $ cd ..
+
+Split from a branch name
+-------------------------
+
+  $ mkdir repo10 && cd repo10
+  $ git init -q
+  $ mkdir lib
+  $ echo "main" > lib/a.ml
+  $ git add . && git commit -q -m "on main"
+  $ git checkout -q -b other
+  $ echo "other" > lib/b.ml
+  $ git add . && git commit -q -m "on other"
+  $ git checkout -q main 2>/dev/null || git checkout -q master
+  $ HASH=$(git-mono split --rev other lib)
+  $ git show "$HASH:b.ml"
+  other
+  $ cd ..
+
+Bad revision
+------------
+
+  $ mkdir repo11 && cd repo11
+  $ git init -q
+  $ git-mono split --rev nonexistent lib 2>&1
+  error: Could not resolve revision 'nonexistent'.
+  git-mono: could not resolve revision 'nonexistent'
+  [124]
+  $ cd ..
+
+Quiet mode (-q) suppresses warnings
+-------------------------------------
+
+  $ mkdir repo12 && cd repo12
+  $ git init -q
+  $ echo "root" > README.md
+  $ git add . && git commit -q -m "root only"
+  $ git-mono split -q nonexistent 2>&1
+  $ cd ..
+
+Verbose mode shows info messages
+---------------------------------
+
+  $ mkdir repo13 && cd repo13
+  $ git init -q
+  $ mkdir lib
+  $ echo "hello" > lib/a.ml
+  $ git add . && git commit -q -m "initial"
+  $ git-mono split -v lib 2>&1 | grep -c "Splitting prefix"
+  1
+  $ cd ..
+
+Multiple prefixes use separate caches
+---------------------------------------
+
+  $ mkdir repo14 && cd repo14
+  $ git init -q
+  $ mkdir lib bin
+  $ echo "lib" > lib/a.ml
+  $ echo "bin" > bin/main.ml
+  $ git add . && git commit -q -m "initial"
+  $ HASH_LIB=$(git-mono split lib)
+  $ HASH_BIN=$(git-mono split bin)
+
+Different hashes (different content)
+
+  $ test "$HASH_LIB" != "$HASH_BIN" && echo "different hashes"
+  different hashes
+
+Separate cache files
+
+  $ test -f .git/subtree-cache/lib && echo "lib cache exists"
+  lib cache exists
+  $ test -f .git/subtree-cache/bin && echo "bin cache exists"
+  bin cache exists
+  $ cd ..
+
+Author and committer are preserved
+------------------------------------
+
+  $ mkdir repo15 && cd repo15
+  $ git init -q
+  $ mkdir lib
+  $ echo "hello" > lib/a.ml
+  $ git add .
+  $ GIT_AUTHOR_NAME="Alice Author" GIT_AUTHOR_EMAIL="[e-mail]" \
+  > GIT_COMMITTER_NAME="Bob Committer" GIT_COMMITTER_EMAIL="[e-mail]" \
+  > git commit -q -m "authored commit"
+  $ HASH=$(git-mono split lib)
+  $ git cat-file -p "$HASH" | grep "^author " | sed 's/ [0-9]* [+-][0-9]*//'
+  author Alice Author <[e-mail]>
+  $ git cat-file -p "$HASH" | grep "^committer " | sed 's/ [0-9]* [+-][0-9]*//'
+  committer Bob Committer <[e-mail]>
+  $ cd ..
+
+Dirty working tree does not affect split
+------------------------------------------
+
+  $ mkdir repo16 && cd repo16
+  $ git init -q
+  $ mkdir lib
+  $ echo "committed" > lib/a.ml
+  $ git add . && git commit -q -m "initial"
+  $ HASH1=$(git-mono split lib)
+
+Make dirty changes (not committed)
+
+  $ echo "dirty" > lib/a.ml
+  $ echo "new file" > lib/b.ml
+
+Split should still work and return same hash (reads object store, not working tree)
+
+  $ HASH2=$(git-mono split lib)
+  $ test "$HASH1" = "$HASH2" && echo "dirty tree ignored"
+  dirty tree ignored
+  $ cd ..
+
+Using -C to specify repository path
+--------------------------------------
+
+  $ mkdir repo17 && cd repo17
+  $ git init -q
+  $ mkdir lib
+  $ echo "remote" > lib/a.ml
+  $ git add . && git commit -q -m "initial"
+  $ cd ..
+  $ HASH=$(git-mono split -C repo17 lib)
+  $ test -n "$HASH" && echo "got hash via -C"
+  got hash via -C
+
+Large tree: split only extracts the right subtree
+---------------------------------------------------
+
+  $ mkdir repo19 && cd repo19
+  $ git init -q
+  $ mkdir -p lib bin doc test
+  $ echo "lib" > lib/a.ml
+  $ echo "bin" > bin/main.ml
+  $ echo "doc" > doc/README.md
+  $ echo "test" > test/test.ml
+  $ git add . && git commit -q -m "initial"
+  $ HASH=$(git-mono split lib)
+  $ git ls-tree "$HASH" --name-only
+  a.ml
+  $ cd ..
+
+Commit message is preserved
+-----------------------------
+
+  $ mkdir repo20 && cd repo20
+  $ git init -q
+  $ mkdir lib
+  $ echo "hello" > lib/a.ml
+  $ git add .
+  $ git commit -q -m "Detailed commit message"
+  $ HASH=$(git-mono split lib)
+  $ git log -1 --format="%s" "$HASH"
+  Detailed commit message
+  $ cd ..
+
+Prefix appearing partway through history
+------------------------------------------
+
+  $ mkdir repo21 && cd repo21
+  $ git init -q
+  $ echo "root" > README.md
+  $ git add . && git commit -q -m "no lib yet"
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "add lib"
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "update lib"
+  $ HASH=$(git-mono split lib)
+
+Only 2 commits in split (the "no lib yet" commit is skipped)
+
+  $ git rev-list "$HASH" | wc -l | tr -d ' '
+  2
+  $ git log --format="%s" "$HASH"
+  update lib
+  add lib
+  $ cd ..
+
+Multiple files in prefix
+-------------------------
+
+  $ mkdir repo22 && cd repo22
+  $ git init -q
+  $ mkdir lib
+  $ echo "a" > lib/a.ml
+  $ echo "b" > lib/b.ml
+  $ echo "c" > lib/c.ml
+  $ git add . && git commit -q -m "initial"
+  $ HASH=$(git-mono split lib)
+  $ git ls-tree "$HASH" --name-only | sort
+  a.ml
+  b.ml
+  c.ml
+  $ cd ..
+
+Nested directories in prefix
+-------------------------------
+
+  $ mkdir repo23 && cd repo23
+  $ git init -q
+  $ mkdir -p lib/src lib/test
+  $ echo "code" > lib/src/main.ml
+  $ echo "test" > lib/test/test.ml
+  $ git add . && git commit -q -m "initial"
+  $ HASH=$(git-mono split lib)
+  $ git ls-tree "$HASH" --name-only
+  src
+  test
+  $ git ls-tree "$HASH:src" --name-only
+  main.ml
+  $ cd ..
+
+Cache file format: pairs of hex hashes
+----------------------------------------
+
+  $ mkdir repo24 && cd repo24
+  $ git init -q
+  $ mkdir lib
+  $ echo "hello" > lib/a.ml
+  $ git add . && git commit -q -m "initial"
+  $ git-mono split lib > /dev/null
+  $ wc -l < .git/subtree-cache/lib | tr -d ' '
+  1
+  $ awk '{ print length($1), length($2) }' .git/subtree-cache/lib
+  40 40
+  $ cd ..
+
+Second split with same tree but different message creates new commit
+---------------------------------------------------------------------
+
+  $ mkdir repo25 && cd repo25
+  $ git init -q
+  $ mkdir lib
+  $ echo "same" > lib/a.ml
+  $ git add . && git commit -q -m "commit A"
+  $ echo "different" > lib/a.ml
+  $ git add . && git commit -q -m "commit B"
+  $ echo "same" > lib/a.ml
+  $ git add . && git commit -q -m "commit C (same tree as A)"
+  $ HASH=$(git-mono split lib)
+
+All 3 commits are present because the tree changes between adjacent parents
+
+  $ git rev-list "$HASH" | wc -l | tr -d ' '
+  3
+  $ cd ..
+
+Idempotency: running split multiple times produces identical results
+----------------------------------------------------------------------
+
+  $ mkdir repo26 && cd repo26
+  $ git init -q
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "first"
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "second"
+  $ echo "v3" > lib/a.ml
+  $ git add . && git commit -q -m "third"
+
+First split (cold cache)
+
+  $ HASH1=$(git-mono split lib)
+
+Second split (warm cache)
+
+  $ HASH2=$(git-mono split lib)
+
+Third split (still warm cache)
+
+  $ HASH3=$(git-mono split lib)
+
+All three runs produce the same hash
+
+  $ test "$HASH1" = "$HASH2" && test "$HASH2" = "$HASH3" && echo "idempotent"
+  idempotent
+
+  $ cd ..
+
+Incremental: add commits one at a time
+----------------------------------------
+
+  $ mkdir repo27 && cd repo27
+  $ git init -q
+  $ mkdir lib
+
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "first"
+  $ HASH_A=$(git-mono split lib)
+
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "second"
+  $ HASH_B=$(git-mono split lib)
+
+  $ echo "v3" > lib/a.ml
+  $ git add . && git commit -q -m "third"
+  $ HASH_C=$(git-mono split lib)
+
+Each incremental split extends the chain
+
+  $ git rev-list "$HASH_A" | wc -l | tr -d ' '
+  1
+  $ git rev-list "$HASH_B" | wc -l | tr -d ' '
+  2
+  $ git rev-list "$HASH_C" | wc -l | tr -d ' '
+  3
+
+The chain is consistent: each split head's parent is the previous split head
+
+  $ test "$(git rev-parse "$HASH_B^")" = "$HASH_A" && echo "B parent = A"
+  B parent = A
+  $ test "$(git rev-parse "$HASH_C^")" = "$HASH_B" && echo "C parent = B"
+  C parent = B
+
+All split commits are reachable from the latest
+
+  $ git merge-base --is-ancestor "$HASH_A" "$HASH_C" && echo "A is ancestor of C"
+  A is ancestor of C
+  $ cd ..
+
+Bidirectional incremental: split two branches independently
+------------------------------------------------------------
+
+  $ mkdir repo28 && cd repo28
+  $ git init -q
+  $ mkdir lib
+  $ echo "base" > lib/a.ml
+  $ git add . && git commit -q -m "base commit"
+  $ HASH_BASE=$(git-mono split lib)
+
+Create two branches from the same base
+
+  $ git checkout -q -b branch-x
+  $ echo "x" > lib/x.ml
+  $ git add . && git commit -q -m "add x"
+  $ HASH_X=$(git-mono split --rev branch-x lib)
+
+  $ git checkout -q main 2>/dev/null || git checkout -q master
+  $ echo "y" > lib/y.ml
+  $ git add . && git commit -q -m "add y"
+  $ HASH_Y=$(git-mono split lib)
+
+Both branches share the same split base
+
+  $ test "$(git rev-parse "$HASH_X^")" = "$HASH_BASE" && echo "X parent = base"
+  X parent = base
+  $ test "$(git rev-parse "$HASH_Y^")" = "$HASH_BASE" && echo "Y parent = base"
+  Y parent = base
+
+Now merge and split again
+
+  $ git merge -q --no-edit branch-x
+  $ HASH_MERGE=$(git-mono split lib)
+
+The merge split has both branch splits as parents
+
+  $ git cat-file -p "$HASH_MERGE" | grep "^parent" | wc -l | tr -d ' '
+  2
+
+The merge split is a descendant of both branch splits
+
+  $ git merge-base --is-ancestor "$HASH_X" "$HASH_MERGE" && echo "X ancestor of merge"
+  X ancestor of merge
+  $ git merge-base --is-ancestor "$HASH_Y" "$HASH_MERGE" && echo "Y ancestor of merge"
+  Y ancestor of merge
+  $ cd ..
+
+Incremental after cache: only new commits are processed
+---------------------------------------------------------
+
+  $ mkdir repo29 && cd repo29
+  $ git init -q
+  $ mkdir lib
+  $ echo "v1" > lib/a.ml
+  $ git add . && git commit -q -m "first"
+  $ echo "v2" > lib/a.ml
+  $ git add . && git commit -q -m "second"
+  $ git-mono split lib > /dev/null
+
+Cache should have 2 entries
+
+  $ wc -l < .git/subtree-cache/lib | tr -d ' '
+  2
+
+Add a new commit and re-split
+
+  $ echo "v3" > lib/a.ml
+  $ git add . && git commit -q -m "third"
+  $ git-mono split lib > /dev/null
+
+Cache should now have 3 entries (only 1 new entry added)
+
+  $ wc -l < .git/subtree-cache/lib | tr -d ' '
+  3
+  $ cd ..

test/test.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let () =
+  Alcotest.run "git"
+    [
+      Test_hash.suite;
+      Test_blob.suite;
+      Test_user.suite;
+      Test_tree.suite;
+      Test_commit.suite;
+      Test_tag.suite;
+      Test_value.suite;
+      Test_reference.suite;
+      Test_pack.suite;
+      Test_pack_index.suite;
+      Test_config.suite;
+      Test_index.suite;
+      Test_repository.suite;
+      Test_rev_list.suite;
+      Test_subtree.suite;
+      Test_worktree.suite;
+      Test_diff.suite;
+      Test_remote.suite;
+    ]

test/test_blob.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let test_digest () =
+  (* git hash-object -t blob --stdin <<< "Hello, World!" gives this hash *)
+  let content = "Hello, World!\n" in
+  let blob = Git.Blob.of_string content in
+  let hash = Git.Blob.digest blob in
+  (* Verify roundtrip *)
+  Alcotest.(check string) "content" content (Git.Blob.to_string blob);
+  Alcotest.(check int) "length" 14 (Git.Blob.length blob);
+  (* The hash should be deterministic *)
+  let hash2 = Git.Blob.digest blob in
+  Alcotest.(check (testable Git.Hash.pp Git.Hash.equal)) "same hash" hash hash2
+
+let tests = [ Alcotest.test_case "digest" `Quick test_digest ]
+let suite = ("blob", tests)

test/test_blob.mli

···
+(** Blob tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_commit.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+
+let test_roundtrip () =
+  let tree_hash = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let author =
+    Git.User.v ~name:"Alice" ~email:"[e-mail]" ~date:1234567890L ()
+  in
+  let commit =
+    Git.Commit.v ~tree:tree_hash ~author ~committer:author
+      (Some "Initial commit\n")
+  in
+  let s = Git.Commit.to_string commit in
+  match Git.Commit.of_string s with
+  | Ok commit' ->
+      Alcotest.(check hash) "tree" tree_hash (Git.Commit.tree commit');
+      Alcotest.(check (list hash)) "parents" [] (Git.Commit.parents commit');
+      Alcotest.(check (option string))
+        "message" (Some "Initial commit\n")
+        (Git.Commit.message commit')
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_with_parents () =
+  let tree_hash = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let parent1 = Git.Hash.of_hex "0000000000000000000000000000000000000001" in
+  let parent2 = Git.Hash.of_hex "0000000000000000000000000000000000000002" in
+  let author =
+    Git.User.v ~name:"Alice" ~email:"[e-mail]" ~date:1234567890L ()
+  in
+  let commit =
+    Git.Commit.v ~tree:tree_hash ~author ~committer:author
+      ~parents:[ parent1; parent2 ] (Some "Merge commit\n")
+  in
+  let s = Git.Commit.to_string commit in
+  match Git.Commit.of_string s with
+  | Ok commit' ->
+      Alcotest.(check (list hash))
+        "parents" [ parent1; parent2 ]
+        (Git.Commit.parents commit')
+  | Error (`Msg m) -> Alcotest.fail m
+
+let tests =
+  [
+    Alcotest.test_case "roundtrip" `Quick test_roundtrip;
+    Alcotest.test_case "with_parents" `Quick test_with_parents;
+  ]
+
+let suite = ("commit", tests)

test/test_commit.mli

···
+(** Commit tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_config.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let with_temp_repo = Test_helpers.with_temp_repo
+
+let test_parse () =
+  let config_content =
+    {|[core]
+	repositoryformatversion = 0
+	filemode = true
+	bare = false
+[remote "origin"]
+	url = https://github.com/user/repo.git
+	fetch = +refs/heads/*:refs/remotes/origin/*
+	pushurl = [e-mail]:user/repo.git
+[branch "main"]
+	remote = origin
+	merge = refs/heads/main
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let core = Git.Config.section "core" in
+  Alcotest.(check (option string))
+    "core.bare" (Some "false")
+    (Git.Config.find config core "bare");
+  let remotes = Git.Config.remotes config in
+  Alcotest.(check int) "1 remote" 1 (List.length remotes);
+  let origin = List.hd remotes in
+  Alcotest.(check string) "remote name" "origin" origin.name;
+  Alcotest.(check (option string))
+    "remote url" (Some "https://github.com/user/repo.git") origin.url;
+  Alcotest.(check (option string))
+    "remote pushurl" (Some "[e-mail]:user/repo.git") origin.push_url;
+  let branches = Git.Config.branches config in
+  Alcotest.(check int) "1 branch" 1 (List.length branches);
+  let main = List.hd branches in
+  Alcotest.(check string) "branch name" "main" main.name;
+  Alcotest.(check (option string)) "branch remote" (Some "origin") main.remote;
+  Alcotest.(check (option string))
+    "branch merge" (Some "refs/heads/main") main.merge
+
+let test_section_subsection () =
+  let config_content =
+    {|[remote "origin"]
+	url = https://github.com/foo/bar.git
+[remote "upstream"]
+	url = https://github.com/other/bar.git
+[branch "main"]
+	remote = origin
+[branch "feature"]
+	remote = upstream
+	rebase = true
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let origin_section = Git.Config.section_sub "remote" "origin" in
+  Alcotest.(check (option string))
+    "origin url" (Some "https://github.com/foo/bar.git")
+    (Git.Config.find config origin_section "url");
+  let upstream_section = Git.Config.section_sub "remote" "upstream" in
+  Alcotest.(check (option string))
+    "upstream url" (Some "https://github.com/other/bar.git")
+    (Git.Config.find config upstream_section "url");
+  let remote_sections = Git.Config.sections config "remote" in
+  Alcotest.(check int) "2 remote sections" 2 (List.length remote_sections);
+  let branch_sections = Git.Config.sections config "branch" in
+  Alcotest.(check int) "2 branch sections" 2 (List.length branch_sections)
+
+let test_comments () =
+  let config_content =
+    {|[core]
+	# This is a comment
+	bare = false ; inline comment
+[remote "origin"]
+	url = https://example.com
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let core = Git.Config.section "core" in
+  Alcotest.(check (option string))
+    "bare without comment" (Some "false")
+    (Git.Config.find config core "bare")
+
+let test_boolean_values () =
+  let config_content =
+    {|[test]
+	yes_val = yes
+	no_val = no
+	on_val = on
+	off_val = off
+	true_val = true
+	false_val = false
+	one_val = 1
+	zero_val = 0
+	empty_val =
+	bare_key
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let test = Git.Config.section "test" in
+  Alcotest.(check (option bool))
+    "yes" (Some true)
+    (Git.Config.bool config test "yes_val");
+  Alcotest.(check (option bool))
+    "on" (Some true)
+    (Git.Config.bool config test "on_val");
+  Alcotest.(check (option bool))
+    "true" (Some true)
+    (Git.Config.bool config test "true_val");
+  Alcotest.(check (option bool))
+    "1" (Some true)
+    (Git.Config.bool config test "one_val");
+  Alcotest.(check (option bool))
+    "bare key" (Some true)
+    (Git.Config.bool config test "bare_key");
+  Alcotest.(check (option bool))
+    "no" (Some false)
+    (Git.Config.bool config test "no_val");
+  Alcotest.(check (option bool))
+    "off" (Some false)
+    (Git.Config.bool config test "off_val");
+  Alcotest.(check (option bool))
+    "false" (Some false)
+    (Git.Config.bool config test "false_val");
+  Alcotest.(check (option bool))
+    "0" (Some false)
+    (Git.Config.bool config test "zero_val");
+  Alcotest.(check (option bool))
+    "empty" (Some false)
+    (Git.Config.bool config test "empty_val")
+
+let test_multivalue () =
+  let config_content =
+    {|[remote "origin"]
+	url = https://github.com/foo/bar.git
+	fetch = +refs/heads/*:refs/remotes/origin/*
+	fetch = +refs/tags/*:refs/tags/*
+	fetch = +refs/notes/*:refs/notes/*
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let origin = Git.Config.section_sub "remote" "origin" in
+  Alcotest.(check (option string))
+    "first fetch" (Some "+refs/heads/*:refs/remotes/origin/*")
+    (Git.Config.find config origin "fetch");
+  let all_fetch = Git.Config.all config origin "fetch" in
+  Alcotest.(check int) "3 fetch refspecs" 3 (List.length all_fetch);
+  Alcotest.(check (list string))
+    "all fetch values"
+    [
+      "+refs/heads/*:refs/remotes/origin/*";
+      "+refs/tags/*:refs/tags/*";
+      "+refs/notes/*:refs/notes/*";
+    ]
+    all_fetch
+
+let test_escape_sequences () =
+  let config_content =
+    {|[remote "foo\"bar"]
+	url = "value with \"quotes\""
+[section "path\\with\\backslash"]
+	key = "line1\nline2"
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let sections = Git.Config.sections config "remote" in
+  Alcotest.(check int) "1 remote" 1 (List.length sections);
+  let remote = List.hd sections in
+  Alcotest.(check (option string))
+    "subsection with quote" (Some "foo\"bar") remote.subsection;
+  Alcotest.(check (option string))
+    "quoted value" (Some "value with \"quotes\"")
+    (Git.Config.find config remote "url");
+  let path_sections = Git.Config.sections config "section" in
+  Alcotest.(check int) "1 section" 1 (List.length path_sections);
+  let path_section = List.hd path_sections in
+  Alcotest.(check (option string))
+    "subsection with backslash" (Some "path\\with\\backslash")
+    path_section.subsection;
+  Alcotest.(check (option string))
+    "value with newline" (Some "line1\nline2")
+    (Git.Config.find config path_section "key")
+
+let test_core () =
+  let config_content =
+    {|[core]
+	repositoryformatversion = 1
+	filemode = false
+	bare = true
+	ignorecase = true
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let core = Git.Config.core config in
+  Alcotest.(check int) "version" 1 core.repositoryformatversion;
+  Alcotest.(check bool) "filemode" false core.filemode;
+  Alcotest.(check bool) "bare" true core.bare;
+  Alcotest.(check bool) "ignorecase" true core.ignorecase
+
+let test_core_defaults () =
+  let config = Git.Config.of_string "[other]\n\tkey = value\n" in
+  let core = Git.Config.core config in
+  Alcotest.(check int) "default version" 0 core.repositoryformatversion;
+  Alcotest.(check bool) "default filemode" true core.filemode;
+  Alcotest.(check bool) "default bare" false core.bare;
+  Alcotest.(check bool) "default ignorecase" false core.ignorecase
+
+let test_user () =
+  let config_content =
+    {|[user]
+	name = Alice Smith
+	email = [e-mail]
+|}
+  in
+  let config = Git.Config.of_string config_content in
+  let user = Git.Config.user config in
+  Alcotest.(check (option string)) "name" (Some "Alice Smith") user.name;
+  Alcotest.(check (option string)) "email" (Some "[e-mail]") user.email
+
+let test_roundtrip () =
+  let core =
+    {
+      Git.Config.bare = false;
+      filemode = true;
+      ignorecase = false;
+      repositoryformatversion = 0;
+    }
+  in
+  let remote =
+    {
+      Git.Config.name = "origin";
+      url = Some "https://example.com";
+      push_url = None;
+      fetch = [ "+refs/heads/*:refs/remotes/origin/*" ];
+    }
+  in
+  let branch =
+    {
+      Git.Config.name = "main";
+      remote = Some "origin";
+      merge = Some "refs/heads/main";
+      rebase = Some true;
+    }
+  in
+  let config =
+    Git.Config.of_core core
+    @ Git.Config.of_remote remote
+    @ Git.Config.of_branch branch
+  in
+  let serialized = Git.Config.to_string config in
+  let parsed = Git.Config.of_string serialized in
+  let parsed_core = Git.Config.core parsed in
+  Alcotest.(check bool) "roundtrip bare" core.bare parsed_core.bare;
+  let parsed_remotes = Git.Config.remotes parsed in
+  Alcotest.(check int) "roundtrip 1 remote" 1 (List.length parsed_remotes);
+  let parsed_origin = List.hd parsed_remotes in
+  Alcotest.(check string) "roundtrip remote name" "origin" parsed_origin.name;
+  let parsed_branches = Git.Config.branches parsed in
+  Alcotest.(check int) "roundtrip 1 branch" 1 (List.length parsed_branches);
+  let parsed_main = List.hd parsed_branches in
+  Alcotest.(check (option bool))
+    "roundtrip rebase" (Some true) parsed_main.rebase
+
+let test_set_unset () =
+  let config = Git.Config.empty in
+  let core = Git.Config.section "core" in
+  let config = Git.Config.set config ~section:core ~key:"bare" ~value:"false" in
+  let config =
+    Git.Config.set config ~section:core ~key:"filemode" ~value:"true"
+  in
+  Alcotest.(check (option string))
+    "bare" (Some "false")
+    (Git.Config.find config core "bare");
+  Alcotest.(check (option string))
+    "filemode" (Some "true")
+    (Git.Config.find config core "filemode");
+  let config = Git.Config.set config ~section:core ~key:"bare" ~value:"true" in
+  Alcotest.(check (option string))
+    "bare updated" (Some "true")
+    (Git.Config.find config core "bare");
+  let config = Git.Config.unset config ~section:core ~key:"bare" in
+  Alcotest.(check (option string))
+    "bare unset" None
+    (Git.Config.find config core "bare");
+  Alcotest.(check (option string))
+    "filemode still there" (Some "true")
+    (Git.Config.find config core "filemode")
+
+let test_repo_remotes () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let git_dir = Fpath.to_string (Git.Repository.git_dir repo) in
+  let config_content =
+    {|[core]
+	bare = false
+[remote "origin"]
+	url = https://github.com/user/repo.git
+[remote "upstream"]
+	url = https://github.com/other/repo.git
+|}
+  in
+  let config_path = Eio.Path.(fs / git_dir / "config") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) config_path config_content;
+  let remotes = Git.Repository.list_remotes repo in
+  Alcotest.(check int) "2 remotes" 2 (List.length remotes);
+  Alcotest.(check bool) "has origin" true (List.mem "origin" remotes);
+  Alcotest.(check bool) "has upstream" true (List.mem "upstream" remotes);
+  Alcotest.(check (option string))
+    "origin url" (Some "https://github.com/user/repo.git")
+    (Git.Repository.remote_url repo "origin");
+  Alcotest.(check (option string))
+    "unknown remote" None
+    (Git.Repository.remote_url repo "nonexistent")
+
+let test_add_remote () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let result =
+    Git.Repository.add_remote repo ~name:"origin"
+      ~url:"https://github.com/user/repo.git" ()
+  in
+  Alcotest.(check bool) "add_remote succeeds" true (Result.is_ok result);
+  let remotes = Git.Repository.list_remotes repo in
+  Alcotest.(check int) "1 remote" 1 (List.length remotes);
+  Alcotest.(check bool) "has origin" true (List.mem "origin" remotes);
+  Alcotest.(check (option string))
+    "origin url" (Some "https://github.com/user/repo.git")
+    (Git.Repository.remote_url repo "origin");
+  let remote = Git.Repository.remote repo "origin" in
+  Alcotest.(check bool) "remote found" true (Option.is_some remote);
+  let remote = Option.get remote in
+  Alcotest.(check int) "1 fetch refspec" 1 (List.length remote.fetch);
+  Alcotest.(check string)
+    "default fetch" "+refs/heads/*:refs/remotes/origin/*" (List.hd remote.fetch);
+  let result =
+    Git.Repository.add_remote repo ~name:"origin"
+      ~url:"https://other.com/repo.git" ()
+  in
+  Alcotest.(check bool) "duplicate fails" true (Result.is_error result)
+
+let test_add_remote_push_url () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let result =
+    Git.Repository.add_remote repo ~name:"origin"
+      ~url:"https://github.com/user/repo.git"
+      ~push_url:"[e-mail]:user/repo.git" ()
+  in
+  Alcotest.(check bool) "add_remote succeeds" true (Result.is_ok result);
+  Alcotest.(check (option string))
+    "push url" (Some "[e-mail]:user/repo.git")
+    (Git.Repository.push_url repo "origin")
+
+let test_remove_remote () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let _ =
+    Git.Repository.add_remote repo ~name:"origin"
+      ~url:"https://github.com/user/repo.git" ()
+  in
+  let _ =
+    Git.Repository.add_remote repo ~name:"upstream"
+      ~url:"https://github.com/other/repo.git" ()
+  in
+  Alcotest.(check int)
+    "2 remotes" 2
+    (List.length (Git.Repository.list_remotes repo));
+  let result = Git.Repository.remove_remote repo "upstream" in
+  Alcotest.(check bool) "remove succeeds" true (Result.is_ok result);
+  let remotes = Git.Repository.list_remotes repo in
+  Alcotest.(check int) "1 remote" 1 (List.length remotes);
+  Alcotest.(check bool) "has origin" true (List.mem "origin" remotes);
+  Alcotest.(check bool) "no upstream" false (List.mem "upstream" remotes);
+  let result = Git.Repository.remove_remote repo "nonexistent" in
+  Alcotest.(check bool) "remove nonexistent fails" true (Result.is_error result)
+
+let tests =
+  [
+    Alcotest.test_case "parse" `Quick test_parse;
+    Alcotest.test_case "section_subsection" `Quick test_section_subsection;
+    Alcotest.test_case "comments" `Quick test_comments;
+    Alcotest.test_case "boolean_values" `Quick test_boolean_values;
+    Alcotest.test_case "multivalue" `Quick test_multivalue;
+    Alcotest.test_case "escape_sequences" `Quick test_escape_sequences;
+    Alcotest.test_case "core" `Quick test_core;
+    Alcotest.test_case "core_defaults" `Quick test_core_defaults;
+    Alcotest.test_case "user" `Quick test_user;
+    Alcotest.test_case "roundtrip" `Quick test_roundtrip;
+    Alcotest.test_case "set_unset" `Quick test_set_unset;
+    Alcotest.test_case "repo_remotes" `Quick test_repo_remotes;
+    Alcotest.test_case "add_remote" `Quick test_add_remote;
+    Alcotest.test_case "add_remote_with_push_url" `Quick
+      test_add_remote_push_url;
+    Alcotest.test_case "remove_remote" `Quick test_remove_remote;
+  ]
+
+let suite = ("config", tests)

test/test_config.mli

···
+(** Config tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_diff.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let test_stats_empty () =
+  let s = Git.Diff.stats [] in
+  Alcotest.(check int) "additions" 0 s.additions;
+  Alcotest.(check int) "deletions" 0 s.deletions;
+  Alcotest.(check int) "modifications" 0 s.modifications
+
+let test_stats_mixed () =
+  let h = Git.Hash.of_hex (String.make 40 'a') in
+  let changes =
+    [
+      Git.Diff.Added { path = "a.txt"; hash = h; perm = `Normal };
+      Git.Diff.Added { path = "b.txt"; hash = h; perm = `Normal };
+      Git.Diff.Removed { path = "c.txt"; hash = h; perm = `Normal };
+      Git.Diff.Modified
+        {
+          path = "d.txt";
+          old_hash = h;
+          new_hash = h;
+          old_perm = `Normal;
+          new_perm = `Normal;
+        };
+    ]
+  in
+  let s = Git.Diff.stats changes in
+  Alcotest.(check int) "additions" 2 s.additions;
+  Alcotest.(check int) "deletions" 1 s.deletions;
+  Alcotest.(check int) "modifications" 1 s.modifications
+
+let test_filter_by_path_empty () =
+  let result = Git.Diff.filter_by_path ~prefix:"src" [] in
+  Alcotest.(check int) "empty list" 0 (List.length result)
+
+let test_filter_by_path () =
+  let h = Git.Hash.of_hex (String.make 40 'b') in
+  let changes =
+    [
+      Git.Diff.Added { path = "src/a.ml"; hash = h; perm = `Normal };
+      Git.Diff.Added { path = "test/b.ml"; hash = h; perm = `Normal };
+      Git.Diff.Added { path = "src/lib/c.ml"; hash = h; perm = `Normal };
+    ]
+  in
+  let filtered = Git.Diff.filter_by_path ~prefix:"src" changes in
+  Alcotest.(check int) "filtered count" 2 (List.length filtered)
+
+let test_pp_change () =
+  let h = Git.Hash.of_hex (String.make 40 'c') in
+  let change = Git.Diff.Added { path = "foo.ml"; hash = h; perm = `Normal } in
+  let s = Fmt.to_to_string Git.Diff.pp_change change in
+  Alcotest.(check bool) "contains path" true (String.length s > 0)
+
+let test_pp_stats () =
+  let s = { Git.Diff.additions = 1; deletions = 2; modifications = 3 } in
+  let out = Fmt.to_to_string Git.Diff.pp_stats s in
+  Alcotest.(check bool) "non-empty" true (String.length out > 0)
+
+let tests =
+  [
+    Alcotest.test_case "stats_empty" `Quick test_stats_empty;
+    Alcotest.test_case "stats_mixed" `Quick test_stats_mixed;
+    Alcotest.test_case "filter_by_path_empty" `Quick test_filter_by_path_empty;
+    Alcotest.test_case "filter_by_path" `Quick test_filter_by_path;
+    Alcotest.test_case "pp_change" `Quick test_pp_change;
+    Alcotest.test_case "pp_stats" `Quick test_pp_stats;
+  ]
+
+let suite = ("diff", tests)

test/test_diff.mli

···
+(** Diff tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_hash.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+
+let test_roundtrip () =
+  let hex = "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let h = Git.Hash.of_hex hex in
+  Alcotest.(check string) "hex roundtrip" hex (Git.Hash.to_hex h);
+  let raw = Git.Hash.to_raw_string h in
+  Alcotest.(check int) "raw length" 20 (String.length raw);
+  let h' = Git.Hash.of_raw_string raw in
+  Alcotest.(check hash) "raw roundtrip" h h'
+
+let tests = [ Alcotest.test_case "roundtrip" `Quick test_roundtrip ]
+let suite = ("hash", tests)

test/test_hash.mli

···
+(** Hash tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_index.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+let with_temp_repo = Test_helpers.with_temp_repo
+
+let test_empty () =
+  let idx = Git.Index.empty in
+  Alcotest.(check int)
+    "empty has 0 entries" 0
+    (List.length (Git.Index.entries idx));
+  let serialized = Git.Index.to_string idx in
+  Alcotest.(check bool)
+    "starts with DIRC" true
+    (String.sub serialized 0 4 = "DIRC")
+
+let test_roundtrip () =
+  let hash1 = Git.Hash.of_hex "1234567890abcdef1234567890abcdef12345678" in
+  let hash2 = Git.Hash.of_hex "abcdef1234567890abcdef1234567890abcdef12" in
+  let entry1 : Git.Index.entry =
+    {
+      ctime_s = 1000l;
+      ctime_ns = 0l;
+      mtime_s = 1000l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Regular;
+      uid = 0l;
+      gid = 0l;
+      size = 100l;
+      hash = hash1;
+      flags = 0;
+      name = "file.txt";
+    }
+  in
+  let entry2 : Git.Index.entry =
+    {
+      ctime_s = 2000l;
+      ctime_ns = 0l;
+      mtime_s = 2000l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Executable;
+      uid = 0l;
+      gid = 0l;
+      size = 200l;
+      hash = hash2;
+      flags = 0;
+      name = "script.sh";
+    }
+  in
+  let idx = Git.Index.add (Git.Index.add Git.Index.empty entry1) entry2 in
+  Alcotest.(check int) "2 entries" 2 (List.length (Git.Index.entries idx));
+  let serialized = Git.Index.to_string idx in
+  match Git.Index.of_string serialized with
+  | Error (`Msg e) -> Alcotest.fail e
+  | Ok parsed ->
+      Alcotest.(check int)
+        "parsed has 2 entries" 2
+        (List.length (Git.Index.entries parsed));
+      let entries = Git.Index.entries parsed in
+      let e1 = List.hd entries in
+      let e2 = List.nth entries 1 in
+      Alcotest.(check string) "first entry name" "file.txt" e1.name;
+      Alcotest.(check string) "second entry name" "script.sh" e2.name;
+      Alcotest.(check string)
+        "first entry hash" (Git.Hash.to_hex hash1) (Git.Hash.to_hex e1.hash)
+
+let test_add_remove () =
+  let hash = Git.Hash.of_hex "1234567890abcdef1234567890abcdef12345678" in
+  let entry : Git.Index.entry =
+    {
+      ctime_s = 0l;
+      ctime_ns = 0l;
+      mtime_s = 0l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Regular;
+      uid = 0l;
+      gid = 0l;
+      size = 0l;
+      hash;
+      flags = 0;
+      name = "test.txt";
+    }
+  in
+  let idx = Git.Index.empty in
+  Alcotest.(check bool) "not in empty" false (Git.Index.mem idx "test.txt");
+  let idx = Git.Index.add idx entry in
+  Alcotest.(check bool) "after add" true (Git.Index.mem idx "test.txt");
+  let idx = Git.Index.remove idx "test.txt" in
+  Alcotest.(check bool) "after remove" false (Git.Index.mem idx "test.txt")
+
+let test_find () =
+  let hash = Git.Hash.of_hex "1234567890abcdef1234567890abcdef12345678" in
+  let entry : Git.Index.entry =
+    {
+      ctime_s = 0l;
+      ctime_ns = 0l;
+      mtime_s = 0l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Executable;
+      uid = 0l;
+      gid = 0l;
+      size = 42l;
+      hash;
+      flags = 0;
+      name = "bin/tool";
+    }
+  in
+  let idx = Git.Index.add Git.Index.empty entry in
+  match Git.Index.find idx "bin/tool" with
+  | None -> Alcotest.fail "entry not found"
+  | Some found ->
+      Alcotest.(check int32) "size" 42l found.size;
+      Alcotest.(check bool)
+        "executable mode" true
+        (found.mode = Git.Index.Executable)
+
+let test_sorted () =
+  let make_entry name =
+    let hash = Git.Hash.of_hex "1234567890abcdef1234567890abcdef12345678" in
+    ({
+       ctime_s = 0l;
+       ctime_ns = 0l;
+       mtime_s = 0l;
+       mtime_ns = 0l;
+       dev = 0l;
+       ino = 0l;
+       mode = Git.Index.Regular;
+       uid = 0l;
+       gid = 0l;
+       size = 0l;
+       hash;
+       flags = 0;
+       name;
+     }
+      : Git.Index.entry)
+  in
+  let idx = Git.Index.empty in
+  let idx = Git.Index.add idx (make_entry "z.txt") in
+  let idx = Git.Index.add idx (make_entry "a.txt") in
+  let idx = Git.Index.add idx (make_entry "m.txt") in
+  let names =
+    List.map (fun (e : Git.Index.entry) -> e.name) (Git.Index.entries idx)
+  in
+  Alcotest.(check (list string)) "sorted" [ "a.txt"; "m.txt"; "z.txt" ] names
+
+let test_remove_prefix () =
+  let make_entry name =
+    let hash = Git.Hash.of_hex "1234567890abcdef1234567890abcdef12345678" in
+    ({
+       ctime_s = 0l;
+       ctime_ns = 0l;
+       mtime_s = 0l;
+       mtime_ns = 0l;
+       dev = 0l;
+       ino = 0l;
+       mode = Git.Index.Regular;
+       uid = 0l;
+       gid = 0l;
+       size = 0l;
+       hash;
+       flags = 0;
+       name;
+     }
+      : Git.Index.entry)
+  in
+  let idx = Git.Index.empty in
+  let idx = Git.Index.add idx (make_entry "README.md") in
+  let idx = Git.Index.add idx (make_entry "packages/foo/opam") in
+  let idx = Git.Index.add idx (make_entry "packages/foo/foo.dev/opam") in
+  let idx = Git.Index.add idx (make_entry "packages/bar/opam") in
+  let idx = Git.Index.add idx (make_entry "src/main.ml") in
+  Alcotest.(check int) "5 entries" 5 (List.length (Git.Index.entries idx));
+  let idx = Git.Index.remove_prefix idx "packages/foo" in
+  let names =
+    List.map (fun (e : Git.Index.entry) -> e.name) (Git.Index.entries idx)
+  in
+  Alcotest.(check (list string))
+    "after remove"
+    [ "README.md"; "packages/bar/opam"; "src/main.ml" ]
+    names;
+  let idx = Git.Index.remove_prefix idx "packages" in
+  let names =
+    List.map (fun (e : Git.Index.entry) -> e.name) (Git.Index.entries idx)
+  in
+  Alcotest.(check (list string))
+    "after remove packages"
+    [ "README.md"; "src/main.ml" ]
+    names
+
+let test_to_tree () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let hash1 = Git.Repository.write_blob repo "content 1" in
+  let hash2 = Git.Repository.write_blob repo "content 2" in
+  let hash3 = Git.Repository.write_blob repo "content 3" in
+  let make_entry name hash =
+    ({
+       ctime_s = 0l;
+       ctime_ns = 0l;
+       mtime_s = 0l;
+       mtime_ns = 0l;
+       dev = 0l;
+       ino = 0l;
+       mode = Git.Index.Regular;
+       uid = 0l;
+       gid = 0l;
+       size = 0l;
+       hash;
+       flags = 0;
+       name;
+     }
+      : Git.Index.entry)
+  in
+  let idx = Git.Index.empty in
+  let idx = Git.Index.add idx (make_entry "README.md" hash1) in
+  let idx = Git.Index.add idx (make_entry "src/main.ml" hash2) in
+  let idx = Git.Index.add idx (make_entry "src/lib/util.ml" hash3) in
+  let tree_hash =
+    Git.Index.to_tree
+      ~write_tree:(Git.Repository.write_tree repo)
+      ~write_blob:(Git.Repository.write_blob repo)
+      idx
+  in
+  match Git.Repository.read repo tree_hash with
+  | Error _ -> Alcotest.fail "failed to read tree"
+  | Ok (Git.Value.Tree tree) ->
+      let entries = Git.Tree.to_list tree in
+      Alcotest.(check int) "2 entries at root" 2 (List.length entries);
+      let names = List.map (fun (e : Git.Tree.entry) -> e.name) entries in
+      Alcotest.(check bool) "has README" true (List.mem "README.md" names);
+      Alcotest.(check bool) "has src" true (List.mem "src" names)
+  | Ok _ -> Alcotest.fail "expected tree"
+
+let test_commit_index () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let hash = Git.Repository.write_blob repo "Hello, World!" in
+  let entry : Git.Index.entry =
+    {
+      ctime_s = 0l;
+      ctime_ns = 0l;
+      mtime_s = 0l;
+      mtime_ns = 0l;
+      dev = 0l;
+      ino = 0l;
+      mode = Git.Index.Regular;
+      uid = 0l;
+      gid = 0l;
+      size = 13l;
+      hash;
+      flags = 0;
+      name = "hello.txt";
+    }
+  in
+  let index = Git.Index.add Git.Index.empty entry in
+  Git.Repository.write_index repo index;
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:1700000000L ()
+  in
+  match
+    Git.Repository.commit_index repo ~author ~committer:author
+      ~message:"Initial commit" ()
+  with
+  | Error (`Msg e) -> Alcotest.fail e
+  | Ok commit_hash -> (
+      match Git.Repository.read repo commit_hash with
+      | Error _ -> Alcotest.fail "couldn't read commit"
+      | Ok (Git.Value.Commit commit) -> (
+          Alcotest.(check (option string))
+            "message" (Some "Initial commit")
+            (Git.Commit.message commit);
+          match Git.Repository.head repo with
+          | None -> Alcotest.fail "HEAD not updated"
+          | Some h ->
+              Alcotest.(check string)
+                "HEAD points to commit"
+                (Git.Hash.to_hex commit_hash)
+                (Git.Hash.to_hex h))
+      | Ok _ -> Alcotest.fail "expected commit")
+
+let test_checkout () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let readme_hash = Git.Repository.write_blob repo "# Hello World" in
+  let main_hash =
+    Git.Repository.write_blob repo "let () = print_endline \"Hello\""
+  in
+  let src_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"main.ml" main_hash ]
+  in
+  let src_hash = Git.Repository.write_tree repo src_tree in
+  let root_tree =
+    Git.Tree.v
+      [
+        Git.Tree.entry ~perm:`Normal ~name:"README.md" readme_hash;
+        Git.Tree.entry ~perm:`Dir ~name:"src" src_hash;
+      ]
+  in
+  let root_hash = Git.Repository.write_tree repo root_tree in
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:1700000000L ()
+  in
+  let commit =
+    Git.Commit.v ~tree:root_hash ~author ~committer:author (Some "Initial")
+  in
+  let commit_hash = Git.Repository.write_commit repo commit in
+  match Git.Repository.checkout repo commit_hash with
+  | Error (`Msg e) -> Alcotest.fail e
+  | Ok () ->
+      let tmp_dir_str = Fpath.to_string tmp_dir in
+      let readme_path = Eio.Path.(fs / tmp_dir_str / "README.md") in
+      let main_path = Eio.Path.(fs / tmp_dir_str / "src" / "main.ml") in
+      Alcotest.(check bool)
+        "README.md exists" true
+        (Eio.Path.is_file readme_path);
+      Alcotest.(check bool)
+        "src/main.ml exists" true
+        (Eio.Path.is_file main_path);
+      let readme_content = Eio.Path.load readme_path in
+      Alcotest.(check string) "README content" "# Hello World" readme_content;
+      let main_content = Eio.Path.load main_path in
+      Alcotest.(check string)
+        "main.ml content" "let () = print_endline \"Hello\"" main_content
+
+let tests =
+  [
+    Alcotest.test_case "empty" `Quick test_empty;
+    Alcotest.test_case "roundtrip" `Quick test_roundtrip;
+    Alcotest.test_case "add_remove" `Quick test_add_remove;
+    Alcotest.test_case "find" `Quick test_find;
+    Alcotest.test_case "sorted" `Quick test_sorted;
+    Alcotest.test_case "remove_prefix" `Quick test_remove_prefix;
+    Alcotest.test_case "to_tree" `Quick test_to_tree;
+    Alcotest.test_case "commit_index" `Quick test_commit_index;
+    Alcotest.test_case "checkout" `Quick test_checkout;
+  ]
+
+let suite = ("index", tests)

test/test_index.mli

···
+(** Index tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_pack.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let pack_file =
+  let ic = open_in_bin "pack-testzone-0.pack" in
+  let len = in_channel_length ic in
+  let data = really_input_string ic len in
+  close_in ic;
+  data
+
+let index_file =
+  let ic = open_in_bin "pack-testzone-0.idx" in
+  let len = in_channel_length ic in
+  let data = really_input_string ic len in
+  close_in ic;
+  data
+
+let test_header () =
+  match Git.Pack.of_string pack_file with
+  | Ok pack ->
+      Alcotest.(check int) "version" 2 (Git.Pack.version pack);
+      (* pack-testzone-0 has 192 objects *)
+      Alcotest.(check int) "count" 192 (Git.Pack.count pack)
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_read_first_object () =
+  match Git.Pack.of_string pack_file with
+  | Ok pack -> (
+      (* Read first object at offset 12 (after header) *)
+      match Git.Pack.read_object_at pack 12 with
+      | Ok (kind, data) ->
+          (* Just verify we got some data *)
+          Alcotest.(check bool) "has data" true (String.length data > 0);
+          Alcotest.(check bool)
+            "valid kind" true
+            (match kind with `Commit | `Tree | `Blob | `Tag -> true)
+      | Error (`Msg m) -> Alcotest.fail m)
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_zlib_inflate () =
+  (* Simple zlib test - compress and decompress *)
+  let original = "Hello, World! This is a test string for zlib compression." in
+  (* Create zlib-compressed data *)
+  let compressed =
+    let reader = Bytesrw.Bytes.Reader.of_string original in
+    let compressed_reader = Bytesrw_zlib.Zlib.compress_reads () reader in
+    Bytesrw.Bytes.Reader.to_string compressed_reader
+  in
+  match Git.Pack.inflate compressed with
+  | Ok decompressed -> Alcotest.(check string) "roundtrip" original decompressed
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_delta () =
+  (* Test delta application with a simple example *)
+  let source = "Hello, World!" in
+  (* Delta format: source_size, target_size, then commands *)
+  (* Source size = 13 (0x0D), Target size = 14 (0x0E) *)
+  (* Command: COPY offset=0, size=13: cmd=0x90 (0x80|0x10), size=0x0D *)
+  (*   - bit 7 (0x80): COPY command
+       - bit 4 (0x10): size byte 0 present
+       - offset is 0 by default (no offset bytes) *)
+  (* Command: INSERT 1 byte '!' = 0x01 '!' *)
+  let delta =
+    String.concat ""
+      [
+        "\x0D";
+        (* source size = 13 *)
+        "\x0E";
+        (* target size = 14 *)
+        "\x90\x0D";
+        (* COPY: cmd=0x90, size=13 *)
+        "\x01!";
+        (* INSERT: 1 byte '!' *)
+      ]
+  in
+  match Git.Pack.apply_delta ~source ~delta with
+  | Ok target -> Alcotest.(check string) "delta applied" "Hello, World!!" target
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_fold () =
+  (* Test that fold iterates over all objects exactly once *)
+  match Git.Pack.of_string pack_file with
+  | Ok pack -> (
+      let result =
+        Git.Pack.fold
+          (fun ~offset ~kind ~data acc ->
+            Alcotest.(check bool) "has data" true (String.length data > 0);
+            Alcotest.(check bool) "valid offset" true (offset >= 12);
+            Alcotest.(check bool)
+              "valid kind" true
+              (match kind with `Commit | `Tree | `Blob | `Tag -> true);
+            acc + 1)
+          0 pack
+      in
+      match result with
+      | Ok count -> Alcotest.(check int) "fold count matches header" 192 count
+      | Error (`Msg m) -> Alcotest.fail m)
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_fold_matches_index () =
+  (* Verify fold visits objects at the same offsets as the index *)
+  match (Git.Pack.of_string pack_file, Git.Pack_index.of_string index_file) with
+  | Ok pack, Ok idx ->
+      (* Collect all offsets from fold *)
+      let fold_offsets =
+        match
+          Git.Pack.fold
+            (fun ~offset ~kind:_ ~data:_ acc -> offset :: acc)
+            [] pack
+        with
+        | Ok offsets -> List.sort compare offsets
+        | Error (`Msg m) -> Alcotest.fail m
+      in
+      (* Collect all offsets from index *)
+      let index_offsets =
+        let offsets = ref [] in
+        Git.Pack_index.iter
+          (fun ~hash:_ ~offset ~crc:_ -> offsets := offset :: !offsets)
+          idx;
+        List.sort compare !offsets
+      in
+      Alcotest.(check int)
+        "same count"
+        (List.length index_offsets)
+        (List.length fold_offsets);
+      Alcotest.(check (list int)) "same offsets" index_offsets fold_offsets
+  | Error (`Msg m), _ -> Alcotest.fail ("pack: " ^ m)
+  | _, Error (`Msg m) -> Alcotest.fail ("index: " ^ m)
+
+(* Helper to run git commands in a directory *)
+let run_git dir args =
+  let cmd =
+    String.concat " "
+      ([ "git"; "-C"; dir ] @ List.map Filename.quote args @ [ "2>/dev/null" ])
+  in
+  let ic = Unix.open_process_in cmd in
+  let output = In_channel.input_all ic in
+  let _ = Unix.close_process_in ic in
+  String.trim output
+
+let test_from_git () =
+  (* Create a fresh repo with git, generate a pack, and verify we can read it *)
+  let tmp_dir = Filename.temp_dir "git_pack_test" "" in
+  Fun.protect
+    ~finally:(fun () -> ignore (Sys.command ("rm -rf " ^ tmp_dir)))
+    (fun () ->
+      (* Initialize repo *)
+      ignore (run_git tmp_dir [ "init" ]);
+      ignore (run_git tmp_dir [ "config"; "user.email"; "[e-mail]" ]);
+      ignore (run_git tmp_dir [ "config"; "user.name"; "Test" ]);
+      (* Create some content *)
+      let file1 = Filename.concat tmp_dir "file1.txt" in
+      let file2 = Filename.concat tmp_dir "file2.txt" in
+      let oc = open_out file1 in
+      output_string oc "Hello, World!\n";
+      close_out oc;
+      ignore (run_git tmp_dir [ "add"; "file1.txt" ]);
+      ignore (run_git tmp_dir [ "commit"; "-m"; "First commit" ]);
+      (* Second commit *)
+      let oc = open_out file2 in
+      output_string oc "Second file content\n";
+      close_out oc;
+      ignore (run_git tmp_dir [ "add"; "file2.txt" ]);
+      ignore (run_git tmp_dir [ "commit"; "-m"; "Second commit" ]);
+      (* Create pack file *)
+      ignore (run_git tmp_dir [ "gc"; "--aggressive" ]);
+      (* Find the pack file *)
+      let pack_dir = Filename.concat tmp_dir ".git/objects/pack" in
+      let files = Sys.readdir pack_dir in
+      let pack_file_path =
+        Array.to_list files
+        |> List.find (fun f -> Filename.check_suffix f ".pack")
+        |> Filename.concat pack_dir
+      in
+      (* Read and parse the pack *)
+      let ic = open_in_bin pack_file_path in
+      let data = In_channel.input_all ic in
+      close_in ic;
+      match Git.Pack.of_string data with
+      | Ok pack -> (
+          (* Should have at least: 2 commits, 2 trees, 2 blobs *)
+          Alcotest.(check bool) "has objects" true (Git.Pack.count pack >= 4);
+          (* Verify we can fold over all objects *)
+          let result =
+            Git.Pack.fold
+              (fun ~offset:_ ~kind:_ ~data acc -> acc + String.length data)
+              0 pack
+          in
+          match result with
+          | Ok total_size ->
+              Alcotest.(check bool) "has content" true (total_size > 0)
+          | Error (`Msg m) -> Alcotest.fail ("fold: " ^ m))
+      | Error (`Msg m) -> Alcotest.fail m)
+
+let test_with_deltas () =
+  (* Create objects that will result in delta encoding *)
+  let tmp_dir = Filename.temp_dir "git_delta_test" "" in
+  Fun.protect
+    ~finally:(fun () -> ignore (Sys.command ("rm -rf " ^ tmp_dir)))
+    (fun () ->
+      (* Initialize repo *)
+      ignore (run_git tmp_dir [ "init" ]);
+      ignore (run_git tmp_dir [ "config"; "user.email"; "[e-mail]" ]);
+      ignore (run_git tmp_dir [ "config"; "user.name"; "Test" ]);
+      (* Create a large file that will be delta-compressed when modified *)
+      let file = Filename.concat tmp_dir "large.txt" in
+      let oc = open_out file in
+      let ppf = Format.formatter_of_out_channel oc in
+      (* Write 10KB of content - enough to trigger delta compression *)
+      for i = 1 to 500 do
+        Fmt.pf ppf "Line %d: This is some repetitive content.\n" i
+      done;
+      Format.pp_print_flush ppf ();
+      close_out oc;
+      ignore (run_git tmp_dir [ "add"; "large.txt" ]);
+      ignore (run_git tmp_dir [ "commit"; "-m"; "Add large file" ]);
+      (* Modify just a few lines - this will create a delta *)
+      let oc = open_out file in
+      let ppf = Format.formatter_of_out_channel oc in
+      for i = 1 to 500 do
+        if i = 250 then Fmt.pf ppf "Line %d: MODIFIED CONTENT HERE!\n" i
+        else Fmt.pf ppf "Line %d: This is some repetitive content.\n" i
+      done;
+      Format.pp_print_flush ppf ();
+      close_out oc;
+      ignore (run_git tmp_dir [ "add"; "large.txt" ]);
+      ignore (run_git tmp_dir [ "commit"; "-m"; "Modify large file" ]);
+      (* Create pack with aggressive delta compression *)
+      ignore
+        (run_git tmp_dir [ "repack"; "-a"; "-d"; "--depth=50"; "--window=250" ]);
+      (* Find and read the pack *)
+      let pack_dir = Filename.concat tmp_dir ".git/objects/pack" in
+      let files = Sys.readdir pack_dir in
+      let pack_file_path =
+        Array.to_list files
+        |> List.find (fun f -> Filename.check_suffix f ".pack")
+        |> Filename.concat pack_dir
+      in
+      let ic = open_in_bin pack_file_path in
+      let data = In_channel.input_all ic in
+      close_in ic;
+      match Git.Pack.of_string data with
+      | Ok pack -> (
+          (* Fold should handle deltas correctly *)
+          let blobs = ref [] in
+          let result =
+            Git.Pack.fold
+              (fun ~offset:_ ~kind ~data acc ->
+                (match kind with `Blob -> blobs := data :: !blobs | _ -> ());
+                acc + 1)
+              0 pack
+          in
+          match result with
+          | Ok count ->
+              Alcotest.(check bool) "parsed all" true (count >= 4);
+              (* Verify we got the blob content *)
+              let has_line_content =
+                List.exists
+                  (fun b -> String.length b > 5 && String.sub b 0 5 = "Line ")
+                  !blobs
+              in
+              Alcotest.(check bool) "found blob content" true has_line_content
+          | Error (`Msg m) -> Alcotest.fail ("fold: " ^ m))
+      | Error (`Msg m) -> Alcotest.fail m)
+
+let tests =
+  [
+    Alcotest.test_case "header" `Quick test_header;
+    Alcotest.test_case "read_first_object" `Quick test_read_first_object;
+    Alcotest.test_case "zlib_inflate" `Quick test_zlib_inflate;
+    Alcotest.test_case "delta" `Quick test_delta;
+    Alcotest.test_case "fold" `Quick test_fold;
+    Alcotest.test_case "fold_matches_index" `Quick test_fold_matches_index;
+    Alcotest.test_case "from_git" `Slow test_from_git;
+    Alcotest.test_case "with_deltas" `Slow test_with_deltas;
+  ]
+
+let suite = ("pack", tests)

test/test_pack.mli

···
+(** Pack tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_pack_index.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let index_file =
+  let ic = open_in_bin "pack-testzone-0.idx" in
+  let len = in_channel_length ic in
+  let data = really_input_string ic len in
+  close_in ic;
+  data
+
+let pack_file =
+  let ic = open_in_bin "pack-testzone-0.pack" in
+  let len = in_channel_length ic in
+  let data = really_input_string ic len in
+  close_in ic;
+  data
+
+let test_header () =
+  match Git.Pack_index.of_string index_file with
+  | Ok idx ->
+      (* pack-testzone-0 has 192 objects *)
+      Alcotest.(check int) "count" 192 (Git.Pack_index.count idx)
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_lookup () =
+  match Git.Pack_index.of_string index_file with
+  | Ok idx -> (
+      (* Get first hash and verify we can look it up *)
+      let first_hash = Git.Pack_index.hash_at idx 0 in
+      (match Git.Pack_index.find idx first_hash with
+      | Some offset -> Alcotest.(check bool) "offset >= 12" true (offset >= 12)
+      | None -> Alcotest.fail "first hash not found");
+      (* Verify offset_at matches find *)
+      let expected_offset = Git.Pack_index.offset_at idx 0 in
+      match Git.Pack_index.find idx first_hash with
+      | Some offset ->
+          Alcotest.(check int) "offset matches" expected_offset offset
+      | None -> Alcotest.fail "first hash not found")
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_iter () =
+  match Git.Pack_index.of_string index_file with
+  | Ok idx ->
+      let count = ref 0 in
+      Git.Pack_index.iter
+        (fun ~hash:_ ~offset ~crc:_ ->
+          incr count;
+          (* All offsets should be >= 12 (after pack header) *)
+          Alcotest.(check bool) "valid offset" true (offset >= 12))
+        idx;
+      Alcotest.(check int) "iter count" 192 !count
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_with_pack () =
+  (* Test reading objects using the index *)
+  match (Git.Pack.of_string pack_file, Git.Pack_index.of_string index_file) with
+  | Ok pack, Ok idx ->
+      (* Read first few objects using offsets from index *)
+      for i = 0 to min 9 (Git.Pack_index.count idx - 1) do
+        let offset = Git.Pack_index.offset_at idx i in
+        match Git.Pack.read_object_at pack offset with
+        | Ok (kind, data) ->
+            Alcotest.(check bool) "has data" true (String.length data > 0);
+            Alcotest.(check bool)
+              "valid kind" true
+              (match kind with `Commit | `Tree | `Blob | `Tag -> true)
+        | Error (`Msg m) ->
+            Alcotest.failf "object %d at offset %d: %s" i offset m
+      done
+  | Error (`Msg m), _ -> Alcotest.fail ("pack: " ^ m)
+  | _, Error (`Msg m) -> Alcotest.fail ("index: " ^ m)
+
+let suite =
+  ( "pack_index",
+    [
+      Alcotest.test_case "header" `Quick test_header;
+      Alcotest.test_case "lookup" `Quick test_lookup;
+      Alcotest.test_case "iter" `Quick test_iter;
+      Alcotest.test_case "with_pack" `Quick test_with_pack;
+    ] )

test/test_pack_index.mli

···
+(** Pack index tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_reference.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+
+let test_basic () =
+  let r = Git.Reference.v "refs/heads/main" in
+  Alcotest.(check string)
+    "to_string" "refs/heads/main"
+    (Git.Reference.to_string r);
+  Alcotest.(check (list string))
+    "segs"
+    [ "refs"; "heads"; "main" ]
+    (Git.Reference.segs r)
+
+let test_contents () =
+  let h = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let hash_contents = Git.Reference.Hash h in
+  let s = Git.Reference.contents_to_string hash_contents in
+  (match Git.Reference.contents_of_string s with
+  | Ok (Git.Reference.Hash h') -> Alcotest.(check hash) "hash" h h'
+  | Ok (Git.Reference.Ref _) -> Alcotest.fail "expected hash"
+  | Error (`Msg m) -> Alcotest.fail m);
+  let ref_contents = Git.Reference.Ref (Git.Reference.v "refs/heads/main") in
+  let s = Git.Reference.contents_to_string ref_contents in
+  match Git.Reference.contents_of_string s with
+  | Ok (Git.Reference.Ref r) ->
+      Alcotest.(check string)
+        "ref" "refs/heads/main"
+        (Git.Reference.to_string r)
+  | Ok (Git.Reference.Hash _) -> Alcotest.fail "expected ref"
+  | Error (`Msg m) -> Alcotest.fail m
+
+let tests =
+  [
+    Alcotest.test_case "basic" `Quick test_basic;
+    Alcotest.test_case "contents" `Quick test_contents;
+  ]
+
+let suite = ("reference", tests)

test/test_reference.mli

···
+(** Reference tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_remote.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+(* Remote operations require network access. These tests verify basic
+   type construction and module availability. *)
+
+let test_ref_entry_fields () =
+  let h = Git.Hash.of_hex (String.make 40 'a') in
+  let entry : Git.Remote.ref_entry =
+    { ref_name = "refs/heads/main"; hash = h }
+  in
+  Alcotest.(check string) "ref_name" "refs/heads/main" entry.ref_name;
+  Alcotest.(check (testable Git.Hash.pp Git.Hash.equal)) "hash" h entry.hash
+
+let tests =
+  [ Alcotest.test_case "ref_entry_fields" `Quick test_ref_entry_fields ]
+
+let suite = ("remote", tests)

test/test_remote.mli

···
+(** Remote tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_repository.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+let with_temp_repo = Test_helpers.with_temp_repo
+let commit = Test_helpers.commit
+let unwrap = function Ok x -> x | Error (`Msg e) -> Alcotest.fail e
+
+let string_contains ~needle haystack =
+  let n = String.length needle in
+  let h = String.length haystack in
+  if n > h then false
+  else
+    let rec check i =
+      if i + n > h then false
+      else if String.sub haystack i n = needle then true
+      else check (i + 1)
+    in
+    check 0
+
+(* Basic repository tests *)
+
+let test_is_repo () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  Alcotest.(check bool) "not a repo" false (Git.Repository.is_repo ~fs tmp_dir);
+  let _repo = Git.Repository.init ~fs tmp_dir in
+  Alcotest.(check bool) "is a repo" true (Git.Repository.is_repo ~fs tmp_dir)
+
+let test_current_branch () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  Alcotest.(check (option string))
+    "default branch" (Some "main")
+    (Git.Repository.current_branch repo)
+
+(* Log tests *)
+
+let test_log () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 =
+    commit ~repo ~tree ~parents:[] ~message:"First commit\n\nBody of first"
+  in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"Second commit" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"Third commit" in
+  let entries = Git.Repository.log repo c3 in
+  Alcotest.(check int) "3 entries" 3 (List.length entries);
+  Alcotest.(check string)
+    "first subject" "Third commit" (List.nth entries 0).subject;
+  Alcotest.(check string)
+    "second subject" "Second commit" (List.nth entries 1).subject;
+  Alcotest.(check string)
+    "third subject" "First commit" (List.nth entries 2).subject;
+  Alcotest.(check string) "third body" "Body of first" (List.nth entries 2).body
+
+let test_log_max_count () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let entries = Git.Repository.log repo ~max_count:2 c3 in
+  Alcotest.(check int) "2 entries" 2 (List.length entries)
+
+let test_log_range () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  let entries = Git.Repository.log_range repo ~base:c1 ~head:c4 () in
+  Alcotest.(check int) "3 entries in range" 3 (List.length entries)
+
+(* Helper to create commit with specific timestamp *)
+let commit_at ~repo ~tree ~parents ~message ~timestamp =
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:timestamp ()
+  in
+  let commit =
+    Git.Commit.v ~tree ~author ~committer:author ~parents (Some message)
+  in
+  Git.Repository.write_commit repo commit
+
+(* log_filtered tests *)
+
+let test_log_filtered_since () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit_at ~repo ~tree ~parents:[] ~message:"c1" ~timestamp:1000L in
+  let c2 =
+    commit_at ~repo ~tree ~parents:[ c1 ] ~message:"c2" ~timestamp:2000L
+  in
+  let c3 =
+    commit_at ~repo ~tree ~parents:[ c2 ] ~message:"c3" ~timestamp:3000L
+  in
+  let entries = Git.Repository.log_filtered repo ~since:2000L c3 in
+  Alcotest.(check int) "2 entries since 2000" 2 (List.length entries)
+
+let test_log_filtered_until () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit_at ~repo ~tree ~parents:[] ~message:"c1" ~timestamp:1000L in
+  let c2 =
+    commit_at ~repo ~tree ~parents:[ c1 ] ~message:"c2" ~timestamp:2000L
+  in
+  let c3 =
+    commit_at ~repo ~tree ~parents:[ c2 ] ~message:"c3" ~timestamp:3000L
+  in
+  let entries = Git.Repository.log_filtered repo ~until:2000L c3 in
+  Alcotest.(check int) "2 entries until 2000" 2 (List.length entries)
+
+let test_log_filtered_path () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  (* Create tree with file "a.txt" *)
+  let blob_a = Git.Repository.write_blob repo "content a" in
+  let tree_a =
+    Git.Repository.write_tree repo
+      (Git.Tree.v [ { name = "a.txt"; perm = `Normal; hash = blob_a } ])
+  in
+  (* Create tree with files "a.txt" and "b.txt" *)
+  let blob_b = Git.Repository.write_blob repo "content b" in
+  let tree_ab =
+    Git.Repository.write_tree repo
+      (Git.Tree.v
+         [
+           { name = "a.txt"; perm = `Normal; hash = blob_a };
+           { name = "b.txt"; perm = `Normal; hash = blob_b };
+         ])
+  in
+  (* Create tree with modified "a.txt" and "b.txt" *)
+  let blob_a2 = Git.Repository.write_blob repo "content a modified" in
+  let tree_ab2 =
+    Git.Repository.write_tree repo
+      (Git.Tree.v
+         [
+           { name = "a.txt"; perm = `Normal; hash = blob_a2 };
+           { name = "b.txt"; perm = `Normal; hash = blob_b };
+         ])
+  in
+  let c1 = commit ~repo ~tree:tree_a ~parents:[] ~message:"add a" in
+  let c2 = commit ~repo ~tree:tree_ab ~parents:[ c1 ] ~message:"add b" in
+  let c3 = commit ~repo ~tree:tree_ab2 ~parents:[ c2 ] ~message:"modify a" in
+  (* Filter for commits touching "a.txt" - should be c1 and c3 *)
+  let entries = Git.Repository.log_filtered repo ~path:"a.txt" c3 in
+  Alcotest.(check int) "2 commits touch a.txt" 2 (List.length entries);
+  (* Filter for commits touching "b.txt" - should be c2 only *)
+  let entries_b = Git.Repository.log_filtered repo ~path:"b.txt" c3 in
+  Alcotest.(check int) "1 commit touches b.txt" 1 (List.length entries_b)
+
+let test_log_filtered_combined () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit_at ~repo ~tree ~parents:[] ~message:"c1" ~timestamp:1000L in
+  let c2 =
+    commit_at ~repo ~tree ~parents:[ c1 ] ~message:"c2" ~timestamp:2000L
+  in
+  let c3 =
+    commit_at ~repo ~tree ~parents:[ c2 ] ~message:"c3" ~timestamp:3000L
+  in
+  let c4 =
+    commit_at ~repo ~tree ~parents:[ c3 ] ~message:"c4" ~timestamp:4000L
+  in
+  let entries = Git.Repository.log_filtered repo ~since:2000L ~until:3000L c4 in
+  Alcotest.(check int) "2 entries in range" 2 (List.length entries)
+
+(* Resolve ref tests *)
+
+let test_resolve_ref_head () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  Alcotest.(check (option hash))
+    "resolve HEAD" (Some c1)
+    (Git.Repository.resolve_ref repo "HEAD")
+
+let test_resolve_ref_branch () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  Git.Repository.write_ref repo "refs/heads/feature" c1;
+  Alcotest.(check (option hash))
+    "resolve branch" (Some c1)
+    (Git.Repository.resolve_ref repo "feature")
+
+let test_resolve_ref_remote () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  (* Create remote ref directory structure *)
+  let git_dir = Fpath.to_string (Git.Repository.git_dir repo) in
+  let remote_dir = Eio.Path.(fs / git_dir / "refs" / "remotes" / "origin") in
+  Eio.Path.mkdirs ~perm:0o755 remote_dir;
+  Git.Repository.write_ref repo "refs/remotes/origin/main" c1;
+  Alcotest.(check (option hash))
+    "resolve origin/main" (Some c1)
+    (Git.Repository.resolve_ref repo "origin/main")
+
+let test_resolve_ref_not_found () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  Alcotest.(check (option hash))
+    "nonexistent ref" None
+    (Git.Repository.resolve_ref repo "nonexistent")
+
+(* log_range_refs tests *)
+
+let test_log_range_refs_basic () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  Git.Repository.write_ref repo "refs/heads/main" c3;
+  Git.Repository.write_ref repo "refs/heads/base" c1;
+  match Git.Repository.log_range_refs repo ~base:"base" ~tip:"main" () with
+  | Ok entries ->
+      Alcotest.(check int) "2 entries in range" 2 (List.length entries)
+  | Error (`Msg msg) -> Alcotest.fail msg
+
+let test_log_range_refs_head () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  Git.Repository.write_ref repo "refs/heads/main" c2;
+  Git.Repository.write_ref repo "refs/heads/old" c1;
+  match Git.Repository.log_range_refs repo ~base:"old" ~tip:"HEAD" () with
+  | Ok entries -> Alcotest.(check int) "1 entry" 1 (List.length entries)
+  | Error (`Msg msg) -> Alcotest.fail msg
+
+let test_log_range_refs_error () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  match
+    Git.Repository.log_range_refs repo ~base:"nonexistent" ~tip:"HEAD" ()
+  with
+  | Ok _ -> Alcotest.fail "should fail"
+  | Error (`Msg _) -> ()
+
+(* Advance head tests *)
+
+let test_advance_head_updates_branch () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  Git.Repository.write_ref repo "HEAD" c1;
+  let git_dir = Fpath.to_string (Git.Repository.git_dir repo) in
+  let head_path = Eio.Path.(fs / git_dir / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option string))
+    "on main" (Some "main")
+    (Git.Repository.current_branch repo);
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"second" in
+  Git.Repository.advance_head repo c2;
+  Alcotest.(check (option string))
+    "still on main" (Some "main")
+    (Git.Repository.current_branch repo);
+  Alcotest.(check (option hash))
+    "main updated" (Some c2)
+    (Git.Repository.read_ref repo "refs/heads/main");
+  Alcotest.(check (option hash))
+    "HEAD updated" (Some c2) (Git.Repository.head repo)
+
+let test_advance_head_detached () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  let git_dir = Fpath.to_string (Git.Repository.git_dir repo) in
+  let head_path = Eio.Path.(fs / git_dir / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path
+    (Git.Hash.to_hex c1 ^ "\n");
+  Alcotest.(check (option string))
+    "detached" None
+    (Git.Repository.current_branch repo);
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"second" in
+  Git.Repository.advance_head repo c2;
+  Alcotest.(check (option string))
+    "still detached" None
+    (Git.Repository.current_branch repo);
+  Alcotest.(check (option hash))
+    "HEAD updated" (Some c2) (Git.Repository.head repo)
+
+(* Repository ancestry tests *)
+
+let test_repo_ancestor_same_commit () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  Alcotest.(check bool)
+    "same commit" true
+    (Git.Repository.is_ancestor repo ~ancestor:c1 ~descendant:c1)
+
+let test_repo_ancestor_direct_parent () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  Alcotest.(check bool)
+    "parent is ancestor" true
+    (Git.Repository.is_ancestor repo ~ancestor:c1 ~descendant:c2);
+  Alcotest.(check bool)
+    "child not ancestor" false
+    (Git.Repository.is_ancestor repo ~ancestor:c2 ~descendant:c1)
+
+let test_repo_is_ancestor_distant () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c4 ] ~message:"c5" in
+  let c6 = commit ~repo ~tree ~parents:[ c5 ] ~message:"c6" in
+  let c7 = commit ~repo ~tree ~parents:[ c6 ] ~message:"c7" in
+  let c8 = commit ~repo ~tree ~parents:[ c7 ] ~message:"c8" in
+  let c9 = commit ~repo ~tree ~parents:[ c8 ] ~message:"c9" in
+  let c10 = commit ~repo ~tree ~parents:[ c9 ] ~message:"c10" in
+  Alcotest.(check bool)
+    "c1 ancestor of c10" true
+    (Git.Repository.is_ancestor repo ~ancestor:c1 ~descendant:c10);
+  Alcotest.(check bool)
+    "c3 ancestor of c10" true
+    (Git.Repository.is_ancestor repo ~ancestor:c3 ~descendant:c10);
+  Alcotest.(check bool)
+    "c10 not ancestor of c1" false
+    (Git.Repository.is_ancestor repo ~ancestor:c10 ~descendant:c1);
+  Alcotest.(check bool)
+    "c5 ancestor of c7" true
+    (Git.Repository.is_ancestor repo ~ancestor:c5 ~descendant:c7)
+
+let test_repo_is_ancestor_diverged () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c5" in
+  let c6 = commit ~repo ~tree ~parents:[ c5 ] ~message:"c6" in
+  Alcotest.(check bool)
+    "c4 not ancestor of c6" false
+    (Git.Repository.is_ancestor repo ~ancestor:c4 ~descendant:c6);
+  Alcotest.(check bool)
+    "c6 not ancestor of c4" false
+    (Git.Repository.is_ancestor repo ~ancestor:c6 ~descendant:c4);
+  Alcotest.(check bool)
+    "c3 not ancestor of c6" false
+    (Git.Repository.is_ancestor repo ~ancestor:c3 ~descendant:c6);
+  Alcotest.(check bool)
+    "c5 not ancestor of c4" false
+    (Git.Repository.is_ancestor repo ~ancestor:c5 ~descendant:c4);
+  Alcotest.(check bool)
+    "c2 ancestor of c4" true
+    (Git.Repository.is_ancestor repo ~ancestor:c2 ~descendant:c4);
+  Alcotest.(check bool)
+    "c2 ancestor of c6" true
+    (Git.Repository.is_ancestor repo ~ancestor:c2 ~descendant:c6)
+
+let test_repo_ancestor_after_merge () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c3; c4 ] ~message:"c5-merge" in
+  Alcotest.(check bool)
+    "c3 ancestor of c5" true
+    (Git.Repository.is_ancestor repo ~ancestor:c3 ~descendant:c5);
+  Alcotest.(check bool)
+    "c4 ancestor of c5" true
+    (Git.Repository.is_ancestor repo ~ancestor:c4 ~descendant:c5);
+  Alcotest.(check bool)
+    "c2 ancestor of c5" true
+    (Git.Repository.is_ancestor repo ~ancestor:c2 ~descendant:c5);
+  Alcotest.(check bool)
+    "c1 ancestor of c5" true
+    (Git.Repository.is_ancestor repo ~ancestor:c1 ~descendant:c5);
+  Alcotest.(check bool)
+    "c5 not ancestor of c3" false
+    (Git.Repository.is_ancestor repo ~ancestor:c5 ~descendant:c3)
+
+let test_repo_count_commits_zero () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  Alcotest.(check int)
+    "same commit" 0
+    (Git.Repository.count_commits_between repo ~base:c1 ~head:c1)
+
+let test_repo_count_commits_adjacent () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  Alcotest.(check int)
+    "adjacent" 1
+    (Git.Repository.count_commits_between repo ~base:c1 ~head:c2)
+
+let test_repo_count_commits_linear () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c4 ] ~message:"c5" in
+  Alcotest.(check int)
+    "c1..c5 = 4" 4
+    (Git.Repository.count_commits_between repo ~base:c1 ~head:c5);
+  Alcotest.(check int)
+    "c2..c5 = 3" 3
+    (Git.Repository.count_commits_between repo ~base:c2 ~head:c5);
+  Alcotest.(check int)
+    "c3..c5 = 2" 2
+    (Git.Repository.count_commits_between repo ~base:c3 ~head:c5);
+  Alcotest.(check int)
+    "c4..c5 = 1" 1
+    (Git.Repository.count_commits_between repo ~base:c4 ~head:c5)
+
+let test_repo_count_commits_merged () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c3; c4 ] ~message:"c5-merge" in
+  let c6 = commit ~repo ~tree ~parents:[ c5 ] ~message:"c6" in
+  Alcotest.(check int)
+    "c2..c6 through merge" 4
+    (Git.Repository.count_commits_between repo ~base:c2 ~head:c6);
+  Alcotest.(check int)
+    "c3..c6" 3
+    (Git.Repository.count_commits_between repo ~base:c3 ~head:c6)
+
+let test_repo_merge_base_same () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  Alcotest.(check (option hash))
+    "same commit" (Some c1)
+    (Git.Repository.merge_base repo c1 c1)
+
+let test_repo_merge_base_linear () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  Alcotest.(check (option hash))
+    "c1 and c4" (Some c1)
+    (Git.Repository.merge_base repo c1 c4);
+  Alcotest.(check (option hash))
+    "c2 and c4" (Some c2)
+    (Git.Repository.merge_base repo c2 c4);
+  Alcotest.(check (option hash))
+    "c4 and c2 (reversed)" (Some c2)
+    (Git.Repository.merge_base repo c4 c2)
+
+let test_repo_merge_base_diamond () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c5" in
+  let c6 = commit ~repo ~tree ~parents:[ c4 ] ~message:"c6" in
+  Alcotest.(check (option hash))
+    "c5 and c6" (Some c2)
+    (Git.Repository.merge_base repo c5 c6);
+  Alcotest.(check (option hash))
+    "c3 and c4" (Some c2)
+    (Git.Repository.merge_base repo c3 c4);
+  Alcotest.(check (option hash))
+    "c3 and c6" (Some c2)
+    (Git.Repository.merge_base repo c3 c6)
+
+let test_repo_mergebase_deep_divergence () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c4 ] ~message:"c5" in
+  let c6 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c6" in
+  let c7 = commit ~repo ~tree ~parents:[ c6 ] ~message:"c7" in
+  let c8 = commit ~repo ~tree ~parents:[ c7 ] ~message:"c8" in
+  let c9 = commit ~repo ~tree ~parents:[ c8 ] ~message:"c9" in
+  let c10 = commit ~repo ~tree ~parents:[ c9 ] ~message:"c10" in
+  Alcotest.(check (option hash))
+    "c5 and c10" (Some c2)
+    (Git.Repository.merge_base repo c5 c10);
+  Alcotest.(check (option hash))
+    "c10 and c5 (reversed)" (Some c2)
+    (Git.Repository.merge_base repo c10 c5)
+
+let test_repo_mergebase_after_merge () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c3; c4 ] ~message:"c5-merge" in
+  let c6 = commit ~repo ~tree ~parents:[ c5 ] ~message:"c6" in
+  Alcotest.(check (option hash))
+    "c6 and c4" (Some c4)
+    (Git.Repository.merge_base repo c6 c4);
+  Alcotest.(check (option hash))
+    "c6 and c3" (Some c3)
+    (Git.Repository.merge_base repo c6 c3)
+
+let test_repo_mergebase_criss_cross () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c5" in
+  let c6 = commit ~repo ~tree ~parents:[ c4; c5 ] ~message:"c6-merge" in
+  let c7 = commit ~repo ~tree ~parents:[ c6; c5 ] ~message:"c7-merge" in
+  Alcotest.(check (option hash))
+    "c4 and c5" (Some c1)
+    (Git.Repository.merge_base repo c4 c5);
+  Alcotest.(check (option hash))
+    "c6 and c5" (Some c5)
+    (Git.Repository.merge_base repo c6 c5);
+  Alcotest.(check (option hash))
+    "c7 and c4" (Some c4)
+    (Git.Repository.merge_base repo c7 c4)
+
+let test_repo_mergebase_no_common () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let a1 = commit ~repo ~tree ~parents:[] ~message:"a1" in
+  let a2 = commit ~repo ~tree ~parents:[ a1 ] ~message:"a2" in
+  let b1 = commit ~repo ~tree ~parents:[] ~message:"b1" in
+  let b2 = commit ~repo ~tree ~parents:[ b1 ] ~message:"b2" in
+  Alcotest.(check (option hash))
+    "no common ancestor" None
+    (Git.Repository.merge_base repo a2 b2)
+
+(* set_push_url tests *)
+
+let test_set_push_url_basic () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  (match
+     Git.Repository.add_remote repo ~name:"origin"
+       ~url:"[e-mail]:user/repo.git" ()
+   with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match
+     Git.Repository.set_push_url repo ~name:"origin"
+       ~url:"[e-mail]:user/repo-push.git"
+   with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check (option string))
+    "push URL set" (Some "[e-mail]:user/repo-push.git")
+    (Git.Repository.push_url repo "origin")
+
+let test_set_push_url_update () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  (match
+     Git.Repository.add_remote repo ~name:"origin"
+       ~url:"[e-mail]:user/repo.git"
+       ~push_url:"[e-mail]:user/old-push.git" ()
+   with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match
+     Git.Repository.set_push_url repo ~name:"origin"
+       ~url:"[e-mail]:user/new-push.git"
+   with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check (option string))
+    "push URL updated" (Some "[e-mail]:user/new-push.git")
+    (Git.Repository.push_url repo "origin")
+
+let test_set_pushurl_no_remote () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  match
+    Git.Repository.set_push_url repo ~name:"nonexistent"
+      ~url:"[e-mail]:user/repo.git"
+  with
+  | Ok () -> Alcotest.fail "should have failed"
+  | Error (`Msg _) -> ()
+
+let test_set_pushurl_preserves_config () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  (match
+     Git.Repository.add_remote repo ~name:"origin"
+       ~url:"[e-mail]:user/repo.git" ()
+   with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match
+     Git.Repository.set_push_url repo ~name:"origin"
+       ~url:"[e-mail]:user/push.git"
+   with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check (option string))
+    "fetch URL unchanged" (Some "[e-mail]:user/repo.git")
+    (Git.Repository.remote_url repo "origin")
+
+(* rename_branch tests *)
+
+let test_rename_branch_basic () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  (match Git.Repository.rename_branch repo ~new_name:"new-branch" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check (option hash))
+    "new branch has commit" (Some c1)
+    (Git.Repository.read_ref repo "refs/heads/new-branch");
+  Alcotest.(check (option hash))
+    "old branch deleted" None
+    (Git.Repository.read_ref repo "refs/heads/main");
+  Alcotest.(check (option string))
+    "current branch" (Some "new-branch")
+    (Git.Repository.current_branch repo)
+
+let test_rename_branch_detached () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path
+    (Git.Hash.to_hex c1 ^ "\n");
+  match Git.Repository.rename_branch repo ~new_name:"new-branch" with
+  | Ok () -> Alcotest.fail "should have failed in detached HEAD"
+  | Error (`Msg msg) ->
+      Alcotest.(check bool)
+        "error mentions detached" true
+        (String.length msg > 0)
+
+let test_rename_branch_preserves_history () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  Git.Repository.write_ref repo "refs/heads/feature" c3;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path
+    "ref: refs/heads/feature\n";
+  (match Git.Repository.rename_branch repo ~new_name:"renamed-feature" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  let log = Git.Repository.log repo c3 in
+  Alcotest.(check int) "3 commits in history" 3 (List.length log)
+
+let test_rename_branch_multiple () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  (match Git.Repository.rename_branch repo ~new_name:"branch-a" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match Git.Repository.rename_branch repo ~new_name:"branch-b" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match Git.Repository.rename_branch repo ~new_name:"branch-c" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check (option string))
+    "current branch" (Some "branch-c")
+    (Git.Repository.current_branch repo);
+  Alcotest.(check (option hash))
+    "branch-c has commit" (Some c1)
+    (Git.Repository.read_ref repo "refs/heads/branch-c");
+  Alcotest.(check (option hash))
+    "branch-a deleted" None
+    (Git.Repository.read_ref repo "refs/heads/branch-a");
+  Alcotest.(check (option hash))
+    "branch-b deleted" None
+    (Git.Repository.read_ref repo "refs/heads/branch-b")
+
+(* tree_hash_at_path tests *)
+
+let test_treehash_at_path_root () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let blob = Git.Repository.write_blob repo "content" in
+  let tree =
+    Git.Repository.write_tree repo
+      (Git.Tree.v [ { name = "file.txt"; perm = `Normal; hash = blob } ])
+  in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option hash))
+    "root tree" (Some tree)
+    (Git.Repository.tree_hash_at_path repo ~rev:"main" ~path:"")
+
+let test_treehash_at_path_subdir () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let blob = Git.Repository.write_blob repo "content" in
+  let sub_tree =
+    Git.Repository.write_tree repo
+      (Git.Tree.v [ { name = "file.txt"; perm = `Normal; hash = blob } ])
+  in
+  let root_tree =
+    Git.Repository.write_tree repo
+      (Git.Tree.v [ { name = "subdir"; perm = `Dir; hash = sub_tree } ])
+  in
+  let c1 = commit ~repo ~tree:root_tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option hash))
+    "subdir tree" (Some sub_tree)
+    (Git.Repository.tree_hash_at_path repo ~rev:"main" ~path:"subdir")
+
+let test_treehash_at_path_missing () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option hash))
+    "not found" None
+    (Git.Repository.tree_hash_at_path repo ~rev:"main" ~path:"nonexistent")
+
+(* subtree_last_upstream_commit tests *)
+
+let test_subtree_last_upstream_squash () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let author = Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:0L () in
+  (* Create a commit with subtree squash message *)
+  let msg = "Squashed 'my-package/' changes from abc123..def456" in
+  let commit = Git.Commit.v ~tree ~author ~committer:author (Some msg) in
+  let c1 = Git.Repository.write_commit repo commit in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option string))
+    "finds upstream commit" (Some "def456")
+    (Git.Repository.subtree_last_upstream_commit repo ~prefix:"my-package")
+
+let test_subtree_last_upstream_add () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let author = Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:0L () in
+  (* Create a commit with subtree add message *)
+  let msg = "Add 'lib/' from commit abc1234567890" in
+  let commit = Git.Commit.v ~tree ~author ~committer:author (Some msg) in
+  let c1 = Git.Repository.write_commit repo commit in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option string))
+    "finds upstream commit" (Some "abc1234567890")
+    (Git.Repository.subtree_last_upstream_commit repo ~prefix:"lib")
+
+let test_subtree_last_upstream_missing () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"Regular commit" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check (option string))
+    "not found" None
+    (Git.Repository.subtree_last_upstream_commit repo ~prefix:"nonexistent")
+
+(* has_subtree_history tests *)
+
+let test_has_subtree_history_true () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let author = Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:0L () in
+  let msg = "Squashed 'pkg/' changes from a..b" in
+  let commit = Git.Commit.v ~tree ~author ~committer:author (Some msg) in
+  let c1 = Git.Repository.write_commit repo commit in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check bool)
+    "has history" true
+    (Git.Repository.has_subtree_history repo ~prefix:"pkg")
+
+let test_has_subtree_history_false () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"Regular commit" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  Alcotest.(check bool)
+    "no history" false
+    (Git.Repository.has_subtree_history repo ~prefix:"nonexistent")
+
+(* add_all tests *)
+
+let test_add_all_new_file () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "test.txt")
+    "hello";
+  unwrap (Git.Repository.add_all repo);
+  let idx = unwrap (Git.Repository.read_index repo) in
+  let entries = Git.Index.entries idx in
+  Alcotest.(check int) "one entry" 1 (List.length entries);
+  Alcotest.(check string) "name" "test.txt" (List.hd entries).name
+
+let test_add_all_nested_dirs () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.mkdir ~perm:0o755 Eio.Path.(work_dir / "src");
+  Eio.Path.mkdir ~perm:0o755 Eio.Path.(work_dir / "src" / "lib");
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "src" / "lib" / "foo.ml")
+    "let x = 1";
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "src" / "main.ml")
+    "let () = ()";
+  unwrap (Git.Repository.add_all repo);
+  let idx = unwrap (Git.Repository.read_index repo) in
+  let entries = Git.Index.entries idx in
+  Alcotest.(check int) "two entries" 2 (List.length entries);
+  let names = List.map (fun (e : Git.Index.entry) -> e.name) entries in
+  Alcotest.(check bool) "has foo.ml" true (List.mem "src/lib/foo.ml" names);
+  Alcotest.(check bool) "has main.ml" true (List.mem "src/main.ml" names)
+
+let test_add_all_removes_deleted () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "content";
+  unwrap (Git.Repository.add_all repo);
+  Eio.Path.unlink Eio.Path.(work_dir / "file.txt");
+  unwrap (Git.Repository.add_all repo);
+  let idx = unwrap (Git.Repository.read_index repo) in
+  Alcotest.(check int) "no entries" 0 (List.length (Git.Index.entries idx))
+
+let test_add_all_updates_modified () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "v1";
+  unwrap (Git.Repository.add_all repo);
+  let hash1 =
+    (List.hd (Git.Index.entries (unwrap (Git.Repository.read_index repo)))).hash
+  in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "v2";
+  unwrap (Git.Repository.add_all repo);
+  let hash2 =
+    (List.hd (Git.Index.entries (unwrap (Git.Repository.read_index repo)))).hash
+  in
+  Alcotest.(check bool) "hash changed" false (Git.Hash.equal hash1 hash2)
+
+let test_addall_ignores_git_dir () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / ".git" / "test")
+    "ignored";
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "normal.txt")
+    "included";
+  unwrap (Git.Repository.add_all repo);
+  let idx = unwrap (Git.Repository.read_index repo) in
+  let entries = Git.Index.entries idx in
+  Alcotest.(check int) "one entry" 1 (List.length entries);
+  Alcotest.(check string) "only normal.txt" "normal.txt" (List.hd entries).name
+
+(* commit tests *)
+
+let setup_config repo =
+  let config =
+    Git.Config.(
+      empty
+      |> set ~section:(section "user") ~key:"name" ~value:"Test User"
+      |> set ~section:(section "user") ~key:"email" ~value:"[e-mail]")
+  in
+  Git.Repository.write_config repo config
+
+let test_commit_basic () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  setup_config repo;
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "content";
+  unwrap (Git.Repository.add_all repo);
+  let commit_hash =
+    unwrap (Git.Repository.commit repo ~message:"Initial commit")
+  in
+  match unwrap (Git.Repository.read repo commit_hash) with
+  | Git.Value.Commit c ->
+      Alcotest.(check (option string))
+        "message" (Some "Initial commit") (Git.Commit.message c);
+      Alcotest.(check string)
+        "author" "Test User"
+        (Git.User.name (Git.Commit.author c))
+  | _ -> Alcotest.fail "expected commit"
+
+let test_commit_updates_head () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  setup_config repo;
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "content";
+  unwrap (Git.Repository.add_all repo);
+  let commit_hash = unwrap (Git.Repository.commit repo ~message:"test") in
+  Alcotest.(check (option hash))
+    "HEAD updated" (Some commit_hash) (Git.Repository.head repo)
+
+let test_commit_no_config () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "content";
+  unwrap (Git.Repository.add_all repo);
+  match Git.Repository.commit repo ~message:"test" with
+  | Error (`Msg msg) ->
+      Alcotest.(check bool) "error mentions config" true (String.length msg > 0)
+  | Ok _ -> Alcotest.fail "expected error"
+
+let test_commit_no_user_name () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let config =
+    Git.Config.(
+      empty |> set ~section:(section "user") ~key:"email" ~value:"[e-mail]")
+  in
+  Git.Repository.write_config repo config;
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "content";
+  unwrap (Git.Repository.add_all repo);
+  match Git.Repository.commit repo ~message:"test" with
+  | Error (`Msg msg) ->
+      Alcotest.(check bool)
+        "error mentions user.name" true
+        (string_contains ~needle:"user.name" msg)
+  | Ok _ -> Alcotest.fail "expected error"
+
+let test_commit_multiple () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  setup_config repo;
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "v1";
+  unwrap (Git.Repository.add_all repo);
+  let hash1 = unwrap (Git.Repository.commit repo ~message:"c1") in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "file.txt")
+    "v2";
+  unwrap (Git.Repository.add_all repo);
+  let hash2 = unwrap (Git.Repository.commit repo ~message:"c2") in
+  match unwrap (Git.Repository.read repo hash2) with
+  | Git.Value.Commit c ->
+      Alcotest.(check (list hash)) "parent" [ hash1 ] (Git.Commit.parents c)
+  | _ -> Alcotest.fail "expected commit"
+
+(* rm tests *)
+
+let test_rm_single_file () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "keep.txt")
+    "keep";
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "delete.txt")
+    "delete";
+  unwrap (Git.Repository.add_all repo);
+  unwrap (Git.Repository.rm repo ~recursive:false "delete.txt");
+  let idx = unwrap (Git.Repository.read_index repo) in
+  let entries = Git.Index.entries idx in
+  Alcotest.(check int) "one entry" 1 (List.length entries);
+  Alcotest.(check string) "keep.txt" "keep.txt" (List.hd entries).name;
+  Alcotest.(check bool)
+    "file deleted" false
+    (Eio.Path.is_file Eio.Path.(work_dir / "delete.txt"))
+
+let test_rm_recursive () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.mkdir ~perm:0o755 Eio.Path.(work_dir / "dir");
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "dir" / "a.txt")
+    "a";
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "dir" / "b.txt")
+    "b";
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "keep.txt")
+    "keep";
+  unwrap (Git.Repository.add_all repo);
+  unwrap (Git.Repository.rm repo ~recursive:true "dir");
+  let idx = unwrap (Git.Repository.read_index repo) in
+  let entries = Git.Index.entries idx in
+  Alcotest.(check int) "one entry" 1 (List.length entries);
+  Alcotest.(check string) "keep.txt" "keep.txt" (List.hd entries).name;
+  Alcotest.(check bool)
+    "dir deleted" false
+    (Eio.Path.is_directory Eio.Path.(work_dir / "dir"))
+
+let test_rm_preserves_others () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let work_dir = Eio.Path.(fs / Fpath.to_string tmp_dir) in
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "foo.txt")
+    "foo";
+  Eio.Path.save ~create:(`Or_truncate 0o644)
+    Eio.Path.(work_dir / "foobar.txt")
+    "foobar";
+  unwrap (Git.Repository.add_all repo);
+  unwrap (Git.Repository.rm repo ~recursive:false "foo.txt");
+  let idx = unwrap (Git.Repository.read_index repo) in
+  let entries = Git.Index.entries idx in
+  Alcotest.(check int) "one entry" 1 (List.length entries);
+  Alcotest.(check string) "foobar.txt" "foobar.txt" (List.hd entries).name
+
+let test_rm_nonexistent () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  unwrap (Git.Repository.rm repo ~recursive:false "nonexistent.txt")
+
+let add_all_tests =
+  [
+    Alcotest.test_case "new_file" `Quick test_add_all_new_file;
+    Alcotest.test_case "nested_dirs" `Quick test_add_all_nested_dirs;
+    Alcotest.test_case "removes_deleted" `Quick test_add_all_removes_deleted;
+    Alcotest.test_case "updates_modified" `Quick test_add_all_updates_modified;
+    Alcotest.test_case "ignores_git_dir" `Quick test_addall_ignores_git_dir;
+  ]
+
+let commit_tests =
+  [
+    Alcotest.test_case "basic" `Quick test_commit_basic;
+    Alcotest.test_case "updates_head" `Quick test_commit_updates_head;
+    Alcotest.test_case "no_config" `Quick test_commit_no_config;
+    Alcotest.test_case "no_user_name" `Quick test_commit_no_user_name;
+    Alcotest.test_case "multiple" `Quick test_commit_multiple;
+  ]
+
+let rm_tests =
+  [
+    Alcotest.test_case "single_file" `Quick test_rm_single_file;
+    Alcotest.test_case "recursive" `Quick test_rm_recursive;
+    Alcotest.test_case "preserves_others" `Quick test_rm_preserves_others;
+    Alcotest.test_case "nonexistent" `Quick test_rm_nonexistent;
+  ]
+
+let tests =
+  [
+    Alcotest.test_case "is_repo" `Quick test_is_repo;
+    Alcotest.test_case "current_branch" `Quick test_current_branch;
+  ]
+
+let log_tests =
+  [
+    Alcotest.test_case "log" `Quick test_log;
+    Alcotest.test_case "log_max_count" `Quick test_log_max_count;
+    Alcotest.test_case "log_range" `Quick test_log_range;
+  ]
+
+let log_filtered_tests =
+  [
+    Alcotest.test_case "since" `Quick test_log_filtered_since;
+    Alcotest.test_case "until" `Quick test_log_filtered_until;
+    Alcotest.test_case "path" `Quick test_log_filtered_path;
+    Alcotest.test_case "combined" `Quick test_log_filtered_combined;
+  ]
+
+let resolve_ref_tests =
+  [
+    Alcotest.test_case "head" `Quick test_resolve_ref_head;
+    Alcotest.test_case "branch" `Quick test_resolve_ref_branch;
+    Alcotest.test_case "remote" `Quick test_resolve_ref_remote;
+    Alcotest.test_case "not_found" `Quick test_resolve_ref_not_found;
+  ]
+
+let log_range_refs_tests =
+  [
+    Alcotest.test_case "basic" `Quick test_log_range_refs_basic;
+    Alcotest.test_case "head" `Quick test_log_range_refs_head;
+    Alcotest.test_case "error" `Quick test_log_range_refs_error;
+  ]
+
+let advance_head_tests =
+  [
+    Alcotest.test_case "updates_branch" `Quick test_advance_head_updates_branch;
+    Alcotest.test_case "detached" `Quick test_advance_head_detached;
+  ]
+
+let ancestry_tests =
+  [
+    Alcotest.test_case "is_ancestor_same_commit" `Quick
+      test_repo_ancestor_same_commit;
+    Alcotest.test_case "is_ancestor_direct_parent" `Quick
+      test_repo_ancestor_direct_parent;
+    Alcotest.test_case "is_ancestor_distant" `Quick
+      test_repo_is_ancestor_distant;
+    Alcotest.test_case "is_ancestor_diverged" `Quick
+      test_repo_is_ancestor_diverged;
+    Alcotest.test_case "is_ancestor_after_merge" `Quick
+      test_repo_ancestor_after_merge;
+    Alcotest.test_case "count_commits_zero" `Quick test_repo_count_commits_zero;
+    Alcotest.test_case "count_commits_adjacent" `Quick
+      test_repo_count_commits_adjacent;
+    Alcotest.test_case "count_commits_linear" `Quick
+      test_repo_count_commits_linear;
+    Alcotest.test_case "count_commits_with_merge" `Quick
+      test_repo_count_commits_merged;
+    Alcotest.test_case "merge_base_same" `Quick test_repo_merge_base_same;
+    Alcotest.test_case "merge_base_linear" `Quick test_repo_merge_base_linear;
+    Alcotest.test_case "merge_base_diamond" `Quick test_repo_merge_base_diamond;
+    Alcotest.test_case "merge_base_deep_divergence" `Quick
+      test_repo_mergebase_deep_divergence;
+    Alcotest.test_case "merge_base_after_merge" `Quick
+      test_repo_mergebase_after_merge;
+    Alcotest.test_case "merge_base_criss_cross" `Quick
+      test_repo_mergebase_criss_cross;
+    Alcotest.test_case "merge_base_no_common" `Quick
+      test_repo_mergebase_no_common;
+  ]
+
+let set_push_url_tests =
+  [
+    Alcotest.test_case "basic" `Quick test_set_push_url_basic;
+    Alcotest.test_case "update" `Quick test_set_push_url_update;
+    Alcotest.test_case "no_remote" `Quick test_set_pushurl_no_remote;
+    Alcotest.test_case "preserves_config" `Quick
+      test_set_pushurl_preserves_config;
+  ]
+
+let rename_branch_tests =
+  [
+    Alcotest.test_case "basic" `Quick test_rename_branch_basic;
+    Alcotest.test_case "detached" `Quick test_rename_branch_detached;
+    Alcotest.test_case "preserves_history" `Quick
+      test_rename_branch_preserves_history;
+    Alcotest.test_case "multiple" `Quick test_rename_branch_multiple;
+  ]
+
+let tree_hash_at_path_tests =
+  [
+    Alcotest.test_case "root" `Quick test_treehash_at_path_root;
+    Alcotest.test_case "subdir" `Quick test_treehash_at_path_subdir;
+    Alcotest.test_case "not_found" `Quick test_treehash_at_path_missing;
+  ]
+
+let subtree_history_tests =
+  [
+    Alcotest.test_case "squash" `Quick test_subtree_last_upstream_squash;
+    Alcotest.test_case "add" `Quick test_subtree_last_upstream_add;
+    Alcotest.test_case "not_found" `Quick test_subtree_last_upstream_missing;
+    Alcotest.test_case "has_history_true" `Quick test_has_subtree_history_true;
+    Alcotest.test_case "has_history_false" `Quick test_has_subtree_history_false;
+  ]
+
+let suite =
+  ( "repository",
+    tests @ log_tests @ log_filtered_tests @ resolve_ref_tests
+    @ log_range_refs_tests @ advance_head_tests @ ancestry_tests
+    @ set_push_url_tests @ rename_branch_tests @ tree_hash_at_path_tests
+    @ subtree_history_tests @ add_all_tests @ commit_tests @ rm_tests )

test/test_repository.mli

···
+(** Repository tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_rev_list.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+let with_temp_repo = Test_helpers.with_temp_repo
+let commit = Test_helpers.commit
+
+let test_is_ancestor () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  Alcotest.(check bool)
+    "c1 ancestor of c3" true
+    (Git.Rev_list.is_ancestor repo ~ancestor:c1 ~descendant:c3);
+  Alcotest.(check bool)
+    "c3 not ancestor of c1" false
+    (Git.Rev_list.is_ancestor repo ~ancestor:c3 ~descendant:c1);
+  Alcotest.(check bool)
+    "c2 ancestor of c2" true
+    (Git.Rev_list.is_ancestor repo ~ancestor:c2 ~descendant:c2)
+
+let test_merge_base () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c4" in
+  Alcotest.(check (option hash))
+    "merge-base c3 c4" (Some c2)
+    (Git.Rev_list.merge_base repo c3 c4);
+  Alcotest.(check (option hash))
+    "merge-base c1 c3" (Some c1)
+    (Git.Rev_list.merge_base repo c1 c3)
+
+let test_count_commits_between () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  Alcotest.(check int)
+    "c1..c4 = 3" 3
+    (Git.Rev_list.count_commits_between repo ~base:c1 ~head:c4);
+  Alcotest.(check int)
+    "c2..c4 = 2" 2
+    (Git.Rev_list.count_commits_between repo ~base:c2 ~head:c4);
+  Alcotest.(check int)
+    "c1..c1 = 0" 0
+    (Git.Rev_list.count_commits_between repo ~base:c1 ~head:c1)
+
+let test_ahead_behind () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"c1" in
+  let c2 = commit ~repo ~tree ~parents:[ c1 ] ~message:"c2" in
+  let c3 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c3" in
+  let c4 = commit ~repo ~tree ~parents:[ c3 ] ~message:"c4" in
+  let c5 = commit ~repo ~tree ~parents:[ c2 ] ~message:"c5" in
+  let c6 = commit ~repo ~tree ~parents:[ c5 ] ~message:"c6" in
+  let c7 = commit ~repo ~tree ~parents:[ c6 ] ~message:"c7" in
+  let ab = Git.Rev_list.ahead_behind repo ~local:c4 ~remote:c7 in
+  Alcotest.(check int) "ahead" 2 ab.ahead;
+  Alcotest.(check int) "behind" 3 ab.behind
+
+let suite =
+  ( "rev_list",
+    [
+      Alcotest.test_case "is_ancestor" `Quick test_is_ancestor;
+      Alcotest.test_case "merge_base" `Quick test_merge_base;
+      Alcotest.test_case "count_commits_between" `Quick
+        test_count_commits_between;
+      Alcotest.test_case "ahead_behind" `Quick test_ahead_behind;
+    ] )

test/test_rev_list.mli

···
+(** Rev_list tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_subtree.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+let with_temp_repo = Test_helpers.with_temp_repo
+
+let test_add () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:1700000000L ()
+  in
+  let remote_blob = Git.Repository.write_blob repo "Remote file content" in
+  let remote_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"remote.txt" remote_blob ]
+  in
+  let remote_tree_hash = Git.Repository.write_tree repo remote_tree in
+  let remote_commit =
+    Git.Commit.v ~tree:remote_tree_hash ~author ~committer:author
+      (Some "Remote commit")
+  in
+  let remote_commit_hash = Git.Repository.write_commit repo remote_commit in
+  let main_blob = Git.Repository.write_blob repo "Main file content" in
+  let main_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"main.txt" main_blob ]
+  in
+  let main_tree_hash = Git.Repository.write_tree repo main_tree in
+  let main_commit =
+    Git.Commit.v ~tree:main_tree_hash ~author ~committer:author
+      (Some "Main commit")
+  in
+  let main_commit_hash = Git.Repository.write_commit repo main_commit in
+  Git.Repository.write_ref repo "HEAD" main_commit_hash;
+  match
+    Git.Subtree.add repo ~prefix:"external" ~commit:remote_commit_hash ~author
+      ~committer:author ()
+  with
+  | Error (`Msg e) -> Alcotest.fail ("subtree add failed: " ^ e)
+  | Ok merge_hash -> (
+      match Git.Repository.read repo merge_hash with
+      | Error (`Msg e) -> Alcotest.fail e
+      | Ok (Git.Value.Commit merge_commit) -> (
+          let parents = Git.Commit.parents merge_commit in
+          Alcotest.(check int) "two parents" 2 (List.length parents);
+          Alcotest.(check hash)
+            "first parent is main" main_commit_hash (List.hd parents);
+          Alcotest.(check hash)
+            "second parent is remote" remote_commit_hash (List.nth parents 1);
+          let merge_tree_hash = Git.Commit.tree merge_commit in
+          match Git.Repository.read repo merge_tree_hash with
+          | Error (`Msg e) -> Alcotest.fail e
+          | Ok (Git.Value.Tree merge_tree) -> (
+              Alcotest.(check bool)
+                "has main.txt" true
+                (Option.is_some (Git.Tree.find ~name:"main.txt" merge_tree));
+              match Git.Tree.find ~name:"external" merge_tree with
+              | None -> Alcotest.fail "missing external dir"
+              | Some ext_entry -> (
+                  Alcotest.(check bool)
+                    "external is dir" true (ext_entry.perm = `Dir);
+                  match Git.Repository.read repo ext_entry.hash with
+                  | Error (`Msg e) -> Alcotest.fail e
+                  | Ok (Git.Value.Tree ext_tree) ->
+                      Alcotest.(check bool)
+                        "has remote.txt" true
+                        (Option.is_some
+                           (Git.Tree.find ~name:"remote.txt" ext_tree))
+                  | _ -> Alcotest.fail "expected tree"))
+          | _ -> Alcotest.fail "expected tree")
+      | _ -> Alcotest.fail "expected commit")
+
+let test_add_nested_prefix () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:1700000000L ()
+  in
+  let remote_blob = Git.Repository.write_blob repo "Nested content" in
+  let remote_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"nested.txt" remote_blob ]
+  in
+  let remote_tree_hash = Git.Repository.write_tree repo remote_tree in
+  let remote_commit =
+    Git.Commit.v ~tree:remote_tree_hash ~author ~committer:author
+      (Some "Remote")
+  in
+  let remote_commit_hash = Git.Repository.write_commit repo remote_commit in
+  let main_blob = Git.Repository.write_blob repo "Main" in
+  let main_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"main.txt" main_blob ]
+  in
+  let main_tree_hash = Git.Repository.write_tree repo main_tree in
+  let main_commit =
+    Git.Commit.v ~tree:main_tree_hash ~author ~committer:author (Some "Main")
+  in
+  let main_commit_hash = Git.Repository.write_commit repo main_commit in
+  Git.Repository.write_ref repo "HEAD" main_commit_hash;
+  match
+    Git.Subtree.add repo ~prefix:"vendor/libs/external"
+      ~commit:remote_commit_hash ~author ~committer:author ()
+  with
+  | Error (`Msg e) -> Alcotest.fail ("subtree add failed: " ^ e)
+  | Ok merge_hash -> (
+      match Git.Repository.read repo merge_hash with
+      | Error (`Msg e) -> Alcotest.fail e
+      | Ok (Git.Value.Commit merge_commit) -> (
+          let tree_hash = Git.Commit.tree merge_commit in
+          match
+            Git.Subtree.tree_at_prefix repo tree_hash "vendor/libs/external"
+          with
+          | None -> Alcotest.fail "could not find vendor/libs/external"
+          | Some ext_hash -> (
+              match Git.Repository.read repo ext_hash with
+              | Error (`Msg e) -> Alcotest.fail e
+              | Ok (Git.Value.Tree ext_tree) ->
+                  Alcotest.(check bool)
+                    "has nested.txt" true
+                    (Option.is_some (Git.Tree.find ~name:"nested.txt" ext_tree))
+              | _ -> Alcotest.fail "expected tree"))
+      | _ -> Alcotest.fail "expected commit")
+
+let test_add_empty_repo () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:1700000000L ()
+  in
+  let remote_blob = Git.Repository.write_blob repo "Content" in
+  let remote_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"file.txt" remote_blob ]
+  in
+  let remote_tree_hash = Git.Repository.write_tree repo remote_tree in
+  let remote_commit =
+    Git.Commit.v ~tree:remote_tree_hash ~author ~committer:author
+      (Some "Remote")
+  in
+  let remote_commit_hash = Git.Repository.write_commit repo remote_commit in
+  match
+    Git.Subtree.add repo ~prefix:"external" ~commit:remote_commit_hash ~author
+      ~committer:author ()
+  with
+  | Error (`Msg e) -> Alcotest.fail ("subtree add failed: " ^ e)
+  | Ok commit_hash -> (
+      match Git.Repository.read repo commit_hash with
+      | Error (`Msg e) -> Alcotest.fail e
+      | Ok (Git.Value.Commit commit) -> (
+          let parents = Git.Commit.parents commit in
+          Alcotest.(check int) "one parent" 1 (List.length parents);
+          Alcotest.(check hash)
+            "parent is remote" remote_commit_hash (List.hd parents);
+          let tree_hash = Git.Commit.tree commit in
+          match Git.Repository.read repo tree_hash with
+          | Error (`Msg e) -> Alcotest.fail e
+          | Ok (Git.Value.Tree tree) -> (
+              match Git.Tree.find ~name:"external" tree with
+              | None -> Alcotest.fail "missing external dir"
+              | Some ext_entry ->
+                  Alcotest.(check bool)
+                    "external is dir" true (ext_entry.perm = `Dir))
+          | _ -> Alcotest.fail "expected tree")
+      | _ -> Alcotest.fail "expected commit")
+
+let test_merge () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let author =
+    Git.User.v ~name:"Test" ~email:"[e-mail]" ~date:1700000000L ()
+  in
+  let remote_blob1 = Git.Repository.write_blob repo "Version 1" in
+  let remote_tree1 =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"file.txt" remote_blob1 ]
+  in
+  let remote_tree1_hash = Git.Repository.write_tree repo remote_tree1 in
+  let remote_commit1 =
+    Git.Commit.v ~tree:remote_tree1_hash ~author ~committer:author
+      (Some "Remote v1")
+  in
+  let remote_commit1_hash = Git.Repository.write_commit repo remote_commit1 in
+  let main_blob = Git.Repository.write_blob repo "Main" in
+  let main_tree =
+    Git.Tree.v [ Git.Tree.entry ~perm:`Normal ~name:"main.txt" main_blob ]
+  in
+  let main_tree_hash = Git.Repository.write_tree repo main_tree in
+  let main_commit =
+    Git.Commit.v ~tree:main_tree_hash ~author ~committer:author (Some "Main")
+  in
+  let main_commit_hash = Git.Repository.write_commit repo main_commit in
+  Git.Repository.write_ref repo "HEAD" main_commit_hash;
+  (match
+     Git.Subtree.add repo ~prefix:"external" ~commit:remote_commit1_hash ~author
+       ~committer:author ()
+   with
+  | Error (`Msg e) -> Alcotest.fail ("add failed: " ^ e)
+  | Ok _ -> ());
+  let remote_blob2 = Git.Repository.write_blob repo "Version 2 - updated" in
+  let remote_tree2 =
+    Git.Tree.v
+      [
+        Git.Tree.entry ~perm:`Normal ~name:"file.txt" remote_blob2;
+        Git.Tree.entry ~perm:`Normal ~name:"new.txt"
+          (Git.Repository.write_blob repo "New file");
+      ]
+  in
+  let remote_tree2_hash = Git.Repository.write_tree repo remote_tree2 in
+  let remote_commit2 =
+    Git.Commit.v ~tree:remote_tree2_hash ~author ~committer:author
+      ~parents:[ remote_commit1_hash ] (Some "Remote v2")
+  in
+  let remote_commit2_hash = Git.Repository.write_commit repo remote_commit2 in
+  match
+    Git.Subtree.merge repo ~prefix:"external" ~commit:remote_commit2_hash
+      ~author ~committer:author ()
+  with
+  | Error (`Msg e) -> Alcotest.fail ("merge failed: " ^ e)
+  | Ok merge_hash -> (
+      match Git.Repository.read repo merge_hash with
+      | Error (`Msg e) -> Alcotest.fail e
+      | Ok (Git.Value.Commit merge_commit) -> (
+          let parents = Git.Commit.parents merge_commit in
+          Alcotest.(check int) "two parents" 2 (List.length parents);
+          let tree_hash = Git.Commit.tree merge_commit in
+          match Git.Subtree.tree_at_prefix repo tree_hash "external" with
+          | None -> Alcotest.fail "subtree not found"
+          | Some ext_hash -> (
+              match Git.Repository.read repo ext_hash with
+              | Error (`Msg e) -> Alcotest.fail e
+              | Ok (Git.Value.Tree ext_tree) ->
+                  Alcotest.(check bool)
+                    "has file.txt" true
+                    (Option.is_some (Git.Tree.find ~name:"file.txt" ext_tree));
+                  Alcotest.(check bool)
+                    "has new.txt" true
+                    (Option.is_some (Git.Tree.find ~name:"new.txt" ext_tree))
+              | _ -> Alcotest.fail "expected tree"))
+      | _ -> Alcotest.fail "expected commit")
+
+let tests =
+  [
+    Alcotest.test_case "add" `Quick test_add;
+    Alcotest.test_case "add_nested_prefix" `Quick test_add_nested_prefix;
+    Alcotest.test_case "add_empty_repo" `Quick test_add_empty_repo;
+    Alcotest.test_case "merge" `Quick test_merge;
+  ]
+
+let suite = ("subtree", tests)

test/test_subtree.mli

···
+(** Subtree tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_tag.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+
+let test_roundtrip () =
+  let obj_hash = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let tagger =
+    Git.User.v ~name:"Alice" ~email:"[e-mail]" ~date:1234567890L ()
+  in
+  let tag =
+    Git.Tag.v obj_hash Git.Tag.Commit ~tagger ~tag:"v1.0.0"
+      (Some "Release v1.0.0\n")
+  in
+  let s = Git.Tag.to_string tag in
+  match Git.Tag.of_string s with
+  | Ok tag' ->
+      Alcotest.(check hash) "object" obj_hash (Git.Tag.obj tag');
+      Alcotest.(check string) "tag" "v1.0.0" (Git.Tag.name tag');
+      Alcotest.(check (option string))
+        "message" (Some "Release v1.0.0\n") (Git.Tag.message tag')
+  | Error (`Msg m) -> Alcotest.fail m
+
+let tests = [ Alcotest.test_case "roundtrip" `Quick test_roundtrip ]
+let suite = ("tag", tests)

test/test_tag.mli

···
+(** Tag tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_tree.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+
+let test_entry () =
+  let h = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let entry = Git.Tree.entry ~perm:`Normal ~name:"test.txt" h in
+  Alcotest.(check string) "name" "test.txt" entry.name;
+  Alcotest.(check hash) "hash" h entry.hash
+
+let test_roundtrip () =
+  let h1 = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let h2 = Git.Hash.of_hex "0000000000000000000000000000000000000001" in
+  let entries =
+    [
+      Git.Tree.entry ~perm:`Normal ~name:"file.txt" h1;
+      Git.Tree.entry ~perm:`Dir ~name:"subdir" h2;
+    ]
+  in
+  let tree = Git.Tree.v entries in
+  let s = Git.Tree.to_string tree in
+  match Git.Tree.of_string s with
+  | Ok tree' ->
+      let entries' = Git.Tree.to_list tree' in
+      Alcotest.(check int) "entry count" 2 (List.length entries')
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_add_dedup () =
+  let h1 = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let h2 = Git.Hash.of_hex "0000000000000000000000000000000000000002" in
+  let e1 = Git.Tree.entry ~perm:`Normal ~name:"file.txt" h1 in
+  let e2 = Git.Tree.entry ~perm:`Normal ~name:"file.txt" h2 in
+  let tree = Git.Tree.add e1 (Git.Tree.v []) in
+  let tree = Git.Tree.add e2 tree in
+  let entries = Git.Tree.to_list tree in
+  Alcotest.(check int) "no duplicate after add" 1 (List.length entries);
+  Alcotest.(check hash) "entry replaced" h2 (List.hd entries).hash
+
+let tests =
+  [
+    Alcotest.test_case "entry" `Quick test_entry;
+    Alcotest.test_case "roundtrip" `Quick test_roundtrip;
+    Alcotest.test_case "add deduplicates" `Quick test_add_dedup;
+  ]
+
+let suite = ("tree", tests)

test/test_tree.mli

···
+(** Tree tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_user.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let test_roundtrip () =
+  let user =
+    Git.User.v ~name:"Alice" ~email:"[e-mail]" ~date:1234567890L
+      ~tz_offset:{ sign = `Plus; hours = 1; minutes = 0 }
+      ()
+  in
+  let s = Git.User.to_string user in
+  Alcotest.(check string)
+    "format" "Alice <[e-mail]> 1234567890 +0100" s;
+  match Git.User.of_string s with
+  | Ok user' ->
+      Alcotest.(check string) "name" (Git.User.name user) (Git.User.name user');
+      Alcotest.(check string)
+        "email" (Git.User.email user) (Git.User.email user');
+      Alcotest.(check int64) "date" (Git.User.date user) (Git.User.date user')
+  | Error (`Msg m) -> Alcotest.fail m
+
+let tests = [ Alcotest.test_case "roundtrip" `Quick test_roundtrip ]
+let suite = ("user", tests)

test/test_user.mli

···
+(** User tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_value.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+
+let test_roundtrip () =
+  let content = "test content" in
+  let blob = Git.Blob.of_string content in
+  let value = Git.Value.blob blob in
+  let s = Git.Value.to_string value in
+  match Git.Value.of_string_with_header s with
+  | Ok value' -> (
+      match value' with
+      | Git.Value.Blob b ->
+          Alcotest.(check string) "content" content (Git.Blob.to_string b)
+      | _ -> Alcotest.fail "expected blob")
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_bytesrw_roundtrip () =
+  let content = "bytesrw test content" in
+  let blob = Git.Blob.of_string content in
+  let value = Git.Value.blob blob in
+  (* Write to buffer *)
+  let buf = Buffer.create 64 in
+  let writer = Bytesrw.Bytes.Writer.of_buffer buf in
+  Git.Value.write writer value;
+  let written = Buffer.contents buf in
+  (* Read back *)
+  let reader = Bytesrw.Bytes.Reader.of_string written in
+  match Git.Value.read reader with
+  | Ok value' -> (
+      match value' with
+      | Git.Value.Blob b ->
+          Alcotest.(check string) "content" content (Git.Blob.to_string b)
+      | _ -> Alcotest.fail "expected blob")
+  | Error (`Msg m) -> Alcotest.fail m
+
+let test_bytesrw_commit () =
+  let tree_hash = Git.Hash.of_hex "da39a3ee5e6b4b0d3255bfef95601890afd80709" in
+  let author =
+    Git.User.v ~name:"Alice" ~email:"[e-mail]" ~date:1234567890L ()
+  in
+  let commit =
+    Git.Commit.v ~tree:tree_hash ~author ~committer:author
+      (Some "Test commit\n")
+  in
+  let value = Git.Value.commit commit in
+  (* Write to buffer *)
+  let buf = Buffer.create 256 in
+  let writer = Bytesrw.Bytes.Writer.of_buffer buf in
+  Git.Value.write writer value;
+  let written = Buffer.contents buf in
+  (* Read back *)
+  let reader = Bytesrw.Bytes.Reader.of_string written in
+  match Git.Value.read reader with
+  | Ok value' -> (
+      match value' with
+      | Git.Value.Commit c ->
+          Alcotest.(check hash) "tree" tree_hash (Git.Commit.tree c);
+          Alcotest.(check (option string))
+            "message" (Some "Test commit\n") (Git.Commit.message c)
+      | _ -> Alcotest.fail "expected commit")
+  | Error (`Msg m) -> Alcotest.fail m
+
+let tests =
+  [
+    Alcotest.test_case "roundtrip" `Quick test_roundtrip;
+    Alcotest.test_case "bytesrw_roundtrip" `Quick test_bytesrw_roundtrip;
+    Alcotest.test_case "bytesrw_commit" `Quick test_bytesrw_commit;
+  ]
+
+let suite = ("value", tests)

test/test_value.mli

···
+(** Value tests. *)
+
+val suite : string * unit Alcotest.test_case list

test/test_worktree.ml

···
+(* Copyright (c) 2024-2026 Thomas Gazagnaire <[e-mail]>
+
+   Permission to use, copy, modify, and distribute this software for any
+   purpose with or without fee is hereby granted, provided that the above
+   copyright notice and this permission notice appear in all copies.
+
+   THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+   WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+   MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+   ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+   WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+   ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+   OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. *)
+
+let hash = Test_helpers.hash
+let with_temp_repo = Test_helpers.with_temp_repo
+let commit = Test_helpers.commit
+
+let test_list_main () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let worktrees =
+    Git.Worktree.list wt ~head:(Git.Repository.head repo)
+      ~current_branch:(Git.Repository.current_branch repo)
+  in
+  Alcotest.(check int) "one worktree" 1 (List.length worktrees);
+  let main = List.hd worktrees in
+  Alcotest.(check bool) "main path matches" true (Fpath.equal main.path tmp_dir)
+
+let test_add_basic () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  let wt_path = Fpath.(tmp_dir / "worktrees" / "feature1") in
+  (match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"feature1" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check bool)
+    "worktree exists" true
+    (Git.Worktree.exists wt ~path:wt_path);
+  Alcotest.(check (option hash))
+    "branch created" (Some c1)
+    (Git.Repository.read_ref repo "refs/heads/feature1")
+
+let test_exists_false () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let nonexistent = Fpath.(tmp_dir / "nonexistent") in
+  Alcotest.(check bool)
+    "non-existent worktree" false
+    (Git.Worktree.exists wt ~path:nonexistent)
+
+let test_remove () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  let wt_path = Fpath.(tmp_dir / "worktrees" / "feature2") in
+  (match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"feature2" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check bool)
+    "worktree exists before remove" true
+    (Git.Worktree.exists wt ~path:wt_path);
+  (match Git.Worktree.remove wt ~path:wt_path ~force:false with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  Alcotest.(check bool)
+    "worktree gone after remove" false
+    (Git.Worktree.exists wt ~path:wt_path)
+
+let test_remove_main_fails () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  match Git.Worktree.remove wt ~path:tmp_dir ~force:false with
+  | Ok () -> Alcotest.fail "should not be able to remove main worktree"
+  | Error (`Msg _) -> ()
+
+let test_list_multiple () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  let wt1 = Fpath.(tmp_dir / "worktrees" / "wt1") in
+  let wt2 = Fpath.(tmp_dir / "worktrees" / "wt2") in
+  let wt3 = Fpath.(tmp_dir / "worktrees" / "wt3") in
+  (match Git.Worktree.add wt ~head:c1 ~path:wt1 ~branch:"wt1" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match Git.Worktree.add wt ~head:c1 ~path:wt2 ~branch:"wt2" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  (match Git.Worktree.add wt ~head:c1 ~path:wt3 ~branch:"wt3" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  let worktrees =
+    Git.Worktree.list wt ~head:(Git.Repository.head repo)
+      ~current_branch:(Git.Repository.current_branch repo)
+  in
+  Alcotest.(check int) "4 worktrees" 4 (List.length worktrees);
+  Alcotest.(check bool) "wt1 exists" true (Git.Worktree.exists wt ~path:wt1);
+  Alcotest.(check bool) "wt2 exists" true (Git.Worktree.exists wt ~path:wt2);
+  Alcotest.(check bool) "wt3 exists" true (Git.Worktree.exists wt ~path:wt3)
+
+let test_entry_branch () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  Git.Repository.write_ref repo "refs/heads/main" c1;
+  let head_path = Eio.Path.(fs / Fpath.to_string tmp_dir / ".git" / "HEAD") in
+  Eio.Path.save ~create:(`Or_truncate 0o644) head_path "ref: refs/heads/main\n";
+  let wt_path = Fpath.(tmp_dir / "worktrees" / "my-feature") in
+  (match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"my-feature" with
+  | Ok () -> ()
+  | Error (`Msg msg) -> Alcotest.fail msg);
+  let worktrees =
+    Git.Worktree.list wt ~head:(Git.Repository.head repo)
+      ~current_branch:(Git.Repository.current_branch repo)
+  in
+  let wt_entry =
+    List.find_opt
+      (fun (e : Git.Worktree.entry) -> Fpath.equal e.path wt_path)
+      worktrees
+  in
+  match wt_entry with
+  | None -> Alcotest.fail "worktree not found in list"
+  | Some entry ->
+      Alcotest.(check (option string))
+        "branch name" (Some "my-feature") entry.branch
+
+let test_add_needs_head () =
+  with_temp_repo @@ fun fs tmp_dir ->
+  let repo = Git.Repository.init ~fs tmp_dir in
+  let wt = Git.Repository.worktree repo in
+  let tree = Git.Repository.write_tree repo (Git.Tree.v []) in
+  let c1 = commit ~repo ~tree ~parents:[] ~message:"initial" in
+  let wt_path = Fpath.(tmp_dir / "worktrees" / "feature") in
+  match Git.Worktree.add wt ~head:c1 ~path:wt_path ~branch:"feature" with
+  | Ok () -> Alcotest.(check bool) "worktree created" true true
+  | Error (`Msg msg) -> Alcotest.fail msg
+
+let tests =
+  [
+    Alcotest.test_case "list_main" `Quick test_list_main;
+    Alcotest.test_case "add_basic" `Quick test_add_basic;
+    Alcotest.test_case "exists_false" `Quick test_exists_false;
+    Alcotest.test_case "remove" `Quick test_remove;
+    Alcotest.test_case "remove_main_fails" `Quick test_remove_main_fails;
+    Alcotest.test_case "list_multiple" `Quick test_list_multiple;
+    Alcotest.test_case "entry_branch" `Quick test_entry_branch;
+    Alcotest.test_case "add_needs_head" `Quick test_add_needs_head;
+  ]
+
+let suite = ("worktree", tests)

test/test_worktree.mli

···
+(** Worktree tests. *)
+
+val suite : string * unit Alcotest.test_case list