Skip to content

Commit

Permalink
irmin: add pretty-printers to high-level Store
Browse files Browse the repository at this point in the history
  • Loading branch information
metanivek committed Jun 12, 2023
1 parent 3222d26 commit 9cedf1e
Show file tree
Hide file tree
Showing 2 changed files with 30 additions and 3 deletions.
14 changes: 12 additions & 2 deletions src/irmin/store.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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]
Expand All @@ -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 ]
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
19 changes: 18 additions & 1 deletion src/irmin/store_intf.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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]
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 ->
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 9cedf1e

Please sign in to comment.