From 034ae69f2f22d7957386e73b3c42053fbf0cdfb2 Mon Sep 17 00:00:00 2001
From: Marius Peter <marius.peter@tutanota.com>
Date: Sat, 21 Jun 2025 12:09:35 +0200
Subject: Refactor resolvers.

---
 lib/handlers.ml  |  19 ++--
 lib/resolvers.ml | 258 +++++++++++++++++++++++++++++--------------------------
 lib/views.ml     |  52 +++++------
 3 files changed, 175 insertions(+), 154 deletions(-)

diff --git a/lib/handlers.ml b/lib/handlers.ml
index 871931c..e63e911 100644
--- a/lib/handlers.ml
+++ b/lib/handlers.ml
@@ -13,36 +13,37 @@ module Repo = struct
 
   let summary req =
     let repo = Dream.param req "repo" in
-    let* branches = Resolvers.all_branches repo in
-    let* commits = Resolvers.recent_commits repo 10 in
+    (* let* branches = Resolvers.Branch.all repo in *)
+    (* let* commits = Resolvers.Commit.recent repo 10 in *)
+    let* commits = Resolvers.Commit.head repo in
     let authors = [ "John Pork"; "Sebastian Jellybean" ] in
-    Views.Repo.summary repo branches commits authors
+    Views.Repo.summary repo () [commits] authors
 
   let log req =
     let repo = Dream.param req "repo" in
-    let* commits = Resolvers.recent_commits repo 100 in
+    let* commits = Resolvers.Commit.recent repo 100 in
     Views.Repo.log repo commits
 
   let files_at_head req =
     let repo = Dream.param req "repo" in
-    let* tree = Resolvers.head_tree repo in
+    let* tree = Resolvers.Tree.head repo in
     Views.Repo.files repo tree
 
   let file_id req =
     let repo = Dream.param req "repo" in
     let id = Dream.param req "repo" in
-    let* blob = Resolvers.blob_of_id repo id in
+    let* blob = Resolvers.Blob.of_id repo id in
     Views.Repo.file repo blob
 
   let refs req =
     let repo = Dream.param req "repo" in
-    let* branches = Resolvers.all_branches repo in
-    Views.Repo.refs repo branches
+    (* let* branches = Resolvers.Branch.all repo in *)
+    Views.Repo.refs repo ()
 
   let commit req =
     let repo = Dream.param req "repo" in
     let id = Dream.param req "id" in
-    let* commit = Resolvers.commit_of_id repo id in
+    let* commit = Resolvers.Commit.of_id repo id in
     Views.Repo.commit repo commit
 end
 
diff --git a/lib/resolvers.ml b/lib/resolvers.ml
index af8fd8b..9baa116 100644
--- a/lib/resolvers.ml
+++ b/lib/resolvers.ml
@@ -2,134 +2,152 @@
 
 module Store = Git_unix.Store
 open Lwt_result.Syntax
