(* -*- 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."; ]; ]; ]; ]