(* -*- 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 module Topnav = struct type t = None | Summary | Log | Files | Refs let v ?(active_path = None) repo = let open HTML in let nav_items = [ (Routes.Repo repo, "Summary", Summary); (Routes.Log repo, "Log", Log); (Routes.Files repo, "Files", Files); (Routes.Refs repo, "Refs", Refs); ] in let li_of_item (route, text, path) = let is_active = path = active_path in let attrs = if is_active then [ id "active" ] else [] in HTML.li attrs [ Routes.link_to route (txt "%s" text) ] in nav [ id "top" ] [ ul [] @@ List.map li_of_item nav_items ] end 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 respond @@ 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 (Refs repo) (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.Files repo else Routes.File (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 "Latest commits" ]; ul [] (List.map (li_of_commit repo) commits); h3 [] [ txt "Authors" ]; ul [] (List.map li_of_author authors); ] in respond @@ Page.render ~page_title:(page_title repo) { title = repo; subtitle = repo_description repo; topnav = Components.Topnav.(v ~active_path:Summary repo); content; } let refs repo branches = let content = HTML. [ h3 [] [ txt "Branches" ]; ul [] (List.map (li_of_branch repo) branches); ] in respond @@ Page.render ~page_title:(page_title repo) { title = repo; subtitle = repo_description repo; topnav = Components.Topnav.(v ~active_path:Refs repo); content; } let log repo commits = let content = HTML. [ h3 [] [ txt "All commits" ]; ul [] (List.map (li_of_commit repo) commits); ] in respond @@ Page.render ~page_title:(page_title repo) { title = repo; subtitle = repo_description repo; topnav = Components.Topnav.(v ~active_path:Log repo); content; } let files repo tree = let title = Printf.sprintf "%s" repo in let content = HTML. [ h3 [] [ txt "Files %s" tree.short_hash ]; ul [] (List.map (li_of_entry repo) tree.entries); ] in respond @@ Page.render ~page_title:(page_title repo) { title; subtitle = repo_description repo; topnav = Components.Topnav.(v ~active_path:Files repo); content; } let file repo blob = let title = Printf.sprintf "%s" repo in 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 let content = HTML.[ h3 [] [ txt "File" ]; div [ id "blob" ] formatted_blob ] in respond @@ Page.render ~page_title:(page_title repo) { title; subtitle = repo_description repo; topnav = Components.Topnav.(v ~active_path:Files 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 respond @@ Page.render ~page_title:(page_title repo) { title; subtitle = repo_description repo; topnav = Components.Topnav.v 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."; ]; ]; ]; ])