robur/git-kv
4
0
Fork 0
Code Issues Pull requests 1 Projects Releases Packages Wiki Activity Actions

Use deepen according what we have.

Browse source 
If we have nothing, we just want the last commit, if we have something, we want
commits between what we have and what the server has. Then, we shallow
correctly our internal store to still keep only one commit.
This commit is contained in:
Romain Calascibetta 2022-10-28 15:12:54 +02:00
parent 631249e333
commit 7b388c029a
1 changed files with 18 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
src/git_kv.ml
View file

@ -71,7 +71,15 @@ let diff store commit0 commit1 = match commit0 with
let pull t = let pull t =
let open Lwt.Infix in let open Lwt.Infix in
Sync.fetch ~capabilities ~ctx:t.ctx t.edn t.store ~deepen:(`Depth 1) (`Some [ t.branch, t.branch ]) >>= fun r -> ( match t.head with
| None -> Lwt.return (`Depth 1)
| Some head ->
Store.read_exn t.store head >>= fun value ->
let[@warning "-8"] Git.Value.Commit commit = value in
(* TODO(dinosaure): we should handle correctly [tz] and re-calculate the timestamp. *)
let { Git.User.date= (timestamp, _tz); _ } = Store.Value.Commit.author commit in
Lwt.return (`Timestamp timestamp) ) >>= fun deepen ->
Sync.fetch ~capabilities ~ctx:t.ctx t.edn t.store ~deepen (`Some [ t.branch, t.branch ]) >>= fun r ->
let data = let data =
Result.map_error Result.map_error
(fun e -> `Msg (Fmt.str "error fetching: %a" Sync.pp_error e)) (fun e -> `Msg (Fmt.str "error fetching: %a" Sync.pp_error e))
@ -80,18 +88,15 @@ let pull t =
match data with match data with
| Error _ as e -> Lwt.return e | Error _ as e -> Lwt.return e
| Ok None -> Lwt.return (Ok []) | Ok None -> Lwt.return (Ok [])
| Ok Some (_, _) -> | Ok Some (_, refs) -> match List.find (fun (r, _) -> Git.Reference.equal r t.branch) refs with
Store.Ref.resolve t.store t.branch >>= fun r -> | (_, head) ->
let head = Store.shallow t.store head >>= fun () ->
Result.map_error (* XXX(dinosaure): the shallow must be done **before** the diff. Otherwise
(fun e -> `Msg (Fmt.str "error resolving branch %a: %a" we will compare [commit0] with [commit0 <- commit1]. We want to compare
Git.Reference.pp t.branch [commit0] and [commit1] (only). *)
Store.pp_error e)) diff t.store t.head head >>= fun diff ->
r |> to_invalid t.head <- Some head ; Lwt.return (Ok diff)
in | exception Not_found -> Lwt.return_error (`Msg (Fmt.str "error fetching: %a does not exist" Git.Reference.pp t.branch))
diff t.store t.head head >>= fun diff ->
t.head <- Some head;
Lwt.return (Ok diff)
let connect ctx endpoint = let connect ctx endpoint =
let open Lwt.Infix in let open Lwt.Infix in