Merge pull request #2227 from samoht/conf

Add Conf.pp and Conf.equal

CHANGES.md

@@ -2,6 +2,10 @@
 
 ### Added
 
+- **irmin**
+  - Add `Conf.pp` and `Conf.equal` to print and compare configuration values
+    (#2227, @samoht)
+
 - **irmin-pack**
   - Add configuration option, `lower_root`, to specify a path for archiving data
     during a GC. (#2177, @metanivek)
@@ -33,7 +37,7 @@
   - Unhandled exceptions in GC worker process are now reported as a failure
     (#2163, @metanivek)
   - Fix the silent mode for the integrity checks. (#2179, @icristescu)
-  
+
 ## 3.6.1 (2023-03-15)
 
 ### Fixed
@@ -47,7 +51,7 @@
 
 - **irmin-pack**
   - Clear LRU when calling `reload` after a GC (#2200, @metanivek)
-  
+
 ## 3.6.0 (2023-02-16)
 
 ### Changed

src/irmin/conf.ml

@@ -14,6 +14,7 @@
  * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  *)
+open! Import
 
 module Univ = struct
   type t = exn
@@ -141,6 +142,24 @@ let get (_, d) k =
 let keys (_, conf) = M.to_seq conf |> Seq.map (fun (k, _) -> k)
 let with_spec (_, conf) spec = (spec, conf)
 
+let to_strings (_, conf) =
+  conf
+  |> M.to_seq
+  |> Seq.map (fun (K k, v) ->
+         ( k.name,
+           match k.of_univ v with
+           | Some v -> Type.to_string k.ty v
+           | None -> assert false ))
+
+let pp ppf t =
+  t |> to_strings |> List.of_seq |> Fmt.Dump.(list (pair string string)) ppf
+
+let equal t1 t2 =
+  t1 == t2
+  || Seq.for_all2
+       (fun (k1, v1) (k2, v2) -> String.equal k1 k2 && String.equal v1 v2)
+       (to_strings t1) (to_strings t2)
+
 (* ~root *)
 let root spec =
   key ~spec ~docv:"ROOT" ~doc:"The location of the Irmin store on disk."

src/irmin/conf.mli

@@ -108,6 +108,13 @@ val root : Spec.t -> string key
 type t
 (** The type for configurations. *)
 
+val pp : t Fmt.t
+(** [pp] is the pretty printer for configuration values. *)
+
+val equal : t -> t -> bool
+(** [equal] is the equality for configuration values. Two values are equal if
+    they have the same [pp] representation. *)
+
 val spec : t -> Spec.t
 (** [spec c] is the specification associated with [c] *)
 

src/irmin/import.ml

@@ -132,6 +132,15 @@ module Seq = struct
     match seq1 () with
     | Nil -> seq2 ()
     | Cons (x, next) -> Cons (x, append next seq2)
+
+  (* Since 4.14 *)
+  let rec for_all2 f xs ys =
+    match xs () with
+    | Nil -> true
+    | Cons (x, xs) -> (
+        match ys () with
+        | Nil -> true
+        | Cons (y, ys) -> f x y && for_all2 f xs ys)
 end
 
 let shuffle state arr =