(* -*- mode: tuareg; -*- *)
open Dream_html
open Config
type page = Summary | Commits | Files | Branches | Tags | Readme
type body_data = {
title : string;
repo : string option;
subtitle : string;
active : page;
content : Dream_html.node list;
}
let page_to_nav_item repo = function
| Summary -> (Routes.Repo repo, "Summary", Summary)
| Commits -> (Routes.Commits repo, "Commits", Commits)
| Files -> (Routes.Files repo, "Files", Files)
| Branches -> (Routes.Branches repo, "Branches", Branches)
| Tags -> (Routes.Tags repo, "Tags", Tags)
| Readme -> (Routes.Readme repo, "README", Readme)
module Components = struct
let topnav ?(active = Summary) repo =
let nav_items =
List.map (page_to_nav_item repo)
[ Summary; Commits; Files; Branches; Tags; Readme ]
in
let li_of_item (route, text, path) =
let is_active = path = active in
let attrs = if is_active then [ HTML.id "active" ] else [] in
HTML.li attrs [ Routes.link_to route (txt "%s" text) ]
in
HTML.(nav [ id "top" ] [ ul [] @@ List.map li_of_item nav_items ])
end
module Page = struct
let page_header header1 header2 =
let header2 =
if String.starts_with ~prefix:"Unnamed repository" header2 then ""
else header2
in
HTML.(null [ h1 [] [ txt "%s" header1 ]; h2 [] [ txt "%s" header2 ] ])
let page_footer () =
let now = Unix.(time () |> localtime) in
let year = string_of_int (now.tm_year + 1900) in
let footer_text = Printf.sprintf "Copyright %s %s" year config.user in
HTML.footer [] [ txt "%s" footer_text ]
let render ?(page_title = "Ogit") body_data =
let open HTML in
let bd = body_data in
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 []
[
page_header bd.title bd.subtitle;
(match bd.repo with
| None -> HTML.null []
| Some repo -> Components.topnav ~active:bd.active repo);
div [ id "main" ] bd.content;
page_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
respond
@@ Page.render
{
title = "Ogit";
repo = None;
subtitle = "Repositories for " ^ config.user;
active = Summary;
content = [ all_repositories ];
}
module Repo = struct
let page_title repo =
Printf.sprintf "%s — %s" repo (Resolvers.repo_description repo)
let li_of_author (author : Resolvers.Commit.user) =
HTML.(li [] [ txt "%s" author.name ])
let li_of_branch repo (branch : Resolvers.Reference.t) =
HTML.(li [] [ Routes.link_to (Branches repo) (txt "%s" branch.name) ])
let li_of_tag repo (tag : Resolvers.Reference.t) =
HTML.(li [] [ Routes.link_to (Tags repo) (txt "%s" tag.name) ])
let li_of_commit repo (commit : Resolvers.Commit.t) =
let timestamp (date, _) =
let tm = date |> Int64.to_float |> Unix.localtime in
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.tm_year + 1900)
(tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min
in
let timestamp_span =
(* HTML.(span [ class_ "commit-hash" ] [ txt "%s" commit.datetime ]) *)
HTML.(
span [ class_ "timestamp" ] [ txt "%s" (timestamp commit.author.date) ])
in
let description =
match commit.message with
| None -> HTML.null []
| Some msg -> txt " %s" msg
in
let route = Routes.Commit (repo, commit.hash) in
let node = HTML.null [ timestamp_span; description ] in
HTML.li [] [ Routes.link_to route node ]
let li_of_entry repo (entry : Resolvers.Entry.t) =
let route = Routes.File (repo, entry.hash) in
let text =
txt "%s" (if entry.perm = 0o040000 then entry.name ^ "/" else entry.name)
in
HTML.(li [] [ Routes.link_to route text ])
let summary repo branches commits =
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title = repo;
subtitle = Resolvers.repo_description repo;
active = Summary;
content =
HTML.
[
h3 [] [ txt "Branches" ];
ul [] (List.map (li_of_branch repo) branches);
h3 [] [ txt "Latest commits" ];
ul [] (List.map (li_of_commit repo) commits);
(* h3 [] [ txt "Authors" ]; *)
(* ul [] (List.map li_of_author authors); *)
];
}
let branches repo branches =
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title = repo;
subtitle = Resolvers.repo_description repo;
active = Branches;
content = HTML.[ ul [] @@ List.map (li_of_branch repo) branches ];
}
let tags repo tags =
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title = repo;
subtitle = Resolvers.repo_description repo;
active = Tags;
content = HTML.[ ul [] @@ List.map (li_of_tag repo) tags ];
}
let commits repo commits =
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title = repo;
subtitle = Resolvers.repo_description repo;
active = Commits;
content = HTML.[ ul [] @@ List.map (li_of_commit repo) commits ];
}
let files repo (tree : Resolvers.Tree.t) =
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title = repo;
subtitle = Resolvers.repo_description repo;
active = Files;
content = HTML.[ ul [] @@ List.map (li_of_entry repo) tree.entries ];
}
let file repo (blob : Resolvers.Blob.t) =
let to_numbered_line number line =
let n = number + 1 in
HTML.
[
a [ id "%d" n; class_ "line-anchor"; href "#%d" n ] [ txt "%d" n ];
span [ class_ "line" ] [ txt "\t%s\n" line ];
]
in
let formatted_blob =
String.split_on_char '\n' blob.content
|> List.mapi to_numbered_line |> List.flatten
in
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title = repo;
subtitle = Resolvers.repo_description repo;
active = Files;
content = HTML.[ div [ id "blob" ] formatted_blob ];
}
let commit repo (commit : Resolvers.Commit.t) =
let message = match commit.message with Some msg -> msg | None -> "" in
respond
@@ Page.render ~page_title:(page_title repo)
{
repo = Some repo;
title =
Printf.sprintf "%s : %s" repo @@ Resolvers.short_hash commit.hash;
subtitle = Resolvers.repo_description repo;
active = Summary;
content = HTML.[ h3 [] [ txt "%s" message ] ];
}
end
let error_page message =
let open HTML in
respond
@@ 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.";
];
];
];
]