Merge pull request #12256 from Alizter/rev-store-cleanup

rev_store: document and improve API

Author: Alizter

src/dune_pkg/opamUrl0.ml

@@ -46,7 +46,7 @@ let classify url loc =
 
 include Comparable.Make (T)
 
-let remote t ~loc rev_store = Rev_store.remote rev_store ~url:(loc, OpamUrl.base_url t)
+let remote t ~loc rev_store = Rev_store.remote rev_store ~loc ~url:(OpamUrl.base_url t)
 
 type resolve =
   | Resolved of Rev_store.Object.resolved

src/dune_pkg/rev_store.ml

@@ -128,12 +128,20 @@ module File = struct
 end
 
 module Remote = struct
-  type nonrec t =
+  type t =
     { url : string
     ; default_branch : Object.resolved option Fiber.t
     ; refs : Object.resolved String.Map.t Fiber.t
     }
 
+  let to_dyn { url; default_branch; refs } =
+    Dyn.record
+      [ "url", Dyn.string url
+      ; "default_branch", Dyn.opaque default_branch
+      ; "refs", Dyn.opaque refs
+      ]
+  ;;
+
   let default_branch t = t.default_branch
 end
 
@@ -145,6 +153,18 @@ type t =
   ; present_objects : (Object.t, unit) Table.t
   }
 
+let to_dyn { dir; remotes; object_mutexes; present_objects } =
+  Dyn.record
+    [ (* This is an external path, so we relativize to sanitize. We don't use
+         [Path.to_dyn] since it wouldn't be correct and therefore confusing. *)
+      "dir", Path.Expert.try_localize_external dir |> Path.to_string |> Dyn.string
+    ; "remotes", Table.to_list remotes |> Dyn.list (Dyn.pair Dyn.string Remote.to_dyn)
+    ; "object_mutexes", Dyn.opaque object_mutexes
+    ; ( "present_objects"
+      , Table.to_list present_objects |> Dyn.list (Dyn.pair Object.to_dyn Dyn.unit) )
+    ]
+;;
+
 let with_mutex t obj ~f =
   let* () = Fiber.return () in
   let mutex =
@@ -843,7 +863,7 @@ let remote =
   let head_mark, head = Re.mark (Re.str "HEAD") in
   let ref = Re.(group (seq [ str "refs/"; rep1 any ])) in
   let re = Re.(compile @@ seq [ bol; group hash; rep1 space; alt [ head; ref ] ]) in
-  fun t ~url:(url_loc, url) ->
+  fun t ~loc:url_loc ~url ->
     let f url =
       let command = [ "ls-remote"; url ] in
       let refs =

src/dune_pkg/rev_store.mli

@@ -1,9 +1,32 @@
 open Stdune
 
+(** * The Revision Store
+
+The revision store is a single shared bare Git repository acting as a cache for
+packages and package repositories.
+
+Git is used as a content-addressable file system. File content of both package
+repositories and opam repositories live here. Having a single place
+is advantageous because it saves space.
+
+Dune is able to lookup any stored Git repository by its revision and see all
+the files that exist within. Those files can then have their contents
+fetched. *)
+
+(** Abstract handle to the shared revision store. *)
 type t
 
+val to_dyn : t -> Dyn.t
+
+(** Get the revision store and initialise if it hasn't been already. *)
+val get : t Fiber.t
+
+(* CR-soon Alizter: Remove this when we are able to set the XDG_HOME
+   directories in the tests. *)
+val load_or_create : dir:Path.t -> t Fiber.t
+
 module Object : sig
-  (** A git object that can exist in storage *)
+  (** A git object that can exist in storage. *)
   type t
 
   (** An object that definitely exists in the storage, but might still not be
@@ -12,44 +35,84 @@ module Object : sig
 
   val of_sha1 : string -> t option
   val to_hex : t -> string
-  val equal : t -> t -> bool
-  val to_dyn : t -> Dyn.t
 end
 
 module File : sig
+  (** A file entry at a particular revision. May be a direct blob or a redirect
+      into a submodules file. *)
   type t
 
-  val path : t -> Path.Local.t
   val to_dyn : t -> Dyn.t
 
+  (** Path relative to the repository root at the given revision. *)
+  val path : t -> Path.Local.t
+
   module Set : Set.S with type elt = t
 end
 
+(** [content_of_files t files] fetches the content of a list of [files] in one
+    batch. It returns a list of strings consisting of the content of the
+    corresponding files. *)
+val content_of_files : t -> File.t list -> string list Fiber.t
+
+module Remote : sig
+  (** A git remote repository known to the revision store. *)
+  type t
+
+  val to_dyn : t -> Dyn.t
+
+  (** The [default_branch] of a remote repository. *)
+  val default_branch : t -> Object.resolved option Fiber.t
+end
+
+(** [remote ~loc ~url] gets the remote pointed to by [url] and makes
+    the revision store aware of it. This is idempotent and is memoized by
+    [url]. *)
+val remote : t -> loc:Loc.t -> url:string -> Remote.t
+
 module At_rev : sig
+  (** An immutable Git repository view at a specific commit. *)
   type t
 
-  module Config : sig
-    val parse : string -> (string * string option * string * string) option
-  end
+  val equal : t -> t -> bool
 
+  (** The underlying commit. *)
   val rev : t -> Object.t
+
+  (** Read file content at this revision. Returns [None] if the file does not
+      exist or is not a blob. *)
   val content : t -> Path.Local.t -> string option Fiber.t
+
+  (** [directory_entries t ~recursive path] lists the files under [path]. If
+      [recursive] then lists the full subtree. Symbolic links are returned as
+      files. *)
   val directory_entries : t -> recursive:bool -> Path.Local.t -> File.Set.t
-  val equal : t -> t -> bool
-  val check_out : t -> target:Path.t -> unit Fiber.t
-end
 
-module Remote : sig
-  (** handle representing a particular git repository *)
-  type t
+  (** [check_out t ~target] materialises the entire tree into [target]
+      including any submodules. *)
+  val check_out : t -> target:Path.t -> unit Fiber.t
 
-  val default_branch : t -> Object.resolved option Fiber.t
+  (** For testing only. *)
+  module Config : sig
+    val parse : string -> (string * string option * string * string) option
+  end
 end
 
-val remote : t -> url:Loc.t * string -> Remote.t
+(** Resolve the revision in the given remote. The [revision] can be any
+    accepted reference name, branch, tag or Sha1 by Git.
+
+    If a reference name is resolved form the remote, the commit is fetched. If
+    the revision is already present, no network I/O is performed. Returns
+    [None] if the remote reports "not found". Raises a user error if the
+    reference is ambigious. *)
 val resolve_revision : t -> Remote.t -> revision:string -> Object.resolved option Fiber.t
-val content_of_files : t -> File.t list -> string list Fiber.t
-val load_or_create : dir:Path.t -> t Fiber.t
-val get : t Fiber.t
+
+(** [fetch_object t remote object] ensures that an [object] from the [remote]
+    is present in the revision store [t]. If the reviison is already present,
+    no network I/O is performed. Returns [None] if the remote reports "not
+    found". *)
 val fetch_object : t -> Remote.t -> Object.t -> At_rev.t option Fiber.t
+
+(** Fetch the file contents of the repository at the given revision into the
+    store and return the repository view. *)
 val fetch_resolved : t -> Remote.t -> Object.resolved -> At_rev.t Fiber.t