change_and_push may return an error, report it

This commit is contained in:
Hannes Mehnert 2022-11-04 10:48:44 +01:00
parent 8e14c13ddc
commit 45657fdf32
3 changed files with 44 additions and 41 deletions

View file

@ -140,7 +140,7 @@ let repl store fd_in =
| [ "quit"; ] -> Lwt.return () | [ "quit"; ] -> Lwt.return ()
| [ "fold"; ] -> | [ "fold"; ] ->
Store.change_and_push store0 (fun store1 -> go store1) Store.change_and_push store0 (fun store1 -> go store1)
>>= fun () -> go store0 >>= fun _ -> go store0
| [ "save"; filename ] -> | [ "save"; filename ] ->
save store0 filename >|= ignore save store0 filename >|= ignore
>>= fun _ -> if is_a_tty then Fmt.pr "\n%!" ; go store0 >>= fun _ -> if is_a_tty then Fmt.pr "\n%!" ; go store0

View file

@ -614,7 +614,9 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
let change_and_push t f = let change_and_push t f =
let open Lwt.Infix in let open Lwt.Infix in
if t.in_closure then Fmt.invalid_arg "Nested change_and_push" ; if t.in_closure then
Lwt.return_error (`Msg "Nested change_and_push")
else
(* XXX(dinosaure): serialize [batch]. If we do [Lwt.both (batch ..) (batch ..)], they (* XXX(dinosaure): serialize [batch]. If we do [Lwt.both (batch ..) (batch ..)], they
can not run concurrently! The second will waiting the first to finish. *) can not run concurrently! The second will waiting the first to finish. *)
( match t.committed with ( match t.committed with
@ -649,8 +651,9 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
>>? fun () -> >>? fun () ->
Store.shallow t.store hash >|= Result.ok) >>= fun () -> Store.shallow t.store hash >|= Result.ok) >>= fun () ->
Lwt.return_ok res ) Lwt.return_ok res )
>|= Result.map_error (Fmt.to_to_string Store.pp_error) >|= Result.map_error
>|= Result.get_ok >>= fun res -> (fun err -> `Msg (Fmt.str "error pushing %a" Store.pp_error err))
>>= fun res ->
Lwt.wakeup_later wk () ; Lwt.wakeup_later wk () ;
t.committed <- None ; t.committed <- None ;
Lwt.return res Lwt.return res

View file

@ -67,5 +67,5 @@ module Make (Pclock : Mirage_clock.PCLOCK) : sig
| `Reference_not_found of Git.Reference.t | `Reference_not_found of Git.Reference.t
| Mirage_kv.write_error ] | Mirage_kv.write_error ]
val change_and_push : t -> (t -> 'a Lwt.t) -> 'a Lwt.t val change_and_push : t -> (t -> 'a Lwt.t) -> ('a, [> `Msg of string ]) result Lwt.t
end end