From 47e6ff041e7805d11fe94dabbd32bf6e5faa98f1 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:35:59 +0200 Subject: [PATCH 01/40] Create irmin-lwt package skeleton New package for the Lwt compatibility layer over Irmin 4's direct-style API. This commit sets up the empty skeleton (dune, opam, .ml, .mli) so the package is buildable before the implementation lands in follow-up commits. See issue #2401 phase 3 and comment #4223023836 for the design. Co-Authored-By: Claude Opus 4.6 (1M context) --- irmin-lwt.opam | 34 ++++++++++++++++++++++++++++++++++ src/irmin-lwt/dune | 4 ++++ src/irmin-lwt/irmin_lwt.ml | 3 +++ src/irmin-lwt/irmin_lwt.mli | 7 +++++++ 4 files changed, 48 insertions(+) create mode 100644 irmin-lwt.opam create mode 100644 src/irmin-lwt/dune create mode 100644 src/irmin-lwt/irmin_lwt.ml create mode 100644 src/irmin-lwt/irmin_lwt.mli diff --git a/irmin-lwt.opam b/irmin-lwt.opam new file mode 100644 index 0000000000..a3d0c0cb84 --- /dev/null +++ b/irmin-lwt.opam @@ -0,0 +1,34 @@ +opam-version: "2.0" +maintainer: "thomas@gazagnaire.org" +authors: ["Thomas Gazagnaire" "Thomas Leonard"] +license: "ISC" +homepage: "https://github.com/mirage/irmin" +bug-reports: "https://github.com/mirage/irmin/issues" +dev-repo: "git+https://github.com/mirage/irmin.git" +doc: "https://mirage.github.io/irmin/" + +build: [ + ["dune" "subst"] {dev} + ["dune" "build" "-p" name "-j" jobs] + ["dune" "runtest" "-p" name "-j" jobs] {with-test} +] + +depends: [ + "ocaml" {>= "5.1.0"} + "dune" {>= "3.5.0"} + "irmin" {= version} + "lwt" {>= "5.7.0"} + "lwt_eio" + "eio" {>= "1.0"} + "eio_main" {>= "1.0" & with-test} + "alcotest-lwt" {with-test & >= "1.8.0"} +] + +synopsis: "Lwt compatibility layer for Irmin 4" +description: """ +This package lets Irmin 3 (Lwt-based) consumers continue to use a monadic +Lwt.t API while the backend is Irmin 4 (direct-style Eio). It is a +transitional shim built on top of lwt_eio: new code should use Irmin +directly. +""" +x-maintenance-intent: [ "(latest)" ] diff --git a/src/irmin-lwt/dune b/src/irmin-lwt/dune new file mode 100644 index 0000000000..6ff737b39f --- /dev/null +++ b/src/irmin-lwt/dune @@ -0,0 +1,4 @@ +(library + (name irmin_lwt) + (public_name irmin-lwt) + (libraries irmin lwt lwt_eio)) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml new file mode 100644 index 0000000000..823833c467 --- /dev/null +++ b/src/irmin-lwt/irmin_lwt.ml @@ -0,0 +1,3 @@ +(* Lwt compatibility layer for Irmin 4. + + Empty skeleton — implementation added in subsequent commits. *) diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli new file mode 100644 index 0000000000..7436a637d2 --- /dev/null +++ b/src/irmin-lwt/irmin_lwt.mli @@ -0,0 +1,7 @@ +(** Lwt compatibility layer for Irmin 4. + + This package lets Irmin 3 (Lwt-based) consumers continue to use a monadic + [Lwt.t] API while the backend is Irmin 4 (direct-style Eio). It is a + transitional shim: new code should use [Irmin] directly. + + See [doc/migration-from-irmin-3.md] for a migration walkthrough. *) From fe801f55008823ec06ac7d98c851c91b8383bdb5 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:40:01 +0200 Subject: [PATCH 02/40] irmin-lwt: implement the MVP wrapper over Irmin.Generic_key.S Add the [Make] functor that wraps an Irmin 4 store's I/O-performing operations so they return ['a Lwt.t] values. Each wrapper threads its call through [Lwt_eio.run_eio] to run the direct-style body on the current Eio scheduler. Covered in this first pass: [Repo.v/close/heads/branches/config/export], [main], [of_branch], [of_commit], [empty], the store accessors (find, mem, get, find_tree, get_tree, hash, find_all), the update operations (set, set_exn, set_tree, set_tree_exn, remove, remove_exn), [merge_into] and [last_modified]. Pure accessors ([repo], [tree], [status]) are forwarded as-is without scheduler round-trip. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 76 +++++++++++++++++++++- src/irmin-lwt/irmin_lwt.mli | 122 ++++++++++++++++++++++++++++++++++++ 2 files changed, 197 insertions(+), 1 deletion(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 823833c467..302a8fc8dd 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -1,3 +1,77 @@ (* Lwt compatibility layer for Irmin 4. - Empty skeleton — implementation added in subsequent commits. *) + Every wrapped operation threads its call through [Lwt_eio.run_eio] so + the direct-style Irmin 4 implementation executes on the Eio + scheduler while the caller remains in the Lwt monad. *) + +let run_eio f = Lwt_eio.run_eio f + +module Make (S : Irmin.Generic_key.S) = struct + type repo = S.repo + type t = S.t + type path = S.path + type contents = S.contents + type tree = S.tree + type commit = S.commit + type branch = S.branch + type info = S.info + type hash = S.hash + type write_error = S.write_error + + module Repo = struct + type nonrec t = repo + + let v config = run_eio (fun () -> S.Repo.v config) + let close r = run_eio (fun () -> S.Repo.close r) + let heads r = run_eio (fun () -> S.Repo.heads r) + let branches r = run_eio (fun () -> S.Repo.branches r) + let config r = S.Repo.config r + + let export ?full ?depth ?min ?max r = + run_eio (fun () -> S.Repo.export ?full ?depth ?min ?max r) + end + + let main r = run_eio (fun () -> S.main r) + let of_branch r b = run_eio (fun () -> S.of_branch r b) + let of_commit c = run_eio (fun () -> S.of_commit c) + let empty r = run_eio (fun () -> S.empty r) + + (* Pure accessors — no I/O, no wrapping needed. *) + let repo = S.repo + let tree = S.tree + let status = S.status + let find t p = run_eio (fun () -> S.find t p) + let find_all t p = run_eio (fun () -> S.find_all t p) + let mem t p = run_eio (fun () -> S.mem t p) + let get t p = run_eio (fun () -> S.get t p) + let find_tree t p = run_eio (fun () -> S.find_tree t p) + let get_tree t p = run_eio (fun () -> S.get_tree t p) + let hash t p = run_eio (fun () -> S.hash t p) + + let set ?clear ?retries ?allow_empty ?parents ~info t p v = + run_eio (fun () -> S.set ?clear ?retries ?allow_empty ?parents ~info t p v) + + let set_exn ?clear ?retries ?allow_empty ?parents ~info t p v = + run_eio (fun () -> + S.set_exn ?clear ?retries ?allow_empty ?parents ~info t p v) + + let set_tree ?clear ?retries ?allow_empty ?parents ~info t p tr = + run_eio (fun () -> + S.set_tree ?clear ?retries ?allow_empty ?parents ~info t p tr) + + let set_tree_exn ?clear ?retries ?allow_empty ?parents ~info t p tr = + run_eio (fun () -> + S.set_tree_exn ?clear ?retries ?allow_empty ?parents ~info t p tr) + + let remove ?clear ?retries ?allow_empty ?parents ~info t p = + run_eio (fun () -> S.remove ?clear ?retries ?allow_empty ?parents ~info t p) + + let remove_exn ?clear ?retries ?allow_empty ?parents ~info t p = + run_eio (fun () -> + S.remove_exn ?clear ?retries ?allow_empty ?parents ~info t p) + + let merge_into ~into ~info t = run_eio (fun () -> S.merge_into ~into ~info t) + + let last_modified ?depth ?n t p = + run_eio (fun () -> S.last_modified ?depth ?n t p) +end diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 7436a637d2..49429e1b52 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -5,3 +5,125 @@ transitional shim: new code should use [Irmin] directly. See [doc/migration-from-irmin-3.md] for a migration walkthrough. *) + +module Make (S : Irmin.Generic_key.S) : sig + (** [Make(S)] wraps every I/O-performing operation of [S] so that it returns + an ['a Lwt.t] value. The wrappers thread each call through + [Lwt_eio.run_eio], which runs the direct-style body on the current Eio + scheduler. The caller must therefore be running inside an Eio event loop + with an active [lwt_eio] bridge — see [Irmin_lwt.run] for a convenience + entry point that sets both up. *) + + type repo = S.repo + type t = S.t + type path = S.path + type contents = S.contents + type tree = S.tree + type commit = S.commit + type branch = S.branch + type info = S.info + type hash = S.hash + type write_error = S.write_error + + module Repo : sig + type nonrec t = repo + + val v : Irmin.Backend.Conf.t -> t Lwt.t + val close : t -> unit Lwt.t + val heads : t -> commit list Lwt.t + val branches : t -> branch list Lwt.t + val config : t -> Irmin.Backend.Conf.t + + val export : + ?full:bool -> + ?depth:int -> + ?min:commit list -> + ?max:[ `Head | `Max of commit list ] -> + t -> + S.slice Lwt.t + end + + val main : repo -> t Lwt.t + val of_branch : repo -> branch -> t Lwt.t + val of_commit : commit -> t Lwt.t + val empty : repo -> t Lwt.t + val repo : t -> repo + val tree : t -> tree + val status : t -> [ `Empty | `Branch of branch | `Commit of commit ] + val find : t -> path -> contents option Lwt.t + val find_all : t -> path -> (contents * S.metadata) option Lwt.t + val mem : t -> path -> bool Lwt.t + val get : t -> path -> contents Lwt.t + val find_tree : t -> path -> tree option Lwt.t + val get_tree : t -> path -> tree Lwt.t + val hash : t -> path -> hash option Lwt.t + + val set : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + contents -> + (unit, write_error) result Lwt.t + + val set_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + contents -> + unit Lwt.t + + val set_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + tree -> + (unit, write_error) result Lwt.t + + val set_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + tree -> + unit Lwt.t + + val remove : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + (unit, write_error) result Lwt.t + + val remove_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + unit Lwt.t + + val merge_into : + into:t -> info:S.Info.f -> t -> (unit, Irmin.Merge.conflict) result Lwt.t + + val last_modified : ?depth:int -> ?n:int -> t -> path -> commit list Lwt.t +end From 02f17f6004c2a7dc87efd74fa051ef430e1f9633 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:42:10 +0200 Subject: [PATCH 03/40] irmin-lwt: add Irmin_lwt.run and run_with_env entry points Expose two top-level helpers that set up the Eio/Lwt bridge for client code: - [run f] wraps [Eio_main.run] + [Lwt_eio.with_event_loop] so Irmin 3-style programs can replace their [Lwt_main.run main] with [Irmin_lwt.run main] at the entry point. - [run_with_env env f] is the same but reuses an existing Eio environment, for clients already inside an Eio event loop. This requires [eio_main] as a library dependency (bumped from with-test to a hard dep in the opam file). Co-Authored-By: Claude Opus 4.6 (1M context) --- irmin-lwt.opam | 2 +- src/irmin-lwt/dune | 2 +- src/irmin-lwt/irmin_lwt.ml | 9 +++++++++ src/irmin-lwt/irmin_lwt.mli | 13 +++++++++++++ 4 files changed, 24 insertions(+), 2 deletions(-) diff --git a/irmin-lwt.opam b/irmin-lwt.opam index a3d0c0cb84..be4dd4f398 100644 --- a/irmin-lwt.opam +++ b/irmin-lwt.opam @@ -20,7 +20,7 @@ depends: [ "lwt" {>= "5.7.0"} "lwt_eio" "eio" {>= "1.0"} - "eio_main" {>= "1.0" & with-test} + "eio_main" {>= "1.0"} "alcotest-lwt" {with-test & >= "1.8.0"} ] diff --git a/src/irmin-lwt/dune b/src/irmin-lwt/dune index 6ff737b39f..9eec35666a 100644 --- a/src/irmin-lwt/dune +++ b/src/irmin-lwt/dune @@ -1,4 +1,4 @@ (library (name irmin_lwt) (public_name irmin-lwt) - (libraries irmin lwt lwt_eio)) + (libraries irmin lwt lwt_eio eio_main)) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 302a8fc8dd..9f8cd8e3da 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -6,6 +6,15 @@ let run_eio f = Lwt_eio.run_eio f +let run f = + Eio_main.run @@ fun env -> + Lwt_eio.with_event_loop ~clock:env#clock @@ fun _ -> + Lwt_eio.Promise.await_lwt (f ()) + +let run_with_env env f = + Lwt_eio.with_event_loop ~clock:env#clock @@ fun _ -> + Lwt_eio.Promise.await_lwt (f ()) + module Make (S : Irmin.Generic_key.S) = struct type repo = S.repo type t = S.t diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 49429e1b52..84d539f416 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -6,6 +6,19 @@ See [doc/migration-from-irmin-3.md] for a migration walkthrough. *) +val run : (unit -> 'a Lwt.t) -> 'a +(** [run f] sets up the Eio runtime and the [lwt_eio] bridge, runs [f ()] to + completion, and returns its result. This is the drop-in replacement for + [Lwt_main.run] in Irmin 3 client code. + + Intended for top-level [let () = Irmin_lwt.run main] style usage in Irmin + 3-era programs being migrated to Irmin 4. *) + +val run_with_env : < clock : _ Eio.Time.clock ; .. > -> (unit -> 'a Lwt.t) -> 'a +(** [run_with_env env f] is like {!run} but reuses an existing Eio environment + instead of calling [Eio_main.run] internally. Useful when the client is + already inside an Eio event loop. *) + module Make (S : Irmin.Generic_key.S) : sig (** [Make(S)] wraps every I/O-performing operation of [S] so that it returns an ['a Lwt.t] value. The wrappers thread each call through From 132d0b8174eb9c8952eacf28963eabf9b20b176e Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:44:37 +0200 Subject: [PATCH 04/40] irmin-lwt: add level-1 smoke test Three small tests over the in-memory backend to confirm that the Lwt-wrapped [Repo.v], [main], [set_exn], [remove_exn], [find] and [Repo.close] traverse the [lwt_eio] bridge correctly: - set then find returns the stored value - remove clears a previously set value - find on an unset path returns None The test binary uses [Irmin_lwt.run] to set up Eio and lwt_eio, and alcotest-lwt to schedule the Lwt-returning cases. Co-Authored-By: Claude Opus 4.6 (1M context) --- test/irmin-lwt/dune | 4 ++++ test/irmin-lwt/test.ml | 50 ++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 test/irmin-lwt/dune create mode 100644 test/irmin-lwt/test.ml diff --git a/test/irmin-lwt/dune b/test/irmin-lwt/dune new file mode 100644 index 0000000000..6b05b4dd79 --- /dev/null +++ b/test/irmin-lwt/dune @@ -0,0 +1,4 @@ +(test + (name test) + (package irmin-lwt) + (libraries alcotest alcotest-lwt irmin irmin.mem irmin-lwt)) diff --git a/test/irmin-lwt/test.ml b/test/irmin-lwt/test.ml new file mode 100644 index 0000000000..7433889537 --- /dev/null +++ b/test/irmin-lwt/test.ml @@ -0,0 +1,50 @@ +(* Level-1 smoke test for irmin-lwt: exercise the minimal Repo/Store + lifecycle through the Lwt-wrapped API against the in-memory backend. *) + +module Backend = Irmin_mem.KV.Make (Irmin.Contents.String) +module Store = Irmin_lwt.Make (Backend) + +let info message () = Backend.Info.v ~author:"irmin-lwt-test" ~message 0L +let contents = Alcotest.option Alcotest.string + +let test_set_then_find _switch () = + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* () = Store.set_exn t ~info:(info "set foo") [ "foo" ] "bar" in + let* v = Store.find t [ "foo" ] in + Alcotest.check contents "foo -> bar" (Some "bar") v; + let* () = Store.Repo.close repo in + Lwt.return_unit + +let test_remove _switch () = + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* () = Store.set_exn t ~info:(info "set foo") [ "foo" ] "bar" in + let* () = Store.remove_exn t ~info:(info "remove foo") [ "foo" ] in + let* v = Store.find t [ "foo" ] in + Alcotest.check contents "foo is gone" None v; + let* () = Store.Repo.close repo in + Lwt.return_unit + +let test_missing_path _switch () = + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* v = Store.find t [ "unset" ] in + Alcotest.check contents "missing path" None v; + let* () = Store.Repo.close repo in + Lwt.return_unit + +let () = + Irmin_lwt.run @@ fun () -> + Alcotest_lwt.run "irmin-lwt" + [ + ( "smoke", + [ + Alcotest_lwt.test_case "set then find" `Quick test_set_then_find; + Alcotest_lwt.test_case "remove" `Quick test_remove; + Alcotest_lwt.test_case "missing path" `Quick test_missing_path; + ] ); + ] From be187fddff7369f5ef37e399aaa5714ac9c4d262 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:46:26 +0200 Subject: [PATCH 05/40] irmin-lwt: add level-2 branch/merge workflow test MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A realistic-shaped test that seeds the main branch, forks a feature branch, adds an entry on the feature, merges it back into main, and confirms all three entries are visible along with a non-empty [last_modified] history for the merged path. This exercises [of_branch], [merge_into] and [last_modified] through the Lwt-wrapped API — the idioms typical Irmin 3 consumers (notably Tezos' context) rely on. Co-Authored-By: Claude Opus 4.6 (1M context) --- test/irmin-lwt/test.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/test/irmin-lwt/test.ml b/test/irmin-lwt/test.ml index 7433889537..fe37832e4a 100644 --- a/test/irmin-lwt/test.ml +++ b/test/irmin-lwt/test.ml @@ -37,6 +37,43 @@ let test_missing_path _switch () = let* () = Store.Repo.close repo in Lwt.return_unit +(* Level-2: a realistic workflow test that exercises branching, merging, + and history introspection — the idioms a typical Irmin 3 consumer + (e.g. Tezos' context) relies on — through the Lwt-wrapped API. *) + +let test_branch_merge_workflow _switch () = + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* main = Store.main repo in + (* Seed the main branch. *) + let* () = Store.set_exn main ~info:(info "seed a") [ "a" ] "1" in + let* () = Store.set_exn main ~info:(info "seed b") [ "b" ] "2" in + (* Fork a feature branch from main and add a third entry. *) + let* () = + Store.set_exn main ~info:(info "fork point") [ "feature-flag" ] "yes" + in + let* feature = Store.of_branch repo "feature" in + let* () = Store.set_exn feature ~info:(info "feature: add c") [ "c" ] "3" in + (* Merge the feature branch back into main. *) + let* result = + Store.merge_into ~into:main ~info:(info "merge feature") feature + in + Alcotest.check + (Alcotest.result Alcotest.unit Alcotest.reject) + "merge succeeds" (Ok ()) result; + (* Main should now see all three entries. *) + let* a = Store.find main [ "a" ] in + let* b = Store.find main [ "b" ] in + let* c = Store.find main [ "c" ] in + Alcotest.check contents "a survived" (Some "1") a; + Alcotest.check contents "b survived" (Some "2") b; + Alcotest.check contents "c merged in" (Some "3") c; + (* [last_modified c] should return at least one commit (the one adding c). *) + let* history = Store.last_modified main [ "c" ] in + Alcotest.(check bool) "c has history" true (history <> []); + let* () = Store.Repo.close repo in + Lwt.return_unit + let () = Irmin_lwt.run @@ fun () -> Alcotest_lwt.run "irmin-lwt" @@ -47,4 +84,9 @@ let () = Alcotest_lwt.test_case "remove" `Quick test_remove; Alcotest_lwt.test_case "missing path" `Quick test_missing_path; ] ); + ( "workflow", + [ + Alcotest_lwt.test_case "branch + merge + history" `Quick + test_branch_merge_workflow; + ] ); ] From 26ec444e710388c2da2fd2e7472250778ee5d55e Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:47:32 +0200 Subject: [PATCH 06/40] irmin-lwt: add level-3 Lwt/lwt_eio interaction tests Three tests covering the subtle cases where a wrapper could break real applications by not forwarding Lwt's scheduling semantics correctly: - [Lwt.catch] around a call to [Store.get] on a missing path catches the [Invalid_argument] exception raised by the direct-style Irmin. - [Lwt.pause] between two Irmin ops does not disturb the store state. - 50 concurrent reads dispatched via [Lwt.all] all complete and return the same value, exercising the bridge under Lwt-side concurrency. Co-Authored-By: Claude Opus 4.6 (1M context) --- test/irmin-lwt/test.ml | 63 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) diff --git a/test/irmin-lwt/test.ml b/test/irmin-lwt/test.ml index fe37832e4a..64bd21c2aa 100644 --- a/test/irmin-lwt/test.ml +++ b/test/irmin-lwt/test.ml @@ -74,6 +74,60 @@ let test_branch_merge_workflow _switch () = let* () = Store.Repo.close repo in Lwt.return_unit +(* Level-3: interactions between the Lwt monad and the lwt_eio bridge. + These are the subtle cases that can break real applications if the + wrapper does not forward Lwt's scheduling semantics correctly. *) + +let test_exception_caught_by_lwt _switch () = + (* [Store.get] raises [Invalid_argument] on a missing path. The + exception must propagate as a failed Lwt promise so that [Lwt.catch] + can handle it. *) + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* caught = + Lwt.catch + (fun () -> + let* _ = Store.get t [ "nope" ] in + Lwt.return_false) + (fun _exn -> Lwt.return_true) + in + Alcotest.(check bool) "Lwt.catch caught the exception" true caught; + let* () = Store.Repo.close repo in + Lwt.return_unit + +let test_pause_interleaved _switch () = + (* [Lwt.pause] between two irmin-lwt calls must not break anything: the + scheduler ceding control and resuming should leave the store in the + expected state. *) + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* () = Store.set_exn t ~info:(info "a") [ "x" ] "first" in + let* () = Lwt.pause () in + let* () = Store.set_exn t ~info:(info "b") [ "x" ] "second" in + let* v = Store.find t [ "x" ] in + Alcotest.check contents "last write wins" (Some "second") v; + let* () = Store.Repo.close repo in + Lwt.return_unit + +let test_many_concurrent_reads _switch () = + (* Dispatch several reads in parallel via [Lwt.all] and check they all + complete with the expected value. This exercises the lwt_eio bridge + under concurrent pressure from the Lwt side. *) + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* () = Store.set_exn t ~info:(info "seed") [ "k" ] "v" in + let n = 50 in + let* results = Lwt.all (List.init n (fun _ -> Store.find t [ "k" ])) in + Alcotest.(check int) "all reads completed" n (List.length results); + Alcotest.(check bool) + "all reads returned the same value" true + (List.for_all (( = ) (Some "v")) results); + let* () = Store.Repo.close repo in + Lwt.return_unit + let () = Irmin_lwt.run @@ fun () -> Alcotest_lwt.run "irmin-lwt" @@ -89,4 +143,13 @@ let () = Alcotest_lwt.test_case "branch + merge + history" `Quick test_branch_merge_workflow; ] ); + ( "lwt-interaction", + [ + Alcotest_lwt.test_case "Lwt.catch catches an Irmin exception" `Quick + test_exception_caught_by_lwt; + Alcotest_lwt.test_case "Lwt.pause interleaves with Irmin ops" `Quick + test_pause_interleaved; + Alcotest_lwt.test_case "many concurrent reads via Lwt.all" `Quick + test_many_concurrent_reads; + ] ); ] From 4a4c7e86b34390aee8fa6e391f450f583bdd2b83 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:48:43 +0200 Subject: [PATCH 07/40] doc: add a migration guide from Irmin 3 (Lwt) to Irmin 4 via irmin-lwt Two-step migration path: 1. Move to irmin-lwt with minimal code changes (opam swap, functor wrapping, entry-point change). Existing Lwt idioms keep working. 2. At your own pace, drop irmin-lwt call by call to switch to direct style. The document also lists the Irmin 3 to 4 breaking changes that the compatibility layer cannot hide (OCaml 5.1+, config renames, removed APIs, yield-point semantics) and describes the initial scope of the wrapper (top-level Store ops only for now; submodule wrappers to come). Co-Authored-By: Claude Opus 4.6 (1M context) --- doc/migration-from-irmin-3.md | 175 ++++++++++++++++++++++++++++++++++ 1 file changed, 175 insertions(+) create mode 100644 doc/migration-from-irmin-3.md diff --git a/doc/migration-from-irmin-3.md b/doc/migration-from-irmin-3.md new file mode 100644 index 0000000000..969db33218 --- /dev/null +++ b/doc/migration-from-irmin-3.md @@ -0,0 +1,175 @@ +# Migrating from Irmin 3 (Lwt) to Irmin 4 (Eio) + +Irmin 4 swaps Lwt-based cooperative concurrency for direct-style Eio. The +core API change is straightforward on paper — every function that used +to return `'a Lwt.t` now returns `'a` directly — but rewriting a large +Irmin 3 codebase in one go is expensive. + +The **`irmin-lwt`** package provides a thin compatibility layer that +lets you keep the Irmin 3 Lwt-monadic style while the backend is already +Irmin 4. It is built on top of +[`lwt_eio`](https://github.com/ocaml-multicore/lwt_eio): every wrapped +operation crosses the Lwt/Eio bridge via `Lwt_eio.run_eio`. + +This document describes a two-step migration path: + +1. Move to `irmin-lwt` with minimal code changes. This unblocks Irmin 4 + adoption without rewriting every call site at once. +2. At your own pace, replace `irmin-lwt` calls with direct-style + `Irmin` calls. This can happen module by module. + +## Step 1: switch to `irmin-lwt` + +### Update the opam dependencies + +```diff + depends: [ +- "irmin" {>= "3.0"} +- "irmin-pack" {>= "3.0"} ++ "irmin" {>= "4.0.0"} ++ "irmin-pack" {>= "4.0.0"} ++ "irmin-lwt" {>= "4.0.0"} + "lwt" + ] +``` + +You can still depend on `lwt` directly. `irmin-lwt` is built on top of +it, not a replacement. + +### Instantiate the store through `Irmin_lwt.Make` + +```diff +-module Store = Irmin_pack_unix.KV (Irmin.Contents.String) ++module Store4 = Irmin_pack_unix.KV (Irmin.Contents.String) ++module Store = Irmin_lwt.Make (Store4) +``` + +`Store.t`, `Store.repo`, `Store.tree`, `Store.commit` and so on are all +re-exported unchanged from the underlying backend. The difference is +that `Store.Repo.v`, `Store.find`, `Store.set_exn`, `Store.merge_into`, +etc. now return `_ Lwt.t` instead of direct values. + +### Replace the entry point + +```diff +-let () = Lwt_main.run (main ()) ++let () = Irmin_lwt.run main +``` + +`Irmin_lwt.run` wraps `Eio_main.run` + `Lwt_eio.with_event_loop` + the +call to your `main`. It is the single line of Eio awareness a migrated +program needs at the top. + +If your program is already running inside an Eio event loop (for +example, you are writing a library that receives an `env` from its +caller), use `Irmin_lwt.run_with_env env main` instead. + +### Leave the rest alone + +Every other call site stays the same. `let*`, `>>=`, `Lwt.return`, +`Lwt.catch`, `Lwt.fail`, `Lwt.pick`, `Lwt.async` all work because +`irmin-lwt` returns `'a Lwt.t`. + +### A minimal before/after + +**Irmin 3 (Lwt):** + +```ocaml +open Lwt.Syntax +module Store = Irmin_mem.KV (Irmin.Contents.String) + +let info = Irmin_mem.Info.none + +let main () = + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* () = Store.set_exn t ~info [ "hello" ] "world" in + let* v = Store.find t [ "hello" ] in + Lwt.return (Option.value ~default:"(none)" v) + +let () = + let result = Lwt_main.run (main ()) in + print_endline result +``` + +**Migrated via `irmin-lwt`:** + +```ocaml +open Lwt.Syntax +module Store4 = Irmin_mem.KV.Make (Irmin.Contents.String) +module Store = Irmin_lwt.Make (Store4) + +let info message () = Store4.Info.v ~author:"app" ~message 0L + +let main () = + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.main repo in + let* () = Store.set_exn t ~info:(info "seed") [ "hello" ] "world" in + let* v = Store.find t [ "hello" ] in + Lwt.return (Option.value ~default:"(none)" v) + +let () = + let result = Irmin_lwt.run main in + print_endline result +``` + +The diff is confined to: the opam file, the module instantiation, the +info constructor, and the entry point. The rest of `main` is byte-for- +byte identical. + +## Pitfalls not strictly related to `irmin-lwt` + +These are Irmin 3 → 4 breaking changes that `irmin-lwt` cannot hide, +because they are semantic rather than monadic: + +- **OCaml 5.1+ is required.** Irmin 4 uses effects; older compilers do + not support them. +- **Configuration renames.** Some `Irmin.Backend.Conf` keys were renamed + or dropped between 3.x and 4.x; check your `Irmin_pack.config` or + `Irmin_git.config` call site. +- **Removed APIs.** Functions deprecated in Irmin 3.x were dropped in 4. + Consult `CHANGES.md` for the exact list. +- **Info constructors.** `Irmin.Info.default` replaces the old + `Irmin_unix.Info`. `Store.Info.v ~author ~message timestamp` is the + canonical way to build a commit info. +- **Yield points.** Every `irmin-lwt` call crosses `Lwt_eio.run_eio`, + which is a scheduler yield. If your code assumed no Lwt yield could + happen between a sequence of Irmin calls, there is one now. This is + almost always invisible, but it is worth knowing for subtle + concurrency-sensitive code. + +## Step 2: drop `irmin-lwt` + +When a module is ready to go fully direct-style: + +1. Replace `Store = Irmin_lwt.Make (Store4)` with `Store = Store4` (or + inline the backend directly). +2. Remove the `Lwt.t` types from the local signatures. +3. Rewrite `let*` / `>>=` chains into plain sequencing (`;`) and `let`. +4. Drop `Lwt.return` wrappers. + +Because this is local to a single module, it can be done piecemeal. +Callers that are still `Lwt`-monadic can keep using the module through +a thin local wrapper, or the other way around if the module exports +direct-style only. + +Once no caller needs the Lwt wrapping, you can remove the `irmin-lwt` +dependency and switch the entry point back to `Eio_main.run`. + +## Scope of `irmin-lwt` + +The initial release wraps the top-level `Store` operations (`Repo`, +`main`, `of_branch`, `of_commit`, `find`, `get`, `mem`, `find_tree`, +`get_tree`, the `set`/`set_tree`/`remove` families, `merge_into`, +`last_modified`). It is enough for the most common Irmin 3 client code. + +Submodules like `Tree`, `Commit`, `Branch`, `Head`, `Sync` are **not +wrapped yet**: if your code calls e.g. `Tree.add` in Lwt context, you +will need to wrap the call yourself: + +```ocaml +let tree' = Lwt_eio.run_eio (fun () -> Store4.Tree.add tree path v) +``` + +These submodule wrappers will be added in follow-up releases based on +concrete migration feedback. From a465f28288ccbef88927be1439ae32241e589b0b Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:49:39 +0200 Subject: [PATCH 08/40] CHANGES: announce the irmin-lwt compatibility package in 4.0.0 Co-Authored-By: Claude Opus 4.6 (1M context) --- CHANGES.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index 12ef65e30d..dcee18cb86 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,13 @@ ## 4.0.0 +### Added + +- **irmin-lwt** + - New package providing a thin Lwt compatibility layer over Irmin 4's + direct-style API, so Irmin 3 consumers can migrate progressively. + Built on top of `lwt_eio`. See `doc/migration-from-irmin-3.md` for + the two-step migration path. + ### Changed - Convert to direct-style with Eio (#2149, @patricoferris, @ElectreAAS, @clecat, @art-w) From 62752a2077b8dbcc1f4923332c2374e7406e27d2 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 14:58:57 +0200 Subject: [PATCH 09/40] irmin-lwt: wrap the Tree submodule (non-fold operations) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Expose [Irmin_lwt.Make(S).Tree] mirroring [S.Tree] with Lwt-returning variants of every I/O-triggering operation: [kind], [diff], [mem], [find], [find_all], [find_tree], [get], [get_all], [get_tree], [list], [seq], [length], [add], [add_tree], [update], [update_tree], [remove], [mem_tree], [stats], [to_concrete], [find_key], [of_key], [of_hash]. Pure constructors and inspectors ([empty], [singleton], [of_contents], [of_node], [v], [pruned], [is_empty], [destruct], [hash], [kinded_hash], [key], [shallow], [clear], [of_concrete], [pp]) are forwarded as-is. [Tree.fold] is intentionally not included here because its callbacks have Lwt return types that need bridging via [Lwt_eio.Promise.await_lwt] — that will be added in a follow-up commit. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 60 ++++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 78 +++++++++++++++++++++++++++++++++++++ 2 files changed, 138 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 9f8cd8e3da..0dcfcb16d2 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -83,4 +83,64 @@ module Make (S : Irmin.Generic_key.S) = struct let last_modified ?depth ?n t p = run_eio (fun () -> S.last_modified ?depth ?n t p) + + module Tree = struct + type nonrec t = tree + type metadata = S.metadata + type node = S.node + type step = S.step + type kinded_hash = S.Tree.kinded_hash + type kinded_key = S.Tree.kinded_key + type elt = S.Tree.elt + + (* Pure constructors and inspectors. *) + let empty = S.Tree.empty + let singleton = S.Tree.singleton + let of_contents = S.Tree.of_contents + let of_node = S.Tree.of_node + let v = S.Tree.v + let pruned = S.Tree.pruned + let is_empty = S.Tree.is_empty + let destruct = S.Tree.destruct + let hash = S.Tree.hash + let kinded_hash = S.Tree.kinded_hash + let key = S.Tree.key + let shallow = S.Tree.shallow + let clear = S.Tree.clear + let of_concrete = S.Tree.of_concrete + let pp = S.Tree.pp + + (* I/O-performing ops, wrapped. *) + let kind t p = run_eio (fun () -> S.Tree.kind t p) + let diff x y = run_eio (fun () -> S.Tree.diff x y) + let mem t p = run_eio (fun () -> S.Tree.mem t p) + let find_all t p = run_eio (fun () -> S.Tree.find_all t p) + let length t ?cache p = run_eio (fun () -> S.Tree.length t ?cache p) + let find t p = run_eio (fun () -> S.Tree.find t p) + let get_all t p = run_eio (fun () -> S.Tree.get_all t p) + let get t p = run_eio (fun () -> S.Tree.get t p) + + let list t ?offset ?length ?cache p = + run_eio (fun () -> S.Tree.list t ?offset ?length ?cache p) + + let seq t ?offset ?length ?cache p = + run_eio (fun () -> S.Tree.seq t ?offset ?length ?cache p) + + let add t p ?metadata c = run_eio (fun () -> S.Tree.add t p ?metadata c) + + let update t p ?metadata f = + run_eio (fun () -> S.Tree.update t p ?metadata f) + + let remove t p = run_eio (fun () -> S.Tree.remove t p) + let mem_tree t p = run_eio (fun () -> S.Tree.mem_tree t p) + let find_tree t p = run_eio (fun () -> S.Tree.find_tree t p) + let get_tree t p = run_eio (fun () -> S.Tree.get_tree t p) + let add_tree t p sub = run_eio (fun () -> S.Tree.add_tree t p sub) + let update_tree t p f = run_eio (fun () -> S.Tree.update_tree t p f) + let stats ?force t = run_eio (fun () -> S.Tree.stats ?force t) + let to_concrete t = run_eio (fun () -> S.Tree.to_concrete t) + let find_key r t = run_eio (fun () -> S.Tree.find_key r t) + let of_key r k = run_eio (fun () -> S.Tree.of_key r k) + let of_hash r h = run_eio (fun () -> S.Tree.of_hash r h) + end end diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 84d539f416..23c03caad9 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -139,4 +139,82 @@ module Make (S : Irmin.Generic_key.S) : sig into:t -> info:S.Info.f -> t -> (unit, Irmin.Merge.conflict) result Lwt.t val last_modified : ?depth:int -> ?n:int -> t -> path -> commit list Lwt.t + + (** Lwt-wrapped tree operations. Pure constructors and inspectors (e.g. + {!empty}, {!is_empty}, {!hash}) are forwarded as-is; operations that might + trigger lazy loading from the backend are threaded through + [Lwt_eio.run_eio]. *) + module Tree : sig + type nonrec t = tree + type metadata = S.metadata + type node = S.node + type step = S.step + type kinded_hash = S.Tree.kinded_hash + type kinded_key = S.Tree.kinded_key + type elt = S.Tree.elt + + val empty : unit -> t + val singleton : path -> ?metadata:metadata -> contents -> t + val of_contents : ?metadata:metadata -> contents -> t + val of_node : node -> t + val v : elt -> t + val pruned : kinded_hash -> t + val is_empty : t -> bool + + val destruct : + t -> [ `Node of node | `Contents of S.Tree.Contents.t * metadata ] + + val hash : ?cache:bool -> t -> hash + val kinded_hash : ?cache:bool -> t -> kinded_hash + val key : t -> kinded_key option + val shallow : Repo.t -> kinded_key -> t + val clear : ?depth:int -> t -> unit + val of_concrete : S.Tree.concrete -> t + val pp : t Irmin.Type.pp + val kind : t -> path -> [ `Contents | `Node ] option Lwt.t + val diff : t -> t -> (path * (contents * metadata) Irmin.Diff.t) list Lwt.t + val mem : t -> path -> bool Lwt.t + val find_all : t -> path -> (contents * metadata) option Lwt.t + val length : t -> ?cache:bool -> path -> int Lwt.t + val find : t -> path -> contents option Lwt.t + val get_all : t -> path -> (contents * metadata) Lwt.t + val get : t -> path -> contents Lwt.t + + val list : + t -> + ?offset:int -> + ?length:int -> + ?cache:bool -> + path -> + (step * t) list Lwt.t + + val seq : + t -> + ?offset:int -> + ?length:int -> + ?cache:bool -> + path -> + (step * t) Seq.t Lwt.t + + val add : t -> path -> ?metadata:metadata -> contents -> t Lwt.t + + val update : + t -> + path -> + ?metadata:metadata -> + (contents option -> contents option) -> + t Lwt.t + + val remove : t -> path -> t Lwt.t + val mem_tree : t -> path -> bool Lwt.t + val find_tree : t -> path -> t option Lwt.t + val get_tree : t -> path -> t Lwt.t + val add_tree : t -> path -> t -> t Lwt.t + val update_tree : t -> path -> (t option -> t option) -> t Lwt.t + val stats : ?force:bool -> t -> S.Tree.stats Lwt.t + val to_concrete : t -> S.Tree.concrete Lwt.t + val find_key : Repo.t -> t -> kinded_key option Lwt.t + val of_key : Repo.t -> kinded_key -> t option Lwt.t + val of_hash : Repo.t -> kinded_hash -> t option Lwt.t + end end From f8a97180522513ecf2cf2d57ecb77ddc2caf3d48 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 15:00:28 +0200 Subject: [PATCH 10/40] irmin-lwt: wrap the Commit submodule Expose [Irmin_lwt.Make(S).Commit] mirroring [S.Commit]: the constructor [v] and the lookups [of_key], [of_hash] return Lwt promises. Pure accessors ([tree], [parents], [info], [hash], [key], [pp], [pp_hash]) are forwarded as-is. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 21 +++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 27 +++++++++++++++++++++++++++ 2 files changed, 48 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 0dcfcb16d2..97f1784c0e 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -143,4 +143,25 @@ module Make (S : Irmin.Generic_key.S) = struct let of_key r k = run_eio (fun () -> S.Tree.of_key r k) let of_hash r h = run_eio (fun () -> S.Tree.of_hash r h) end + + module Commit = struct + type nonrec t = commit + type commit_key = S.commit_key + + (* Pure accessors. *) + let tree = S.Commit.tree + let parents = S.Commit.parents + let info = S.Commit.info + let hash = S.Commit.hash + let key = S.Commit.key + let pp = S.Commit.pp + let pp_hash = S.Commit.pp_hash + + (* I/O-performing. *) + let v ?clear r ~info ~parents tree = + run_eio (fun () -> S.Commit.v ?clear r ~info ~parents tree) + + let of_key r k = run_eio (fun () -> S.Commit.of_key r k) + let of_hash r h = run_eio (fun () -> S.Commit.of_hash r h) + end end diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 23c03caad9..27963ffd61 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -217,4 +217,31 @@ module Make (S : Irmin.Generic_key.S) : sig val of_key : Repo.t -> kinded_key -> t option Lwt.t val of_hash : Repo.t -> kinded_hash -> t option Lwt.t end + + (** Lwt-wrapped commit operations. Pure accessors ([tree], [parents], [info], + [hash], [key], [pp]) are forwarded as-is; constructors and lookups that + might load from the backend are wrapped. *) + module Commit : sig + type nonrec t = commit + type commit_key = S.commit_key + + val tree : t -> tree + val parents : t -> commit_key list + val info : t -> info + val hash : t -> hash + val key : t -> commit_key + val pp : t Fmt.t + val pp_hash : t Fmt.t + + val v : + ?clear:bool -> + Repo.t -> + info:info -> + parents:commit_key list -> + tree -> + t Lwt.t + + val of_key : Repo.t -> commit_key -> t option Lwt.t + val of_hash : Repo.t -> hash -> t option Lwt.t + end end From a78b49ad28db8ace411f463abc69041ab5a0d87a Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 15:02:01 +0200 Subject: [PATCH 11/40] irmin-lwt: wrap the Branch and Head submodules, plus top-level watches Cover the branch-level store operations ([Branch.mem], [find], [get], [set], [remove], [list], [watch], [watch_all]), the head-level ones ([Head.list], [find], [get], [set], [fast_forward], [test_and_set], [merge]), and the top-level [watch], [watch_key], [unwatch]. Watch callbacks are in Lwt ([_ -> unit Lwt.t]) as in Irmin 3; the wrapper bridges them to direct-style callbacks by running the returned promise through [Lwt_eio.Promise.await_lwt] so the Irmin 4 watcher can call them synchronously from its own fibre. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 49 +++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 71 +++++++++++++++++++++++++++++++++++++ 2 files changed, 120 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 97f1784c0e..554081f743 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -164,4 +164,53 @@ module Make (S : Irmin.Generic_key.S) = struct let of_key r k = run_eio (fun () -> S.Commit.of_key r k) let of_hash r h = run_eio (fun () -> S.Commit.of_hash r h) end + + module Branch = struct + type nonrec t = branch + + let mem r b = run_eio (fun () -> S.Branch.mem r b) + let find r b = run_eio (fun () -> S.Branch.find r b) + let get r b = run_eio (fun () -> S.Branch.get r b) + let set r b c = run_eio (fun () -> S.Branch.set r b c) + let remove r b = run_eio (fun () -> S.Branch.remove r b) + let list r = run_eio (fun () -> S.Branch.list r) + let pp = S.Branch.pp + + let watch r b ?init lwt_cb = + let cb diff = Lwt_eio.Promise.await_lwt (lwt_cb diff) in + run_eio (fun () -> S.Branch.watch r b ?init cb) + + let watch_all r ?init lwt_cb = + let cb br diff = Lwt_eio.Promise.await_lwt (lwt_cb br diff) in + run_eio (fun () -> S.Branch.watch_all r ?init cb) + end + + module Head = struct + let list r = run_eio (fun () -> S.Head.list r) + let find t = run_eio (fun () -> S.Head.find t) + let get t = run_eio (fun () -> S.Head.get t) + let set t c = run_eio (fun () -> S.Head.set t c) + + let fast_forward t ?max_depth ?n c = + run_eio (fun () -> S.Head.fast_forward t ?max_depth ?n c) + + let test_and_set t ~test ~set = + run_eio (fun () -> S.Head.test_and_set t ~test ~set) + + let merge ~into ~info ?max_depth ?n c = + run_eio (fun () -> S.Head.merge ~into ~info ?max_depth ?n c) + end + + type watch = S.watch + (** Top-level watches. *) + + let watch t ?init lwt_cb = + let cb diff = Lwt_eio.Promise.await_lwt (lwt_cb diff) in + run_eio (fun () -> S.watch t ?init cb) + + let watch_key t path ?init lwt_cb = + let cb diff = Lwt_eio.Promise.await_lwt (lwt_cb diff) in + run_eio (fun () -> S.watch_key t path ?init cb) + + let unwatch w = run_eio (fun () -> S.unwatch w) end diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 27963ffd61..ae89cc0b7c 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -244,4 +244,75 @@ module Make (S : Irmin.Generic_key.S) : sig val of_key : Repo.t -> commit_key -> t option Lwt.t val of_hash : Repo.t -> hash -> t option Lwt.t end + + type watch = S.watch + (** Top-level watch type, used by {!watch}, {!watch_key} and the watch + operations on {!module-Branch}. *) + + (** Lwt-wrapped branch operations. *) + module Branch : sig + type nonrec t = branch + + val mem : Repo.t -> t -> bool Lwt.t + val find : Repo.t -> t -> commit option Lwt.t + val get : Repo.t -> t -> commit Lwt.t + val set : Repo.t -> t -> commit -> unit Lwt.t + val remove : Repo.t -> t -> unit Lwt.t + val list : Repo.t -> t list Lwt.t + val pp : t Fmt.t + + val watch : + Repo.t -> + t -> + ?init:commit -> + (commit Irmin.Diff.t -> unit Lwt.t) -> + watch Lwt.t + + val watch_all : + Repo.t -> + ?init:(t * commit) list -> + (t -> commit Irmin.Diff.t -> unit Lwt.t) -> + watch Lwt.t + end + + (** Lwt-wrapped head operations. *) + module Head : sig + val list : Repo.t -> commit list Lwt.t + val find : t -> commit option Lwt.t + val get : t -> commit Lwt.t + val set : t -> commit -> unit Lwt.t + + val fast_forward : + t -> + ?max_depth:int -> + ?n:int -> + commit -> + ( unit, + [ `No_change | `Rejected | `Max_depth_reached | `Too_many_lcas ] ) + result + Lwt.t + + val test_and_set : + t -> test:commit option -> set:commit option -> bool Lwt.t + + val merge : + into:t -> + info:S.Info.f -> + ?max_depth:int -> + ?n:int -> + commit -> + (unit, Irmin.Merge.conflict) result Lwt.t + end + + val watch : + t -> ?init:commit -> (commit Irmin.Diff.t -> unit Lwt.t) -> watch Lwt.t + + val watch_key : + t -> + path -> + ?init:commit -> + ((commit * tree) Irmin.Diff.t -> unit Lwt.t) -> + watch Lwt.t + + val unwatch : watch -> unit Lwt.t end From 1f25d88766690d0c721baeeb551774aef6a7b877 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 15:03:59 +0200 Subject: [PATCH 12/40] irmin-lwt: add Tree.fold with Lwt-returning callbacks Expose a Lwt-aware [Tree.fold] that accepts [folder_lwt] callbacks of type [path -> 'b -> 'a -> 'a Lwt.t] (and [force] with a Lwt-returning [`False] branch), then bridges each callback to the direct-style [S.Tree.fold] by awaiting its Lwt promise through [Lwt_eio.Promise.await_lwt]. The overall call is then wrapped in [run_eio] so [fold] returns ['a Lwt.t]. Together with the rest of [Tree], this covers the fold-based traversals typical Irmin 3 consumers (e.g. Tezos context) rely on. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 35 +++++++++++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 69 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 554081f743..2e71891a8c 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -142,6 +142,41 @@ module Make (S : Irmin.Generic_key.S) = struct let find_key r t = run_eio (fun () -> S.Tree.find_key r t) let of_key r k = run_eio (fun () -> S.Tree.of_key r k) let of_hash r h = run_eio (fun () -> S.Tree.of_hash r h) + + (* [fold] accepts Lwt-returning folders as Irmin 3 did; each folder is + bridged to direct style via [Lwt_eio.Promise.await_lwt] before being + handed to the underlying Irmin 4 [S.Tree.fold]. *) + type marks = S.Tree.marks + + let empty_marks = S.Tree.empty_marks + + type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + type uniq = [ `False | `True | `Marks of marks ] + type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type depth = S.Tree.depth + + let lift_folder = function + | None -> None + | Some (f : _ folder_lwt) -> + Some (fun path b acc -> Lwt_eio.Promise.await_lwt (f path b acc)) + + let lift_force = function + | None -> None + | Some `True -> Some `True + | Some (`False f) -> + Some (`False (fun path acc -> Lwt_eio.Promise.await_lwt (f path acc))) + + let fold ?order ?force ?cache ?uniq ?pre ?post ?depth ?contents ?node ?tree + t acc = + let force = lift_force force in + let pre = lift_folder pre in + let post = lift_folder post in + let contents = lift_folder contents in + let node = lift_folder node in + let tree = lift_folder tree in + run_eio (fun () -> + S.Tree.fold ?order ?force ?cache ?uniq ?pre ?post ?depth ?contents + ?node ?tree t acc) end module Commit = struct diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index ae89cc0b7c..68e297a21d 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -216,6 +216,40 @@ module Make (S : Irmin.Generic_key.S) : sig val find_key : Repo.t -> t -> kinded_key option Lwt.t val of_key : Repo.t -> kinded_key -> t option Lwt.t val of_hash : Repo.t -> kinded_hash -> t option Lwt.t + + (** {2 Fold} *) + + type marks = S.Tree.marks + + val empty_marks : unit -> marks + + type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + (** Like {!S.Tree.force} but the [`False] callback returns an Lwt promise. + *) + + type uniq = [ `False | `True | `Marks of marks ] + type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type depth = S.Tree.depth + + val fold : + ?order:[ `Sorted | `Undefined | `Random of Random.State.t ] -> + ?force:'a force_lwt -> + ?cache:bool -> + ?uniq:uniq -> + ?pre:('a, step list) folder_lwt -> + ?post:('a, step list) folder_lwt -> + ?depth:depth -> + ?contents:('a, contents) folder_lwt -> + ?node:('a, node) folder_lwt -> + ?tree:('a, t) folder_lwt -> + t -> + 'a -> + 'a Lwt.t + (** [fold] is the Lwt-wrapped counterpart of [S.Tree.fold]. Every callback + ([pre], [post], [contents], [node], [tree], and the [`False] branch of + [force]) is expected to return an [Lwt.t] promise; the wrapper awaits + each promise on the lwt_eio bridge before resuming the underlying + traversal. *) end (** Lwt-wrapped commit operations. Pure accessors ([tree], [parents], [info], From dd3739f6bc879f8c78dd4a52978cab62a99fd4f5 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 15:06:00 +0200 Subject: [PATCH 13/40] irmin-lwt: extend tests to cover Tree / Commit / Branch / Head / fold Four new tests for the newly wrapped submodules: - Tree.add/find round-trip exercises the pure-ish tree ops and the Lwt-wrapped lookups. - Tree.fold with a Lwt-returning [contents] folder confirms the callback bridging via [Lwt_eio.Promise.await_lwt] works end-to-end. - Commit.v + Branch.set/find verifies the commit constructor and branch round-trip through the Lwt layer. - Head.find on a fresh branch checks the empty-then-populated head transition; the test uses a unique branch name since Irmin_mem shares its hashtable across repo handles. Co-Authored-By: Claude Opus 4.6 (1M context) --- test/irmin-lwt/test.ml | 96 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) diff --git a/test/irmin-lwt/test.ml b/test/irmin-lwt/test.ml index 64bd21c2aa..e1e09803e5 100644 --- a/test/irmin-lwt/test.ml +++ b/test/irmin-lwt/test.ml @@ -128,6 +128,89 @@ let test_many_concurrent_reads _switch () = let* () = Store.Repo.close repo in Lwt.return_unit +(* Submodule tests: exercise the Tree, Commit, Branch and Head wrappers + that the MVP did not cover. These are the submodules a typical Irmin 3 + consumer (e.g. Tezos' context) uses heavily. *) + +let test_tree_build_and_read _switch () = + let open Lwt.Syntax in + let empty = Store.Tree.empty () in + let* tree = Store.Tree.add empty [ "a" ] "1" in + let* tree = Store.Tree.add tree [ "b"; "c" ] "2" in + let* v1 = Store.Tree.find tree [ "a" ] in + let* v2 = Store.Tree.find tree [ "b"; "c" ] in + let* missing = Store.Tree.find tree [ "nope" ] in + Alcotest.check contents "tree a" (Some "1") v1; + Alcotest.check contents "tree b/c" (Some "2") v2; + Alcotest.check contents "tree missing" None missing; + Alcotest.(check bool) "non-empty" false (Store.Tree.is_empty tree); + Lwt.return_unit + +let test_tree_fold _switch () = + (* Traverse a small tree with a Lwt-returning contents folder and + collect the encountered contents into a list. *) + let open Lwt.Syntax in + let empty = Store.Tree.empty () in + let* tree = Store.Tree.add empty [ "a" ] "1" in + let* tree = Store.Tree.add tree [ "b" ] "2" in + let* tree = Store.Tree.add tree [ "c" ] "3" in + let collect _path c acc = Lwt.return (c :: acc) in + let* seen = Store.Tree.fold ~contents:collect tree [] in + let sorted = List.sort compare seen in + Alcotest.(check (list string)) + "fold collected all contents" [ "1"; "2"; "3" ] sorted; + Lwt.return_unit + +let hash_to_string h = Irmin.Type.to_string Backend.Hash.t h + +let test_commit_and_branch _switch () = + (* Build a tree, commit it explicitly through [Commit.v], set a branch + to it through [Branch.set], then read it back via [Branch.find]. *) + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let tree = Store.Tree.empty () in + let* tree = Store.Tree.add tree [ "k" ] "v" in + let* c = + Store.Commit.v repo ~info:(info "explicit commit" ()) ~parents:[] tree + in + let* () = Store.Branch.set repo "topic" c in + let* c' = Store.Branch.find repo "topic" in + let* () = + match c' with + | None -> Alcotest.fail "branch lookup returned None" + | Some c' -> + Alcotest.(check string) + "same commit hash" + (hash_to_string (Store.Commit.hash c)) + (hash_to_string (Store.Commit.hash c')); + Lwt.return_unit + in + let* () = Store.Repo.close repo in + Lwt.return_unit + +let test_head_follows_writes _switch () = + (* After a write, [Head.find] should see a commit, and the returned + commit's tree should contain the new entry. Use a unique branch + name so other tests don't pollute the in-memory backend's shared + state. *) + let open Lwt.Syntax in + let* repo = Store.Repo.v (Irmin_mem.config ()) in + let* t = Store.of_branch repo "head-follows-writes" in + let* head0 = Store.Head.find t in + Alcotest.(check bool) "empty head initially" true (Option.is_none head0); + let* () = Store.set_exn t ~info:(info "create head") [ "k" ] "v" in + let* head1 = Store.Head.find t in + let* () = + match head1 with + | None -> Alcotest.fail "expected a head after a write" + | Some c -> + let* v = Store.Tree.find (Store.Commit.tree c) [ "k" ] in + Alcotest.check contents "head tree contains write" (Some "v") v; + Lwt.return_unit + in + let* () = Store.Repo.close repo in + Lwt.return_unit + let () = Irmin_lwt.run @@ fun () -> Alcotest_lwt.run "irmin-lwt" @@ -152,4 +235,17 @@ let () = Alcotest_lwt.test_case "many concurrent reads via Lwt.all" `Quick test_many_concurrent_reads; ] ); + ( "tree", + [ + Alcotest_lwt.test_case "build and read" `Quick + test_tree_build_and_read; + Alcotest_lwt.test_case "fold with Lwt callback" `Quick test_tree_fold; + ] ); + ( "commit-branch-head", + [ + Alcotest_lwt.test_case "commit + branch round-trip" `Quick + test_commit_and_branch; + Alcotest_lwt.test_case "head follows writes" `Quick + test_head_follows_writes; + ] ); ] From c7b32e19b6df4638e2ad4054a3309f04b0480dfa Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 15:06:54 +0200 Subject: [PATCH 14/40] doc: update migration guide for expanded irmin-lwt scope Now that [Tree], [Commit], [Branch], [Head] and the top-level watches are wrapped, rewrite the "Scope" section to reflect the actual coverage. Keep the escape hatch (call [Lwt_eio.run_eio] directly) documented for the few helpers that are still not wrapped (the [Sync] functor, a few rarely-used [Repo] helpers). Co-Authored-By: Claude Opus 4.6 (1M context) --- doc/migration-from-irmin-3.md | 49 +++++++++++++++++++++++++++-------- 1 file changed, 38 insertions(+), 11 deletions(-) diff --git a/doc/migration-from-irmin-3.md b/doc/migration-from-irmin-3.md index 969db33218..d836a19ff2 100644 --- a/doc/migration-from-irmin-3.md +++ b/doc/migration-from-irmin-3.md @@ -158,18 +158,45 @@ dependency and switch the entry point back to `Eio_main.run`. ## Scope of `irmin-lwt` -The initial release wraps the top-level `Store` operations (`Repo`, -`main`, `of_branch`, `of_commit`, `find`, `get`, `mem`, `find_tree`, -`get_tree`, the `set`/`set_tree`/`remove` families, `merge_into`, -`last_modified`). It is enough for the most common Irmin 3 client code. - -Submodules like `Tree`, `Commit`, `Branch`, `Head`, `Sync` are **not -wrapped yet**: if your code calls e.g. `Tree.add` in Lwt context, you -will need to wrap the call yourself: +The current release wraps: + +- Top-level `Store` operations: `Repo.v`/`close`/`heads`/`branches`/ + `config`/`export`, `main`, `of_branch`, `of_commit`, `empty`, `find`, + `find_all`, `mem`, `get`, `find_tree`, `get_tree`, `hash`, the + `set`/`set_tree`/`remove` families, `merge_into`, `last_modified`. +- `Tree` submodule: constructors and pure inspectors (`empty`, + `singleton`, `of_contents`, `of_node`, `v`, `pruned`, `is_empty`, + `destruct`, `hash`, `kinded_hash`, `key`, `shallow`, `clear`, + `of_concrete`, `pp`) are forwarded as-is; I/O-triggering operations + (`kind`, `diff`, `mem`, `find`, `find_all`, `find_tree`, `get`, + `get_all`, `get_tree`, `list`, `seq`, `length`, `add`, `add_tree`, + `update`, `update_tree`, `remove`, `mem_tree`, `stats`, `to_concrete`, + `find_key`, `of_key`, `of_hash`) and `fold` are Lwt-wrapped. `fold` + accepts Lwt-returning folders, same as in Irmin 3. +- `Commit` submodule: `v`, `of_key`, `of_hash` are Lwt-wrapped. Pure + accessors (`tree`, `parents`, `info`, `hash`, `key`, `pp`, + `pp_hash`) are forwarded. +- `Branch` submodule: all operations (`mem`, `find`, `get`, `set`, + `remove`, `list`, `watch`, `watch_all`). Watch callbacks are + Lwt-returning as in Irmin 3. +- `Head` submodule: `list`, `find`, `get`, `set`, `fast_forward`, + `test_and_set`, `merge`. +- Top-level `watch`, `watch_key`, `unwatch`. + +### Not wrapped yet + +- The `Sync` functor (remote git fetch/push/pull). If your code uses + `Irmin.Sync (S)`, call through `Lwt_eio.run_eio` manually for now. +- A few rarely-used helpers on `Repo` (`iter`, `breadth_first_traversal`, + `default_pred_*`). + +If you need something that is not wrapped, you can always drop into +Irmin 4 via `Lwt_eio.run_eio`: ```ocaml -let tree' = Lwt_eio.run_eio (fun () -> Store4.Tree.add tree path v) +let tree' = + Lwt_eio.run_eio (fun () -> Store4.Some_unwrapped_op ... ) ``` -These submodule wrappers will be added in follow-up releases based on -concrete migration feedback. +File an issue with a concrete call site and we will extend the wrapper +accordingly. From 3d70c5835f77c05fd411e5aa608e0cfab94ace0f Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 17:49:02 +0200 Subject: [PATCH 15/40] irmin-lwt: re-export type aliases and type-level submodules Expose the full type surface of [Irmin.Generic_key.S] from [Make(S)]: - Add the missing type aliases: [step], [metadata], [node], [slice], [contents_key], [node_key], [commit_key], [lca_error], [ff_error]. - Re-export the type-level submodules: [Schema], [Info], [Hash], [Path], [Metadata], [Backend], [Contents], [History], [Status] via [module type of] (aliasing functor arguments is forbidden, so we use a structural re-export). This unblocks downstream consumers that need to apply other Irmin functors on top of an [Irmin_lwt.Make(S)] result (e.g. Tezos' [Tezos_context_helpers.Context.Make_tree]). Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 21 +++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 22 ++++++++++++++++++++++ 2 files changed, 43 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 2e71891a8c..1aa8dbb7a2 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -18,15 +18,36 @@ let run_with_env env f = module Make (S : Irmin.Generic_key.S) = struct type repo = S.repo type t = S.t + type step = S.step type path = S.path + type metadata = S.metadata type contents = S.contents + type node = S.node type tree = S.tree type commit = S.commit type branch = S.branch + type slice = S.slice type info = S.info type hash = S.hash + type contents_key = S.contents_key + type node_key = S.node_key + type commit_key = S.commit_key + type lca_error = S.lca_error + type ff_error = S.ff_error type write_error = S.write_error + (* Re-exports of the type-level modules of [S]. These are pure, + forwarded as-is. *) + module Schema = S.Schema + module Info = S.Info + module Hash = S.Hash + module Path = S.Path + module Metadata = S.Metadata + module Backend = S.Backend + module Contents = S.Contents + module History = S.History + module Status = S.Status + module Repo = struct type nonrec t = repo diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 68e297a21d..440b9df850 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -29,15 +29,37 @@ module Make (S : Irmin.Generic_key.S) : sig type repo = S.repo type t = S.t + type step = S.step type path = S.path + type metadata = S.metadata type contents = S.contents + type node = S.node type tree = S.tree type commit = S.commit type branch = S.branch + type slice = S.slice type info = S.info type hash = S.hash + type contents_key = S.contents_key + type node_key = S.node_key + type commit_key = S.commit_key + type lca_error = S.lca_error + type ff_error = S.ff_error type write_error = S.write_error + module Schema : module type of S.Schema + (** Type-level modules of [S], forwarded as-is. They carry no I/O and do not + need Lwt wrapping. *) + + module Info : module type of S.Info + module Hash : module type of S.Hash + module Path : module type of S.Path + module Metadata : module type of S.Metadata + module Backend : module type of S.Backend + module Contents : module type of S.Contents + module History : module type of S.History + module Status : module type of S.Status + module Repo : sig type nonrec t = repo From f5a8934f098d1455902bb893e2b096c4a1d43c5a Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 17:50:06 +0200 Subject: [PATCH 16/40] irmin-lwt: expose master, backend converters, save_contents, save_tree These are the named gaps reported by the Octez compilation test as required but missing from [Irmin_lwt.Make(S)]'s output when applied as the [Store] argument of [Tezos_context_helpers.Context.Make_tree]: - [master]: deprecated Irmin 3 alias of [main], retained for compatibility. Wrapped like [main]. - [of_backend_node], [to_backend_node], [to_backend_portable_node], [to_backend_commit], [of_backend_commit]: pure converters between frontend and backend representations, forwarded as-is. - [save_contents], [save_tree]: persist to the backend store, wrapped with [run_eio]. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 12 ++++++++++++ src/irmin-lwt/irmin_lwt.mli | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 47 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 1aa8dbb7a2..d66e874b11 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -62,6 +62,7 @@ module Make (S : Irmin.Generic_key.S) = struct end let main r = run_eio (fun () -> S.main r) + let master r = run_eio (fun () -> S.main r) let of_branch r b = run_eio (fun () -> S.of_branch r b) let of_commit c = run_eio (fun () -> S.of_commit c) let empty r = run_eio (fun () -> S.empty r) @@ -105,6 +106,17 @@ module Make (S : Irmin.Generic_key.S) = struct let last_modified ?depth ?n t p = run_eio (fun () -> S.last_modified ?depth ?n t p) + (* Backend converters. These are pure. *) + let of_backend_node = S.of_backend_node + let to_backend_node = S.to_backend_node + let to_backend_portable_node = S.to_backend_portable_node + let to_backend_commit = S.to_backend_commit + let of_backend_commit = S.of_backend_commit + + (* Saves. These do I/O. *) + let save_contents c v = run_eio (fun () -> S.save_contents c v) + let save_tree ?clear r c n t = run_eio (fun () -> S.save_tree ?clear r c n t) + module Tree = struct type nonrec t = tree type metadata = S.metadata diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 440b9df850..47bcfbe0f9 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -79,6 +79,11 @@ module Make (S : Irmin.Generic_key.S) : sig end val main : repo -> t Lwt.t + + val master : repo -> t Lwt.t + [@@ocaml.deprecated "Use `main` instead."] + (** Deprecated alias kept for Irmin 3 compatibility. Use {!main}. *) + val of_branch : repo -> branch -> t Lwt.t val of_commit : commit -> t Lwt.t val empty : repo -> t Lwt.t @@ -162,6 +167,36 @@ module Make (S : Irmin.Generic_key.S) : sig val last_modified : ?depth:int -> ?n:int -> t -> path -> commit list Lwt.t + (** {2 Backend converters} + + These translate between frontend and backend representations. They are + pure — no I/O, no scheduler round-trip. *) + + val of_backend_node : repo -> S.Backend.Node.value -> node + val to_backend_node : node -> S.Backend.Node.value + val to_backend_portable_node : node -> S.Backend.Node_portable.t + val to_backend_commit : commit -> S.Backend.Commit.value + + val of_backend_commit : + repo -> S.Backend.Commit.Key.t -> S.Backend.Commit.value -> commit + + (** {2 Saving raw contents and trees} + + Lwt-wrapped because they persist to the backend store. *) + + val save_contents : + [> Irmin.Perms.write ] S.Backend.Contents.t -> + contents -> + contents_key Lwt.t + + val save_tree : + ?clear:bool -> + repo -> + [> Irmin.Perms.write ] S.Backend.Contents.t -> + [> Irmin.Perms.read_write ] S.Backend.Node.t -> + tree -> + [ `Contents of contents_key | `Node of node_key ] Lwt.t + (** Lwt-wrapped tree operations. Pure constructors and inspectors (e.g. {!empty}, {!is_empty}, {!hash}) are forwarded as-is; operations that might trigger lazy loading from the backend are threaded through From 881039e2a5f7cec912d82e1baeba87ee4e4a18ff Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 17:52:28 +0200 Subject: [PATCH 17/40] irmin-lwt: sweep remaining Generic_key.S surface MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Wrap the rest of [Irmin.Generic_key.S]'s I/O-performing operations that were not in the initial MVP, so a [Irmin_lwt.Make(S)] result carries essentially the full Lwt-flavored Store API: - [commit_t] (pure type descriptor, forwarded) - [test_and_set], [test_and_set_exn], [test_and_set_tree], [test_and_set_tree_exn] - [test_set_and_get], [test_set_and_get_exn], [test_set_and_get_tree], [test_set_and_get_tree_exn] - [merge], [merge_exn], [merge_tree], [merge_tree_exn] - [merge_with_branch], [merge_with_commit] - [with_tree], [with_tree_exn] - [clone] - [lcas], [lcas_with_branch], [lcas_with_commit] - [history] All are straightforward [run_eio] wrappers over the direct-style [S] counterparts. This should close the remaining gap #4 flagged by the Octez compilation test — downstream consumers that reused a wide slice of Irmin 3's Store API can now point at [Irmin_lwt.Make(S)] without hitting "value X is required but not provided". Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 93 ++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 208 ++++++++++++++++++++++++++++++++++++ 2 files changed, 301 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index d66e874b11..31d00c0171 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -101,8 +101,101 @@ module Make (S : Irmin.Generic_key.S) = struct run_eio (fun () -> S.remove_exn ?clear ?retries ?allow_empty ?parents ~info t p) + let commit_t = S.commit_t + + let test_and_set ?clear ?retries ?allow_empty ?parents ~info t p ~test ~set = + run_eio (fun () -> + S.test_and_set ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set) + + let test_and_set_exn ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set = + run_eio (fun () -> + S.test_and_set_exn ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set) + + let test_and_set_tree ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set = + run_eio (fun () -> + S.test_and_set_tree ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set) + + let test_and_set_tree_exn ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set = + run_eio (fun () -> + S.test_and_set_tree_exn ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set) + + let test_set_and_get ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set = + run_eio (fun () -> + S.test_set_and_get ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set) + + let test_set_and_get_exn ?clear ?retries ?allow_empty ?parents ~info t p ~test + ~set = + run_eio (fun () -> + S.test_set_and_get_exn ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set) + + let test_set_and_get_tree ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set = + run_eio (fun () -> + S.test_set_and_get_tree ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set) + + let test_set_and_get_tree_exn ?clear ?retries ?allow_empty ?parents ~info t p + ~test ~set = + run_eio (fun () -> + S.test_set_and_get_tree_exn ?clear ?retries ?allow_empty ?parents ~info + t p ~test ~set) + + let merge ?clear ?retries ?allow_empty ?parents ~info ~old t p v = + run_eio (fun () -> + S.merge ?clear ?retries ?allow_empty ?parents ~info ~old t p v) + + let merge_exn ?clear ?retries ?allow_empty ?parents ~info ~old t p v = + run_eio (fun () -> + S.merge_exn ?clear ?retries ?allow_empty ?parents ~info ~old t p v) + + let merge_tree ?clear ?retries ?allow_empty ?parents ~info ~old t p v = + run_eio (fun () -> + S.merge_tree ?clear ?retries ?allow_empty ?parents ~info ~old t p v) + + let merge_tree_exn ?clear ?retries ?allow_empty ?parents ~info ~old t p v = + run_eio (fun () -> + S.merge_tree_exn ?clear ?retries ?allow_empty ?parents ~info ~old t p v) + + let with_tree ?clear ?retries ?allow_empty ?parents ?strategy ~info t p f = + run_eio (fun () -> + S.with_tree ?clear ?retries ?allow_empty ?parents ?strategy ~info t p f) + + let with_tree_exn ?clear ?retries ?allow_empty ?parents ?strategy ~info t p f + = + run_eio (fun () -> + S.with_tree_exn ?clear ?retries ?allow_empty ?parents ?strategy ~info t + p f) + + let clone ~src ~dst = run_eio (fun () -> S.clone ~src ~dst) let merge_into ~into ~info t = run_eio (fun () -> S.merge_into ~into ~info t) + let merge_with_branch t ~info ?max_depth ?n b = + run_eio (fun () -> S.merge_with_branch t ~info ?max_depth ?n b) + + let merge_with_commit t ~info ?max_depth ?n c = + run_eio (fun () -> S.merge_with_commit t ~info ?max_depth ?n c) + + let lcas ?max_depth ?n t1 t2 = run_eio (fun () -> S.lcas ?max_depth ?n t1 t2) + + let lcas_with_branch t ?max_depth ?n b = + run_eio (fun () -> S.lcas_with_branch t ?max_depth ?n b) + + let lcas_with_commit t ?max_depth ?n c = + run_eio (fun () -> S.lcas_with_commit t ?max_depth ?n c) + + let history ?depth ?min ?max t = + run_eio (fun () -> S.history ?depth ?min ?max t) + let last_modified ?depth ?n t p = run_eio (fun () -> S.last_modified ?depth ?n t p) diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 47bcfbe0f9..4bcd33e788 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -162,9 +162,217 @@ module Make (S : Irmin.Generic_key.S) : sig path -> unit Lwt.t + val commit_t : repo -> commit Irmin.Type.t + + val test_and_set : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + (unit, write_error) result Lwt.t + + val test_and_set_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + unit Lwt.t + + val test_and_set_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + (unit, write_error) result Lwt.t + + val test_and_set_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + unit Lwt.t + + val test_set_and_get : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + (commit option, write_error) result Lwt.t + + val test_set_and_get_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + commit option Lwt.t + + val test_set_and_get_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + (commit option, write_error) result Lwt.t + + val test_set_and_get_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + commit option Lwt.t + + val merge : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + old:contents option -> + t -> + path -> + contents option -> + (unit, write_error) result Lwt.t + + val merge_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + old:contents option -> + t -> + path -> + contents option -> + unit Lwt.t + + val merge_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + old:tree option -> + t -> + path -> + tree option -> + (unit, write_error) result Lwt.t + + val merge_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:S.Info.f -> + old:tree option -> + t -> + path -> + tree option -> + unit Lwt.t + + val with_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + ?strategy:[ `Set | `Test_and_set | `Merge ] -> + info:S.Info.f -> + t -> + path -> + (tree option -> tree option) -> + (unit, write_error) result Lwt.t + + val with_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + ?strategy:[ `Set | `Test_and_set | `Merge ] -> + info:S.Info.f -> + t -> + path -> + (tree option -> tree option) -> + unit Lwt.t + + val clone : src:t -> dst:branch -> t Lwt.t + val merge_into : into:t -> info:S.Info.f -> t -> (unit, Irmin.Merge.conflict) result Lwt.t + val merge_with_branch : + t -> + info:S.Info.f -> + ?max_depth:int -> + ?n:int -> + branch -> + (unit, Irmin.Merge.conflict) result Lwt.t + + val merge_with_commit : + t -> + info:S.Info.f -> + ?max_depth:int -> + ?n:int -> + commit -> + (unit, Irmin.Merge.conflict) result Lwt.t + + val lcas : + ?max_depth:int -> ?n:int -> t -> t -> (commit list, lca_error) result Lwt.t + + val lcas_with_branch : + t -> + ?max_depth:int -> + ?n:int -> + branch -> + (commit list, lca_error) result Lwt.t + + val lcas_with_commit : + t -> + ?max_depth:int -> + ?n:int -> + commit -> + (commit list, lca_error) result Lwt.t + + val history : + ?depth:int -> ?min:commit list -> ?max:commit list -> t -> History.t Lwt.t + val last_modified : ?depth:int -> ?n:int -> t -> path -> commit list Lwt.t (** {2 Backend converters} From ccc7415a909d04fda0be648b62cbe2413f5348ce Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 17:59:00 +0200 Subject: [PATCH 18/40] irmin-lwt: add Pack.Make functor for irmin-pack-unix-specific operations Introduce a [Irmin_lwt.Pack.Make] functor that takes an [Irmin_pack_io.S] store and returns a module that includes the full [Make(S)] Lwt-wrapped generic-key API plus the pack-unix extensions: - integrity checks: [integrity_check], [integrity_check_inodes], [traverse_pack_file], [test_traverse_pack_file] - chunking: [split], [is_split_allowed], [add_volume] - on-disk: [reload], [flush], [create_one_commit_store] - [Gc]: [start_exn], [finalise_exn], [run] (with Lwt-returning [finished] callback), [wait], [cancel], [is_finished], [behaviour], [is_allowed], [latest_gc_target] - [Snapshot]: re-export with Lwt-wrapped [export] Adds [irmin-pack.io] as a library dependency and [irmin-pack] as an opam dependency. Addresses gaps 5-10 of the Octez compilation test: consumers that need pack-unix operations (Tezos context GC, snapshot export, etc.) can now apply [Irmin_lwt.Pack.Make] on their pack-unix store instead of reaching into [Irmin_pack_io] directly via [Lwt_eio.run_eio]. Co-Authored-By: Claude Opus 4.6 (1M context) --- irmin-lwt.opam | 13 ++--- src/irmin-lwt/dune | 2 +- src/irmin-lwt/irmin_lwt.ml | 68 ++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 96 +++++++++++++++++++++++++++++++++++++ 4 files changed, 172 insertions(+), 7 deletions(-) diff --git a/irmin-lwt.opam b/irmin-lwt.opam index be4dd4f398..4c19a1b299 100644 --- a/irmin-lwt.opam +++ b/irmin-lwt.opam @@ -14,13 +14,14 @@ build: [ ] depends: [ - "ocaml" {>= "5.1.0"} - "dune" {>= "3.5.0"} - "irmin" {= version} - "lwt" {>= "5.7.0"} + "ocaml" {>= "5.1.0"} + "dune" {>= "3.5.0"} + "irmin" {= version} + "irmin-pack" {= version} + "lwt" {>= "5.7.0"} "lwt_eio" - "eio" {>= "1.0"} - "eio_main" {>= "1.0"} + "eio" {>= "1.0"} + "eio_main" {>= "1.0"} "alcotest-lwt" {with-test & >= "1.8.0"} ] diff --git a/src/irmin-lwt/dune b/src/irmin-lwt/dune index 9eec35666a..c148091378 100644 --- a/src/irmin-lwt/dune +++ b/src/irmin-lwt/dune @@ -1,4 +1,4 @@ (library (name irmin_lwt) (public_name irmin-lwt) - (libraries irmin lwt lwt_eio eio_main)) + (libraries irmin irmin-pack.io lwt lwt_eio eio_main)) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 31d00c0171..274213a315 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -375,3 +375,71 @@ module Make (S : Irmin.Generic_key.S) = struct let unwatch w = run_eio (fun () -> S.unwatch w) end + +(* Lwt wrappers for [irmin-pack-unix]-specific operations. + + [Pack.Make] takes an [Irmin_pack_io.S] (the full pack-unix store + signature) and returns a module that: + - [include]s [Make (S)] — every generic-key Lwt-wrapped operation is + available; + - additionally exposes Lwt-wrapped versions of the pack-unix + extensions: integrity check, GC, snapshots, split/reload/flush, + [create_one_commit_store]. *) +module Pack = struct + module Make (S : Irmin_pack_io.S) = struct + include Make (S) + + let integrity_check ?ppf ?heads ~auto_repair r = + run_eio (fun () -> S.integrity_check ?ppf ?heads ~auto_repair r) + + let integrity_check_inodes ?heads r = + run_eio (fun () -> S.integrity_check_inodes ?heads r) + + let traverse_pack_file kind conf = + run_eio (fun () -> S.traverse_pack_file kind conf) + + let test_traverse_pack_file kind conf = + run_eio (fun () -> S.test_traverse_pack_file kind conf) + + let split r = run_eio (fun () -> S.split r) + let is_split_allowed r = S.is_split_allowed r + let add_volume r = run_eio (fun () -> S.add_volume r) + let reload r = run_eio (fun () -> S.reload r) + let flush r = run_eio (fun () -> S.flush r) + + let create_one_commit_store ~domain_mgr r ck path = + run_eio (fun () -> S.create_one_commit_store ~domain_mgr r ck path) + + module Gc = struct + type process_state = S.Gc.process_state + type msg = S.Gc.msg + + let start_exn ~domain_mgr ?unlink r c = + run_eio (fun () -> S.Gc.start_exn ~domain_mgr ?unlink r c) + + let finalise_exn ?wait r = run_eio (fun () -> S.Gc.finalise_exn ?wait r) + + let run ~domain_mgr ?finished r c = + let finished = + Option.map + (fun lwt_f result -> Lwt_eio.Promise.await_lwt (lwt_f result)) + finished + in + run_eio (fun () -> S.Gc.run ~domain_mgr ?finished r c) + + let wait r = run_eio (fun () -> S.Gc.wait r) + let cancel r = run_eio (fun () -> S.Gc.cancel r) + let is_finished r = S.Gc.is_finished r + let behaviour r = S.Gc.behaviour r + let is_allowed r = S.Gc.is_allowed r + let latest_gc_target r = S.Gc.latest_gc_target r + end + + module Snapshot = struct + include S.Snapshot + + let export ?on_disk r f ~root_key = + run_eio (fun () -> S.Snapshot.export ?on_disk r f ~root_key) + end + end +end diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 4bcd33e788..932ebf05fa 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -615,3 +615,99 @@ module Make (S : Irmin.Generic_key.S) : sig val unwatch : watch -> unit Lwt.t end + +(** Lwt wrappers for [irmin-pack-unix]-specific operations. + + [Pack.Make] takes an [Irmin_pack_io.S] (the full pack-unix store signature) + and returns a module that includes the result of the generic [Make] functor + plus Lwt-wrapped versions of the pack-unix extensions: integrity check, GC, + snapshots, split/reload/flush, [create_one_commit_store]. *) +module Pack : sig + module Make (S : Irmin_pack_io.S) : sig + include module type of Make (S) + + val integrity_check : + ?ppf:Format.formatter -> + ?heads:commit list -> + auto_repair:bool -> + repo -> + ( [> `Fixed of int | `No_error ], + [> `Cannot_fix of string | `Corrupted of int ] ) + result + Lwt.t + + val integrity_check_inodes : + ?heads:commit list -> + repo -> + ([> `No_error ], [> `Cannot_fix of string ]) result Lwt.t + + val traverse_pack_file : + [ `Reconstruct_index of [ `In_place | `Output of string ] + | `Check_index + | `Check_and_fix_index ] -> + Irmin.config -> + unit Lwt.t + + val test_traverse_pack_file : + [ `Reconstruct_index of [ `In_place | `Output of string ] + | `Check_index + | `Check_and_fix_index ] -> + Irmin.config -> + unit Lwt.t + + val split : repo -> unit Lwt.t + val is_split_allowed : repo -> bool + val add_volume : repo -> unit Lwt.t + val reload : repo -> unit Lwt.t + val flush : repo -> unit Lwt.t + + val create_one_commit_store : + domain_mgr:_ Eio.Domain_manager.t -> + repo -> + commit_key -> + Eio.Fs.dir_ty Eio.Path.t -> + unit Lwt.t + + module Gc : sig + type process_state = S.Gc.process_state + type msg = S.Gc.msg + + val start_exn : + domain_mgr:_ Eio.Domain_manager.t -> + ?unlink:bool -> + repo -> + commit_key -> + bool Lwt.t + + val finalise_exn : ?wait:bool -> repo -> process_state Lwt.t + + val run : + domain_mgr:_ Eio.Domain_manager.t -> + ?finished: + ((Irmin_pack_io.Stats.Latest_gc.stats, msg) result -> unit Lwt.t) -> + repo -> + commit_key -> + (bool, msg) result Lwt.t + + val wait : + repo -> (Irmin_pack_io.Stats.Latest_gc.stats option, msg) result Lwt.t + + val cancel : repo -> bool Lwt.t + val is_finished : repo -> bool + val behaviour : repo -> [ `Archive | `Delete ] + val is_allowed : repo -> bool + val latest_gc_target : repo -> commit_key option + end + + module Snapshot : sig + include module type of S.Snapshot + + val export : + ?on_disk:[ `Path of Eio.Fs.dir_ty Eio.Path.t ] -> + repo -> + (t -> unit) -> + root_key:Tree.kinded_key -> + int Lwt.t + end + end +end From 62a2e180fe466e721b27ceda82b7210203c58492 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 18:25:57 +0200 Subject: [PATCH 19/40] irmin-lwt: preserve type equalities in type-level submodule re-exports The shorter [module X : module type of S.X] idiom produces a fresh signature with abstract types: from a consumer's point of view, [Backend.Contents.t] was not definitionally equal to [S.Backend.Contents.t]. That equality is needed when a downstream functor (e.g. Tezos' [Tezos_context_helpers.Context.Make_tree]) receives values whose types reference both the frontend [Backend.Contents.t] and the original [S.Backend.Contents.t]. Switching to [module X : module type of struct include S.X end] captures the signature through a structural inclusion and preserves the type equalities. Applied to all nine type-level re-exports (Schema, Info, Hash, Path, Metadata, Backend, Contents, History, Status). Reported by the Octez compilation test as "Backend.Contents.t vs S.Backend.Contents.t" type mismatch. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.mli | 54 +++++++++++++++++++++++++++++-------- 1 file changed, 43 insertions(+), 11 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 932ebf05fa..bf5132b79f 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -47,18 +47,50 @@ module Make (S : Irmin.Generic_key.S) : sig type ff_error = S.ff_error type write_error = S.write_error - module Schema : module type of S.Schema (** Type-level modules of [S], forwarded as-is. They carry no I/O and do not - need Lwt wrapping. *) - - module Info : module type of S.Info - module Hash : module type of S.Hash - module Path : module type of S.Path - module Metadata : module type of S.Metadata - module Backend : module type of S.Backend - module Contents : module type of S.Contents - module History : module type of S.History - module Status : module type of S.Status + need Lwt wrapping. + + The [module type of struct include S.X end] idiom is used instead of the + shorter [module type of S.X] because the latter produces fresh abstract + types: [Backend.Contents.t] would not be definitionally equal to + [S.Backend.Contents.t], which breaks downstream functors (e.g. Tezos' + [Tezos_context_helpers.Context.Make_tree]) that receive values of both + types. *) + module Schema : module type of struct + include S.Schema + end + + module Info : module type of struct + include S.Info + end + + module Hash : module type of struct + include S.Hash + end + + module Path : module type of struct + include S.Path + end + + module Metadata : module type of struct + include S.Metadata + end + + module Backend : module type of struct + include S.Backend + end + + module Contents : module type of struct + include S.Contents + end + + module History : module type of struct + include S.History + end + + module Status : module type of struct + include S.Status + end module Repo : sig type nonrec t = repo From b7d80421f32cca3a232e42b8065814369df15cc1 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 18:27:14 +0200 Subject: [PATCH 20/40] irmin-lwt: expose the 16 Irmin.Type.t descriptors Each type in [Irmin.Generic_key.S] that is annotated [@@deriving irmin] produces a corresponding [_t : _ Irmin.Type.t] value that downstream code uses for encoding, hashing, pretty-printing, etc. Forward them all: [step_t], [path_t], [metadata_t], [contents_t], [node_t], [tree_t], [hash_t], [branch_t], [slice_t], [info_t], [lca_error_t], [ff_error_t], [contents_key_t], [node_key_t], [commit_key_t], [write_error_t]. They are pure, forwarded without [run_eio]. Reported missing by the Octez compilation test. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 17 +++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 20 ++++++++++++++++++++ 2 files changed, 37 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 274213a315..0b75f4fff6 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -101,6 +101,23 @@ module Make (S : Irmin.Generic_key.S) = struct run_eio (fun () -> S.remove_exn ?clear ?retries ?allow_empty ?parents ~info t p) + (* Irmin.Type.t descriptors derived by [@@deriving irmin] on [S]. *) + let step_t = S.step_t + let path_t = S.path_t + let metadata_t = S.metadata_t + let contents_t = S.contents_t + let node_t = S.node_t + let tree_t = S.tree_t + let hash_t = S.hash_t + let branch_t = S.branch_t + let slice_t = S.slice_t + let info_t = S.info_t + let lca_error_t = S.lca_error_t + let ff_error_t = S.ff_error_t + let contents_key_t = S.contents_key_t + let node_key_t = S.node_key_t + let commit_key_t = S.commit_key_t + let write_error_t = S.write_error_t let commit_t = S.commit_t let test_and_set ?clear ?retries ?allow_empty ?parents ~info t p ~test ~set = diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index bf5132b79f..c4698f8918 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -194,6 +194,26 @@ module Make (S : Irmin.Generic_key.S) : sig path -> unit Lwt.t + (** {2 [Irmin.Type.t] descriptors} + + Forwarded from [S] — pure, no I/O. *) + + val step_t : step Irmin.Type.t + val path_t : path Irmin.Type.t + val metadata_t : metadata Irmin.Type.t + val contents_t : contents Irmin.Type.t + val node_t : node Irmin.Type.t + val tree_t : tree Irmin.Type.t + val hash_t : hash Irmin.Type.t + val branch_t : branch Irmin.Type.t + val slice_t : slice Irmin.Type.t + val info_t : info Irmin.Type.t + val lca_error_t : lca_error Irmin.Type.t + val ff_error_t : ff_error Irmin.Type.t + val contents_key_t : contents_key Irmin.Type.t + val node_key_t : node_key Irmin.Type.t + val commit_key_t : commit_key Irmin.Type.t + val write_error_t : write_error Irmin.Type.t val commit_t : repo -> commit Irmin.Type.t val test_and_set : From d7c20dad4d266e2e8690356a9176516a863c710d Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 18:28:14 +0200 Subject: [PATCH 21/40] irmin-lwt: add kind, list, mem_tree, get_all, key and type kinded_key These store-level accessors are present in [Irmin.Generic_key.S] but were missed by the initial sweep. All perform I/O (lazy loading from the backend is possible), so they are wrapped with [run_eio]. Also exposes [type kinded_key = [ `Contents of contents_key | `Node of node_key ]] as a named type so downstream consumers can reference it (previously inlined in [save_tree]). Reported missing by the Octez compilation test. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 6 ++++++ src/irmin-lwt/irmin_lwt.mli | 13 +++++++++++-- 2 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 0b75f4fff6..e1af08c837 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -35,6 +35,7 @@ module Make (S : Irmin.Generic_key.S) = struct type lca_error = S.lca_error type ff_error = S.ff_error type write_error = S.write_error + type kinded_key = [ `Contents of contents_key | `Node of node_key ] (* Re-exports of the type-level modules of [S]. These are pure, forwarded as-is. *) @@ -74,10 +75,15 @@ module Make (S : Irmin.Generic_key.S) = struct let find t p = run_eio (fun () -> S.find t p) let find_all t p = run_eio (fun () -> S.find_all t p) let mem t p = run_eio (fun () -> S.mem t p) + let mem_tree t p = run_eio (fun () -> S.mem_tree t p) let get t p = run_eio (fun () -> S.get t p) + let get_all t p = run_eio (fun () -> S.get_all t p) let find_tree t p = run_eio (fun () -> S.find_tree t p) let get_tree t p = run_eio (fun () -> S.get_tree t p) let hash t p = run_eio (fun () -> S.hash t p) + let kind t p = run_eio (fun () -> S.kind t p) + let list t p = run_eio (fun () -> S.list t p) + let key t p = run_eio (fun () -> S.key t p) let set ?clear ?retries ?allow_empty ?parents ~info t p v = run_eio (fun () -> S.set ?clear ?retries ?allow_empty ?parents ~info t p v) diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index c4698f8918..dd7154f0cf 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -122,13 +122,22 @@ module Make (S : Irmin.Generic_key.S) : sig val repo : t -> repo val tree : t -> tree val status : t -> [ `Empty | `Branch of branch | `Commit of commit ] + + type kinded_key = [ `Contents of contents_key | `Node of node_key ] + (** The type of keys as returned by {!val-key} and {!save_tree}. *) + val find : t -> path -> contents option Lwt.t - val find_all : t -> path -> (contents * S.metadata) option Lwt.t + val find_all : t -> path -> (contents * metadata) option Lwt.t val mem : t -> path -> bool Lwt.t + val mem_tree : t -> path -> bool Lwt.t val get : t -> path -> contents Lwt.t + val get_all : t -> path -> (contents * metadata) Lwt.t val find_tree : t -> path -> tree option Lwt.t val get_tree : t -> path -> tree Lwt.t val hash : t -> path -> hash option Lwt.t + val kind : t -> path -> [ `Contents | `Node ] option Lwt.t + val list : t -> path -> (step * tree) list Lwt.t + val key : t -> path -> kinded_key option Lwt.t val set : ?clear:bool -> @@ -455,7 +464,7 @@ module Make (S : Irmin.Generic_key.S) : sig [> Irmin.Perms.write ] S.Backend.Contents.t -> [> Irmin.Perms.read_write ] S.Backend.Node.t -> tree -> - [ `Contents of contents_key | `Node of node_key ] Lwt.t + kinded_key Lwt.t (** Lwt-wrapped tree operations. Pure constructors and inspectors (e.g. {!empty}, {!is_empty}, {!hash}) are forwarded as-is; operations that might From 98c04fd99cff4f769263aebdf58cded99fdacdea Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 18:31:49 +0200 Subject: [PATCH 22/40] irmin-lwt: add type 'a merge, fix merge_into arity, and extend Irmin.remote Three related completions of [Irmin.Generic_key.S] surface: - Expose [type 'a merge] as the Lwt-wrapped abbreviation used by [merge_into], [merge_with_branch] and [merge_with_commit]. Downstream consumers may reference the alias directly. - Fix [merge_into]: the previous signature was missing the [?max_depth] and [?n] optional parameters carried by [t merge]. Now properly [into:t -> t merge]. - Extend the top-level [Irmin.remote] with [E of Backend.Remote.endpoint], matching the extension that the underlying [S] exposes. This allows downstream code that matches on the extensible variant to see the endpoint carried by a remote produced through [Irmin_lwt.Make(S)]. Reported missing by the Octez compilation test. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 16 +++++++++++++++- src/irmin-lwt/irmin_lwt.mli | 17 +++++++++++++++-- 2 files changed, 30 insertions(+), 3 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index e1af08c837..6586114ed9 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -200,7 +200,16 @@ module Make (S : Irmin.Generic_key.S) = struct p f) let clone ~src ~dst = run_eio (fun () -> S.clone ~src ~dst) - let merge_into ~into ~info t = run_eio (fun () -> S.merge_into ~into ~info t) + + type 'a merge = + info:S.Info.f -> + ?max_depth:int -> + ?n:int -> + 'a -> + (unit, Irmin.Merge.conflict) result Lwt.t + + let merge_into ~into ~info ?max_depth ?n t = + run_eio (fun () -> S.merge_into ~into ~info ?max_depth ?n t) let merge_with_branch t ~info ?max_depth ?n b = run_eio (fun () -> S.merge_with_branch t ~info ?max_depth ?n b) @@ -229,6 +238,11 @@ module Make (S : Irmin.Generic_key.S) = struct let to_backend_commit = S.to_backend_commit let of_backend_commit = S.of_backend_commit + (* Extend the top-level [Irmin.remote] the same way [S] does, so the + identifiers in [Irmin_lwt.Make(S).E] and [S.E] refer to remotes carrying + the same [endpoint] type. *) + type Irmin.remote += E of Backend.Remote.endpoint + (* Saves. These do I/O. *) let save_contents c v = run_eio (fun () -> S.save_contents c v) let save_tree ?clear r c n t = run_eio (fun () -> S.save_tree ?clear r c n t) diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index dd7154f0cf..d51ff84d32 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -395,8 +395,21 @@ module Make (S : Irmin.Generic_key.S) : sig val clone : src:t -> dst:branch -> t Lwt.t - val merge_into : - into:t -> info:S.Info.f -> t -> (unit, Irmin.Merge.conflict) result Lwt.t + type 'a merge = + info:S.Info.f -> + ?max_depth:int -> + ?n:int -> + 'a -> + (unit, Irmin.Merge.conflict) result Lwt.t + (** Abbreviation for the Lwt-wrapped merge signature used by {!merge_into}, + {!merge_with_branch} and {!merge_with_commit}. *) + + type Irmin.remote += + | E of Backend.Remote.endpoint + (** Extends the top-level [Irmin.remote] with the endpoint type of + [S]'s backend, matching the extension in [S]. *) + + val merge_into : into:t -> t merge val merge_with_branch : t -> From 2b2130809d135c05ee95435eb2b170af63ffbf9c Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 18:38:15 +0200 Subject: [PATCH 23/40] irmin-lwt: expose the remaining Repo submodule surface Extend [Irmin_lwt.Make(S).Repo] to cover the rest of [S.Repo]: - [type elt] and [elt_t]: the topological element variant (Commit, Node, Contents, Branch) and its [Irmin.Type.t] descriptor. Exposed as a concrete polymorphic variant so callers can pattern-match on it. - [default_pred_commit], [default_pred_node], [default_pred_contents]: pure forwarding (no I/O). - [import]: Lwt-wrapped. - [iter] and [breadth_first_traversal]: Lwt-wrapped; each of the 13 optional callbacks (edge/branch/commit/node/contents/skip_*/pred_*) is accepted as Lwt-returning (matching Irmin 3) and bridged to the direct-style call expected by the underlying Irmin 4 traversal via [Lwt_eio.Promise.await_lwt]. Closes the 8 Repo-level items flagged by the second Octez compilation pass. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 55 ++++++++++++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 56 +++++++++++++++++++++++++++++++++++++ 2 files changed, 111 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 6586114ed9..6a76bd19d3 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -51,7 +51,9 @@ module Make (S : Irmin.Generic_key.S) = struct module Repo = struct type nonrec t = repo + type elt = S.Repo.elt + let elt_t = S.Repo.elt_t let v config = run_eio (fun () -> S.Repo.v config) let close r = run_eio (fun () -> S.Repo.close r) let heads r = run_eio (fun () -> S.Repo.heads r) @@ -60,6 +62,59 @@ module Make (S : Irmin.Generic_key.S) = struct let export ?full ?depth ?min ?max r = run_eio (fun () -> S.Repo.export ?full ?depth ?min ?max r) + + let import t s = run_eio (fun () -> S.Repo.import t s) + + (* Pure: no lazy loading. *) + let default_pred_commit = S.Repo.default_pred_commit + let default_pred_node = S.Repo.default_pred_node + let default_pred_contents = S.Repo.default_pred_contents + + (* Helpers to bridge the Lwt-returning callbacks of [iter] and + [breadth_first_traversal] to the direct-style callbacks that the + underlying Irmin 4 function expects. *) + let lift_cb1 = function + | None -> None + | Some f -> Some (fun x -> Lwt_eio.Promise.await_lwt (f x)) + + let lift_cb2 = function + | None -> None + | Some f -> Some (fun x y -> Lwt_eio.Promise.await_lwt (f x y)) + + let iter ?cache_size ~min ~max ?edge ?branch ?commit ?node ?contents + ?skip_branch ?skip_commit ?skip_node ?skip_contents ?pred_branch + ?pred_commit ?pred_node ?pred_contents ?rev t = + let edge = lift_cb2 edge in + let branch = lift_cb1 branch in + let commit = lift_cb1 commit in + let node = lift_cb1 node in + let contents = lift_cb1 contents in + let skip_branch = lift_cb1 skip_branch in + let skip_commit = lift_cb1 skip_commit in + let skip_node = lift_cb1 skip_node in + let skip_contents = lift_cb1 skip_contents in + let pred_branch = lift_cb2 pred_branch in + let pred_commit = lift_cb2 pred_commit in + let pred_node = lift_cb2 pred_node in + let pred_contents = lift_cb2 pred_contents in + run_eio (fun () -> + S.Repo.iter ?cache_size ~min ~max ?edge ?branch ?commit ?node + ?contents ?skip_branch ?skip_commit ?skip_node ?skip_contents + ?pred_branch ?pred_commit ?pred_node ?pred_contents ?rev t) + + let breadth_first_traversal ?cache_size ~max ?branch ?commit ?node ?contents + ?pred_branch ?pred_commit ?pred_node ?pred_contents t = + let branch = lift_cb1 branch in + let commit = lift_cb1 commit in + let node = lift_cb1 node in + let contents = lift_cb1 contents in + let pred_branch = lift_cb2 pred_branch in + let pred_commit = lift_cb2 pred_commit in + let pred_node = lift_cb2 pred_node in + let pred_contents = lift_cb2 pred_contents in + run_eio (fun () -> + S.Repo.breadth_first_traversal ?cache_size ~max ?branch ?commit ?node + ?contents ?pred_branch ?pred_commit ?pred_node ?pred_contents t) end let main r = run_eio (fun () -> S.main r) diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index d51ff84d32..9f6ae2d1d4 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -95,6 +95,14 @@ module Make (S : Irmin.Generic_key.S) : sig module Repo : sig type nonrec t = repo + type elt = + [ `Commit of commit_key + | `Node of node_key + | `Contents of contents_key + | `Branch of branch ] + (** The type for elements iterated over by {!iter}. *) + + val elt_t : elt Irmin.Type.t val v : Irmin.Backend.Conf.t -> t Lwt.t val close : t -> unit Lwt.t val heads : t -> commit list Lwt.t @@ -108,6 +116,54 @@ module Make (S : Irmin.Generic_key.S) : sig ?max:[ `Head | `Max of commit list ] -> t -> S.slice Lwt.t + + val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t + + (** {2 Default predecessor walks} *) + + val default_pred_commit : t -> commit_key -> elt list + val default_pred_node : t -> node_key -> elt list + val default_pred_contents : t -> contents_key -> elt list + + (** {2 Topological traversals} *) + + val iter : + ?cache_size:int -> + min:elt list -> + max:elt list -> + ?edge:(elt -> elt -> unit Lwt.t) -> + ?branch:(branch -> unit Lwt.t) -> + ?commit:(commit_key -> unit Lwt.t) -> + ?node:(node_key -> unit Lwt.t) -> + ?contents:(contents_key -> unit Lwt.t) -> + ?skip_branch:(branch -> bool Lwt.t) -> + ?skip_commit:(commit_key -> bool Lwt.t) -> + ?skip_node:(node_key -> bool Lwt.t) -> + ?skip_contents:(contents_key -> bool Lwt.t) -> + ?pred_branch:(t -> branch -> elt list Lwt.t) -> + ?pred_commit:(t -> commit_key -> elt list Lwt.t) -> + ?pred_node:(t -> node_key -> elt list Lwt.t) -> + ?pred_contents:(t -> contents_key -> elt list Lwt.t) -> + ?rev:bool -> + t -> + unit Lwt.t + (** Lwt-wrapped counterpart of [S.Repo.iter]. Every callback is bridged to + the direct-style call expected by the underlying traversal through + [Lwt_eio.Promise.await_lwt]. *) + + val breadth_first_traversal : + ?cache_size:int -> + max:elt list -> + ?branch:(branch -> unit Lwt.t) -> + ?commit:(commit_key -> unit Lwt.t) -> + ?node:(node_key -> unit Lwt.t) -> + ?contents:(contents_key -> unit Lwt.t) -> + ?pred_branch:(t -> branch -> elt list Lwt.t) -> + ?pred_commit:(t -> commit_key -> elt list Lwt.t) -> + ?pred_node:(t -> node_key -> elt list Lwt.t) -> + ?pred_contents:(t -> contents_key -> elt list Lwt.t) -> + t -> + unit Lwt.t end val main : repo -> t Lwt.t From 260e64e0f36af7085622befaef3e5a29b50aae44 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Fri, 24 Apr 2026 18:56:58 +0200 Subject: [PATCH 24/40] irmin-lwt: expose Make's output as a named module type S MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Extract the Lwt-flavoured signature produced by [Make] into a top-level [module type S] and have [Make] return a module conforming to it with explicit type and module equalities. This is the architectural piece needed by Tezos' [Tezos_context_helpers.Context.DB]: module type DB = Irmin.Generic_key.S with module Schema = Schema stops type-checking against [Irmin_lwt.Make(S)]'s result because the latter's [Repo.v] returns [t Lwt.t] instead of [t]. With this change, downstream consumers can now write module type DB = Irmin_lwt.S with module Schema = Schema and type contents = value and ... and pass an [Irmin_lwt.Make(_)] module as [DB]. The [module type S] body is mirrored between [.ml] and [.mli] (both are required — OCaml demands the module type declaration in both); the rest of the implementation is unchanged. Tree's lazy [Contents] submodule is re-exposed, and the store-level [Contents] is wrapped with Lwt-returning [of_key]/[of_hash] to match the signature. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 689 +++++++++++++++++++++++++++++++++++- src/irmin-lwt/irmin_lwt.mli | 400 +++++++++++---------- 2 files changed, 882 insertions(+), 207 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 6a76bd19d3..d0fd76dd1d 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -15,6 +15,679 @@ let run_with_env env f = Lwt_eio.with_event_loop ~clock:env#clock @@ fun _ -> Lwt_eio.Promise.await_lwt (f ()) +module type S = sig + type repo + type t + type step + type path + type metadata + type contents + type node + type tree + type commit + type branch + type slice + type info + type hash + type contents_key + type node_key + type commit_key + type lca_error + type ff_error + type write_error + type kinded_key = [ `Contents of contents_key | `Node of node_key ] + type watch + + (** {1 Type-level submodules} *) + + module Schema : Irmin.Schema.S + module Info : Irmin.Info.S with type t = info + module Hash : Irmin.Hash.S with type t = hash + module Path : Irmin.Path.S with type t = path and type step = step + module Metadata : Irmin.Metadata.S with type t = metadata + + module Backend : + Irmin.Backend.S + with module Schema = Schema + with type Slice.t = slice + and type Repo.t = repo + and type Contents.key = contents_key + and type Node.key = node_key + and type Commit.key = commit_key + + module Contents : sig + include Irmin.Contents.S with type t = contents + + val hash : contents -> hash + val of_key : repo -> contents_key -> contents option Lwt.t + val of_hash : repo -> hash -> contents option Lwt.t + end + + module History : Graph.Sig.P with type V.t = commit + + module Status : sig + type t = [ `Empty | `Branch of branch | `Commit of commit ] + + val t : repo -> t Irmin.Type.t + val pp : t Fmt.t + end + + type Irmin.remote += + | E of Backend.Remote.endpoint + (** Extends [Irmin.remote] with the endpoint type of [Backend]. *) + + (** {1 Repositories} *) + + module Repo : sig + type nonrec t = repo + + type elt = + [ `Commit of commit_key + | `Node of node_key + | `Contents of contents_key + | `Branch of branch ] + + val elt_t : elt Irmin.Type.t + val v : Irmin.Backend.Conf.t -> t Lwt.t + val close : t -> unit Lwt.t + val heads : t -> commit list Lwt.t + val branches : t -> branch list Lwt.t + val config : t -> Irmin.Backend.Conf.t + + val export : + ?full:bool -> + ?depth:int -> + ?min:commit list -> + ?max:[ `Head | `Max of commit list ] -> + t -> + slice Lwt.t + + val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t + val default_pred_commit : t -> commit_key -> elt list + val default_pred_node : t -> node_key -> elt list + val default_pred_contents : t -> contents_key -> elt list + + val iter : + ?cache_size:int -> + min:elt list -> + max:elt list -> + ?edge:(elt -> elt -> unit Lwt.t) -> + ?branch:(branch -> unit Lwt.t) -> + ?commit:(commit_key -> unit Lwt.t) -> + ?node:(node_key -> unit Lwt.t) -> + ?contents:(contents_key -> unit Lwt.t) -> + ?skip_branch:(branch -> bool Lwt.t) -> + ?skip_commit:(commit_key -> bool Lwt.t) -> + ?skip_node:(node_key -> bool Lwt.t) -> + ?skip_contents:(contents_key -> bool Lwt.t) -> + ?pred_branch:(t -> branch -> elt list Lwt.t) -> + ?pred_commit:(t -> commit_key -> elt list Lwt.t) -> + ?pred_node:(t -> node_key -> elt list Lwt.t) -> + ?pred_contents:(t -> contents_key -> elt list Lwt.t) -> + ?rev:bool -> + t -> + unit Lwt.t + + val breadth_first_traversal : + ?cache_size:int -> + max:elt list -> + ?branch:(branch -> unit Lwt.t) -> + ?commit:(commit_key -> unit Lwt.t) -> + ?node:(node_key -> unit Lwt.t) -> + ?contents:(contents_key -> unit Lwt.t) -> + ?pred_branch:(t -> branch -> elt list Lwt.t) -> + ?pred_commit:(t -> commit_key -> elt list Lwt.t) -> + ?pred_node:(t -> node_key -> elt list Lwt.t) -> + ?pred_contents:(t -> contents_key -> elt list Lwt.t) -> + t -> + unit Lwt.t + end + + (** {1 Stores} *) + + val main : repo -> t Lwt.t + + val master : repo -> t Lwt.t + [@@ocaml.deprecated "Use `main` instead."] + (** Deprecated alias kept for Irmin 3 compatibility. Use {!main}. *) + + val of_branch : repo -> branch -> t Lwt.t + val of_commit : commit -> t Lwt.t + val empty : repo -> t Lwt.t + val repo : t -> repo + val tree : t -> tree + val status : t -> [ `Empty | `Branch of branch | `Commit of commit ] + + (** {2 Reads} *) + + val find : t -> path -> contents option Lwt.t + val find_all : t -> path -> (contents * metadata) option Lwt.t + val mem : t -> path -> bool Lwt.t + val mem_tree : t -> path -> bool Lwt.t + val get : t -> path -> contents Lwt.t + val get_all : t -> path -> (contents * metadata) Lwt.t + val find_tree : t -> path -> tree option Lwt.t + val get_tree : t -> path -> tree Lwt.t + val hash : t -> path -> hash option Lwt.t + val kind : t -> path -> [ `Contents | `Node ] option Lwt.t + val list : t -> path -> (step * tree) list Lwt.t + val key : t -> path -> kinded_key option Lwt.t + + (** {2 Writes} *) + + val set : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + contents -> + (unit, write_error) result Lwt.t + + val set_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + contents -> + unit Lwt.t + + val set_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + tree -> + (unit, write_error) result Lwt.t + + val set_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + tree -> + unit Lwt.t + + val remove : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + (unit, write_error) result Lwt.t + + val remove_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + unit Lwt.t + + val test_and_set : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + (unit, write_error) result Lwt.t + + val test_and_set_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + unit Lwt.t + + val test_and_set_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + (unit, write_error) result Lwt.t + + val test_and_set_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + unit Lwt.t + + val test_set_and_get : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + (commit option, write_error) result Lwt.t + + val test_set_and_get_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:contents option -> + set:contents option -> + commit option Lwt.t + + val test_set_and_get_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + (commit option, write_error) result Lwt.t + + val test_set_and_get_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + t -> + path -> + test:tree option -> + set:tree option -> + commit option Lwt.t + + val merge : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + old:contents option -> + t -> + path -> + contents option -> + (unit, write_error) result Lwt.t + + val merge_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + old:contents option -> + t -> + path -> + contents option -> + unit Lwt.t + + val merge_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + old:tree option -> + t -> + path -> + tree option -> + (unit, write_error) result Lwt.t + + val merge_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + info:Info.f -> + old:tree option -> + t -> + path -> + tree option -> + unit Lwt.t + + val with_tree : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + ?strategy:[ `Set | `Test_and_set | `Merge ] -> + info:Info.f -> + t -> + path -> + (tree option -> tree option) -> + (unit, write_error) result Lwt.t + + val with_tree_exn : + ?clear:bool -> + ?retries:int -> + ?allow_empty:bool -> + ?parents:commit list -> + ?strategy:[ `Set | `Test_and_set | `Merge ] -> + info:Info.f -> + t -> + path -> + (tree option -> tree option) -> + unit Lwt.t + + val clone : src:t -> dst:branch -> t Lwt.t + + (** {2 Merges and ancestors} *) + + type 'a merge = + info:Info.f -> + ?max_depth:int -> + ?n:int -> + 'a -> + (unit, Irmin.Merge.conflict) result Lwt.t + (** Lwt-wrapped abbreviation for merge-into-something functions. *) + + val merge_into : into:t -> t merge + val merge_with_branch : t -> branch merge + val merge_with_commit : t -> commit merge + + val lcas : + ?max_depth:int -> ?n:int -> t -> t -> (commit list, lca_error) result Lwt.t + + val lcas_with_branch : + t -> + ?max_depth:int -> + ?n:int -> + branch -> + (commit list, lca_error) result Lwt.t + + val lcas_with_commit : + t -> + ?max_depth:int -> + ?n:int -> + commit -> + (commit list, lca_error) result Lwt.t + + val history : + ?depth:int -> ?min:commit list -> ?max:commit list -> t -> History.t Lwt.t + + val last_modified : ?depth:int -> ?n:int -> t -> path -> commit list Lwt.t + + (** {2 Backend converters} *) + + val of_backend_node : repo -> Backend.Node.value -> node + val to_backend_node : node -> Backend.Node.value + val to_backend_portable_node : node -> Backend.Node_portable.t + val to_backend_commit : commit -> Backend.Commit.value + + val of_backend_commit : + repo -> Backend.Commit.Key.t -> Backend.Commit.value -> commit + + val save_contents : + [> Irmin.Perms.write ] Backend.Contents.t -> contents -> contents_key Lwt.t + + val save_tree : + ?clear:bool -> + repo -> + [> Irmin.Perms.write ] Backend.Contents.t -> + [> Irmin.Perms.read_write ] Backend.Node.t -> + tree -> + kinded_key Lwt.t + + (** {1 Trees} *) + + module Tree : sig + type nonrec t = tree + type kinded_hash + type kinded_key + type elt + type marks + type depth + type stats + type concrete + type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + type uniq = [ `False | `True | `Marks of marks ] + type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + + (** Operations on lazy tree contents. *) + module Contents : sig + type nonrec t + + val hash : ?cache:bool -> t -> hash + val key : t -> contents_key option + end + + val empty : unit -> t + val singleton : path -> ?metadata:metadata -> contents -> t + val of_contents : ?metadata:metadata -> contents -> t + val of_node : node -> t + val v : elt -> t + val pruned : kinded_hash -> t + val is_empty : t -> bool + val destruct : t -> [ `Node of node | `Contents of Contents.t * metadata ] + val hash : ?cache:bool -> t -> hash + val kinded_hash : ?cache:bool -> t -> kinded_hash + val key : t -> kinded_key option + val shallow : Repo.t -> kinded_key -> t + val clear : ?depth:int -> t -> unit + val pp : t Irmin.Type.pp + val kind : t -> path -> [ `Contents | `Node ] option Lwt.t + val diff : t -> t -> (path * (contents * metadata) Irmin.Diff.t) list Lwt.t + val mem : t -> path -> bool Lwt.t + val find_all : t -> path -> (contents * metadata) option Lwt.t + val length : t -> ?cache:bool -> path -> int Lwt.t + val find : t -> path -> contents option Lwt.t + val get_all : t -> path -> (contents * metadata) Lwt.t + val get : t -> path -> contents Lwt.t + + val list : + t -> + ?offset:int -> + ?length:int -> + ?cache:bool -> + path -> + (step * t) list Lwt.t + + val seq : + t -> + ?offset:int -> + ?length:int -> + ?cache:bool -> + path -> + (step * t) Seq.t Lwt.t + + val add : t -> path -> ?metadata:metadata -> contents -> t Lwt.t + + val update : + t -> + path -> + ?metadata:metadata -> + (contents option -> contents option) -> + t Lwt.t + + val remove : t -> path -> t Lwt.t + val mem_tree : t -> path -> bool Lwt.t + val find_tree : t -> path -> t option Lwt.t + val get_tree : t -> path -> t Lwt.t + val add_tree : t -> path -> t -> t Lwt.t + val update_tree : t -> path -> (t option -> t option) -> t Lwt.t + val of_concrete : concrete -> t + val stats : ?force:bool -> t -> stats Lwt.t + val to_concrete : t -> concrete Lwt.t + val find_key : Repo.t -> t -> kinded_key option Lwt.t + val of_key : Repo.t -> kinded_key -> t option Lwt.t + val of_hash : Repo.t -> kinded_hash -> t option Lwt.t + + (** {2 Fold} *) + + val empty_marks : unit -> marks + + val fold : + ?order:[ `Sorted | `Undefined | `Random of Random.State.t ] -> + ?force:'a force_lwt -> + ?cache:bool -> + ?uniq:uniq -> + ?pre:('a, step list) folder_lwt -> + ?post:('a, step list) folder_lwt -> + ?depth:depth -> + ?contents:('a, contents) folder_lwt -> + ?node:('a, node) folder_lwt -> + ?tree:('a, t) folder_lwt -> + t -> + 'a -> + 'a Lwt.t + end + + (** {1 Commits} *) + + module Commit : sig + type nonrec t = commit + type nonrec commit_key = commit_key + + val tree : t -> tree + val parents : t -> commit_key list + val info : t -> info + val hash : t -> hash + val key : t -> commit_key + val pp : t Fmt.t + val pp_hash : t Fmt.t + + val v : + ?clear:bool -> + Repo.t -> + info:info -> + parents:commit_key list -> + tree -> + t Lwt.t + + val of_key : Repo.t -> commit_key -> t option Lwt.t + val of_hash : Repo.t -> hash -> t option Lwt.t + end + + (** {1 Branches} *) + + module Branch : sig + type nonrec t = branch + + val mem : Repo.t -> t -> bool Lwt.t + val find : Repo.t -> t -> commit option Lwt.t + val get : Repo.t -> t -> commit Lwt.t + val set : Repo.t -> t -> commit -> unit Lwt.t + val remove : Repo.t -> t -> unit Lwt.t + val list : Repo.t -> t list Lwt.t + val pp : t Fmt.t + + val watch : + Repo.t -> + t -> + ?init:commit -> + (commit Irmin.Diff.t -> unit Lwt.t) -> + watch Lwt.t + + val watch_all : + Repo.t -> + ?init:(t * commit) list -> + (t -> commit Irmin.Diff.t -> unit Lwt.t) -> + watch Lwt.t + end + + (** {1 Heads} *) + + module Head : sig + val list : Repo.t -> commit list Lwt.t + val find : t -> commit option Lwt.t + val get : t -> commit Lwt.t + val set : t -> commit -> unit Lwt.t + + val fast_forward : + t -> + ?max_depth:int -> + ?n:int -> + commit -> + ( unit, + [ `No_change | `Rejected | `Max_depth_reached | `Too_many_lcas ] ) + result + Lwt.t + + val test_and_set : + t -> test:commit option -> set:commit option -> bool Lwt.t + + val merge : + into:t -> + info:Info.f -> + ?max_depth:int -> + ?n:int -> + commit -> + (unit, Irmin.Merge.conflict) result Lwt.t + end + + (** {1 Watches} *) + + val watch : + t -> ?init:commit -> (commit Irmin.Diff.t -> unit Lwt.t) -> watch Lwt.t + + val watch_key : + t -> + path -> + ?init:commit -> + ((commit * tree) Irmin.Diff.t -> unit Lwt.t) -> + watch Lwt.t + + val unwatch : watch -> unit Lwt.t + + (** {1 Type descriptors} *) + + val step_t : step Irmin.Type.t + val path_t : path Irmin.Type.t + val metadata_t : metadata Irmin.Type.t + val contents_t : contents Irmin.Type.t + val node_t : node Irmin.Type.t + val tree_t : tree Irmin.Type.t + val hash_t : hash Irmin.Type.t + val branch_t : branch Irmin.Type.t + val slice_t : slice Irmin.Type.t + val info_t : info Irmin.Type.t + val lca_error_t : lca_error Irmin.Type.t + val ff_error_t : ff_error Irmin.Type.t + val contents_key_t : contents_key Irmin.Type.t + val node_key_t : node_key Irmin.Type.t + val commit_key_t : commit_key Irmin.Type.t + val write_error_t : write_error Irmin.Type.t + val commit_t : repo -> commit Irmin.Type.t +end + module Make (S : Irmin.Generic_key.S) = struct type repo = S.repo type t = S.t @@ -45,10 +718,17 @@ module Make (S : Irmin.Generic_key.S) = struct module Path = S.Path module Metadata = S.Metadata module Backend = S.Backend - module Contents = S.Contents module History = S.History module Status = S.Status + module Contents = struct + include (S.Contents : Irmin.Contents.S with type t = S.contents) + + let hash = S.Contents.hash + let of_key r k = run_eio (fun () -> S.Contents.of_key r k) + let of_hash r h = run_eio (fun () -> S.Contents.of_hash r h) + end + module Repo = struct type nonrec t = repo type elt = S.Repo.elt @@ -304,12 +984,13 @@ module Make (S : Irmin.Generic_key.S) = struct module Tree = struct type nonrec t = tree - type metadata = S.metadata - type node = S.node - type step = S.step type kinded_hash = S.Tree.kinded_hash type kinded_key = S.Tree.kinded_key type elt = S.Tree.elt + type stats = S.Tree.stats + type concrete = S.Tree.concrete + + module Contents = S.Tree.Contents (* Pure constructors and inspectors. *) let empty = S.Tree.empty diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 9f6ae2d1d4..5ffdab5025 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -19,78 +19,78 @@ val run_with_env : < clock : _ Eio.Time.clock ; .. > -> (unit -> 'a Lwt.t) -> 'a instead of calling [Eio_main.run] internally. Useful when the client is already inside an Eio event loop. *) -module Make (S : Irmin.Generic_key.S) : sig - (** [Make(S)] wraps every I/O-performing operation of [S] so that it returns - an ['a Lwt.t] value. The wrappers thread each call through - [Lwt_eio.run_eio], which runs the direct-style body on the current Eio - scheduler. The caller must therefore be running inside an Eio event loop - with an active [lwt_eio] bridge — see [Irmin_lwt.run] for a convenience - entry point that sets both up. *) - - type repo = S.repo - type t = S.t - type step = S.step - type path = S.path - type metadata = S.metadata - type contents = S.contents - type node = S.node - type tree = S.tree - type commit = S.commit - type branch = S.branch - type slice = S.slice - type info = S.info - type hash = S.hash - type contents_key = S.contents_key - type node_key = S.node_key - type commit_key = S.commit_key - type lca_error = S.lca_error - type ff_error = S.ff_error - type write_error = S.write_error - - (** Type-level modules of [S], forwarded as-is. They carry no I/O and do not - need Lwt wrapping. - - The [module type of struct include S.X end] idiom is used instead of the - shorter [module type of S.X] because the latter produces fresh abstract - types: [Backend.Contents.t] would not be definitionally equal to - [S.Backend.Contents.t], which breaks downstream functors (e.g. Tezos' - [Tezos_context_helpers.Context.Make_tree]) that receive values of both - types. *) - module Schema : module type of struct - include S.Schema - end - - module Info : module type of struct - include S.Info - end - - module Hash : module type of struct - include S.Hash +(** The Lwt-flavoured counterpart of [Irmin.Generic_key.S]. + + Every I/O-triggering operation of [Irmin.Generic_key.S] is replaced by a + version returning ['_ Lwt.t]; type-level submodules (Schema, Info, Hash, + Path, Metadata, Backend, Contents, History, Status) are kept so downstream + consumers can write [Irmin_lwt.S with module Schema = …] the same way they + would write [Irmin.Generic_key.S with module Schema = …]. + + See {!Make} for the functor that produces a module conforming to [S] from an + arbitrary [Irmin.Generic_key.S]. *) +module type S = sig + type repo + type t + type step + type path + type metadata + type contents + type node + type tree + type commit + type branch + type slice + type info + type hash + type contents_key + type node_key + type commit_key + type lca_error + type ff_error + type write_error + type kinded_key = [ `Contents of contents_key | `Node of node_key ] + type watch + + (** {1 Type-level submodules} *) + + module Schema : Irmin.Schema.S + module Info : Irmin.Info.S with type t = info + module Hash : Irmin.Hash.S with type t = hash + module Path : Irmin.Path.S with type t = path and type step = step + module Metadata : Irmin.Metadata.S with type t = metadata + + module Backend : + Irmin.Backend.S + with module Schema = Schema + with type Slice.t = slice + and type Repo.t = repo + and type Contents.key = contents_key + and type Node.key = node_key + and type Commit.key = commit_key + + module Contents : sig + include Irmin.Contents.S with type t = contents + + val hash : contents -> hash + val of_key : repo -> contents_key -> contents option Lwt.t + val of_hash : repo -> hash -> contents option Lwt.t end - module Path : module type of struct - include S.Path - end + module History : Graph.Sig.P with type V.t = commit - module Metadata : module type of struct - include S.Metadata - end + module Status : sig + type t = [ `Empty | `Branch of branch | `Commit of commit ] - module Backend : module type of struct - include S.Backend + val t : repo -> t Irmin.Type.t + val pp : t Fmt.t end - module Contents : module type of struct - include S.Contents - end + type Irmin.remote += + | E of Backend.Remote.endpoint + (** Extends [Irmin.remote] with the endpoint type of [Backend]. *) - module History : module type of struct - include S.History - end - - module Status : module type of struct - include S.Status - end + (** {1 Repositories} *) module Repo : sig type nonrec t = repo @@ -100,7 +100,6 @@ module Make (S : Irmin.Generic_key.S) : sig | `Node of node_key | `Contents of contents_key | `Branch of branch ] - (** The type for elements iterated over by {!iter}. *) val elt_t : elt Irmin.Type.t val v : Irmin.Backend.Conf.t -> t Lwt.t @@ -115,18 +114,13 @@ module Make (S : Irmin.Generic_key.S) : sig ?min:commit list -> ?max:[ `Head | `Max of commit list ] -> t -> - S.slice Lwt.t + slice Lwt.t val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t - - (** {2 Default predecessor walks} *) - val default_pred_commit : t -> commit_key -> elt list val default_pred_node : t -> node_key -> elt list val default_pred_contents : t -> contents_key -> elt list - (** {2 Topological traversals} *) - val iter : ?cache_size:int -> min:elt list -> @@ -147,9 +141,6 @@ module Make (S : Irmin.Generic_key.S) : sig ?rev:bool -> t -> unit Lwt.t - (** Lwt-wrapped counterpart of [S.Repo.iter]. Every callback is bridged to - the direct-style call expected by the underlying traversal through - [Lwt_eio.Promise.await_lwt]. *) val breadth_first_traversal : ?cache_size:int -> @@ -166,6 +157,8 @@ module Make (S : Irmin.Generic_key.S) : sig unit Lwt.t end + (** {1 Stores} *) + val main : repo -> t Lwt.t val master : repo -> t Lwt.t @@ -179,8 +172,7 @@ module Make (S : Irmin.Generic_key.S) : sig val tree : t -> tree val status : t -> [ `Empty | `Branch of branch | `Commit of commit ] - type kinded_key = [ `Contents of contents_key | `Node of node_key ] - (** The type of keys as returned by {!val-key} and {!save_tree}. *) + (** {2 Reads} *) val find : t -> path -> contents option Lwt.t val find_all : t -> path -> (contents * metadata) option Lwt.t @@ -195,12 +187,14 @@ module Make (S : Irmin.Generic_key.S) : sig val list : t -> path -> (step * tree) list Lwt.t val key : t -> path -> kinded_key option Lwt.t + (** {2 Writes} *) + val set : ?clear:bool -> ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> contents -> @@ -211,7 +205,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> contents -> @@ -222,7 +216,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> tree -> @@ -233,7 +227,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> tree -> @@ -244,7 +238,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> (unit, write_error) result Lwt.t @@ -254,39 +248,17 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> unit Lwt.t - (** {2 [Irmin.Type.t] descriptors} - - Forwarded from [S] — pure, no I/O. *) - - val step_t : step Irmin.Type.t - val path_t : path Irmin.Type.t - val metadata_t : metadata Irmin.Type.t - val contents_t : contents Irmin.Type.t - val node_t : node Irmin.Type.t - val tree_t : tree Irmin.Type.t - val hash_t : hash Irmin.Type.t - val branch_t : branch Irmin.Type.t - val slice_t : slice Irmin.Type.t - val info_t : info Irmin.Type.t - val lca_error_t : lca_error Irmin.Type.t - val ff_error_t : ff_error Irmin.Type.t - val contents_key_t : contents_key Irmin.Type.t - val node_key_t : node_key Irmin.Type.t - val commit_key_t : commit_key Irmin.Type.t - val write_error_t : write_error Irmin.Type.t - val commit_t : repo -> commit Irmin.Type.t - val test_and_set : ?clear:bool -> ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:contents option -> @@ -298,7 +270,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:contents option -> @@ -310,7 +282,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:tree option -> @@ -322,7 +294,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:tree option -> @@ -334,7 +306,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:contents option -> @@ -346,7 +318,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:contents option -> @@ -358,7 +330,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:tree option -> @@ -370,7 +342,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> t -> path -> test:tree option -> @@ -382,7 +354,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> old:contents option -> t -> path -> @@ -394,7 +366,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> old:contents option -> t -> path -> @@ -406,7 +378,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> old:tree option -> t -> path -> @@ -418,7 +390,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?retries:int -> ?allow_empty:bool -> ?parents:commit list -> - info:S.Info.f -> + info:Info.f -> old:tree option -> t -> path -> @@ -431,7 +403,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?allow_empty:bool -> ?parents:commit list -> ?strategy:[ `Set | `Test_and_set | `Merge ] -> - info:S.Info.f -> + info:Info.f -> t -> path -> (tree option -> tree option) -> @@ -443,7 +415,7 @@ module Make (S : Irmin.Generic_key.S) : sig ?allow_empty:bool -> ?parents:commit list -> ?strategy:[ `Set | `Test_and_set | `Merge ] -> - info:S.Info.f -> + info:Info.f -> t -> path -> (tree option -> tree option) -> @@ -451,37 +423,19 @@ module Make (S : Irmin.Generic_key.S) : sig val clone : src:t -> dst:branch -> t Lwt.t + (** {2 Merges and ancestors} *) + type 'a merge = - info:S.Info.f -> + info:Info.f -> ?max_depth:int -> ?n:int -> 'a -> (unit, Irmin.Merge.conflict) result Lwt.t - (** Abbreviation for the Lwt-wrapped merge signature used by {!merge_into}, - {!merge_with_branch} and {!merge_with_commit}. *) - - type Irmin.remote += - | E of Backend.Remote.endpoint - (** Extends the top-level [Irmin.remote] with the endpoint type of - [S]'s backend, matching the extension in [S]. *) + (** Lwt-wrapped abbreviation for merge-into-something functions. *) val merge_into : into:t -> t merge - - val merge_with_branch : - t -> - info:S.Info.f -> - ?max_depth:int -> - ?n:int -> - branch -> - (unit, Irmin.Merge.conflict) result Lwt.t - - val merge_with_commit : - t -> - info:S.Info.f -> - ?max_depth:int -> - ?n:int -> - commit -> - (unit, Irmin.Merge.conflict) result Lwt.t + val merge_with_branch : t -> branch merge + val merge_with_commit : t -> commit merge val lcas : ?max_depth:int -> ?n:int -> t -> t -> (commit list, lca_error) result Lwt.t @@ -505,48 +459,49 @@ module Make (S : Irmin.Generic_key.S) : sig val last_modified : ?depth:int -> ?n:int -> t -> path -> commit list Lwt.t - (** {2 Backend converters} + (** {2 Backend converters} *) - These translate between frontend and backend representations. They are - pure — no I/O, no scheduler round-trip. *) - - val of_backend_node : repo -> S.Backend.Node.value -> node - val to_backend_node : node -> S.Backend.Node.value - val to_backend_portable_node : node -> S.Backend.Node_portable.t - val to_backend_commit : commit -> S.Backend.Commit.value + val of_backend_node : repo -> Backend.Node.value -> node + val to_backend_node : node -> Backend.Node.value + val to_backend_portable_node : node -> Backend.Node_portable.t + val to_backend_commit : commit -> Backend.Commit.value val of_backend_commit : - repo -> S.Backend.Commit.Key.t -> S.Backend.Commit.value -> commit - - (** {2 Saving raw contents and trees} - - Lwt-wrapped because they persist to the backend store. *) + repo -> Backend.Commit.Key.t -> Backend.Commit.value -> commit val save_contents : - [> Irmin.Perms.write ] S.Backend.Contents.t -> - contents -> - contents_key Lwt.t + [> Irmin.Perms.write ] Backend.Contents.t -> contents -> contents_key Lwt.t val save_tree : ?clear:bool -> repo -> - [> Irmin.Perms.write ] S.Backend.Contents.t -> - [> Irmin.Perms.read_write ] S.Backend.Node.t -> + [> Irmin.Perms.write ] Backend.Contents.t -> + [> Irmin.Perms.read_write ] Backend.Node.t -> tree -> kinded_key Lwt.t - (** Lwt-wrapped tree operations. Pure constructors and inspectors (e.g. - {!empty}, {!is_empty}, {!hash}) are forwarded as-is; operations that might - trigger lazy loading from the backend are threaded through - [Lwt_eio.run_eio]. *) + (** {1 Trees} *) + module Tree : sig type nonrec t = tree - type metadata = S.metadata - type node = S.node - type step = S.step - type kinded_hash = S.Tree.kinded_hash - type kinded_key = S.Tree.kinded_key - type elt = S.Tree.elt + type kinded_hash + type kinded_key + type elt + type marks + type depth + type stats + type concrete + type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + type uniq = [ `False | `True | `Marks of marks ] + type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + + (** Operations on lazy tree contents. *) + module Contents : sig + type nonrec t + + val hash : ?cache:bool -> t -> hash + val key : t -> contents_key option + end val empty : unit -> t val singleton : path -> ?metadata:metadata -> contents -> t @@ -555,16 +510,12 @@ module Make (S : Irmin.Generic_key.S) : sig val v : elt -> t val pruned : kinded_hash -> t val is_empty : t -> bool - - val destruct : - t -> [ `Node of node | `Contents of S.Tree.Contents.t * metadata ] - + val destruct : t -> [ `Node of node | `Contents of Contents.t * metadata ] val hash : ?cache:bool -> t -> hash val kinded_hash : ?cache:bool -> t -> kinded_hash val key : t -> kinded_key option val shallow : Repo.t -> kinded_key -> t val clear : ?depth:int -> t -> unit - val of_concrete : S.Tree.concrete -> t val pp : t Irmin.Type.pp val kind : t -> path -> [ `Contents | `Node ] option Lwt.t val diff : t -> t -> (path * (contents * metadata) Irmin.Diff.t) list Lwt.t @@ -606,26 +557,17 @@ module Make (S : Irmin.Generic_key.S) : sig val get_tree : t -> path -> t Lwt.t val add_tree : t -> path -> t -> t Lwt.t val update_tree : t -> path -> (t option -> t option) -> t Lwt.t - val stats : ?force:bool -> t -> S.Tree.stats Lwt.t - val to_concrete : t -> S.Tree.concrete Lwt.t + val of_concrete : concrete -> t + val stats : ?force:bool -> t -> stats Lwt.t + val to_concrete : t -> concrete Lwt.t val find_key : Repo.t -> t -> kinded_key option Lwt.t val of_key : Repo.t -> kinded_key -> t option Lwt.t val of_hash : Repo.t -> kinded_hash -> t option Lwt.t (** {2 Fold} *) - type marks = S.Tree.marks - val empty_marks : unit -> marks - type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] - (** Like {!S.Tree.force} but the [`False] callback returns an Lwt promise. - *) - - type uniq = [ `False | `True | `Marks of marks ] - type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t - type depth = S.Tree.depth - val fold : ?order:[ `Sorted | `Undefined | `Random of Random.State.t ] -> ?force:'a force_lwt -> @@ -640,19 +582,13 @@ module Make (S : Irmin.Generic_key.S) : sig t -> 'a -> 'a Lwt.t - (** [fold] is the Lwt-wrapped counterpart of [S.Tree.fold]. Every callback - ([pre], [post], [contents], [node], [tree], and the [`False] branch of - [force]) is expected to return an [Lwt.t] promise; the wrapper awaits - each promise on the lwt_eio bridge before resuming the underlying - traversal. *) end - (** Lwt-wrapped commit operations. Pure accessors ([tree], [parents], [info], - [hash], [key], [pp]) are forwarded as-is; constructors and lookups that - might load from the backend are wrapped. *) + (** {1 Commits} *) + module Commit : sig type nonrec t = commit - type commit_key = S.commit_key + type nonrec commit_key = commit_key val tree : t -> tree val parents : t -> commit_key list @@ -674,11 +610,8 @@ module Make (S : Irmin.Generic_key.S) : sig val of_hash : Repo.t -> hash -> t option Lwt.t end - type watch = S.watch - (** Top-level watch type, used by {!watch}, {!watch_key} and the watch - operations on {!module-Branch}. *) + (** {1 Branches} *) - (** Lwt-wrapped branch operations. *) module Branch : sig type nonrec t = branch @@ -704,7 +637,8 @@ module Make (S : Irmin.Generic_key.S) : sig watch Lwt.t end - (** Lwt-wrapped head operations. *) + (** {1 Heads} *) + module Head : sig val list : Repo.t -> commit list Lwt.t val find : t -> commit option Lwt.t @@ -726,13 +660,15 @@ module Make (S : Irmin.Generic_key.S) : sig val merge : into:t -> - info:S.Info.f -> + info:Info.f -> ?max_depth:int -> ?n:int -> commit -> (unit, Irmin.Merge.conflict) result Lwt.t end + (** {1 Watches} *) + val watch : t -> ?init:commit -> (commit Irmin.Diff.t -> unit Lwt.t) -> watch Lwt.t @@ -744,8 +680,66 @@ module Make (S : Irmin.Generic_key.S) : sig watch Lwt.t val unwatch : watch -> unit Lwt.t + + (** {1 Type descriptors} *) + + val step_t : step Irmin.Type.t + val path_t : path Irmin.Type.t + val metadata_t : metadata Irmin.Type.t + val contents_t : contents Irmin.Type.t + val node_t : node Irmin.Type.t + val tree_t : tree Irmin.Type.t + val hash_t : hash Irmin.Type.t + val branch_t : branch Irmin.Type.t + val slice_t : slice Irmin.Type.t + val info_t : info Irmin.Type.t + val lca_error_t : lca_error Irmin.Type.t + val ff_error_t : ff_error Irmin.Type.t + val contents_key_t : contents_key Irmin.Type.t + val node_key_t : node_key Irmin.Type.t + val commit_key_t : commit_key Irmin.Type.t + val write_error_t : write_error Irmin.Type.t + val commit_t : repo -> commit Irmin.Type.t end +module Make (S : Irmin.Generic_key.S) : + S + with type repo = S.repo + and type t = S.t + and type step = S.step + and type path = S.path + and type metadata = S.metadata + and type contents = S.contents + and type node = S.node + and type tree = S.tree + and type commit = S.commit + and type branch = S.branch + and type slice = S.slice + and type info = S.info + and type hash = S.hash + and type contents_key = S.contents_key + and type node_key = S.node_key + and type commit_key = S.commit_key + and type lca_error = S.lca_error + and type ff_error = S.ff_error + and type write_error = S.write_error + and type watch = S.watch + and module Schema = S.Schema + and module Info = S.Info + and module Hash = S.Hash + and module Path = S.Path + and module Metadata = S.Metadata + and module Backend = S.Backend + and module History = S.History + and type Repo.elt = S.Repo.elt + and type Tree.kinded_hash = S.Tree.kinded_hash + and type Tree.kinded_key = S.Tree.kinded_key + and type Tree.elt = S.Tree.elt + and type Tree.marks = S.Tree.marks + and type Tree.depth = S.Tree.depth + and type Tree.stats = S.Tree.stats + and type Tree.concrete = S.Tree.concrete + (** Lwt wrappers for [irmin-pack-unix]-specific operations. [Pack.Make] takes an [Irmin_pack_io.S] (the full pack-unix store signature) From f5700b898f9ff6a068b183e44931435d3a1e52cd Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 12:08:34 +0200 Subject: [PATCH 25/40] irmin-lwt: link top-level types to Schema in module type S Without these equalities, [Irmin_lwt.S with module Schema = Schema] in a downstream consumer (Tezos' [Tezos_context_helpers.Context.DB]) only substituted [Schema] but left [hash], [contents], [step], etc. abstract. Cue type errors like "Store.Tree.hash returns Store.hash but Tezos expects Hash.t (= Schema.Hash.t)". Mirror the pattern of [Irmin.Generic_key.S]: declare [Schema] first and define the types it derives as type aliases: type step = Schema.Path.step type path = Schema.Path.t type metadata = Schema.Metadata.t type contents = Schema.Contents.t type branch = Schema.Branch.t type info = Schema.Info.t type hash = Schema.Hash.t Now [Irmin_lwt.S with module Schema = Schema] propagates the equalities to every Schema-derived type. The redundant [type X = S.X] constraints in [Make]'s output type are dropped accordingly. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 21 +++++++++++++-------- src/irmin-lwt/irmin_lwt.mli | 32 +++++++++++++++----------------- 2 files changed, 28 insertions(+), 25 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index d0fd76dd1d..1264a70b31 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -16,19 +16,25 @@ let run_with_env env f = Lwt_eio.Promise.await_lwt (f ()) module type S = sig + (** {1 Schema} *) + + module Schema : Irmin.Schema.S + + (** {1 Types} *) + type repo type t - type step - type path - type metadata - type contents + type step = Schema.Path.step + type path = Schema.Path.t + type metadata = Schema.Metadata.t + type contents = Schema.Contents.t type node type tree type commit - type branch + type branch = Schema.Branch.t type slice - type info - type hash + type info = Schema.Info.t + type hash = Schema.Hash.t type contents_key type node_key type commit_key @@ -40,7 +46,6 @@ module type S = sig (** {1 Type-level submodules} *) - module Schema : Irmin.Schema.S module Info : Irmin.Info.S with type t = info module Hash : Irmin.Hash.S with type t = hash module Path : Irmin.Path.S with type t = path and type step = step diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 5ffdab5025..35178e818c 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -30,19 +30,25 @@ val run_with_env : < clock : _ Eio.Time.clock ; .. > -> (unit -> 'a Lwt.t) -> 'a See {!Make} for the functor that produces a module conforming to [S] from an arbitrary [Irmin.Generic_key.S]. *) module type S = sig + (** {1 Schema} *) + + module Schema : Irmin.Schema.S + + (** {1 Types} *) + type repo type t - type step - type path - type metadata - type contents + type step = Schema.Path.step + type path = Schema.Path.t + type metadata = Schema.Metadata.t + type contents = Schema.Contents.t type node type tree type commit - type branch + type branch = Schema.Branch.t type slice - type info - type hash + type info = Schema.Info.t + type hash = Schema.Hash.t type contents_key type node_key type commit_key @@ -54,7 +60,6 @@ module type S = sig (** {1 Type-level submodules} *) - module Schema : Irmin.Schema.S module Info : Irmin.Info.S with type t = info module Hash : Irmin.Hash.S with type t = hash module Path : Irmin.Path.S with type t = path and type step = step @@ -704,19 +709,13 @@ end module Make (S : Irmin.Generic_key.S) : S - with type repo = S.repo + with module Schema = S.Schema + and type repo = S.repo and type t = S.t - and type step = S.step - and type path = S.path - and type metadata = S.metadata - and type contents = S.contents and type node = S.node and type tree = S.tree and type commit = S.commit - and type branch = S.branch and type slice = S.slice - and type info = S.info - and type hash = S.hash and type contents_key = S.contents_key and type node_key = S.node_key and type commit_key = S.commit_key @@ -724,7 +723,6 @@ module Make (S : Irmin.Generic_key.S) : and type ff_error = S.ff_error and type write_error = S.write_error and type watch = S.watch - and module Schema = S.Schema and module Info = S.Info and module Hash = S.Hash and module Path = S.Path From 2218c245143bfe737351eb29601ecbbe2ff30a6d Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 12:16:14 +0200 Subject: [PATCH 26/40] irmin-lwt: complete Tree.Contents with force, force_exn, clear MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The previous [Tree.Contents] in [module type S] only declared [t], [hash] and [key]. Octez (and any consumer that consults a lazy contents node) also needs: - [type error]: errors raised when forcing a lazy contents value ([Dangling_hash], [Pruned_hash], [Portable_value]). - [type 'a or_error]: result alias. - [val force]: returns the contents value or an error, Lwt-wrapped (the call may load from the backend). - [val force_exn]: same, but raises on error. Lwt-wrapped. - [val clear]: clears the cached value, pure. In the [Make] implementation, [Contents] now extends [S.Tree.Contents] through [include (S.Tree.Contents : module type of struct include … end with type t = …)] so the existing direct-style methods are forwarded and only [force]/[force_exn] are shadowed with their Lwt-wrapped versions. Reported missing by Octez compilation ([helpers/context.ml:118] uses [Store.Tree.Contents.force_exn]). Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 24 ++++++++++++++++++++++-- src/irmin-lwt/irmin_lwt.mli | 9 +++++++++ 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 1264a70b31..659bcdbad0 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -486,12 +486,20 @@ module type S = sig type uniq = [ `False | `True | `Marks of marks ] type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type error = + [ `Dangling_hash of hash | `Pruned_hash of hash | `Portable_value ] + + type 'a or_error = ('a, error) result + (** Operations on lazy tree contents. *) module Contents : sig type nonrec t val hash : ?cache:bool -> t -> hash val key : t -> contents_key option + val force : t -> contents or_error Lwt.t + val force_exn : t -> contents Lwt.t + val clear : t -> unit end val empty : unit -> t @@ -994,8 +1002,20 @@ module Make (S : Irmin.Generic_key.S) = struct type elt = S.Tree.elt type stats = S.Tree.stats type concrete = S.Tree.concrete - - module Contents = S.Tree.Contents + type error = S.Tree.error + type 'a or_error = ('a, error) result + + module Contents = struct + include ( + S.Tree.Contents : + module type of struct + include S.Tree.Contents + end + with type t = S.Tree.Contents.t) + + let force c = run_eio (fun () -> S.Tree.Contents.force c) + let force_exn c = run_eio (fun () -> S.Tree.Contents.force_exn c) + end (* Pure constructors and inspectors. *) let empty = S.Tree.empty diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 35178e818c..ca2424e062 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -500,12 +500,21 @@ module type S = sig type uniq = [ `False | `True | `Marks of marks ] type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type error = + [ `Dangling_hash of hash | `Pruned_hash of hash | `Portable_value ] + (** Errors that can be raised when forcing a lazy tree value. *) + + type 'a or_error = ('a, error) result + (** Operations on lazy tree contents. *) module Contents : sig type nonrec t val hash : ?cache:bool -> t -> hash val key : t -> contents_key option + val force : t -> contents or_error Lwt.t + val force_exn : t -> contents Lwt.t + val clear : t -> unit end val empty : unit -> t From a9c9a273996d9c65c69f1390a7e22e747b011244 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 12:23:59 +0200 Subject: [PATCH 27/40] irmin-lwt: expose Tree's polymorphic variants transparently Octez (and any code that pattern-matches on lazy tree values) needs the following [Tree] types to be transparent rather than abstract: - [kinded_hash = [`Contents of hash * metadata | `Node of hash]] - [kinded_key = [`Contents of contents_key * metadata | `Node of node_key]] - [elt = [`Node of node | `Contents of contents * metadata]] - [concrete = [`Tree of (step * concrete) list | `Contents of contents * metadata]] - [depth = [`Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int]] These were declared abstract in the previous [module type S] body, so [match c with `Tree l -> _ | `Contents (v, _) -> _] (used in [helpers/context.ml:152]) failed to type-check. Polymorphic variants are structural in OCaml, so re-declaring them with the same constructor shape lets values from [S.Tree.X] flow through without any coercion. For [stats], which is a record (nominally typed), we keep the type abstract and expose the [Irmin.Type.t] descriptor [stats_t] instead. Field access is available through [Irmin.Type] introspection. Reported by the third Octez compilation pass. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 46 +++++++++++++++++++++++++++++-------- src/irmin-lwt/irmin_lwt.mli | 25 ++++++++++++++++---- 2 files changed, 57 insertions(+), 14 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 659bcdbad0..648a4a4f2c 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -475,13 +475,24 @@ module type S = sig module Tree : sig type nonrec t = tree - type kinded_hash - type kinded_key - type elt + type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + + type kinded_key = + [ `Contents of contents_key * metadata | `Node of node_key ] + + type elt = [ `Node of node | `Contents of contents * metadata ] type marks - type depth + + type depth = + [ `Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int ] + type stats - type concrete + + val stats_t : stats Irmin.Type.t + + type concrete = + [ `Tree of (step * concrete) list | `Contents of contents * metadata ] + type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] type uniq = [ `False | `True | `Marks of marks ] type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t @@ -997,11 +1008,28 @@ module Make (S : Irmin.Generic_key.S) = struct module Tree = struct type nonrec t = tree - type kinded_hash = S.Tree.kinded_hash - type kinded_key = S.Tree.kinded_key - type elt = S.Tree.elt + + (* Polymorphic variants: declared transparently here. They are + structurally identical to the upstream [S.Tree.X] versions, so + values flow through without coercion thanks to polymorphic-variant + subtyping. *) + type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + + type kinded_key = + [ `Contents of contents_key * metadata | `Node of node_key ] + + type elt = [ `Node of node | `Contents of contents * metadata ] + + type concrete = + [ `Tree of (step * concrete) list | `Contents of contents * metadata ] + + (* [stats] is a record. We keep it as an alias of [S.Tree.stats] so + it remains nominally compatible. Field access is exposed through + [stats_t] / [Irmin.Type] introspection. *) type stats = S.Tree.stats - type concrete = S.Tree.concrete + + let stats_t = S.Tree.stats_t + type error = S.Tree.error type 'a or_error = ('a, error) result diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index ca2424e062..9eedb6e4f9 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -489,13 +489,28 @@ module type S = sig module Tree : sig type nonrec t = tree - type kinded_hash - type kinded_key - type elt + type kinded_hash = [ `Contents of hash * metadata | `Node of hash ] + + type kinded_key = + [ `Contents of contents_key * metadata | `Node of node_key ] + + type elt = [ `Node of node | `Contents of contents * metadata ] type marks - type depth + + type depth = + [ `Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int ] + type stats - type concrete + (** Tree statistics. The record fields ([nodes], [leafs], [skips], [depth], + [width]) cannot be exposed through the functor boundary, but the + [Irmin.Type.t] descriptor [stats_t] gives field access via [Irmin.Type] + introspection. *) + + val stats_t : stats Irmin.Type.t + + type concrete = + [ `Tree of (step * concrete) list | `Contents of contents * metadata ] + type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] type uniq = [ `False | `True | `Marks of marks ] type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t From 3e573c679bdac7193f70b9e23c2572eab6c316b5 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 12:25:13 +0200 Subject: [PATCH 28/40] irmin-lwt: expose top-level error types as transparent variants too The same pattern as the Tree commit: [lca_error], [ff_error] and [write_error] were declared abstract, preventing pattern matching on them at use sites. Re-declare them with their full constructor shape: - [lca_error = [`Max_depth_reached | `Too_many_lcas]] - [ff_error = [`No_change | `Rejected | lca_error]] - [write_error = [Irmin.Merge.conflict | `Too_many_retries of int | `Test_was of tree option]] Now downstream code can pattern-match on the result of [merge_into], [fast_forward], [lcas], [test_and_set], etc. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 11 ++++++++--- src/irmin-lwt/irmin_lwt.mli | 11 ++++++++--- 2 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 648a4a4f2c..f7f9e1af2c 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -38,9 +38,14 @@ module type S = sig type contents_key type node_key type commit_key - type lca_error - type ff_error - type write_error + type lca_error = [ `Max_depth_reached | `Too_many_lcas ] + type ff_error = [ `No_change | `Rejected | lca_error ] + + type write_error = + [ Irmin.Merge.conflict + | `Too_many_retries of int + | `Test_was of tree option ] + type kinded_key = [ `Contents of contents_key | `Node of node_key ] type watch diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 9eedb6e4f9..c5b3738fcb 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -52,9 +52,14 @@ module type S = sig type contents_key type node_key type commit_key - type lca_error - type ff_error - type write_error + type lca_error = [ `Max_depth_reached | `Too_many_lcas ] + type ff_error = [ `No_change | `Rejected | lca_error ] + + type write_error = + [ Irmin.Merge.conflict + | `Too_many_retries of int + | `Test_was of tree option ] + type kinded_key = [ `Contents of contents_key | `Node of node_key ] type watch From 6773cf39b3bf1a6a55eca4c8493438b642d1bc37 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:13:04 +0200 Subject: [PATCH 29/40] irmin-lwt: expose Tree.inspect, counters, dump_counters, reset_counters, merge These were missing from the [Tree] submodule of [module type S]: - [val merge : t Irmin.Merge.t]: the merge value used by Irmin tree combinators. - [type counters], [val counters], [val dump_counters], [val reset_counters]: the performance counters shared between all trees backed by the same set of internal caches. [counters] is kept abstract since it is a record (nominal typing) and the underlying [S.Tree.counters] is abstract from inside the functor body. - [val inspect]: a synchronous inspector returning a transparent variant describing the kind and internal state of a tree node ([`Map], [`Key], [`Value], [`Portable_dirty], [`Pruned]). [helpers/context.ml] in Octez calls [inspect] for debugging / introspection paths. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 22 ++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 19 +++++++++++++++++++ 2 files changed, 41 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index f7f9e1af2c..528e0dce5b 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -597,6 +597,19 @@ module type S = sig t -> 'a -> 'a Lwt.t + + val merge : t Irmin.Merge.t + + type counters + + val counters : unit -> counters + val dump_counters : unit Fmt.t + val reset_counters : unit -> unit + + val inspect : + t -> + [ `Contents + | `Node of [ `Map | `Key | `Value | `Portable_dirty | `Pruned ] ] end (** {1 Commits} *) @@ -1134,6 +1147,15 @@ module Make (S : Irmin.Generic_key.S) = struct run_eio (fun () -> S.Tree.fold ?order ?force ?cache ?uniq ?pre ?post ?depth ?contents ?node ?tree t acc) + + let merge = S.Tree.merge + + type counters = S.Tree.counters + + let counters = S.Tree.counters + let dump_counters = S.Tree.dump_counters + let reset_counters = S.Tree.reset_counters + let inspect = S.Tree.inspect end module Commit = struct diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index c5b3738fcb..e936b81a2c 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -616,6 +616,25 @@ module type S = sig t -> 'a -> 'a Lwt.t + + (** {2 Merge} *) + + val merge : t Irmin.Merge.t + + (** {2 Performance counters and inspection} *) + + type counters + + val counters : unit -> counters + val dump_counters : unit Fmt.t + val reset_counters : unit -> unit + + val inspect : + t -> + [ `Contents + | `Node of [ `Map | `Key | `Value | `Portable_dirty | `Pruned ] ] + (** [inspect t] is similar to {!val-kind}, with extra state information + returned for nodes. Pure: no I/O. *) end (** {1 Commits} *) From 7c796008b1eb77fe6ddaa4d9db9ec19d7b67176b Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:19:22 +0200 Subject: [PATCH 30/40] irmin-lwt: re-export Tree.Dangling_hash, Pruned_hash, Portable_value Octez code that catches the Dangling_hash exception ([helpers/context.ml:227]) needs to pattern-match against [Store.Tree.Dangling_hash _]. Without the exception being declared in the Lwt module type, the match arm silently does not fire and the exception escapes. Re-export the three exceptions raised by Irmin's tree code with the standard OCaml constructor-aliasing syntax: exception Dangling_hash = S.Tree.Dangling_hash exception Pruned_hash = S.Tree.Pruned_hash exception Portable_value = S.Tree.Portable_value The exception value itself is shared, so [Store.Tree.Dangling_hash] (via [Irmin_lwt.Make(S).Tree.Dangling_hash]) and the underlying [S.Tree.Dangling_hash] are the same constructor. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 8 ++++++++ src/irmin-lwt/irmin_lwt.mli | 10 ++++++++++ 2 files changed, 18 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 528e0dce5b..2ded1e25f9 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -507,6 +507,10 @@ module type S = sig type 'a or_error = ('a, error) result + exception Dangling_hash of { context : string; hash : hash } + exception Pruned_hash of { context : string; hash : hash } + exception Portable_value of { context : string } + (** Operations on lazy tree contents. *) module Contents : sig type nonrec t @@ -1051,6 +1055,10 @@ module Make (S : Irmin.Generic_key.S) = struct type error = S.Tree.error type 'a or_error = ('a, error) result + exception Dangling_hash = S.Tree.Dangling_hash + exception Pruned_hash = S.Tree.Pruned_hash + exception Portable_value = S.Tree.Portable_value + module Contents = struct include ( S.Tree.Contents : diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index e936b81a2c..554637c301 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -526,6 +526,16 @@ module type S = sig type 'a or_error = ('a, error) result + exception Dangling_hash of { context : string; hash : hash } + (** Raised by functions that can force lazy tree nodes but do not return an + explicit {!or_error}. *) + + exception Pruned_hash of { context : string; hash : hash } + (** Raised by functions that attempt to load {!pruned} tree nodes. *) + + exception Portable_value of { context : string } + (** Raised by functions that attempt to perform IO on a portable tree. *) + (** Operations on lazy tree contents. *) module Contents : sig type nonrec t From def1e5034871dad91179a6bc6371af9f433b62ee Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:24:31 +0200 Subject: [PATCH 31/40] irmin-lwt: expose Tree.Proof, produce_proof, verify_proof, hash_of_proof_state MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Round out [Tree] with the Merkle proof surface that upstream [Irmin.Generic_key.S.Tree] exposes (and that Octez relies on for context proofs). In [module type S.Tree]: - [module Proof] mirrors [Irmin.Proof.S] for the store's contents, hash, step and metadata. The [proof_tree] and [inode_tree] are exposed as transparent variants so callers can pattern-match on proof structure (Tezos uses this for Merkle proof serialization). - [type verifier_error = [`Proof_mismatch of string]]. - [val produce_proof], [val verify_proof] — Lwt-wrapped, with the user callback bridged via [Lwt_eio.Promise.await_lwt] (same idiom as [Tree.fold] and the watchers). - [val hash_of_proof_state] — pure forwarding. In [Make]'s [Tree], [Proof] re-uses [S.Tree.Proof]'s implementation by [include] with destructive substitution on [tree] and [t], then exposes them under their renamed names ([proof_tree], [proof]) matching the [module type S] declaration. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 83 +++++++++++++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 44 ++++++++++++++++++++ 2 files changed, 127 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 2ded1e25f9..3222434250 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -614,6 +614,45 @@ module type S = sig t -> [ `Contents | `Node of [ `Map | `Key | `Value | `Portable_dirty | `Pruned ] ] + + module Proof : sig + type 'a inode = { length : int; proofs : (int * 'a) list } + type 'a inode_extender = { length : int; segments : int list; proof : 'a } + + type proof_tree = + | Contents of contents * metadata + | Blinded_contents of hash * metadata + | Node of (step * proof_tree) list + | Blinded_node of hash + | Inode of inode_tree inode + | Extender of inode_tree inode_extender + + and inode_tree = + | Blinded_inode of hash + | Inode_values of (step * proof_tree) list + | Inode_tree of inode_tree inode + | Inode_extender of inode_tree inode_extender + + type proof + + val v : before:kinded_hash -> after:kinded_hash -> proof_tree -> proof + val before : proof -> kinded_hash + val after : proof -> kinded_hash + val state : proof -> proof_tree + val to_tree : proof -> t + end + + type verifier_error = [ `Proof_mismatch of string ] + + val produce_proof : + Repo.t -> kinded_key -> (t -> (t * 'a) Lwt.t) -> (Proof.proof * 'a) Lwt.t + + val verify_proof : + Proof.proof -> + (t -> (t * 'a) Lwt.t) -> + (t * 'a, verifier_error) result Lwt.t + + val hash_of_proof_state : Proof.proof_tree -> kinded_hash end (** {1 Commits} *) @@ -1164,6 +1203,50 @@ module Make (S : Irmin.Generic_key.S) = struct let dump_counters = S.Tree.dump_counters let reset_counters = S.Tree.reset_counters let inspect = S.Tree.inspect + + module Proof = struct + include ( + S.Tree.Proof : + module type of struct + include S.Tree.Proof + end + with type tree := S.Tree.Proof.tree + and type t := S.Tree.Proof.t) + + type proof_tree = S.Tree.Proof.tree = + | Contents of S.contents * S.metadata + | Blinded_contents of S.hash * S.metadata + | Node of (S.step * proof_tree) list + | Blinded_node of S.hash + | Inode of inode_tree inode + | Extender of inode_tree inode_extender + + and inode_tree = S.Tree.Proof.inode_tree = + | Blinded_inode of S.hash + | Inode_values of (S.step * proof_tree) list + | Inode_tree of inode_tree inode + | Inode_extender of inode_tree inode_extender + + type proof = S.Tree.Proof.t + + let v = S.Tree.Proof.v + let before = S.Tree.Proof.before + let after = S.Tree.Proof.after + let state = S.Tree.Proof.state + let to_tree = S.Tree.Proof.to_tree + end + + type verifier_error = [ `Proof_mismatch of string ] + + let produce_proof repo key f = + let f' tree = Lwt_eio.Promise.await_lwt (f tree) in + run_eio (fun () -> S.Tree.produce_proof repo key f') + + let verify_proof proof f = + let f' tree = Lwt_eio.Promise.await_lwt (f tree) in + run_eio (fun () -> S.Tree.verify_proof proof f') + + let hash_of_proof_state = S.Tree.hash_of_proof_state end module Commit = struct diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 554637c301..7ae61d7743 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -645,6 +645,50 @@ module type S = sig | `Node of [ `Map | `Key | `Value | `Portable_dirty | `Pruned ] ] (** [inspect t] is similar to {!val-kind}, with extra state information returned for nodes. Pure: no I/O. *) + + (** {2 Merkle proofs} *) + + (** [Tree.Proof] mirrors [Irmin.Proof.S] for the store's [contents], [hash], + [step] and [metadata]. *) + module Proof : sig + type 'a inode = { length : int; proofs : (int * 'a) list } + type 'a inode_extender = { length : int; segments : int list; proof : 'a } + + type proof_tree = + | Contents of contents * metadata + | Blinded_contents of hash * metadata + | Node of (step * proof_tree) list + | Blinded_node of hash + | Inode of inode_tree inode + | Extender of inode_tree inode_extender + + and inode_tree = + | Blinded_inode of hash + | Inode_values of (step * proof_tree) list + | Inode_tree of inode_tree inode + | Inode_extender of inode_tree inode_extender + + type proof + (** The type for Merkle proofs. *) + + val v : before:kinded_hash -> after:kinded_hash -> proof_tree -> proof + val before : proof -> kinded_hash + val after : proof -> kinded_hash + val state : proof -> proof_tree + val to_tree : proof -> t + end + + type verifier_error = [ `Proof_mismatch of string ] + + val produce_proof : + Repo.t -> kinded_key -> (t -> (t * 'a) Lwt.t) -> (Proof.proof * 'a) Lwt.t + + val verify_proof : + Proof.proof -> + (t -> (t * 'a) Lwt.t) -> + (t * 'a, verifier_error) result Lwt.t + + val hash_of_proof_state : Proof.proof_tree -> kinded_hash end (** {1 Commits} *) From 20fdd6c0b386e765b2900ee1799ae080c0cbf1e2 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:31:04 +0200 Subject: [PATCH 32/40] irmin-lwt: align Tree.Proof type names with upstream (tree, t, irmin_tree) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Match the naming convention of [Irmin.Generic_key.S.Tree.Proof]: the proof tree variant is [tree] (not [proof_tree]) and the proof type is [t] (not [proof]). Following upstream's idiom, the outer [Tree.t] is reachable inside [Proof] as [irmin_tree], a fresh abstract type that gets substituted away as [t] (the parent's [t]) at the end of the [module Proof] signature via [with type irmin_tree := t]. This keeps Octez (and any other consumer) able to reuse code written against [Irmin.Generic_key.S.Tree.Proof] verbatim — same path, same identifiers, same shape. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 38 +++++++++++++++++++------------------ src/irmin-lwt/irmin_lwt.mli | 30 +++++++++++++++-------------- 2 files changed, 36 insertions(+), 32 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 3222434250..445b8fc499 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -619,40 +619,42 @@ module type S = sig type 'a inode = { length : int; proofs : (int * 'a) list } type 'a inode_extender = { length : int; segments : int list; proof : 'a } - type proof_tree = + type tree = | Contents of contents * metadata | Blinded_contents of hash * metadata - | Node of (step * proof_tree) list + | Node of (step * tree) list | Blinded_node of hash | Inode of inode_tree inode | Extender of inode_tree inode_extender and inode_tree = | Blinded_inode of hash - | Inode_values of (step * proof_tree) list + | Inode_values of (step * tree) list | Inode_tree of inode_tree inode | Inode_extender of inode_tree inode_extender - type proof + type t - val v : before:kinded_hash -> after:kinded_hash -> proof_tree -> proof - val before : proof -> kinded_hash - val after : proof -> kinded_hash - val state : proof -> proof_tree - val to_tree : proof -> t + val v : before:kinded_hash -> after:kinded_hash -> tree -> t + val before : t -> kinded_hash + val after : t -> kinded_hash + val state : t -> tree + + type irmin_tree + + val to_tree : t -> irmin_tree end + with type irmin_tree := t type verifier_error = [ `Proof_mismatch of string ] val produce_proof : - Repo.t -> kinded_key -> (t -> (t * 'a) Lwt.t) -> (Proof.proof * 'a) Lwt.t + Repo.t -> kinded_key -> (t -> (t * 'a) Lwt.t) -> (Proof.t * 'a) Lwt.t val verify_proof : - Proof.proof -> - (t -> (t * 'a) Lwt.t) -> - (t * 'a, verifier_error) result Lwt.t + Proof.t -> (t -> (t * 'a) Lwt.t) -> (t * 'a, verifier_error) result Lwt.t - val hash_of_proof_state : Proof.proof_tree -> kinded_hash + val hash_of_proof_state : Proof.tree -> kinded_hash end (** {1 Commits} *) @@ -1213,21 +1215,21 @@ module Make (S : Irmin.Generic_key.S) = struct with type tree := S.Tree.Proof.tree and type t := S.Tree.Proof.t) - type proof_tree = S.Tree.Proof.tree = + type tree = S.Tree.Proof.tree = | Contents of S.contents * S.metadata | Blinded_contents of S.hash * S.metadata - | Node of (S.step * proof_tree) list + | Node of (S.step * tree) list | Blinded_node of S.hash | Inode of inode_tree inode | Extender of inode_tree inode_extender and inode_tree = S.Tree.Proof.inode_tree = | Blinded_inode of S.hash - | Inode_values of (S.step * proof_tree) list + | Inode_values of (S.step * tree) list | Inode_tree of inode_tree inode | Inode_extender of inode_tree inode_extender - type proof = S.Tree.Proof.t + type t = S.Tree.Proof.t let v = S.Tree.Proof.v let before = S.Tree.Proof.before diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 7ae61d7743..c33fd78c83 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -654,41 +654,43 @@ module type S = sig type 'a inode = { length : int; proofs : (int * 'a) list } type 'a inode_extender = { length : int; segments : int list; proof : 'a } - type proof_tree = + type tree = | Contents of contents * metadata | Blinded_contents of hash * metadata - | Node of (step * proof_tree) list + | Node of (step * tree) list | Blinded_node of hash | Inode of inode_tree inode | Extender of inode_tree inode_extender and inode_tree = | Blinded_inode of hash - | Inode_values of (step * proof_tree) list + | Inode_values of (step * tree) list | Inode_tree of inode_tree inode | Inode_extender of inode_tree inode_extender - type proof + type t (** The type for Merkle proofs. *) - val v : before:kinded_hash -> after:kinded_hash -> proof_tree -> proof - val before : proof -> kinded_hash - val after : proof -> kinded_hash - val state : proof -> proof_tree - val to_tree : proof -> t + val v : before:kinded_hash -> after:kinded_hash -> tree -> t + val before : t -> kinded_hash + val after : t -> kinded_hash + val state : t -> tree + + type irmin_tree + + val to_tree : t -> irmin_tree end + with type irmin_tree := t type verifier_error = [ `Proof_mismatch of string ] val produce_proof : - Repo.t -> kinded_key -> (t -> (t * 'a) Lwt.t) -> (Proof.proof * 'a) Lwt.t + Repo.t -> kinded_key -> (t -> (t * 'a) Lwt.t) -> (Proof.t * 'a) Lwt.t val verify_proof : - Proof.proof -> - (t -> (t * 'a) Lwt.t) -> - (t * 'a, verifier_error) result Lwt.t + Proof.t -> (t -> (t * 'a) Lwt.t) -> (t * 'a, verifier_error) result Lwt.t - val hash_of_proof_state : Proof.proof_tree -> kinded_hash + val hash_of_proof_state : Proof.tree -> kinded_hash end (** {1 Commits} *) From 6e8cc528d0960f1000deb84675d430704c493a4b Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:45:07 +0200 Subject: [PATCH 33/40] irmin-lwt: Lwt-wrap tree, to_backend_node, to_backend_portable_node Audit pass against Irmin 3.11's Generic_key.S surface uncovered three top-level signatures that should be Lwt-returning to match the old API exactly: - val tree : t -> tree Lwt.t (was: t -> tree) - val to_backend_node : node -> Backend.Node.value Lwt.t (was: sync) - val to_backend_portable_node : node -> Backend.Node_portable.t Lwt.t These are pure conversion functions in Irmin 4 (no I/O), but Irmin 3 exposed them as Lwt-returning, so consumers expect [let* x = tree t] and [let* v = to_backend_node n]. Wrapping them through [run_eio] restores that ergonomic. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 17 +++++++++++------ src/irmin-lwt/irmin_lwt.mli | 6 +++--- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 445b8fc499..2cfe1cf0e0 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -165,7 +165,7 @@ module type S = sig val of_commit : commit -> t Lwt.t val empty : repo -> t Lwt.t val repo : t -> repo - val tree : t -> tree + val tree : t -> tree Lwt.t val status : t -> [ `Empty | `Branch of branch | `Commit of commit ] (** {2 Reads} *) @@ -458,8 +458,8 @@ module type S = sig (** {2 Backend converters} *) val of_backend_node : repo -> Backend.Node.value -> node - val to_backend_node : node -> Backend.Node.value - val to_backend_portable_node : node -> Backend.Node_portable.t + val to_backend_node : node -> Backend.Node.value Lwt.t + val to_backend_portable_node : node -> Backend.Node_portable.t Lwt.t val to_backend_commit : commit -> Backend.Commit.value val of_backend_commit : @@ -892,8 +892,10 @@ module Make (S : Irmin.Generic_key.S) = struct (* Pure accessors — no I/O, no wrapping needed. *) let repo = S.repo - let tree = S.tree let status = S.status + + (* [tree] reads from the store handle. Lwt-wrapped to match Irmin 3. *) + let tree t = run_eio (fun () -> S.tree t) let find t p = run_eio (fun () -> S.find t p) let find_all t p = run_eio (fun () -> S.find_all t p) let mem t p = run_eio (fun () -> S.mem t p) @@ -1055,8 +1057,11 @@ module Make (S : Irmin.Generic_key.S) = struct (* Backend converters. These are pure. *) let of_backend_node = S.of_backend_node - let to_backend_node = S.to_backend_node - let to_backend_portable_node = S.to_backend_portable_node + let to_backend_node n = run_eio (fun () -> S.to_backend_node n) + + let to_backend_portable_node n = + run_eio (fun () -> S.to_backend_portable_node n) + let to_backend_commit = S.to_backend_commit let of_backend_commit = S.of_backend_commit diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index c33fd78c83..92292c47c2 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -179,7 +179,7 @@ module type S = sig val of_commit : commit -> t Lwt.t val empty : repo -> t Lwt.t val repo : t -> repo - val tree : t -> tree + val tree : t -> tree Lwt.t val status : t -> [ `Empty | `Branch of branch | `Commit of commit ] (** {2 Reads} *) @@ -472,8 +472,8 @@ module type S = sig (** {2 Backend converters} *) val of_backend_node : repo -> Backend.Node.value -> node - val to_backend_node : node -> Backend.Node.value - val to_backend_portable_node : node -> Backend.Node_portable.t + val to_backend_node : node -> Backend.Node.value Lwt.t + val to_backend_portable_node : node -> Backend.Node_portable.t Lwt.t val to_backend_commit : commit -> Backend.Commit.value val of_backend_commit : From b78eab714e190396479d7e90cd2ba2e3d55ee6cc Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:46:16 +0200 Subject: [PATCH 34/40] irmin-lwt: rename Tree.force_lwt and Tree.folder_lwt to upstream names MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Both Irmin 3 and Irmin 4 name these types [force] and [folder] (only the callback signatures differ between the two). The [_lwt] suffix I introduced was a disambiguation that turned out to be unhelpful: it makes the irmin-lwt API gratuitously different from upstream and forces consumers to rename when porting from Irmin 3. type 'a force_lwt → type 'a force type ('a, 'b) folder_lwt → type ('a, 'b) folder The shape of the types is identical to Irmin 3's [force] and [folder]; the wrapping happens at the callback level (callbacks are Lwt-returning). Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 22 +++++++++++----------- src/irmin-lwt/irmin_lwt.mli | 16 ++++++++-------- 2 files changed, 19 insertions(+), 19 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 2cfe1cf0e0..dede13b587 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -498,9 +498,9 @@ module type S = sig type concrete = [ `Tree of (step * concrete) list | `Contents of contents * metadata ] - type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + type 'a force = [ `True | `False of path -> 'a -> 'a Lwt.t ] type uniq = [ `False | `True | `Marks of marks ] - type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type ('a, 'b) folder = path -> 'b -> 'a -> 'a Lwt.t type error = [ `Dangling_hash of hash | `Pruned_hash of hash | `Portable_value ] @@ -589,15 +589,15 @@ module type S = sig val fold : ?order:[ `Sorted | `Undefined | `Random of Random.State.t ] -> - ?force:'a force_lwt -> + ?force:'a force -> ?cache:bool -> ?uniq:uniq -> - ?pre:('a, step list) folder_lwt -> - ?post:('a, step list) folder_lwt -> + ?pre:('a, step list) folder -> + ?post:('a, step list) folder -> ?depth:depth -> - ?contents:('a, contents) folder_lwt -> - ?node:('a, node) folder_lwt -> - ?tree:('a, t) folder_lwt -> + ?contents:('a, contents) folder -> + ?node:('a, node) folder -> + ?tree:('a, t) folder -> t -> 'a -> 'a Lwt.t @@ -1174,14 +1174,14 @@ module Make (S : Irmin.Generic_key.S) = struct let empty_marks = S.Tree.empty_marks - type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + type 'a force = [ `True | `False of path -> 'a -> 'a Lwt.t ] type uniq = [ `False | `True | `Marks of marks ] - type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type ('a, 'b) folder = path -> 'b -> 'a -> 'a Lwt.t type depth = S.Tree.depth let lift_folder = function | None -> None - | Some (f : _ folder_lwt) -> + | Some (f : _ folder) -> Some (fun path b acc -> Lwt_eio.Promise.await_lwt (f path b acc)) let lift_force = function diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 92292c47c2..2f087ab887 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -516,9 +516,9 @@ module type S = sig type concrete = [ `Tree of (step * concrete) list | `Contents of contents * metadata ] - type 'a force_lwt = [ `True | `False of path -> 'a -> 'a Lwt.t ] + type 'a force = [ `True | `False of path -> 'a -> 'a Lwt.t ] type uniq = [ `False | `True | `Marks of marks ] - type ('a, 'b) folder_lwt = path -> 'b -> 'a -> 'a Lwt.t + type ('a, 'b) folder = path -> 'b -> 'a -> 'a Lwt.t type error = [ `Dangling_hash of hash | `Pruned_hash of hash | `Portable_value ] @@ -614,15 +614,15 @@ module type S = sig val fold : ?order:[ `Sorted | `Undefined | `Random of Random.State.t ] -> - ?force:'a force_lwt -> + ?force:'a force -> ?cache:bool -> ?uniq:uniq -> - ?pre:('a, step list) folder_lwt -> - ?post:('a, step list) folder_lwt -> + ?pre:('a, step list) folder -> + ?post:('a, step list) folder -> ?depth:depth -> - ?contents:('a, contents) folder_lwt -> - ?node:('a, node) folder_lwt -> - ?tree:('a, t) folder_lwt -> + ?contents:('a, contents) folder -> + ?node:('a, node) folder -> + ?tree:('a, t) folder -> t -> 'a -> 'a Lwt.t From 72809819d30dedcac7fde5409f3bed5293d98a54 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:53:50 +0200 Subject: [PATCH 35/40] irmin-lwt: add Sync functor and top-level remote_store [Irmin_lwt.Sync.Make (X : Irmin.Generic_key.S)] mirrors [Irmin.Sync.Make] but with Lwt-wrapped operations: [fetch], [fetch_exn], [pull], [pull_exn], [push], [push_exn]. Errors are exposed transparently: type pull_error = [ `Msg of string | Irmin.Merge.conflict ] type push_error = [ `Msg of string | `Detached_head ] [remote_store] is forwarded as-is from [Irmin.remote_store] (pure). Useful for any consumer that synchronises with a remote Irmin store. Co-Authored-By: Claude Opus 4.6 (1M context) --- src/irmin-lwt/irmin_lwt.ml | 75 +++++++++++++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 58 ++++++++++++++++++++++++++++ 2 files changed, 133 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index dede13b587..16eaf0b844 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -1394,3 +1394,78 @@ module Pack = struct end end end + +module Sync = struct + module type S = sig + type db + type commit + type status = [ `Empty | `Head of commit ] + type info + + val status_t : db -> status Irmin.Type.t + val pp_status : status Fmt.t + + val fetch : + db -> + ?depth:int -> + Irmin.remote -> + (status, [ `Msg of string ]) result Lwt.t + + val fetch_exn : db -> ?depth:int -> Irmin.remote -> status Lwt.t + + type pull_error = [ `Msg of string | Irmin.Merge.conflict ] + + val pp_pull_error : pull_error Fmt.t + + val pull : + db -> + ?depth:int -> + Irmin.remote -> + [ `Merge of unit -> info | `Set ] -> + (status, pull_error) result Lwt.t + + val pull_exn : + db -> + ?depth:int -> + Irmin.remote -> + [ `Merge of unit -> info | `Set ] -> + status Lwt.t + + type push_error = [ `Msg of string | `Detached_head ] + + val pp_push_error : push_error Fmt.t + + val push : + db -> ?depth:int -> Irmin.remote -> (status, push_error) result Lwt.t + + val push_exn : db -> ?depth:int -> Irmin.remote -> status Lwt.t + end + + module Make (X : Irmin.Generic_key.S) = struct + module S = Irmin.Sync.Make (X) + + type db = X.t + type commit = X.commit + type status = [ `Empty | `Head of commit ] + type info = X.info + + let status_t = S.status_t + let pp_status = S.pp_status + let fetch db ?depth r = run_eio (fun () -> S.fetch db ?depth r) + let fetch_exn db ?depth r = run_eio (fun () -> S.fetch_exn db ?depth r) + + type pull_error = S.pull_error + + let pp_pull_error = S.pp_pull_error + let pull db ?depth r s = run_eio (fun () -> S.pull db ?depth r s) + let pull_exn db ?depth r s = run_eio (fun () -> S.pull_exn db ?depth r s) + + type push_error = S.push_error + + let pp_push_error = S.pp_push_error + let push db ?depth r = run_eio (fun () -> S.push db ?depth r) + let push_exn db ?depth r = run_eio (fun () -> S.push_exn db ?depth r) + end +end + +let remote_store = Irmin.remote_store diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 2f087ab887..0111f1e464 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -937,3 +937,61 @@ module Pack : sig end end end + +(** {1 Native Synchronisation} + + Lwt wrappers for [Irmin.Sync]. Mirrors the Irmin 3 API exactly. *) +module Sync : sig + module type S = sig + type db + type commit + type status = [ `Empty | `Head of commit ] + type info + + val status_t : db -> status Irmin.Type.t + val pp_status : status Fmt.t + + val fetch : + db -> + ?depth:int -> + Irmin.remote -> + (status, [ `Msg of string ]) result Lwt.t + + val fetch_exn : db -> ?depth:int -> Irmin.remote -> status Lwt.t + + type pull_error = [ `Msg of string | Irmin.Merge.conflict ] + + val pp_pull_error : pull_error Fmt.t + + val pull : + db -> + ?depth:int -> + Irmin.remote -> + [ `Merge of unit -> info | `Set ] -> + (status, pull_error) result Lwt.t + + val pull_exn : + db -> + ?depth:int -> + Irmin.remote -> + [ `Merge of unit -> info | `Set ] -> + status Lwt.t + + type push_error = [ `Msg of string | `Detached_head ] + + val pp_push_error : push_error Fmt.t + + val push : + db -> ?depth:int -> Irmin.remote -> (status, push_error) result Lwt.t + + val push_exn : db -> ?depth:int -> Irmin.remote -> status Lwt.t + end + + module Make (X : Irmin.Generic_key.S) : + S with type db = X.t and type commit = X.commit and type info = X.info +end + +val remote_store : + (module Irmin.Generic_key.S with type t = 'a) -> 'a -> Irmin.remote +(** [remote_store t] is the remote corresponding to the local store [t]. + Forwarding from [Irmin.remote_store]; pure (no Lwt). *) From 3fac4c7875922c791bde6051e85a0bf95035d96c Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 15:57:39 +0200 Subject: [PATCH 36/40] irmin-lwt: add Json_tree and Dot Lwt wrappers for [Irmin.Json_tree] and [Irmin.Dot], matching the Irmin 3.11 surface. Json_tree takes [Irmin.S] (its upstream constraint where contents_key = hash); Dot takes [Generic_key.S]. --- src/irmin-lwt/irmin_lwt.ml | 23 +++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 35 +++++++++++++++++++++++++++++++++++ 2 files changed, 58 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 16eaf0b844..4f26aa6243 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -1469,3 +1469,26 @@ module Sync = struct end let remote_store = Irmin.remote_store + +module Json_tree + (Store : Irmin.S with type Schema.Contents.t = Irmin.Contents.json) = +struct + module J = Irmin.Json_tree (Store) + include (J : Irmin.Contents.S with type t = Irmin.Contents.json) + + let to_concrete_tree = J.to_concrete_tree + let of_concrete_tree = J.of_concrete_tree + let get_tree tree path = run_eio (fun () -> J.get_tree tree path) + let set_tree tree path v = run_eio (fun () -> J.set_tree tree path v) + let get t path = run_eio (fun () -> J.get t path) + let set t path v ~info = run_eio (fun () -> J.set t path v ~info) +end + +module Dot (S : Irmin.Generic_key.S) = struct + module D = Irmin.Dot (S) + + type db = S.t + + let output_buffer db ?html ?depth ?full ~date buf = + run_eio (fun () -> D.output_buffer db ?html ?depth ?full ~date buf) +end diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 0111f1e464..b1e3a19dac 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -995,3 +995,38 @@ val remote_store : (module Irmin.Generic_key.S with type t = 'a) -> 'a -> Irmin.remote (** [remote_store t] is the remote corresponding to the local store [t]. Forwarding from [Irmin.remote_store]; pure (no Lwt). *) + +(** {1 JSON-as-tree projections} + + Lwt wrapper for [Irmin.Json_tree]. Extracts and projects JSON values onto a + tree or store at a given path. *) +module Json_tree : functor + (Store : Irmin.S with type Schema.Contents.t = Irmin.Contents.json) + -> sig + include Irmin.Contents.S with type t = Irmin.Contents.json + + val to_concrete_tree : t -> Store.Tree.concrete + val of_concrete_tree : Store.Tree.concrete -> t + val get_tree : Store.tree -> Store.path -> t Lwt.t + val set_tree : Store.tree -> Store.path -> t -> Store.tree Lwt.t + val get : Store.t -> Store.path -> t Lwt.t + + val set : + Store.t -> Store.path -> t -> info:(unit -> Store.info) -> unit Lwt.t +end + +(** {1 Graphviz output} + + Lwt wrapper for [Irmin.Dot]. *) +module Dot : functor (S : Irmin.Generic_key.S) -> sig + type db = S.t + + val output_buffer : + db -> + ?html:bool -> + ?depth:int -> + ?full:bool -> + date:(int64 -> string) -> + Buffer.t -> + unit Lwt.t +end From 218ff85019badaac42cf0e6adf1f41e77adfaba0 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Mon, 27 Apr 2026 16:03:12 +0200 Subject: [PATCH 37/40] irmin-lwt: add S_simple, KV, Maker, KV_maker module types Lwt-flavoured counterparts of [Irmin.S], [Irmin.KV], [Irmin.Maker], and [Irmin.KV_maker] so downstream code can declare interfaces and functor parameters in the same shape as Irmin 3. [Maker.Make] and [KV_maker.Make] produce [S] (the generic-keyed Lwt signature) with hash-equal-to-key constraints, matching upstream [Irmin.Maker] which produces [S_generic_key] with the same equalities. --- src/irmin-lwt/irmin_lwt.ml | 51 +++++++++++++++++++++++++++++ src/irmin-lwt/irmin_lwt.mli | 65 +++++++++++++++++++++++++++++++++++++ 2 files changed, 116 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 4f26aa6243..021c39616a 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -775,6 +775,57 @@ module type S = sig val commit_t : repo -> commit Irmin.Type.t end +module type S_simple = sig + type hash + + include + S + with type Schema.Hash.t = hash + and type hash := hash + and type contents_key = hash + and type node_key = hash + and type commit_key = hash +end + +module type KV = + S_simple + with type Schema.Path.step = string + and type Schema.Path.t = string list + and type Schema.Branch.t = string + +module type Maker = sig + type endpoint + + module Make (Schema : Irmin.Schema.S) : + S + with module Schema = Schema + and type Backend.Remote.endpoint = endpoint + and type contents_key = Schema.Hash.t + and type node_key = Schema.Hash.t + and type commit_key = Schema.Hash.t +end + +module type KV_maker = sig + type endpoint + type metadata + type info + type hash + + module Make (C : Irmin.Contents.S) : + S + with module Schema.Contents = C + and type Schema.Metadata.t = metadata + and type Schema.Hash.t = hash + and type Schema.Info.t = info + and type Schema.Path.step = string + and type Schema.Path.t = string list + and type Schema.Branch.t = string + and type Backend.Remote.endpoint = endpoint + and type contents_key = hash + and type node_key = hash + and type commit_key = hash +end + module Make (S : Irmin.Generic_key.S) = struct type repo = S.repo type t = S.t diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index b1e3a19dac..0bc77195a6 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -811,6 +811,71 @@ module type S = sig val commit_t : repo -> commit Irmin.Type.t end +(** {1 Convenience module types} + + Lwt-flavoured counterparts of [Irmin.S], [Irmin.KV], [Irmin.Maker], and + [Irmin.KV_maker]. They let downstream code declare interfaces and functor + parameters in the same shape as Irmin 3. *) + +(** Counterpart of [Irmin.S]: a store whose contents, node, and commit keys are + all the schema's hash type. *) +module type S_simple = sig + type hash + + include + S + with type Schema.Hash.t = hash + and type hash := hash + and type contents_key = hash + and type node_key = hash + and type commit_key = hash +end + +(** Counterpart of [Irmin.KV]: an [S_simple] with [string]-keyed paths and + branches. *) +module type KV = + S_simple + with type Schema.Path.step = string + and type Schema.Path.t = string list + and type Schema.Branch.t = string + +(** Counterpart of [Irmin.Maker]: the type-level signature of a + hash-keyed-store-producing functor parametrised by a [Schema]. *) +module type Maker = sig + type endpoint + + module Make (Schema : Irmin.Schema.S) : + S + with module Schema = Schema + and type Backend.Remote.endpoint = endpoint + and type contents_key = Schema.Hash.t + and type node_key = Schema.Hash.t + and type commit_key = Schema.Hash.t +end + +(** Counterpart of [Irmin.KV_maker]: the type-level signature of a hash-keyed + string-pathed-store-producing functor parametrised by [Contents]. *) +module type KV_maker = sig + type endpoint + type metadata + type info + type hash + + module Make (C : Irmin.Contents.S) : + S + with module Schema.Contents = C + and type Schema.Metadata.t = metadata + and type Schema.Hash.t = hash + and type Schema.Info.t = info + and type Schema.Path.step = string + and type Schema.Path.t = string list + and type Schema.Branch.t = string + and type Backend.Remote.endpoint = endpoint + and type contents_key = hash + and type node_key = hash + and type commit_key = hash +end + module Make (S : Irmin.Generic_key.S) : S with module Schema = S.Schema From b7e3255198c4ba312769181d696e5580984c19ea Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Tue, 28 Apr 2026 10:26:00 +0200 Subject: [PATCH 38/40] irmin-lwt: Lwt-wrap Repo.default_pred_commit/node/contents These three reference predecessor functions were exposed without an Lwt.t wrapping, breaking the Irmin 3.11 signature where they all return [elt list Lwt.t]. Client code feeding them as ?pred_commit / ?pred_node / ?pred_contents callbacks to [Repo.iter] would not type-check. --- src/irmin-lwt/irmin_lwt.ml | 16 ++++++++++------ src/irmin-lwt/irmin_lwt.mli | 6 +++--- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 021c39616a..a5c54dfc0c 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -113,9 +113,9 @@ module type S = sig slice Lwt.t val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t - val default_pred_commit : t -> commit_key -> elt list - val default_pred_node : t -> node_key -> elt list - val default_pred_contents : t -> contents_key -> elt list + val default_pred_commit : t -> commit_key -> elt list Lwt.t + val default_pred_node : t -> node_key -> elt list Lwt.t + val default_pred_contents : t -> contents_key -> elt list Lwt.t val iter : ?cache_size:int -> @@ -884,9 +884,13 @@ module Make (S : Irmin.Generic_key.S) = struct let import t s = run_eio (fun () -> S.Repo.import t s) (* Pure: no lazy loading. *) - let default_pred_commit = S.Repo.default_pred_commit - let default_pred_node = S.Repo.default_pred_node - let default_pred_contents = S.Repo.default_pred_contents + let default_pred_commit t k = + run_eio (fun () -> S.Repo.default_pred_commit t k) + + let default_pred_node t k = run_eio (fun () -> S.Repo.default_pred_node t k) + + let default_pred_contents t k = + run_eio (fun () -> S.Repo.default_pred_contents t k) (* Helpers to bridge the Lwt-returning callbacks of [iter] and [breadth_first_traversal] to the direct-style callbacks that the diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 0bc77195a6..6fcd7ba7a4 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -127,9 +127,9 @@ module type S = sig slice Lwt.t val import : t -> slice -> (unit, [ `Msg of string ]) result Lwt.t - val default_pred_commit : t -> commit_key -> elt list - val default_pred_node : t -> node_key -> elt list - val default_pred_contents : t -> contents_key -> elt list + val default_pred_commit : t -> commit_key -> elt list Lwt.t + val default_pred_node : t -> node_key -> elt list Lwt.t + val default_pred_contents : t -> contents_key -> elt list Lwt.t val iter : ?cache_size:int -> From 9e9fa6dd5aa456c02bdbf9a5a867acf89372d081 Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Tue, 28 Apr 2026 10:28:03 +0200 Subject: [PATCH 39/40] irmin-lwt: declare Closeable trait and use it in S.Repo Mirror Irmin 3.11's [Repo] signature, which exposes its [val close] through [include Closeable with type _ t := t] rather than as a free [val close]. The visible signature is unchanged for clients reading fields directly, but [module M : Irmin_lwt.Closeable = ...]-style constraints now type-check against [Repo]. --- src/irmin-lwt/irmin_lwt.ml | 10 +++++++++- src/irmin-lwt/irmin_lwt.mli | 15 ++++++++++++++- 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index a5c54dfc0c..7a7c9d7eae 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -15,6 +15,12 @@ let run_with_env env f = Lwt_eio.with_event_loop ~clock:env#clock @@ fun _ -> Lwt_eio.Promise.await_lwt (f ()) +module type Closeable = sig + type 'a t + + val close : 'a t -> unit Lwt.t +end + module type S = sig (** {1 Schema} *) @@ -99,7 +105,9 @@ module type S = sig val elt_t : elt Irmin.Type.t val v : Irmin.Backend.Conf.t -> t Lwt.t - val close : t -> unit Lwt.t + + include Closeable with type _ t := t + val heads : t -> commit list Lwt.t val branches : t -> branch list Lwt.t val config : t -> Irmin.Backend.Conf.t diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index 6fcd7ba7a4..beeb0388d5 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -19,6 +19,16 @@ val run_with_env : < clock : _ Eio.Time.clock ; .. > -> (unit -> 'a Lwt.t) -> 'a instead of calling [Eio_main.run] internally. Useful when the client is already inside an Eio event loop. *) +(** Lwt-flavoured counterpart of the internal [Irmin.Closeable] trait: a single + [close] operation that releases the resources held by a handle. Used as + [include Closeable with type _ t := t] in [S.Repo] to mirror the Irmin 3 + [Repo] signature. *) +module type Closeable = sig + type 'a t + + val close : 'a t -> unit Lwt.t +end + (** The Lwt-flavoured counterpart of [Irmin.Generic_key.S]. Every I/O-triggering operation of [Irmin.Generic_key.S] is replaced by a @@ -113,7 +123,10 @@ module type S = sig val elt_t : elt Irmin.Type.t val v : Irmin.Backend.Conf.t -> t Lwt.t - val close : t -> unit Lwt.t + + include Closeable with type _ t := t + (** @inline *) + val heads : t -> commit list Lwt.t val branches : t -> branch list Lwt.t val config : t -> Irmin.Backend.Conf.t From ec7be0fdd8ef5786edd1e14d7b996f2907b1f9af Mon Sep 17 00:00:00 2001 From: Vincent Balat Date: Tue, 28 Apr 2026 11:22:08 +0200 Subject: [PATCH 40/40] irmin-lwt: include Irmin.Branch.S in S.Branch Mirror the Irmin 3.11 [S.Branch] signature, which terminates with [include Branch.S with type t = branch] to expose [val main], [val is_valid], and [val t : t Irmin.Type.t] alongside the I/O functions. Without this, [Store.Branch.main] is unreachable through [Irmin_lwt.S.Branch]. --- src/irmin-lwt/irmin_lwt.ml | 6 ++++++ src/irmin-lwt/irmin_lwt.mli | 3 +++ 2 files changed, 9 insertions(+) diff --git a/src/irmin-lwt/irmin_lwt.ml b/src/irmin-lwt/irmin_lwt.ml index 7a7c9d7eae..ad6cb0b6e5 100644 --- a/src/irmin-lwt/irmin_lwt.ml +++ b/src/irmin-lwt/irmin_lwt.ml @@ -716,6 +716,8 @@ module type S = sig ?init:(t * commit) list -> (t -> commit Irmin.Diff.t -> unit Lwt.t) -> watch Lwt.t + + include Irmin.Branch.S with type t := branch end (** {1 Heads} *) @@ -1358,6 +1360,10 @@ module Make (S : Irmin.Generic_key.S) = struct let watch_all r ?init lwt_cb = let cb br diff = Lwt_eio.Promise.await_lwt (lwt_cb br diff) in run_eio (fun () -> S.Branch.watch_all r ?init cb) + + let main = S.Branch.main + let is_valid = S.Branch.is_valid + let t = S.Branch.t end module Head = struct diff --git a/src/irmin-lwt/irmin_lwt.mli b/src/irmin-lwt/irmin_lwt.mli index beeb0388d5..9cbe272a93 100644 --- a/src/irmin-lwt/irmin_lwt.mli +++ b/src/irmin-lwt/irmin_lwt.mli @@ -757,6 +757,9 @@ module type S = sig ?init:(t * commit) list -> (t -> commit Irmin.Diff.t -> unit Lwt.t) -> watch Lwt.t + + include Irmin.Branch.S with type t := branch + (** @inline *) end (** {1 Heads} *)