diff --git a/CHANGES.md b/CHANGES.md index 08f38e5efe..452feacbc6 100644 --- a/CHANGES.md +++ b/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 diff --git a/src/irmin/store.ml b/src/irmin/store.ml index d2c5002214..b73edf07bd 100644 --- a/src/irmin/store.ml +++ b/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 diff --git a/src/irmin/store_intf.ml b/src/irmin/store_intf.ml index ef51974e3d..7d0f3714f0 100644 --- a/src/irmin/store_intf.ml +++ b/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