(* -*- mode: tuareg; -*- *)
open Dream_html
open Config
type body_data = {
title : string;
subtitle : string;
topnav : Dream_html.node;
content : Dream_html.node list;
}
module Components = struct
open Dream_html
let topnav repo =
let open HTML in
let li_of_a (path, text) =
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
li attrs [ a [ href "%s" url ] [ txt text ] ]
in
nav
[ id "top" ]
[
ul []
@@ List.map li_of_a
[
("", "summary");
("refs/", "refs");
("log/", "log");
("tree/", "tree");
("commit/", "commit");
];
]
end
module Page = struct
open Dream_html
open HTML
let header title subtitle =
let subtitle =
if String.starts_with ~prefix:"Unnamed repository" subtitle then ""
else subtitle
in
null [ h1 [] [ txt "%s" title ]; h2 [] [ txt "%s" subtitle ] ]
let footer () =
let today = Unix.localtime (Unix.time ()) in
let year = string_of_int (today.Unix.tm_year + 1900) in
let footer_text = Printf.sprintf "Copyright %s %s" year config.user in
footer [] [ txt "%s" footer_text ]
let render ?(page_title = "Ogit") body_data =
html []
[
head []
[
title [] "%s" page_title;
link [ rel "stylesheet"; href "/static/styles.css" ];
link
[ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
];
body []
[
header body_data.title body_data.subtitle;
body_data.topnav;
div [ id "main" ] body_data.content;
footer ();
];
]
end
let root () =
let all_repositories =
let repos =
Sys.readdir config.git_project_root
|> Array.to_list |> List.sort String.compare
in
let li_of_repo repo =
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
in
HTML.(div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ])
in
let body_data =
{
title = "Ogit";
subtitle = "Repositories for " ^ config.user;
topnav = HTML.null [];
content = [ all_repositories ];
}
in
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.(
li [] [ Routes.link_to (Tag (repo, branch.name)) (txt "%s" branch.name) ])
let li_of_commit repo commit =
let open HTML in
match commit.message with
| None -> li [] [ txt "%s" commit.short_hash ]
| Some msg ->
li []
[
Routes.link_to
(Commit (repo, commit.hash))
(null
[
span [ class_ "commit-hash" ] [ txt "%s" commit.short_hash ];
txt " — %s" msg;
]);
]
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 content =
HTML.
[
h3 [] [ txt "Branches" ];
ul [] (List.map (li_of_branch repo) branches);
h3 [] [ txt "Recent commits" ];
ul [] (List.map (li_of_commit repo) commits);
h3 [] [ txt "Authors" ];
ul [] (List.map li_of_author authors);
]
in
Page.render ~page_title:(page_title repo)
{
title = repo;
subtitle = repo_description repo;
topnav = Components.topnav repo;
content;
}
let refs repo branches =
let content =
HTML.
[
h3 [] [ txt "Branches" ];
ul [] (List.map (li_of_branch repo) branches);
]
in
Page.render ~page_title:(page_title repo)
{
title = repo;
subtitle = repo_description repo;
topnav = Components.topnav repo;
content;
}
let log repo commits =
let content =
HTML.
[
h3 [] [ txt "All commits" ];
ul [] (List.map (li_of_commit repo) commits);
]
in
Page.render ~page_title:(page_title repo)
{
title = repo;
subtitle = repo_description repo;
topnav = Components.topnav repo;
content;
}
let tree repo tree =
let title = Printf.sprintf "%s" repo in
let content =
HTML.
[
h3 [] [ txt "Tree %s" tree.short_hash ];
ul [] (List.map (li_of_entry repo) tree.entries);
]
in
Page.render ~page_title:(page_title repo)
{
title;
subtitle = repo_description repo;
topnav = Components.topnav repo;
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
let content = HTML.[ h3 [] [ txt "%s" message ] ] in
Page.render ~page_title:(page_title repo)
{
title;
subtitle = repo_description repo;
topnav = Components.topnav repo;
content;
}
end
let error_page message =
HTML.(
html []
[
head []
[
title [] "Fatal error";
link [ rel "stylesheet"; href "/static/styles.css" ];
link
[ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
];
body []
[
h1 [] [ txt "Fatal Error" ];
div
[ id "main" ]
[
p [] [ b [] [ txt "%s" message ] ];
p []
[
txt
"Your best course of action is to press the 'back' \
button in your browser.";
];
];
];
])