Don't try to push if the tree_root still is the same
If the user just read into the batched function and does not change anything, we just return the result.
This commit is contained in:
parent
b5fa25d9a5
commit
64fc2402ab
1 changed files with 20 additions and 17 deletions
|
@ -630,12 +630,15 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
|
||||||
(* XXX(dinosaure): we assume that only [batch] can reset [t.committed] to [None] and
|
(* XXX(dinosaure): we assume that only [batch] can reset [t.committed] to [None] and
|
||||||
we ensured that [batch] can not be called into [f]. So we are sure that [t'.committed]
|
we ensured that [batch] can not be called into [f]. So we are sure that [t'.committed]
|
||||||
must be [Some _] in anyway. *)
|
must be [Some _] in anyway. *)
|
||||||
let[@warning "-8"] Some (tree_root_hash, _) = t'.committed in
|
let[@warning "-8"] Some (new_tree_root_hash, _) = t'.committed in
|
||||||
|
if Digestif.SHA1.equal new_tree_root_hash tree_root_hash
|
||||||
|
then Lwt.return_ok res (* XXX(dinosaure): nothing to send! *)
|
||||||
|
else
|
||||||
let action = Option.fold ~none:(`Create t.branch) ~some:(fun _ -> `Update (t.branch, t.branch)) t.head in
|
let action = Option.fold ~none:(`Create t.branch) ~some:(fun _ -> `Update (t.branch, t.branch)) t.head in
|
||||||
let parents = Option.value ~default:[] (Option.map (fun head -> [ head ]) t.head) in
|
let parents = Option.value ~default:[] (Option.map (fun head -> [ head ]) t.head) in
|
||||||
let committer = author ~now in
|
let committer = author ~now in
|
||||||
let author = author ~now in
|
let author = author ~now in
|
||||||
let commit = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
|
let commit = Store.Value.Commit.make ~tree:new_tree_root_hash ~author ~committer
|
||||||
~parents (Some "Committed by git-kv") in
|
~parents (Some "Committed by git-kv") in
|
||||||
Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
|
Store.write t.store (Git.Value.Commit commit) >>= fun (hash, _) ->
|
||||||
t.head <- Some hash ;
|
t.head <- Some hash ;
|
||||||
|
|
Loading…
Reference in a new issue