diff options
Diffstat (limited to 'lib/git_presenters.ml')
-rw-r--r-- | lib/git_presenters.ml | 62 |
1 files changed, 39 insertions, 23 deletions
diff --git a/lib/git_presenters.ml b/lib/git_presenters.ml index f0a0317..215e9c5 100644 --- a/lib/git_presenters.ml +++ b/lib/git_presenters.ml @@ -3,6 +3,7 @@ module Store = Git_unix.Store open Lwt_result.Syntax open Config +open Lwt_result.Infix let full_path path = Filename.concat config.git_project_root path @@ -69,8 +70,10 @@ let all_branches repo = let* refs = Store.Ref.list store in let branches = List.map - (fun (ref, hash) -> - { name = Git.Reference.to_string ref; hash = Store.Hash.to_hex hash }) + (fun (reference, hash) -> + let name = Git.Reference.to_string reference in + let hash = Store.Hash.to_hex hash in + { name; hash }) refs in Lwt_result.return branches @@ -83,37 +86,45 @@ type tree_entry = { } type tree = { hash : string; short_hash : string; entries : tree_entry list } - -let to_entry _ = - { - hash = "foo"; - short_hash = String.sub "foobar" 0 8; - name = "foobarbino"; - perm = 122; - } +type blob = { content : string } + +let to_entry (entry : Store.Value.Tree.entry) = + let perm = + match entry.perm with + | `Commit -> 0o160000 + | `Dir -> 0o040000 + | `Everybody -> 0o100664 + | `Exec -> 0o100755 + | `Link -> 0o120000 + | `Normal -> 0o100644 + in + let hash = Store.Hash.to_hex entry.node in + let short_hash = String.sub hash 0 8 in + { hash; short_hash; name = entry.name; perm } let present_tree tree = Store.Value.Tree.to_list tree |> List.map to_entry let to_tree store hash = - let* v = Store.read store hash in - match v with + Store.read store hash >>= function | Git.Value.Tree tree -> let hash = Store.Hash.to_hex hash in - Lwt_result.return - { hash; short_hash = String.sub hash 0 8; entries = present_tree tree } - | _ -> - Dream.log "Value is not a tree"; - Lwt_result.fail (`Msg "value is not a tree") + let short_hash = String.sub hash 0 8 in + let entries = present_tree tree in + Lwt_result.return { hash; short_hash; entries } + | _ -> Lwt_result.fail (`Msg "value is not a tree") + +let to_blob store hash = + Store.read store hash >>= function + | Git.Value.Blob blob -> + let content = Store.Value.Blob.to_string blob in + Lwt_result.return { content } + | _ -> Lwt_result.fail (`Msg "value is not a tree") let head_tree_id store = - let* commit_hash = Store.Ref.resolve store Git.Reference.head in - let* v = Store.read store commit_hash in - match v with + Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function | Git.Value.Commit commit -> Store.Value.Commit.tree commit |> Lwt_result.return - | _ -> - Dream.log "no head tree id"; - Lwt_result.fail (`Msg "") + | _ -> `Msg "no head tree id" |> Lwt_result.fail let head_tree repo = let* store = store repo in @@ -124,3 +135,8 @@ let tree_of_id repo id = let* store = store repo in let* hash = Lwt_result.return (Store.Hash.of_hex id) in to_tree store hash + +let blob_of_id repo id = + let* store = store repo in + let* hash = Lwt_result.return (Store.Hash.of_hex id) in + to_blob store hash |