type head_data = { page_title : string } type body_data = { title : string; subtitle : string; topnav : Dream_html.node; content : Dream_html.node list; } module Layout = struct open Dream_html open HTML let header title subtitle = 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.author in footer [] [ txt "%s" footer_text ] let default_head_data = { page_title = "Ogit" } let application ?(head_data = default_head_data) body_data = html [] [ head [] [ title [] "%s" head_data.page_title; link [ rel "stylesheet"; href "/static/styles.css" ]; ]; body [] [ header "Ogit" body_data.subtitle; body_data.topnav; div [ id "main" ] body_data.content; footer; ]; ] end module Ogit_root = struct open Dream_html open HTML let repositories_in directory = try let repos = Sys.readdir directory |> Array.to_list |> List.sort String.compare in let li_of_repo repo = li [] [ a [ href "%s" repo ] [ txt "%s" repo ] ] in div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ] with Sys_error _ -> div [] [ txt "Error: Unable to read repository list." ] let body_data = { title = "My repositories"; subtitle = "Repositories for " ^ Config.author; topnav = null []; content = [ repositories_in Config.git_directory ]; } let render () = Layout.application body_data end module Repo_root = struct open Dream_html open HTML (* open Lwt.Syntax *) let render repo_path = (* let* title_result = Git_helpers.get_head_commit_hash repo_path in *) (* let title = *) (* match title_result with Ok hash -> hash | Error msg -> "Error: " ^ msg *) (* in *) let title = "Finble" in let subtitle = Filename.concat Config.git_directory repo_path in let topnav = nav [ id "top" ] [ ul [] [ li [] [ a [ href "/" ] [ txt "summary" ] ]; li [] [ a [ href "/" ] [ txt "refs" ] ]; li [] [ a [ href "/" ] [ txt "log" ] ]; li [] [ a [ href "/" ] [ txt "tree" ] ]; li [] [ a [ href "/" ] [ txt "commit" ] ]; li [] [ a [ href "/" ] [ txt "diff" ] ]; ]; ] in let recent_commits = Git_unhelpers.get_git_log repo_path in let li_of_commit commit = li [] [ a [ href "%s" commit ] [ txt "%s" commit ] ] in let content = [ h3 [] [ txt "Recent commits" ]; ul [] @@ List.map li_of_commit recent_commits; ] in let body_data = { title; subtitle; topnav; content } in Lwt.return @@ Layout.application body_data end module Repo_tree = struct open Dream_html open HTML open Lwt.Syntax let render repo_path = let* title_result = Git_helpers.get_head_commit_hash repo_path in let title = match title_result with Ok hash -> hash | Error msg -> "Error: " ^ msg in let subtitle = "Dinglefops" in let topnav = null [] in let content = [ txt "foobar" ] in let body_data = { title; subtitle; topnav; content } in Lwt.return @@ Layout.application body_data end