Merge pull request #1839 from metanivek/toplevel_printers

irmin: add pretty-printers to high-level Store that work with `utop`

CHANGES.md

@@ -7,6 +7,9 @@
 - **irmin-client**
   - Added `irmin-client` package to connect to `irmin-server` instances (#2031,
     @zshipko)
+- **irmin**
+  - Add pretty printers for `Commit`, `Tree`, `Info`, `Status`, `Branch` when
+    using `utop` (@metanivek, #1839)
 
 ### Fixed
 

src/irmin/store.ml

@@ -41,9 +41,14 @@ module Make (B : Backend.S) = struct
   module Path = B.Node.Path
   module Commits = Commit.History (B.Commit)
   module Backend = B
-  module Info = B.Commit.Info
   module T = Tree.Make (B)
 
+  module Info = struct
+    include B.Commit.Info
+
+    let pp = Type.pp t
+  end
+
   module Contents = struct
     include B.Contents.Val
     module H = Typed (B.Contents.Val)
@@ -94,6 +99,8 @@ module Make (B : Backend.S) = struct
     let hash : ?cache:bool -> t -> hash =
      fun ?cache tr ->
       match hash ?cache tr with `Node h -> h | `Contents (h, _) -> h
+
+    let pp = Type.pp t
   end
 
   type branch = Branch_store.Key.t [@@deriving irmin ~equal ~pp]
@@ -109,7 +116,7 @@ module Make (B : Backend.S) = struct
   type tree = Tree.t [@@deriving irmin ~pp]
   type path = Path.t [@@deriving irmin ~pp]
   type step = Path.step [@@deriving irmin]
-  type info = B.Commit.Info.t [@@deriving irmin]
+  type info = Info.t [@@deriving irmin]
   type Remote.t += E of B.Remote.endpoint
   type lca_error = [ `Max_depth_reached | `Too_many_lcas ] [@@deriving irmin]
   type ff_error = [ `Rejected | `No_change | lca_error ]
@@ -186,6 +193,7 @@ module Make (B : Backend.S) = struct
     let parents t = B.Commit.Val.parents t.v
     let pp_hash ppf t = Type.pp Hash.t ppf (hash t)
     let pp_key ppf t = Type.pp B.Commit.Key.t ppf t.key
+    let pp ppf commit = Type.pp (t commit.r) ppf commit
 
     let of_key r key =
       B.Commit.find (B.Repo.commit_t r) key >|= function
@@ -1214,6 +1222,8 @@ module Make (B : Backend.S) = struct
 
     let get t k =
       find t k >>= function None -> err_not_found k | Some v -> Lwt.return v
+
+    let pp = pp_branch
   end
 
   module Status = struct

src/irmin/store_intf.ml

@@ -88,6 +88,10 @@ module type S_generic_key = sig
   module Info : sig
     include Info.S with type t = info
     (** @inline *)
+
+    val pp : t Fmt.t
+    [@@ocaml.toplevel_printer]
+    (** [pp] is a pretty-printer for info. *)
   end
 
   type contents_key [@@deriving irmin]
@@ -264,6 +268,7 @@ module type S_generic_key = sig
     (** [t] is the value type for {!type-t}. *)
 
     val pp : t Fmt.t
+    [@@ocaml.toplevel_printer]
     (** [pp] is the pretty-printer for store status. *)
   end
 
@@ -340,7 +345,11 @@ module type S_generic_key = sig
     (** [t] is the value type for {!type-t}. *)
 
     val pp_hash : t Fmt.t
-    (** [pp] is the pretty-printer for commit. Display only the hash. *)
+    (** [pp_hash] is a pretty-printer for a commit. Displays only the hash. *)
+
+    val pp : t Fmt.t
+    [@@ocaml.toplevel_printer]
+    (** [pp] is a full pretty-printer for a commit. Displays all information. *)
 
     val v :
       ?clear:bool ->
@@ -421,6 +430,10 @@ module type S_generic_key = sig
          and type node := node
          and type hash := hash
 
+    val pp : tree Type.pp
+    [@@ocaml.toplevel_printer]
+    (** [pp] is a pretty-printer for a tree. *)
+
     (** {1 Import/Export} *)
 
     type kinded_key =
@@ -1070,6 +1083,10 @@ module type S_generic_key = sig
     (** [watch_all t f] calls [f] on every branch-related change in [t],
         including creation/deletion events. *)
 
+    val pp : branch Fmt.t
+    [@@ocaml.toplevel_printer]
+    (** [pp] is a pretty-printer for a branch. *)
+
     include Branch.S with type t = branch
     (** Base functions for branches. *)
   end