[OCaml] Mobile-friendly clone of cgit.
feat show repo description and HEAD commit timestamp
Each repository on the root '/' page now displays: - The repo name as a link (as before) - The description from .git/description (greyed, after the name) - The HEAD commit timestamp right-aligned (relative time) The fs_node type is extended with repo_info carrying the description. Dates are fetched asynchronously in the handler and passed as an association list to the view.
Changed files
lib/handlers.ml
@@ -15,10 +15,37 @@
15
15
if config.Config.title = "" then "Repositories for " ^ config.Config.user
16
16
else config.Config.title
17
17
18
Added:
let collect_repo_paths nodes =
19
Added:
let rec walk prefix acc = function
20
Added:
| Resolvers.Repo { repo_name; _ } ->
21
Added:
let full =
22
Added:
if prefix = "" then repo_name else prefix ^ "/" ^ repo_name
23
Added:
in
24
Added:
full :: acc
25
Added:
| Resolvers.Directory (dir_name, children) ->
26
Added:
let p = if prefix = "" then dir_name else prefix ^ "/" ^ dir_name in
27
Added:
List.fold_left (walk p) acc children
28
Added:
in
29
Added:
List.fold_left (walk "") [] nodes
30
Added:
18
31
let root config _request =
19
32
match Resolvers.scan_project_root config with
20
33
| Ok nodes ->
21
Removed:
Views.root ~user:config.Config.user ~root_title:(root_title config) nodes
34
Added:
let open Lwt.Syntax in
35
Added:
let repo_paths = collect_repo_paths nodes in
36
Added:
let* dates =
37
Added:
Lwt_list.map_p
38
Added:
(fun path ->
39
Added:
Lwt.bind (Resolvers.open_repository config path) @@ function
40
Added:
| Error _ -> Lwt.return (path, None)
41
Added:
| Ok repository ->
42
Added:
let* date = Resolvers.head_commit_date repository in
43
Added:
let* () = Resolvers.close_repository repository in
44
Added:
Lwt.return (path, date))
45
Added:
repo_paths
46
Added:
in
47
Added:
Views.root ~user:config.Config.user ~root_title:(root_title config) ~dates
48
Added:
nodes
22
49
| Error error -> error_response error
23
50
24
51
module Repo = struct
lib/resolvers.ml
@@ -107,8 +107,24 @@
107
107
collect [] names
108
108
with Sys_error message -> Error (Internal message)
109
109
110
Removed:
type fs_node = Repo of string | Directory of string * fs_node list
110
Added:
type repo_info = { repo_name : string; description : string }
111
Added:
type fs_node = Repo of repo_info | Directory of string * fs_node list
111
112
113
Added:
let default_repo_description = "Unnamed repository"
114
Added:
115
Added:
let read_description_file description_path =
116
Added:
try
117
Added:
match
118
Added:
In_channel.with_open_text description_path In_channel.input_all
119
Added:
|> String.trim
120
Added:
with
121
Added:
| "" -> default_repo_description
122
Added:
| description -> description
123
Added:
with Sys_error _ -> default_repo_description
124
Added:
125
Added:
let description_of_layout { git_dir; _ } =
126
Added:
Filename.concat git_dir "description" |> read_description_file
127
Added:
112
128
let scan_project_root config =
113
129
let ( let* ) = Result.bind in
114
130
let rec scan dir_path =
@@ -127,7 +143,9 @@
127
143
else
128
144
let* layout = repository_layout_result path in
129
145
match layout with
130
Removed:
| Some _ -> collect (Repo name :: acc) rest
146
Added:
| Some layout ->
147
Added:
let description = description_of_layout layout in
148
Added:
collect (Repo { repo_name = name; description } :: acc) rest
131
149
| None ->
132
150
let* children = scan path in
133
151
if children = [] then collect acc rest
@@ -137,21 +155,6 @@
137
155
with Sys_error message -> Error (Internal message)
138
156
in
139
157
scan config.Config.git_project_root
140
Removed:
141
Removed:
let default_repo_description = "Unnamed repository"
142
Removed:
143
Removed:
let read_description_file description_path =
144
Removed:
try
145
Removed:
match
146
Removed:
In_channel.with_open_text description_path In_channel.input_all
147
Removed:
|> String.trim
148
Removed:
with
149
Removed:
| "" -> default_repo_description
150
Removed:
| description -> description
151
Removed:
with Sys_error _ -> default_repo_description
152
Removed:
153
Removed:
let description_of_layout { git_dir; _ } =
154
Removed:
Filename.concat git_dir "description" |> read_description_file
155
158
156
159
type repository = {
157
160
name : string;
lib/resolvers.mli
@@ -26,7 +26,8 @@
26
26
val repository_layout : string -> repository_layout option
27
27
val repositories : Config.t -> (string list, error) result
28
28
29
Removed:
type fs_node = Repo of string | Directory of string * fs_node list
29
Added:
type repo_info = { repo_name : string; description : string }
30
Added:
type fs_node = Repo of repo_info | Directory of string * fs_node list
30
31
31
32
val scan_project_root : Config.t -> (fs_node list, error) result
32
33
val open_repository : Config.t -> string -> (repository, error) Lwt_result.t
lib/static/styles.css
@@ -240,6 +240,32 @@
240
240
background-color: #252525;
241
241
}
242
242
243
Added:
/* Root page repository items */
244
Added:
#repositories li {
245
Added:
display: flex;
246
Added:
align-items: center;
247
Added:
justify-content: space-between;
248
Added:
gap: 1em;
249
Added:
}
250
Added:
251
Added:
#repositories li > a {
252
Added:
flex: 1;
253
Added:
min-width: 0;
254
Added:
overflow: hidden;
255
Added:
text-overflow: ellipsis;
256
Added:
white-space: nowrap;
257
Added:
padding: 0.75em;
258
Added:
min-height: var(--target-size);
259
Added:
display: flex;
260
Added:
align-items: center;
261
Added:
box-sizing: border-box;
262
Added:
}
263
Added:
264
Added:
.repo-description {
265
Added:
color: #b0b0b0;
266
Added:
font-size: 0.85em;
267
Added:
}
268
Added:
243
269
/* Commit list items — aligned with directory list items: anchors fill the row height */
244
270
245
271
div#main ul li:has(.commit-left) {
lib/views/root.ml
@@ -2,14 +2,33 @@
2
2
3
3
open Dream_html
4
4
5
Removed:
let rec li_of_fs_node ~prefix node =
5
Added:
let rec li_of_fs_node ~prefix ~dates node =
6
6
match node with
7
Removed:
| Resolvers.Repo repo_name ->
7
Added:
| Resolvers.Repo { repo_name; description } ->
8
8
let full_path =
9
9
if prefix = "" then repo_name else prefix ^ "/" ^ repo_name
10
10
in
11
Added:
let desc_span =
12
Added:
if description = Resolvers.default_repo_description then HTML.null []
13
Added:
else
14
Added:
HTML.(span [ class_ "repo-description" ] [ txt " — %s" description ])
15
Added:
in
16
Added:
let ago_span =
17
Added:
match List.assoc_opt full_path dates with
18
Added:
| None | Some None -> HTML.null []
19
Added:
| Some (Some date) ->
20
Added:
HTML.(
21
Added:
span
22
Added:
[ class_ "commit-ago" ]
23
Added:
[ txt "%s" (Time_fmt.relative_time date) ])
24
Added:
in
11
25
HTML.(
12
Removed:
li [] [ Routes.link_to (Routes.Repo full_path) (txt "%s" repo_name) ])
26
Added:
li []
27
Added:
[
28
Added:
Routes.link_to (Routes.Repo full_path)
29
Added:
(null [ txt "%s" repo_name; desc_span ]);
30
Added:
ago_span;
31
Added:
])
13
32
| Resolvers.Directory (dir_name, children) ->
14
33
let child_prefix =
15
34
if prefix = "" then dir_name else prefix ^ "/" ^ dir_name
@@ -28,16 +47,18 @@
28
47
];
29
48
ul
30
49
[ class_ "tree-nested" ]
31
Removed:
(List.map (li_of_fs_node ~prefix:child_prefix) children);
50
Added:
(List.map
51
Added:
(li_of_fs_node ~prefix:child_prefix ~dates)
52
Added:
children);
32
53
];
33
54
])
34
55
35
Removed:
let render ~user ~root_title nodes =
56
Added:
let render ~user ~root_title ~dates nodes =
36
57
let tree =
37
58
HTML.(
38
59
div
39
60
[ id "repositories" ]
40
Removed:
[ ul [] (List.map (li_of_fs_node ~prefix:"") nodes) ])
61
Added:
[ ul [] (List.map (li_of_fs_node ~prefix:"" ~dates) nodes) ])
41
62
in
42
63
respond
43
64
@@ Layout.render ~user ~root_title