From 4946275b48bfc92ce4b420e36c6cf48694776bbc Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sat, 1 Mar 2025 19:19:30 +0100 Subject: Start work on Git "un"helper functions. Worse is better. I'll revisit the OCaml Git package once I'm more comfortable with OCaml overall. --- lib/config.ml | 2 +- lib/dune | 2 +- lib/git_helpers.ml | 25 +++++---------- lib/git_unhelpers.ml | 19 ++++++++++++ lib/handlers.ml | 2 +- lib/static/styles.css | 28 ++++++++++++++--- lib/views.ml | 85 ++++++++++++++++++++++++++++++++------------------- 7 files changed, 107 insertions(+), 56 deletions(-) create mode 100644 lib/git_unhelpers.ml diff --git a/lib/config.ml b/lib/config.ml index c391c43..d47101f 100644 --- a/lib/config.ml +++ b/lib/config.ml @@ -1,2 +1,2 @@ let git_directory = Filename.concat (Unix.getenv "HOME") "git" -let author = "Marius PETER" +let author = "Marius Peter" diff --git a/lib/dune b/lib/dune index 3963ffd..076d7c6 100644 --- a/lib/dune +++ b/lib/dune @@ -1,5 +1,5 @@ (library (name ogit) - (libraries dream dream-html git git-unix) + (libraries unix dream dream-html git git-unix) (preprocess (pps lwt_ppx))) diff --git a/lib/git_helpers.ml b/lib/git_helpers.ml index d973a88..0626d02 100644 --- a/lib/git_helpers.ml +++ b/lib/git_helpers.ml @@ -1,20 +1,11 @@ open Lwt.Infix -open Git_unix let get_head_commit_hash repo_path = - let root = Fpath.v repo_path in - - (* 1. Open the Git repository *) - let%lwt repo = - Store.v root >>= function - | Ok repo -> Lwt.return repo - | Error _ -> Lwt.fail_with "Could not open the Git repository." - in - - (* 2. Resolve HEAD to get the latest commit hash *) - let%lwt commit_hash = - Git_unix.Store.Ref.resolve repo Git.Reference.master >>= function - | Ok hash -> Lwt.return hash - | Error _ -> Lwt.fail_with "Failed to resolve HEAD" - in - Lwt.return @@ (commit_hash |> Digestif.SHA1.to_hex) + let full_path = Filename.concat Config.git_directory repo_path in + let%lwt store_result = Git_unix.Store.v @@ Fpath.v full_path in + match store_result with + | Error _ -> Lwt.return_error "Could not open the Git repository." + | Ok store -> ( + Git_unix.Store.Ref.resolve store Git.Reference.head >|= function + | Error _ -> Error ("Failed to resolve HEAD for repo " ^ repo_path) + | Ok hash -> Ok (Git_unix.Store.Hash.to_hex hash)) diff --git a/lib/git_unhelpers.ml b/lib/git_unhelpers.ml new file mode 100644 index 0000000..28d4d3a --- /dev/null +++ b/lib/git_unhelpers.ml @@ -0,0 +1,19 @@ +(* These will be reimplemented using OCaml's Git library, one day... *) + +let get_git_log repo_path = + let full_path = Filename.concat Config.git_directory repo_path in + let full_cmd = + let cmd = Printf.sprintf "git -C %s log" full_path in + let options = [ "--pretty=format:'%ad %s'"; "--date=short"; "-n 10" ] in + String.concat " " (cmd :: options) + in + let ic = Unix.open_process_in full_cmd in + let rec read_lines acc = + try + let line = input_line ic in + read_lines (line :: acc) + with End_of_file -> + ignore (Unix.close_process_in ic); + List.rev acc + in + read_lines [] diff --git a/lib/handlers.ml b/lib/handlers.ml index 7c80bcb..4a6e0ca 100644 --- a/lib/handlers.ml +++ b/lib/handlers.ml @@ -1,6 +1,6 @@ open Lwt.Infix -let ogit_root _ = Views.Ogit_root.render () >>= Dream_html.respond +let ogit_root _ = Views.Ogit_root.render () |> Dream_html.respond let repo_root repo_name = Views.Repo_root.render repo_name >>= Dream_html.respond diff --git a/lib/static/styles.css b/lib/static/styles.css index 680a6b1..cd87fc1 100644 --- a/lib/static/styles.css +++ b/lib/static/styles.css @@ -1,18 +1,25 @@ body { font-family: sans-serif; + max-width: 60em; + margin: auto; + padding: 0 1em; + background-color: #181818; + color: white; } nav#top { - background-color: dimgray; + background-color: black; } nav#top ul { - display: flex; + display: flex; + flex-wrap: wrap; list-style-type: none; + padding: 0; } nav#top ul li { - padding: 1em 0; + padding: 0.5em 0; } nav#top ul li a { @@ -22,6 +29,19 @@ nav#top ul li a { } nav#top ul li a:hover { - background-color: #555; + background-color: white; + color: black; text-decoration: revert; } + +ul { + padding-left: 1em; +} + +li { + line-height: 1.5; +} + +a { + color: white; +} diff --git a/lib/views.ml b/lib/views.ml index 797c405..446d601 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -1,7 +1,7 @@ type head_data = { page_title : string } type body_data = { - title : string Lwt.t; + title : string; subtitle : string; topnav : Dream_html.node; content : Dream_html.node list; @@ -16,16 +16,13 @@ module Layout = struct let footer = let today = Unix.localtime (Unix.time ()) in - let year = today.Unix.tm_year + 1900 |> string_of_int in - let space = " " in - let footer_text = - String.concat space [ "Copyright"; year; Config.author ] - 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 head_data = { page_title = "Ogit" } + let default_head_data = { page_title = "Ogit" } - let application ?(head_data = head_data) body_data = + let application ?(head_data = default_head_data) body_data = html [] [ head [] @@ -48,44 +45,63 @@ module Ogit_root = struct open HTML let repositories_in directory = - let repositories = Sys.readdir directory |> Array.to_list - and li_of_repo repo = li [] [ a [ href "%s" repo ] [ txt "%s" repo ] ] in - div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repositories ] + 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 = Lwt.return "My repositories"; + title = "My repositories"; subtitle = "Repositories for " ^ Config.author; topnav = null []; content = [ repositories_in Config.git_directory ]; } - let render () = Lwt.return @@ Layout.application body_data + let render () = Layout.application body_data end module Repo_root = struct open Dream_html open HTML + (* open Lwt.Syntax *) - let topnav = - nav - [ id "top" ] + 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 = [ - 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" ] ]; - ]; + h3 [] [ txt "Recent commits" ]; + ul [] @@ List.map li_of_commit recent_commits; ] - - let render repo_name = - let title = Git_helpers.get_head_commit_hash repo_name in - let subtitle = "Repository" in - let content = [ null [] ] in + in let body_data = { title; subtitle; topnav; content } in Lwt.return @@ Layout.application body_data end @@ -93,11 +109,16 @@ end module Repo_tree = struct open Dream_html open HTML + open Lwt.Syntax - let render repo_name = - let title = repo_name and content = [ txt "foobar" ] in + 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 -- cgit v1.2.3