(* -*- mode: tuareg; -*- *)
open Dream_html
open Git_presenters
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 () = 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
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
HTML.(
div [ id "repositories" ] [ ul [] @@ List.map Routes.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
let page_title repo = Printf.sprintf "%s — %s" repo (repo_description repo)
let li_of_branch repo branch =
HTML.(li [] [ Routes.link_to branch.name (Tag (repo, branch.name)) ])
let li_of_commit repo commit =
match commit.message with
| Some msg ->
HTML.(
li []
[
Routes.link_to
(commit.short_hash ^ " - " ^ msg)
(Commit (repo, commit.hash));
])
| None -> HTML.(li [] [ txt "%s" commit.short_hash ])
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);
h3 [] [ txt "Recent commits" ];
ul [] (List.map li_of_commit 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 li_of_branch = li_of_branch repo in
let content =
HTML.[ h3 [] [ txt "Branches" ]; ul [] (List.map li_of_branch 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 li_of_commit = li_of_commit repo in
let content =
HTML.
[ h3 [] [ txt "All commits" ]; ul [] (List.map li_of_commit commits) ]
in
Page.render ~page_title:(page_title repo)
{
title = repo;
subtitle = repo_description repo;
topnav = Components.topnav repo;
content;
}
let tree repo =
let content = HTML.[ null [] ] in
Page.render ~page_title:(page_title repo)
{
title = repo;
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.";
];
];
];
])