Permalink
Browse files

irmin: separate set/test_and_set/merge functions to update the store

The function now return a result type, but also add _exn variants which
raise an exception.
  • Loading branch information...
samoht committed Oct 6, 2018
1 parent ed60541 commit 20a013e23d49435e74fa0fc8f8879194a2b50b9d
@@ -136,7 +136,7 @@ let log t fmt =
Printf.ksprintf (fun message ->
all_logs t >>= fun logs ->
let logs = Log.add logs (Entry.v message) in
Store.set t ~info:(info "Adding a new entry") log_file logs
Store.set_exn t ~info:(info "Adding a new entry") log_file logs
) fmt
let print_logs name t =
@@ -171,7 +171,7 @@ let main () =
print_logs "branch 2" t >>= fun () ->
Store.merge ~info:(info "Merging x into t") x ~into:t >>= function
Store.merge_into ~info:(info "Merging x into t") x ~into:t >>= function
| Ok () -> print_logs "merge" t
| Error _ -> failwith "conflict!"
@@ -26,7 +26,7 @@ let provision repo =
Store.Tree.add v ["bin"; "sh"]
"�����XpN ������� H__PAGEZERO(__TEXT__text__TEXT [...]"
>>= fun v ->
Store.set_tree t ~info:(provision "Cloning Ubuntu 14.04 Gold Image.") [] v
Store.set_tree_exn t ~info:(provision "Cloning Ubuntu 14.04 Gold Image.") [] v
(* 2. VM configuration. *)
let sysadmin = info ~user:"Bob the sysadmin"
@@ -37,7 +37,7 @@ let configure repo =
Store.clone ~src:t ~dst:"dev" >>= fun t ->
Lwt_unix.sleep 2. >>= fun () ->
Store.set t ~info:(sysadmin "DNS configuration") ["etc";"resolv.conf"]
Store.set_exn t ~info:(sysadmin "DNS configuration") ["etc";"resolv.conf"]
"domain mydomain.com\nnameserver 128.221.130.23" >>= fun () ->
Lwt_unix.sleep 2. >>= fun () ->
@@ -51,14 +51,14 @@ let attack repo =
Store.of_branch repo "prod" >>= fun t ->
Lwt_unix.sleep 2. >>= fun () ->
Store.set t ~info:(info "$ vim /etc/resolv.conf")
Store.set_exn t ~info:(info "$ vim /etc/resolv.conf")
["etc";"resolv.conf"]
"domain mydomain.com\n\
nameserver 12.221.130.23"
>>= fun () ->
Lwt_unix.sleep 2. >>= fun () ->
Store.set t ~info:(info "$ gcc -c /tmp/sh.c -o /bin/sh")
Store.set_exn t ~info:(info "$ gcc -c /tmp/sh.c -o /bin/sh")
["bin";"sh"]
"�����XpNx ������� H__PAGEZERO(__TEXT__text__TEXT [...]"
@@ -9,7 +9,7 @@ module Store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
let update t k v =
let msg = sprintf "Updating /%s" (String.concat "/" k) in
print_endline msg;
Store.set t ~info:(info "%s" msg) k v
Store.set_exn t ~info:(info "%s" msg) k v
let read_exn t k =
let msg = sprintf "Reading /%s" (String.concat "/" k) in
@@ -33,7 +33,7 @@ let main () =
update t ["root";"misc";"3.txt"] "Hohoho" >>= fun () ->
update x ["root";"misc";"2.txt"] "Cool!" >>= fun () ->
Store.merge ~info:(info "t: Merge with 'x'") x ~into:t >>= function
Store.merge_into ~info:(info "t: Merge with 'x'") x ~into:t >>= function
| Error _ -> failwith "conflict!"
| Ok () ->
print_endline "merging ...";
@@ -83,7 +83,7 @@ let init () =
Config.init ();
Store.Repo.v config >>= fun repo ->
Store.of_branch repo master >>= fun t ->
Store.set t ~info:(info images.(0) "init") ["0"] "0" >>= fun () ->
Store.set_exn t ~info:(info images.(0) "init") ["0"] "0" >>= fun () ->
Lwt_list.iter_s (fun i ->
Store.clone ~src:t ~dst:(branch i) >>= fun _ ->
Lwt.return_unit
@@ -104,7 +104,7 @@ let rec process image =
in
Store.Repo.v config >>= fun repo ->
Store.of_branch repo id >>= fun t ->
Store.set t ~info:(info image actions.message) key (value ()) >>= fun () ->
Store.set_exn t ~info:(info image actions.message) key (value ()) >>= fun () ->
begin if Random.int 3 = 0 then
let branch = branch (random_array images) in
@@ -26,7 +26,7 @@ let test () =
Store.get_tree t [] >>= fun tree ->
Store.Tree.add tree ["BAR.md"] "Hoho!" >>= fun tree ->
Store.Tree.add tree ["FOO.md"] "Hihi!" >>= fun tree ->
Store.set_tree t ~info:(info "merge") [] tree >>= fun () ->
Store.set_tree_exn t ~info:(info "merge") [] tree >>= fun () ->
Printf.printf "%s\n%!" readme;
Store.get t ["BAR.md"] >>= fun bar ->
Printf.printf "%s\n%!" bar;
@@ -22,7 +22,7 @@ let test () =
Store.get_tree t [] >>= fun tree ->
Store.Tree.add tree ["BAR.md"] "Hoho!" >>= fun tree ->
Store.Tree.add tree ["FOO.md"] "Hihi!" >>= fun tree ->
Store.set_tree t ~info:(info "merge") [] tree >|= fun () ->
Store.set_tree_exn t ~info:(info "merge") [] tree >|= fun () ->
Printf.printf "%s\n%!" readme
let () =
@@ -48,15 +48,15 @@ let main () =
Store.Repo.v config >>= fun repo ->
Store.master repo >>= fun t ->
Store.set_tree t ~info:(info "update a/b") ["a";"b"] v >>= fun () ->
Store.set_tree_exn t ~info:(info "update a/b") ["a";"b"] v >>= fun () ->
Store.get_tree t ["a";"b"] >>= fun v ->
t_of_tree v >>= fun tt ->
Store.set_tree t ~info:(info "update a/c") ["a";"c"] v >>= fun () ->
Store.set_tree_exn t ~info:(info "update a/c") ["a";"c"] v >>= fun () ->
let tt = tt @ [ { x = "ggg"; y = 4 } ] in
tree_of_t tt >>= fun vv ->
Store.set_tree t ~info:(info "merge tree into a/b") ["a";"b"] vv
Store.set_tree_exn t ~info:(info "merge tree into a/b") ["a";"b"] vv
let () =
Lwt_main.run (main ())
@@ -250,6 +250,9 @@ module Make(Store : STORE) : S with type store = Store.t = struct
| Error msg -> Error msg)
| None -> Ok None
let err_write e =
Lwt.return_error (Irmin.Type.to_string Store.write_error_t e)
let remote s = match Store.remote with
| Some remote_fn ->
Schema.[
@@ -332,8 +335,9 @@ module Make(Store : STORE) : S with type store = Store.t = struct
let value = Irmin.Type.of_string Store.contents_t v in
match key, value with
| Ok key, Ok value ->
Store.set t key value ~info >>= fun () ->
Store.Head.find t >>= Lwt.return_ok
(Store.set t key value ~info >>= function
| Ok () -> Store.Head.find t >>= Lwt.return_ok
| Error e -> err_write e)
| Error (`Msg msg), _ | _, Error (`Msg msg) -> Lwt.return_error msg)
| Error msg -> Lwt.return_error msg
)
@@ -353,8 +357,9 @@ module Make(Store : STORE) : S with type store = Store.t = struct
let key = Irmin.Type.of_string Store.key_t key in
match key with
| Ok key ->
Store.remove t key ~info >>= fun () ->
Store.Head.find t >>= Lwt.return_ok
(Store.remove t key ~info >>= function
| Ok () -> Store.Head.find t >>= Lwt.return_ok
| Error e -> err_write e)
| Error (`Msg msg) -> Lwt.return_error msg)
| Error msg -> Lwt.return_error msg
)
@@ -436,4 +441,3 @@ module Make(Store : STORE) : S with type store = Store.t = struct
let start_server ?port s =
Server.start ?port ~ctx:(fun _req -> ()) (schema s)
end
Oops, something went wrong.

0 comments on commit 20a013e

Please sign in to comment.