Start work on Trees.

Making slow but steady progress...  Bulldozer mindset.

5 files changed, 109 insertions, 37 deletions

diff --git a/lib/config.ml b/lib/config.ml
index 540a5d0..7e037ef 100644
--- a/lib/config.ml
+++ b/lib/config.ml
@@ -69,5 +69,4 @@ let read_file ?(file = config_file) () =
     prerr_endline "[config.ml] Falling back to default config.";
     Ok default
 
-let config =
-  match read_file ~file:config_file () with Ok cfg -> cfg | Error _ -> default
+let config = match read_file () with Ok cfg -> cfg | Error _ -> default
diff --git a/lib/dune b/lib/dune
index 8a23695..d011235 100644
--- a/lib/dune
+++ b/lib/dune
@@ -3,5 +3,5 @@
 (library
  (name ogit)
  (libraries dream dream-html git-unix toml)
- (preprocess (pps dream-html.ppx)))
-
+ (preprocess
+  (pps dream-html.ppx)))
diff --git a/lib/git_presenters.ml b/lib/git_presenters.ml
index feff7ac..f0a0317 100644
--- a/lib/git_presenters.ml
+++ b/lib/git_presenters.ml
@@ -27,11 +27,11 @@ type commit = {
   message : string option;
 }
 
-let to_commit store h =
-  let* v = Store.read store h in
+let to_commit store hash =
+  let* v = Store.read store hash in
   match v with
   | Git.Value.Commit c ->
-      let hash = Store.Hash.to_hex h in
+      let hash = Store.Hash.to_hex hash in
       Lwt_result.return
         {
           hash;
@@ -40,7 +40,12 @@ let to_commit store h =
           author = Store.Value.Commit.author c;
           message = Store.Value.Commit.message c;
         }
-  | _ -> Lwt_result.fail @@ `Msg "value is not a commit"
+  | _ -> 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
@@ -56,18 +61,66 @@ let recent_commits repo n =
   in
   walk [] head n
 
-let of_id repo id =
-  let* store = store repo in
-  let id = Store.Hash.of_hex id in
-  to_commit store id
-
-type branch = { name : string }
+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 (ref, _) -> { name = Git.Reference.to_string ref }) refs
+    List.map
+      (fun (ref, hash) ->
+        { name = Git.Reference.to_string ref; hash = Store.Hash.to_hex 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 }
+
+let to_entry _ =
+  {
+    hash = "foo";
+    short_hash = String.sub "foobar" 0 8;
+    name = "foobarbino";
+    perm = 122;
+  }
+
+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
+  | 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 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
+  | Git.Value.Commit commit ->
+      Store.Value.Commit.tree commit |> Lwt_result.return
+  | _ ->
+      Dream.log "no head tree id";
+      Lwt_result.fail (`Msg "")
+
+let head_tree repo =
+  let* store = store repo in
+  let* hash = head_tree_id store in
+  to_tree store hash
+
+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
diff --git a/lib/handlers.ml b/lib/handlers.ml
index 8771f5f..17f3ac0 100644
--- a/lib/handlers.ml
+++ b/lib/handlers.ml
@@ -10,10 +10,11 @@ module Repo = struct
     m >>= function
     | Ok x -> f x
     | Error e ->
-        let msg = Format.asprintf "%a" Git_unix.Store.pp_error e in
+        let msg = Format.asprintf "%a" Store.pp_error e in
         Views.error_page msg |> Dream_html.respond
 
-  let repo req = Dream.param req "repo_name"
+  let repo req = Dream.param req "repo"
+  let id_of_req req = Dream.param req "id"
 
   let summary req =
     let* branches = all_branches (repo req) in
@@ -29,25 +30,36 @@ module Repo = struct
     let* commits = recent_commits (repo req) 100 in
     Views.Repo.log (repo req) commits |> Dream_html.respond
 
-  let tree req = Views.Repo.tree (repo req) |> Dream_html.respond
+  let tree_head req =
+    Dream.log "Tree head";
+    let* tree = head_tree (repo req) in
+    Views.Repo.tree (repo req) tree |> Dream_html.respond
+
+  let tree_id req =
+    Dream.log "Tree id";
+    let id = id_of_req req in
+    let* tree = tree_of_id (repo req) id in
+    Views.Repo.tree (repo req) tree |> Dream_html.respond
 
   let commit req =
-    let id = match Dream.query req "id" with Some id -> id | None -> "" in
-    let* commit = of_id (repo req) id in
+    let id = id_of_req req in
+    let* commit = commit_of_id (repo req) id in
     Views.Repo.commit (repo req) commit |> Dream_html.respond
 end
 
 let all_handlers =
-  [
-    Dream.get "/" root;
-    Dream.scope "/:repo_name" []
-      Repo.
-        [
-          Dream.get "/" summary;
-          Dream.get "/refs/" refs;
-          Dream.get "/log/" log;
-          Dream.get "/tree/" tree;
-          Dream.get "/commit/" commit;
-        ];
-    Dream.get "/static/**" (Dream.static "./lib/static");
-  ]
+  Dream.
+    [
+      get "/" root;
+      scope "/:repo" []
+        Repo.
+          [
+            get "/" summary;
+            get "/refs/" refs;
+            get "/log/" log;
+            get "/tree/" tree_head;
+            get "/tree/:id" tree_id;
+            get "/commit/:id" commit;
+          ];
+      get "/static/**" (static "./lib/static");
+    ]
diff --git a/lib/views.ml b/lib/views.ml
index 33654ea..283d8d9 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -98,7 +98,7 @@ let root () =
 module Repo = struct
   let page_title repo = Printf.sprintf "%s — %s" repo (repo_description repo)
 
-  let li_of_branch repo branch =
+  let li_of_branch repo (branch : branch) =
     HTML.(li [] [ Routes.link_to branch.name (Tag (repo, branch.name)) ])
 
   let li_of_commit repo commit =
@@ -163,11 +163,19 @@ module Repo = struct
         content;
       }
 
-  let tree repo =
-    let content = HTML.[ null [] ] in
+  let tree repo tree =
+    let title = Printf.sprintf "%s : %s" repo tree.short_hash in
+    let li_of_entry entry = HTML.(li [] [ txt "%s" entry.name ]) in
+    let content =
+      HTML.
+        [
+          h3 [] [ txt "Tree %s" tree.short_hash ];
+          ul [] (List.map li_of_entry tree.entries);
+        ]
+    in
     Page.render ~page_title:(page_title repo)
       {
-        title = repo;
+        title;
         subtitle = repo_description repo;
         topnav = Components.topnav repo;
         content;