irmin_git: fetch_all for fetching all refs of a remote repo

src/irmin-git/remote.ml

@@ -77,6 +77,44 @@ struct
         >>? fun () -> Lwt.return (Ok (Some hash))
     | _ -> assert false
 
+  let fetch_all t ?depth (ctx, e) =
+    [%log.debug "fetch_all %a" Smart_git.Endpoint.pp e];
+    let push_stdout msg = Gitlog.info (fun f -> f "%s" msg)
+    and push_stderr msg = Gitlog.warn (fun f -> f "%s" msg)
+    and deepen =
+      match depth with Some depth -> Some (`Depth depth) | None -> None
+    and capabilities =
+      [
+        `Side_band_64k;
+        `Multi_ack_detailed;
+        `Ofs_delta;
+        `Thin_pack;
+        `Report_status;
+      ]
+    in
+    S.fetch ~push_stdout ~push_stderr ~capabilities ~ctx e t ?deepen `All
+    >>= function
+    | Error `Not_found -> Lwt.return [ Error (`Msg "not found") ]
+    | Error (`Msg err) -> Lwt.return [ Error (`Msg err) ]
+    | Error (`Exn err) -> Lwt.return [ Error (`Msg (Printexc.to_string err)) ]
+    | Error err ->
+        Fmt.kstr (fun e -> Lwt.return [ Error (`Msg e) ]) "%a" S.pp_error err
+    | Ok None -> Lwt.return [ Ok None ]
+    | Ok (Some (_, refs)) ->
+        Lwt_list.map_p
+          (fun (reference, hash) ->
+            let value = Git.Reference.uid hash in
+            let br =
+              Git.Reference.v
+                ("refs/remotes/origin/" ^ Git.Reference.to_string reference)
+            in
+            G.Ref.write t br value >|= reword_error (msgf "%a" G.pp_error)
+            >>? fun () ->
+            G.Ref.write t reference value
+            >|= reword_error (msgf "%a" G.pp_error)
+            >>? fun () -> Lwt.return (Ok (Some hash)))
+          refs
+
   let push t ?depth:_ (ctx, e) br =
     [%log.debug "push %a" Smart_git.Endpoint.pp e];
     let reference = git_of_branch br in

src/irmin/remote.ml

@@ -28,6 +28,9 @@ module None (H : Type.S) (R : Type.S) = struct
   let fetch () ?depth:_ _ _br =
     Lwt.return (Error (`Msg "fetch operation is not available"))
 
+  let fetch_all () ?depth:_ _ =
+    Lwt.return [ Error (`Msg "fetch_all operation is not available") ]
+
   let push () ?depth:_ _ _br =
     Lwt.return (Error (`Msg "push operation is not available"))
 end

src/irmin/remote_intf.ml

@@ -42,6 +42,15 @@ module type S = sig
       same name, which is now in the local store. [No_head] means no such branch
       exists. *)
 
+  val fetch_all :
+    t ->
+    ?depth:int ->
+    endpoint ->
+    (commit option, [> `Msg of string ]) result list Lwt.t
+  (** [fetch_all t] is like [fetch] but fetches every remote reference, not just
+      the one associated with a particular branch. It returns list of all
+      reference heads, which are all now in the local store. *)
+
   val push :
     t ->
     ?depth:int ->