[OCaml] Mobile-friendly clone of cgit.
refactor Rename view module Repo to Repo_view
Three modules were named Repo: this one, Handlers.Repo, and Resolvers.Repo. References like Repo.context in handlers.mli were ambiguous to read. The view module now carries the distinct name.
Changed files
doc/index.mld
@@ -30,7 +30,7 @@
30
30
so URLs are never written by hand.
31
31
- {!module-Ogit.Layout} — the page shell surrounding every page's content.
32
32
- {!module-Ogit.Root} — the repository list and project directory pages.
33
Removed:
- {!module-Ogit.Repo} — the repository pages.
33
Added:
- {!module-Ogit.Repo_view} — the repository pages.
34
34
- {!module-Ogit.Error} — error pages.
35
35
36
36
{2 Supporting modules}
lib/handlers.mli
@@ -22,7 +22,7 @@
22
22
val with_repository :
23
23
Config.t ->
24
24
string ->
25
Removed:
(Resolvers.repository -> Repo.context -> Dream.response Dream.promise) ->
25
Added:
(Resolvers.repository -> Repo_view.context -> Dream.response Dream.promise) ->
26
26
Dream.response Dream.promise
27
27
(** Open a repository by name, build a view context, run the continuation,
28
28
then close the repository. Renders an error page on failure. *)
lib/views.ml
@@ -6,12 +6,12 @@
6
6
module Repo = struct
7
7
type commit_message = Commit_message.t = { summary : string; body : string }
8
8
9
Removed:
let context = Repo.context
9
Added:
let context = Repo_view.context
10
10
let parse_commit_message = Commit_message.parse
11
11
let parse_conventional = Commit_message.parse_conventional
12
Removed:
let summary = Repo.summary
13
Removed:
let commits = Repo.commits
14
Removed:
let files = Repo.files
15
Removed:
let file = Repo.file
16
Removed:
let commit = Repo.commit
12
Added:
let summary = Repo_view.summary
13
Added:
let commits = Repo_view.commits
14
Added:
let files = Repo_view.files
15
Added:
let file = Repo_view.file
16
Added:
let commit = Repo_view.commit
17
17
end
lib/views.mli
@@ -26,13 +26,13 @@
26
26
type commit_message = Commit_message.t = { summary : string; body : string }
27
27
28
28
val context :
29
Removed:
site:Layout.site -> repo:string -> description:string -> Repo.context
29
Added:
site:Layout.site -> repo:string -> description:string -> Repo_view.context
30
30
31
31
val parse_commit_message : string option -> Commit_message.t
32
32
val parse_conventional : string -> string option * string
33
33
34
34
val summary :
35
Removed:
Repo.context ->
35
Added:
Repo_view.context ->
36
36
?readme:Resolvers.Readme.t ->
37
37
unit ->
38
38
Dream.response Dream.promise
@@ -45,24 +45,24 @@
45
45
page_number:int ->
46
46
has_prev:bool ->
47
47
has_next:bool ->
48
Removed:
Repo.context ->
48
Added:
Repo_view.context ->
49
49
Resolvers.Commit.t list ->
50
50
Dream.response Dream.promise
51
51
52
52
val files :
53
Removed:
Repo.context ->
53
Added:
Repo_view.context ->
54
54
(string * string) list ->
55
55
Resolvers.Tree.tree_node list ->
56
56
Dream.response Dream.promise
57
57
58
58
val file :
59
Removed:
Repo.context ->
59
Added:
Repo_view.context ->
60
60
(string * string) list ->
61
61
Resolvers.Blob.t ->
62
62
Dream.response Dream.promise
63
63
64
64
val commit :
65
Removed:
Repo.context ->
65
Added:
Repo_view.context ->
66
66
Resolvers.Commit.t ->
67
67
Resolvers.Diff.file list ->
68
68
Dream.response Dream.promise
lib/views/repo.ml
@@ -1,362 +0,0 @@
1
Removed:
(** The repository pages: summary, commit list, file tree, blob, commit detail,
2
Removed:
branches and tags.
3
Removed:
4
Removed:
Each page is a description: it names the parts it is made of and hands them
5
Removed:
to {!Layout}. Markup lives in {!Ui}, ogit's page parts in {!Components},
6
Removed:
language guessing in {!Syntax}, and date formatting in {!Time_format}. *)
7
Removed:
8
Removed:
type context = { repo : string; description : string; site : Layout.site }
9
Removed:
(** What every repository page needs to know about its subject. *)
10
Removed:
11
Removed:
type commit_message = Commit_message.t = { summary : string; body : string }
12
Removed:
13
Removed:
let context ~site ~repo ~description = { repo; description; site }
14
Removed:
15
Removed:
(** {1 Commit messages} *)
16
Removed:
17
Removed:
let parse_commit_message = Commit_message.parse
18
Removed:
let parse_conventional = Commit_message.parse_conventional
19
Removed:
20
Removed:
(** {1 Links into the commit list} *)
21
Removed:
22
Removed:
let commits_url = Components.commits_url
23
Removed:
24
Removed:
(** A person's name, linking to the commits attributed to them. Keeps the other
25
Removed:
active filters intact so identities compose with type filters. *)
26
Removed:
let identity_link ?filter_type ?author ?committer ?(show_email = false) ~role
27
Removed:
repo (user : Resolvers.Commit.user) =
28
Removed:
let href, role_name =
29
Removed:
match role with
30
Removed:
| `Author ->
31
Removed:
(commits_url ?filter_type ~author:user.email ?committer repo, "author")
32
Removed:
| `Committer ->
33
Removed:
( commits_url ?filter_type ?author ~committer:user.email repo,
34
Removed:
"committer" )
35
Removed:
in
36
Removed:
Ui.text_link ~class_:"commit-identity"
37
Removed:
~label:(Printf.sprintf "Filter commits by %s %s" role_name user.name)
38
Removed:
~href
39
Removed:
(if show_email then Printf.sprintf "%s <%s>" user.name user.email
40
Removed:
else user.name)
41
Removed:
42
Removed:
(** {1 Page shell} *)
43
Removed:
44
Removed:
let page_title context = context.repo ^ " — " ^ context.description
45
Removed:
46
Removed:
let render_page ?heading ?(toolbar = []) context ~active content =
47
Removed:
Ui.respond
48
Removed:
@@ Layout.render context.site ~page_title:(page_title context)
49
Removed:
{
50
Removed:
repo = Some context.repo;
51
Removed:
title = Option.value heading ~default:context.repo;
52
Removed:
subtitle = context.description;
53
Removed:
active;
54
Removed:
toolbar;
55
Removed:
home_href = None;
56
Removed:
content;
57
Removed:
}
58
Removed:
59
Removed:
(** {1 Rows} *)
60
Removed:
61
Removed:
(** One line of the commit list: when it happened, what changed, and who did it.
62
Removed:
63
Removed:
@param hide_pill
64
Removed:
suppresses the type badge when the list is already filtered to a single
65
Removed:
type, where repeating it on every row adds nothing.
66
Removed:
@param author
67
Removed:
when filtering by author, the author column is dropped for the same
68
Removed:
reason. *)
69
Removed:
let commit_row ?filter_type ?author ?committer ?(hide_pill = false) repo
70
Removed:
(commit : Resolvers.Commit.t) =
71
Removed:
let message = parse_commit_message commit.message in
72
Removed:
let commit_type, title = parse_conventional message.summary in
73
Removed:
let badge =
74
Removed:
match commit_type with
75
Removed:
| Some commit_type when not hide_pill ->
76
Removed:
Components.commit_type_badge
77
Removed:
~href:(commits_url ~filter_type:commit_type ?author ?committer repo)
78
Removed:
commit_type
79
Removed:
| _ -> Ui.nothing
80
Removed:
in
81
Removed:
Ui.item
82
Removed:
[
83
Removed:
Ui.inline_text ~class_:"timestamp"
84
Removed:
(Time_format.short_time commit.author.date);
85
Removed:
badge;
86
Removed:
Ui.inline ~class_:"commit-title"
87
Removed:
[ Components.route_link (Commit (repo, commit.hash)) title ];
88
Removed:
Ui.inline_text ~class_:"commit-ago"
89
Removed:
(Time_format.relative_time commit.author.date);
90
Removed:
(match author with
91
Removed:
| Some _ -> Ui.nothing
92
Removed:
| None ->
93
Removed:
Ui.inline ~class_:"commit-author"
94
Removed:
[
95
Removed:
identity_link ?filter_type ?author ?committer ~role:`Author repo
96
Removed:
commit.author;
97
Removed:
]);
98
Removed:
]
99
Removed:
100
Removed:
(** Directories with more than seven entries show three children and a link to
101
Removed:
the full directory page, keeping the tree scannable without hiding anything
102
Removed:
permanently. The repository root is exempt — it always shows all entries. *)
103
Removed:
let tree_truncation_threshold = 7
104
Removed:
105
Removed:
let tree_display_limit = 3
106
Removed:
107
Removed:
let rec tree_row repo (node : Resolvers.Tree.tree_node) =
108
Removed:
let entry = node.entry in
109
Removed:
let route = Routes.File (repo, entry.hash) in
110
Removed:
(* Dotfiles stay visible but are de-emphasised. *)
111
Removed:
let modifier =
112
Removed:
if String.length entry.name > 0 && entry.name.[0] = '.' then "tree-hidden"
113
Removed:
else ""
114
Removed:
in
115
Removed:
match node.children with
116
Removed:
| None -> Components.file_entry ~modifier ~route entry.name
117
Removed:
| Some children ->
118
Removed:
let total = List.length children in
119
Removed:
let shown, omitted =
120
Removed:
if total <= tree_truncation_threshold then (children, 0)
121
Removed:
else
122
Removed:
(List_ext.take tree_display_limit children, total - tree_display_limit)
123
Removed:
in
124
Removed:
let overflow =
125
Removed:
if omitted = 0 then [] else [ Components.overflow_row ~route omitted ]
126
Removed:
in
127
Removed:
Components.directory ~modifier ~route ~name:entry.name
128
Removed:
(List.map (tree_row repo) shown @ overflow)
129
Removed:
130
Removed:
(** {1 Trails} *)
131
Removed:
132
Removed:
(** The path from the repository root to the entry being viewed. *)
133
Removed:
let path_trail repo (trail : (string * string) list) =
134
Removed:
let repo_name =
135
Removed:
match List.rev (String.split_on_char '/' repo) with
136
Removed:
| name :: _ -> name
137
Removed:
| [] -> repo
138
Removed:
in
139
Removed:
let root = Ui.crumb ~href:(Components.url (Files repo)) repo_name in
140
Removed:
let entries =
141
Removed:
List.map
142
Removed:
(fun (name, hash) ->
143
Removed:
Ui.crumb ~href:(Components.url (File (repo, hash))) name)
144
Removed:
trail
145
Removed:
in
146
Removed:
Ui.breadcrumb ~class_:"path-pill" ~link_class:"path-pill-link"
147
Removed:
~separator_class:"path-pill-sep" ~separator:"/" (root :: entries)
148
Removed:
149
Removed:
(** {1 Pages} *)
150
Removed:
151
Removed:
let summary context ?readme () =
152
Removed:
let readme_panel =
153
Removed:
match readme with
154
Removed:
| None -> Ui.nothing
155
Removed:
| Some (readme : Resolvers.Readme.t) ->
156
Removed:
Components.inline_readme ~filename:readme.name readme.content
157
Removed:
in
158
Removed:
render_page context ~active:Summary ~toolbar:[] [ readme_panel ]
159
Removed:
160
Removed:
let commits ?filter_type ?author ?committer ?(truncated = false) ~page_number
161
Removed:
~has_prev ~has_next context commits =
162
Removed:
(* Each active filter offers a control that clears just itself, leaving the
163
Removed:
others applied. *)
164
Removed:
let active_filters =
165
Removed:
(match filter_type with
166
Removed:
| None -> []
167
Removed:
| Some commit_type ->
168
Removed:
[
169
Removed:
( "commit type",
170
Removed:
commit_type,
171
Removed:
commits_url ?author ?committer context.repo,
172
Removed:
"commit-pill commit-pill-" ^ commit_type );
173
Removed:
])
174
Removed:
@ (match author with
175
Removed:
| None -> []
176
Removed:
| Some email ->
177
Removed:
[
178
Removed:
( "author",
179
Removed:
"Author: " ^ email,
180
Removed:
commits_url ?filter_type ?committer context.repo,
181
Removed:
"toolbar-filter-value" );
182
Removed:
])
183
Removed:
@
184
Removed:
match committer with
185
Removed:
| None -> []
186
Removed:
| Some email ->
187
Removed:
[
188
Removed:
( "committer",
189
Removed:
"Committer: " ^ email,
190
Removed:
commits_url ?filter_type ?author context.repo,
191
Removed:
"toolbar-filter-value" );
192
Removed:
]
193
Removed:
in
194
Removed:
let filters =
195
Removed:
match active_filters with
196
Removed:
| [] -> []
197
Removed:
| filters ->
198
Removed:
[
199
Removed:
Ui.block ~class_:"toolbar-filters"
200
Removed:
(List.map
201
Removed:
(fun (name, value, dismiss_href, value_class) ->
202
Removed:
Ui.dismissible ~value_class ~dismiss_href
203
Removed:
~dismiss_label:(Printf.sprintf "Remove %s filter" name)
204
Removed:
value)
205
Removed:
filters);
206
Removed:
]
207
Removed:
in
208
Removed:
let page_url n =
209
Removed:
commits_url ?filter_type ?author ?committer ~page_number:n context.repo
210
Removed:
in
211
Removed:
let pagination =
212
Removed:
if not (has_prev || has_next) then []
213
Removed:
else
214
Removed:
[
215
Removed:
Ui.pagination
216
Removed:
?previous_href:
217
Removed:
(if has_prev then Some (page_url (page_number - 1)) else None)
218
Removed:
?next_href:
219
Removed:
(if has_next then Some (page_url (page_number + 1)) else None)
220
Removed:
page_number;
221
Removed:
]
222
Removed:
in
223
Removed:
render_page context ~active:Commits ~toolbar:(filters @ pagination)
224
Removed:
[
225
Removed:
Ui.items_of ~id:"commit-list"
226
Removed:
(commit_row
227
Removed:
~hide_pill:(Option.is_some filter_type)
228
Removed:
?filter_type ?author ?committer context.repo)
229
Removed:
commits;
230
Removed:
(if truncated then
231
Removed:
Ui.paragraph_text ~class_:"commit-list-note"
232
Removed:
"The search stopped before it reached the oldest history. Older \
233
Removed:
matching commits are not shown."
234
Removed:
else Ui.nothing);
235
Removed:
]
236
Removed:
237
Removed:
let files context trail (entries : Resolvers.Tree.tree_node list) =
238
Removed:
render_page context ~active:Files
239
Removed:
~toolbar:[ path_trail context.repo trail ]
240
Removed:
[ Ui.items_of ~id:"file-tree" (tree_row context.repo) entries ]
241
Removed:
242
Removed:
let is_image_filename filename =
243
Removed:
match Filename.extension filename |> String.lowercase_ascii with
244
Removed:
| ".png" | ".jpg" | ".jpeg" | ".gif" | ".svg" | ".webp" | ".ico" | ".bmp"
245
Removed:
| ".avif" ->
246
Removed:
true
247
Removed:
| _ -> false
248
Removed:
249
Removed:
let file context trail (blob : Resolvers.Blob.t) =
250
Removed:
let filename =
251
Removed:
match List.rev trail with (name, _) :: _ -> Some name | [] -> None
252
Removed:
in
253
Removed:
let raw_link =
254
Removed:
match List.rev trail with
255
Removed:
| (_, hash) :: _ ->
256
Removed:
Ui.paragraph
257
Removed:
[ Components.route_link (Raw_file (context.repo, hash)) "View raw" ]
258
Removed:
| [] -> Ui.nothing
259
Removed:
in
260
Removed:
let body =
261
Removed:
match filename with
262
Removed:
| Some filename when is_image_filename filename ->
263
Removed:
let src =
264
Removed:
match List.rev trail with
265
Removed:
| (_, hash) :: _ -> Components.url (Raw_file (context.repo, hash))
266
Removed:
| [] -> ""
267
Removed:
in
268
Removed:
Ui.block ~class_:"image-preview"
269
Removed:
[ Ui.image ~class_:"file-image" ~alt:filename ~src () ]
270
Removed:
| Some filename when Prose.Render.is_doc_filename filename ->
271
Removed:
Prose.Render.render ~filename blob.content
272
Removed:
| _ ->
273
Removed:
let language = Highlight.Detect.detect ~filename blob.content in
274
Removed:
let lines = Highlight.Engine.highlight ~lang:language blob.content in
275
Removed:
Ui.highlighted_code_listing ~id:"blob" lines
276
Removed:
in
277
Removed:
let toolbar = [ path_trail context.repo trail ] in
278
Removed:
render_page context ~active:Files ~toolbar [ raw_link; body ]
279
Removed:
280
Removed:
let commit context (commit : Resolvers.Commit.t) diff =
281
Removed:
let message = parse_commit_message commit.message in
282
Removed:
let commit_type, title = parse_conventional message.summary in
283
Removed:
let number = function Some n -> string_of_int n | None -> "" in
284
Removed:
let diff_line (line : Resolvers.Diff.line) : Ui.Diff.line =
285
Removed:
{
286
Removed:
before = number line.old_number;
287
Removed:
after = number line.new_number;
288
Removed:
change =
289
Removed:
(match line.kind with
290
Removed:
| Resolvers.Diff.Context -> Ui.Diff.Unchanged
291
Removed:
| Resolvers.Diff.Addition -> Ui.Diff.Added
292
Removed:
| Resolvers.Diff.Deletion -> Ui.Diff.Removed);
293
Removed:
content = line.text;
294
Removed:
}
295
Removed:
in
296
Removed:
let diff_section (hunk : Resolvers.Diff.hunk) : Ui.Diff.section =
297
Removed:
{
298
Removed:
section_heading =
299
Removed:
Printf.sprintf "@@ -%d,%d +%d,%d @@" hunk.old_start hunk.old_count
300
Removed:
hunk.new_start hunk.new_count;
301
Removed:
lines = List.map diff_line hunk.lines;
302
Removed:
}
303
Removed:
in
304
Removed:
let mode = function
305
Removed:
| None -> "000000"
306
Removed:
| Some mode -> Printf.sprintf "%06o" mode
307
Removed:
in
308
Removed:
let hash = function
309
Removed:
| None -> "00000000"
310
Removed:
| Some hash -> Resolvers.short_hash hash
311
Removed:
in
312
Removed:
let diff_file (file : Resolvers.Diff.file) : Ui.Diff.file =
313
Removed:
{
314
Removed:
path = file.path;
315
Removed:
detail =
316
Removed:
Printf.sprintf "index %s..%s %s..%s" (hash file.old_hash)
317
Removed:
(hash file.new_hash) (mode file.old_mode) (mode file.new_mode);
318
Removed:
sections = List.map diff_section file.hunks;
319
Removed:
note = (if file.binary then Some "Binary files differ" else None);
320
Removed:
}
321
Removed:
in
322
Removed:
let badge =
323
Removed:
match commit_type with
324
Removed:
| None -> Ui.nothing
325
Removed:
| Some commit_type ->
326
Removed:
Components.commit_type_badge
327
Removed:
~href:(commits_url ~filter_type:commit_type context.repo)
328
Removed:
commit_type
329
Removed:
in
330
Removed:
let body =
331
Removed:
if message.body = "" then []
332
Removed:
else [ Ui.paragraph_text ~class_:"commit-body" message.body ]
333
Removed:
in
334
Removed:
let timestamp date =
335
Removed:
let machine, display = Time_format.exact_time date in
336
Removed:
Ui.timestamp ~machine display
337
Removed:
in
338
Removed:
let metadata =
339
Removed:
Ui.definitions ~class_:"commit-meta"
340
Removed:
[
341
Removed:
("Commit", [ Ui.text commit.hash ]);
342
Removed:
( "Author",
343
Removed:
[
344
Removed:
identity_link ~show_email:true ~role:`Author context.repo
345
Removed:
commit.author;
346
Removed:
] );
347
Removed:
("Author date", [ timestamp commit.author.date ]);
348
Removed:
( "Committer",
349
Removed:
[
350
Removed:
identity_link ~show_email:true ~role:`Committer context.repo
351
Removed:
commit.committer;
352
Removed:
] );
353
Removed:
("Committer date", [ timestamp commit.committer.date ]);
354
Removed:
]
355
Removed:
in
356
Removed:
render_page
357
Removed:
~heading:(context.repo ^ " : " ^ Resolvers.short_hash commit.hash)
358
Removed:
context ~active:Commits
359
Removed:
((Ui.heading ~level:3 [ badge; Ui.text (" " ^ title) ] :: body)
360
Removed:
@ [ metadata ]
361
Removed:
@ Ui.Diff.view ~empty_message:"No file changes in this commit."
362
Removed:
(List.map diff_file diff))
lib/views/repo.mli
@@ -1,69 +0,0 @@
1
Removed:
(** The repository pages: summary, commit list, file tree, blob, and commit
2
Removed:
detail.
3
Removed:
4
Removed:
Each page is a description: it names the parts it is made of and hands them
5
Removed:
to {!Layout}. Markup lives in {!Ui}, ogit's page parts in {!Components},
6
Removed:
language guessing in {!Syntax}, and date formatting in {!Time_format}. *)
7
Removed:
8
Removed:
(** {1 Context} *)
9
Removed:
10
Removed:
type context
11
Removed:
(** What every repository page needs to know about its subject. *)
12
Removed:
13
Removed:
val context : site:Layout.site -> repo:string -> description:string -> context
14
Removed:
(** Build a page context from site settings and repository metadata. *)
15
Removed:
16
Removed:
(** {1 Commit messages} *)
17
Removed:
18
Removed:
type commit_message = { summary : string; body : string }
19
Removed:
(** A commit message split into its first-line summary and remaining body. *)
20
Removed:
21
Removed:
val parse_commit_message : string option -> commit_message
22
Removed:
(** Split a raw commit message into summary and body. *)
23
Removed:
24
Removed:
val parse_conventional : string -> string option * string
25
Removed:
(** [parse_conventional summary] returns [(Some type, title)] if the summary
26
Removed:
follows Conventional Commits, or [(None, summary)] otherwise. *)
27
Removed:
28
Removed:
(** {1 Pages} *)
29
Removed:
30
Removed:
val summary :
31
Removed:
context -> ?readme:Resolvers.Readme.t -> unit -> Dream.response Dream.promise
32
Removed:
(** The repository summary page, optionally showing a README. *)
33
Removed:
34
Removed:
val commits :
35
Removed:
?filter_type:string ->
36
Removed:
?author:string ->
37
Removed:
?committer:string ->
38
Removed:
?truncated:bool ->
39
Removed:
page_number:int ->
40
Removed:
has_prev:bool ->
41
Removed:
has_next:bool ->
42
Removed:
context ->
43
Removed:
Resolvers.Commit.t list ->
44
Removed:
Dream.response Dream.promise
45
Removed:
(** The paginated commit list, with optional type/author/committer filters.
46
Removed:
[truncated] adds a notice that the history walk stopped before the oldest
47
Removed:
commits, so older matches may be missing. *)
48
Removed:
49
Removed:
val files :
50
Removed:
context ->
51
Removed:
(string * string) list ->
52
Removed:
Resolvers.Tree.tree_node list ->
53
Removed:
Dream.response Dream.promise
54
Removed:
(** The file tree page. The trail is the path from root to the current
55
Removed:
directory. *)
56
Removed:
57
Removed:
val file :
58
Removed:
context ->
59
Removed:
(string * string) list ->
60
Removed:
Resolvers.Blob.t ->
61
Removed:
Dream.response Dream.promise
62
Removed:
(** A single file view with syntax highlighting or prose rendering. *)
63
Removed:
64
Removed:
val commit :
65
Removed:
context ->
66
Removed:
Resolvers.Commit.t ->
67
Removed:
Resolvers.Diff.file list ->
68
Removed:
Dream.response Dream.promise
69
Removed:
(** The commit detail page showing metadata and a diff. *)
lib/views/repo_view.ml
@@ -0,0 +1,362 @@
1
Added:
(** The repository pages: summary, commit list, file tree, blob, commit detail,
2
Added:
branches and tags.
3
Added:
4
Added:
Each page is a description: it names the parts it is made of and hands them
5
Added:
to {!Layout}. Markup lives in {!Ui}, ogit's page parts in {!Components},
6
Added:
language guessing in {!Syntax}, and date formatting in {!Time_format}. *)
7
Added:
8
Added:
type context = { repo : string; description : string; site : Layout.site }
9
Added:
(** What every repository page needs to know about its subject. *)
10
Added:
11
Added:
type commit_message = Commit_message.t = { summary : string; body : string }
12
Added:
13
Added:
let context ~site ~repo ~description = { repo; description; site }
14
Added:
15
Added:
(** {1 Commit messages} *)
16
Added:
17
Added:
let parse_commit_message = Commit_message.parse
18
Added:
let parse_conventional = Commit_message.parse_conventional
19
Added:
20
Added:
(** {1 Links into the commit list} *)
21
Added:
22
Added:
let commits_url = Components.commits_url
23
Added:
24
Added:
(** A person's name, linking to the commits attributed to them. Keeps the other
25
Added:
active filters intact so identities compose with type filters. *)
26
Added:
let identity_link ?filter_type ?author ?committer ?(show_email = false) ~role
27
Added:
repo (user : Resolvers.Commit.user) =
28
Added:
let href, role_name =
29
Added:
match role with
30
Added:
| `Author ->
31
Added:
(commits_url ?filter_type ~author:user.email ?committer repo, "author")
32
Added:
| `Committer ->
33
Added:
( commits_url ?filter_type ?author ~committer:user.email repo,
34
Added:
"committer" )
35
Added:
in
36
Added:
Ui.text_link ~class_:"commit-identity"
37
Added:
~label:(Printf.sprintf "Filter commits by %s %s" role_name user.name)
38
Added:
~href
39
Added:
(if show_email then Printf.sprintf "%s <%s>" user.name user.email
40
Added:
else user.name)
41
Added:
42
Added:
(** {1 Page shell} *)
43
Added:
44
Added:
let page_title context = context.repo ^ " — " ^ context.description
45
Added:
46
Added:
let render_page ?heading ?(toolbar = []) context ~active content =
47
Added:
Ui.respond
48
Added:
@@ Layout.render context.site ~page_title:(page_title context)
49
Added:
{
50
Added:
repo = Some context.repo;
51
Added:
title = Option.value heading ~default:context.repo;
52
Added:
subtitle = context.description;
53
Added:
active;
54
Added:
toolbar;
55
Added:
home_href = None;
56
Added:
content;
57
Added:
}
58
Added:
59
Added:
(** {1 Rows} *)
60
Added:
61
Added:
(** One line of the commit list: when it happened, what changed, and who did it.
62
Added:
63
Added:
@param hide_pill
64
Added:
suppresses the type badge when the list is already filtered to a single
65
Added:
type, where repeating it on every row adds nothing.
66
Added:
@param author
67
Added:
when filtering by author, the author column is dropped for the same
68
Added:
reason. *)
69
Added:
let commit_row ?filter_type ?author ?committer ?(hide_pill = false) repo
70
Added:
(commit : Resolvers.Commit.t) =
71
Added:
let message = parse_commit_message commit.message in
72
Added:
let commit_type, title = parse_conventional message.summary in
73
Added:
let badge =
74
Added:
match commit_type with
75
Added:
| Some commit_type when not hide_pill ->
76
Added:
Components.commit_type_badge
77
Added:
~href:(commits_url ~filter_type:commit_type ?author ?committer repo)
78
Added:
commit_type
79
Added:
| _ -> Ui.nothing
80
Added:
in
81
Added:
Ui.item
82
Added:
[
83
Added:
Ui.inline_text ~class_:"timestamp"
84
Added:
(Time_format.short_time commit.author.date);
85
Added:
badge;
86
Added:
Ui.inline ~class_:"commit-title"
87
Added:
[ Components.route_link (Commit (repo, commit.hash)) title ];
88
Added:
Ui.inline_text ~class_:"commit-ago"
89
Added:
(Time_format.relative_time commit.author.date);
90
Added:
(match author with
91
Added:
| Some _ -> Ui.nothing
92
Added:
| None ->
93
Added:
Ui.inline ~class_:"commit-author"
94
Added:
[
95
Added:
identity_link ?filter_type ?author ?committer ~role:`Author repo
96
Added:
commit.author;
97
Added:
]);
98
Added:
]
99
Added:
100
Added:
(** Directories with more than seven entries show three children and a link to
101
Added:
the full directory page, keeping the tree scannable without hiding anything
102
Added:
permanently. The repository root is exempt — it always shows all entries. *)
103
Added:
let tree_truncation_threshold = 7
104
Added:
105
Added:
let tree_display_limit = 3
106
Added:
107
Added:
let rec tree_row repo (node : Resolvers.Tree.tree_node) =
108
Added:
let entry = node.entry in
109
Added:
let route = Routes.File (repo, entry.hash) in
110
Added:
(* Dotfiles stay visible but are de-emphasised. *)
111
Added:
let modifier =
112
Added:
if String.length entry.name > 0 && entry.name.[0] = '.' then "tree-hidden"
113
Added:
else ""
114
Added:
in
115
Added:
match node.children with
116
Added:
| None -> Components.file_entry ~modifier ~route entry.name
117
Added:
| Some children ->
118
Added:
let total = List.length children in
119
Added:
let shown, omitted =
120
Added:
if total <= tree_truncation_threshold then (children, 0)
121
Added:
else
122
Added:
(List_ext.take tree_display_limit children, total - tree_display_limit)
123
Added:
in
124
Added:
let overflow =
125
Added:
if omitted = 0 then [] else [ Components.overflow_row ~route omitted ]
126
Added:
in
127
Added:
Components.directory ~modifier ~route ~name:entry.name
128
Added:
(List.map (tree_row repo) shown @ overflow)
129
Added:
130
Added:
(** {1 Trails} *)
131
Added:
132
Added:
(** The path from the repository root to the entry being viewed. *)
133
Added:
let path_trail repo (trail : (string * string) list) =
134
Added:
let repo_name =
135
Added:
match List.rev (String.split_on_char '/' repo) with
136
Added:
| name :: _ -> name
137
Added:
| [] -> repo
138
Added:
in
139
Added:
let root = Ui.crumb ~href:(Components.url (Files repo)) repo_name in
140
Added:
let entries =
141
Added:
List.map
142
Added:
(fun (name, hash) ->
143
Added:
Ui.crumb ~href:(Components.url (File (repo, hash))) name)
144
Added:
trail
145
Added:
in
146
Added:
Ui.breadcrumb ~class_:"path-pill" ~link_class:"path-pill-link"
147
Added:
~separator_class:"path-pill-sep" ~separator:"/" (root :: entries)
148
Added:
149
Added:
(** {1 Pages} *)
150
Added:
151
Added:
let summary context ?readme () =
152
Added:
let readme_panel =
153
Added:
match readme with
154
Added:
| None -> Ui.nothing
155
Added:
| Some (readme : Resolvers.Readme.t) ->
156
Added:
Components.inline_readme ~filename:readme.name readme.content
157
Added:
in
158
Added:
render_page context ~active:Summary ~toolbar:[] [ readme_panel ]
159
Added:
160
Added:
let commits ?filter_type ?author ?committer ?(truncated = false) ~page_number
161
Added:
~has_prev ~has_next context commits =
162
Added:
(* Each active filter offers a control that clears just itself, leaving the
163
Added:
others applied. *)
164
Added:
let active_filters =
165
Added:
(match filter_type with
166
Added:
| None -> []
167
Added:
| Some commit_type ->
168
Added:
[
169
Added:
( "commit type",
170
Added:
commit_type,
171
Added:
commits_url ?author ?committer context.repo,
172
Added:
"commit-pill commit-pill-" ^ commit_type );
173
Added:
])
174
Added:
@ (match author with
175
Added:
| None -> []
176
Added:
| Some email ->
177
Added:
[
178
Added:
( "author",
179
Added:
"Author: " ^ email,
180
Added:
commits_url ?filter_type ?committer context.repo,
181
Added:
"toolbar-filter-value" );
182
Added:
])
183
Added:
@
184
Added:
match committer with
185
Added:
| None -> []
186
Added:
| Some email ->
187
Added:
[
188
Added:
( "committer",
189
Added:
"Committer: " ^ email,
190
Added:
commits_url ?filter_type ?author context.repo,
191
Added:
"toolbar-filter-value" );
192
Added:
]
193
Added:
in
194
Added:
let filters =
195
Added:
match active_filters with
196
Added:
| [] -> []
197
Added:
| filters ->
198
Added:
[
199
Added:
Ui.block ~class_:"toolbar-filters"
200
Added:
(List.map
201
Added:
(fun (name, value, dismiss_href, value_class) ->
202
Added:
Ui.dismissible ~value_class ~dismiss_href
203
Added:
~dismiss_label:(Printf.sprintf "Remove %s filter" name)
204
Added:
value)
205
Added:
filters);
206
Added:
]
207
Added:
in
208
Added:
let page_url n =
209
Added:
commits_url ?filter_type ?author ?committer ~page_number:n context.repo
210
Added:
in
211
Added:
let pagination =
212
Added:
if not (has_prev || has_next) then []
213
Added:
else
214
Added:
[
215
Added:
Ui.pagination
216
Added:
?previous_href:
217
Added:
(if has_prev then Some (page_url (page_number - 1)) else None)
218
Added:
?next_href:
219
Added:
(if has_next then Some (page_url (page_number + 1)) else None)
220
Added:
page_number;
221
Added:
]
222
Added:
in
223
Added:
render_page context ~active:Commits ~toolbar:(filters @ pagination)
224
Added:
[
225
Added:
Ui.items_of ~id:"commit-list"
226
Added:
(commit_row
227
Added:
~hide_pill:(Option.is_some filter_type)
228
Added:
?filter_type ?author ?committer context.repo)
229
Added:
commits;
230
Added:
(if truncated then
231
Added:
Ui.paragraph_text ~class_:"commit-list-note"
232
Added:
"The search stopped before it reached the oldest history. Older \
233
Added:
matching commits are not shown."
234
Added:
else Ui.nothing);
235
Added:
]
236
Added:
237
Added:
let files context trail (entries : Resolvers.Tree.tree_node list) =
238
Added:
render_page context ~active:Files
239
Added:
~toolbar:[ path_trail context.repo trail ]
240
Added:
[ Ui.items_of ~id:"file-tree" (tree_row context.repo) entries ]
241
Added:
242
Added:
let is_image_filename filename =
243
Added:
match Filename.extension filename |> String.lowercase_ascii with
244
Added:
| ".png" | ".jpg" | ".jpeg" | ".gif" | ".svg" | ".webp" | ".ico" | ".bmp"
245
Added:
| ".avif" ->
246
Added:
true
247
Added:
| _ -> false
248
Added:
249
Added:
let file context trail (blob : Resolvers.Blob.t) =
250
Added:
let filename =
251
Added:
match List.rev trail with (name, _) :: _ -> Some name | [] -> None
252
Added:
in
253
Added:
let raw_link =
254
Added:
match List.rev trail with
255
Added:
| (_, hash) :: _ ->
256
Added:
Ui.paragraph
257
Added:
[ Components.route_link (Raw_file (context.repo, hash)) "View raw" ]
258
Added:
| [] -> Ui.nothing
259
Added:
in
260
Added:
let body =
261
Added:
match filename with
262
Added:
| Some filename when is_image_filename filename ->
263
Added:
let src =
264
Added:
match List.rev trail with
265
Added:
| (_, hash) :: _ -> Components.url (Raw_file (context.repo, hash))
266
Added:
| [] -> ""
267
Added:
in
268
Added:
Ui.block ~class_:"image-preview"
269
Added:
[ Ui.image ~class_:"file-image" ~alt:filename ~src () ]
270
Added:
| Some filename when Prose.Render.is_doc_filename filename ->
271
Added:
Prose.Render.render ~filename blob.content
272
Added:
| _ ->
273
Added:
let language = Highlight.Detect.detect ~filename blob.content in
274
Added:
let lines = Highlight.Engine.highlight ~lang:language blob.content in
275
Added:
Ui.highlighted_code_listing ~id:"blob" lines
276
Added:
in
277
Added:
let toolbar = [ path_trail context.repo trail ] in
278
Added:
render_page context ~active:Files ~toolbar [ raw_link; body ]
279
Added:
280
Added:
let commit context (commit : Resolvers.Commit.t) diff =
281
Added:
let message = parse_commit_message commit.message in
282
Added:
let commit_type, title = parse_conventional message.summary in
283
Added:
let number = function Some n -> string_of_int n | None -> "" in
284
Added:
let diff_line (line : Resolvers.Diff.line) : Ui.Diff.line =
285
Added:
{
286
Added:
before = number line.old_number;
287
Added:
after = number line.new_number;
288
Added:
change =
289
Added:
(match line.kind with
290
Added:
| Resolvers.Diff.Context -> Ui.Diff.Unchanged
291
Added:
| Resolvers.Diff.Addition -> Ui.Diff.Added
292
Added:
| Resolvers.Diff.Deletion -> Ui.Diff.Removed);
293
Added:
content = line.text;
294
Added:
}
295
Added:
in
296
Added:
let diff_section (hunk : Resolvers.Diff.hunk) : Ui.Diff.section =
297
Added:
{
298
Added:
section_heading =
299
Added:
Printf.sprintf "@@ -%d,%d +%d,%d @@" hunk.old_start hunk.old_count
300
Added:
hunk.new_start hunk.new_count;
301
Added:
lines = List.map diff_line hunk.lines;
302
Added:
}
303
Added:
in
304
Added:
let mode = function
305
Added:
| None -> "000000"
306
Added:
| Some mode -> Printf.sprintf "%06o" mode
307
Added:
in
308
Added:
let hash = function
309
Added:
| None -> "00000000"
310
Added:
| Some hash -> Resolvers.short_hash hash
311
Added:
in
312
Added:
let diff_file (file : Resolvers.Diff.file) : Ui.Diff.file =
313
Added:
{
314
Added:
path = file.path;
315
Added:
detail =
316
Added:
Printf.sprintf "index %s..%s %s..%s" (hash file.old_hash)
317
Added:
(hash file.new_hash) (mode file.old_mode) (mode file.new_mode);
318
Added:
sections = List.map diff_section file.hunks;
319
Added:
note = (if file.binary then Some "Binary files differ" else None);
320
Added:
}
321
Added:
in
322
Added:
let badge =
323
Added:
match commit_type with
324
Added:
| None -> Ui.nothing
325
Added:
| Some commit_type ->
326
Added:
Components.commit_type_badge
327
Added:
~href:(commits_url ~filter_type:commit_type context.repo)
328
Added:
commit_type
329
Added:
in
330
Added:
let body =
331
Added:
if message.body = "" then []
332
Added:
else [ Ui.paragraph_text ~class_:"commit-body" message.body ]
333
Added:
in
334
Added:
let timestamp date =
335
Added:
let machine, display = Time_format.exact_time date in
336
Added:
Ui.timestamp ~machine display
337
Added:
in
338
Added:
let metadata =
339
Added:
Ui.definitions ~class_:"commit-meta"
340
Added:
[
341
Added:
("Commit", [ Ui.text commit.hash ]);
342
Added:
( "Author",
343
Added:
[
344
Added:
identity_link ~show_email:true ~role:`Author context.repo
345
Added:
commit.author;
346
Added:
] );
347
Added:
("Author date", [ timestamp commit.author.date ]);
348
Added:
( "Committer",
349
Added:
[
350
Added:
identity_link ~show_email:true ~role:`Committer context.repo
351
Added:
commit.committer;
352
Added:
] );
353
Added:
("Committer date", [ timestamp commit.committer.date ]);
354
Added:
]
355
Added:
in
356
Added:
render_page
357
Added:
~heading:(context.repo ^ " : " ^ Resolvers.short_hash commit.hash)
358
Added:
context ~active:Commits
359
Added:
((Ui.heading ~level:3 [ badge; Ui.text (" " ^ title) ] :: body)
360
Added:
@ [ metadata ]
361
Added:
@ Ui.Diff.view ~empty_message:"No file changes in this commit."
362
Added:
(List.map diff_file diff))
lib/views/repo_view.mli
@@ -0,0 +1,69 @@
1
Added:
(** The repository pages: summary, commit list, file tree, blob, and commit
2
Added:
detail.
3
Added:
4
Added:
Each page is a description: it names the parts it is made of and hands them
5
Added:
to {!Layout}. Markup lives in {!Ui}, ogit's page parts in {!Components},
6
Added:
language guessing in {!Syntax}, and date formatting in {!Time_format}. *)
7
Added:
8
Added:
(** {1 Context} *)
9
Added:
10
Added:
type context
11
Added:
(** What every repository page needs to know about its subject. *)
12
Added:
13
Added:
val context : site:Layout.site -> repo:string -> description:string -> context
14
Added:
(** Build a page context from site settings and repository metadata. *)
15
Added:
16
Added:
(** {1 Commit messages} *)
17
Added:
18
Added:
type commit_message = { summary : string; body : string }
19
Added:
(** A commit message split into its first-line summary and remaining body. *)
20
Added:
21
Added:
val parse_commit_message : string option -> commit_message
22
Added:
(** Split a raw commit message into summary and body. *)
23
Added:
24
Added:
val parse_conventional : string -> string option * string
25
Added:
(** [parse_conventional summary] returns [(Some type, title)] if the summary
26
Added:
follows Conventional Commits, or [(None, summary)] otherwise. *)
27
Added:
28
Added:
(** {1 Pages} *)
29
Added:
30
Added:
val summary :
31
Added:
context -> ?readme:Resolvers.Readme.t -> unit -> Dream.response Dream.promise
32
Added:
(** The repository summary page, optionally showing a README. *)
33
Added:
34
Added:
val commits :
35
Added:
?filter_type:string ->
36
Added:
?author:string ->
37
Added:
?committer:string ->
38
Added:
?truncated:bool ->
39
Added:
page_number:int ->
40
Added:
has_prev:bool ->
41
Added:
has_next:bool ->
42
Added:
context ->
43
Added:
Resolvers.Commit.t list ->
44
Added:
Dream.response Dream.promise
45
Added:
(** The paginated commit list, with optional type/author/committer filters.
46
Added:
[truncated] adds a notice that the history walk stopped before the oldest
47
Added:
commits, so older matches may be missing. *)
48
Added:
49
Added:
val files :
50
Added:
context ->
51
Added:
(string * string) list ->
52
Added:
Resolvers.Tree.tree_node list ->
53
Added:
Dream.response Dream.promise
54
Added:
(** The file tree page. The trail is the path from root to the current
55
Added:
directory. *)
56
Added:
57
Added:
val file :
58
Added:
context ->
59
Added:
(string * string) list ->
60
Added:
Resolvers.Blob.t ->
61
Added:
Dream.response Dream.promise
62
Added:
(** A single file view with syntax highlighting or prose rendering. *)
63
Added:
64
Added:
val commit :
65
Added:
context ->
66
Added:
Resolvers.Commit.t ->
67
Added:
Resolvers.Diff.file list ->
68
Added:
Dream.response Dream.promise
69
Added:
(** The commit detail page showing metadata and a diff. *)