Implement Tree and Blob views.

Getting real close to something good now!

1 files changed, 40 insertions, 16 deletions

diff --git a/lib/views.ml b/lib/views.ml
index b6cf617..e1056b7 100644
--- a/lib/views.ml
+++ b/lib/views.ml
@@ -1,7 +1,6 @@
 (* -*- mode: tuareg; -*- *)
 
 open Dream_html
-open Git_presenters
 open Config
 
 type body_data = {
@@ -16,9 +15,7 @@ module Components = struct
 
   let topnav repo =
     let open HTML in
-    let () = Dream.log "%s" ("current path is: " ^ repo) in
     let li_of_a (path, text) =
-      let () = Dream.log "%s" ("and path is: " ^ path) in
       let is_active = String.ends_with ~suffix:path repo in
       let attrs = if is_active then [ id "active" ] else [] in
       let url = Printf.sprintf "/%s/%s" repo path in
@@ -98,7 +95,10 @@ let root () =
   Page.render body_data
 
 module Repo = struct
+  open Git_presenters
+
   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.(
@@ -120,17 +120,24 @@ module Repo = struct
                  ]);
           ]
 
+  let li_of_entry repo entry =
+    let display_name =
+      if entry.perm = 0o040000 then entry.name ^ "/" else entry.name
+    in
+    let route =
+      if entry.perm = 0o040000 then Routes.Tree (repo, entry.hash)
+      else Routes.Blob (repo, entry.hash)
+    in
+    HTML.(li [] [ Routes.link_to route @@ txt "%s" display_name ])
+
   let summary repo branches commits authors =
-    let li_of_branch = li_of_branch repo in
-    let li_of_commit = li_of_commit repo in
-    let li_of_author author = HTML.(li [] [ txt "%s" author ]) in
     let content =
       HTML.
         [
           h3 [] [ txt "Branches" ];
-          ul [] (List.map li_of_branch branches);
+          ul [] (List.map (li_of_branch repo) branches);
           h3 [] [ txt "Recent commits" ];
-          ul [] (List.map li_of_commit commits);
+          ul [] (List.map (li_of_commit repo) commits);
           h3 [] [ txt "Authors" ];
           ul [] (List.map li_of_author authors);
         ]
@@ -144,9 +151,12 @@ module Repo = struct
       }
 
   let refs repo branches =
-    let li_of_branch = li_of_branch repo in
     let content =
-      HTML.[ h3 [] [ txt "Branches" ]; ul [] (List.map li_of_branch branches) ]
+      HTML.
+        [
+          h3 [] [ txt "Branches" ];
+          ul [] (List.map (li_of_branch repo) branches);
+        ]
     in
     Page.render ~page_title:(page_title repo)
       {
@@ -157,10 +167,12 @@ module Repo = struct
       }
 
   let log repo commits =
-    let li_of_commit = li_of_commit repo in
     let content =
       HTML.
-        [ h3 [] [ txt "All commits" ]; ul [] (List.map li_of_commit commits) ]
+        [
+          h3 [] [ txt "All commits" ];
+          ul [] (List.map (li_of_commit repo) commits);
+        ]
     in
     Page.render ~page_title:(page_title repo)
       {
@@ -171,13 +183,12 @@ module Repo = struct
       }
 
   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 title = Printf.sprintf "%s" repo in
     let content =
       HTML.
         [
           h3 [] [ txt "Tree %s" tree.short_hash ];
-          ul [] (List.map li_of_entry tree.entries);
+          ul [] (List.map (li_of_entry repo) tree.entries);
         ]
     in
     Page.render ~page_title:(page_title repo)
@@ -188,6 +199,19 @@ module Repo = struct
         content;
       }
 
+  let blob repo blob =
+    let title = Printf.sprintf "%s" repo in
+    let content =
+      HTML.[ h3 [] [ txt "Blob" ]; p [] [ txt "%s" blob.content ] ]
+    in
+    Page.render ~page_title:(page_title repo)
+      {
+        title;
+        subtitle = repo_description repo;
+        topnav = Components.topnav repo;
+        content;
+      }
+
   let commit repo commit =
     let message = match commit.message with Some msg -> msg | None -> "" in
     let title = Printf.sprintf "%s : %s" repo commit.short_hash in
@@ -207,7 +231,7 @@ let error_page message =
       [
         head []
           [
-            title [] "Fatal Error";
+            title [] "Fatal error";
             link [ rel "stylesheet"; href "/static/styles.css" ];
             link
               [ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];