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

Merge pull request 'Use deepen according what we have' (#22) from fix-pull-out-of-sync into main

Browse source 
Reviewed-on: https://git.robur.io/robur/git-kv/pulls/22
This commit is contained in:
dinosaure 2022-10-28 13:17:36 +00:00
commit 3433ec4c6f
1 changed files with 18 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
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))
r |> to_invalid
in
diff t.store t.head head >>= fun diff -> diff t.store t.head head >>= fun diff ->
t.head <- Some head; t.head <- Some head ; Lwt.return (Ok diff)
Lwt.return (Ok diff) | exception Not_found -> Lwt.return_error (`Msg (Fmt.str "error fetching: %a does not exist" Git.Reference.pp t.branch))
let connect ctx endpoint = let connect ctx endpoint =
let open Lwt.Infix in let open Lwt.Infix in