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

change_and_push: be able to specify author and message

Browse source
This commit is contained in:
Hannes Mehnert 2022-12-15 13:29:19 +01:00
parent 12261fc13a
commit f5fa3857c1
2 changed files with 18 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

26
src/git_kv.ml
View file

@ -459,10 +459,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
get t key >|= fun data -> get t key >|= fun data ->
Optint.Int63.of_int (String.length data) Optint.Int63.of_int (String.length data)
let author ~now = let author ?(name = "Git KV") ?(email = "git@mirage.io") now =
{ Git.User.name= "Git KV" { Git.User.name ; email ; date = now (), None }
; email= "git@mirage.io"
; date= now (), None }
let rec unroll_tree t ~tree_root_hash (pred_perm, pred_name, pred_hash) rpath = let rec unroll_tree t ~tree_root_hash (pred_perm, pred_name, pred_hash) rpath =
let open Lwt.Infix in let open Lwt.Infix in
@ -522,8 +520,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
t.committed <- Some (tree_root_hash, th) ; t.committed <- Some (tree_root_hash, th) ;
Lwt.return_ok () Lwt.return_ok ()
| None -> | None ->
let committer = author ~now in let committer = author now in
let author = author ~now in let author = author now in
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 commit = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer let commit = Store.Value.Commit.make ~tree:tree_root_hash ~author ~committer
@ -577,8 +575,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
( match and_commit with ( match and_commit with
| Some (_old_tree_root_hash, th) -> t.committed <- Some (tree_root_hash, th) ; Lwt.return_ok () | Some (_old_tree_root_hash, th) -> t.committed <- Some (tree_root_hash, th) ; Lwt.return_ok ()
| None -> | None ->
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:tree_root_hash ~author ~committer
~parents:[ head ] (Some "Committed by git-kv") in ~parents:[ head ] (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, _) ->
@ -601,8 +599,8 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
( match and_commit with ( match and_commit with
| Some (_old_tree_root_hash, th) -> t.committed <- Some (tree_root_hash, th) ; Lwt.return_ok () | Some (_old_tree_root_hash, th) -> t.committed <- Some (tree_root_hash, th) ; Lwt.return_ok ()
| None -> | None ->
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:tree_root_hash ~author ~committer
~parents:[ head ] (Some "Committed by git-kv") in ~parents:[ head ] (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, _) ->
@ -638,7 +636,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
let data = String.make size '\000' in let data = String.make size '\000' in
set t key data set t key data
let change_and_push t f = let change_and_push t ?author:name ?author_email:email ?(message = "Committed by git-kv") f =
let open Lwt.Infix in let open Lwt.Infix in
if t.in_closure then if t.in_closure then
Lwt.return_error (`Msg "Nested change_and_push") Lwt.return_error (`Msg "Nested change_and_push")
@ -664,10 +662,10 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
else 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 author = author ?name ?email now in
let author = author ~now in let committer = author in
let commit = Store.Value.Commit.make ~tree:new_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 message) 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 ;
Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () -> Store.Ref.write t.store t.branch (Git.Reference.uid hash) >>= fun () ->

7
src/git_kv.mli
View file

@ -68,5 +68,10 @@ module Make (Pclock : Mirage_clock.PCLOCK) : sig
| Mirage_kv.write_error ] | Mirage_kv.write_error ]
and type error = [ `Msg of string | Mirage_kv.error ] and type error = [ `Msg of string | Mirage_kv.error ]
val change_and_push : t -> (t -> 'a Lwt.t) -> ('a, [> `Msg of string ]) result Lwt.t val change_and_push : t -> ?author:string -> ?author_email:string ->
?message:string -> (t -> 'a Lwt.t) -> ('a, [> `Msg of string ]) result Lwt.t
(** [change_and_push store ~author ~author_email ~message f] applies the
changes of [f] to [store], and creates a commit using [author],
[author_email], and [message] (committer will be the same as author), and
pushes that commit to the remote. *)
end end