Implement Tree and Blob views.

Getting real close to something good now!

1 files changed, 16 insertions, 16 deletions

diff --git a/lib/routes.ml b/lib/routes.ml
index c136152..84c2851 100644
--- a/lib/routes.ml
+++ b/lib/routes.ml
@@ -1,29 +1,29 @@
 (* -*- mode: tuareg; -*- *)
 
-open Dream_html
-open HTML
-
 type t =
   | Root
   | Repo of string
   | Tag of string * string
   | Commit of string * string
-  | Tree of string * string * string
-  | Blob of string * string * string
+  | Tree of string * string
+  | Blob of string * string
 
 let%path root_path = "/"
 let%path repo_path = "/%s/"
 let%path tag_path = "/%s/refs/%s"
 let%path commit_path = "/%s/commit/%s"
-let%path tree_path = "/%s/tree/%s/%s"
-let%path blob_path = "/%s/blob/%s/%s"
-
-let path_attr = function
-  | Root -> path_attr href root_path
-  | Repo repo -> path_attr href repo_path repo
-  | Tag (repo, branch) -> path_attr href tag_path repo branch
-  | Commit (repo, commit) -> path_attr href commit_path repo commit
-  | Tree (repo, commit, path) -> path_attr href tree_path repo commit path
-  | Blob (repo, commit, path) -> path_attr href blob_path repo commit path
+let%path tree_path = "/%s/tree/%s"
+let%path blob_path = "/%s/blob/%s"
 
-let link_to route content = a [ path_attr route ] [ content ]
+let link_to route contents =
+  let open Dream_html in
+  let open HTML in
+  let path = function
+    | Root -> path_attr href root_path
+    | Repo repo -> path_attr href repo_path repo
+    | Tag (repo, branch) -> path_attr href tag_path repo branch
+    | Commit (repo, commit) -> path_attr href commit_path repo commit
+    | Tree (repo, hash) -> path_attr href tree_path repo hash
+    | Blob (repo, hash) -> path_attr href blob_path repo hash
+  in
+  a [ path route ] [ contents ]