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

avoid rresult, use result instead

Browse source
This commit is contained in:
Hannes Mehnert 2022-11-04 10:42:30 +01:00
parent 6fdede7310
commit 8c7562ea16
4 changed files with 10 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
app/mgit.ml
View file

@ -22,7 +22,6 @@ let () = Logs.set_reporter (reporter Fmt.stderr)
let () = Logs.set_level ~all:true (Some Logs.Debug) let () = Logs.set_level ~all:true (Some Logs.Debug)
*) *)
open Rresult
open Lwt.Infix open Lwt.Infix
let get ~quiet store key = let get ~quiet store key =

1
git-kv.opam
View file

@ -14,6 +14,7 @@ depends: [
"mirage-kv" {>= "4.0.0"} "mirage-kv" {>= "4.0.0"}
"git-unix" {>= "3.10.0"} "git-unix" {>= "3.10.0"}
"carton" {>= "0.6.0"} "carton" {>= "0.6.0"}
"fmt" {>= "0.8.7"}
"mirage-clock-unix" "mirage-clock-unix"
"mirage-clock" "mirage-clock"
"ptime" "ptime"

2
src/dune
View file

@ -2,4 +2,4 @@
(name git_kv) (name git_kv)
(public_name git-kv) (public_name git-kv)
(flags (-w -32)) (flags (-w -32))
(libraries git ptime mirage-clock mirage-kv)) (libraries git ptime mirage-clock mirage-kv fmt))

16
src/git_kv.ml
View file

@ -334,9 +334,9 @@ let of_octets ctx ~remote data =
(* TODO maybe recover edn and branch from data as well? *) (* TODO maybe recover edn and branch from data as well? *)
Lwt.catch Lwt.catch
(fun () -> (fun () ->
init_store () init_store () >|=
>|= Rresult.R.reword_error (Rresult.R.msgf "%a" Store.pp_error) Result.map_error (Fmt.to_to_string Store.pp_error) >|=
>|= Rresult.R.failwith_error_msg >>= fun store -> Result.get_ok >>= fun store ->
analyze store data >>= fun head -> analyze store data >>= fun head ->
let edn, branch = split_url remote in let edn, branch = split_url remote in
Lwt.return_ok { ctx ; edn ; branch ; store ; committed= None; in_closure= false; head; }) Lwt.return_ok { ctx ; edn ; branch ; store ; committed= None; in_closure= false; head; })
@ -532,12 +532,12 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
| `Not_found hash -> `Hash_not_found hash | `Not_found hash -> `Hash_not_found hash
| `Reference_not_found ref -> `Reference_not_found ref | `Reference_not_found ref -> `Reference_not_found ref
| `Msg err -> `Msg err | `Msg err -> `Msg err
| err -> Rresult.R.msgf "%a" Store.pp_error err | err -> `Msg (Fmt.to_to_string Store.pp_error err)
let set t key contents = let set t key contents =
let open Lwt.Infix in let open Lwt.Infix in
set ?and_commit:t.committed t key contents set ?and_commit:t.committed t key contents
>|= Rresult.R.reword_error to_write_error >|= Result.map_error to_write_error
let set_partial t key ~offset chunk = let set_partial t key ~offset chunk =
let open Lwt_result.Infix in let open Lwt_result.Infix in
@ -604,7 +604,7 @@ module Make (Pclock : Mirage_clock.PCLOCK) = struct
let remove t key = let remove t key =
let open Lwt.Infix in let open Lwt.Infix in
remove ?and_commit:t.committed t key >|= Rresult.R.reword_error to_write_error remove ?and_commit:t.committed t key >|= Result.map_error to_write_error
let rename t ~source ~dest = let rename t ~source ~dest =
(* TODO(dinosaure): optimize it! It was done on the naive way. *) (* TODO(dinosaure): optimize it! It was done on the naive way. *)
@ -652,8 +652,8 @@ 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 )
>|= Rresult.R.reword_error (msgf "%a" Store.pp_error) >|= Result.map_error (Fmt.to_to_string Store.pp_error)
>|= Rresult.R.failwith_error_msg >>= fun res -> >|= Result.get_ok >>= fun res ->
Lwt.wakeup_later wk () ; Lwt.wakeup_later wk () ;
t.committed <- None ; t.committed <- None ;
Lwt.return res Lwt.return res