lib/routes.ml


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

(* -*- mode: tuareg; -*- *)

type t =
  | Root
  | Repo of string
  | Tag of string * string
  | Commit of 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"
let%path blob_path = "/%s/blob/%s"

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 ]