[OCaml] Mobile-friendly clone of cgit.

feat add project directory pages with navigable breadcrumbs

- Add Project_dir route for browsing project directories (e.g. /FAPG/) - Add scan_subdirectory and read_subdir_readme to resolvers - When a Summary route fails to open as a repo (Not_found), fall back to rendering the project directory listing with its own README - Breadcrumb segments for nested repos now link to their parent project directory (e.g. FAPG links to /FAPG/) instead of / - nav-home on project directory pages links to the project root - Preserve 400 response for invalid repo names (Bad_request)

Commit
1606464c7363e6e49f2e9afa0aa0ba8ea76b4d1d
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
lib/handlers.ml
index 46ad12ed..df1851d1 100644..100644
@@ -301,6 +301,37 @@
301 301 Views.Repo.file ~active:Layout.Readme context [] blob
302 302 end
303 303
304 Added: let project_dir config subdir =
305 Added: match Resolvers.scan_subdirectory config subdir with
306 Added: | Ok nodes ->
307 Added: let open Lwt.Syntax in
308 Added: let rec collect_repo_paths prefix = function
309 Added: | Resolvers.Repo { repo_name; _ } ->
310 Added: let full =
311 Added: if prefix = "" then repo_name else prefix ^ "/" ^ repo_name
312 Added: in
313 Added: [ full ]
314 Added: | Resolvers.Directory (dir_name, children) ->
315 Added: let p = if prefix = "" then dir_name else prefix ^ "/" ^ dir_name in
316 Added: List.concat_map (collect_repo_paths p) children
317 Added: in
318 Added: let repo_paths = List.concat_map (collect_repo_paths subdir) nodes in
319 Added: let* dates =
320 Added: Lwt_list.map_p
321 Added: (fun path ->
322 Added: Lwt.bind (Resolvers.open_repository config path) @@ function
323 Added: | Error _ -> Lwt.return (path, None)
324 Added: | Ok repository ->
325 Added: let* date = Resolvers.head_commit_date repository in
326 Added: let* () = Resolvers.close_repository repository in
327 Added: Lwt.return (path, date))
328 Added: repo_paths
329 Added: in
330 Added: let readme = Resolvers.read_subdir_readme config subdir in
331 Added: Views.root ~user_name:config.Config.user_name
332 Added: ~root_title:(root_title config) ~dates ~prefix:subdir ?readme nodes
333 Added: | Error error -> error_response error
334 Added:
304 335 let routes config =
305 336 let repo_dispatcher request =
306 337 let path = Dream.target request in
@@ -320,7 +351,14 @@
320 351 | Some (name, action) -> (
321 352 match action with
322 353 | Routes.Summary ->
323 Removed: Repo.with_repository config name (Repo.summary config)
354 Added: Lwt.bind (Resolvers.open_repository config name) (function
355 Added: | Error (Resolvers.Not_found _) -> project_dir config name
356 Added: | Error error -> error_response error
357 Added: | Ok repository ->
358 Added: let context = Repo.view_context config repository in
359 Added: Lwt.finalize
360 Added: (fun () -> Repo.summary config repository context)
361 Added: (fun () -> Resolvers.close_repository repository))
324 362 | Routes.Commits_page ->
325 363 Repo.with_repository config name (fun repository context ->
326 364 Repo.commits config request repository context)
lib/resolvers.ml
index 5854c548..70fb3dad 100644..100644
@@ -716,3 +716,53 @@
716 716 with Sys_error _ -> try_candidates rest)
717 717 in
718 718 try_candidates readme_candidates
719 Added:
720 Added: let scan_subdirectory config subdir =
721 Added: let ( let* ) = Result.bind in
722 Added: let rec scan dir_path =
723 Added: try
724 Added: let names =
725 Added: Sys.readdir dir_path |> Array.to_list |> List.sort String.compare
726 Added: in
727 Added: let rec collect acc = function
728 Added: | [] -> Ok (List.rev acc)
729 Added: | name :: rest when String.starts_with ~prefix:"." name ->
730 Added: collect acc rest
731 Added: | name :: rest -> (
732 Added: let path = Filename.concat dir_path name in
733 Added: let* is_dir = is_directory_result path in
734 Added: if not is_dir then collect acc rest
735 Added: else
736 Added: let* layout = repository_layout_result path in
737 Added: match layout with
738 Added: | Some layout ->
739 Added: let description = description_of_layout layout in
740 Added: collect (Repo { repo_name = name; description } :: acc) rest
741 Added: | None ->
742 Added: let* children = scan path in
743 Added: if children = [] then collect acc rest
744 Added: else collect (Directory (name, children) :: acc) rest)
745 Added: in
746 Added: collect [] names
747 Added: with Sys_error message -> Error (Internal message)
748 Added: in
749 Added: let full_path = Filename.concat config.Config.git_project_root subdir in
750 Added: if not (Sys.file_exists full_path && Sys.is_directory full_path) then
751 Added: Error (Not_found ("directory not found: " ^ subdir))
752 Added: else scan full_path
753 Added:
754 Added: let read_subdir_readme config subdir =
755 Added: let readme_candidates =
756 Added: [ "README"; "README.md"; "README.org"; "README.txt" ]
757 Added: in
758 Added: let base = Filename.concat config.Config.git_project_root subdir in
759 Added: let rec try_candidates = function
760 Added: | [] -> None
761 Added: | name :: rest -> (
762 Added: let path = Filename.concat base name in
763 Added: try
764 Added: let content = In_channel.with_open_text path In_channel.input_all in
765 Added: Some { Blob.content }
766 Added: with Sys_error _ -> try_candidates rest)
767 Added: in
768 Added: try_candidates readme_candidates
lib/resolvers.mli
index e3a6790c..9d5501ae 100644..100644
@@ -132,3 +132,5 @@
132 132 (** {1 Root helpers} *)
133 133
134 134 val read_root_readme : Config.t -> Blob.t option
135 Added: val scan_subdirectory : Config.t -> string -> (fs_node list, error) result
136 Added: val read_subdir_readme : Config.t -> string -> Blob.t option
lib/routes.ml
index b06385c6..074d49ab 100644..100644
@@ -2,6 +2,7 @@
2 2
3 3 type t =
4 4 | Root
5 Added: | Project_dir of string
5 6 | Repo of string
6 7 | Commits of string
7 8 | Commits_branch of string * string
@@ -19,6 +20,7 @@
19 20 (* Generate URL paths for routes *)
20 21 let path_of = function
21 22 | Root -> "/"
23 Added: | Project_dir dir -> "/" ^ dir ^ "/"
22 24 | Repo repo -> "/" ^ repo ^ "/summary/"
23 25 | Commits repo -> "/" ^ repo ^ "/commits/"
24 26 | Commits_branch (repo, branch) -> "/" ^ repo ^ "/commits/" ^ branch
lib/views/layout.ml
index ffb0fa35..a294158f 100644..100644
@@ -11,6 +11,7 @@
11 11 active : page;
12 12 toolbar : node list;
13 13 content : node list;
14 Added: home_href : string option;
14 15 }
15 16
16 17 let page_to_nav_item repo = function
@@ -21,7 +22,7 @@
21 22 | Tags -> (Routes.Tags repo, "Tags", Tags)
22 23 | Readme -> (Routes.Readme repo, "README", Readme)
23 24
24 Removed: let rootnav ~title:nav_title =
25 Added: let rootnav ~title:nav_title ?home_href () =
25 26 HTML.(
26 27 nav
27 28 [ id "top"; Aria.label "Site navigation" ]
@@ -29,7 +30,10 @@
29 30 a
30 31 [ href "https://git-scm.com"; class_ "nav-logo" ]
31 32 [ img [ src "/static/git_icon.svg"; alt "Git"; class_ "site-logo" ] ];
32 Removed: span [ class_ "nav-home" ] [ txt "%s" nav_title ];
33 Added: (match home_href with
34 Added: | None -> span [ class_ "nav-home" ] [ txt "%s" nav_title ]
35 Added: | Some href_val ->
36 Added: a [ href "%s" href_val; class_ "nav-home" ] [ txt "%s" nav_title ]);
33 37 ])
34 38
35 39 let topnav ?(active = Summary) ?(toolbar = []) repo =
@@ -149,7 +153,7 @@
149 153 [
150 154 a [ href "#main"; class_ "skip-link" ] [ txt "Skip to content" ];
151 155 (match page_data.repo with
152 Removed: | None -> rootnav ~title:root_title
156 Added: | None -> rootnav ~title:root_title ?home_href:page_data.home_href ()
153 157 | Some repo ->
154 158 topnav ~active:page_data.active ~toolbar:page_data.toolbar repo);
155 159 HTML.main
lib/views/repo.ml
index 53fd3b90..8c07b3d7 100644..100644
@@ -259,6 +259,7 @@
259 259 subtitle = context.description;
260 260 active;
261 261 toolbar = Option.value toolbar ~default:[];
262 Added: home_href = None;
262 263 content;
263 264 }
264 265
@@ -696,7 +697,12 @@
696 697 ~other_attrs:[ HTML.class_ "path-pill-link" ]
697 698 (txt "%s" seg)
698 699 else
699 Removed: HTML.(a [ href "/"; class_ "path-pill-link" ] [ txt "%s" seg ])
700 Added: let dir_path =
701 Added: String.concat "/" (List_ext.take (i + 1) segments)
702 Added: in
703 Added: Routes.link_to (Project_dir dir_path)
704 Added: ~other_attrs:[ HTML.class_ "path-pill-link" ]
705 Added: (txt "%s" seg)
700 706 in
701 707 if i = 0 then node
702 708 else
lib/views/root.ml
index 8ae6448b..94f9a273 100644..100644
@@ -55,11 +55,11 @@
55 55 ];
56 56 ])
57 57
58 Removed: let render ~user_name ~root_title ~dates ?(favorites = []) ?(archived = [])
59 Removed: ?readme nodes =
58 Added: let render ~user_name ~root_title ~dates ?(prefix = "") ?(favorites = [])
59 Added: ?(archived = []) ?readme nodes =
60 60 let repo_list list_id nodes =
61 61 HTML.(
62 Removed: ul [ id "%s" list_id ] (List.map (li_of_fs_node ~prefix:"" ~dates) nodes))
62 Added: ul [ id "%s" list_id ] (List.map (li_of_fs_node ~prefix ~dates) nodes))
63 63 in
64 64 let favorites_section =
65 65 match favorites with
@@ -160,6 +160,9 @@
160 160 subtitle = "";
161 161 active = Summary;
162 162 toolbar = [];
163 Added: home_href =
164 Added: (if prefix = "" then None
165 Added: else Some (Routes.path_of (Project_dir prefix)));
163 166 content =
164 167 [
165 168 HTML.(