diff options
| -rw-r--r-- | lib/git_helpers.ml | 91 | ||||
| -rw-r--r-- | lib/handlers.ml | 54 | ||||
| -rw-r--r-- | lib/static/styles.css | 7 | ||||
| -rw-r--r-- | lib/views.ml | 215 |
4 files changed, 204 insertions, 163 deletions
diff --git a/lib/git_helpers.ml b/lib/git_helpers.ml index 5e5d4cd..ed917a8 100644 --- a/lib/git_helpers.ml +++ b/lib/git_helpers.ml @@ -4,13 +4,6 @@ module Value = Git.Value type user_record = { name : string; email : string } -type commit_record = { - hash : string; - parents : string list; - author : Git.User.t; - message : string option; -} - let full_path path = Filename.concat Config.git_directory path let store repo_path = @@ -23,39 +16,51 @@ let repo_description repo_path = let description_path = Filename.concat (full_path repo_path) "description" in In_channel.with_open_text description_path In_channel.input_all -(* Read a Git object and turn it into our [commit_record], or propagate an error. *) -let get_commit_record store h = - Store.read store h >>= function - | Ok (Value.Commit c) -> - Lwt.return_ok - { - hash = Store.Hash.to_hex h; - parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex; - author = Store.Value.Commit.author c; - message = Store.Value.Commit.message c; - } - | Ok _ -> Lwt.return_error (`Msg "object is not a commit") - | Error e -> Lwt.return_error e - -let recent_commits repo_path n = - let open Lwt_result.Syntax in - let* store = store repo_path in - let* head = Store.Ref.resolve store Git.Reference.head in - let rec walk acc hash count = - if count = 0 then Lwt.return_ok (List.rev acc) - else - get_commit_record store hash >>= function - | Error e -> Lwt.return_error e - | Ok commit -> ( - match commit.parents with - | parent :: _ -> - walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1) - | [] -> Lwt.return_ok (List.rev (commit :: acc))) - in - walk [] head n - -let get_commit repo_path id = - let open Lwt_result.Syntax in - let* store = store repo_path in - let id = Store.Hash.of_hex id in - get_commit_record store id +module Commit = struct + type t = { + hash : string; + parents : string list; + author : Git.User.t; + message : string option; + } + + let of_hash store h = + Store.read store h >>= function + | Ok (Value.Commit c) -> + Lwt_result.return + { + hash = Store.Hash.to_hex h; + parents = Store.Value.Commit.parents c |> List.map Store.Hash.to_hex; + author = Store.Value.Commit.author c; + message = Store.Value.Commit.message c; + } + | Ok _ -> Lwt.return_error (`Msg "object is not a commit") + | Error e -> Lwt.return_error e + + let recent_commits repo_path n = + let open Lwt_result.Syntax in + let* store = store repo_path in + let* head = Store.Ref.resolve store Git.Reference.head in + let rec walk acc hash count = + if count = 0 then Lwt_result.return (List.rev acc) + else + of_hash store hash >>= function + | Error e -> Lwt.return_error e + | Ok commit -> ( + match commit.parents with + | parent :: _ -> + walk (commit :: acc) (Store.Hash.of_hex parent) (count - 1) + | [] -> Lwt_result.return (List.rev (commit :: acc))) + in + walk [] head n + + let of_id repo_path id = + let open Lwt_result.Syntax in + let* store = store repo_path in + let id = Store.Hash.of_hex id in + of_hash store id +end + +module Branch = struct + let all_branches repo_path = [ "foo"; "bar"; repo_path ] +end diff --git a/lib/handlers.ml b/lib/handlers.ml index 95aecd3..321c693 100644 --- a/lib/handlers.ml +++ b/lib/handlers.ml @@ -6,41 +6,39 @@ let ( let* ) m f = let msg = Format.asprintf "%a" Git_unix.Store.pp_error e in Views.error_page msg |> Dream_html.respond -let ogit_root _req = Views.ogit_root () |> Dream_html.respond +let root _req = Views.root () |> Dream_html.respond -let repo_summary req = - let repo_path = Dream.param req "repo_name" in - let branches = [ "bing"; "bong" ] in - let* commits = Git_helpers.recent_commits repo_path 10 in - Views.repo_summary repo_path branches commits |> Dream_html.respond +module Repo = struct + let repo_path req = Dream.param req "repo_name" -let repo_commit req = - let repo_path = Dream.param req "repo_name" in - let id = match Dream.query req "id" with Some id -> id | None -> "" in - let* commit = Git_helpers.get_commit repo_path id in - Views.repo_commit repo_path commit |> Dream_html.respond + let summary req = + let branches = Git_helpers.Branch.all_branches (repo_path req) in + let* commits = Git_helpers.Commit.recent_commits (repo_path req) 10 in + let authors = [ "John Pork"; "Sebastian Jellybean" ] in + Views.Repo.summary (repo_path req) branches commits authors + |> Dream_html.respond -(* let repo_tree req = *) -(* let repo_name = Dream.param req "repo_name" in *) -(* let path = Git_helpers.full_path repo_name in *) -(* let dir_path = Dream.target req in *) -(* Views.repo_tree ~repo_path:path dir_path |> Dream_html.respond *) + let refs req = Views.Repo.refs (repo_path req) |> Dream_html.respond + let log req = Views.Repo.log (repo_path req) |> Dream_html.respond + let tree req = Views.Repo.tree (repo_path req) |> Dream_html.respond -(* let repo_blob req = *) -(* let repo_name = Dream.param req "repo_name" in *) -(* let path = Git_helpers.full_path repo_name in *) -(* let blob_path = Dream.query req "path" |> Option.value ~default:"" in *) -(* Views.repo_blob repo_name blob_path |> Dream_html.respond *) + let commit req = + let id = match Dream.query req "id" with Some id -> id | None -> "" in + let* commit = Git_helpers.Commit.of_id (repo_path req) id in + Views.Repo.commit (repo_path req) commit |> Dream_html.respond +end let all_handlers = [ - Dream.get "/" ogit_root; + Dream.get "/" root; Dream.scope "/:repo_name" [] - [ - Dream.get "/" repo_summary; - Dream.get "/commit/" repo_commit; - (* Dream.get "/tree" repo_tree; *) - (* Dream.get "/blob" repo_blob; *) - ]; + Repo. + [ + Dream.get "/" summary; + Dream.get "/refs/" refs; + Dream.get "/log/" log; + Dream.get "/tree/" tree; + Dream.get "/commit/" commit; + ]; Dream.get "/static/**" (Dream.static "./lib/static"); ] diff --git a/lib/static/styles.css b/lib/static/styles.css index de2c3db..ae8a86c 100644 --- a/lib/static/styles.css +++ b/lib/static/styles.css @@ -69,3 +69,10 @@ div#main a:hover { color: black; text-decoration: revert; } + +h1 { + position: sticky; + top: 0; + background: inherit; + padding: 0.5em 0; +} diff --git a/lib/views.ml b/lib/views.ml index 3c1330e..e023236 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -3,11 +3,39 @@ 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 +module Components = struct + open Dream_html + + let topnav current_path = + let open HTML in + let li_of_a (path, text) = + let is_active = path = current_path in + let attrs = if is_active then [ id "active" ] else [] in + let url = + if String.equal path "/" then Printf.sprintf "/%s/" current_path + else Printf.sprintf "/%s/%s" current_path 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 @@ -22,7 +50,7 @@ module Layout = struct let default_head_data = { page_title = "Ogit" } - let application ?(head_data = default_head_data) body_data = + let render ?(head_data = default_head_data) body_data = html [] [ head [] @@ -35,44 +63,14 @@ module Layout = struct body [] [ header body_data.title body_data.subtitle; - body_data.topnav; + Components.topnav body_data.title; div [ id "main" ] body_data.content; footer (); ]; ] end -module Components = struct - open Dream_html - - let topnav repo_path current_path = - let open HTML in - let li_of_a (path, text) = - let is_active = path = current_path in - let attrs = if is_active then [ id "active" ] else [] in - let url = - if String.equal path "/" then Printf.sprintf "/%s/" repo_path - else Printf.sprintf "/%s/%s" repo_path 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"); - ("diff", "diff"); - ]; - ] -end - -let ogit_root () = +let root () = let open Dream_html in let repositories_in directory = let repos = @@ -87,60 +85,88 @@ let ogit_root () = { title = "Ogit"; subtitle = "Repositories for " ^ Config.author; - topnav = HTML.(null []); content = [ repositories_in Config.git_directory ]; } in - Layout.application body_data + Page.render body_data -let repo_summary repo_path branches commits = - let open Git_helpers in - let open Dream_html in - let li_of_branch branch = - HTML.(li [] [ a [ href "%s" branch ] [ txt "%s" branch ] ]) - in - let li_of_commit commit = - match commit.message with - | Some msg -> - HTML.( - li [] - [ - a - [ href "commit/?id=%s" commit.hash ] - [ txt "%s %s" (short_hash commit.hash) msg ]; - ]) - | None -> HTML.(li [] [ a [ href "" ] [ txt "caca!!" ] ]) - 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); - ] - in - Layout.application - { - title = repo_path; - subtitle = repo_description repo_path; - topnav = Components.topnav repo_path ""; - content; - } +module Repo = struct + let summary repo_path branches commits authors = + let open Dream_html in + let li_of_branch branch = + HTML.(li [] [ a [ href "%s" branch ] [ txt "%s" branch ] ]) + in + let li_of_commit (commit : Git_helpers.Commit.t) = + match commit.message with + | Some msg -> + HTML.( + li [] + [ + a + [ href "commit/?id=%s" commit.hash ] + [ txt "%s %s" (Git_helpers.short_hash commit.hash) msg ]; + ]) + | None -> HTML.(li [] [ a [ href "" ] [ txt "caca!!" ] ]) + in + let li_of_author author = + HTML.(li [] [ a [ href "" ] [ 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 + { + title = repo_path; + subtitle = Git_helpers.repo_description repo_path; + content; + } -let repo_commit repo_path commit = - let open Git_helpers in - let open Dream_html in - let message = match commit.message with Some msg -> msg | None -> "" in - let content = HTML.[ h3 [] [ txt "%s" message ] ] in - let title = Printf.sprintf "%s : %s" repo_path (short_hash commit.hash) in - Layout.application - { - title; - subtitle = ""; - topnav = Components.topnav repo_path ""; - content; - } + let refs repo_path = + let open Dream_html in + Page.render + HTML. + { + title = repo_path; + subtitle = Git_helpers.repo_description repo_path; + content = [ null [] ]; + } + + let log repo_path = + let open Dream_html in + Page.render + HTML. + { + title = repo_path; + subtitle = Git_helpers.repo_description repo_path; + content = [ null [] ]; + } + + let tree repo_path = + let open Dream_html in + Page.render + HTML. + { + title = repo_path; + subtitle = Git_helpers.repo_description repo_path; + content = [ null [] ]; + } + + let commit repo_path (commit : Git_helpers.Commit.t) = + let open Dream_html in + let open Git_helpers in + let message = match commit.message with Some msg -> msg | None -> "" in + let content = HTML.[ h3 [] [ txt "%s" message ] ] in + let title = Printf.sprintf "%s : %s" repo_path (short_hash commit.hash) in + Page.render { title; subtitle = ""; content } +end let error_page message = let open Dream_html in @@ -149,19 +175,24 @@ let error_page message = [ head [] [ - title [] "Big error"; + 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 "Major error alert" ]; - h2 [] [ txt "Major alert subtitle" ]; - (* Components.topnav; *) - div [ id "main" ] [ txt "%s" message ]; + 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."; + ]; + ]; ]; ]) - -let repo_tree repo_path = repo_summary repo_path -let repo_blob repo_path = repo_summary repo_path |