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

only use a single commit in rename

Browse source
This commit is contained in:
Hannes Mehnert 2024-10-28 21:56:53 +01:00
parent e2295fe0b3
commit 93bcbe576d
1 changed files with 14 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/git_kv.ml
View file

@ -652,13 +652,6 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
let open Lwt.Infix in let open Lwt.Infix in
remove ?and_commit:t.committed t key >|= Result.map_error to_write_error remove ?and_commit:t.committed t key >|= Result.map_error to_write_error
let rename t ~source ~dest =
(* TODO(dinosaure): optimize it! It was done on the naive way. *)
let open Lwt_result.Infix in
get t source >>= fun contents ->
remove t source >>= fun () ->
set t dest contents
let allocate t key ?last_modified:_ size = let allocate t key ?last_modified:_ size =
let open Lwt.Infix in let open Lwt.Infix in
exists t key >>= function exists t key >>= function
@ -709,4 +702,18 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
Lwt.return_ok res) Lwt.return_ok res)
>|= Result.map_error >|= Result.map_error
(fun err -> `Msg (Fmt.str "error pushing %a" Store.pp_error err))) (fun err -> `Msg (Fmt.str "error pushing %a" Store.pp_error err)))
let rename t ~source ~dest =
let open Lwt_result.Infix in
let op t =
get t source >>= fun contents ->
remove t source >>= fun () ->
set t dest contents
in
match t.committed with
| Some _ -> op t
| None ->
change_and_push t op >>! function
| Ok a -> Lwt.return a
| Error _ as e -> Lwt.return e
end end