[OCaml] Mobile-friendly clone of cgit.
feat display git project root as collapsible filesystem tree
The root '/' page now recursively scans the git project root directory and renders it as a collapsible tree: - Bare repos (objects/ + HEAD) → clickable leaf nodes - Non-bare repos (.git/ directory) → clickable leaf nodes - Plain directories → collapsible nodes with chevron toggle - Hidden directories (starting with '.') are skipped - Empty directories are omitted The per-repo summary page no longer shows the file tree (it was mistakenly added there instead of here).
Changed files
lib/handlers.ml
@@ -16,31 +16,9 @@
16
16
else config.Config.title
17
17
18
18
let root config _request =
19
Removed:
match Resolvers.repositories config with
20
Removed:
| Ok repositories ->
21
Removed:
let open Lwt.Syntax in
22
Removed:
let* repos_with_dates =
23
Removed:
Lwt_list.map_p
24
Removed:
(fun name ->
25
Removed:
Lwt.bind (Resolvers.open_repository config name) @@ function
26
Removed:
| Error _ -> Lwt.return (name, None)
27
Removed:
| Ok repository ->
28
Removed:
let* date = Resolvers.head_commit_date repository in
29
Removed:
let* () = Resolvers.close_repository repository in
30
Removed:
Lwt.return (name, date))
31
Removed:
repositories
32
Removed:
in
33
Removed:
let sorted =
34
Removed:
List.sort
35
Removed:
(fun (_, a) (_, b) ->
36
Removed:
match (a, b) with
37
Removed:
| None, None -> 0
38
Removed:
| None, Some _ -> 1
39
Removed:
| Some _, None -> -1
40
Removed:
| Some (ta, _), Some (tb, _) -> Int64.compare tb ta)
41
Removed:
repos_with_dates
42
Removed:
in
43
Removed:
Views.root ~user:config.Config.user ~root_title:(root_title config) sorted
19
Added:
match Resolvers.scan_project_root config with
20
Added:
| Ok nodes ->
21
Added:
Views.root ~user:config.Config.user ~root_title:(root_title config) nodes
44
22
| Error error -> error_response error
45
23
46
24
module Repo = struct
@@ -74,12 +52,10 @@
74
52
handler repository context id)
75
53
76
54
let summary config repository context =
77
Removed:
let* tree = Resolvers.Tree.head repository in
78
Removed:
let* nodes = Resolvers.Tree.expand repository tree in
79
55
let* commits =
80
56
Resolvers.Commit.recent repository config.Config.commits_max_displayed
81
57
in
82
Removed:
Views.Repo.summary context nodes commits
58
Added:
Views.Repo.summary context commits
83
59
84
60
let commit_matches ?filter_type ?author ?committer
85
61
(commit : Resolvers.Commit.t) =
lib/resolvers.ml
@@ -104,6 +104,37 @@
104
104
collect [] names
105
105
with Sys_error message -> Error (Internal message)
106
106
107
Added:
type fs_node = Repo of string | Directory of string * fs_node list
108
Added:
109
Added:
let scan_project_root config =
110
Added:
let ( let* ) = Result.bind in
111
Added:
let rec scan dir_path =
112
Added:
try
113
Added:
let names =
114
Added:
Sys.readdir dir_path |> Array.to_list |> List.sort String.compare
115
Added:
in
116
Added:
let rec collect acc = function
117
Added:
| [] -> Ok (List.rev acc)
118
Added:
| name :: rest when String.starts_with ~prefix:"." name ->
119
Added:
collect acc rest
120
Added:
| name :: rest -> (
121
Added:
let path = Filename.concat dir_path name in
122
Added:
let* is_dir = is_directory_result path in
123
Added:
if not is_dir then collect acc rest
124
Added:
else
125
Added:
let* layout = repository_layout_result path in
126
Added:
match layout with
127
Added:
| Some _ -> collect (Repo name :: acc) rest
128
Added:
| None ->
129
Added:
let* children = scan path in
130
Added:
if children = [] then collect acc rest
131
Added:
else collect (Directory (name, children) :: acc) rest)
132
Added:
in
133
Added:
collect [] names
134
Added:
with Sys_error message -> Error (Internal message)
135
Added:
in
136
Added:
scan config.Config.git_project_root
137
Added:
107
138
let default_repo_description = "Unnamed repository"
108
139
109
140
let read_description_file description_path =
lib/resolvers.mli
@@ -25,6 +25,10 @@
25
25
val is_repository : string -> bool
26
26
val repository_layout : string -> repository_layout option
27
27
val repositories : Config.t -> (string list, error) result
28
Added:
29
Added:
type fs_node = Repo of string | Directory of string * fs_node list
30
Added:
31
Added:
val scan_project_root : Config.t -> (fs_node list, error) result
28
32
val open_repository : Config.t -> string -> (repository, error) Lwt_result.t
29
33
val repository_name : repository -> string
30
34
val repository_description : repository -> string
lib/views/repo.ml
@@ -501,7 +501,7 @@
501
501
];
502
502
])
503
503
504
Removed:
let summary context (entries : Resolvers.Tree.tree_node list) commits =
504
Added:
let summary context commits =
505
505
let description_section =
506
506
if context.description = "" then HTML.null []
507
507
else HTML.(p [] [ txt "%s" context.description ])
@@ -510,7 +510,6 @@
510
510
HTML.
511
511
[
512
512
description_section;
513
Removed:
ul [] (List.map (li_of_tree_node context.repo) entries);
514
513
h3 [] [ txt "Latest commits" ];
515
514
ul [] (List.map (li_of_commit context.repo) commits);
516
515
]
lib/views/root.ml
@@ -2,26 +2,32 @@
2
2
3
3
open Dream_html
4
4
5
Removed:
let render ~user ~root_title repositories =
6
Removed:
let li_of_repo (repo_name, date) =
7
Removed:
let ago_span =
8
Removed:
match date with
9
Removed:
| None -> HTML.null []
10
Removed:
| Some d ->
11
Removed:
HTML.(
12
Removed:
span [ class_ "commit-ago" ] [ txt "%s" (Time_fmt.relative_time d) ])
13
Removed:
in
14
Removed:
HTML.(
15
Removed:
li []
16
Removed:
[
17
Removed:
Routes.link_to (Routes.Repo repo_name)
18
Removed:
(null [ txt "%s" repo_name; ago_span ]);
19
Removed:
])
5
Added:
let rec li_of_fs_node node =
6
Added:
match node with
7
Added:
| Resolvers.Repo repo_name ->
8
Added:
HTML.(
9
Added:
li [] [ Routes.link_to (Routes.Repo repo_name) (txt "%s" repo_name) ])
10
Added:
| Resolvers.Directory (dir_name, children) ->
11
Added:
HTML.(
12
Added:
li
13
Added:
[ class_ "tree-dir" ]
14
Added:
[
15
Added:
details []
16
Added:
[
17
Added:
summary
18
Added:
[ class_ "tree-toggle" ]
19
Added:
[
20
Added:
span [ class_ "tree-chevron" ] [ txt "\xe2\x80\xba" ];
21
Added:
span [] [ txt "%s/" dir_name ];
22
Added:
];
23
Added:
ul [ class_ "tree-nested" ] (List.map li_of_fs_node children);
24
Added:
];
25
Added:
])
26
Added:
27
Added:
let render ~user ~root_title nodes =
28
Added:
let tree =
29
Added:
HTML.(div [ id "repositories" ] [ ul [] (List.map li_of_fs_node nodes) ])
20
30
in
21
Removed:
let all_repositories =
22
Removed:
HTML.(
23
Removed:
div [ id "repositories" ] [ ul [] (List.map li_of_repo repositories) ])
24
Removed:
in
25
31
respond
26
32
@@ Layout.render ~user ~root_title
27
33
{
@@ -29,5 +35,5 @@
29
35
repo = None;
30
36
subtitle = "";
31
37
active = Summary;
32
Removed:
content = [ all_repositories ];
38
Added:
content = [ tree ];
33
39
}