Refactor Git_presenters to Resolvers.

What this module really does is resolve Git types to values usable by
ogit views.

1 files changed, 135 insertions, 0 deletions

diff --git a/lib/resolvers.ml b/lib/resolvers.ml
new file mode 100644
index 0000000..af8fd8b
--- /dev/null
+++ b/lib/resolvers.ml
@@ -0,0 +1,135 @@
+(* -*- mode: tuareg; -*- *)
+
+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
+
+let store repo =
+  let path = Fpath.v @@ full_path repo in
+  Store.v ~dotgit:path path
+
+let repo_description repo =
+  let description_path = Filename.concat (full_path repo) "description" in
+  In_channel.with_open_text description_path In_channel.input_all
+
+type user = Git.User.t
+
+type commit = {
+  hash : string;
+  short_hash : string;
+  parents : string list;
+  author : user;
+  message : string option;
+}
+
+let to_commit store hash =
+  Store.read store hash >>= function
+  | Git.Value.Commit c ->
+      let hash = Store.Hash.to_hex hash in
+      Lwt_result.return
+        {
+          hash;
+          short_hash = String.sub hash 0 8;
+          parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex;
+          author = Store.Value.Commit.author c;
+          message = Store.Value.Commit.message c;
+        }
+  | _ -> Lwt_result.fail (`Msg "value is not a commit")
+
+let commit_of_id repo id =
+  let* store = store repo in
+  let hash = Store.Hash.of_hex id in
+  to_commit store hash
+
+let recent_commits repo n =
+  let* store = store repo in
+  let* head = Store.Ref.resolve store Git.Reference.head in
+  let rec walk acc hash count =
+    if count = 0 then Lwt_result.return (List.rev acc)
+    else
+      let* commit = to_commit store hash in
+      match commit.parents with
+      | parent :: _ ->
+          walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1)
+      | [] -> Lwt_result.return (List.rev (commit :: acc))
+  in
+  walk [] head n
+
+type branch = { hash : string; name : string }
+
+let all_branches repo =
+  let* store = store repo in
+  let open Lwt.Syntax in
+  let* refs = Store.Ref.list store in
+  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 })
+      refs
+  in
+  Lwt_result.return branches
+
+type tree_entry = {
+  hash : string;
+  short_hash : string;
+  name : string;
+  perm : int;
+}
+
+type tree = { hash : string; short_hash : string; entries : tree_entry list }
+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 to_tree store hash =
+  Store.read store hash >>= function
+  | Git.Value.Tree tree ->
+      let hash = Store.Hash.to_hex hash in
+      let short_hash = String.sub hash 0 8 in
+      let entries = Store.Value.Tree.to_list tree |> List.map to_entry 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 blob")
+
+let head_tree repo =
+  let* store = store repo in
+  let* hash =
+    Store.Ref.resolve store Git.Reference.head >>= Store.read store >>= function
+    | Git.Value.Commit commit ->
+        Store.Value.Commit.tree commit |> Lwt_result.return
+    | _ -> `Msg "no head tree id" |> Lwt_result.fail
+  in
+  to_tree store hash
+
+let tree_of_id repo id =
+  let* store = store repo in
+  let hash = Store.Hash.of_hex id in
+  to_tree store hash
+
+let blob_of_id repo id =
+  let* store = store repo in
+  let hash = Store.Hash.of_hex id in
+  to_blob store hash