[OCaml] Mobile-friendly clone of cgit.
Split views into views/ directory with layout and page modules
- lib/views/layout.ml: page chrome (header, footer, nav, render, error_page) - lib/views/root.ml: index/root page - lib/views/repo.ml: all repository pages (summary, commits, files, etc.) - lib/views.ml: thin re-export module preserving the existing API - Use (include_subdirs unqualified) in dune to include views/ in ogit lib
lib/dune
@@ -1,5 +1,7 @@
1
1
;; -*- mode: lisp; -*-
2
2
3
Added:
(include_subdirs unqualified)
4
Added:
3
5
(library
4
6
(name ogit)
5
7
(libraries dream dream-html git-unix toml)
lib/views.ml
@@ -1,440 +1,16 @@
1
1
(* -*- mode: tuareg; -*- *)
2
2
3
Removed:
open Dream_html
4
Removed:
open Config
3
Added:
(** View layer — re-exports layout and page modules. *)
5
4
6
Removed:
type page = Summary | Commits | Files | Branches | Tags | Readme
5
Added:
let error_page = Layout.error_page
6
Added:
let root = Root.render
7
7
8
Removed:
type body_data = {
9
Removed:
title : string;
10
Removed:
repo : string option;
11
Removed:
subtitle : string;
12
Removed:
active : page;
13
Removed:
content : node list;
14
Removed:
}
15
Removed:
16
Removed:
let page_to_nav_item repo = function
17
Removed:
| Summary -> (Routes.Repo repo, "Summary", Summary)
18
Removed:
| Commits -> (Routes.Commits repo, "Commits", Commits)
19
Removed:
| Files -> (Routes.Files repo, "Files", Files)
20
Removed:
| Branches -> (Routes.Branches repo, "Branches", Branches)
21
Removed:
| Tags -> (Routes.Tags repo, "Tags", Tags)
22
Removed:
| Readme -> (Routes.Readme repo, "README", Readme)
23
Removed:
24
Removed:
module Components = struct
25
Removed:
let topnav ?(active = Summary) repo =
26
Removed:
let nav_items =
27
Removed:
List.map (page_to_nav_item repo)
28
Removed:
[ Summary; Commits; Files; Branches; Tags; Readme ]
29
Removed:
in
30
Removed:
let li_of_item (route, text, path) =
31
Removed:
let is_active = path = active in
32
Removed:
let attrs = if is_active then [ Aria.current `page ] else [] in
33
Removed:
HTML.li attrs [ Routes.link_to route (txt "%s" text) ]
34
Removed:
in
35
Removed:
HTML.(
36
Removed:
nav
37
Removed:
[ id "top"; Aria.label "Repository navigation" ]
38
Removed:
[
39
Removed:
Routes.link_to Root ~other_attrs:[ class_ "nav-home" ] (txt "Home");
40
Removed:
input [ type_ "checkbox"; id "nav-toggle"; class_ "nav-toggle" ];
41
Removed:
label
42
Removed:
[ for_ "nav-toggle"; class_ "nav-hamburger"; Aria.label "Menu" ]
43
Removed:
[ txt "\xe2\x8b\xae" ];
44
Removed:
ul [] (List.map li_of_item nav_items);
45
Removed:
])
46
Removed:
end
47
Removed:
48
Removed:
module Page = struct
49
Removed:
let page_header header1 header2 =
50
Removed:
let header2 =
51
Removed:
if String.starts_with ~prefix:"Unnamed repository" header2 then ""
52
Removed:
else header2
53
Removed:
in
54
Removed:
HTML.(
55
Removed:
header
56
Removed:
[ id "page-header" ]
57
Removed:
[
58
Removed:
img
59
Removed:
[
60
Removed:
src "/static/git_icon.svg";
61
Removed:
alt "";
62
Removed:
role `presentation;
63
Removed:
class_ "site-logo";
64
Removed:
];
65
Removed:
div [] [ h1 [] [ txt "%s" header1 ]; h2 [] [ txt "%s" header2 ] ];
66
Removed:
])
67
Removed:
68
Removed:
let page_footer () =
69
Removed:
let now = Unix.(time () |> localtime) in
70
Removed:
let year = string_of_int (now.tm_year + 1900) in
71
Removed:
let footer_text = Printf.sprintf "Copyright %s %s" year config.user in
72
Removed:
HTML.footer [] [ txt "%s" footer_text ]
73
Removed:
74
Removed:
let head page_title =
75
Removed:
let open HTML in
76
Removed:
head []
77
Removed:
[
78
Removed:
title [] "%s" page_title;
79
Removed:
meta [ name "viewport"; content "width=device-width, initial-scale=1" ];
80
Removed:
link [ rel "stylesheet"; href "/static/styles.css" ];
81
Removed:
link [ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
82
Removed:
]
83
Removed:
84
Removed:
let body bd =
85
Removed:
let open HTML in
86
Removed:
body []
87
Removed:
[
88
Removed:
a [ href "#main"; class_ "skip-link" ] [ txt "Skip to content" ];
89
Removed:
page_header bd.title bd.subtitle;
90
Removed:
(match bd.repo with
91
Removed:
| None -> HTML.null []
92
Removed:
| Some repo -> Components.topnav ~active:bd.active repo);
93
Removed:
div [ id "main" ] bd.content;
94
Removed:
page_footer ();
95
Removed:
]
96
Removed:
97
Removed:
let render ?(page_title = "Ogit") body_data =
98
Removed:
HTML.html [ HTML.lang "en" ] [ head page_title; body body_data ]
99
Removed:
end
100
Removed:
101
Removed:
let error_page message =
102
Removed:
let open HTML in
103
Removed:
respond
104
Removed:
@@ html []
105
Removed:
[
106
Removed:
Page.head "Fatal Error";
107
Removed:
body []
108
Removed:
[
109
Removed:
h1 [] [ txt "Fatal Error" ];
110
Removed:
div
111
Removed:
[ id "main" ]
112
Removed:
[
113
Removed:
p [] [ b [] [ txt "%s" message ] ];
114
Removed:
p []
115
Removed:
[
116
Removed:
txt
117
Removed:
"Your best course of action is to press the 'back' \
118
Removed:
button in your browser.";
119
Removed:
];
120
Removed:
];
121
Removed:
];
122
Removed:
]
123
Removed:
124
Removed:
let root () =
125
Removed:
try
126
Removed:
let all_repositories =
127
Removed:
(* Ignore hidden directories. *)
128
Removed:
let repos =
129
Removed:
Sys.readdir config.git_project_root
130
Removed:
|> Array.to_list
131
Removed:
|> List.filter (fun name ->
132
Removed:
(not (name.[0] = '.'))
133
Removed:
&& Resolvers.is_repository
134
Removed:
(Filename.concat config.git_project_root name))
135
Removed:
|> List.sort String.compare
136
Removed:
in
137
Removed:
let li_of_repo repo =
138
Removed:
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
139
Removed:
in
140
Removed:
HTML.(div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ])
141
Removed:
in
142
Removed:
respond
143
Removed:
@@ Page.render
144
Removed:
{
145
Removed:
title = "Ogit";
146
Removed:
repo = None;
147
Removed:
subtitle = "Repositories for " ^ config.user;
148
Removed:
active = Summary;
149
Removed:
content = [ all_repositories ];
150
Removed:
}
151
Removed:
with Sys_error message -> error_page message
152
Removed:
153
8
module Repo = struct
154
Removed:
let page_title repo =
155
Removed:
Printf.sprintf "%s — %s" repo (Resolvers.repo_description repo)
156
Removed:
157
Removed:
let li_of_author (author : Resolvers.Commit.user) =
158
Removed:
HTML.(li [] [ txt "%s" author.name ])
159
Removed:
160
Removed:
let li_of_branch repo (branch : Resolvers.Reference.t) =
161
Removed:
HTML.(
162
Removed:
li []
163
Removed:
[
164
Removed:
Routes.link_to
165
Removed:
(Commits_branch (repo, branch.name))
166
Removed:
(txt "%s" branch.name);
167
Removed:
])
168
Removed:
169
Removed:
let li_of_tag repo (tag : Resolvers.Reference.t) =
170
Removed:
HTML.(li [] [ Routes.link_to (Tags repo) (txt "%s" tag.name) ])
171
Removed:
172
Removed:
let commit_summary message =
173
Removed:
match message with
174
Removed:
| None -> ""
175
Removed:
| Some msg -> (
176
Removed:
match String.split_on_char '\n' msg with
177
Removed:
| [] -> ""
178
Removed:
| first :: _ -> first)
179
Removed:
180
Removed:
let commit_body message =
181
Removed:
match message with
182
Removed:
| None -> ""
183
Removed:
| Some msg -> (
184
Removed:
match String.split_on_char '\n' msg with
185
Removed:
| [] | [ _ ] -> ""
186
Removed:
| _ :: rest ->
187
Removed:
let body = String.concat "\n" rest |> String.trim in
188
Removed:
body)
189
Removed:
190
Removed:
let li_of_commit repo (commit : Resolvers.Commit.t) =
191
Removed:
let timestamp (date, _) =
192
Removed:
let tm = date |> Int64.to_float |> Unix.localtime in
193
Removed:
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.tm_year + 1900)
194
Removed:
(tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min
195
Removed:
in
196
Removed:
let timestamp_span =
197
Removed:
HTML.(
198
Removed:
span [ class_ "timestamp" ] [ txt "%s" (timestamp commit.author.date) ])
199
Removed:
in
200
Removed:
let summary = commit_summary commit.message in
201
Removed:
let description =
202
Removed:
if summary = "" then HTML.null [] else txt " %s" summary
203
Removed:
in
204
Removed:
let route = Routes.Commit (repo, commit.hash) in
205
Removed:
let node = HTML.null [ timestamp_span; description ] in
206
Removed:
HTML.li [] [ Routes.link_to route node ]
207
Removed:
208
Removed:
let li_of_entry repo (entry : Resolvers.Entry.t) =
209
Removed:
let route = Routes.File (repo, entry.hash) in
210
Removed:
let text =
211
Removed:
txt "%s" (if entry.perm = Dir then entry.name ^ "/" else entry.name)
212
Removed:
in
213
Removed:
HTML.(li [] [ Routes.link_to route text ])
214
Removed:
215
Removed:
let summary repo branches commits =
216
Removed:
respond
217
Removed:
@@ Page.render ~page_title:(page_title repo)
218
Removed:
{
219
Removed:
repo = Some repo;
220
Removed:
title = repo;
221
Removed:
subtitle = Resolvers.repo_description repo;
222
Removed:
active = Summary;
223
Removed:
content =
224
Removed:
HTML.
225
Removed:
[
226
Removed:
h3 [] [ txt "Branches" ];
227
Removed:
ul [] (List.map (li_of_branch repo) branches);
228
Removed:
h3 [] [ txt "Latest commits" ];
229
Removed:
ul [] (List.map (li_of_commit repo) commits);
230
Removed:
(* h3 [] [ txt "Authors" ]; *)
231
Removed:
(* ul [] (List.map li_of_author authors); *)
232
Removed:
];
233
Removed:
}
234
Removed:
235
Removed:
let commits repo commits =
236
Removed:
respond
237
Removed:
@@ Page.render ~page_title:(page_title repo)
238
Removed:
{
239
Removed:
repo = Some repo;
240
Removed:
title = repo;
241
Removed:
subtitle = Resolvers.repo_description repo;
242
Removed:
active = Commits;
243
Removed:
content = HTML.[ ul [] @@ List.map (li_of_commit repo) commits ];
244
Removed:
}
245
Removed:
246
Removed:
let breadcrumbs repo (trail : (string * string) list) =
247
Removed:
let root_link = Routes.link_to (Files repo) (txt "/") in
248
Removed:
let crumbs =
249
Removed:
List.map
250
Removed:
(fun (name, hash) -> Routes.link_to (File (repo, hash)) (txt "%s" name))
251
Removed:
trail
252
Removed:
in
253
Removed:
let separator = txt " / " in
254
Removed:
let rec interleave = function
255
Removed:
| [] -> []
256
Removed:
| [ x ] -> [ x ]
257
Removed:
| x :: rest -> x :: separator :: interleave rest
258
Removed:
in
259
Removed:
HTML.(
260
Removed:
nav
261
Removed:
[ class_ "breadcrumbs"; Aria.label "File path" ]
262
Removed:
(interleave (root_link :: crumbs)))
263
Removed:
264
Removed:
let files repo trail (tree : Resolvers.Tree.t) =
265
Removed:
respond
266
Removed:
@@ Page.render ~page_title:(page_title repo)
267
Removed:
{
268
Removed:
repo = Some repo;
269
Removed:
title = repo;
270
Removed:
subtitle = Resolvers.repo_description repo;
271
Removed:
active = Files;
272
Removed:
content =
273
Removed:
HTML.
274
Removed:
[
275
Removed:
breadcrumbs repo trail;
276
Removed:
ul [] @@ List.map (li_of_entry repo) tree.entries;
277
Removed:
];
278
Removed:
}
279
Removed:
280
Removed:
let file repo trail (blob : Resolvers.Blob.t) =
281
Removed:
let to_numbered_line number line =
282
Removed:
let n = number + 1 in
283
Removed:
HTML.
284
Removed:
[
285
Removed:
a
286
Removed:
[
287
Removed:
id "%d" n;
288
Removed:
class_ "line-anchor";
289
Removed:
href "#%d" n;
290
Removed:
Aria.label "Line %d" n;
291
Removed:
]
292
Removed:
[ txt "%d" n ];
293
Removed:
span [ class_ "line" ] [ txt "\t%s\n" line ];
294
Removed:
]
295
Removed:
in
296
Removed:
let formatted_blob =
297
Removed:
String.split_on_char '\n' blob.content
298
Removed:
|> List.mapi to_numbered_line |> List.flatten
299
Removed:
in
300
Removed:
respond
301
Removed:
@@ Page.render ~page_title:(page_title repo)
302
Removed:
{
303
Removed:
repo = Some repo;
304
Removed:
title = repo;
305
Removed:
subtitle = Resolvers.repo_description repo;
306
Removed:
active = Files;
307
Removed:
content =
308
Removed:
HTML.[ breadcrumbs repo trail; div [ id "blob" ] formatted_blob ];
309
Removed:
}
310
Removed:
311
Removed:
let commit repo (commit : Resolvers.Commit.t) diff =
312
Removed:
let commit_summary_text = commit_summary commit.message in
313
Removed:
let commit_body_text = commit_body commit.message in
314
Removed:
let number = function Some number -> string_of_int number | None -> "" in
315
Removed:
let line (line : Resolvers.Diff.line) =
316
Removed:
let class_name, marker, sr_label =
317
Removed:
match line.kind with
318
Removed:
| Resolvers.Diff.Context -> ("context", " ", "")
319
Removed:
| Resolvers.Diff.Addition -> ("addition", "+", "Added: ")
320
Removed:
| Resolvers.Diff.Deletion -> ("deletion", "-", "Removed: ")
321
Removed:
in
322
Removed:
HTML.(
323
Removed:
div
324
Removed:
[ class_ "diff-line %s" class_name ]
325
Removed:
[
326
Removed:
span [ class_ "line-number" ] [ txt "%s" (number line.old_number) ];
327
Removed:
span [ class_ "line-number" ] [ txt "%s" (number line.new_number) ];
328
Removed:
span [ class_ "diff-marker"; Aria.hidden true ] [ txt "%s" marker ];
329
Removed:
span [ class_ "sr-only" ] [ txt "%s" sr_label ];
330
Removed:
span [ class_ "diff-text" ] [ txt "%s" line.text ];
331
Removed:
])
332
Removed:
in
333
Removed:
let hunk (hunk : Resolvers.Diff.hunk) =
334
Removed:
HTML.
335
Removed:
[
336
Removed:
div
337
Removed:
[ class_ "hunk-header" ]
338
Removed:
[
339
Removed:
txt "@@ -%d,%d +%d,%d @@" hunk.old_start hunk.old_count
340
Removed:
hunk.new_start hunk.new_count;
341
Removed:
];
342
Removed:
null (List.map line hunk.lines);
343
Removed:
]
344
Removed:
in
345
Removed:
let mode = function
346
Removed:
| None -> "000000"
347
Removed:
| Some mode -> Printf.sprintf "%06o" mode
348
Removed:
in
349
Removed:
let hash = function
350
Removed:
| None -> "00000000"
351
Removed:
| Some hash -> Resolvers.short_hash hash
352
Removed:
in
353
Removed:
let file (file : Resolvers.Diff.file) =
354
Removed:
let file_body =
355
Removed:
if file.binary then
356
Removed:
HTML.[ p [ class_ "binary-diff" ] [ txt "Binary files differ" ] ]
357
Removed:
else List.concat_map hunk file.hunks
358
Removed:
in
359
Removed:
HTML.(
360
Removed:
section
361
Removed:
[ class_ "diff-file" ]
362
Removed:
([
363
Removed:
h4 [ class_ "diff-file-header" ] [ txt "%s" file.path ];
364
Removed:
div
365
Removed:
[ class_ "diff-meta" ]
366
Removed:
[
367
Removed:
txt "index %s..%s %s..%s" (hash file.old_hash)
368
Removed:
(hash file.new_hash) (mode file.old_mode)
369
Removed:
(mode file.new_mode);
370
Removed:
];
371
Removed:
]
372
Removed:
@ file_body))
373
Removed:
in
374
Removed:
let diff_content =
375
Removed:
match diff with
376
Removed:
| [] -> HTML.[ p [] [ txt "No file changes in this commit." ] ]
377
Removed:
| files -> List.map file files
378
Removed:
in
379
Removed:
respond
380
Removed:
@@ Page.render ~page_title:(page_title repo)
381
Removed:
{
382
Removed:
repo = Some repo;
383
Removed:
title =
384
Removed:
Printf.sprintf "%s : %s" repo @@ Resolvers.short_hash commit.hash;
385
Removed:
subtitle = Resolvers.repo_description repo;
386
Removed:
active = Summary;
387
Removed:
content =
388
Removed:
HTML.(
389
Removed:
[ h3 [] [ txt "%s" commit_summary_text ] ]
390
Removed:
@ (if commit_body_text = "" then []
391
Removed:
else
392
Removed:
[ p [ class_ "commit-body" ] [ txt "%s" commit_body_text ] ])
393
Removed:
@ [
394
Removed:
dl
395
Removed:
[ class_ "commit-meta" ]
396
Removed:
[
397
Removed:
dt [] [ txt "Commit" ];
398
Removed:
dd [] [ txt "%s" commit.hash ];
399
Removed:
dt [] [ txt "Author" ];
400
Removed:
dd []
401
Removed:
[
402
Removed:
txt "%s <%s>" commit.author.name commit.author.email;
403
Removed:
];
404
Removed:
];
405
Removed:
]
406
Removed:
@ diff_content);
407
Removed:
}
408
Removed:
409
Removed:
let branches repo branches =
410
Removed:
let content =
411
Removed:
match branches with
412
Removed:
| [] -> HTML.[ p [] [ txt "No branches for repo %s" repo ] ]
413
Removed:
| branches -> HTML.[ ul [] @@ List.map (li_of_branch repo) branches ]
414
Removed:
in
415
Removed:
respond
416
Removed:
@@ Page.render ~page_title:(page_title repo)
417
Removed:
{
418
Removed:
repo = Some repo;
419
Removed:
title = repo;
420
Removed:
subtitle = Resolvers.repo_description repo;
421
Removed:
active = Branches;
422
Removed:
content;
423
Removed:
}
424
Removed:
425
Removed:
let tags repo tags =
426
Removed:
let content =
427
Removed:
match tags with
428
Removed:
| [] -> HTML.[ p [] [ txt "No tags for repo %s" repo ] ]
429
Removed:
| tags -> HTML.[ ul [] @@ List.map (li_of_tag repo) tags ]
430
Removed:
in
431
Removed:
respond
432
Removed:
@@ Page.render ~page_title:(page_title repo)
433
Removed:
{
434
Removed:
repo = Some repo;
435
Removed:
title = repo;
436
Removed:
subtitle = Resolvers.repo_description repo;
437
Removed:
active = Tags;
438
Removed:
content;
439
Removed:
}
9
Added:
let summary = Repo.summary
10
Added:
let commits = Repo.commits
11
Added:
let files = Repo.files
12
Added:
let file = Repo.file
13
Added:
let commit = Repo.commit
14
Added:
let branches = Repo.branches
15
Added:
let tags = Repo.tags
440
16
end
lib/views/layout.ml
@@ -0,0 +1,126 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Dream_html
4
Added:
open Config
5
Added:
6
Added:
type page = Summary | Commits | Files | Branches | Tags | Readme
7
Added:
8
Added:
type body_data = {
9
Added:
title : string;
10
Added:
repo : string option;
11
Added:
subtitle : string;
12
Added:
active : page;
13
Added:
content : node list;
14
Added:
}
15
Added:
16
Added:
let page_to_nav_item repo = function
17
Added:
| Summary -> (Routes.Repo repo, "Summary", Summary)
18
Added:
| Commits -> (Routes.Commits repo, "Commits", Commits)
19
Added:
| Files -> (Routes.Files repo, "Files", Files)
20
Added:
| Branches -> (Routes.Branches repo, "Branches", Branches)
21
Added:
| Tags -> (Routes.Tags repo, "Tags", Tags)
22
Added:
| Readme -> (Routes.Readme repo, "README", Readme)
23
Added:
24
Added:
let topnav ?(active = Summary) repo =
25
Added:
let nav_items =
26
Added:
List.map (page_to_nav_item repo)
27
Added:
[ Summary; Commits; Files; Branches; Tags; Readme ]
28
Added:
in
29
Added:
let li_of_item (route, text, path) =
30
Added:
let is_active = path = active in
31
Added:
let attrs = if is_active then [ Aria.current `page ] else [] in
32
Added:
HTML.li attrs [ Routes.link_to route (txt "%s" text) ]
33
Added:
in
34
Added:
HTML.(
35
Added:
nav
36
Added:
[ id "top"; Aria.label "Repository navigation" ]
37
Added:
[
38
Added:
Routes.link_to Root ~other_attrs:[ class_ "nav-home" ] (txt "Home");
39
Added:
input [ type_ "checkbox"; id "nav-toggle"; class_ "nav-toggle" ];
40
Added:
label
41
Added:
[ for_ "nav-toggle"; class_ "nav-hamburger"; Aria.label "Menu" ]
42
Added:
[ txt "\xe2\x8b\xae" ];
43
Added:
ul [] (List.map li_of_item nav_items);
44
Added:
])
45
Added:
46
Added:
let page_header header1 header2 =
47
Added:
let header2 =
48
Added:
if String.starts_with ~prefix:"Unnamed repository" header2 then ""
49
Added:
else header2
50
Added:
in
51
Added:
HTML.(
52
Added:
header
53
Added:
[ id "page-header" ]
54
Added:
[
55
Added:
img
56
Added:
[
57
Added:
src "/static/git_icon.svg";
58
Added:
alt "";
59
Added:
role `presentation;
60
Added:
class_ "site-logo";
61
Added:
];
62
Added:
div [] [ h1 [] [ txt "%s" header1 ]; h2 [] [ txt "%s" header2 ] ];
63
Added:
])
64
Added:
65
Added:
let page_footer () =
66
Added:
let now = Unix.(time () |> localtime) in
67
Added:
let year = string_of_int (now.tm_year + 1900) in
68
Added:
let footer_text = Printf.sprintf "Copyright %s %s" year config.user in
69
Added:
HTML.footer [] [ txt "%s" footer_text ]
70
Added:
71
Added:
let head page_title =
72
Added:
let open HTML in
73
Added:
head []
74
Added:
[
75
Added:
title [] "%s" page_title;
76
Added:
meta [ name "viewport"; content "width=device-width, initial-scale=1" ];
77
Added:
link [ rel "stylesheet"; href "/static/styles.css" ];
78
Added:
link [ rel "icon"; type_ "image/x-icon"; href "/static/git_icon.svg" ];
79
Added:
]
80
Added:
81
Added:
let body bd =
82
Added:
let open HTML in
83
Added:
body []
84
Added:
[
85
Added:
a [ href "#main"; class_ "skip-link" ] [ txt "Skip to content" ];
86
Added:
page_header bd.title bd.subtitle;
87
Added:
(match bd.repo with
88
Added:
| None -> HTML.null []
89
Added:
| Some repo -> topnav ~active:bd.active repo);
90
Added:
div [ id "main" ] bd.content;
91
Added:
page_footer ();
92
Added:
]
93
Added:
94
Added:
let render ?(page_title = "Ogit") body_data =
95
Added:
HTML.html [ HTML.lang "en" ] [ head page_title; body body_data ]
96
Added:
97
Added:
let error_page message =
98
Added:
let open HTML in
99
Added:
respond
100
Added:
@@ html []
101
Added:
[
102
Added:
head []
103
Added:
[
104
Added:
title [] "Fatal Error";
105
Added:
meta
106
Added:
[
107
Added:
name "viewport"; content "width=device-width, initial-scale=1";
108
Added:
];
109
Added:
link [ rel "stylesheet"; href "/static/styles.css" ];
110
Added:
];
111
Added:
body []
112
Added:
[
113
Added:
h1 [] [ txt "Fatal Error" ];
114
Added:
div
115
Added:
[ id "main" ]
116
Added:
[
117
Added:
p [] [ b [] [ txt "%s" message ] ];
118
Added:
p []
119
Added:
[
120
Added:
txt
121
Added:
"Your best course of action is to press the 'back' \
122
Added:
button in your browser.";
123
Added:
];
124
Added:
];
125
Added:
];
126
Added:
]
lib/views/repo.ml
@@ -0,0 +1,278 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Dream_html
4
Added:
5
Added:
let page_title repo =
6
Added:
Printf.sprintf "%s — %s" repo (Resolvers.repo_description repo)
7
Added:
8
Added:
let li_of_branch repo (branch : Resolvers.Reference.t) =
9
Added:
HTML.(
10
Added:
li []
11
Added:
[
12
Added:
Routes.link_to
13
Added:
(Commits_branch (repo, branch.name))
14
Added:
(txt "%s" branch.name);
15
Added:
])
16
Added:
17
Added:
let li_of_tag repo (tag : Resolvers.Reference.t) =
18
Added:
HTML.(li [] [ Routes.link_to (Tags repo) (txt "%s" tag.name) ])
19
Added:
20
Added:
let commit_summary message =
21
Added:
match message with
22
Added:
| None -> ""
23
Added:
| Some msg -> (
24
Added:
match String.split_on_char '\n' msg with [] -> "" | first :: _ -> first)
25
Added:
26
Added:
let commit_body message =
27
Added:
match message with
28
Added:
| None -> ""
29
Added:
| Some msg -> (
30
Added:
match String.split_on_char '\n' msg with
31
Added:
| [] | [ _ ] -> ""
32
Added:
| _ :: rest ->
33
Added:
let body = String.concat "\n" rest |> String.trim in
34
Added:
body)
35
Added:
36
Added:
let li_of_commit repo (commit : Resolvers.Commit.t) =
37
Added:
let timestamp (date, _) =
38
Added:
let tm = date |> Int64.to_float |> Unix.localtime in
39
Added:
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.tm_year + 1900)
40
Added:
(tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min
41
Added:
in
42
Added:
let timestamp_span =
43
Added:
HTML.(
44
Added:
span [ class_ "timestamp" ] [ txt "%s" (timestamp commit.author.date) ])
45
Added:
in
46
Added:
let summary = commit_summary commit.message in
47
Added:
let description = if summary = "" then HTML.null [] else txt " %s" summary in
48
Added:
let route = Routes.Commit (repo, commit.hash) in
49
Added:
let node = HTML.null [ timestamp_span; description ] in
50
Added:
HTML.li [] [ Routes.link_to route node ]
51
Added:
52
Added:
let li_of_entry repo (entry : Resolvers.Entry.t) =
53
Added:
let route = Routes.File (repo, entry.hash) in
54
Added:
let text =
55
Added:
txt "%s" (if entry.perm = Dir then entry.name ^ "/" else entry.name)
56
Added:
in
57
Added:
HTML.(li [] [ Routes.link_to route text ])
58
Added:
59
Added:
let summary repo branches commits =
60
Added:
respond
61
Added:
@@ Layout.render ~page_title:(page_title repo)
62
Added:
{
63
Added:
repo = Some repo;
64
Added:
title = repo;
65
Added:
subtitle = Resolvers.repo_description repo;
66
Added:
active = Summary;
67
Added:
content =
68
Added:
HTML.
69
Added:
[
70
Added:
h3 [] [ txt "Branches" ];
71
Added:
ul [] (List.map (li_of_branch repo) branches);
72
Added:
h3 [] [ txt "Latest commits" ];
73
Added:
ul [] (List.map (li_of_commit repo) commits);
74
Added:
];
75
Added:
}
76
Added:
77
Added:
let commits repo commits =
78
Added:
respond
79
Added:
@@ Layout.render ~page_title:(page_title repo)
80
Added:
{
81
Added:
repo = Some repo;
82
Added:
title = repo;
83
Added:
subtitle = Resolvers.repo_description repo;
84
Added:
active = Commits;
85
Added:
content = HTML.[ ul [] @@ List.map (li_of_commit repo) commits ];
86
Added:
}
87
Added:
88
Added:
let breadcrumbs repo (trail : (string * string) list) =
89
Added:
let root_link = Routes.link_to (Files repo) (txt "/") in
90
Added:
let crumbs =
91
Added:
List.map
92
Added:
(fun (name, hash) -> Routes.link_to (File (repo, hash)) (txt "%s" name))
93
Added:
trail
94
Added:
in
95
Added:
let separator = txt " / " in
96
Added:
let rec interleave = function
97
Added:
| [] -> []
98
Added:
| [ x ] -> [ x ]
99
Added:
| x :: rest -> x :: separator :: interleave rest
100
Added:
in
101
Added:
HTML.(
102
Added:
nav
103
Added:
[ class_ "breadcrumbs"; Aria.label "File path" ]
104
Added:
(interleave (root_link :: crumbs)))
105
Added:
106
Added:
let files repo trail (tree : Resolvers.Tree.t) =
107
Added:
respond
108
Added:
@@ Layout.render ~page_title:(page_title repo)
109
Added:
{
110
Added:
repo = Some repo;
111
Added:
title = repo;
112
Added:
subtitle = Resolvers.repo_description repo;
113
Added:
active = Files;
114
Added:
content =
115
Added:
HTML.
116
Added:
[
117
Added:
breadcrumbs repo trail;
118
Added:
ul [] @@ List.map (li_of_entry repo) tree.entries;
119
Added:
];
120
Added:
}
121
Added:
122
Added:
let file repo trail (blob : Resolvers.Blob.t) =
123
Added:
let to_numbered_line number line =
124
Added:
let n = number + 1 in
125
Added:
HTML.
126
Added:
[
127
Added:
a
128
Added:
[
129
Added:
id "%d" n;
130
Added:
class_ "line-anchor";
131
Added:
href "#%d" n;
132
Added:
Aria.label "Line %d" n;
133
Added:
]
134
Added:
[ txt "%d" n ];
135
Added:
span [ class_ "line" ] [ txt "\t%s\n" line ];
136
Added:
]
137
Added:
in
138
Added:
let formatted_blob =
139
Added:
String.split_on_char '\n' blob.content
140
Added:
|> List.mapi to_numbered_line |> List.flatten
141
Added:
in
142
Added:
respond
143
Added:
@@ Layout.render ~page_title:(page_title repo)
144
Added:
{
145
Added:
repo = Some repo;
146
Added:
title = repo;
147
Added:
subtitle = Resolvers.repo_description repo;
148
Added:
active = Files;
149
Added:
content =
150
Added:
HTML.[ breadcrumbs repo trail; div [ id "blob" ] formatted_blob ];
151
Added:
}
152
Added:
153
Added:
let commit repo (commit : Resolvers.Commit.t) diff =
154
Added:
let commit_summary_text = commit_summary commit.message in
155
Added:
let commit_body_text = commit_body commit.message in
156
Added:
let number = function Some number -> string_of_int number | None -> "" in
157
Added:
let line (line : Resolvers.Diff.line) =
158
Added:
let class_name, marker, sr_label =
159
Added:
match line.kind with
160
Added:
| Resolvers.Diff.Context -> ("context", " ", "")
161
Added:
| Resolvers.Diff.Addition -> ("addition", "+", "Added: ")
162
Added:
| Resolvers.Diff.Deletion -> ("deletion", "-", "Removed: ")
163
Added:
in
164
Added:
HTML.(
165
Added:
div
166
Added:
[ class_ "diff-line %s" class_name ]
167
Added:
[
168
Added:
span [ class_ "line-number" ] [ txt "%s" (number line.old_number) ];
169
Added:
span [ class_ "line-number" ] [ txt "%s" (number line.new_number) ];
170
Added:
span [ class_ "diff-marker"; Aria.hidden true ] [ txt "%s" marker ];
171
Added:
span [ class_ "sr-only" ] [ txt "%s" sr_label ];
172
Added:
span [ class_ "diff-text" ] [ txt "%s" line.text ];
173
Added:
])
174
Added:
in
175
Added:
let hunk (hunk : Resolvers.Diff.hunk) =
176
Added:
HTML.
177
Added:
[
178
Added:
div
179
Added:
[ class_ "hunk-header" ]
180
Added:
[
181
Added:
txt "@@ -%d,%d +%d,%d @@" hunk.old_start hunk.old_count
182
Added:
hunk.new_start hunk.new_count;
183
Added:
];
184
Added:
null (List.map line hunk.lines);
185
Added:
]
186
Added:
in
187
Added:
let mode = function
188
Added:
| None -> "000000"
189
Added:
| Some mode -> Printf.sprintf "%06o" mode
190
Added:
in
191
Added:
let hash = function
192
Added:
| None -> "00000000"
193
Added:
| Some hash -> Resolvers.short_hash hash
194
Added:
in
195
Added:
let file (file : Resolvers.Diff.file) =
196
Added:
let file_body =
197
Added:
if file.binary then
198
Added:
HTML.[ p [ class_ "binary-diff" ] [ txt "Binary files differ" ] ]
199
Added:
else List.concat_map hunk file.hunks
200
Added:
in
201
Added:
HTML.(
202
Added:
section
203
Added:
[ class_ "diff-file" ]
204
Added:
([
205
Added:
h4 [ class_ "diff-file-header" ] [ txt "%s" file.path ];
206
Added:
div
207
Added:
[ class_ "diff-meta" ]
208
Added:
[
209
Added:
txt "index %s..%s %s..%s" (hash file.old_hash)
210
Added:
(hash file.new_hash) (mode file.old_mode) (mode file.new_mode);
211
Added:
];
212
Added:
]
213
Added:
@ file_body))
214
Added:
in
215
Added:
let diff_content =
216
Added:
match diff with
217
Added:
| [] -> HTML.[ p [] [ txt "No file changes in this commit." ] ]
218
Added:
| files -> List.map file files
219
Added:
in
220
Added:
respond
221
Added:
@@ Layout.render ~page_title:(page_title repo)
222
Added:
{
223
Added:
repo = Some repo;
224
Added:
title =
225
Added:
Printf.sprintf "%s : %s" repo @@ Resolvers.short_hash commit.hash;
226
Added:
subtitle = Resolvers.repo_description repo;
227
Added:
active = Summary;
228
Added:
content =
229
Added:
HTML.(
230
Added:
[ h3 [] [ txt "%s" commit_summary_text ] ]
231
Added:
@ (if commit_body_text = "" then []
232
Added:
else
233
Added:
[ p [ class_ "commit-body" ] [ txt "%s" commit_body_text ] ])
234
Added:
@ [
235
Added:
dl
236
Added:
[ class_ "commit-meta" ]
237
Added:
[
238
Added:
dt [] [ txt "Commit" ];
239
Added:
dd [] [ txt "%s" commit.hash ];
240
Added:
dt [] [ txt "Author" ];
241
Added:
dd []
242
Added:
[ txt "%s <%s>" commit.author.name commit.author.email ];
243
Added:
];
244
Added:
]
245
Added:
@ diff_content);
246
Added:
}
247
Added:
248
Added:
let branches repo branches =
249
Added:
let content =
250
Added:
match branches with
251
Added:
| [] -> HTML.[ p [] [ txt "No branches for repo %s" repo ] ]
252
Added:
| branches -> HTML.[ ul [] @@ List.map (li_of_branch repo) branches ]
253
Added:
in
254
Added:
respond
255
Added:
@@ Layout.render ~page_title:(page_title repo)
256
Added:
{
257
Added:
repo = Some repo;
258
Added:
title = repo;
259
Added:
subtitle = Resolvers.repo_description repo;
260
Added:
active = Branches;
261
Added:
content;
262
Added:
}
263
Added:
264
Added:
let tags repo tags =
265
Added:
let content =
266
Added:
match tags with
267
Added:
| [] -> HTML.[ p [] [ txt "No tags for repo %s" repo ] ]
268
Added:
| tags -> HTML.[ ul [] @@ List.map (li_of_tag repo) tags ]
269
Added:
in
270
Added:
respond
271
Added:
@@ Layout.render ~page_title:(page_title repo)
272
Added:
{
273
Added:
repo = Some repo;
274
Added:
title = repo;
275
Added:
subtitle = Resolvers.repo_description repo;
276
Added:
active = Tags;
277
Added:
content;
278
Added:
}
lib/views/root.ml
@@ -0,0 +1,32 @@
1
Added:
(* -*- mode: tuareg; -*- *)
2
Added:
3
Added:
open Dream_html
4
Added:
open Config
5
Added:
6
Added:
let render () =
7
Added:
try
8
Added:
let all_repositories =
9
Added:
let repos =
10
Added:
Sys.readdir config.git_project_root
11
Added:
|> Array.to_list
12
Added:
|> List.filter (fun name ->
13
Added:
(not (name.[0] = '.'))
14
Added:
&& Resolvers.is_repository
15
Added:
(Filename.concat config.git_project_root name))
16
Added:
|> List.sort String.compare
17
Added:
in
18
Added:
let li_of_repo repo =
19
Added:
HTML.li [] [ Routes.link_to (Routes.Repo repo) (txt "%s" repo) ]
20
Added:
in
21
Added:
HTML.(div [ id "repositories" ] [ ul [] @@ List.map li_of_repo repos ])
22
Added:
in
23
Added:
respond
24
Added:
@@ Layout.render
25
Added:
{
26
Added:
title = "Ogit";
27
Added:
repo = None;
28
Added:
subtitle = "Repositories for " ^ config.user;
29
Added:
active = Summary;
30
Added:
content = [ all_repositories ];
31
Added:
}
32
Added:
with Sys_error message -> Layout.error_page message