diff options
| -rw-r--r-- | lib/resolvers.ml | 27 |
1 files changed, 12 insertions, 15 deletions
diff --git a/lib/resolvers.ml b/lib/resolvers.ml index 0beb675..488ec56 100644 --- a/lib/resolvers.ml +++ b/lib/resolvers.ml @@ -2,8 +2,6 @@ module Store = Git_unix.Store open Lwt_result.Syntax - -(* open Lwt_result.Infix *) open Config let full_path path = Filename.concat config.git_project_root path @@ -40,10 +38,9 @@ module Commit = struct let of_id repo id = let* store = store repo in let hash = Store.Hash.of_hex id in - Store.read store hash - |> Lwt_result.map @@ function - | Git.Value.Commit commit -> to_t commit - | _ -> failwith (id ^ " does not point to a commit object") + Lwt_result.bind (Store.read store hash) @@ function + | Git.Value.Commit commit -> Lwt_result.return (to_t commit) + | _ -> Lwt_result.fail @@ `Msg (id ^ " does not point to a commit object") let head repo = let* store = store repo in @@ -76,9 +73,10 @@ module Branch = struct let branches = List.map (fun (reference, hash) -> - let name = Git.Reference.to_string reference in - let hash = Store.Hash.to_hex hash in - { name; hash }) + { + name = Git.Reference.to_string reference; + hash = Store.Hash.to_hex hash; + }) refs in Lwt_result.return branches @@ -123,8 +121,8 @@ module Tree = struct let* store = store repo in let hash = Store.Hash.of_hex id in Lwt_result.bind (Store.read store hash) @@ function - | Git.Value.Tree tree -> to_t tree |> Lwt_result.return - | _ -> `Msg "no head tree id" |> Lwt_result.fail + | Git.Value.Tree tree -> Lwt_result.return (to_t tree) + | _ -> Lwt_result.fail @@ `Msg ("no tree for id " ^ id) let head repo : (t, Store.error) Lwt_result.t = let* store = store repo in @@ -144,8 +142,7 @@ module Blob = struct let of_id repo id = let* store = store repo in let hash = Store.Hash.of_hex id in - Store.read store hash - |> Lwt_result.map @@ function - | Git.Value.Blob blob -> to_t blob - | _ -> failwith (id ^ " does not point to a blob object") + Lwt_result.bind (Store.read store hash) @@ function + | Git.Value.Blob blob -> Lwt_result.return (to_t blob) + | _ -> Lwt_result.fail @@ `Msg (id ^ " does not point to a blob object") end |