-open Lwt_result.Infix
+
+(* 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
+  let path = full_path repo |> Fpath.v 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
+let short_hash hash = String.sub hash 0 8
+
+module Commit = struct
+  type user = Git.User.t
+
+  type t = {
+    hash : string;
+    parents : string list;
+    author : user;
+    message : string option;
+  }
+
+  let to_t c =
+    let open Store.Value in
+    {
+      hash = Store.Value.Commit.digest c |> Store.Hash.to_hex;
+      parents = Commit.parents c |> List.map Store.Hash.to_hex;
+      author = Commit.author c;
+      message = Commit.message c;
+    }
+
+  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")
+
+  let head repo =
+    let* store = store repo in
+    let* hash = Store.Ref.resolve store Git.Reference.head in
+    let id = hash |> Store.Hash.to_hex in
+    of_id repo id
+
+  let recent repo n =
+    let* head_commit = head repo in
+    let rec walk acc hash count =
+      if count = 0 then Lwt_result.return (List.rev acc)
+      else
+        let* commit = of_id repo hash in
+        match commit.parents with
+        | parent_hash :: _ -> walk (commit :: acc) parent_hash (count - 1)
+        | [] -> Lwt_result.return (List.rev (commit :: acc))
+    in
+    walk [] head_commit.hash n
+end
+
+(* module Branch = struct *)
+(*   type t = { hash : string; name : string } *)
+
+(*   let to_t (branch : Store.Reference.t) = *)
+(*     { *)
+(*       hash = Store.Reference.hash branch ; *)
+(*       name = Store.Reference.contents branch; *)
+(*     } *)
+
+(*   let of_id repo id = *)
+(*     let* store = store repo in *)
+(*     let hash = Store.Hash.of_hex id in *)
+(*     Store.Ref.resolve store hash *)
+(*     |> Lwt_result.map @@ function *)
+(*     | Git.Reference.Ref branch -> to_t branch *)
+(*        | _ -> failwith "no head tree id" *)
+
+(*   let all repo = *)
+(*     let* store = store repo 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 *)
+(* end *)
+
+module Entry = struct
+  type t = { hash : string; name : string; perm : int }
+
+  let to_t (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
+    { hash; name = entry.name; perm }
+end
+
+module Tree = struct
+  type t = { hash : string; entries : Entry.t list }
+
+  let to_t (tree : Store.Value.Tree.t) =
+    let hash = Store.Value.Tree.hash tree |> Int.to_string in
+    let entries = Store.Value.Tree.to_list tree |> List.map Entry.to_t in
+    { hash; entries }
+
+  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.Tree tree -> to_t tree
+       | _ -> failwith "no head tree id"
+
+  let head repo : (t, Store.error) Lwt_result.t =
+    let* store = store repo in
+    let* hash =
+      Store.Ref.resolve store Git.Reference.head
+      |> Lwt_result.map Store.Hash.to_hex
+    in
+    of_id repo hash
+end
+
+module Blob = struct
+  type t = { content : string }
+
+  let to_t (blob : Store.Value.Blob.t) =
+    { content = Store.Value.Blob.to_string blob }
+
+  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")
+end
diff --git a/lib/views.ml b/lib/views.ml
index fc211c5..ca012fc 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -90,18 +90,19 @@ let root () =
   respond @@ Page.render body_data
 
 module Repo = struct
-  open Resolvers
+  let page_title repo =
+    Printf.sprintf "%s — %s" repo (Resolvers.repo_description repo)
 
-  let page_title repo = Printf.sprintf "%s — %s" repo (repo_description repo)
   let li_of_author author = HTML.(li [] [ txt "%s" author ])
 
-  let li_of_branch repo (branch : branch) =
-    HTML.(li [] [ Routes.link_to (Refs repo) (txt "%s" branch.name) ])
+  (* let li_of_branch repo (branch : Resolvers.Branch.t) = *)
+  (*   HTML.(li [] [ Routes.link_to (Refs repo) (txt "%s" branch.name) ]) *)
 
-  let li_of_commit repo commit =
+  let li_of_commit repo (commit : Resolvers.Commit.t) =
     let open HTML in
+    let short_hash = Resolvers.short_hash commit.hash in
     match commit.message with
-    | None -> li [] [ txt "%s" commit.short_hash ]
+    | None -> li [] [ txt "%s" short_hash ]
     | Some msg ->
         li []
           [
@@ -109,12 +110,12 @@ module Repo = struct
               (Commit (repo, commit.hash))
               (null
                  [
-                   span [ class_ "commit-hash" ] [ txt "%s" commit.short_hash ];
+                   span [ class_ "commit-hash" ] [ txt "%s" short_hash ];
                    txt " — %s" msg;
                  ]);
           ]
 
-  let li_of_entry repo entry =
+  let li_of_entry repo (entry : Resolvers.Entry.t) =
     let display_name =
       if entry.perm = 0o040000 then entry.name ^ "/" else entry.name
     in
@@ -124,12 +125,12 @@ module Repo = struct
     in
     HTML.(li [] [ Routes.link_to route @@ txt "%s" display_name ])
 
-  let summary repo branches commits authors =
+  let summary repo _branches commits authors =
     let content =
       HTML.
         [
           h3 [] [ txt "Branches" ];
-          ul [] (List.map (li_of_branch repo) branches);
+          (* ul [] (List.map (li_of_branch repo) branches); *)
           h3 [] [ txt "Latest commits" ];
           ul [] (List.map (li_of_commit repo) commits);
           h3 [] [ txt "Authors" ];
@@ -140,24 +141,24 @@ module Repo = struct
     @@ Page.render ~page_title:(page_title repo)
          {
            title = repo;
-           subtitle = repo_description repo;
+           subtitle = Resolvers.repo_description repo;
            topnav = Components.Topnav.(v ~active_path:Summary repo);
            content;
          }
 
-  let refs repo branches =
+  let refs repo _branches =
     let content =
       HTML.
         [
           h3 [] [ txt "Branches" ];
-          ul [] (List.map (li_of_branch repo) branches);
+          (* ul [] (List.map (li_of_branch repo) branches); *)
         ]
     in
     respond
     @@ Page.render ~page_title:(page_title repo)
          {
            title = repo;
-           subtitle = repo_description repo;
+           subtitle = Resolvers.repo_description repo;
            topnav = Components.Topnav.(v ~active_path:Refs repo);
            content;
          }
@@ -174,30 +175,29 @@ module Repo = struct
     @@ Page.render ~page_title:(page_title repo)
          {
            title = repo;
-           subtitle = repo_description repo;
+           subtitle = Resolvers.repo_description repo;
            topnav = Components.Topnav.(v ~active_path:Log repo);
            content;
          }
 
-  let files repo tree =
-    let title = Printf.sprintf "%s" repo in
+  let files repo (tree : Resolvers.Tree.t) =
     let content =
       HTML.
         [
-          h3 [] [ txt "Files %s" tree.short_hash ];
+          h3 [] [ txt "Files %s" @@ Resolvers.short_hash tree.hash ];
           ul [] (List.map (li_of_entry repo) tree.entries);
         ]
     in
     respond
     @@ Page.render ~page_title:(page_title repo)
          {
-           title;
-           subtitle = repo_description repo;
+           title = Printf.sprintf "%s" repo;
+           subtitle = Resolvers.repo_description repo;
            topnav = Components.Topnav.(v ~active_path:Files repo);
            content;
          }
 
-  let file repo blob =
+  let file repo (blob : Resolvers.Blob.t) =
     let title = Printf.sprintf "%s" repo in
     let to_numbered_line number line =
       let n = number + 1 in
@@ -218,20 +218,22 @@ module Repo = struct
     @@ Page.render ~page_title:(page_title repo)
          {
            title;
-           subtitle = repo_description repo;
+           subtitle = Resolvers.repo_description repo;
            topnav = Components.Topnav.(v ~active_path:Files repo);
            content;
          }
 
-  let commit repo commit =
+  let commit repo (commit : Resolvers.Commit.t) =
     let message = match commit.message with Some msg -> msg | None -> "" in
-    let title = Printf.sprintf "%s : %s" repo commit.short_hash in
+    let title =
+      Printf.sprintf "%s : %s" repo @@ Resolvers.short_hash commit.hash
+    in
     let content = HTML.[ h3 [] [ txt "%s" message ] ] in
     respond
     @@ Page.render ~page_title:(page_title repo)
          {
            title;
-           subtitle = repo_description repo;
+           subtitle = Resolvers.repo_description repo;
            topnav = Components.Topnav.v repo;
            content;
          }
-- 
cgit v1.2.3