My aggregated monorepo of OCaml code, automaintained
Merge branch 'main' of https://tangled.org/anil.recoil.org/monopam-myspace
+5075
-79
+44
arod/arod.opam
+44
arod/arod.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Webserver for Bushel content"
4
+
description: """
5
+
Arod is a tiny_httpd-based webserver that serves Bushel content
6
+
(notes, papers, projects, ideas, videos) as a website. It uses
7
+
TOML configuration for easy deployment and includes support for
8
+
responsive images, syntax highlighting, and feeds."""
9
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
10
+
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
11
+
license: "ISC"
12
+
depends: [
13
+
"dune" {>= "3.18"}
14
+
"ocaml" {>= "5.2"}
15
+
"bushel" {>= "0.1"}
16
+
"tiny_httpd" {>= "0.17"}
17
+
"htmlit" {>= "0.1"}
18
+
"cmarkit" {>= "0.3"}
19
+
"uri" {>= "4.4"}
20
+
"ptime" {>= "1.2"}
21
+
"fmt" {>= "0.9"}
22
+
"tomlt" {>= "0.1"}
23
+
"eio" {>= "1.2"}
24
+
"eio_main"
25
+
"cmdliner"
26
+
"logs"
27
+
"unix"
28
+
"odoc" {with-doc}
29
+
]
30
+
build: [
31
+
["dune" "subst"] {dev}
32
+
[
33
+
"dune"
34
+
"build"
35
+
"-p"
36
+
name
37
+
"-j"
38
+
jobs
39
+
"@install"
40
+
"@runtest" {with-test}
41
+
"@doc" {with-doc}
42
+
]
43
+
]
44
+
x-maintenance-intent: ["(latest)"]
+21
arod/bin/dune
+21
arod/bin/dune
+493
arod/bin/main.ml
+493
arod/bin/main.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Arod webserver - a tiny_httpd based server for Bushel content *)
7
+
8
+
open Tiny_httpd
9
+
open Arod.Entries
10
+
11
+
(** {1 Logging} *)
12
+
13
+
let src = Logs.Src.create "arod" ~doc:"Arod webserver"
14
+
module Log = (val Logs.src_log src : Logs.LOG)
15
+
16
+
(** {1 Query Helpers} *)
17
+
18
+
let get_query_params req =
19
+
Request.query req
20
+
21
+
let get_query_param req name =
22
+
match List.assoc_opt name (get_query_params req) with
23
+
| Some v -> Some v
24
+
| None -> None
25
+
26
+
let get_query_params_multi req name =
27
+
List.filter_map (fun (k, v) ->
28
+
if k = name then Some v else None
29
+
) (get_query_params req)
30
+
31
+
let get_query_info req =
32
+
let tags = get_query_params_multi req "t" |> List.map Arod.Model.Tags.of_string in
33
+
let min = match get_query_param req "min" with None -> 25 | Some v -> int_of_string v in
34
+
let show_all = match get_query_param req "all" with None -> false | Some _ -> true in
35
+
{tags; min; show_all}
36
+
37
+
(** {1 Response Helpers} *)
38
+
39
+
let html_response content =
40
+
Response.make_string ~headers:[("content-type", "text/html; charset=utf-8")] (Ok content)
41
+
42
+
let not_found_response = Response.fail ~code:404 "Not Found"
43
+
44
+
let plain_response content =
45
+
Response.make_string ~headers:[("content-type", "text/plain")] (Ok content)
46
+
47
+
let atom_response content =
48
+
Response.make_string ~headers:[("content-type", "application/atom+xml; charset=utf-8")] (Ok content)
49
+
50
+
let xml_response content =
51
+
Response.make_string ~headers:[("content-type", "application/xml")] (Ok content)
52
+
53
+
let json_response content =
54
+
Response.make_string ~headers:[("content-type", "application/json; charset=utf-8")] (Ok content)
55
+
56
+
(** {1 File Serving} *)
57
+
58
+
let serve_file ~dir path =
59
+
let clean_path =
60
+
let parts = String.split_on_char '/' path in
61
+
let safe_parts = List.filter (fun s -> s <> ".." && s <> ".") parts in
62
+
String.concat "/" safe_parts
63
+
in
64
+
let file_path = Filename.concat dir clean_path in
65
+
Log.info (fun m -> m "Serving file: %s (dir=%s, path=%s)" file_path dir path);
66
+
try
67
+
if Sys.file_exists file_path && not (Sys.is_directory file_path) then begin
68
+
let ic = open_in_bin file_path in
69
+
let len = in_channel_length ic in
70
+
let content = really_input_string ic len in
71
+
close_in ic;
72
+
let mime_type =
73
+
if String.ends_with ~suffix:".pdf" file_path then "application/pdf"
74
+
else if String.ends_with ~suffix:".html" file_path then "text/html"
75
+
else if String.ends_with ~suffix:".css" file_path then "text/css"
76
+
else if String.ends_with ~suffix:".js" file_path then "text/javascript"
77
+
else if String.ends_with ~suffix:".svg" file_path then "image/svg+xml"
78
+
else if String.ends_with ~suffix:".png" file_path then "image/png"
79
+
else if String.ends_with ~suffix:".jpg" file_path || String.ends_with ~suffix:".jpeg" file_path then "image/jpeg"
80
+
else if String.ends_with ~suffix:".webp" file_path then "image/webp"
81
+
else if String.ends_with ~suffix:".xml" file_path then "application/xml"
82
+
else if String.ends_with ~suffix:".wasm" file_path then "application/wasm"
83
+
else if String.ends_with ~suffix:".ico" file_path then "image/x-icon"
84
+
else if String.ends_with ~suffix:".woff" file_path then "font/woff"
85
+
else if String.ends_with ~suffix:".woff2" file_path then "font/woff2"
86
+
else if String.ends_with ~suffix:".bib" file_path then "application/x-bibtex"
87
+
else "application/octet-stream"
88
+
in
89
+
Log.info (fun m -> m "Served %s (%d bytes, %s)" file_path len mime_type);
90
+
Response.make_string ~headers:[("content-type", mime_type)] (Ok content)
91
+
end else begin
92
+
Log.warn (fun m -> m "File not found: %s" file_path);
93
+
not_found_response
94
+
end
95
+
with e ->
96
+
Log.err (fun m -> m "Failed to serve file %s: %s" file_path (Printexc.to_string e));
97
+
not_found_response
98
+
99
+
(** {1 HTML Output Helper} *)
100
+
101
+
let to_page el = Htmlit.El.to_string ~doctype:true el
102
+
103
+
(** {1 Entry Handlers} *)
104
+
105
+
let entries_handler ~extra_tags ~types req =
106
+
let q = get_query_info req in
107
+
let all_tags = Arod.Model.concat_tags q.tags (List.map Arod.Model.Tags.of_string extra_tags) in
108
+
html_response (to_page (view_entries ~show_all:q.show_all ~tags:all_tags ~min:q.min ~types (entries_of_req ~extra_tags ~types q)))
109
+
110
+
let feed_handler ~types req =
111
+
let q = get_query_info req in
112
+
html_response (to_page (view_news ~show_all:q.show_all ~tags:q.tags ~min:q.min ~types (feed_of_req ~types q)))
113
+
114
+
let feed_handler_with_tags ~extra_tags ~types req =
115
+
let q = get_query_info req in
116
+
let tags = Arod.Model.concat_tags q.tags (List.map Arod.Model.Tags.of_string extra_tags) in
117
+
let q = { q with tags } in
118
+
html_response (to_page (view_news ~show_all:q.show_all ~tags:q.tags ~min:q.min ~types (feed_of_req ~types q)))
119
+
120
+
let ideas_handler _req =
121
+
html_response (to_page (Arod.Ideas.view_ideas_by_project ()))
122
+
123
+
let projects_handler _req =
124
+
html_response (to_page (Arod.Projects.view_projects_timeline ()))
125
+
126
+
let index_handler req =
127
+
let q = get_query_info req in
128
+
match Arod.Model.lookup "index" with
129
+
| None -> not_found_response
130
+
| Some ent -> html_response (to_page (view_one q ent))
131
+
132
+
(** {1 Content Handlers} *)
133
+
134
+
let paper_handler cfg slug _req =
135
+
let q = get_query_info _req in
136
+
match slug with
137
+
| slug when String.ends_with ~suffix:".pdf" slug ->
138
+
serve_file ~dir:cfg.Arod.Config.paths.static_dir ("papers/" ^ slug)
139
+
| slug when String.ends_with ~suffix:".bib" slug ->
140
+
let paper_slug = Filename.chop_extension slug in
141
+
(match Arod.Model.lookup paper_slug with
142
+
| Some (`Paper p) -> plain_response (Arod.Model.Paper.bib p)
143
+
| _ -> not_found_response)
144
+
| _ ->
145
+
match Arod.Model.lookup slug with
146
+
| None -> not_found_response
147
+
| Some ent -> html_response (to_page (view_one q ent))
148
+
149
+
let content_handler slug req =
150
+
let q = get_query_info req in
151
+
match Arod.Model.lookup slug with
152
+
| None -> not_found_response
153
+
| Some ent -> html_response (to_page (view_one q ent))
154
+
155
+
let news_redirect_handler slug _req =
156
+
Response.make_raw ~code:301
157
+
~headers:[("Location", "/notes/" ^ slug)]
158
+
"Moved Permanently"
159
+
160
+
(** {1 Feed Handlers} *)
161
+
162
+
let atom_uri req =
163
+
let path = Request.path req in
164
+
let query = Request.query req in
165
+
if query = [] then path
166
+
else
167
+
let query_string = String.concat "&" (List.map (fun (k,v) -> k ^ "=" ^ v) query) in
168
+
path ^ "?" ^ query_string
169
+
170
+
let atom_handler cfg req =
171
+
try
172
+
let q = get_query_info req in
173
+
let feed = feed_of_req ~types:[] q in
174
+
let ur = atom_uri req in
175
+
let s = Arod.Feed.feed_string cfg ur feed in
176
+
atom_response s
177
+
with exn -> Printexc.print_backtrace stdout; raise exn
178
+
179
+
let perma_atom_handler cfg _req =
180
+
try
181
+
let feed = perma_feed_of_req () in
182
+
let s = Arod.Feed.feed_string cfg "/perma.xml" feed in
183
+
atom_response s
184
+
with exn -> Printexc.print_backtrace stdout; raise exn
185
+
186
+
let jsonfeed_handler cfg req =
187
+
try
188
+
let q = get_query_info req in
189
+
let feed = feed_of_req ~types:[] q in
190
+
let s = Arod.Jsonfeed.feed_string cfg "/feed.json" feed in
191
+
json_response s
192
+
with exn -> Printexc.print_backtrace stdout; raise exn
193
+
194
+
let perma_jsonfeed_handler cfg _req =
195
+
try
196
+
let feed = perma_feed_of_req () in
197
+
let s = Arod.Jsonfeed.feed_string cfg "/perma.json" feed in
198
+
json_response s
199
+
with exn -> Printexc.print_backtrace stdout; raise exn
200
+
201
+
(** {1 Sitemap Handler} *)
202
+
203
+
let sitemap_handler cfg _req =
204
+
let all_feed = Arod.Model.all_entries ()
205
+
|> List.sort Arod.Model.Entry.compare
206
+
|> List.rev in
207
+
let url_of_entry ent =
208
+
let lastmod = Arod.Model.Entry.date ent in
209
+
let loc = cfg.Arod.Config.site.base_url ^ Arod.Model.Entry.site_url ent in
210
+
Sitemap.v ~lastmod loc
211
+
in
212
+
let sitemap = List.map url_of_entry all_feed |> Sitemap.output in
213
+
xml_response sitemap
214
+
215
+
(** {1 Bushel Graph Handlers} *)
216
+
217
+
let bushel_graph_data_handler _req =
218
+
let entries = Arod.Model.get_entries () in
219
+
match Bushel.Link_graph.get_graph () with
220
+
| None ->
221
+
json_response "{\"error\": \"Link graph not initialized\"}"
222
+
| Some graph ->
223
+
let json = Bushel.Link_graph.to_json graph entries in
224
+
json_response (Ezjsonm.value_to_string json)
225
+
226
+
let bushel_graph_handler _req =
227
+
html_response (to_page (Arod.Page.bushel_graph ()))
228
+
229
+
(** {1 Pagination API Handler} *)
230
+
231
+
let pagination_api_handler req =
232
+
try
233
+
let collection_type = match get_query_param req "collection" with
234
+
| Some t -> t
235
+
| None -> failwith "Missing collection parameter"
236
+
in
237
+
let offset = match get_query_param req "offset" with
238
+
| Some o -> int_of_string o
239
+
| None -> 0
240
+
in
241
+
let limit = match get_query_param req "limit" with
242
+
| Some l -> int_of_string l
243
+
| None -> 25
244
+
in
245
+
let type_strings = get_query_params_multi req "type" in
246
+
let types = List.filter_map entry_type_of_string type_strings in
247
+
let q = get_query_info req in
248
+
249
+
let html = match collection_type with
250
+
| "feed" ->
251
+
let all_feed = feed_of_req ~types q in
252
+
let total = List.length all_feed in
253
+
let feed_slice =
254
+
all_feed
255
+
|> (fun l -> List.filteri (fun i _ -> i >= offset) l)
256
+
|> (fun l -> List.filteri (fun i _ -> i < limit) l)
257
+
in
258
+
let has_more = (offset + List.length feed_slice) < total in
259
+
(render_feeds_html feed_slice, total, has_more)
260
+
| "entries" ->
261
+
let all_ents = entries_of_req ~extra_tags:[] ~types q in
262
+
let total = List.length all_ents in
263
+
let ents_slice =
264
+
all_ents
265
+
|> (fun l -> List.filteri (fun i _ -> i >= offset) l)
266
+
|> (fun l -> List.filteri (fun i _ -> i < limit) l)
267
+
in
268
+
let has_more = (offset + List.length ents_slice) < total in
269
+
(render_entries_html ents_slice, total, has_more)
270
+
| _ -> failwith "Invalid collection type"
271
+
in
272
+
let rendered_html, total, has_more = html in
273
+
274
+
let json = `O [
275
+
("html", `String rendered_html);
276
+
("total", `Float (float_of_int total));
277
+
("offset", `Float (float_of_int offset));
278
+
("limit", `Float (float_of_int limit));
279
+
("has_more", `Bool has_more);
280
+
] in
281
+
json_response (Ezjsonm.to_string json)
282
+
with e ->
283
+
let error_json = `O [("error", `String (Printexc.to_string e))] in
284
+
json_response (Ezjsonm.to_string error_json)
285
+
286
+
(** {1 Well-Known Handler} *)
287
+
288
+
let well_known_handler cfg key _req =
289
+
match List.find_opt (fun e -> e.Arod.Config.key = key) cfg.Arod.Config.well_known with
290
+
| Some entry -> plain_response entry.value
291
+
| None -> not_found_response
292
+
293
+
(** {1 Server Setup} *)
294
+
295
+
let setup_routes server cfg =
296
+
let open Route in
297
+
298
+
(* Index routes *)
299
+
Server.add_route_handler ~meth:`GET server (exact_path "/" return) index_handler;
300
+
Server.add_route_handler ~meth:`GET server (exact_path "/about" return) index_handler;
301
+
Server.add_route_handler ~meth:`GET server (exact_path "/about/" return) index_handler;
302
+
303
+
(* Atom feeds *)
304
+
Server.add_route_handler ~meth:`GET server (exact_path "/wiki.xml" return) (atom_handler cfg);
305
+
Server.add_route_handler ~meth:`GET server (exact_path "/news.xml" return) (atom_handler cfg);
306
+
Server.add_route_handler ~meth:`GET server (exact_path "/feeds/atom.xml" return) (atom_handler cfg);
307
+
Server.add_route_handler ~meth:`GET server (exact_path "/notes/atom.xml" return) (atom_handler cfg);
308
+
Server.add_route_handler ~meth:`GET server (exact_path "/perma.xml" return) (perma_atom_handler cfg);
309
+
310
+
(* JSON feeds *)
311
+
Server.add_route_handler ~meth:`GET server (exact_path "/feed.json" return) (jsonfeed_handler cfg);
312
+
Server.add_route_handler ~meth:`GET server (exact_path "/feeds/feed.json" return) (jsonfeed_handler cfg);
313
+
Server.add_route_handler ~meth:`GET server (exact_path "/notes/feed.json" return) (jsonfeed_handler cfg);
314
+
Server.add_route_handler ~meth:`GET server (exact_path "/perma.json" return) (perma_jsonfeed_handler cfg);
315
+
316
+
(* Sitemap *)
317
+
Server.add_route_handler ~meth:`GET server (exact_path "/sitemap.xml" return) (sitemap_handler cfg);
318
+
319
+
(* Papers *)
320
+
Server.add_route_handler ~meth:`GET server (exact "papers" @/ string @/ return) (paper_handler cfg);
321
+
Server.add_route_handler ~meth:`GET server (exact "papers" @/ string @/ exact "" @/ return) (paper_handler cfg);
322
+
Server.add_route_handler ~meth:`GET server (exact_path "/papers" return) (entries_handler ~extra_tags:[] ~types:[`Paper]);
323
+
Server.add_route_handler ~meth:`GET server (exact_path "/papers/" return) (entries_handler ~extra_tags:[] ~types:[`Paper]);
324
+
325
+
(* Ideas *)
326
+
Server.add_route_handler ~meth:`GET server (exact "ideas" @/ string @/ return) content_handler;
327
+
Server.add_route_handler ~meth:`GET server (exact "ideas" @/ string @/ exact "" @/ return) content_handler;
328
+
Server.add_route_handler ~meth:`GET server (exact_path "/ideas" return) ideas_handler;
329
+
Server.add_route_handler ~meth:`GET server (exact_path "/ideas/" return) ideas_handler;
330
+
331
+
(* Notes *)
332
+
Server.add_route_handler ~meth:`GET server (exact "notes" @/ string @/ return) content_handler;
333
+
Server.add_route_handler ~meth:`GET server (exact "notes" @/ string @/ exact "" @/ return) content_handler;
334
+
Server.add_route_handler ~meth:`GET server (exact_path "/notes" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Note]);
335
+
Server.add_route_handler ~meth:`GET server (exact_path "/notes/" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Note]);
336
+
337
+
(* Videos/Talks *)
338
+
Server.add_route_handler ~meth:`GET server (exact "videos" @/ string @/ return) content_handler;
339
+
Server.add_route_handler ~meth:`GET server (exact "videos" @/ string @/ exact "" @/ return) content_handler;
340
+
Server.add_route_handler ~meth:`GET server (exact_path "/talks" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]);
341
+
Server.add_route_handler ~meth:`GET server (exact_path "/talks/" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]);
342
+
Server.add_route_handler ~meth:`GET server (exact_path "/videos" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]);
343
+
Server.add_route_handler ~meth:`GET server (exact_path "/videos/" return) (feed_handler_with_tags ~extra_tags:[] ~types:[`Video]);
344
+
345
+
(* Projects *)
346
+
Server.add_route_handler ~meth:`GET server (exact "projects" @/ string @/ return) content_handler;
347
+
Server.add_route_handler ~meth:`GET server (exact "projects" @/ string @/ exact "" @/ return) content_handler;
348
+
Server.add_route_handler ~meth:`GET server (exact_path "/projects" return) projects_handler;
349
+
Server.add_route_handler ~meth:`GET server (exact_path "/projects/" return) projects_handler;
350
+
351
+
(* Legacy news redirect *)
352
+
Server.add_route_handler ~meth:`GET server (exact "news" @/ string @/ return) news_redirect_handler;
353
+
354
+
(* Wiki/News legacy *)
355
+
Server.add_route_handler ~meth:`GET server (exact_path "/wiki" return) (entries_handler ~extra_tags:[] ~types:[`Paper; `Note; `Video; `Idea; `Project]);
356
+
Server.add_route_handler ~meth:`GET server (exact_path "/news" return) (feed_handler ~types:[`Note]);
357
+
358
+
(* Pagination API *)
359
+
Server.add_route_handler ~meth:`GET server (exact_path "/api/entries" return) pagination_api_handler;
360
+
361
+
(* Bushel link graph *)
362
+
Server.add_route_handler ~meth:`GET server (exact_path "/bushel" return) bushel_graph_handler;
363
+
Server.add_route_handler ~meth:`GET server (exact_path "/bushel/" return) bushel_graph_handler;
364
+
Server.add_route_handler ~meth:`GET server (exact_path "/bushel/graph.json" return) bushel_graph_data_handler;
365
+
366
+
(* Well-known endpoints *)
367
+
Server.add_route_handler ~meth:`GET server (exact ".well-known" @/ string @/ return) (well_known_handler cfg);
368
+
369
+
(* Robots.txt *)
370
+
Server.add_route_handler ~meth:`GET server (exact_path "/robots.txt" return)
371
+
(fun _req -> serve_file ~dir:cfg.paths.assets_dir "robots.txt");
372
+
373
+
(* Static files *)
374
+
Server.add_route_handler ~meth:`GET server (exact "assets" @/ rest_of_path)
375
+
(fun path _req -> serve_file ~dir:cfg.paths.assets_dir path);
376
+
Server.add_route_handler ~meth:`GET server (exact "images" @/ rest_of_path)
377
+
(fun path _req -> serve_file ~dir:cfg.paths.images_dir path);
378
+
Server.add_route_handler ~meth:`GET server (exact "static" @/ rest_of_path)
379
+
(fun path _req -> serve_file ~dir:cfg.paths.static_dir path);
380
+
381
+
()
382
+
383
+
(** {1 CLI} *)
384
+
385
+
open Cmdliner
386
+
387
+
let setup_logging style_renderer level =
388
+
Fmt_tty.setup_std_outputs ?style_renderer ();
389
+
Logs.set_level level;
390
+
Logs.set_reporter (Logs_fmt.reporter ())
391
+
392
+
let logging_t =
393
+
let open Cmdliner in
394
+
Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ())
395
+
396
+
let config_file =
397
+
let doc = "Path to config file (default: ~/.config/arod/config.toml)." in
398
+
Arg.(value & opt (some file) None & info ["c"; "config"] ~docv:"FILE" ~doc)
399
+
400
+
let serve_cmd =
401
+
let run () config_file =
402
+
let cfg = Arod.Config.load_or_default ?path:config_file () in
403
+
Log.info (fun m -> m "Starting Arod server...");
404
+
Log.info (fun m -> m "Config:@.%a" Arod.Config.pp cfg);
405
+
406
+
Eio_main.run @@ fun env ->
407
+
let fs = Eio.Stdenv.fs env in
408
+
409
+
Log.info (fun m -> m "Loading entries from %s" cfg.paths.data_dir);
410
+
let _entries = Arod.Model.init ~cfg fs in
411
+
Log.info (fun m -> m "Loaded %d notes, %d papers, %d projects, %d ideas, %d videos, %d images"
412
+
(List.length (Arod.Model.notes ()))
413
+
(List.length (Arod.Model.papers ()))
414
+
(List.length (Arod.Model.projects ()))
415
+
(List.length (Arod.Model.ideas ()))
416
+
(List.length (Arod.Model.videos ()))
417
+
(List.length (Arod.Model.images ())));
418
+
419
+
let server = Tiny_httpd.create ~addr:cfg.server.host ~port:cfg.server.port () in
420
+
421
+
Tiny_httpd.add_middleware server ~stage:(`Stage 1) (fun h req ->
422
+
let start_time = Unix.gettimeofday () in
423
+
let resp = h req in
424
+
let elapsed = Unix.gettimeofday () -. start_time in
425
+
Log.info (fun m -> m "%s %s - %.3fs"
426
+
(Meth.to_string (Request.meth req))
427
+
(Request.path req)
428
+
elapsed);
429
+
resp
430
+
);
431
+
432
+
setup_routes server cfg;
433
+
434
+
Log.app (fun m -> m "Listening on http://%s:%d" cfg.server.host cfg.server.port);
435
+
match Tiny_httpd.run server with
436
+
| Ok () -> 0
437
+
| Error e ->
438
+
Log.err (fun m -> m "Server error: %s" (Printexc.to_string e));
439
+
1
440
+
in
441
+
let doc = "Start the Arod webserver." in
442
+
let info = Cmd.info "serve" ~doc in
443
+
Cmd.v info Term.(const run $ logging_t $ config_file)
444
+
445
+
let init_cmd =
446
+
let run () =
447
+
let path = Arod.Config.config_file () in
448
+
let dir = Filename.dirname path in
449
+
if not (Sys.file_exists dir) then
450
+
Unix.mkdir dir 0o755;
451
+
if Sys.file_exists path then begin
452
+
Printf.eprintf "Config file already exists: %s\n" path;
453
+
1
454
+
end else begin
455
+
let oc = open_out path in
456
+
output_string oc Arod.Config.sample_config;
457
+
close_out oc;
458
+
Printf.printf "Created config file: %s\n" path;
459
+
0
460
+
end
461
+
in
462
+
let doc = "Initialize a default configuration file." in
463
+
let info = Cmd.info "init" ~doc in
464
+
Cmd.v info Term.(const run $ const ())
465
+
466
+
let config_cmd =
467
+
let run () config_file =
468
+
let cfg = Arod.Config.load_or_default ?path:config_file () in
469
+
Fmt.pr "%a\n" Arod.Config.pp cfg;
470
+
0
471
+
in
472
+
let doc = "Show current configuration." in
473
+
let info = Cmd.info "config" ~doc in
474
+
Cmd.v info Term.(const run $ logging_t $ config_file)
475
+
476
+
let main_cmd =
477
+
let doc = "Arod - a webserver for Bushel content" in
478
+
let man = [
479
+
`S Manpage.s_description;
480
+
`P "Arod is a tiny_httpd-based webserver that serves Bushel content \
481
+
(notes, papers, projects, ideas, videos) as a website.";
482
+
`S "CONFIGURATION";
483
+
`P "Configuration is read from ~/.config/arod/config.toml";
484
+
`P "Run $(b,arod init) to create a default config file.";
485
+
] in
486
+
let info = Cmd.info "arod" ~version:"0.1.0" ~doc ~man in
487
+
Cmd.group info [serve_cmd; init_cmd; config_cmd]
488
+
489
+
let () =
490
+
match Cmd.eval_value main_cmd with
491
+
| Ok (`Ok exit_code) -> exit exit_code
492
+
| Ok `Help | Ok `Version -> exit 0
493
+
| Error _ -> exit 1
+34
arod/dune-project
+34
arod/dune-project
···
1
+
(lang dune 3.18)
2
+
(name arod)
3
+
4
+
(generate_opam_files true)
5
+
(maintenance_intent "(latest)")
6
+
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy <anil@recoil.org>")
9
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
10
+
11
+
(package
12
+
(name arod)
13
+
(synopsis "Webserver for Bushel content")
14
+
(description
15
+
"Arod is a tiny_httpd-based webserver that serves Bushel content
16
+
(notes, papers, projects, ideas, videos) as a website. It uses
17
+
TOML configuration for easy deployment and includes support for
18
+
responsive images, syntax highlighting, and feeds.")
19
+
(depends
20
+
(ocaml (>= 5.2))
21
+
(bushel (>= 0.1))
22
+
(tiny_httpd (>= 0.17))
23
+
(htmlit (>= 0.1))
24
+
(cmarkit (>= 0.3))
25
+
(uri (>= 4.4))
26
+
(ptime (>= 1.2))
27
+
(fmt (>= 0.9))
28
+
(tomlt (>= 0.1))
29
+
(eio (>= 1.2))
30
+
eio_main
31
+
cmdliner
32
+
logs
33
+
unix
34
+
(odoc :with-doc)))
+62
arod/lib/arod.ml
+62
arod/lib/arod.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Arod - Webserver for Bushel content
7
+
8
+
Arod is a tiny_httpd-based webserver that serves Bushel content
9
+
(notes, papers, projects, ideas, videos) as a website.
10
+
11
+
{1 Core Modules}
12
+
13
+
- {!Config} - TOML configuration
14
+
- {!Model} - Bushel bridge layer
15
+
- {!View} - Core rendering utilities
16
+
- {!Page} - Page layout
17
+
- {!Entries} - Entry type filtering and rendering *)
18
+
19
+
module Config = Arod_config
20
+
(** TOML-based configuration for the webserver. *)
21
+
22
+
module Model = Arod_model
23
+
(** Model layer bridging Bushel to the webserver. *)
24
+
25
+
module View = Arod_view
26
+
(** Core view rendering utilities. *)
27
+
28
+
module Page = Arod_page
29
+
(** Page layout. *)
30
+
31
+
module Footer = Arod_footer
32
+
(** Standard footer. *)
33
+
34
+
module Notes = Arod_notes
35
+
(** Note rendering. *)
36
+
37
+
module Papers = Arod_papers
38
+
(** Paper rendering. *)
39
+
40
+
module Ideas = Arod_ideas
41
+
(** Idea rendering. *)
42
+
43
+
module Projects = Arod_projects
44
+
(** Project rendering. *)
45
+
46
+
module Videos = Arod_videos
47
+
(** Video rendering. *)
48
+
49
+
module Entries = Arod_entries
50
+
(** Entry type filtering and rendering. *)
51
+
52
+
module Feed = Arod_feed
53
+
(** Atom feed generation. *)
54
+
55
+
module Jsonfeed = Arod_jsonfeed
56
+
(** JSON feed generation. *)
57
+
58
+
module Richdata = Arod_richdata
59
+
(** JSON-LD rich data for SEO. *)
60
+
61
+
module Html = Arod_html
62
+
(** Legacy HTML generation (for compatibility). *)
+244
arod/lib/arod_config.ml
+244
arod/lib/arod_config.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Configuration for the Arod webserver *)
7
+
8
+
type server = {
9
+
host : string;
10
+
port : int;
11
+
}
12
+
13
+
type paths = {
14
+
data_dir : string;
15
+
assets_dir : string;
16
+
images_dir : string;
17
+
static_dir : string;
18
+
}
19
+
20
+
type site = {
21
+
base_url : string;
22
+
name : string;
23
+
description : string;
24
+
author_handle : string;
25
+
author_name : string;
26
+
author_email : string option;
27
+
author_orcid : string option;
28
+
}
29
+
30
+
type feeds = {
31
+
title : string;
32
+
subtitle : string option;
33
+
}
34
+
35
+
type well_known_entry = {
36
+
key : string;
37
+
value : string;
38
+
}
39
+
40
+
type t = {
41
+
server : server;
42
+
paths : paths;
43
+
site : site;
44
+
feeds : feeds;
45
+
well_known : well_known_entry list;
46
+
}
47
+
48
+
(** Path expansion helper - expands ~ to home directory *)
49
+
let expand_path p =
50
+
if String.length p > 0 && p.[0] = '~' then
51
+
let home = Sys.getenv_opt "HOME" |> Option.value ~default:"/tmp" in
52
+
home ^ String.sub p 1 (String.length p - 1)
53
+
else p
54
+
55
+
(** Default configuration *)
56
+
let default =
57
+
let home = Sys.getenv_opt "HOME" |> Option.value ~default:"/tmp" in
58
+
{
59
+
server = {
60
+
host = "0.0.0.0";
61
+
port = 8080;
62
+
};
63
+
paths = {
64
+
data_dir = Filename.concat home "bushel";
65
+
assets_dir = "./assets";
66
+
images_dir = Filename.concat home "bushel/images/web";
67
+
static_dir = "./static";
68
+
};
69
+
site = {
70
+
base_url = "http://localhost:8080";
71
+
name = "My Site";
72
+
description = "A personal website powered by Bushel";
73
+
author_handle = "me";
74
+
author_name = "Site Author";
75
+
author_email = None;
76
+
author_orcid = None;
77
+
};
78
+
feeds = {
79
+
title = "Site Feed";
80
+
subtitle = None;
81
+
};
82
+
well_known = [];
83
+
}
84
+
85
+
(** {1 TOML Codecs} *)
86
+
87
+
(** String codec with path expansion *)
88
+
let path_string =
89
+
Tomlt.(map string ~dec:expand_path)
90
+
91
+
let server_codec =
92
+
Tomlt.(Table.(
93
+
obj (fun host port -> { host; port })
94
+
|> mem "host" string ~dec_absent:default.server.host ~enc:(fun s -> s.host)
95
+
|> mem "port" int ~dec_absent:default.server.port ~enc:(fun s -> s.port)
96
+
|> finish
97
+
))
98
+
99
+
let paths_codec =
100
+
Tomlt.(Table.(
101
+
obj (fun data_dir assets_dir images_dir static_dir ->
102
+
{ data_dir; assets_dir; images_dir; static_dir })
103
+
|> mem "data_dir" path_string ~dec_absent:default.paths.data_dir ~enc:(fun p -> p.data_dir)
104
+
|> mem "assets_dir" path_string ~dec_absent:default.paths.assets_dir ~enc:(fun p -> p.assets_dir)
105
+
|> mem "images_dir" path_string ~dec_absent:default.paths.images_dir ~enc:(fun p -> p.images_dir)
106
+
|> mem "static_dir" path_string ~dec_absent:default.paths.static_dir ~enc:(fun p -> p.static_dir)
107
+
|> finish
108
+
))
109
+
110
+
let site_codec =
111
+
Tomlt.(Table.(
112
+
obj (fun base_url name description author_handle author_name author_email author_orcid ->
113
+
{ base_url; name; description; author_handle; author_name; author_email; author_orcid })
114
+
|> mem "base_url" string ~dec_absent:default.site.base_url ~enc:(fun s -> s.base_url)
115
+
|> mem "name" string ~dec_absent:default.site.name ~enc:(fun s -> s.name)
116
+
|> mem "description" string ~dec_absent:default.site.description ~enc:(fun s -> s.description)
117
+
|> mem "author_handle" string ~dec_absent:default.site.author_handle ~enc:(fun s -> s.author_handle)
118
+
|> mem "author_name" string ~dec_absent:default.site.author_name ~enc:(fun s -> s.author_name)
119
+
|> opt_mem "author_email" string ~enc:(fun s -> s.author_email)
120
+
|> opt_mem "author_orcid" string ~enc:(fun s -> s.author_orcid)
121
+
|> finish
122
+
))
123
+
124
+
let feeds_codec =
125
+
Tomlt.(Table.(
126
+
obj (fun title subtitle -> { title; subtitle })
127
+
|> mem "title" string ~dec_absent:default.feeds.title ~enc:(fun f -> f.title)
128
+
|> opt_mem "subtitle" string ~enc:(fun f -> f.subtitle)
129
+
|> finish
130
+
))
131
+
132
+
let well_known_entry_codec =
133
+
Tomlt.(Table.(
134
+
obj (fun key value -> { key; value })
135
+
|> mem "key" string ~enc:(fun e -> e.key)
136
+
|> mem "value" string ~enc:(fun e -> e.value)
137
+
|> finish
138
+
))
139
+
140
+
(** Codec for well_known as a table of key-value pairs *)
141
+
let well_known_codec =
142
+
Tomlt.(Table.(
143
+
keep_unknown
144
+
~enc:(fun wk -> List.map (fun e -> (e.key, e.value)) wk)
145
+
(Mems.assoc string)
146
+
(obj (fun assoc -> List.map (fun (key, value) -> { key; value }) assoc))
147
+
|> finish
148
+
))
149
+
150
+
let config_codec =
151
+
Tomlt.(Table.(
152
+
obj (fun server paths site feeds well_known ->
153
+
{ server; paths; site; feeds; well_known })
154
+
|> mem "server" server_codec ~dec_absent:default.server ~enc:(fun c -> c.server)
155
+
|> mem "paths" paths_codec ~dec_absent:default.paths ~enc:(fun c -> c.paths)
156
+
|> mem "site" site_codec ~dec_absent:default.site ~enc:(fun c -> c.site)
157
+
|> mem "feeds" feeds_codec ~dec_absent:default.feeds ~enc:(fun c -> c.feeds)
158
+
|> mem "well_known" well_known_codec ~dec_absent:[] ~enc:(fun c -> c.well_known)
159
+
|> finish
160
+
))
161
+
162
+
let of_toml_string s =
163
+
match Tomlt_bytesrw.decode_string config_codec s with
164
+
| Ok cfg -> cfg
165
+
| Error e -> failwith (Tomlt.Error.to_string e)
166
+
167
+
let of_file path =
168
+
let ic = open_in path in
169
+
let content = really_input_string ic (in_channel_length ic) in
170
+
close_in ic;
171
+
of_toml_string content
172
+
173
+
let config_file () =
174
+
let xdg_config = Sys.getenv_opt "XDG_CONFIG_HOME" in
175
+
let home = Sys.getenv_opt "HOME" in
176
+
match xdg_config, home with
177
+
| Some xdg, _ -> Filename.concat xdg "arod/config.toml"
178
+
| None, Some h -> Filename.concat h ".config/arod/config.toml"
179
+
| None, None -> "./config.toml"
180
+
181
+
let load_or_default ?path () =
182
+
let path = match path with
183
+
| Some p -> p
184
+
| None -> config_file ()
185
+
in
186
+
if Sys.file_exists path then
187
+
of_file path
188
+
else
189
+
default
190
+
191
+
(** {1 Sample Config Generation} *)
192
+
193
+
let sample_config = {|# Arod Webserver Configuration
194
+
195
+
[server]
196
+
host = "0.0.0.0"
197
+
port = 8080
198
+
199
+
[paths]
200
+
# Bushel data directory (notes, papers, projects, etc.)
201
+
data_dir = "~/bushel"
202
+
# Static assets (CSS, JS, icons)
203
+
assets_dir = "./assets"
204
+
# Processed images from srcsetter
205
+
images_dir = "~/bushel/images/web"
206
+
# Static files (PDFs, etc.)
207
+
static_dir = "./static"
208
+
209
+
[site]
210
+
base_url = "https://example.com"
211
+
name = "My Site"
212
+
description = "A personal website powered by Bushel"
213
+
author_handle = "me"
214
+
author_name = "Your Name"
215
+
# author_email = "you@example.com"
216
+
# author_orcid = "0000-0000-0000-0000"
217
+
218
+
[feeds]
219
+
title = "Site Feed"
220
+
# subtitle = "Latest posts and updates"
221
+
222
+
# Optional: well-known endpoints for AT Protocol, etc.
223
+
# [well_known]
224
+
# "site.standard.publication" = "at://did:plc:example/app.bsky.feed.post/id"
225
+
|}
226
+
227
+
(** {1 Pretty Printing} *)
228
+
229
+
let pp ppf t =
230
+
let open Fmt in
231
+
pf ppf "@[<v>";
232
+
pf ppf "Server:@,";
233
+
pf ppf " host: %s@," t.server.host;
234
+
pf ppf " port: %d@," t.server.port;
235
+
pf ppf "@,Paths:@,";
236
+
pf ppf " data_dir: %s@," t.paths.data_dir;
237
+
pf ppf " assets_dir: %s@," t.paths.assets_dir;
238
+
pf ppf " images_dir: %s@," t.paths.images_dir;
239
+
pf ppf " static_dir: %s@," t.paths.static_dir;
240
+
pf ppf "@,Site:@,";
241
+
pf ppf " base_url: %s@," t.site.base_url;
242
+
pf ppf " name: %s@," t.site.name;
243
+
pf ppf " author: %s (@%s)@," t.site.author_name t.site.author_handle;
244
+
pf ppf "@]"
+406
arod/lib/arod_entries.ml
+406
arod/lib/arod_entries.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Entry type filtering and rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
10
+
(** Entry type filter *)
11
+
type entry_type = [ `Paper | `Note | `Video | `Idea | `Project ]
12
+
13
+
let entry_type_to_string = function
14
+
| `Paper -> "paper"
15
+
| `Note -> "note"
16
+
| `Video -> "video"
17
+
| `Idea -> "idea"
18
+
| `Project -> "project"
19
+
20
+
let entry_type_of_string = function
21
+
| "paper" -> Some `Paper
22
+
| "note" -> Some `Note
23
+
| "video" -> Some `Video
24
+
| "idea" -> Some `Idea
25
+
| "project" -> Some `Project
26
+
| _ -> None
27
+
28
+
(** Helper functions for common attributes *)
29
+
let class_ c = At.class' c
30
+
let href h = At.href h
31
+
32
+
let render_entry (ent:Arod_model.Entry.entry) =
33
+
let (t, _word_count_info) = match ent with
34
+
| `Paper p -> Arod_papers.paper_for_entry p
35
+
| `Note n -> Arod_notes.one_note_brief n
36
+
| `Video v -> Arod_videos.one_video v
37
+
| `Idea i -> Arod_ideas.one_idea_brief i
38
+
| `Project p -> Arod_projects.one_project_brief p
39
+
in
40
+
El.splice [t; Arod_view.tags_meta ent]
41
+
42
+
let render_entry_for_feed ent =
43
+
match ent with
44
+
| `Paper p -> fst (Arod_papers.paper_for_feed p)
45
+
| `Note n -> fst (Arod_notes.note_for_feed n)
46
+
| `Video v -> fst (Arod_videos.video_for_feed v)
47
+
| `Idea i -> fst (Arod_ideas.idea_for_feed i)
48
+
| `Project p -> fst (Arod_projects.project_for_feed p)
49
+
50
+
let render_feed ent =
51
+
let (entry_html, _word_count_info) = match ent with
52
+
| `Paper p -> Arod_papers.paper_for_feed p
53
+
| `Note n -> Arod_notes.note_for_feed n
54
+
| `Video v -> Arod_videos.video_for_feed v
55
+
| `Idea i -> Arod_ideas.idea_for_feed i
56
+
| `Project p -> Arod_projects.project_for_feed p
57
+
in
58
+
El.splice [
59
+
Arod_view.entry_href ent;
60
+
entry_html;
61
+
Arod_view.tags_meta ent
62
+
]
63
+
64
+
let render_backlinks_content ent =
65
+
let slug = Arod_model.Entry.slug ent in
66
+
let entry_type = match ent with
67
+
| `Paper _ -> "paper"
68
+
| `Note _ -> "note"
69
+
| `Idea _ -> "idea"
70
+
| `Project _ -> "project"
71
+
| `Video _ -> "video"
72
+
in
73
+
let entries = Arod_model.get_entries () in
74
+
let backlink_slugs = Bushel.Link_graph.get_backlinks_for_slug slug in
75
+
if backlink_slugs = [] then
76
+
None
77
+
else
78
+
let backlink_items = List.filter_map (fun backlink_slug ->
79
+
match Arod_model.Entry.lookup entries backlink_slug with
80
+
| Some entry ->
81
+
let title = Arod_model.Entry.title entry in
82
+
let url = Arod_model.Entry.site_url entry in
83
+
Some (El.li [El.a ~at:[At.href url] [El.txt title]])
84
+
| None -> None
85
+
) backlink_slugs in
86
+
if backlink_items = [] then
87
+
None
88
+
else
89
+
Some (El.splice [
90
+
El.span ~at:[At.class' "sidenote-number"] [El.txt "↑"];
91
+
El.span ~at:[At.class' "sidenote-icon"] [El.txt ""];
92
+
El.txt (Printf.sprintf "The following entries link to this %s: " entry_type);
93
+
El.ul backlink_items
94
+
])
95
+
96
+
let render_one_entry ent =
97
+
match ent with
98
+
| `Paper p -> Arod_papers.one_paper_full p, Arod_papers.one_paper_extra p
99
+
| `Idea i -> Arod_ideas.one_idea_full i, El.splice []
100
+
| `Note n -> Arod_notes.one_note_full n, El.splice []
101
+
| `Video v -> Arod_videos.one_video_full v, El.splice []
102
+
| `Project p -> Arod_projects.one_project_full p, El.splice []
103
+
104
+
type query_info = {
105
+
tags: Arod_model.Tags.t list;
106
+
min: int;
107
+
show_all: bool;
108
+
}
109
+
110
+
let sort_of_ent ent =
111
+
match ent with
112
+
| `Paper p -> (match Arod_model.Paper.bibtype p with
113
+
| "inproceedings" -> "conference paper"
114
+
| "article" | "journal" -> "journal paper"
115
+
| "misc" -> "preprint"
116
+
| "techreport" -> "technical report"
117
+
| _ -> "paper"), ""
118
+
| `Note {Arod_model.Note.updated=Some _;date=u; _} ->
119
+
"note", Printf.sprintf " (originally on %s)" (Arod_view.ptime_date ~with_d:true u)
120
+
| `Note _ -> "note", ""
121
+
| `Project _ -> "project", ""
122
+
| `Idea _ -> "research idea", ""
123
+
| `Video _ -> "video", ""
124
+
125
+
let footer = Arod_footer.footer
126
+
127
+
let take n l =
128
+
let[@tail_mod_cons] rec aux n l =
129
+
match n, l with
130
+
| 0, _ | _, [] -> []
131
+
| n, x::l -> x::aux (n - 1) l
132
+
in
133
+
if n < 0 then invalid_arg "List.take";
134
+
aux n l
135
+
136
+
let feed_title_link ent =
137
+
El.a ~at:[href (Arod_model.Entry.site_url ent)] [El.txt (Arod_model.Entry.title ent)]
138
+
139
+
let tags_heading tags =
140
+
Arod_view.map_and Arod_model.Tags.to_raw_string tags
141
+
142
+
let view_news ~show_all ~tags ~min:_ ~types feed =
143
+
let feed' =
144
+
match show_all, List.length feed with
145
+
| false, n when n > 25 -> take 25 feed
146
+
| false, _ -> feed
147
+
| true, _ -> feed
148
+
in
149
+
let title = "News " ^ (match tags with [] -> "" | tags -> " about " ^ (tags_heading tags)) in
150
+
let description = Printf.sprintf "Showing %d news item(s)" (List.length feed') in
151
+
let main_content =
152
+
let rec intersperse_hr = function
153
+
| [] -> []
154
+
| [x] -> [render_feed x]
155
+
| x::xs -> render_feed x :: El.hr () :: intersperse_hr xs
156
+
in
157
+
intersperse_hr feed' in
158
+
let page_footer = El.splice [footer] in
159
+
let pagination_attrs =
160
+
let tags_str = String.concat "," (List.map Arod_model.Tags.to_raw_string tags) in
161
+
let types_str = String.concat "," (List.map entry_type_to_string types) in
162
+
[
163
+
At.v "data-pagination" "true";
164
+
At.v "data-collection-type" "feed";
165
+
At.v "data-total-count" (string_of_int (List.length feed));
166
+
At.v "data-current-count" (string_of_int (List.length feed'));
167
+
At.v "data-tags" tags_str;
168
+
At.v "data-types" types_str;
169
+
]
170
+
in
171
+
let page_content =
172
+
El.splice [
173
+
El.article ~at:pagination_attrs main_content;
174
+
El.aside []
175
+
]
176
+
in
177
+
Arod_page.page ~title ~page_content ~page_footer ~description ()
178
+
179
+
let render_entries_html ents =
180
+
let rendered = List.map render_entry ents in
181
+
let rec add_separators = function
182
+
| [] -> []
183
+
| [x] -> [x]
184
+
| x :: xs -> x :: El.hr () :: add_separators xs
185
+
in
186
+
let html_elements = El.hr () :: add_separators rendered in
187
+
El.to_string ~doctype:false (El.splice html_elements)
188
+
189
+
let render_feeds_html feeds =
190
+
let rec intersperse_hr = function
191
+
| [] -> []
192
+
| [x] -> [render_feed x]
193
+
| x::xs -> render_feed x :: El.hr () :: intersperse_hr xs
194
+
in
195
+
let html_elements = El.hr () :: intersperse_hr feeds in
196
+
El.to_string ~doctype:false (El.splice html_elements)
197
+
198
+
let view_entries ~show_all ~tags ~min:_ ~types ents =
199
+
let ents' =
200
+
match show_all, List.length ents with
201
+
| false, n when n > 25 -> take 25 ents
202
+
| false, _ -> ents
203
+
| true, _ -> ents
204
+
in
205
+
let title = String.capitalize_ascii (tags_heading tags ^ (if tags <> [] then " " else "")) in
206
+
let description = Printf.sprintf "Showing %d item(s)" (List.length ents') in
207
+
let main_content =
208
+
let rendered = List.map render_entry ents' in
209
+
let rec add_separators = function
210
+
| [] -> []
211
+
| [x] -> [x]
212
+
| x :: xs -> x :: El.hr () :: add_separators xs
213
+
in
214
+
add_separators rendered
215
+
in
216
+
let page_footer = El.splice [footer] in
217
+
let pagination_attrs =
218
+
let tags_str = String.concat "," (List.map Arod_model.Tags.to_raw_string tags) in
219
+
let types_str = String.concat "," (List.map entry_type_to_string types) in
220
+
[
221
+
At.v "data-pagination" "true";
222
+
At.v "data-collection-type" "entries";
223
+
At.v "data-total-count" (string_of_int (List.length ents));
224
+
At.v "data-current-count" (string_of_int (List.length ents'));
225
+
At.v "data-tags" tags_str;
226
+
At.v "data-types" types_str;
227
+
]
228
+
in
229
+
let page_content =
230
+
El.splice [
231
+
El.article ~at:pagination_attrs main_content;
232
+
El.aside []
233
+
]
234
+
in
235
+
Arod_page.page ~title ~page_content ~page_footer ~description ()
236
+
237
+
let breadcrumbs cfg l = ("Home", cfg.Arod_config.site.base_url ^ "/") :: l
238
+
239
+
let view_one _q ent =
240
+
let cfg = Arod_model.get_config () in
241
+
let entries = Arod_model.get_entries () in
242
+
let title = Arod_model.Entry.title ent in
243
+
let description = match Arod_model.Entry.synopsis ent with Some v -> v | None -> "" in
244
+
let eh, extra = render_one_entry ent in
245
+
let is_index = Arod_model.Entry.is_index_entry ent in
246
+
let standardsite = match ent with
247
+
| `Note n -> Arod_model.Note.standardsite n
248
+
| _ -> None
249
+
in
250
+
let backlinks_content =
251
+
if is_index then None
252
+
else render_backlinks_content ent
253
+
in
254
+
let related_container =
255
+
match ent with
256
+
| `Project _ -> El.splice []
257
+
| _ when is_index -> El.splice []
258
+
| `Note _ ->
259
+
let tags = Arod_model.Entry.tags_of_ent entries ent in
260
+
let tag_strings = List.map Arod_model.Tags.to_raw_string tags |> String.concat " " in
261
+
El.div ~at:[
262
+
class_ "related-items";
263
+
At.v "data-entry-title" title;
264
+
At.v "data-entry-id" (Arod_model.Entry.slug ent);
265
+
At.v "data-entry-tags" tag_strings
266
+
] []
267
+
| _ ->
268
+
let tags = Arod_model.Entry.tags_of_ent entries ent in
269
+
let tag_strings = List.map Arod_model.Tags.to_raw_string tags |> String.concat " " in
270
+
El.splice [
271
+
El.hr ();
272
+
El.div ~at:[
273
+
class_ "related-items";
274
+
At.v "data-entry-title" title;
275
+
At.v "data-entry-id" (Arod_model.Entry.slug ent);
276
+
At.v "data-entry-tags" tag_strings
277
+
] []
278
+
]
279
+
in
280
+
let bs = Arod_richdata.(breadcrumbs @@ breadcrumb_of_ent cfg ent) in
281
+
let jsonld = bs ^ (Arod_richdata.json_of_entry cfg ent) in
282
+
let image = match Arod_model.Entry.thumbnail entries ent with
283
+
| Some thumb -> cfg.site.base_url ^ thumb
284
+
| None -> cfg.site.base_url ^ "/assets/imagetitle-default.jpg"
285
+
in
286
+
let page_footer, page_content =
287
+
if is_index then
288
+
let page_footer = footer in
289
+
let page_content = El.splice [
290
+
El.article [eh];
291
+
El.aside []
292
+
] in
293
+
page_footer, page_content
294
+
else
295
+
let page_footer = footer in
296
+
let references_html = match ent with
297
+
| `Note n -> El.splice [El.hr (); Arod_view.note_references_html n]
298
+
| _ -> El.splice []
299
+
in
300
+
let page_content = El.splice [
301
+
El.article [
302
+
eh;
303
+
Arod_view.tags_meta ?backlinks_content ent;
304
+
references_html;
305
+
related_container;
306
+
extra
307
+
];
308
+
El.aside []
309
+
] in
310
+
page_footer, page_content
311
+
in
312
+
Arod_page.page ~image ~title ~jsonld ?standardsite ~page_content ~page_footer ~description ()
313
+
314
+
let filter_fn query_tags item_tags =
315
+
let item_sets, item_text = List.partition (function `Set _ -> true | _ -> false) item_tags in
316
+
let query_sets, query_text = List.partition (function `Set _ -> true | _ -> false) query_tags in
317
+
let test_set seta setb =
318
+
match setb with
319
+
| [] -> true
320
+
| setb -> List.exists (fun tag -> List.mem tag seta) setb
321
+
in
322
+
(test_set item_sets query_sets) &&
323
+
(test_set item_text query_text)
324
+
325
+
let entry_matches_type types ent =
326
+
if types = [] then true
327
+
else
328
+
List.exists (fun typ ->
329
+
match typ, ent with
330
+
| `Paper, `Paper _ -> true
331
+
| `Note, `Note _ -> true
332
+
| `Video, `Video _ -> true
333
+
| `Idea, `Idea _ -> true
334
+
| `Project, `Project _ -> true
335
+
| _ -> false
336
+
) types
337
+
338
+
let feed_of_req ~types q =
339
+
let entries = Arod_model.get_entries () in
340
+
let filterent = entry_matches_type types in
341
+
let select ent =
342
+
let only_talks = function
343
+
| `Video { Arod_model.Video.talk; _ } -> talk
344
+
| _ -> true
345
+
in
346
+
let not_index_page = function
347
+
| `Note { Arod_model.Note.index_page; _ } -> not index_page
348
+
| _ -> true
349
+
in
350
+
only_talks ent && not_index_page ent
351
+
in
352
+
let all_entries = Arod_model.all_entries () in
353
+
match q.tags with
354
+
| [] ->
355
+
all_entries
356
+
|> List.filter (fun ent -> select ent && filterent ent)
357
+
|> List.sort Arod_model.Entry.compare
358
+
|> List.rev
359
+
| t ->
360
+
all_entries
361
+
|> List.filter (fun ent ->
362
+
select ent && filterent ent && filter_fn t (Arod_model.Entry.tags_of_ent entries ent))
363
+
|> List.sort Arod_model.Entry.compare
364
+
|> List.rev
365
+
366
+
let perma_feed_of_req () =
367
+
let filterent ent =
368
+
match ent with
369
+
| `Note n -> Arod_model.Note.perma n
370
+
| _ -> false
371
+
in
372
+
let all_entries = Arod_model.all_entries () in
373
+
all_entries
374
+
|> List.filter filterent
375
+
|> List.sort Arod_model.Entry.compare
376
+
|> List.rev
377
+
378
+
let entries_of_req ~extra_tags ~types q =
379
+
let entries = Arod_model.get_entries () in
380
+
let tags = Arod_model.concat_tags q.tags (List.map Arod_model.Tags.of_string extra_tags) in
381
+
let q = { q with tags } in
382
+
let filterent = entry_matches_type types in
383
+
let select ent =
384
+
let only_talks = function
385
+
| `Video { Arod_model.Video.talk; _ } -> talk
386
+
| _ -> true
387
+
in
388
+
let not_index_page = function
389
+
| `Note { Arod_model.Note.index_page; _ } -> not index_page
390
+
| _ -> true
391
+
in
392
+
only_talks ent && not_index_page ent
393
+
in
394
+
let all_entries = Arod_model.all_entries () in
395
+
match q.tags with
396
+
| [] ->
397
+
all_entries
398
+
|> List.filter (fun ent -> select ent && filterent ent)
399
+
|> List.sort Arod_model.Entry.compare
400
+
|> List.rev
401
+
| ts ->
402
+
all_entries
403
+
|> List.filter (fun ent ->
404
+
select ent && filterent ent && filter_fn ts (Arod_model.Entry.tags_of_ent entries ent))
405
+
|> List.sort Arod_model.Entry.compare
406
+
|> List.rev
+138
arod/lib/arod_feed.ml
+138
arod/lib/arod_feed.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Atom feed generation for Arod webserver *)
7
+
8
+
module E = Arod_model.Entry
9
+
module N = Arod_model.Note
10
+
module C = Sortal_schema.Contact
11
+
module X = Syndic.Atom
12
+
13
+
let anil_copyright = "(c) 1998-2025 Anil Madhavapeddy, all rights reserved"
14
+
15
+
let author c =
16
+
let uri = Option.map Uri.of_string (C.best_url c) in
17
+
let email = match C.emails c with e :: _ -> Some e.C.address | [] -> None in
18
+
{X.name=(C.name c); email; uri}
19
+
20
+
let form_uri cfg path = Uri.of_string (cfg.Arod_config.site.base_url ^ path)
21
+
22
+
let atom_id cfg e = form_uri cfg @@ E.site_url e
23
+
24
+
let generator = {
25
+
X.version = Some "1.0";
26
+
uri = Some (Uri.of_string "https://github.com/avsm/bushel");
27
+
content = "Bushel"
28
+
}
29
+
30
+
let link cfg e =
31
+
let href = form_uri cfg @@ E.site_url e in
32
+
let rel = X.Self in
33
+
let type_media = None in
34
+
let title = E.title e in
35
+
let length = None in
36
+
let hreflang = None in
37
+
{X.href; rel; type_media; title; length; hreflang}
38
+
39
+
let news_feed_link cfg =
40
+
let href = form_uri cfg "/news.xml" in
41
+
let rel = X.Self in
42
+
let type_media = None in
43
+
let title = cfg.Arod_config.site.name in
44
+
let length = None in
45
+
let hreflang = None in
46
+
{X.href; rel; type_media; title; length; hreflang}
47
+
48
+
let ext_link ~title l =
49
+
let href = Uri.of_string l in
50
+
let rel = X.Alternate in
51
+
let type_media = None in
52
+
let title = title in
53
+
let length = None in
54
+
let hreflang = None in
55
+
[{X.href; rel; type_media; title; length; hreflang}]
56
+
57
+
let atom_of_note cfg ~author note =
58
+
let e = `Note note in
59
+
let id = atom_id cfg e in
60
+
let categories = List.map (fun tag ->
61
+
X.category tag
62
+
) (N.tags note) in
63
+
let rights : X.title = X.Text anil_copyright in
64
+
let source = None in
65
+
let title : X.title = X.Text note.N.title in
66
+
let published = N.origdate note in
67
+
let updated = N.datetime note in
68
+
let authors = author, [] in
69
+
70
+
let base_html = Arod_view.md_to_atom_html note.N.body in
71
+
72
+
let is_perma = N.perma note in
73
+
let has_doi = match N.doi note with Some _ -> true | None -> false in
74
+
let html_with_refs =
75
+
if is_perma || has_doi then
76
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
77
+
| Some c -> c
78
+
| None -> failwith "Author not found"
79
+
in
80
+
let references = Bushel.Md.note_references (Arod_model.get_entries ()) me note in
81
+
if List.length references > 0 then
82
+
let refs_html =
83
+
let ref_items = List.map (fun (doi, citation, _) ->
84
+
let doi_url = Printf.sprintf "https://doi.org/%s" doi in
85
+
Printf.sprintf "<li>%s<a href=\"%s\" target=\"_blank\"><i>%s</i></a></li>"
86
+
citation doi_url doi
87
+
) references |> String.concat "\n" in
88
+
Printf.sprintf "<h1>References</h1><ul>%s</ul>" ref_items
89
+
in
90
+
base_html ^ refs_html
91
+
else
92
+
base_html
93
+
else
94
+
base_html
95
+
in
96
+
97
+
let html_base_uri = Some (Uri.of_string (cfg.site.base_url ^ "/")) in
98
+
let content, links =
99
+
match N.link note with
100
+
| `Local _ ->
101
+
let content = Some (X.Html (html_base_uri, html_with_refs)) in
102
+
let links = [link cfg e] in
103
+
content, links
104
+
| `Ext (_l,u) ->
105
+
let content = Some (X.Html (html_base_uri, html_with_refs)) in
106
+
let links = ext_link ~title:note.N.title u in
107
+
content, links
108
+
in
109
+
let entry = Syndic.Atom.entry
110
+
~categories ~links ~published ~rights ?content
111
+
?source ~title ~updated
112
+
~id ~authors ()
113
+
in
114
+
entry
115
+
116
+
let atom_of_entry cfg ~author (e:Arod_model.Entry.entry) =
117
+
match e with
118
+
| `Note n -> Some (atom_of_note cfg ~author n)
119
+
| _ -> None
120
+
121
+
let feed cfg uri entries =
122
+
try
123
+
let author = author @@ (Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle |> Option.get) in
124
+
let authors = [author] in
125
+
let icon = Uri.of_string (cfg.site.base_url ^ "/assets/favicon.ico") in
126
+
let links = [news_feed_link cfg] in
127
+
let atom_entries = List.filter_map (atom_of_entry cfg ~author) entries in
128
+
let title : X.text_construct = X.Text (cfg.site.name ^ "'s feed") in
129
+
let updated = Arod_model.Entry.datetime (List.hd entries) in
130
+
let id = form_uri cfg uri in
131
+
let rights : X.title = X.Text anil_copyright in
132
+
X.feed ~id ~rights ~authors ~title ~updated ~icon ~links atom_entries
133
+
with exn -> Printexc.print_backtrace stdout; print_endline "x"; raise exn
134
+
135
+
let feed_string cfg uri f =
136
+
let buf = Buffer.create 1024 in
137
+
X.output (feed cfg uri f) (`Buffer buf);
138
+
Buffer.contents buf
+320
arod/lib/arod_html.ml
+320
arod/lib/arod_html.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Htmlit-based HTML generation for Arod *)
7
+
8
+
open Htmlit
9
+
10
+
(** {1 Attribute Helpers} *)
11
+
12
+
let class_ c = At.class' c
13
+
let id i = At.id i
14
+
let href h = At.href h
15
+
let alt a = At.alt a
16
+
let src s = At.src s
17
+
let title t = At.title t
18
+
let name n = At.name n
19
+
let content c = At.content c
20
+
let loading l = At.v "loading" l
21
+
let sizes s = At.v "sizes" s
22
+
let srcset s = At.v "srcset" s
23
+
let data_tag t = At.v "data-tag" t
24
+
let frameborder f = At.v "frameborder" f
25
+
let allowfullscreen = At.v "allowfullscreen" ""
26
+
let sandbox s = At.v "sandbox" s
27
+
let width w = At.v "width" w
28
+
let height h = At.v "height" h
29
+
let rel r = At.rel r
30
+
let property p = At.v "property" p
31
+
let http_equiv h = At.v "http-equiv" h
32
+
let type_ t = At.type' t
33
+
let lang l = At.lang l
34
+
35
+
(** {1 SVG Icons} *)
36
+
37
+
let svg_icon_paper =
38
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M16 7 C16 7 9 1 2 6 L2 28 C9 23 16 28 16 28 16 28 23 23 30 28 L30 6 C23 1 16 7 16 7 Z M16 7 L16 28" /></svg>|}
39
+
40
+
let svg_icon_project =
41
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M30 8 L2 8 2 26 30 26 Z M20 8 C20 8 20 4 16 4 12 4 12 8 12 8 M8 26 L8 8 M24 26 L24 8" /></svg>|}
42
+
43
+
let svg_icon_note =
44
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M27 15 L27 30 2 30 2 5 17 5 M30 6 L26 2 9 19 7 25 13 23 Z M22 6 L26 10 Z M9 19 L13 23 Z" /></svg>|}
45
+
46
+
let svg_icon_video =
47
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M22 13 L30 8 30 24 22 19 Z M2 8 L2 24 22 24 22 8 Z" /></svg>|}
48
+
49
+
let svg_icon_idea =
50
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M18 13 L26 2 8 13 14 19 6 30 24 19 Z" /></svg>|}
51
+
52
+
let svg_icon_search =
53
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 24 24" width="18" height="18" fill="none" stroke="currentColor" stroke-width="2" stroke-linecap="round" stroke-linejoin="round"><circle cx="11" cy="11" r="8"/><path d="m21 21-4.35-4.35"/></svg>|}
54
+
55
+
(** {1 Date Formatting} *)
56
+
57
+
let int_to_date_suffix ~r n =
58
+
let suffix =
59
+
if n mod 10 = 1 && n mod 100 <> 11 then "st"
60
+
else if n mod 10 = 2 && n mod 100 <> 12 then "nd"
61
+
else if n mod 10 = 3 && n mod 100 <> 13 then "rd"
62
+
else "th"
63
+
in
64
+
let x = string_of_int n in
65
+
let x = if r && String.length x = 1 then " " ^ x else x in
66
+
x ^ suffix
67
+
68
+
let month_name = function
69
+
| 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr"
70
+
| 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug"
71
+
| 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec"
72
+
| _ -> ""
73
+
74
+
let ptime_date ?(r=false) ?(with_d=false) (y, m, d) =
75
+
let ms = month_name m in
76
+
match with_d with
77
+
| false -> Printf.sprintf "%s %4d" ms y
78
+
| true -> Printf.sprintf "%s %s %4d" (int_to_date_suffix ~r d) ms y
79
+
80
+
(** {1 Image Rendering} *)
81
+
82
+
let img ?cl ?(alt_text="") ?(title_text="") img_ent =
83
+
let origin_url = Printf.sprintf "/images/%s.webp"
84
+
(Filename.chop_extension (Arod_model.Img.origin img_ent)) in
85
+
86
+
let srcsets =
87
+
let variants = Arod_model.Img.variants img_ent in
88
+
String.concat ","
89
+
(Arod_model.Img.MS.fold (fun f (w, _h) acc ->
90
+
Printf.sprintf "/images/%s %dw" f w :: acc
91
+
) variants [])
92
+
in
93
+
94
+
let base_attrs = [
95
+
loading "lazy";
96
+
src origin_url;
97
+
srcset srcsets;
98
+
sizes "(max-width: 768px) 100vw, 33vw"
99
+
] in
100
+
101
+
let attrs = match cl with
102
+
| Some c -> class_ c :: base_attrs
103
+
| None -> base_attrs
104
+
in
105
+
106
+
match alt_text with
107
+
| "%r" ->
108
+
El.figure ~at:[class_ "image-right"] [
109
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
110
+
El.figcaption [El.txt title_text]
111
+
]
112
+
| "%c" ->
113
+
El.figure ~at:[class_ "image-center"] [
114
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
115
+
El.figcaption [El.txt title_text]
116
+
]
117
+
| "%lc" ->
118
+
El.figure ~at:[class_ "image-left-float"] [
119
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
120
+
El.figcaption [El.txt title_text]
121
+
]
122
+
| "%rc" ->
123
+
El.figure ~at:[class_ "image-right-float"] [
124
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
125
+
El.figcaption [El.txt title_text]
126
+
]
127
+
| _ ->
128
+
El.img ~at:(At.alt alt_text :: At.title title_text :: attrs) ()
129
+
130
+
(** {1 Tag Rendering} *)
131
+
132
+
let render_tag ?active tag_value =
133
+
let active_cl = match active with Some true -> " tag-active" | _ -> "" in
134
+
135
+
let icon, text =
136
+
match tag_value with
137
+
| `Slug t ->
138
+
(match Arod_model.lookup t with
139
+
| Some ent ->
140
+
let icon_name = match ent with
141
+
| `Paper _ -> Some "paper.svg"
142
+
| `Note _ -> Some "note.svg"
143
+
| `Project _ -> Some "project.svg"
144
+
| `Idea _ -> Some "idea.svg"
145
+
| `Video _ -> Some "video.svg"
146
+
in
147
+
icon_name, Arod_model.Entry.slug ent
148
+
| None -> None, t)
149
+
| `Set slug ->
150
+
let icon_name = match slug with
151
+
| "papers" -> Some "paper.svg"
152
+
| "notes" -> Some "note.svg"
153
+
| "projects" -> Some "project.svg"
154
+
| "ideas" -> Some "idea.svg"
155
+
| "videos" | "talks" -> Some "video.svg"
156
+
| _ -> None
157
+
in
158
+
icon_name, slug
159
+
| _ -> None, Arod_model.Tags.to_string tag_value
160
+
in
161
+
162
+
let t = Arod_model.Tags.to_string tag_value in
163
+
let icon_el = match icon with
164
+
| None -> El.splice []
165
+
| Some icon_name ->
166
+
El.img ~at:[
167
+
alt "icon";
168
+
class_ "hide-mobile inline-icon";
169
+
src (Printf.sprintf "/assets/%s" icon_name)
170
+
] ()
171
+
in
172
+
173
+
El.span ~at:[
174
+
data_tag t;
175
+
class_ ("tag-label" ^ active_cl)
176
+
] [icon_el; El.txt text]
177
+
178
+
let render_tags tags =
179
+
let filtered_tags = List.filter (function
180
+
| `Text _ | `Set _ -> true
181
+
| _ -> false
182
+
) tags in
183
+
El.splice ~sep:(El.txt " ") (List.map render_tag filtered_tags)
184
+
185
+
(** {1 Entry Rendering} *)
186
+
187
+
let entry_href ?title_override ?(tag="h2") ent =
188
+
let title_text = match title_override with
189
+
| None -> Arod_model.Entry.title ent
190
+
| Some t -> t
191
+
in
192
+
193
+
match ent with
194
+
| `Note { Arod_model.Note.index_page = true; _ } -> El.splice []
195
+
| _ ->
196
+
let h_fn = match tag with
197
+
| "h1" -> El.h1
198
+
| "h2" -> El.h2
199
+
| "h3" -> El.h3
200
+
| "h4" -> El.h4
201
+
| _ -> El.h2
202
+
in
203
+
h_fn [
204
+
El.a ~at:[href (Arod_model.Entry.site_url ent)] [El.txt title_text];
205
+
El.span ~at:[class_ "title-date"] [
206
+
El.txt " / ";
207
+
El.txt (ptime_date ~with_d:false (Arod_model.Entry.date ent))
208
+
]
209
+
]
210
+
211
+
let tags_meta ?link ?(tags=[]) ?date ent =
212
+
let tags = List.map Arod_model.Tags.of_string tags in
213
+
let link_el = match link with
214
+
| None -> El.a ~at:[href (Arod_model.Entry.site_url ent)] [El.txt "#"]
215
+
| Some l -> El.a ~at:[href l] [El.txt "#"]
216
+
in
217
+
218
+
let date_str = ptime_date ~with_d:true
219
+
(match date with None -> Arod_model.Entry.date ent | Some d -> d) in
220
+
221
+
El.div ~at:[class_ "note-meta"] [
222
+
link_el;
223
+
El.txt " ";
224
+
El.txt date_str;
225
+
El.txt " ";
226
+
El.span ~at:[class_ "tags"] [
227
+
render_tags (Arod_model.concat_tags tags (Arod_model.tags_of_ent ent))
228
+
]
229
+
]
230
+
231
+
let full_body ent =
232
+
El.unsafe_raw (Arod_model.md_to_html (Arod_model.Entry.body ent))
233
+
234
+
(** {1 Video Embedding} *)
235
+
236
+
let embed_video ~video_title ~url =
237
+
El.div ~at:[class_ "video-center"] [
238
+
El.iframe ~at:[
239
+
title video_title;
240
+
width "100%";
241
+
height "315px";
242
+
src url;
243
+
frameborder "0";
244
+
allowfullscreen;
245
+
sandbox "allow-same-origin allow-scripts allow-popups allow-forms"
246
+
] []
247
+
]
248
+
249
+
(** {1 Page Layout} *)
250
+
251
+
let page ?(image="/assets/imagetitle-default.jpg") ?(jsonld="") ~page_title ~description ~page_content () =
252
+
let cfg = Arod_model.get_config () in
253
+
let title_text = if page_title = "" then cfg.site.name else page_title in
254
+
255
+
let head_els = [
256
+
El.meta ~at:[http_equiv "X-UA-Compatible"; content "ie=edge"] ();
257
+
El.meta ~at:[name "description"; content description] ();
258
+
El.meta ~at:[property "og:image"; content image] ();
259
+
El.meta ~at:[property "og:site_name"; content cfg.site.name] ();
260
+
El.meta ~at:[property "og:type"; content "object"] ();
261
+
El.meta ~at:[property "og:title"; content title_text] ();
262
+
El.meta ~at:[property "og:description"; content description] ();
263
+
El.meta ~at:[name "twitter:card"; content "summary_large_image"] ();
264
+
El.meta ~at:[name "twitter:title"; content title_text] ();
265
+
El.meta ~at:[name "twitter:description"; content description] ();
266
+
El.meta ~at:[name "twitter:image"; content image] ();
267
+
El.meta ~at:[name "theme-color"; content "#fff"] ();
268
+
El.meta ~at:[name "color-scheme"; content "white"] ();
269
+
El.link ~at:[rel "apple-touch-icon"; sizes "180x180"; href "/assets/apple-touch-icon.png"] ();
270
+
El.link ~at:[rel "icon"; type_ "image/png"; sizes "32x32"; href "/assets/favicon-32x32.png"] ();
271
+
El.link ~at:[rel "icon"; type_ "image/png"; sizes "16x16"; href "/assets/favicon-16x16.png"] ();
272
+
El.link ~at:[rel "alternate"; type_ "application/atom+xml"; At.title "Atom Feed"; href "/news.xml"] ();
273
+
El.link ~at:[rel "alternate"; type_ "application/feed+json"; At.title "JSON Feed"; href "/feed.json"] ();
274
+
El.link ~at:[rel "stylesheet"; href "/assets/site.css"] ();
275
+
El.link ~at:[rel "stylesheet"; href "/assets/highlight.min.css"] ();
276
+
El.unsafe_raw jsonld;
277
+
El.script ~at:[src "/assets/highlight.min.js"] [];
278
+
El.script [El.txt "hljs.highlightAll();"]
279
+
] in
280
+
281
+
let header_el = El.header ~at:[class_ "site-header"] [
282
+
El.div ~at:[class_ "header-content"] [
283
+
El.h1 ~at:[class_ "site-name"] [
284
+
El.a ~at:[href "/"] [El.txt cfg.site.name]
285
+
];
286
+
El.nav ~at:[class_ "main-nav"] [
287
+
El.a ~at:[class_ "nav-link"; href "/papers"] [svg_icon_paper; El.txt "Papers"];
288
+
El.a ~at:[class_ "nav-link"; href "/projects"] [svg_icon_project; El.txt "Projects"];
289
+
El.a ~at:[class_ "nav-link"; href "/notes"] [svg_icon_note; El.txt "Notes"];
290
+
El.a ~at:[class_ "nav-link"; href "/videos"] [svg_icon_video; El.txt "Talks"];
291
+
El.a ~at:[class_ "nav-link"; href "/ideas"] [svg_icon_idea; El.txt "Ideas"];
292
+
];
293
+
El.div ~at:[class_ "header-right"] [
294
+
El.div ~at:[class_ "search-container"] [
295
+
El.button ~at:[class_ "search-toggle"; At.v "aria-label" "Search"; id "search-toggle-btn"] [
296
+
svg_icon_search;
297
+
El.span ~at:[class_ "search-label"] [El.txt "Search"]
298
+
]
299
+
]
300
+
]
301
+
]
302
+
] in
303
+
304
+
let footer_el = El.footer [
305
+
El.txt (Printf.sprintf "Powered by Bushel | %s" cfg.site.name)
306
+
] in
307
+
308
+
let body_el = El.body ~at:[class_ "light"] [
309
+
header_el;
310
+
El.div ~at:[class_ "content-grid"] [page_content];
311
+
footer_el;
312
+
El.script ~at:[src "/assets/site.js"] [];
313
+
] in
314
+
315
+
El.page ~lang:"en" ~title:title_text ~more_head:(El.splice head_els) body_el
316
+
317
+
(** {1 Output Helpers} *)
318
+
319
+
let to_string el = El.to_string ~doctype:false el
320
+
let to_page el = El.to_string ~doctype:true el
+260
arod/lib/arod_ideas.ml
+260
arod/lib/arod_ideas.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Idea rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
open Printf
10
+
11
+
module MI = Arod_model.Idea
12
+
13
+
let class_ c = At.class' c
14
+
15
+
let color_of_status =
16
+
let open MI in
17
+
function
18
+
| Available -> "#ddffdd"
19
+
| Discussion -> "#efee99"
20
+
| Ongoing -> "#ffeebb"
21
+
| Completed -> "#f0f0fe"
22
+
| Expired -> "#cccccc"
23
+
24
+
let status_to_long_string s =
25
+
let open MI in
26
+
function
27
+
| Available -> sprintf {|is <span class="idea-available">available</span> for being worked on|}
28
+
| Discussion -> sprintf {|is <span class="idea-discussion">under discussion</span> with a student but not yet confirmed|}
29
+
| Ongoing -> sprintf {|is currently <span class="idea-ongoing">being worked on</span> by %s|} s
30
+
| Completed -> sprintf {|has been <span class="idea-completed">completed</span> by %s|} s
31
+
| Expired -> sprintf {|has <span class="idea-expired">expired</span>|}
32
+
33
+
let level_to_long_string =
34
+
let open MI in
35
+
function
36
+
| Any -> " as a good starter project"
37
+
| PartII -> " as a Cambridge Computer Science Part II project"
38
+
| MPhil -> " as a Cambridge Computer Science Part III or MPhil project"
39
+
| PhD -> " as a Cambridge Computer Science PhD topic"
40
+
| Postdoc -> " as a postdoctoral project"
41
+
42
+
let idea_to_html_no_sidenotes idea =
43
+
let open MI in
44
+
let idea_url = "/ideas/" ^ idea.slug in
45
+
46
+
let render_contacts contacts =
47
+
match contacts with
48
+
| [] -> El.splice []
49
+
| cs ->
50
+
let contact_links = List.filter_map (fun handle ->
51
+
match Arod_model.lookup_by_handle handle with
52
+
| Some contact ->
53
+
let name = Sortal_schema.Contact.name contact in
54
+
(match Sortal_schema.Contact.best_url contact with
55
+
| Some url -> Some (El.a ~at:[At.href url] [El.txt name])
56
+
| None -> Some (El.txt name))
57
+
| None ->
58
+
Some (El.txt ("@" ^ handle))
59
+
) cs in
60
+
let rec intersperse_and = function
61
+
| [] -> []
62
+
| [x] -> [x]
63
+
| [x; y] -> [x; El.txt " and "; y]
64
+
| x :: xs -> x :: El.txt ", " :: intersperse_and xs
65
+
in
66
+
El.splice (intersperse_and contact_links)
67
+
in
68
+
69
+
let sups = List.filter (fun x -> x <> "avsm") idea.supervisors in
70
+
let sups_el = match sups with
71
+
| [] -> El.splice []
72
+
| _ -> El.splice [El.txt " and cosupervised with "; render_contacts sups]
73
+
in
74
+
75
+
let studs_el = match idea.students with
76
+
| [] -> El.splice []
77
+
| _ -> El.splice [render_contacts idea.students]
78
+
in
79
+
80
+
let lev = match idea.level with
81
+
| Any -> ""
82
+
| PartII -> " (Part II)"
83
+
| MPhil -> " (MPhil)"
84
+
| PhD -> " (PhD)"
85
+
| Postdoc -> ""
86
+
in
87
+
88
+
let status_and_info = match idea.status with
89
+
| Available -> El.splice [
90
+
El.a ~at:[At.href idea_url] [El.txt (MI.title idea)];
91
+
El.txt " ";
92
+
El.br ();
93
+
El.span ~at:[At.class' "idea-available"] [El.txt ("Available" ^ lev)];
94
+
El.txt " ";
95
+
sups_el
96
+
]
97
+
| Discussion -> El.splice [
98
+
El.a ~at:[At.href idea_url] [El.txt (MI.title idea)];
99
+
El.txt " ";
100
+
El.br ();
101
+
El.span ~at:[At.class' "idea-discussion"] [El.txt ("Under discussion" ^ lev)];
102
+
El.txt " ";
103
+
sups_el
104
+
]
105
+
| Ongoing -> El.splice [
106
+
El.a ~at:[At.href idea_url] [El.txt (MI.title idea)];
107
+
El.txt " ";
108
+
El.br ();
109
+
El.span ~at:[At.class' "idea-ongoing"] [El.txt ("Currently ongoing" ^ lev)];
110
+
El.txt " with ";
111
+
studs_el;
112
+
El.txt " ";
113
+
sups_el
114
+
]
115
+
| Completed -> El.splice [
116
+
El.a ~at:[At.href idea_url] [El.txt (MI.title idea)];
117
+
El.txt " ";
118
+
El.br ();
119
+
El.span ~at:[At.class' "idea-completed"] [El.txt ("Completed" ^ lev)];
120
+
El.txt " by ";
121
+
studs_el;
122
+
El.txt " ";
123
+
sups_el;
124
+
El.txt (" in " ^ string_of_int idea.year)
125
+
]
126
+
| Expired -> El.splice [
127
+
El.a ~at:[At.href idea_url] [El.txt (MI.title idea)];
128
+
El.txt " ";
129
+
El.br ();
130
+
El.span ~at:[At.class' "idea-expired"] [El.txt ("Expired" ^ lev)];
131
+
El.txt " ";
132
+
sups_el
133
+
]
134
+
in
135
+
status_and_info
136
+
137
+
let sups_for i =
138
+
let v = match MI.status i with
139
+
| Completed -> "was"
140
+
| Ongoing -> "is"
141
+
| _ -> "may be" in
142
+
let sups = List.filter (fun x -> x <> "avsm") i.supervisors in
143
+
match sups with
144
+
| [] -> ""
145
+
| s -> " It " ^ v ^ " co-supervised with " ^ (Arod_view.map_and (sprintf "[@%s]") s) ^ "."
146
+
147
+
let one_idea_full i =
148
+
let studs = Arod_view.map_and (sprintf "[@%s]") (MI.students i) in
149
+
let r = Printf.sprintf "# %s\n\nThis is an idea proposed in %d%s, and %s.%s\n\n%s"
150
+
(MI.title i) (MI.year i) (level_to_long_string @@ MI.level i) (status_to_long_string studs (MI.status i)) (sups_for i) (MI.body i)
151
+
in
152
+
El.div ~at:[class_ "idea"] [
153
+
El.unsafe_raw (Arod_view.md_to_html r)
154
+
]
155
+
156
+
let idea_for_feed i =
157
+
let studs = Arod_view.map_and (sprintf "[@%s]") (MI.students i) in
158
+
let r = Printf.sprintf "This is an idea proposed %s, and %s.%s"
159
+
(level_to_long_string @@ MI.level i) (status_to_long_string studs (MI.status i)) (sups_for i)
160
+
in
161
+
let (body_html, word_count_info) = Arod_view.truncated_body (`Idea i) in
162
+
(El.splice [
163
+
El.unsafe_raw (Arod_view.md_to_html r);
164
+
body_html
165
+
], word_count_info)
166
+
167
+
let one_idea_brief i =
168
+
let studs = Arod_view.map_and (sprintf "[@%s]") (MI.students i) in
169
+
let r = Printf.sprintf "This is an idea proposed in %d%s, and %s.%s"
170
+
(MI.year i) (level_to_long_string @@ MI.level i) (status_to_long_string studs (MI.status i)) (sups_for i)
171
+
in
172
+
let (body_html, word_count_info) = Arod_view.truncated_body (`Idea i) in
173
+
(El.splice [
174
+
Arod_view.entry_href (`Idea i);
175
+
El.div ~at:[class_ "idea"] [
176
+
El.unsafe_raw (Arod_view.md_to_html r);
177
+
body_html
178
+
]
179
+
], word_count_info)
180
+
181
+
let view_ideas_by_project () =
182
+
let entries = Arod_model.get_entries () in
183
+
let all_ideas = Arod_model.Entry.ideas entries in
184
+
let all_projects = Arod_model.Entry.projects entries
185
+
|> List.sort Arod_model.Project.compare |> List.rev in
186
+
187
+
let ideas_by_project = Hashtbl.create 32 in
188
+
List.iter (fun i ->
189
+
let proj_slug = MI.project i in
190
+
let existing = try Hashtbl.find ideas_by_project proj_slug with Not_found -> [] in
191
+
Hashtbl.replace ideas_by_project proj_slug (i :: existing)
192
+
) all_ideas;
193
+
194
+
Hashtbl.iter (fun proj_slug ideas ->
195
+
Hashtbl.replace ideas_by_project proj_slug (List.sort MI.compare ideas)
196
+
) ideas_by_project;
197
+
198
+
let project_sections = List.filter_map (fun p ->
199
+
let proj_slug = p.Arod_model.Project.slug in
200
+
match Hashtbl.find_opt ideas_by_project proj_slug with
201
+
| None -> None
202
+
| Some ideas ->
203
+
let idea_items = List.map (fun i ->
204
+
El.li ~at:[At.class' "idea-item"; At.v "data-status" (MI.status_to_string (MI.status i))] [
205
+
idea_to_html_no_sidenotes i
206
+
]
207
+
) ideas in
208
+
let thumbnail_md = Printf.sprintf "![%%lc](:project-%s \"%s\")" proj_slug p.Arod_model.Project.title in
209
+
let thumbnail_html = El.unsafe_raw (Arod_view.md_to_html thumbnail_md) in
210
+
Some (El.div ~at:[At.class' "project-section"] [
211
+
El.h2 [
212
+
El.a ~at:[At.href ("/projects/" ^ proj_slug)] [El.txt p.Arod_model.Project.title]
213
+
];
214
+
thumbnail_html;
215
+
El.p [Arod_view.truncated_body (`Project p) |> fst];
216
+
El.ul ~at:[At.class' "ideas-list"] idea_items
217
+
])
218
+
) all_projects in
219
+
220
+
let status_filter = El.div ~at:[At.class' "status-filter"] [
221
+
El.h3 [El.txt "Filter by status:"];
222
+
El.label [
223
+
El.input ~at:[At.type' "checkbox"; At.id "filter-available"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Available"] ();
224
+
El.span ~at:[At.class' "status-label idea-available"] [El.txt "Available"]
225
+
];
226
+
El.label [
227
+
El.input ~at:[At.type' "checkbox"; At.id "filter-discussion"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Discussion"] ();
228
+
El.span ~at:[At.class' "status-label idea-discussion"] [El.txt "Discussion"]
229
+
];
230
+
El.label [
231
+
El.input ~at:[At.type' "checkbox"; At.id "filter-ongoing"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Ongoing"] ();
232
+
El.span ~at:[At.class' "status-label idea-ongoing"] [El.txt "Ongoing"]
233
+
];
234
+
El.label [
235
+
El.input ~at:[At.type' "checkbox"; At.id "filter-completed"; At.checked; At.class' "status-checkbox"; At.v "data-status" "Completed"] ();
236
+
El.span ~at:[At.class' "status-label idea-completed"] [El.txt "Completed"]
237
+
];
238
+
El.label [
239
+
El.input ~at:[At.type' "checkbox"; At.id "filter-expired"; At.class' "status-checkbox"; At.v "data-status" "Expired"] ();
240
+
El.span ~at:[At.class' "status-label idea-expired"] [El.txt "Expired"]
241
+
]
242
+
] in
243
+
244
+
let title = "Research Ideas" in
245
+
let description = "Research ideas grouped by project" in
246
+
247
+
let intro = El.p [El.txt "These are research ideas for students at various levels (Part II, MPhil, PhD, and postdoctoral). Browse through the ideas below to find projects that interest you. You're also welcome to propose your own research ideas that align with our ongoing projects."] in
248
+
249
+
let page_footer = Arod_footer.footer in
250
+
let page_content = El.splice [
251
+
El.article [
252
+
El.h1 [El.txt title];
253
+
intro;
254
+
El.splice project_sections
255
+
];
256
+
El.aside [
257
+
status_filter
258
+
]
259
+
] in
260
+
Arod_page.page ~title ~page_content ~page_footer ~description ()
+202
arod/lib/arod_jsonfeed.ml
+202
arod/lib/arod_jsonfeed.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JSON feed generation for Arod webserver *)
7
+
8
+
module E = Arod_model.Entry
9
+
module N = Arod_model.Note
10
+
module C = Sortal_schema.Contact
11
+
module P = Arod_model.Paper
12
+
module J = Jsonfeed
13
+
14
+
let form_uri cfg path = cfg.Arod_config.site.base_url ^ path
15
+
16
+
let author cfg c =
17
+
let name = C.name c in
18
+
let url = match C.orcid c with
19
+
| Some orcid -> Some (Printf.sprintf "https://orcid.org/%s" orcid)
20
+
| None -> C.best_url c
21
+
in
22
+
let avatar = Some (form_uri cfg "/images/anil-headshot.webp") in
23
+
Jsonfeed.Author.create ?name:(Some name) ?url ?avatar ()
24
+
25
+
let item_of_note cfg note =
26
+
let e = `Note note in
27
+
let id = match N.doi note with
28
+
| Some doi ->
29
+
let is_valid_doi =
30
+
not (String.contains doi ' ') &&
31
+
not (String.contains doi '\t') &&
32
+
not (String.contains doi '\n') &&
33
+
String.length doi > 0
34
+
in
35
+
if is_valid_doi then
36
+
Printf.sprintf "https://doi.org/%s" doi
37
+
else
38
+
let note_title = N.title note in
39
+
failwith (Printf.sprintf "Invalid DOI in note '%s': '%s'" note_title doi)
40
+
| None -> form_uri cfg (E.site_url e)
41
+
in
42
+
let url = form_uri cfg (E.site_url e) in
43
+
let title = N.title note in
44
+
let date_published = N.origdate note in
45
+
let date_modified = N.datetime note in
46
+
let tags = N.tags note in
47
+
48
+
let base_html = Arod_view.md_to_atom_html note.N.body in
49
+
50
+
let is_perma = N.perma note in
51
+
let has_doi = match N.doi note with Some _ -> true | None -> false in
52
+
let html_with_refs =
53
+
if is_perma || has_doi then
54
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
55
+
| Some c -> c
56
+
| None -> failwith "Author not found"
57
+
in
58
+
let references = Bushel.Md.note_references (Arod_model.get_entries ()) me note in
59
+
if List.length references > 0 then
60
+
let refs_html =
61
+
let ref_items = List.map (fun (doi, citation, _) ->
62
+
let doi_url = Printf.sprintf "https://doi.org/%s" doi in
63
+
Printf.sprintf "<li>%s<a href=\"%s\" target=\"_blank\"><i>%s</i></a></li>"
64
+
citation doi_url doi
65
+
) references |> String.concat "\n" in
66
+
Printf.sprintf "<h1>References</h1><ul>%s</ul>" ref_items
67
+
in
68
+
base_html ^ refs_html
69
+
else
70
+
base_html
71
+
else
72
+
base_html
73
+
in
74
+
let content = `Html html_with_refs in
75
+
76
+
let external_url = match note.N.via with
77
+
| Some (_title, via_url) -> Some via_url
78
+
| None ->
79
+
match N.link note with
80
+
| `Local _ -> None
81
+
| `Ext (_l, u) -> Some u
82
+
in
83
+
84
+
let image = match note.N.titleimage with
85
+
| Some img_slug ->
86
+
(try
87
+
let entries = Arod_model.get_entries () in
88
+
(match E.lookup_image entries img_slug with
89
+
| Some img_ent ->
90
+
let target_width = 1280 in
91
+
let open Arod_model.Img in
92
+
let variants = MS.bindings img_ent.variants in
93
+
let best_variant =
94
+
match variants with
95
+
| [] ->
96
+
Printf.sprintf "%s.webp" (Filename.chop_extension (origin img_ent))
97
+
| _ ->
98
+
let sorted = List.sort (fun (_f1,(w1,_h1)) (_f2,(w2,_h2)) ->
99
+
let diff1 = abs (w1 - target_width) in
100
+
let diff2 = abs (w2 - target_width) in
101
+
compare diff1 diff2
102
+
) variants in
103
+
fst (List.hd sorted)
104
+
in
105
+
Some (Printf.sprintf "%s/images/%s" cfg.Arod_config.site.base_url best_variant)
106
+
| None -> None)
107
+
with Not_found -> None)
108
+
| None -> None
109
+
in
110
+
111
+
let summary = note.N.synopsis in
112
+
113
+
let attachments = match N.slug_ent note with
114
+
| Some slug ->
115
+
(match Arod_model.lookup slug with
116
+
| Some (`Paper p) ->
117
+
let slug = P.slug p in
118
+
let pdf_path = Filename.concat cfg.Arod_config.paths.static_dir
119
+
(Printf.sprintf "papers/%s.pdf" slug) in
120
+
if Sys.file_exists pdf_path then
121
+
let pdf_url = form_uri cfg (Printf.sprintf "/papers/%s.pdf" slug) in
122
+
let pdf_title = P.title p in
123
+
[J.Attachment.create ~url:pdf_url ~mime_type:"application/pdf" ~title:pdf_title ()]
124
+
else
125
+
(match P.best_url p with
126
+
| Some url when String.ends_with ~suffix:".pdf" url ->
127
+
let pdf_url = form_uri cfg url in
128
+
let pdf_title = P.title p in
129
+
[J.Attachment.create ~url:pdf_url ~mime_type:"application/pdf" ~title:pdf_title ()]
130
+
| _ -> [])
131
+
| _ -> [])
132
+
| None -> []
133
+
in
134
+
135
+
let references =
136
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
137
+
| Some c -> c
138
+
| None -> failwith "Author not found"
139
+
in
140
+
Bushel.Md.note_references (Arod_model.get_entries ()) me note
141
+
|> List.map (fun (doi, _citation, ref_source) ->
142
+
let doi_url = Printf.sprintf "https://doi.org/%s" doi in
143
+
let cito = match ref_source with
144
+
| Bushel.Md.Paper -> [`CitesAsSourceDocument]
145
+
| Bushel.Md.Note -> [`CitesAsRelated]
146
+
| Bushel.Md.External -> [`Cites]
147
+
in
148
+
J.Reference.create ~url:doi_url ~doi ~cito ()
149
+
)
150
+
in
151
+
152
+
let json_author = author cfg (Arod_model.lookup_by_handle cfg.site.author_handle |> Option.get) in
153
+
154
+
Jsonfeed.Item.create
155
+
~id
156
+
~content
157
+
~url
158
+
?external_url
159
+
?image
160
+
?summary
161
+
~title
162
+
~date_published
163
+
~date_modified
164
+
~authors:[json_author]
165
+
~tags
166
+
~attachments
167
+
~references
168
+
()
169
+
170
+
let item_of_entry cfg (e:Arod_model.Entry.entry) =
171
+
match e with
172
+
| `Note n -> Some (item_of_note cfg n)
173
+
| _ -> None
174
+
175
+
let feed cfg uri entries =
176
+
let title = cfg.Arod_config.site.name ^ "'s feed" in
177
+
let home_page_url = cfg.site.base_url in
178
+
let feed_url = form_uri cfg uri in
179
+
let icon = cfg.site.base_url ^ "/assets/favicon.ico" in
180
+
let json_author = author cfg (Arod_model.lookup_by_handle cfg.site.author_handle |> Option.get) in
181
+
let authors = [json_author] in
182
+
let language = "en-US" in
183
+
184
+
let items = List.filter_map (item_of_entry cfg) entries in
185
+
186
+
Jsonfeed.create
187
+
~title
188
+
~home_page_url
189
+
~feed_url
190
+
~icon
191
+
~authors
192
+
~language
193
+
~items
194
+
()
195
+
196
+
let feed_string cfg uri entries =
197
+
let f = feed cfg uri entries in
198
+
match Jsonfeed.to_string f with
199
+
| Ok s -> s
200
+
| Error e ->
201
+
let msg = Fmt.str "Failed to encode JSON Feed: %a" Jsont.Error.pp e in
202
+
failwith msg
+222
arod/lib/arod_model.ml
+222
arod/lib/arod_model.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Model layer bridging Bushel to the Arod webserver *)
7
+
8
+
(** Re-export Bushel modules for convenience *)
9
+
module Paper = Bushel.Paper
10
+
module Note = Bushel.Note
11
+
module Idea = Bushel.Idea
12
+
module Project = Bushel.Project
13
+
module Video = Bushel.Video
14
+
module Entry = Bushel.Entry
15
+
module Tags = Bushel.Tags
16
+
module Md = Bushel.Md
17
+
module Util = Bushel.Util
18
+
module Img = Srcsetter
19
+
module Contact = Sortal_schema.Contact
20
+
21
+
(** {1 Global State} *)
22
+
23
+
(** The loaded entries - set once at startup *)
24
+
let entries : Bushel.Entry.t option ref = ref None
25
+
26
+
(** The site configuration *)
27
+
let config : Arod_config.t option ref = ref None
28
+
29
+
(** Get the loaded entries, raising if not initialized *)
30
+
let get_entries () =
31
+
match !entries with
32
+
| Some e -> e
33
+
| None -> failwith "Arod_model: entries not loaded"
34
+
35
+
(** Get the site config *)
36
+
let get_config () =
37
+
match !config with
38
+
| Some c -> c
39
+
| None -> Arod_config.default
40
+
41
+
(** {1 Initialization} *)
42
+
43
+
(** Load entries from the configured data directory *)
44
+
let init ~cfg fs =
45
+
config := Some cfg;
46
+
let image_output_dir = cfg.Arod_config.paths.images_dir in
47
+
let data_dir = cfg.paths.data_dir in
48
+
let loaded = Bushel_eio.Bushel_loader.load ~image_output_dir fs data_dir in
49
+
entries := Some loaded;
50
+
loaded
51
+
52
+
(** {1 Lookup Functions} *)
53
+
54
+
let lookup slug =
55
+
Entry.lookup (get_entries ()) slug
56
+
57
+
let lookup_exn slug =
58
+
Entry.lookup_exn (get_entries ()) slug
59
+
60
+
let lookup_image slug =
61
+
Entry.lookup_image (get_entries ()) slug
62
+
63
+
let lookup_by_handle handle =
64
+
let contacts = Entry.contacts (get_entries ()) in
65
+
List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) contacts
66
+
67
+
let lookup_by_name name =
68
+
Entry.lookup_by_name (get_entries ()) name
69
+
70
+
(** {1 Entry Accessors} *)
71
+
72
+
let papers () = Entry.papers (get_entries ())
73
+
let notes () = Entry.notes (get_entries ())
74
+
let ideas () = Entry.ideas (get_entries ())
75
+
let projects () = Entry.projects (get_entries ())
76
+
let videos () = Entry.videos (get_entries ())
77
+
let contacts () = Entry.contacts (get_entries ())
78
+
let images () = Entry.images (get_entries ())
79
+
let all_entries () = Entry.all_entries (get_entries ())
80
+
81
+
(** {1 Author/Site Identity} *)
82
+
83
+
let author () =
84
+
let cfg = get_config () in
85
+
lookup_by_handle cfg.site.author_handle
86
+
87
+
let author_name () =
88
+
match author () with
89
+
| Some c -> Sortal_schema.Contact.name c
90
+
| None -> (get_config ()).site.author_name
91
+
92
+
let base_url () = (get_config ()).site.base_url
93
+
let site_name () = (get_config ()).site.name
94
+
let site_description () = (get_config ()).site.description
95
+
96
+
(** {1 Markdown Rendering} *)
97
+
98
+
(** Custom HTML renderer for Cmarkit that handles Bushel extensions *)
99
+
let custom_html_renderer () =
100
+
let open Cmarkit in
101
+
let open Cmarkit_renderer.Context in
102
+
let inline c = function
103
+
| Inline.Image (img, _meta) ->
104
+
(* Handle bushel image syntax - :slug format *)
105
+
(match Inline.Link.reference img with
106
+
| `Inline (ld, _) ->
107
+
(match Link_definition.dest ld with
108
+
| Some (src, _) when Md.is_bushel_slug src ->
109
+
let slug = Md.strip_handle src in
110
+
let title = match Link_definition.title ld with
111
+
| Some lines -> String.concat "" (List.map Block_line.tight_to_string lines)
112
+
| None -> ""
113
+
in
114
+
let caption =
115
+
Inline.Link.text img
116
+
|> Inline.to_plain_text ~break_on_soft:false
117
+
|> fun r -> String.concat "\n" (List.map (String.concat "") r)
118
+
in
119
+
(* Check if this is a video *)
120
+
(match lookup slug with
121
+
| Some (`Video v) ->
122
+
let video_url = Video.url v in
123
+
let embed_url =
124
+
let uri = Uri.of_string video_url in
125
+
let path = Uri.path uri |> String.split_on_char '/' in
126
+
let path = List.map (function "watch" -> "embed" | p -> p) path in
127
+
Uri.with_path uri (String.concat "/" path) |> Uri.to_string
128
+
in
129
+
let html = Printf.sprintf
130
+
{|<div class="video-center"><iframe title="%s" width="100%%" height="315px" src="%s" frameborder="0" allowfullscreen sandbox="allow-same-origin allow-scripts allow-popups allow-forms"></iframe></div>|}
131
+
title embed_url
132
+
in
133
+
string c html;
134
+
true
135
+
| _ ->
136
+
(* Image handling *)
137
+
let img_info = lookup_image slug in
138
+
let dest = match img_info with
139
+
| Some img -> "/images/" ^ Img.name img
140
+
| None -> "/images/" ^ slug ^ ".webp"
141
+
in
142
+
let srcset_attr = match img_info with
143
+
| Some img ->
144
+
let variants = Img.variants img in
145
+
let parts = Img.MS.fold (fun name (w, _) acc ->
146
+
Printf.sprintf "/images/%s %dw" name w :: acc
147
+
) variants [] in
148
+
if parts = [] then ""
149
+
else Printf.sprintf " srcset=\"%s\"" (String.concat ", " parts)
150
+
| None -> ""
151
+
in
152
+
(* Check for positioning directive *)
153
+
(match caption with
154
+
| "%c" | "%r" | "%lc" | "%rc" ->
155
+
let fig_class = match caption with
156
+
| "%c" -> "image-center"
157
+
| "%r" -> "image-right"
158
+
| "%lc" -> "image-left-float"
159
+
| "%rc" -> "image-right-float"
160
+
| _ -> "image-center"
161
+
in
162
+
let html = Printf.sprintf
163
+
{|<figure class="%s"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy"%s sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|}
164
+
fig_class dest title title srcset_attr title
165
+
in
166
+
string c html;
167
+
true
168
+
| _ ->
169
+
(* Regular image with content-image class for lightbox *)
170
+
let html = Printf.sprintf
171
+
{|<img class="content-image" src="%s" alt="%s" title="%s" loading="lazy"%s sizes="(max-width: 768px) 100vw, 33vw">|}
172
+
dest caption title srcset_attr
173
+
in
174
+
string c html;
175
+
true))
176
+
| _ -> false)
177
+
| _ -> false)
178
+
| _ -> false
179
+
in
180
+
let default = Cmarkit_html.renderer ~safe:false () in
181
+
Cmarkit_renderer.compose default (Cmarkit_renderer.make ~inline ())
182
+
183
+
(** Convert markdown to HTML with Bushel link resolution *)
184
+
let md_to_html ?renderer md =
185
+
let open Cmarkit in
186
+
let doc = Doc.of_string ~strict:false ~resolver:Md.with_bushel_links md in
187
+
let mapper = Mapper.make ~inline:(Md.make_link_only_mapper (get_entries ())) () in
188
+
let mapped_doc = Mapper.map_doc mapper doc in
189
+
let r = match renderer with Some r -> r | None -> custom_html_renderer () in
190
+
Cmarkit_renderer.doc_to_string r mapped_doc
191
+
192
+
(** {1 Tag Helpers} *)
193
+
194
+
let tags_of_ent ent =
195
+
Entry.tags_of_ent (get_entries ()) ent
196
+
197
+
let concat_tags tags1 tags2 =
198
+
List.sort_uniq compare (tags1 @ tags2)
199
+
200
+
(** Count tags across all entries *)
201
+
let count_tags_for_ents entries =
202
+
let counts = Hashtbl.create 32 in
203
+
List.iter (fun ent ->
204
+
let tags = Entry.tags_of_ent (get_entries ()) ent in
205
+
List.iter (fun tag ->
206
+
let current = Hashtbl.find_opt counts tag |> Option.value ~default:0 in
207
+
Hashtbl.replace counts tag (current + 1)
208
+
) tags
209
+
) entries;
210
+
counts
211
+
212
+
(** Get category tags with counts for the header navigation *)
213
+
let cats () =
214
+
let entries = all_entries () in
215
+
let counts = count_tags_for_ents entries in
216
+
Hashtbl.fold (fun k v acc ->
217
+
match k with
218
+
| `Set "videos" -> acc (* Skip videos, use talks instead *)
219
+
| `Set _ -> (k, v) :: acc
220
+
| _ -> acc
221
+
) counts []
222
+
|> List.sort (fun (a, _) (b, _) -> compare (Tags.to_string a) (Tags.to_string b))
+32
arod/lib/arod_notes.ml
+32
arod/lib/arod_notes.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Note rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
10
+
let note_for_feed n =
11
+
let (body_html, word_count_info) = Arod_view.truncated_body (`Note n) in
12
+
(body_html, word_count_info)
13
+
14
+
let one_note_brief n =
15
+
let (body_html, word_count_info) = Arod_view.truncated_body (`Note n) in
16
+
(El.splice [
17
+
Arod_view.entry_href (`Note n);
18
+
body_html
19
+
], word_count_info)
20
+
21
+
let one_note_full n =
22
+
let body = Arod_model.Note.body n in
23
+
let body_with_ref = match Arod_model.Note.slug_ent n with
24
+
| None -> body
25
+
| Some slug_ent ->
26
+
let parent_ent = Arod_model.lookup_exn slug_ent in
27
+
let parent_title = Arod_model.Entry.title parent_ent in
28
+
body ^ "\n\nRead more about [" ^ parent_title ^ "](:" ^ slug_ent ^ ")."
29
+
in
30
+
El.div ~at:[At.class' "note"] [
31
+
El.unsafe_raw (Arod_view.md_to_html body_with_ref)
32
+
]
+300
arod/lib/arod_page.ml
+300
arod/lib/arod_page.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Page layout for Arod webserver *)
7
+
8
+
open Htmlit
9
+
10
+
(** SVG icons for navigation *)
11
+
let svg_icon_paper =
12
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M16 7 C16 7 9 1 2 6 L2 28 C9 23 16 28 16 28 16 28 23 23 30 28 L30 6 C23 1 16 7 16 7 Z M16 7 L16 28" /></svg>|}
13
+
14
+
let svg_icon_project =
15
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M30 8 L2 8 2 26 30 26 Z M20 8 C20 8 20 4 16 4 12 4 12 8 12 8 M8 26 L8 8 M24 26 L24 8" /></svg>|}
16
+
17
+
let svg_icon_note =
18
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M27 15 L27 30 2 30 2 5 17 5 M30 6 L26 2 9 19 7 25 13 23 Z M22 6 L26 10 Z M9 19 L13 23 Z" /></svg>|}
19
+
20
+
let svg_icon_video =
21
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M22 13 L30 8 30 24 22 19 Z M2 8 L2 24 22 24 22 8 Z" /></svg>|}
22
+
23
+
let svg_icon_idea =
24
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M18 13 L26 2 8 13 14 19 6 30 24 19 Z" /></svg>|}
25
+
26
+
let svg_icon_search =
27
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 24 24" width="18" height="18" fill="none" stroke="currentColor" stroke-width="2" stroke-linecap="round" stroke-linejoin="round"><circle cx="11" cy="11" r="8"/><path d="m21 21-4.35-4.35"/></svg>|}
28
+
29
+
(** Search modal HTML *)
30
+
let search_modal =
31
+
El.div ~at:[At.class' "search-modal"; At.id "search-modal"] [
32
+
El.div ~at:[At.class' "search-modal-content"] [
33
+
El.div ~at:[At.class' "search-modal-header"] [
34
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 24 24" width="20" height="20" fill="none" stroke="currentColor" stroke-width="2" stroke-linecap="round" stroke-linejoin="round"><circle cx="11" cy="11" r="8"/><path d="m21 21-4.35-4.35"/></svg>|};
35
+
El.input ~at:[
36
+
At.class' "search-modal-input";
37
+
At.id "search-modal-input";
38
+
At.type' "text";
39
+
At.v "placeholder" "Search papers, notes, videos, projects...";
40
+
At.v "autocomplete" "off"
41
+
] ();
42
+
El.button ~at:[At.class' "search-modal-close"; At.id "search-modal-close"] [
43
+
El.txt "×"
44
+
]
45
+
];
46
+
El.div ~at:[At.class' "search-filters"; At.id "search-filters"] [
47
+
El.div ~at:[At.class' "search-filters-controls"] [
48
+
El.button ~at:[At.class' "search-filter-toggle"; At.id "filter-toggle-all"] [El.txt "All"];
49
+
El.button ~at:[At.class' "search-filter-toggle"; At.id "filter-toggle-none"] [El.txt "None"]
50
+
];
51
+
El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "papers"] [El.txt "Papers"];
52
+
El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "notes"] [El.txt "Notes"];
53
+
El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "videos"] [El.txt "Videos"];
54
+
El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "projects"] [El.txt "Projects"];
55
+
El.button ~at:[At.class' "search-filter active"; At.v "data-collection" "ideas"] [El.txt "Ideas"]
56
+
];
57
+
El.div ~at:[At.class' "search-modal-body"; At.id "search-modal-body"] [
58
+
El.div ~at:[At.class' "search-loading"] [
59
+
El.txt "Loading recent items..."
60
+
]
61
+
];
62
+
El.div ~at:[At.class' "search-modal-footer"] [
63
+
El.div ~at:[At.class' "search-status"; At.id "search-status"] [
64
+
El.span ~at:[At.class' "search-status-indicator"] [];
65
+
El.span ~at:[At.class' "search-status-text"] [El.txt "Ready"]
66
+
];
67
+
El.div ~at:[At.class' "search-keyboard-hint"] [
68
+
El.span [
69
+
El.unsafe_raw {|<kbd>↑</kbd> <kbd>↓</kbd>|};
70
+
El.txt " navigate"
71
+
];
72
+
El.span [
73
+
El.unsafe_raw {|<kbd>↵</kbd>|};
74
+
El.txt " select"
75
+
];
76
+
El.span [
77
+
El.unsafe_raw {|<kbd>ESC</kbd>|};
78
+
El.txt " close"
79
+
]
80
+
]
81
+
]
82
+
]
83
+
]
84
+
85
+
let page ?(image="/assets/imagetitle-default.jpg") ?(jsonld="") ?standardsite ?(page_footer=El.splice []) ~title ~description ~page_content:content () =
86
+
let cfg = Arod_model.get_config () in
87
+
let page_title = if title = "" then cfg.site.name else title in
88
+
89
+
let head_els = [
90
+
El.meta ~at:[At.v "http-equiv" "X-UA-Compatible"; At.content "ie=edge"] ();
91
+
El.meta ~at:[At.name "description"; At.content description] ();
92
+
El.meta ~at:[At.v "property" "og:image"; At.content image] ();
93
+
El.meta ~at:[At.v "property" "og:site_name"; At.content cfg.site.name] ();
94
+
El.meta ~at:[At.v "property" "og:type"; At.content "object"] ();
95
+
El.meta ~at:[At.v "property" "og:title"; At.content page_title] ();
96
+
El.meta ~at:[At.v "property" "og:description"; At.content description] ();
97
+
El.meta ~at:[At.name "twitter:card"; At.content "summary_large_image"] ();
98
+
El.meta ~at:[At.name "twitter:title"; At.content page_title] ();
99
+
El.meta ~at:[At.name "twitter:description"; At.content description] ();
100
+
El.meta ~at:[At.name "twitter:image"; At.content image] ();
101
+
El.meta ~at:[At.name "theme-color"; At.content "#fff"] ();
102
+
El.meta ~at:[At.name "color-scheme"; At.content "white"] ();
103
+
El.link ~at:[At.rel "apple-touch-icon"; At.v "sizes" "180x180"; At.href "/assets/apple-touch-icon.png"] ();
104
+
El.link ~at:[At.rel "icon"; At.type' "image/png"; At.v "sizes" "32x32"; At.href "/assets/favicon-32x32.png"] ();
105
+
El.link ~at:[At.rel "icon"; At.type' "image/png"; At.v "sizes" "16x16"; At.href "/assets/favicon-16x16.png"] ();
106
+
El.link ~at:[At.rel "alternate"; At.type' "application/atom+xml"; At.title "Atom Feed"; At.href "/news.xml"] ();
107
+
El.link ~at:[At.rel "alternate"; At.type' "application/atom+xml"; At.title "Perma Feed (Significant Articles)"; At.href "/perma.xml"] ();
108
+
El.link ~at:[At.rel "alternate"; At.type' "application/feed+json"; At.title "JSON Feed"; At.href "/feed.json"] ();
109
+
El.link ~at:[At.rel "alternate"; At.type' "application/feed+json"; At.title "Perma JSON Feed (Significant Articles)"; At.href "/perma.json"] ();
110
+
El.link ~at:[At.rel "stylesheet"; At.href "/assets/site.css"] ();
111
+
El.link ~at:[At.rel "stylesheet"; At.href "/assets/highlight.min.css"] ();
112
+
El.unsafe_raw jsonld;
113
+
El.script ~at:[At.src "/assets/highlight.min.js"] [];
114
+
El.script [El.txt "hljs.highlightAll();"]
115
+
] in
116
+
117
+
(* Add standardsite link if present *)
118
+
let head_els = match standardsite with
119
+
| Some url -> head_els @ [El.link ~at:[At.rel "site.standard.document"; At.href url] ()]
120
+
| None -> head_els
121
+
in
122
+
123
+
let header_el = El.header ~at:[At.class' "site-header"] [
124
+
El.div ~at:[At.class' "header-content"] [
125
+
(* Site name on the left *)
126
+
El.h1 ~at:[At.class' "site-name"] [
127
+
El.a ~at:[At.href "/"] [El.txt cfg.site.name]
128
+
];
129
+
(* Navigation links *)
130
+
El.nav ~at:[At.class' "main-nav"] [
131
+
El.a ~at:[At.class' "nav-link"; At.href "/papers"] [
132
+
svg_icon_paper;
133
+
El.txt "Papers"
134
+
];
135
+
El.a ~at:[At.class' "nav-link"; At.href "/projects"] [
136
+
svg_icon_project;
137
+
El.txt "Projects"
138
+
];
139
+
El.a ~at:[At.class' "nav-link"; At.href "/notes"] [
140
+
svg_icon_note;
141
+
El.txt "Notes"
142
+
];
143
+
El.a ~at:[At.class' "nav-link"; At.href "/videos"] [
144
+
svg_icon_video;
145
+
El.txt "Talks"
146
+
];
147
+
El.a ~at:[At.class' "nav-link"; At.href "/ideas"] [
148
+
svg_icon_idea;
149
+
El.txt "Ideas"
150
+
]
151
+
];
152
+
(* Right side: Search *)
153
+
El.div ~at:[At.class' "header-right"] [
154
+
El.div ~at:[At.class' "search-container"] [
155
+
El.button ~at:[
156
+
At.class' "search-toggle";
157
+
At.v "aria-label" "Search";
158
+
At.id "search-toggle-btn"
159
+
] [
160
+
svg_icon_search;
161
+
El.span ~at:[At.class' "search-label"] [El.txt "Search"]
162
+
]
163
+
]
164
+
]
165
+
]
166
+
] in
167
+
168
+
let footer_el = El.footer [page_footer] in
169
+
170
+
let body_el = El.body ~at:[At.class' "light"] [
171
+
header_el;
172
+
El.div ~at:[At.class' "content-grid"] [content];
173
+
footer_el;
174
+
search_modal;
175
+
El.script ~at:[At.src "/assets/site.js"] []
176
+
] in
177
+
178
+
El.page ~lang:"en" ~title:page_title ~more_head:(El.splice head_els) body_el
179
+
180
+
let bushel_graph () =
181
+
let title = "Bushel Link Graph" in
182
+
let description = "Interactive force-directed graph visualization of links and backlinks in the Bushel dataset" in
183
+
184
+
let graph_html = El.div [
185
+
El.h1 [El.txt "Bushel Link Graph"];
186
+
187
+
El.div ~at:[At.id "controls"; At.style "margin: 20px 0; padding: 15px; background: #f5f5f5; border-radius: 5px;"] [
188
+
El.div ~at:[At.style "margin-bottom: 10px;"] [
189
+
El.strong [El.txt "Filter by type: "];
190
+
El.label ~at:[At.style "margin: 0 10px;"] [
191
+
El.input ~at:[At.type' "checkbox"; At.id "filter-paper"; At.checked; At.class' "type-filter"] ();
192
+
El.txt " Papers"
193
+
];
194
+
El.label ~at:[At.style "margin: 0 10px;"] [
195
+
El.input ~at:[At.type' "checkbox"; At.id "filter-project"; At.checked; At.class' "type-filter"] ();
196
+
El.txt " Projects"
197
+
];
198
+
El.label ~at:[At.style "margin: 0 10px;"] [
199
+
El.input ~at:[At.type' "checkbox"; At.id "filter-note"; At.checked; At.class' "type-filter"] ();
200
+
El.txt " Notes"
201
+
];
202
+
El.label ~at:[At.style "margin: 0 10px;"] [
203
+
El.input ~at:[At.type' "checkbox"; At.id "filter-idea"; At.checked; At.class' "type-filter"] ();
204
+
El.txt " Ideas"
205
+
];
206
+
El.label ~at:[At.style "margin: 0 10px;"] [
207
+
El.input ~at:[At.type' "checkbox"; At.id "filter-video"; At.checked; At.class' "type-filter"] ();
208
+
El.txt " Videos"
209
+
];
210
+
El.label ~at:[At.style "margin: 0 10px;"] [
211
+
El.input ~at:[At.type' "checkbox"; At.id "filter-contact"; At.checked; At.class' "type-filter"] ();
212
+
El.txt " Contacts"
213
+
];
214
+
El.label ~at:[At.style "margin: 0 10px;"] [
215
+
El.input ~at:[At.type' "checkbox"; At.id "filter-domain"; At.checked; At.class' "type-filter"] ();
216
+
El.txt " Domains"
217
+
]
218
+
];
219
+
El.div ~at:[At.style "margin-bottom: 10px;"] [
220
+
El.strong [El.txt "Link type: "];
221
+
El.label ~at:[At.style "margin: 0 10px;"] [
222
+
El.input ~at:[At.type' "checkbox"; At.id "filter-internal"; At.checked; At.class' "link-filter"] ();
223
+
El.txt " Internal"
224
+
];
225
+
El.label ~at:[At.style "margin: 0 10px;"] [
226
+
El.input ~at:[At.type' "checkbox"; At.id "filter-external"; At.checked; At.class' "link-filter"] ();
227
+
El.txt " External"
228
+
]
229
+
];
230
+
El.div [
231
+
El.button ~at:[At.id "reset-filters"; At.style "padding: 5px 15px; cursor: pointer;"] [El.txt "Reset Filters"]
232
+
]
233
+
];
234
+
235
+
El.div ~at:[At.id "graph"; At.style "width: 100%; height: 800px; border: 1px solid #ddd;"] [];
236
+
237
+
El.script ~at:[At.src "https://d3js.org/d3.v7.min.js"] [];
238
+
239
+
El.script [El.unsafe_raw {|
240
+
fetch('/bushel/graph.json')
241
+
.then(response => response.json())
242
+
.then(data => { initGraph(data); })
243
+
.catch(error => {
244
+
console.error('Error loading graph data:', error);
245
+
document.getElementById('graph').innerHTML = '<p style="color: red;">Error loading graph data</p>';
246
+
});
247
+
248
+
function initGraph(graphData) {
249
+
const width = document.getElementById('graph').offsetWidth;
250
+
const height = 800;
251
+
const colors = {
252
+
'paper': '#4285f4', 'project': '#ea4335', 'note': '#fbbc04',
253
+
'idea': '#34a853', 'video': '#ff6d00', 'contact': '#9c27b0', 'domain': '#607d8b'
254
+
};
255
+
const svg = d3.select('#graph').append('svg').attr('width', width).attr('height', height);
256
+
const g = svg.append('g');
257
+
svg.call(d3.zoom().scaleExtent([0.1, 4]).on('zoom', (event) => g.attr('transform', event.transform)));
258
+
const simulation = d3.forceSimulation(graphData.nodes)
259
+
.force('link', d3.forceLink(graphData.links).id(d => d.id).distance(d => d.type === 'external' ? 150 : 100))
260
+
.force('charge', d3.forceManyBody().strength(-300))
261
+
.force('center', d3.forceCenter(width / 2, height / 2))
262
+
.force('collision', d3.forceCollide().radius(30));
263
+
const link = g.append('g').selectAll('line').data(graphData.links).join('line')
264
+
.attr('class', d => 'link link-' + d.type)
265
+
.attr('stroke', d => d.type === 'internal' ? '#999' : '#ccc')
266
+
.attr('stroke-opacity', 0.6).attr('stroke-width', 1);
267
+
const node = g.append('g').selectAll('g').data(graphData.nodes).join('g')
268
+
.attr('class', d => 'node node-' + d.type).style('cursor', 'pointer')
269
+
.call(d3.drag().on('start', dragstarted).on('drag', dragged).on('end', dragended));
270
+
node.append('circle').attr('r', d => d.group === 'domain' ? 8 : 10)
271
+
.attr('fill', d => colors[d.type] || '#999').attr('stroke', '#fff').attr('stroke-width', 2);
272
+
node.append('text').text(d => d.group === 'domain' ? d.title : d.id)
273
+
.attr('x', 12).attr('y', 4).attr('font-size', '10px').attr('fill', '#333');
274
+
node.append('title').text(d => d.title + '\nType: ' + d.type);
275
+
simulation.on('tick', () => {
276
+
link.attr('x1', d => d.source.x).attr('y1', d => d.source.y).attr('x2', d => d.target.x).attr('y2', d => d.target.y);
277
+
node.attr('transform', d => 'translate(' + d.x + ',' + d.y + ')');
278
+
});
279
+
function dragstarted(event) { if (!event.active) simulation.alphaTarget(0.3).restart(); event.subject.fx = event.subject.x; event.subject.fy = event.subject.y; }
280
+
function dragged(event) { event.subject.fx = event.x; event.subject.fy = event.y; }
281
+
function dragended(event) { if (!event.active) simulation.alphaTarget(0); event.subject.fx = null; event.subject.fy = null; }
282
+
function updateFilters() {
283
+
const activeTypes = new Set();
284
+
document.querySelectorAll('.type-filter').forEach(cb => { if (cb.checked) activeTypes.add(cb.id.replace('filter-', '')); });
285
+
const activeLinks = new Set();
286
+
document.querySelectorAll('.link-filter').forEach(cb => { if (cb.checked) activeLinks.add(cb.id.replace('filter-', '')); });
287
+
node.style('display', d => activeTypes.has(d.type) ? null : 'none');
288
+
link.style('display', d => (activeTypes.has(d.source.type) && activeTypes.has(d.target.type) && activeLinks.has(d.type)) ? null : 'none');
289
+
simulation.alpha(0.3).restart();
290
+
}
291
+
document.querySelectorAll('.type-filter, .link-filter').forEach(cb => cb.addEventListener('change', updateFilters));
292
+
document.getElementById('reset-filters').addEventListener('click', () => {
293
+
document.querySelectorAll('.type-filter, .link-filter').forEach(cb => cb.checked = true);
294
+
updateFilters();
295
+
});
296
+
}
297
+
|}]
298
+
] in
299
+
300
+
page ~title ~description ~page_content:graph_html ~page_footer:Arod_footer.footer ()
+214
arod/lib/arod_papers.ml
+214
arod/lib/arod_papers.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Paper rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
open Printf
10
+
11
+
module MP = Arod_model.Paper
12
+
module MC = Arod_model.Contact
13
+
14
+
(** Author name with text-wrap:nowrap *)
15
+
let author_name name =
16
+
El.span ~at:[At.style "text-wrap:nowrap"] [El.txt name]
17
+
18
+
(** Render one author - link to their best URL if available *)
19
+
let one_author author_name_str =
20
+
match Arod_model.lookup_by_name author_name_str with
21
+
| None ->
22
+
El.span ~at:[At.class' "author"] [author_name author_name_str]
23
+
| Some contact ->
24
+
let name = MC.name contact in
25
+
match MC.best_url contact with
26
+
| None ->
27
+
El.span ~at:[At.class' "author"] [author_name name]
28
+
| Some url ->
29
+
El.a ~at:[At.href url] [author_name name]
30
+
31
+
(** Render all authors with proper comma and "and" formatting *)
32
+
let authors p =
33
+
let author_names = MP.authors p in
34
+
let author_els = List.map one_author author_names in
35
+
match author_els with
36
+
| [] -> El.splice []
37
+
| [a] -> a
38
+
| els ->
39
+
let rec make_list = function
40
+
| [] -> []
41
+
| [x] -> [El.txt " and "; x]
42
+
| x :: xs -> x :: El.txt ", " :: make_list xs
43
+
in
44
+
El.splice (make_list els)
45
+
46
+
(** Generate publication info based on bibtype *)
47
+
let paper_publisher p =
48
+
let bibty = MP.bibtype p in
49
+
let ourl l = function
50
+
| None -> l
51
+
| Some u -> sprintf {|<a href="%s">%s</a>|} u l
52
+
in
53
+
let string_of_vol_issue p =
54
+
match (MP.volume p), (MP.number p) with
55
+
| Some v, Some n -> sprintf " (vol %s issue %s)" v n
56
+
| Some v, None -> sprintf " (vol %s)" v
57
+
| None, Some n -> sprintf " (issue %s)" n
58
+
| _ -> ""
59
+
in
60
+
let result = match String.lowercase_ascii bibty with
61
+
| "misc" ->
62
+
sprintf {|Working paper at %s|} (ourl (MP.publisher p) (MP.url p))
63
+
| "inproceedings" ->
64
+
sprintf {|Paper in the %s|} (ourl (MP.booktitle p) (MP.url p))
65
+
| "proceedings" ->
66
+
sprintf {|%s|} (ourl (MP.title p) (MP.url p))
67
+
| "abstract" ->
68
+
sprintf {|Abstract in the %s|} (ourl (MP.booktitle p) (MP.url p))
69
+
| "article" | "journal" ->
70
+
sprintf {|Journal paper in %s%s|} (ourl (MP.journal p) (MP.url p)) (string_of_vol_issue p)
71
+
| "book" ->
72
+
sprintf {|Book published by %s|} (ourl (MP.publisher p) (MP.url p))
73
+
| "techreport" ->
74
+
sprintf {|Technical report%s at %s|}
75
+
(match MP.number p with None -> "" | Some n -> " (" ^ n ^ ")")
76
+
(ourl (MP.institution p) (MP.url p))
77
+
| _ -> sprintf {|Publication in %s|} (ourl (MP.publisher p) (MP.url p))
78
+
in
79
+
El.unsafe_raw result
80
+
81
+
(** Extract host without www prefix *)
82
+
let host_without_www u =
83
+
match Uri.host (Uri.of_string u) with
84
+
| None -> ""
85
+
| Some h ->
86
+
if String.starts_with ~prefix:"www." h then
87
+
String.sub h 4 (String.length h - 4)
88
+
else h
89
+
90
+
(** Render the links bar (URL, DOI, BIB, PDF) *)
91
+
let paper_bar_for_feed ?(nopdf=false) p =
92
+
let cfg = Arod_model.get_config () in
93
+
let pdf =
94
+
let pdf_path = Filename.concat cfg.paths.static_dir (sprintf "papers/%s.pdf" (MP.slug p)) in
95
+
if Sys.file_exists pdf_path && not nopdf then
96
+
Some (El.a ~at:[At.href (sprintf "/papers/%s.pdf" (MP.slug p))] [
97
+
El.span ~at:[At.class' "nobreak"] [
98
+
El.txt "PDF";
99
+
El.img ~at:[At.class' "inline-icon"; At.alt "pdf"; At.src "/assets/pdf.svg"] ()
100
+
]
101
+
])
102
+
else None
103
+
in
104
+
let bib =
105
+
if nopdf then None
106
+
else Some (El.a ~at:[At.href (sprintf "/papers/%s.bib" (MP.slug p))] [El.txt "BIB"])
107
+
in
108
+
let url =
109
+
match MP.url p with
110
+
| None -> None
111
+
| Some u ->
112
+
Some (El.splice [
113
+
El.a ~at:[At.href u] [El.txt "URL"];
114
+
El.txt " ";
115
+
El.unsafe_raw (sprintf {|<i style="color: #666666">(%s)</i>|} (host_without_www u))
116
+
])
117
+
in
118
+
let doi =
119
+
match MP.doi p with
120
+
| None -> None
121
+
| Some d ->
122
+
Some (El.a ~at:[At.href ("https://doi.org/" ^ d)] [El.txt "DOI"])
123
+
in
124
+
let bits = [url; doi; bib; pdf] |> List.filter_map Fun.id in
125
+
El.splice ~sep:(El.unsafe_raw " ") bits
126
+
127
+
(** Render paper for feed/listing (blockquote style) *)
128
+
let paper_for_feed p =
129
+
let title_el = El.p ~at:[At.class' "paper-title"] [
130
+
El.a ~at:[At.href (Arod_model.Entry.site_url (`Paper p))] [El.txt (MP.title p)]
131
+
] in
132
+
(El.blockquote ~at:[At.class' "paper noquote"] [
133
+
El.div ~at:[At.class' "paper-info"] [
134
+
title_el;
135
+
El.p [authors p; El.txt "."];
136
+
El.p [paper_publisher p; El.txt "."];
137
+
El.p [paper_bar_for_feed p]
138
+
]
139
+
], None)
140
+
141
+
(** Render paper for entry listing *)
142
+
let paper_for_entry ?nopdf p =
143
+
(El.div ~at:[At.class' "paper"] [
144
+
El.div ~at:[At.class' "paper-info"] [
145
+
El.p ~at:[At.class' "paper-title"] [
146
+
El.a ~at:[At.href (Arod_model.Entry.site_url (`Paper p))] [El.txt (MP.title p)]
147
+
];
148
+
El.p [authors p; El.txt "."];
149
+
El.p [paper_publisher p; El.txt "."];
150
+
El.p [paper_bar_for_feed ?nopdf p]
151
+
]
152
+
], None)
153
+
154
+
(** Render older versions section for a paper *)
155
+
let one_paper_extra p =
156
+
let entries = Arod_model.get_entries () in
157
+
let all = Arod_model.Entry.old_papers entries
158
+
|> List.filter (fun op -> MP.slug op = MP.slug p)
159
+
in
160
+
match all with
161
+
| [] -> El.splice []
162
+
| all ->
163
+
let older_versions = List.map (fun op ->
164
+
let (paper_html, _) = paper_for_entry ~nopdf:true op in
165
+
El.splice [
166
+
El.hr ();
167
+
El.p [
168
+
El.txt ("This is " ^ op.Arod_model.Paper.ver ^ " of the publication from " ^
169
+
Arod_view.ptime_date ~with_d:false (MP.date op) ^ ".")
170
+
];
171
+
El.blockquote ~at:[At.class' "noquote"] [
172
+
paper_html
173
+
];
174
+
Arod_view.tags_meta (`Paper op)
175
+
]
176
+
) all in
177
+
El.splice [
178
+
El.h1 [El.txt "Older versions"];
179
+
El.p [
180
+
El.txt "There are earlier revisions of this paper available below for historical reasons. ";
181
+
El.txt "Please cite the latest version of the paper above instead of these."
182
+
];
183
+
El.splice older_versions
184
+
]
185
+
186
+
(** Render full paper page *)
187
+
let one_paper_full p =
188
+
let img_el =
189
+
match Arod_model.lookup_image (MP.slug p) with
190
+
| Some img ->
191
+
El.p [
192
+
El.a ~at:[At.href (Option.value ~default:"#" (MP.best_url p))] [
193
+
Arod_view.img ~cl:"image-center" img
194
+
]
195
+
]
196
+
| None -> El.splice []
197
+
in
198
+
let abstract_html =
199
+
let abstract = MP.abstract p in
200
+
if abstract <> "" then
201
+
El.p [El.unsafe_raw (Arod_view.md_to_html abstract)]
202
+
else
203
+
El.splice []
204
+
in
205
+
El.div ~at:[At.class' "paper"] [
206
+
El.div ~at:[At.class' "paper-info"] [
207
+
El.h2 [El.txt (MP.title p)];
208
+
El.p [authors p; El.txt "."];
209
+
El.p [paper_publisher p; El.txt "."];
210
+
El.p [paper_bar_for_feed p]
211
+
];
212
+
img_el;
213
+
abstract_html
214
+
]
+255
arod/lib/arod_projects.ml
+255
arod/lib/arod_projects.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Project rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
open Printf
10
+
11
+
module MP = Arod_model.Project
12
+
module StringSet = Set.Make(String)
13
+
14
+
let class_ c = At.class' c
15
+
16
+
let ideas_for_project entries project =
17
+
List.filter (fun i -> Arod_model.Idea.project i = project.MP.slug)
18
+
(Arod_model.Entry.ideas entries)
19
+
20
+
let project_for_feed p =
21
+
let (body_html, word_count_info) = Arod_view.truncated_body (`Project p) in
22
+
(El.div [body_html], word_count_info)
23
+
24
+
let one_project_brief p =
25
+
let entries = Arod_model.get_entries () in
26
+
let idea_items = ideas_for_project entries p
27
+
|> List.sort Arod_model.Idea.compare
28
+
|> List.map (fun i ->
29
+
El.li [Arod_ideas.idea_to_html_no_sidenotes i]
30
+
) in
31
+
let (body_html, word_count_info) = Arod_view.truncated_body (`Project p) in
32
+
(El.splice [
33
+
Arod_view.entry_href (`Project p);
34
+
body_html;
35
+
El.ul idea_items
36
+
], word_count_info)
37
+
38
+
let one_project_full p =
39
+
let entries = Arod_model.get_entries () in
40
+
let project_slug = p.MP.slug in
41
+
42
+
let backlink_slugs = Bushel.Link_graph.get_backlinks_for_slug project_slug in
43
+
let backlink_set = List.fold_left (fun acc slug ->
44
+
StringSet.add slug acc
45
+
) StringSet.empty backlink_slugs in
46
+
47
+
let all_entries = Arod_model.all_entries () in
48
+
49
+
let project_papers = List.filter (fun e ->
50
+
match e with
51
+
| `Paper paper -> List.mem project_slug (Arod_model.Paper.project_slugs paper)
52
+
| _ -> false
53
+
) all_entries |> List.sort (fun a b ->
54
+
compare (Arod_model.Entry.date b) (Arod_model.Entry.date a)
55
+
) in
56
+
57
+
let recent_activity = List.filter (fun e ->
58
+
match e with
59
+
| `Paper _ -> false
60
+
| _ -> StringSet.mem (Arod_model.Entry.slug e) backlink_set
61
+
) all_entries |> List.sort (fun a b ->
62
+
compare (Arod_model.Entry.date b) (Arod_model.Entry.date a)
63
+
) in
64
+
65
+
let activity_section =
66
+
if recent_activity = [] then El.splice []
67
+
else
68
+
let activity_items = List.map (fun ent ->
69
+
let icon_name = Arod_view.ent_to_icon ent in
70
+
let date_str = Arod_view.ptime_date ~with_d:false (Arod_model.Entry.date ent) in
71
+
72
+
let lookup_title slug =
73
+
match Arod_model.Entry.lookup entries slug with
74
+
| Some ent -> Some (Arod_model.Entry.title ent)
75
+
| None -> None
76
+
in
77
+
78
+
let description = match ent with
79
+
| `Paper paper -> Bushel.Description.paper_description paper ~date_str
80
+
| `Note n -> Bushel.Description.note_description n ~date_str ~lookup_fn:lookup_title
81
+
| `Idea i -> Bushel.Description.idea_description i ~date_str
82
+
| `Video v -> Bushel.Description.video_description v ~date_str ~lookup_fn:lookup_title
83
+
| `Project pr -> Bushel.Description.project_description pr
84
+
in
85
+
86
+
El.li [
87
+
El.img ~at:[
88
+
At.alt "icon";
89
+
At.class' "inline-icon";
90
+
At.src (sprintf "/assets/%s" icon_name)
91
+
] ();
92
+
El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [
93
+
El.txt (Arod_model.Entry.title ent)
94
+
];
95
+
El.txt " – ";
96
+
El.span ~at:[At.class' "activity-description"] [El.txt description]
97
+
]
98
+
) recent_activity in
99
+
El.splice [
100
+
El.h1 [El.txt "Activity"];
101
+
El.ul ~at:[At.class' "activity-list"] activity_items
102
+
]
103
+
in
104
+
105
+
let references_section =
106
+
if project_papers = [] then El.splice []
107
+
else
108
+
let paper_items = List.map (fun ent ->
109
+
match ent with
110
+
| `Paper paper -> Arod_papers.paper_for_entry paper |> fst
111
+
| _ -> El.splice []
112
+
) project_papers in
113
+
El.splice [
114
+
El.h1 [El.txt "References"];
115
+
El.splice paper_items
116
+
]
117
+
in
118
+
119
+
let title = MP.title p in
120
+
121
+
El.div ~at:[class_ "project"] [
122
+
El.h1 [El.txt title];
123
+
El.p [Arod_view.full_body (`Project p)];
124
+
activity_section;
125
+
references_section
126
+
]
127
+
128
+
let view_projects_timeline () =
129
+
let entries = Arod_model.get_entries () in
130
+
let all_projects = Arod_model.Entry.projects entries
131
+
|> List.sort MP.compare
132
+
|> List.rev in
133
+
134
+
if all_projects = [] then
135
+
El.div [El.txt "No projects found"]
136
+
else
137
+
let current_year = let (y, _, _), _ = Ptime.to_date_time (Ptime_clock.now ()) in y in
138
+
139
+
let project_cards = List.map (fun p ->
140
+
let start_year = p.MP.start in
141
+
let end_year = match p.MP.finish with Some y -> y | None -> current_year in
142
+
let duration = end_year - start_year in
143
+
144
+
let all_entries = Arod_model.all_entries () in
145
+
let project_slug = p.MP.slug in
146
+
147
+
let recent_papers = List.filter (fun e ->
148
+
match e with
149
+
| `Paper paper -> List.mem project_slug (Arod_model.Paper.project_slugs paper)
150
+
| _ -> false
151
+
) all_entries |> List.sort (fun a b ->
152
+
compare (Arod_model.Entry.date b) (Arod_model.Entry.date a)
153
+
) |> (fun l -> if List.length l > 3 then List.filteri (fun i _ -> i < 3) l else l) in
154
+
155
+
let backlink_slugs = Bushel.Link_graph.get_backlinks_for_slug project_slug in
156
+
let backlink_set = List.fold_left (fun acc slug ->
157
+
StringSet.add slug acc
158
+
) StringSet.empty backlink_slugs in
159
+
160
+
let recent_notes = List.filter (fun e ->
161
+
match e with
162
+
| `Note _ -> StringSet.mem (Arod_model.Entry.slug e) backlink_set
163
+
| _ -> false
164
+
) all_entries |> List.sort (fun a b ->
165
+
compare (Arod_model.Entry.date b) (Arod_model.Entry.date a)
166
+
) |> (fun l -> if List.length l > 3 then List.filteri (fun i _ -> i < 3) l else l) in
167
+
168
+
let recent_items_display =
169
+
let paper_items = List.map (fun ent ->
170
+
El.li [
171
+
El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [
172
+
El.txt (Arod_model.Entry.title ent)
173
+
]
174
+
]
175
+
) recent_papers in
176
+
let note_items = List.map (fun ent ->
177
+
El.li [
178
+
El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [
179
+
El.txt (Arod_model.Entry.title ent)
180
+
]
181
+
]
182
+
) recent_notes in
183
+
184
+
if paper_items = [] && note_items = [] then El.splice []
185
+
else
186
+
El.div ~at:[At.class' "project-recent-items"] [
187
+
(if paper_items <> [] then
188
+
El.div ~at:[At.class' "project-recent-column"] [
189
+
El.h4 [El.txt "Recent papers"];
190
+
El.ul paper_items
191
+
]
192
+
else El.splice []);
193
+
(if note_items <> [] then
194
+
El.div ~at:[At.class' "project-recent-column"] [
195
+
El.h4 [El.txt "Recent notes"];
196
+
El.ul note_items
197
+
]
198
+
else El.splice [])
199
+
]
200
+
in
201
+
202
+
let thumbnail_md = sprintf "![%%lc](:project-%s \"%s\")" p.MP.slug p.MP.title in
203
+
let thumbnail_html = El.unsafe_raw (Arod_view.md_to_html thumbnail_md) in
204
+
205
+
let date_range = match p.MP.finish with
206
+
| Some y -> sprintf "%d–%d" start_year y
207
+
| None -> sprintf "%d–present" start_year
208
+
in
209
+
210
+
let duration_height = max 40 (duration * 8) in
211
+
212
+
El.div ~at:[At.class' "timeline-project"] [
213
+
El.div ~at:[At.class' "timeline-marker-wrapper"] [
214
+
El.div ~at:[At.class' "timeline-dot"] [];
215
+
El.div ~at:[
216
+
At.class' "timeline-duration";
217
+
At.v "style" (sprintf "height: %dpx" duration_height)
218
+
] [];
219
+
El.span ~at:[At.class' "timeline-year"] [El.txt (string_of_int start_year)]
220
+
];
221
+
El.div ~at:[At.class' "project-card"] [
222
+
El.div ~at:[At.class' "project-header"] [
223
+
El.h3 [
224
+
El.a ~at:[At.href ("/projects/" ^ p.MP.slug)] [
225
+
El.txt p.MP.title
226
+
]
227
+
];
228
+
El.span ~at:[At.class' "project-dates"] [El.txt date_range]
229
+
];
230
+
thumbnail_html;
231
+
El.div ~at:[At.class' "project-body"] [
232
+
Arod_view.truncated_body (`Project p) |> fst
233
+
];
234
+
recent_items_display
235
+
]
236
+
]
237
+
) all_projects in
238
+
239
+
let title = "Projects" in
240
+
let description = "Research projects timeline" in
241
+
242
+
let intro = El.p [El.txt "Research projects and relevant publications, ideas and notes."] in
243
+
244
+
let page_footer = Arod_footer.footer in
245
+
246
+
let page_content = El.splice [
247
+
El.article [
248
+
El.h1 [El.txt title];
249
+
intro;
250
+
El.div ~at:[At.class' "projects-timeline"] project_cards
251
+
];
252
+
El.aside []
253
+
] in
254
+
255
+
Arod_page.page ~title ~page_content ~page_footer ~description ()
+130
arod/lib/arod_richdata.ml
+130
arod/lib/arod_richdata.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** JSON-LD rich data for SEO *)
7
+
8
+
let jsonld j =
9
+
Printf.sprintf {|<script type="application/ld+json">%s</script>|}
10
+
(Ezjsonm.to_string (`O j))
11
+
12
+
let jsonlds j =
13
+
Printf.sprintf {|<script type="application/ld+json">%s</script>|}
14
+
(Ezjsonm.to_string (`A j))
15
+
16
+
type els = (string * string) list
17
+
18
+
let breadcrumbs_ld (els:els) =
19
+
let elsj =
20
+
List.mapi (fun i (name, item) ->
21
+
let last = i = List.length els - 1 in
22
+
`O ([
23
+
"@type", `String "ListItem";
24
+
"position", `String (string_of_int (i+1));
25
+
"name", `String name ] @ (if last then [] else ["item", `String item]))
26
+
) els in
27
+
[
28
+
"@context", `String "https://schema.org";
29
+
"@type", `String "BreadcrumbList";
30
+
"itemListElement", `A elsj
31
+
]
32
+
33
+
let breadcrumbs els = jsonld @@ breadcrumbs_ld els
34
+
35
+
module MC = Sortal_schema.Contact
36
+
module MN = Bushel.Note
37
+
module MP = Bushel.Paper
38
+
39
+
let json_of_contact (c:MC.t) =
40
+
`O ([
41
+
"@type", `String "Person";
42
+
"name", `String (MC.name c);
43
+
] @ (match MC.best_url c with None -> [] | Some c -> ["url", `String c]))
44
+
45
+
let date p = Ptime.to_rfc3339 p
46
+
47
+
let note_ld ~author ?(images=[]) (c:MN.t) =
48
+
let x = [
49
+
"@context", `String "https://schema.org";
50
+
"@type", `String "NewsArticle";
51
+
"headline", `String c.MN.title;
52
+
"image", `A (List.map (fun i -> `String i) images);
53
+
"datePublished", `String (date @@ MN.origdate c);
54
+
"dateModified", `String (date @@ MN.datetime c);
55
+
"abstract", `String (Option.value ~default:"" @@ MN.synopsis c);
56
+
"author", `A [json_of_contact author]
57
+
] in
58
+
match c.MN.via with
59
+
| None -> x
60
+
| Some (_,u) -> ("significantLink", `String u) :: x
61
+
62
+
let paper_ld (p:MP.t) =
63
+
let authors = MP.authors p |> List.filter_map Arod_model.lookup_by_name in
64
+
[
65
+
"@context", `String "https://schema.org";
66
+
"@type", `String "ScholarlyArticle";
67
+
"pagination", `String (MP.pages p);
68
+
"abstract", `String (MP.abstract p);
69
+
"datePublished", `String (date @@ MP.datetime p);
70
+
"publisher", `String (MP.publisher p);
71
+
"url", `String (Option.value ~default:"" @@ MP.url p);
72
+
"headline", `String (MP.title p);
73
+
"author", `A (List.map json_of_contact authors)
74
+
]
75
+
76
+
let generic_ld cfg e =
77
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
78
+
| Some c -> c
79
+
| None -> failwith "Author not found"
80
+
in
81
+
[
82
+
"@context", `String "https://schema.org";
83
+
"@type", `String "WebPage";
84
+
"datePublished", `String (date @@ Bushel.Entry.datetime e);
85
+
"author", `A [json_of_contact me];
86
+
"abstract", `String (Option.value ~default:"" @@ Bushel.Entry.synopsis e)
87
+
]
88
+
89
+
let entry_ld cfg e =
90
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
91
+
| Some c -> c
92
+
| None -> failwith "Author not found"
93
+
in
94
+
match e with
95
+
| `Note n -> note_ld ~author:me n
96
+
| `Paper p -> paper_ld p
97
+
| _ -> generic_ld cfg e
98
+
99
+
let breadcrumb_of_ent cfg ent =
100
+
("Home", cfg.Arod_config.site.base_url ^ "/") ::
101
+
( match ent with
102
+
| `Paper _ -> "Papers", (cfg.site.base_url ^ "/papers")
103
+
| `Video _ -> "Videos", (cfg.site.base_url ^ "/videos")
104
+
| `Idea _ -> "Ideas", (cfg.site.base_url ^ "/ideas")
105
+
| `Project _ -> "Projects", (cfg.site.base_url ^ "/projects")
106
+
| `Note _ -> "Notes", (cfg.site.base_url ^ "/notes")
107
+
) ::
108
+
[Bushel.Entry.title ent, ""]
109
+
110
+
let json_of_entry cfg ent =
111
+
jsonld @@ entry_ld cfg ent
112
+
113
+
let json_of_feed cfg feed =
114
+
match feed with
115
+
| `Note (n, e) ->
116
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
117
+
| Some c -> c
118
+
| None -> failwith "Author not found"
119
+
in
120
+
let note_with_ent_ld = [
121
+
"@context", `String "https://schema.org";
122
+
"@type", `String "NewsArticle";
123
+
"headline", `String (MN.title n);
124
+
"image", `A [];
125
+
"datePublished", `String (date @@ MN.datetime n);
126
+
"author", `A [json_of_contact me];
127
+
"mainEntity", `O (entry_ld cfg e)
128
+
] in
129
+
jsonld note_with_ent_ld
130
+
| `Entry e -> jsonld @@ entry_ld cfg e
+26
arod/lib/arod_videos.ml
+26
arod/lib/arod_videos.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Video rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
open Printf
10
+
11
+
module MV = Arod_model.Video
12
+
13
+
let video_for_feed v =
14
+
let md = sprintf "\n\n" v.MV.slug in
15
+
(El.unsafe_raw (Arod_view.md_to_html md), None)
16
+
17
+
let one_video v =
18
+
let md = sprintf "\n\n%s" v.MV.slug v.MV.description in
19
+
(El.splice [
20
+
Arod_view.entry_href (`Video v);
21
+
El.unsafe_raw (Arod_view.md_to_html md)
22
+
], None)
23
+
24
+
let one_video_full v =
25
+
let (html, _word_count_info) = one_video v in
26
+
html
+904
arod/lib/arod_view.ml
+904
arod/lib/arod_view.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Core view rendering for Arod webserver *)
7
+
8
+
open Htmlit
9
+
10
+
(** {1 Attribute Helpers} *)
11
+
12
+
let class_ c = At.class' c
13
+
14
+
(** {1 HTML Escaping} *)
15
+
16
+
let html_escape_attr s =
17
+
let buf = Buffer.create (String.length s) in
18
+
String.iter (function
19
+
| '&' -> Buffer.add_string buf "&"
20
+
| '"' -> Buffer.add_string buf """
21
+
| '<' -> Buffer.add_string buf "<"
22
+
| '>' -> Buffer.add_string buf ">"
23
+
| c -> Buffer.add_char buf c
24
+
) s;
25
+
Buffer.contents buf
26
+
27
+
(** {1 Icon Helpers} *)
28
+
29
+
let ent_to_icon = function
30
+
| `Paper _ -> "paper.svg"
31
+
| `Note _ -> "note.svg"
32
+
| `Project _ -> "project.svg"
33
+
| `Idea _ -> "idea.svg"
34
+
| `Video _ -> "video.svg"
35
+
36
+
let set_to_icon = function
37
+
| "papers" -> Some "paper.svg"
38
+
| "notes" -> Some "note.svg"
39
+
| "projects" -> Some "project.svg"
40
+
| "ideas" -> Some "idea.svg"
41
+
| "videos" -> Some "video.svg"
42
+
| "talks" -> Some "video.svg"
43
+
| _ -> None
44
+
45
+
(** {1 Tag Rendering} *)
46
+
47
+
let render_tag ?(relevant=false) ?(active=false) ?fnum ?num t =
48
+
let active_cl = if active then " tag-active" else "" in
49
+
let relevant_cl = if relevant then " tag-relevant" else "" in
50
+
51
+
let icon, text =
52
+
match t with
53
+
| `Slug t ->
54
+
let ent = Arod_model.lookup_exn t in
55
+
let icon_name = match ent with
56
+
| `Paper _ -> "paper.svg"
57
+
| `Note _ -> "note.svg"
58
+
| `Project _ -> "project.svg"
59
+
| `Idea _ -> "idea.svg"
60
+
| `Video _ -> "video.svg"
61
+
in
62
+
Some icon_name, Arod_model.Entry.slug ent
63
+
| `Set slug ->
64
+
let icon_name = match slug with
65
+
| "papers" -> Some "paper.svg"
66
+
| "notes" -> Some "note.svg"
67
+
| "projects" -> Some "project.svg"
68
+
| "ideas" -> Some "idea.svg"
69
+
| "videos" | "talks" -> Some "video.svg"
70
+
| _ -> None
71
+
in
72
+
icon_name, slug
73
+
| _ -> None, Arod_model.Tags.to_string t
74
+
in
75
+
76
+
let t_str = Arod_model.Tags.to_string t in
77
+
let icon_el = match icon with
78
+
| None -> El.splice []
79
+
| Some icon_name ->
80
+
El.img ~at:[
81
+
At.alt "icon";
82
+
At.class' "hide-mobile inline-icon";
83
+
At.src (Printf.sprintf "/assets/%s" icon_name)
84
+
] ()
85
+
in
86
+
87
+
let count_els = match num, fnum with
88
+
| None, None -> []
89
+
| None, Some fn ->
90
+
[El.span ~at:[At.class' "tag-count-container"] [
91
+
El.span ~at:[At.class' "tag-count-bg"] [El.txt (string_of_int fn)]
92
+
]]
93
+
| Some n, Some fn when fn <> n ->
94
+
[El.span ~at:[At.class' "tag-count-container"] [
95
+
El.span ~at:[At.class' "tag-count"] [El.txt (string_of_int n)];
96
+
El.span ~at:[At.class' "tag-count-bg"] [El.txt (string_of_int fn)]
97
+
]]
98
+
| Some n, _ ->
99
+
[El.span ~at:[At.class' "tag-count-container"] [
100
+
El.span ~at:[At.class' "tag-count"] [El.txt (string_of_int n)]
101
+
]]
102
+
in
103
+
104
+
El.span ~at:[
105
+
At.v "data-tag" t_str;
106
+
At.class' ("tag-label" ^ active_cl ^ relevant_cl)
107
+
] ([icon_el; El.txt text] @ count_els)
108
+
109
+
let render_tags (ts:Arod_model.Tags.t list) =
110
+
let ts = List.filter (function
111
+
| `Text _
112
+
| `Set _ -> true
113
+
| _ -> false
114
+
) ts in
115
+
El.splice ~sep:(El.txt " ") (List.map render_tag ts)
116
+
117
+
(** {1 Image Rendering} *)
118
+
119
+
let img ?cl ?(alt="") ?(title="") img_ent =
120
+
let origin_url = Printf.sprintf "/images/%s.webp"
121
+
(Filename.chop_extension (Arod_model.Img.origin img_ent)) in
122
+
123
+
let open Arod_model.Img in
124
+
let srcsets = String.concat ","
125
+
(List.map (fun (f,(w,_h)) -> Printf.sprintf "/images/%s %dw" f w)
126
+
(MS.bindings img_ent.variants)) in
127
+
128
+
let base_attrs = [
129
+
At.v "loading" "lazy";
130
+
At.src origin_url;
131
+
At.v "srcset" srcsets;
132
+
At.v "sizes" "(max-width: 768px) 100vw, 33vw"
133
+
] in
134
+
135
+
let attrs = match cl with
136
+
| Some c -> At.class' c :: base_attrs
137
+
| None -> base_attrs
138
+
in
139
+
140
+
match alt with
141
+
| "%r" ->
142
+
El.figure ~at:[At.class' "image-right"] [
143
+
El.img ~at:(At.alt title :: At.title title :: attrs) ();
144
+
El.figcaption [El.txt title]
145
+
]
146
+
| "%c" ->
147
+
El.figure ~at:[At.class' "image-center"] [
148
+
El.img ~at:(At.alt title :: At.title title :: attrs) ();
149
+
El.figcaption [El.txt title]
150
+
]
151
+
| "%lc" ->
152
+
El.figure ~at:[At.class' "image-left-float"] [
153
+
El.img ~at:(At.alt title :: At.title title :: attrs) ();
154
+
El.figcaption [El.txt title]
155
+
]
156
+
| "%rc" ->
157
+
El.figure ~at:[At.class' "image-right-float"] [
158
+
El.img ~at:(At.alt title :: At.title title :: attrs) ();
159
+
El.figcaption [El.txt title]
160
+
]
161
+
| _ ->
162
+
El.img ~at:(At.alt alt :: At.title title :: attrs) ()
163
+
164
+
(** {1 Date Formatting} *)
165
+
166
+
let int_to_date_suffix ~r n =
167
+
let suffix =
168
+
if n mod 10 = 1 && n mod 100 <> 11 then "st"
169
+
else if n mod 10 = 2 && n mod 100 <> 12 then "nd"
170
+
else if n mod 10 = 3 && n mod 100 <> 13 then "rd"
171
+
else "th"
172
+
in
173
+
let x = string_of_int n in
174
+
let x = if r && String.length x = 1 then " " ^ x else x in
175
+
x ^ suffix
176
+
177
+
let month_name = function
178
+
| 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr"
179
+
| 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug"
180
+
| 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec"
181
+
| _ -> ""
182
+
183
+
let ptime_date ?(r=false) ?(with_d=false) (y,m,d) =
184
+
let ms = month_name m in
185
+
match with_d with
186
+
| false -> Printf.sprintf "%s %4d" ms y
187
+
| true -> Printf.sprintf "%s %s %4d" (int_to_date_suffix ~r d) ms y
188
+
189
+
(** {1 String Helpers} *)
190
+
191
+
let string_drop_prefix ~prefix str =
192
+
let prefix_len = String.length prefix in
193
+
let str_len = String.length str in
194
+
if str_len >= prefix_len && String.sub str 0 prefix_len = prefix then
195
+
String.sub str prefix_len (str_len - prefix_len)
196
+
else
197
+
str
198
+
199
+
let map_and fn l =
200
+
let ll = List.length l in
201
+
List.mapi (fun i v ->
202
+
match i with
203
+
| 0 -> fn v
204
+
| _ when i + 1 = ll -> " and " ^ (fn v)
205
+
| _ -> ", " ^ (fn v)
206
+
) l |> String.concat ""
207
+
208
+
(** {1 Link Renderers for Cmarkit} *)
209
+
210
+
let bushel_link c l =
211
+
let defs = Cmarkit_renderer.Context.get_defs c in
212
+
match Cmarkit.Inline.Link.reference_definition defs l with
213
+
| Some Cmarkit.Link_definition.Def (ld, _) -> begin
214
+
match Cmarkit.Link_definition.dest ld with
215
+
| Some ("#", _) ->
216
+
let text =
217
+
Cmarkit.Inline.Link.text l |>
218
+
Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r ->
219
+
String.concat "\n" (List.map (String.concat "") r) in
220
+
Cmarkit_renderer.Context.string c
221
+
(Printf.sprintf {|<a href="#" class="tag-search-link" data-search-tag="%s"><span class="hash-prefix">#</span>%s</a>|}
222
+
(html_escape_attr text) (html_escape_attr text));
223
+
true
224
+
| Some (dest, _) when String.starts_with ~prefix:"###" dest ->
225
+
let type_filter = String.sub dest 3 (String.length dest - 3) in
226
+
let text =
227
+
Cmarkit.Inline.Link.text l |>
228
+
Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r ->
229
+
String.concat "\n" (List.map (String.concat "") r) in
230
+
Cmarkit_renderer.Context.string c
231
+
(Printf.sprintf {|<a href="#" class="type-filter-link" data-filter-type="%s">%s</a>|}
232
+
(html_escape_attr type_filter) (html_escape_attr text));
233
+
true
234
+
| Some (dest, _) when String.starts_with ~prefix:"##" dest ->
235
+
let tag = String.sub dest 2 (String.length dest - 2) in
236
+
let text =
237
+
Cmarkit.Inline.Link.text l |>
238
+
Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r ->
239
+
String.concat "\n" (List.map (String.concat "") r) in
240
+
Cmarkit_renderer.Context.string c
241
+
(Printf.sprintf {|<a href="#" class="tag-search-link" data-search-tag="%s"><span class="hash-prefix">#</span>%s</a>|}
242
+
(html_escape_attr tag) (html_escape_attr text));
243
+
true
244
+
| _ -> false
245
+
end
246
+
| _ -> false
247
+
248
+
let media_link c l =
249
+
let is_bushel_image = String.starts_with ~prefix:"/images/" in
250
+
let is_bushel_video = String.starts_with ~prefix:"/videos/" in
251
+
let defs = Cmarkit_renderer.Context.get_defs c in
252
+
match Cmarkit.Inline.Link.reference_definition defs l with
253
+
| Some Cmarkit.Link_definition.Def (ld, _) -> begin
254
+
match Cmarkit.Link_definition.dest ld with
255
+
| Some (src, _) when is_bushel_image src ->
256
+
let title = match Cmarkit.Link_definition.title ld with
257
+
| None -> ""
258
+
| Some title -> String.concat "\n" (List.map (fun (_, (t, _)) -> t) title) in
259
+
let alt =
260
+
Cmarkit.Inline.Link.text l |>
261
+
Cmarkit.Inline.to_plain_text ~break_on_soft:false |> fun r ->
262
+
String.concat "\n" (List.map (String.concat "") r) in
263
+
(* Strip /images/ prefix and .webp extension to get the slug *)
264
+
let img_path = string_drop_prefix ~prefix:"/images/" src in
265
+
let img_slug = Filename.chop_extension img_path in
266
+
let img_ent = Arod_model.lookup_image img_slug in
267
+
(match img_ent with
268
+
| Some img_ent ->
269
+
let html = El.to_string ~doctype:false (img ~title ~alt ~cl:"content-image" img_ent) in
270
+
Cmarkit_renderer.Context.string c html;
271
+
true
272
+
| None ->
273
+
(* Image not in index - still handle positioning directives *)
274
+
let html = match alt with
275
+
| "%c" ->
276
+
Printf.sprintf
277
+
{|<figure class="image-center"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|}
278
+
src title title title
279
+
| "%r" ->
280
+
Printf.sprintf
281
+
{|<figure class="image-right"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|}
282
+
src title title title
283
+
| "%lc" ->
284
+
Printf.sprintf
285
+
{|<figure class="image-left-float"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|}
286
+
src title title title
287
+
| "%rc" ->
288
+
Printf.sprintf
289
+
{|<figure class="image-right-float"><img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw"><figcaption>%s</figcaption></figure>|}
290
+
src title title title
291
+
| _ ->
292
+
Printf.sprintf
293
+
{|<img class="content-image" src="%s" alt="%s" title="%s" loading="lazy" sizes="(max-width: 768px) 100vw, 33vw">|}
294
+
src alt title
295
+
in
296
+
Cmarkit_renderer.Context.string c html;
297
+
true)
298
+
| Some (src, _) when is_bushel_video src ->
299
+
let title = match Cmarkit.Link_definition.title ld with
300
+
| None -> ""
301
+
| Some title -> String.concat "\n" (List.map (fun (_, (t, _)) -> t) title) in
302
+
let url =
303
+
match Arod_model.lookup (string_drop_prefix ~prefix:"/videos/" src) with
304
+
| Some (`Video v) ->
305
+
let rewrite_watch_to_embed url =
306
+
let url = Uri.of_string url in
307
+
let path = Uri.path url |> String.split_on_char '/' in
308
+
let path = List.map (function "watch" -> "embed" |v -> v) path in
309
+
Uri.with_path url (String.concat "/" path) |> Uri.to_string in
310
+
rewrite_watch_to_embed (Arod_model.Video.url v)
311
+
| Some _ -> failwith "slug not a video"
312
+
| None -> failwith "video not found"
313
+
in
314
+
let html = El.to_string ~doctype:false (El.div ~at:[At.class' "video-center"] [
315
+
El.iframe ~at:[
316
+
At.title title;
317
+
At.v "width" "100%";
318
+
At.v "height" "315px";
319
+
At.src url;
320
+
At.v "frameborder" "0";
321
+
At.v "allowfullscreen" "";
322
+
At.v "sandbox" "allow-same-origin allow-scripts allow-popups allow-forms"
323
+
] []
324
+
]) in
325
+
Cmarkit_renderer.Context.string c html;
326
+
true
327
+
| None | Some _ -> false
328
+
end
329
+
| None | Some _ -> false
330
+
331
+
(** {1 Sidenote Rendering} *)
332
+
333
+
let rec render_sidenote c = function
334
+
| Bushel.Md.Contact_note (contact, trigger_text) ->
335
+
let open Sortal_schema.Contact in
336
+
let handle = handle contact in
337
+
let name = name contact in
338
+
let link_url = best_url contact |> Option.value ~default:"" in
339
+
let thumbnail_url = Arod_model.Entry.contact_thumbnail (Arod_model.get_entries ()) contact in
340
+
341
+
let data_attrs = [
342
+
Printf.sprintf {|data-slug="%s"|} handle;
343
+
Printf.sprintf {|data-handle="%s"|} handle;
344
+
Printf.sprintf {|data-name="%s"|} (html_escape_attr name);
345
+
Printf.sprintf {|data-link="%s"|} link_url;
346
+
] in
347
+
348
+
let data_attrs = match thumbnail_url with
349
+
| Some url -> data_attrs @ [Printf.sprintf {|data-image="%s"|} url]
350
+
| None -> data_attrs
351
+
in
352
+
353
+
let data_attrs = match emails contact with
354
+
| e :: _ -> data_attrs @ [Printf.sprintf {|data-email="%s"|} (html_escape_attr e.address)]
355
+
| [] -> data_attrs
356
+
in
357
+
358
+
let data_attrs = match github_handle contact with
359
+
| Some g -> data_attrs @ [Printf.sprintf {|data-github="%s"|} (html_escape_attr g)]
360
+
| None -> data_attrs
361
+
in
362
+
363
+
let data_attrs = match orcid contact with
364
+
| Some o -> data_attrs @ [Printf.sprintf {|data-orcid="%s"|} (html_escape_attr o)]
365
+
| None -> data_attrs
366
+
in
367
+
368
+
Cmarkit_renderer.Context.string c (Printf.sprintf
369
+
{|<side-note type="contact" %s>%s</side-note>|}
370
+
(String.concat " " data_attrs) trigger_text);
371
+
true
372
+
373
+
| Bushel.Md.Paper_note (paper, trigger_text) ->
374
+
let paper_slug = paper.Bushel.Paper.slug in
375
+
let title = Bushel.Paper.title paper in
376
+
let authors = Bushel.Paper.authors paper in
377
+
let year = Bushel.Paper.year paper in
378
+
let doi = Bushel.Paper.doi paper in
379
+
380
+
let link_url = Printf.sprintf "/papers/%s" paper_slug in
381
+
382
+
let author_str = match authors with
383
+
| [] -> ""
384
+
| [a] ->
385
+
let parts = String.split_on_char ' ' a in
386
+
List.nth parts (List.length parts - 1)
387
+
| a :: _ ->
388
+
let parts = String.split_on_char ' ' a in
389
+
let last_name = List.nth parts (List.length parts - 1) in
390
+
last_name ^ " et al"
391
+
in
392
+
393
+
let data_attrs = [
394
+
Printf.sprintf {|data-slug="%s"|} paper_slug;
395
+
Printf.sprintf {|data-title="%s"|} (html_escape_attr title);
396
+
Printf.sprintf {|data-authors="%s"|} (html_escape_attr author_str);
397
+
Printf.sprintf {|data-year="%d"|} year;
398
+
Printf.sprintf {|data-link="%s"|} link_url;
399
+
] in
400
+
401
+
let data_attrs = match doi with
402
+
| Some d -> data_attrs @ [Printf.sprintf {|data-doi="%s"|} (html_escape_attr d)]
403
+
| None -> data_attrs
404
+
in
405
+
406
+
Cmarkit_renderer.Context.string c (Printf.sprintf
407
+
{|<side-note type="paper" %s>%s</side-note>|}
408
+
(String.concat " " data_attrs) trigger_text);
409
+
true
410
+
411
+
| Bushel.Md.Idea_note (idea, trigger_text) ->
412
+
let idea_slug = idea.Bushel.Idea.slug in
413
+
let title = Bushel.Idea.title idea in
414
+
let year = Bushel.Idea.year idea in
415
+
let status = Bushel.Idea.status idea |> Bushel.Idea.status_to_string in
416
+
let level = Bushel.Idea.level idea |> Bushel.Idea.level_to_string in
417
+
418
+
let link_url = Printf.sprintf "/ideas/%s" idea_slug in
419
+
420
+
let data_attrs = [
421
+
Printf.sprintf {|data-slug="%s"|} idea_slug;
422
+
Printf.sprintf {|data-title="%s"|} (html_escape_attr title);
423
+
Printf.sprintf {|data-year="%d"|} year;
424
+
Printf.sprintf {|data-status="%s"|} (html_escape_attr status);
425
+
Printf.sprintf {|data-level="%s"|} (html_escape_attr level);
426
+
Printf.sprintf {|data-link="%s"|} link_url;
427
+
] in
428
+
429
+
Cmarkit_renderer.Context.string c (Printf.sprintf
430
+
{|<side-note type="idea" %s>%s</side-note>|}
431
+
(String.concat " " data_attrs) trigger_text);
432
+
true
433
+
434
+
| Bushel.Md.Note_note (note, trigger_text) ->
435
+
let note_slug = note.Bushel.Note.slug in
436
+
let title = Bushel.Note.title note in
437
+
let year, month, day = Bushel.Note.date note in
438
+
let word_count = Bushel.Note.words note in
439
+
440
+
let link_url = Printf.sprintf "/notes/%s" note_slug in
441
+
let thumbnail_url = Arod_model.Entry.thumbnail (Arod_model.get_entries ()) (`Note note) in
442
+
443
+
let data_attrs = [
444
+
Printf.sprintf {|data-slug="%s"|} note_slug;
445
+
Printf.sprintf {|data-title="%s"|} (html_escape_attr title);
446
+
Printf.sprintf {|data-year="%d"|} year;
447
+
Printf.sprintf {|data-month="%d"|} month;
448
+
Printf.sprintf {|data-day="%d"|} day;
449
+
Printf.sprintf {|data-words="%d"|} word_count;
450
+
Printf.sprintf {|data-link="%s"|} link_url;
451
+
] in
452
+
453
+
let data_attrs = match thumbnail_url with
454
+
| Some url -> data_attrs @ [Printf.sprintf {|data-image="%s"|} url]
455
+
| None -> data_attrs
456
+
in
457
+
458
+
Cmarkit_renderer.Context.string c (Printf.sprintf
459
+
{|<side-note type="note" %s>%s</side-note>|}
460
+
(String.concat " " data_attrs) trigger_text);
461
+
true
462
+
463
+
| Bushel.Md.Project_note (project, trigger_text) ->
464
+
let project_slug = project.Bushel.Project.slug in
465
+
let title = Bushel.Project.title project in
466
+
let start = project.Bushel.Project.start in
467
+
let finish = project.Bushel.Project.finish in
468
+
let ideas = Bushel.Project.ideas project in
469
+
470
+
let link_url = Printf.sprintf "/projects/%s" project_slug in
471
+
472
+
let data_attrs = [
473
+
Printf.sprintf {|data-slug="%s"|} project_slug;
474
+
Printf.sprintf {|data-title="%s"|} (html_escape_attr title);
475
+
Printf.sprintf {|data-start="%d"|} start;
476
+
Printf.sprintf {|data-ideas="%s"|} (html_escape_attr ideas);
477
+
Printf.sprintf {|data-link="%s"|} link_url;
478
+
] in
479
+
480
+
let data_attrs = match finish with
481
+
| Some f -> data_attrs @ [Printf.sprintf {|data-finish="%d"|} f]
482
+
| None -> data_attrs
483
+
in
484
+
485
+
Cmarkit_renderer.Context.string c (Printf.sprintf
486
+
{|<side-note type="project" %s>%s</side-note>|}
487
+
(String.concat " " data_attrs) trigger_text);
488
+
true
489
+
490
+
| Bushel.Md.Video_note (video, trigger_text) ->
491
+
let video_slug = video.Bushel.Video.slug in
492
+
let title = Bushel.Video.title video in
493
+
let is_talk = Bushel.Video.talk video in
494
+
let year, month, day = Bushel.Video.date video in
495
+
496
+
let link_url = Printf.sprintf "/videos/%s" video_slug in
497
+
498
+
let data_attrs = [
499
+
Printf.sprintf {|data-slug="%s"|} video_slug;
500
+
Printf.sprintf {|data-title="%s"|} (html_escape_attr title);
501
+
Printf.sprintf {|data-year="%d"|} year;
502
+
Printf.sprintf {|data-month="%d"|} month;
503
+
Printf.sprintf {|data-day="%d"|} day;
504
+
Printf.sprintf {|data-talk="%b"|} is_talk;
505
+
Printf.sprintf {|data-link="%s"|} link_url;
506
+
] in
507
+
508
+
Cmarkit_renderer.Context.string c (Printf.sprintf
509
+
{|<side-note type="video" %s>%s</side-note>|}
510
+
(String.concat " " data_attrs) trigger_text);
511
+
true
512
+
513
+
| Bushel.Md.Footnote_note (slug, block, trigger_text) ->
514
+
let temp_doc = Cmarkit.Doc.make block in
515
+
let footnote_inline c = function
516
+
| Cmarkit.Inline.Image (l, _) -> media_link c l
517
+
| Cmarkit.Inline.Link (l, _) -> bushel_link c l
518
+
| _ -> false
519
+
in
520
+
let footnote_renderer = Cmarkit_html.renderer ~safe:false () in
521
+
let footnote_renderer = Cmarkit_renderer.compose footnote_renderer (Cmarkit_renderer.make ~inline:footnote_inline ()) in
522
+
let content_html = Cmarkit_renderer.doc_to_string footnote_renderer temp_doc in
523
+
524
+
let data_attrs = [
525
+
Printf.sprintf {|data-slug="%s"|} slug;
526
+
Printf.sprintf {|data-label="%s"|} (html_escape_attr trigger_text);
527
+
] in
528
+
529
+
Cmarkit_renderer.Context.string c (Printf.sprintf
530
+
{|<side-note type="footnote" %s><template class="footnote-content">%s</template></side-note>|}
531
+
(String.concat " " data_attrs) content_html);
532
+
true
533
+
534
+
and custom_inline_renderer c = function
535
+
| Cmarkit.Inline.Image (l, _) -> media_link c l
536
+
| Cmarkit.Inline.Link (l, _) -> bushel_link c l
537
+
| Bushel.Md.Side_note data -> render_sidenote c data
538
+
| _ -> false
539
+
540
+
(** Custom HTML renderer that handles sidenotes and bushel extensions *)
541
+
let custom_html_renderer () =
542
+
let default = Cmarkit_html.renderer ~safe:false () in
543
+
Cmarkit_renderer.compose default (Cmarkit_renderer.make ~inline:custom_inline_renderer ())
544
+
545
+
(** {1 Markdown to HTML} *)
546
+
547
+
let md_to_html content =
548
+
let open Cmarkit in
549
+
let doc = Doc.of_string ~strict:false ~resolver:Bushel.Md.with_bushel_links content in
550
+
let entries = Arod_model.get_entries () in
551
+
(* Use sidenote mapper to create Side_note inlines *)
552
+
let mapper = Mapper.make ~inline:(Bushel.Md.make_sidenote_mapper entries) () in
553
+
let mapped_doc = Mapper.map_doc mapper doc in
554
+
let renderer = custom_html_renderer () in
555
+
Cmarkit_renderer.doc_to_string renderer mapped_doc
556
+
557
+
let md_to_atom_html content =
558
+
let open Cmarkit in
559
+
let doc = Doc.of_string ~strict:false ~heading_auto_ids:true ~resolver:Bushel.Md.with_bushel_links content in
560
+
let defs = Doc.defs doc in
561
+
let footnote_map = Hashtbl.create 7 in
562
+
let entries = Arod_model.get_entries () in
563
+
564
+
let atom_bushel_mapper _m inline =
565
+
match inline with
566
+
| Inline.Image (lb, meta) ->
567
+
(match Inline.Link.reference lb with
568
+
| `Inline (ld, _) ->
569
+
(match Link_definition.dest ld with
570
+
| Some (url, _) when Bushel.Md.is_bushel_slug url ->
571
+
let slug = Bushel.Md.strip_handle url in
572
+
(match Arod_model.Entry.lookup entries slug with
573
+
| Some (`Video _) ->
574
+
let dest = Printf.sprintf "/videos/%s" slug in
575
+
let title = Link_definition.title ld in
576
+
let alt_text = Inline.Link.text lb |> Inline.to_plain_text ~break_on_soft:false
577
+
|> fun r -> String.concat "\n" (List.map (String.concat "") r) in
578
+
let txt = Inline.Text (alt_text, meta) in
579
+
let new_ld = Link_definition.make ?title ~dest:(dest, meta) () in
580
+
let ll = `Inline (new_ld, meta) in
581
+
let new_lb = Inline.Link.make txt ll in
582
+
Mapper.ret (Inline.Image (new_lb, meta))
583
+
| Some ent ->
584
+
let dest = Arod_model.Entry.site_url ent in
585
+
let title = Link_definition.title ld in
586
+
let alt_text = Inline.Link.text lb |> Inline.to_plain_text ~break_on_soft:false
587
+
|> fun r -> String.concat "\n" (List.map (String.concat "") r) in
588
+
let txt = Inline.Text (alt_text, meta) in
589
+
let new_ld = Link_definition.make ?title ~dest:(dest, meta) () in
590
+
let ll = `Inline (new_ld, meta) in
591
+
let new_lb = Inline.Link.make txt ll in
592
+
Mapper.ret (Inline.Image (new_lb, meta))
593
+
| None ->
594
+
(match Arod_model.Entry.lookup_image entries slug with
595
+
| Some img ->
596
+
let dest = Printf.sprintf "/images/%s.webp" (Filename.chop_extension (Arod_model.Img.origin img)) in
597
+
let title = Link_definition.title ld in
598
+
let alt_text = Inline.Link.text lb |> Inline.to_plain_text ~break_on_soft:false
599
+
|> fun r -> String.concat "\n" (List.map (String.concat "") r) in
600
+
let txt = Inline.Text (alt_text, meta) in
601
+
let new_ld = Link_definition.make ?title ~dest:(dest, meta) () in
602
+
let ll = `Inline (new_ld, meta) in
603
+
let new_lb = Inline.Link.make txt ll in
604
+
Mapper.ret (Inline.Image (new_lb, meta))
605
+
| None ->
606
+
failwith (Printf.sprintf "%s slug not found in atom markdown" slug)))
607
+
| _ -> Mapper.default)
608
+
| _ -> Mapper.default)
609
+
| _ ->
610
+
Bushel.Md.make_bushel_link_only_mapper defs entries _m inline
611
+
in
612
+
let doc =
613
+
Mapper.map_doc
614
+
(Mapper.make ~inline:atom_bushel_mapper ())
615
+
doc
616
+
in
617
+
618
+
let footnotes = ref [] in
619
+
let atom_inline c = function
620
+
| Inline.Image (lb, _meta) ->
621
+
(match Inline.Link.reference lb with
622
+
| `Inline (ld, _) ->
623
+
(match Link_definition.dest ld with
624
+
| Some (dest, _) when String.starts_with ~prefix:"/videos/" dest ->
625
+
let slug = string_drop_prefix ~prefix:"/videos/" dest in
626
+
(match Arod_model.lookup slug with
627
+
| Some (`Video v) ->
628
+
let video_url =
629
+
let url_str = Arod_model.Video.url v in
630
+
let url = Uri.of_string url_str in
631
+
let path = Uri.path url |> String.split_on_char '/' in
632
+
let path = List.map (function "watch" -> "embed" | v -> v) path in
633
+
Uri.with_path url (String.concat "/" path) |> Uri.to_string in
634
+
let title = Arod_model.Video.title v in
635
+
let iframe_html = Printf.sprintf
636
+
{|<div class="video-center"><iframe title="%s" src="%s" frameborder="0" allowfullscreen="" sandbox="allow-same-origin allow-scripts allow-popups allow-forms" style="aspect-ratio: 16/9; width: 100%%;"></iframe></div>|}
637
+
title video_url in
638
+
Cmarkit_renderer.Context.string c iframe_html;
639
+
true
640
+
| _ -> false)
641
+
| _ -> false)
642
+
| _ -> false)
643
+
| Inline.Link (lb, _meta) ->
644
+
(match Inline.Link.referenced_label lb with
645
+
| Some l when String.starts_with ~prefix:"^" (Label.key l) ->
646
+
(match Inline.Link.reference_definition defs lb with
647
+
| Some (Block.Footnote.Def (fn, _)) ->
648
+
let label_key = Label.key l in
649
+
let num, text =
650
+
match Hashtbl.find_opt footnote_map label_key with
651
+
| Some (n, t) -> (n, t)
652
+
| None ->
653
+
let n = Hashtbl.length footnote_map + 1 in
654
+
let t = Printf.sprintf "[%d]" n in
655
+
Hashtbl.add footnote_map label_key (n, t);
656
+
footnotes := (n, label_key, Block.Footnote.block fn) :: !footnotes;
657
+
(n, t)
658
+
in
659
+
let sup_id = Printf.sprintf "fnref:%d" num in
660
+
let href_attr = Printf.sprintf "#fn:%d" num in
661
+
Cmarkit_renderer.Context.string c (Printf.sprintf "<sup id=\"%s\"><a href=\"%s\" class=\"footnote\">%s</a></sup>" sup_id href_attr text);
662
+
true
663
+
| _ -> false)
664
+
| _ -> false)
665
+
| _ -> false
666
+
in
667
+
let atom_renderer = Cmarkit_renderer.make ~inline:atom_inline () in
668
+
let default = Cmarkit_html.renderer ~safe:false () in
669
+
let renderer = Cmarkit_renderer.compose default atom_renderer in
670
+
let main_html = Cmarkit_renderer.doc_to_string renderer doc in
671
+
672
+
if !footnotes = [] then main_html
673
+
else
674
+
let sorted_footnotes = List.sort (fun (a,_,_) (b,_,_) -> compare a b) !footnotes in
675
+
let footnote_content_renderer = Cmarkit_html.renderer ~safe:false () in
676
+
let footnote_items =
677
+
String.concat "\n" (List.map (fun (num, _label, block) ->
678
+
let fn_id = Printf.sprintf "fn:%d" num in
679
+
let fnref_id = Printf.sprintf "fnref:%d" num in
680
+
let temp_doc = Cmarkit.Doc.make block in
681
+
let processed_doc = Mapper.map_doc (Mapper.make ~inline:atom_bushel_mapper ()) temp_doc in
682
+
let block_html = Cmarkit_renderer.doc_to_string footnote_content_renderer processed_doc in
683
+
Printf.sprintf "<li id=\"%s\"><p>%s <a href=\"#%s\" class=\"reversefootnote\">↩</a></p></li>" fn_id block_html fnref_id
684
+
) sorted_footnotes)
685
+
in
686
+
let footnotes_html = Printf.sprintf "<div class=\"footnotes\"><ol>%s</ol></div>" footnote_items in
687
+
main_html ^ "\n" ^ footnotes_html
688
+
689
+
(** {1 Body Rendering} *)
690
+
691
+
let truncated_body ent =
692
+
let body = Arod_model.Entry.body ent in
693
+
let first, last = Arod_model.Util.first_and_last_hunks body in
694
+
let remaining_words = Arod_model.Util.count_words last in
695
+
let total_words = Arod_model.Util.count_words first + remaining_words in
696
+
let is_note = match ent with `Note _ -> true | _ -> false in
697
+
let is_truncated = remaining_words > 1 in
698
+
let word_count_info =
699
+
if is_truncated || (is_note && total_words > 0) then
700
+
Some (total_words, is_truncated)
701
+
else
702
+
None
703
+
in
704
+
let markdown_with_link =
705
+
let footnote_lines = Arod_model.Util.find_footnote_lines last in
706
+
let footnotes_text =
707
+
if footnote_lines = [] then ""
708
+
else "\n\n" ^ String.concat "\n" footnote_lines
709
+
in
710
+
match word_count_info with
711
+
| Some (total, true) ->
712
+
let url = Arod_model.Entry.site_url ent in
713
+
first ^ "\n\n*[Read full note... (" ^ string_of_int total ^ " words](" ^ url ^ "))*\n" ^ footnotes_text
714
+
| _ -> first ^ footnotes_text
715
+
in
716
+
(El.unsafe_raw (md_to_html markdown_with_link), word_count_info)
717
+
718
+
let full_body ent =
719
+
El.unsafe_raw (md_to_html (Arod_model.Entry.body ent))
720
+
721
+
(** {1 Entry Heading} *)
722
+
723
+
let entry_href ?title ?(tag="h2") ent =
724
+
let via, via_url =
725
+
match ent with
726
+
| `Note n ->
727
+
( match n.Arod_model.Note.via with
728
+
| None -> None, None
729
+
| Some (t,u) -> Some t, Some u )
730
+
| _ -> None, None
731
+
in
732
+
733
+
let via_el =
734
+
match via, via_url with
735
+
| Some t, Some u when t <> "" ->
736
+
El.a ~at:[At.class' "via"; At.href u] [El.txt (Printf.sprintf "(via %s)" t)]
737
+
| _, Some u ->
738
+
El.a ~at:[At.class' "via"; At.href u] [El.txt "(via)"]
739
+
| _ -> El.splice []
740
+
in
741
+
742
+
let title_text = match title with
743
+
| None -> Arod_model.Entry.title ent
744
+
| Some t -> t
745
+
in
746
+
747
+
match ent with
748
+
| `Note {index_page=true;_} -> El.splice []
749
+
| _ ->
750
+
let h_fn = match tag with
751
+
| "h1" -> El.h1
752
+
| "h2" -> El.h2
753
+
| "h3" -> El.h3
754
+
| "h4" -> El.h4
755
+
| "h5" -> El.h5
756
+
| "h6" -> El.h6
757
+
| _ -> El.h2
758
+
in
759
+
760
+
let doi_el = match ent with
761
+
| `Note n when Arod_model.Note.perma n ->
762
+
(match Arod_model.Note.doi n with
763
+
| Some doi_str ->
764
+
El.span ~at:[At.class' "title-doi"] [
765
+
El.txt " / ";
766
+
El.a ~at:[At.href ("https://doi.org/" ^ doi_str)] [El.txt "DOI"];
767
+
]
768
+
| None -> El.splice [])
769
+
| _ -> El.splice []
770
+
in
771
+
772
+
h_fn [
773
+
El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [El.txt title_text];
774
+
El.txt " ";
775
+
via_el;
776
+
El.span ~at:[At.class' "title-date"] [
777
+
El.txt " / ";
778
+
El.txt (ptime_date ~with_d:false (Arod_model.Entry.date ent))
779
+
];
780
+
doi_el
781
+
]
782
+
783
+
(** {1 Tags Metadata} *)
784
+
785
+
let tags_meta ?extra ?link ?(tags=[]) ?date ?backlinks_content ent =
786
+
let tags = List.map Arod_model.Tags.of_string tags in
787
+
let link_el = match link with
788
+
| None -> El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [El.txt "#"]
789
+
| Some l -> El.a ~at:[At.href l] [El.txt "#"]
790
+
in
791
+
792
+
let date_str = ptime_date ~with_d:true
793
+
(match date with None -> Arod_model.Entry.date ent | Some d -> d) in
794
+
795
+
let bullet = El.span ~at:[At.class' "meta-bullet"] [El.txt "•"] in
796
+
797
+
let sections = [] in
798
+
let sections = sections @ [[link_el; El.txt " "; El.txt date_str]] in
799
+
800
+
let sections = match ent with
801
+
| `Note n when Arod_model.Note.perma n ->
802
+
(match Arod_model.Note.doi n with
803
+
| Some doi_str ->
804
+
let doi_section = [
805
+
El.txt "DOI: ";
806
+
El.a ~at:[At.href ("https://doi.org/" ^ doi_str)] [El.txt doi_str]
807
+
] in
808
+
sections @ [doi_section]
809
+
| None -> sections)
810
+
| _ -> sections
811
+
in
812
+
813
+
let sections = match extra with
814
+
| Some v -> sections @ [[El.txt v]]
815
+
| None -> sections
816
+
in
817
+
818
+
let sections = match backlinks_content with
819
+
| Some content ->
820
+
let entry_slug = Arod_model.Entry.slug ent in
821
+
let checkbox_id = "sidenote__checkbox--backlinks-" ^ entry_slug in
822
+
let content_id = "sidenote-backlinks-" ^ entry_slug in
823
+
let backlinks_section = [
824
+
El.span ~at:[At.class' "sidenote"; At.v "role" "note"] [
825
+
El.input ~at:[
826
+
At.type' "checkbox";
827
+
At.id checkbox_id;
828
+
At.class' "sidenote__checkbox";
829
+
At.v "aria-label" "Show backlinks";
830
+
At.v "aria-hidden" "true";
831
+
At.v "hidden" ""
832
+
] ();
833
+
El.label ~at:[
834
+
At.v "for" checkbox_id;
835
+
At.class' "sidenote__button";
836
+
At.v "data-sidenote-number" "↑";
837
+
At.v "aria-describedby" content_id;
838
+
At.v "tabindex" "0"
839
+
] [El.txt "backlinks"];
840
+
El.span ~at:[
841
+
At.id content_id;
842
+
At.class' "sidenote__content";
843
+
At.v "aria-hidden" "true";
844
+
At.v "hidden" "";
845
+
At.v "data-sidenote-number" "↑"
846
+
] [content]
847
+
]
848
+
] in
849
+
sections @ [backlinks_section]
850
+
| None -> sections
851
+
in
852
+
853
+
let all_tags = Arod_model.concat_tags tags (Arod_model.tags_of_ent ent) in
854
+
let sections = match all_tags with
855
+
| [] -> sections
856
+
| tags ->
857
+
let tag_elements = List.map (fun tag ->
858
+
let tag_str = Arod_model.Tags.to_raw_string tag in
859
+
El.span ~at:[At.v "data-tag" tag_str; At.class' "tag-label"] [
860
+
El.txt tag_str
861
+
]
862
+
) tags in
863
+
let tags_section = List.fold_left (fun acc el ->
864
+
if acc = [] then [el]
865
+
else acc @ [El.txt ", "; el]
866
+
) [] tag_elements in
867
+
sections @ [tags_section]
868
+
in
869
+
870
+
let meta_parts = List.fold_left (fun acc section ->
871
+
if acc = [] then section
872
+
else acc @ [bullet] @ section
873
+
) [] sections in
874
+
875
+
El.div ~at:[At.class' "note-meta"] meta_parts
876
+
877
+
(** {1 References Section} *)
878
+
879
+
let note_references_html note =
880
+
let is_perma = Arod_model.Note.perma note in
881
+
let has_doi = match Arod_model.Note.doi note with Some _ -> true | None -> false in
882
+
if not (is_perma || has_doi) then
883
+
El.splice []
884
+
else
885
+
let cfg = Arod_model.get_config () in
886
+
let me = Arod_model.lookup_by_handle cfg.site.author_handle in
887
+
match me with
888
+
| None -> El.splice []
889
+
| Some author_contact ->
890
+
let references = Bushel.Md.note_references (Arod_model.get_entries ()) author_contact note in
891
+
if List.length references > 0 then
892
+
let ref_items = List.map (fun (doi, citation, _is_paper) ->
893
+
let doi_url = Printf.sprintf "https://doi.org/%s" doi in
894
+
El.li [
895
+
El.txt citation;
896
+
El.a ~at:[At.href doi_url; At.v "target" "_blank"] [El.i [El.txt doi]];
897
+
]
898
+
) references in
899
+
El.div ~at:[At.class' "references-section"] [
900
+
El.h3 ~at:[At.class' "references-heading"] [El.txt "References"];
901
+
El.ul ~at:[At.class' "references-list"] ref_items
902
+
]
903
+
else
904
+
El.splice []
+19
arod/lib/dune
+19
arod/lib/dune
+9
-1
ocaml-bushel/bin/main.ml
+9
-1
ocaml-bushel/bin/main.ml
···
158
158
in
159
159
(* Build table *)
160
160
let rows = List.map (fun e ->
161
+
let thumb = match Bushel.Entry.thumbnail_slug entries e with
162
+
| Some s -> s
163
+
| None -> "-"
164
+
in
161
165
[ type_string e
162
166
; Bushel.Entry.slug e
163
167
; truncate 50 (Bushel.Entry.title e)
164
168
; format_date (Bushel.Entry.date e)
169
+
; thumb
165
170
]
166
171
) limited in
167
172
let table = Table.make
168
-
~headers:["TYPE"; "SLUG"; "TITLE"; "DATE"]
173
+
~headers:["TYPE"; "SLUG"; "TITLE"; "DATE"; "THUMBNAIL"]
169
174
rows
170
175
in
171
176
Table.print table;
···
235
240
Printf.printf "Title: %s\n" (Bushel.Entry.title entry);
236
241
Printf.printf "Date: %s\n" (format_date (Bushel.Entry.date entry));
237
242
Printf.printf "URL: %s\n" (Bushel.Entry.site_url entry);
243
+
(match Bushel.Entry.thumbnail_slug entries entry with
244
+
| Some s -> Printf.printf "Thumbnail: %s\n" s
245
+
| None -> Printf.printf "Thumbnail: -\n");
238
246
(match Bushel.Entry.synopsis entry with
239
247
| Some s -> Printf.printf "Synopsis: %s\n" s
240
248
| None -> ());
+3
ocaml-bushel/lib/bushel.ml
+3
ocaml-bushel/lib/bushel.ml
+98
ocaml-bushel/lib/bushel_doi_entry.ml
+98
ocaml-bushel/lib/bushel_doi_entry.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** DOI entries resolved from external sources via Zotero Translation Server *)
7
+
8
+
type status =
9
+
| Resolved
10
+
| Failed of string
11
+
12
+
type t = {
13
+
doi : string;
14
+
title : string;
15
+
authors : string list;
16
+
year : int;
17
+
bibtype : string;
18
+
publisher : string;
19
+
resolved_at : string;
20
+
source_urls : string list;
21
+
status : status;
22
+
ignore : bool;
23
+
}
24
+
25
+
type ts = t list
26
+
27
+
let get_string key fields =
28
+
match List.assoc_opt key fields with
29
+
| Some (`String s) -> s
30
+
| _ -> ""
31
+
32
+
let get_string_opt key fields =
33
+
match List.assoc_opt key fields with
34
+
| Some (`String s) -> Some s
35
+
| _ -> None
36
+
37
+
let get_int key fields =
38
+
match List.assoc_opt key fields with
39
+
| Some (`Float f) -> int_of_float f
40
+
| _ -> 0
41
+
42
+
let get_bool key fields =
43
+
match List.assoc_opt key fields with
44
+
| Some (`Bool b) -> b
45
+
| _ -> false
46
+
47
+
let get_strings key fields =
48
+
match List.assoc_opt key fields with
49
+
| Some (`A items) ->
50
+
List.filter_map (function `String s -> Some s | _ -> None) items
51
+
| _ -> []
52
+
53
+
let of_yaml_value = function
54
+
| `O fields ->
55
+
let doi = get_string "doi" fields in
56
+
let resolved_at = get_string "resolved_at" fields in
57
+
let source_urls =
58
+
match get_strings "source_urls" fields with
59
+
| [] ->
60
+
(match get_string_opt "source_url" fields with
61
+
| Some u -> [u]
62
+
| None -> [])
63
+
| urls -> urls
64
+
in
65
+
let ignore = get_bool "ignore" fields in
66
+
let error = get_string_opt "error" fields in
67
+
(match error with
68
+
| Some err ->
69
+
Some { doi; title = ""; authors = []; year = 0; bibtype = "";
70
+
publisher = ""; resolved_at; source_urls;
71
+
status = Failed err; ignore }
72
+
| None ->
73
+
let title = get_string "title" fields in
74
+
let authors = get_strings "authors" fields in
75
+
let year = get_int "year" fields in
76
+
let bibtype = get_string "bibtype" fields in
77
+
let publisher = get_string "publisher" fields in
78
+
Some { doi; title; authors; year; bibtype; publisher;
79
+
resolved_at; source_urls; status = Resolved; ignore })
80
+
| _ -> None
81
+
82
+
(** Load DOI entries from a YAML string *)
83
+
let of_yaml_string str =
84
+
try
85
+
match Yamlrw.of_string str with
86
+
| `A entries -> List.filter_map of_yaml_value entries
87
+
| _ -> []
88
+
with Yamlrw.Yamlrw_error _ -> []
89
+
90
+
(** Find entry by DOI (excludes ignored entries) *)
91
+
let find_by_doi entries doi =
92
+
List.find_opt (fun entry -> not entry.ignore && entry.doi = doi) entries
93
+
94
+
(** Find entry by source URL (excludes ignored entries) *)
95
+
let find_by_url entries url =
96
+
List.find_opt (fun entry ->
97
+
not entry.ignore && List.mem url entry.source_urls
98
+
) entries
+203
-2
ocaml-bushel/lib/bushel_entry.ml
+203
-2
ocaml-bushel/lib/bushel_entry.ml
···
27
27
images : Srcsetter.t list;
28
28
image_index : (string, Srcsetter.t) Hashtbl.t;
29
29
data_dir : string;
30
+
doi_entries : Bushel_doi_entry.ts;
30
31
}
31
32
32
33
(** {1 Constructors} *)
33
34
34
-
let v ~papers ~notes ~projects ~ideas ~videos ~contacts ?(images=[]) ~data_dir () =
35
+
let v ~papers ~notes ~projects ~ideas ~videos ~contacts ?(images=[]) ?(doi_entries=[]) ~data_dir () =
35
36
let slugs : slugs = Hashtbl.create 42 in
36
37
let papers, old_papers = List.partition (fun p -> p.Bushel_paper.latest) papers in
37
38
List.iter (fun n -> Hashtbl.add slugs n.Bushel_note.slug (`Note n)) notes;
···
42
43
(* Build image index *)
43
44
let image_index = Hashtbl.create (List.length images) in
44
45
List.iter (fun img -> Hashtbl.add image_index (Srcsetter.slug img) img) images;
45
-
{ slugs; papers; old_papers; notes; projects; ideas; videos; contacts; images; image_index; data_dir }
46
+
{ slugs; papers; old_papers; notes; projects; ideas; videos; contacts; images; image_index; data_dir; doi_entries }
46
47
47
48
(** {1 Accessors} *)
48
49
···
55
56
let old_papers { old_papers; _ } = old_papers
56
57
let images { images; _ } = images
57
58
let data_dir { data_dir; _ } = data_dir
59
+
let doi_entries { doi_entries; _ } = doi_entries
58
60
59
61
(** {1 Image Lookup} *)
60
62
···
194
196
| `Slug t -> lk t
195
197
| _ -> None
196
198
) tags
199
+
200
+
(** {1 Thumbnail Functions} *)
201
+
202
+
(** Get the smallest webp variant from a srcsetter image - prefers size just above 480px *)
203
+
let smallest_webp_variant img =
204
+
let variants = Srcsetter.variants img in
205
+
let webp_variants =
206
+
Srcsetter.MS.bindings variants
207
+
|> List.filter (fun (name, _) -> String.ends_with ~suffix:".webp" name)
208
+
in
209
+
match webp_variants with
210
+
| [] ->
211
+
(* No webp variants - use the name field which is always webp *)
212
+
"/images/" ^ Srcsetter.name img
213
+
| variants ->
214
+
(* Prefer variants with width > 480px, choosing the smallest one above 480 *)
215
+
let large_variants = List.filter (fun (_, (w, _)) -> w > 480) variants in
216
+
let candidates = if large_variants = [] then variants else large_variants in
217
+
(* Find the smallest variant from candidates *)
218
+
let smallest = List.fold_left (fun acc (name, (w, h)) ->
219
+
match acc with
220
+
| None -> Some (name, w, h)
221
+
| Some (_, min_w, _) when w < min_w -> Some (name, w, h)
222
+
| _ -> acc
223
+
) None candidates in
224
+
match smallest with
225
+
| Some (name, _, _) -> "/images/" ^ name
226
+
| None -> "/images/" ^ Srcsetter.name img
227
+
228
+
(** Get thumbnail slug for a contact *)
229
+
let contact_thumbnail_slug contact =
230
+
(* Contact images use just the handle as slug *)
231
+
Some (Sortal_schema.Contact.handle contact)
232
+
233
+
(** Get thumbnail URL for a contact - resolved through srcsetter *)
234
+
let contact_thumbnail entries contact =
235
+
match contact_thumbnail_slug contact with
236
+
| None -> None
237
+
| Some thumb_slug ->
238
+
match lookup_image entries thumb_slug with
239
+
| Some img -> Some (smallest_webp_variant img)
240
+
| None -> None
241
+
242
+
(** Extract the first image URL from markdown text *)
243
+
let extract_first_image md =
244
+
let open Cmarkit in
245
+
let doc = Doc.of_string md in
246
+
let found_image = ref None in
247
+
let find_image_in_inline _mapper = function
248
+
| Inline.Image (img, _) ->
249
+
(match Inline.Link.reference img with
250
+
| `Inline (ld, _) ->
251
+
(match Link_definition.dest ld with
252
+
| Some (url, _) when !found_image = None ->
253
+
found_image := Some url;
254
+
Mapper.default
255
+
| _ -> Mapper.default)
256
+
| _ -> Mapper.default)
257
+
| _ -> Mapper.default
258
+
in
259
+
let mapper = Mapper.make ~inline:find_image_in_inline () in
260
+
let _ = Mapper.map_doc mapper doc in
261
+
!found_image
262
+
263
+
(** Extract the first video slug from markdown text by looking for bushel video links *)
264
+
let extract_first_video entries md =
265
+
let open Cmarkit in
266
+
let doc = Doc.of_string md in
267
+
let found_video = ref None in
268
+
let find_video_in_inline _mapper = function
269
+
| Inline.Link (link, _) ->
270
+
(match Inline.Link.reference link with
271
+
| `Inline (ld, _) ->
272
+
(match Link_definition.dest ld with
273
+
| Some (url, _) when !found_video = None && String.starts_with ~prefix:":" url ->
274
+
let slug = String.sub url 1 (String.length url - 1) in
275
+
(match lookup entries slug with
276
+
| Some (`Video v) ->
277
+
found_video := Some (Bushel_video.uuid v);
278
+
Mapper.default
279
+
| _ -> Mapper.default)
280
+
| _ -> Mapper.default)
281
+
| _ -> Mapper.default)
282
+
| _ -> Mapper.default
283
+
in
284
+
let mapper = Mapper.make ~inline:find_video_in_inline () in
285
+
let _ = Mapper.map_doc mapper doc in
286
+
!found_video
287
+
288
+
(** Get thumbnail slug for an entry with fallbacks *)
289
+
let rec thumbnail_slug entries = function
290
+
| `Paper p -> Some (Bushel_paper.slug p)
291
+
| `Video v -> Some (Bushel_video.uuid v)
292
+
| `Project p -> Some (Printf.sprintf "project-%s" (Bushel_project.slug p))
293
+
| `Idea i ->
294
+
let is_active = match Bushel_idea.status i with
295
+
| Bushel_idea.Available | Bushel_idea.Discussion | Bushel_idea.Ongoing -> true
296
+
| Bushel_idea.Completed | Bushel_idea.Expired -> false
297
+
in
298
+
if is_active then
299
+
(* Use first supervisor's face image *)
300
+
let supervisors = Bushel_idea.supervisors i in
301
+
match supervisors with
302
+
| sup :: _ ->
303
+
let handle = if String.length sup > 0 && sup.[0] = '@'
304
+
then String.sub sup 1 (String.length sup - 1)
305
+
else sup
306
+
in
307
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) (contacts entries) with
308
+
| Some c ->
309
+
Some (Sortal_schema.Contact.handle c)
310
+
| None ->
311
+
(* Fallback to project thumbnail *)
312
+
let project_slug = Bushel_idea.project i in
313
+
(match lookup entries project_slug with
314
+
| Some p -> thumbnail_slug entries p
315
+
| None -> None))
316
+
| [] ->
317
+
(* No supervisors, use project thumbnail *)
318
+
let project_slug = Bushel_idea.project i in
319
+
(match lookup entries project_slug with
320
+
| Some p -> thumbnail_slug entries p
321
+
| None -> None)
322
+
else
323
+
(* Use project thumbnail for completed/expired ideas *)
324
+
let project_slug = Bushel_idea.project i in
325
+
(match lookup entries project_slug with
326
+
| Some p -> thumbnail_slug entries p
327
+
| None -> None)
328
+
| `Note n ->
329
+
(* Use titleimage if set, otherwise extract first image from body,
330
+
then try video, otherwise use slug_ent's thumbnail *)
331
+
(match Bushel_note.titleimage n with
332
+
| Some slug -> Some slug
333
+
| None ->
334
+
match extract_first_image (Bushel_note.body n) with
335
+
| Some url when String.starts_with ~prefix:":" url ->
336
+
Some (String.sub url 1 (String.length url - 1))
337
+
| Some _ -> None
338
+
| None ->
339
+
match extract_first_video entries (Bushel_note.body n) with
340
+
| Some video_uuid -> Some video_uuid
341
+
| None ->
342
+
(* Fallback to slug_ent's thumbnail if present *)
343
+
match Bushel_note.slug_ent n with
344
+
| Some slug_ent ->
345
+
(match lookup entries slug_ent with
346
+
| Some entry -> thumbnail_slug entries entry
347
+
| None -> None)
348
+
| None -> None)
349
+
350
+
(** Get thumbnail URL for an entry with fallbacks - resolved through srcsetter *)
351
+
let thumbnail entries entry =
352
+
match thumbnail_slug entries entry with
353
+
| None -> None
354
+
| Some thumb_slug ->
355
+
match lookup_image entries thumb_slug with
356
+
| Some img -> Some (smallest_webp_variant img)
357
+
| None ->
358
+
(* For projects, fallback to supervisor faces if project image doesn't exist *)
359
+
(match entry with
360
+
| `Project p ->
361
+
(* Find ideas for this project *)
362
+
let project_ideas = List.filter (fun idea ->
363
+
Bushel_idea.project idea = ":" ^ Bushel_project.slug p
364
+
) (ideas entries) in
365
+
(* Collect all unique supervisors from these ideas *)
366
+
let all_supervisors =
367
+
List.fold_left (fun acc idea ->
368
+
List.fold_left (fun acc2 sup ->
369
+
if List.mem sup acc2 then acc2 else sup :: acc2
370
+
) acc (Bushel_idea.supervisors idea)
371
+
) [] project_ideas
372
+
in
373
+
(* Split into avsm and others, preferring others first *)
374
+
let (others, avsm) = List.partition (fun sup ->
375
+
let handle = if String.length sup > 0 && sup.[0] = '@'
376
+
then String.sub sup 1 (String.length sup - 1)
377
+
else sup
378
+
in
379
+
handle <> "avsm"
380
+
) all_supervisors in
381
+
let ordered_supervisors = others @ avsm in
382
+
let rec try_supervisors = function
383
+
| [] -> None
384
+
| sup :: rest ->
385
+
let handle = if String.length sup > 0 && sup.[0] = '@'
386
+
then String.sub sup 1 (String.length sup - 1)
387
+
else sup
388
+
in
389
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) (contacts entries) with
390
+
| Some c ->
391
+
(match lookup_image entries (Sortal_schema.Contact.handle c) with
392
+
| Some img -> Some (smallest_webp_variant img)
393
+
| None -> try_supervisors rest)
394
+
| None -> try_supervisors rest)
395
+
in
396
+
try_supervisors ordered_supervisors
397
+
| _ -> None)
+19
ocaml-bushel/lib/bushel_entry.mli
+19
ocaml-bushel/lib/bushel_entry.mli
···
30
30
videos:Bushel_video.t list ->
31
31
contacts:Sortal_schema.Contact.t list ->
32
32
?images:Srcsetter.t list ->
33
+
?doi_entries:Bushel_doi_entry.ts ->
33
34
data_dir:string ->
34
35
unit ->
35
36
t
···
46
47
val old_papers : t -> Bushel_paper.ts
47
48
val images : t -> Srcsetter.t list
48
49
val data_dir : t -> string
50
+
val doi_entries : t -> Bushel_doi_entry.ts
49
51
50
52
(** {1 Lookup Functions} *)
51
53
···
127
129
128
130
val mention_entries : t -> Bushel_tags.t list -> entry list
129
131
(** [mention_entries entries tags] returns entries mentioned in the tags. *)
132
+
133
+
(** {1 Thumbnail Functions} *)
134
+
135
+
val smallest_webp_variant : Srcsetter.t -> string
136
+
(** [smallest_webp_variant img] returns URL path to smallest webp variant above 480px. *)
137
+
138
+
val contact_thumbnail_slug : Sortal_schema.Contact.t -> string option
139
+
(** [contact_thumbnail_slug contact] returns the image slug for a contact. *)
140
+
141
+
val contact_thumbnail : t -> Sortal_schema.Contact.t -> string option
142
+
(** [contact_thumbnail entries contact] returns the thumbnail URL for a contact. *)
143
+
144
+
val thumbnail_slug : t -> entry -> string option
145
+
(** [thumbnail_slug entries entry] returns the image slug for an entry. *)
146
+
147
+
val thumbnail : t -> entry -> string option
148
+
(** [thumbnail entries entry] returns the thumbnail URL for an entry. *)
+312
ocaml-bushel/lib/bushel_md.ml
+312
ocaml-bushel/lib/bushel_md.ml
···
17
17
- Plain HTML mode for feeds and simple output
18
18
*)
19
19
20
+
(** {1 Sidenote Types}
21
+
22
+
Sidenote data types for interactive previews on hover.
23
+
These are defined here as Cmarkit inline extensions that can be
24
+
generated by the sidenote mapper and rendered by the webserver. *)
25
+
26
+
type sidenote_data =
27
+
| Contact_note of Sortal_schema.Contact.t * string
28
+
| Paper_note of Bushel_paper.t * string
29
+
| Idea_note of Bushel_idea.t * string
30
+
| Note_note of Bushel_note.t * string
31
+
| Project_note of Bushel_project.t * string
32
+
| Video_note of Bushel_video.t * string
33
+
| Footnote_note of string * Cmarkit.Block.t * string
34
+
35
+
(** Extensible inline for sidenotes *)
36
+
type Cmarkit.Inline.t += Side_note of sidenote_data
37
+
20
38
(** {1 Link Detection} *)
21
39
22
40
let is_bushel_slug = String.starts_with ~prefix:":"
···
103
121
| _ -> None)
104
122
| _ -> None
105
123
124
+
(** {1 Sidenote Mapper}
125
+
126
+
Creates sidenotes for Bushel links. Used for interactive previews
127
+
on the main website. *)
128
+
129
+
let make_sidenote_mapper entries =
130
+
let open Cmarkit in
131
+
fun _m ->
132
+
function
133
+
| Inline.Link (lb, meta) ->
134
+
(match link_target_is_bushel lb with
135
+
| Some (url, title) ->
136
+
let s = strip_handle url in
137
+
if is_tag_slug url then
138
+
(* Tag link - keep as regular link with ## prefix for renderer *)
139
+
let txt = Inline.Text (title, meta) in
140
+
let ld = Link_definition.make ~dest:(url, meta) () in
141
+
let ll = `Inline (ld, meta) in
142
+
let link = Inline.Link.make txt ll in
143
+
Mapper.ret (Inline.Link (link, meta))
144
+
else if is_contact_slug url then
145
+
(* Contact sidenote *)
146
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with
147
+
| Some c ->
148
+
let sidenote = Side_note (Contact_note (c, title)) in
149
+
Mapper.ret sidenote
150
+
| None ->
151
+
(* Contact not found, fallback to text *)
152
+
let txt = Inline.Text (title, meta) in
153
+
Mapper.ret txt)
154
+
else
155
+
(* Check entry type and generate appropriate sidenote *)
156
+
(match Bushel_entry.lookup entries s with
157
+
| Some (`Paper p) ->
158
+
let sidenote = Side_note (Paper_note (p, title)) in
159
+
Mapper.ret sidenote
160
+
| Some (`Idea i) ->
161
+
let sidenote = Side_note (Idea_note (i, title)) in
162
+
Mapper.ret sidenote
163
+
| Some (`Note n) ->
164
+
let sidenote = Side_note (Note_note (n, title)) in
165
+
Mapper.ret sidenote
166
+
| Some (`Project p) ->
167
+
let sidenote = Side_note (Project_note (p, title)) in
168
+
Mapper.ret sidenote
169
+
| Some (`Video v) ->
170
+
let sidenote = Side_note (Video_note (v, title)) in
171
+
Mapper.ret sidenote
172
+
| None ->
173
+
(* Entry not found, use regular link *)
174
+
let dest = Bushel_entry.lookup_site_url entries s in
175
+
let txt = Inline.Text (title, meta) in
176
+
let ld = Link_definition.make ~dest:(dest, meta) () in
177
+
let ll = `Inline (ld, meta) in
178
+
let link = Inline.Link.make txt ll in
179
+
Mapper.ret (Inline.Link (link, meta)))
180
+
| None ->
181
+
(* Handle reference-style links *)
182
+
(match Inline.Link.referenced_label lb with
183
+
| Some l ->
184
+
let m = Label.meta l in
185
+
(match Meta.find authorlink m with
186
+
| Some () ->
187
+
let slug = Label.key l in
188
+
let s = strip_handle slug in
189
+
(match List.find_opt (fun c -> Sortal_schema.Contact.handle c = s) (Bushel_entry.contacts entries) with
190
+
| Some c ->
191
+
let name = Sortal_schema.Contact.name c in
192
+
let sidenote = Side_note (Contact_note (c, name)) in
193
+
Mapper.ret sidenote
194
+
| None ->
195
+
let title = Inline.Link.text lb |> text_of_inline in
196
+
let txt = Inline.Text (title, meta) in
197
+
Mapper.ret txt)
198
+
| None ->
199
+
(match Meta.find sluglink m with
200
+
| Some () ->
201
+
let slug = Label.key l in
202
+
if is_bushel_slug slug then
203
+
let s = strip_handle slug in
204
+
let title = Inline.Link.text lb |> text_of_inline in
205
+
(match Bushel_entry.lookup entries s with
206
+
| Some (`Paper p) -> Mapper.ret (Side_note (Paper_note (p, title)))
207
+
| Some (`Idea i) -> Mapper.ret (Side_note (Idea_note (i, title)))
208
+
| Some (`Note n) -> Mapper.ret (Side_note (Note_note (n, title)))
209
+
| Some (`Project p) -> Mapper.ret (Side_note (Project_note (p, title)))
210
+
| Some (`Video v) -> Mapper.ret (Side_note (Video_note (v, title)))
211
+
| None ->
212
+
let dest = Bushel_entry.lookup_site_url entries s in
213
+
let txt = Inline.Text (title, meta) in
214
+
let ld = Link_definition.make ~dest:(dest, meta) () in
215
+
let ll = `Inline (ld, meta) in
216
+
let link = Inline.Link.make txt ll in
217
+
Mapper.ret (Inline.Link (link, meta)))
218
+
else if is_tag_slug slug then
219
+
let sh = strip_handle slug in
220
+
let txt = Inline.Text (sh, meta) in
221
+
let ld = Link_definition.make ~dest:("#", meta) () in
222
+
let ll = `Inline (ld, meta) in
223
+
let link = Inline.Link.make txt ll in
224
+
Mapper.ret (Inline.Link (link, meta))
225
+
else Mapper.default
226
+
| None -> Mapper.default))
227
+
| None -> Mapper.default))
228
+
| Inline.Image (lb, meta) ->
229
+
(* Handle images with bushel slugs *)
230
+
(match image_target_is_bushel lb with
231
+
| Some (url, alt, caption) ->
232
+
let s = strip_handle url in
233
+
(* Check if this is a video - if so, use /videos/ path *)
234
+
(match Bushel_entry.lookup entries s with
235
+
| Some (`Video _) ->
236
+
let dest = Printf.sprintf "/videos/%s" s in
237
+
let txt = Inline.Text (caption, meta) in
238
+
let ld = Link_definition.make ?title:alt ~dest:(dest, meta) () in
239
+
let ll = `Inline (ld, meta) in
240
+
let img = Inline.Link.make txt ll in
241
+
Mapper.ret (Inline.Image (img, meta))
242
+
| _ ->
243
+
(* Convert bushel slug to /images/ path *)
244
+
let dest = Printf.sprintf "/images/%s.webp" s in
245
+
let txt = Inline.Text (caption, meta) in
246
+
let ld = Link_definition.make ?title:alt ~dest:(dest, meta) () in
247
+
let ll = `Inline (ld, meta) in
248
+
let img = Inline.Link.make txt ll in
249
+
Mapper.ret (Inline.Image (img, meta)))
250
+
| None -> Mapper.default)
251
+
| _ -> Mapper.default
252
+
253
+
(** Alias for compatibility *)
254
+
let make_bushel_inline_mapper = make_sidenote_mapper
255
+
106
256
(** {1 Link-Only Mapper}
107
257
108
258
Converts Bushel links to regular HTML links without sidenotes.
···
179
329
| None -> Mapper.default))
180
330
| None -> Mapper.default))
181
331
| _ -> Mapper.default
332
+
333
+
(** Alias for compatibility *)
334
+
let make_bushel_link_only_mapper _defs = make_link_only_mapper
182
335
183
336
(** {1 Slug Scanning} *)
184
337
···
623
776
let mapper = Mapper.make ~inline:(make_to_markdown_mapper ~base_url ~image_base entries) () in
624
777
let mapped_doc = Mapper.map_doc mapper doc in
625
778
Cmarkit_commonmark.of_doc mapped_doc
779
+
780
+
(** {1 References}
781
+
782
+
Reference extraction for CiTO annotations. *)
783
+
784
+
(** Reference source type for CiTO annotations *)
785
+
type reference_source =
786
+
| Paper (** CitesAsSourceDocument *)
787
+
| Note (** CitesAsRelated *)
788
+
| External (** Cites *)
789
+
790
+
(** Extract references (papers/notes with DOIs) from a note.
791
+
Returns a list of (doi, citation_text, reference_source) tuples.
792
+
793
+
@param entries The entry collection
794
+
@param default_author The default author contact for notes without explicit author
795
+
@param note The note to extract references from *)
796
+
let note_references entries (default_author:Sortal_schema.Contact.t) note =
797
+
let refs = ref [] in
798
+
799
+
(* Helper to format author name: extract last name from full name *)
800
+
let format_author_last name =
801
+
let parts = String.split_on_char ' ' name in
802
+
List.nth parts (List.length parts - 1)
803
+
in
804
+
805
+
(* Helper to format a citation *)
806
+
let format_citation ~authors ~year ~title ~publisher =
807
+
let author_str = match authors with
808
+
| [] -> ""
809
+
| [author] -> format_author_last author ^ " "
810
+
| author :: _ -> (format_author_last author) ^ " et al "
811
+
in
812
+
let pub_str = match publisher with
813
+
| None | Some "" -> ""
814
+
| Some p -> p ^ ". "
815
+
in
816
+
Printf.sprintf "%s(%d). %s. %s" author_str year title pub_str
817
+
in
818
+
819
+
(* Check slug_ent if it exists *)
820
+
(match Bushel_note.slug_ent note with
821
+
| Some slug ->
822
+
(match Bushel_entry.lookup entries slug with
823
+
| Some (`Paper p) ->
824
+
(match Bushel_paper.doi p with
825
+
| Some doi ->
826
+
let authors = Bushel_paper.authors p in
827
+
let year = Bushel_paper.year p in
828
+
let title = Bushel_paper.title p in
829
+
let publisher = Some (Bushel_paper.publisher p) in
830
+
let citation = format_citation ~authors ~year ~title ~publisher in
831
+
refs := (doi, citation, Paper) :: !refs
832
+
| None -> ())
833
+
| Some (`Note n) ->
834
+
(match Bushel_note.doi n with
835
+
| Some doi ->
836
+
let authors = match Bushel_note.author n with
837
+
| Some a -> [a]
838
+
| None -> [Sortal_schema.Contact.name default_author]
839
+
in
840
+
let (year, _, _) = Bushel_note.date n in
841
+
let title = Bushel_note.title n in
842
+
let publisher = None in
843
+
let citation = format_citation ~authors ~year ~title ~publisher in
844
+
refs := (doi, citation, Note) :: !refs
845
+
| None -> ())
846
+
| _ -> ())
847
+
| None -> ());
848
+
849
+
(* Scan body for bushel references *)
850
+
let slugs = scan_for_slugs entries (Bushel_note.body note) in
851
+
List.iter (fun slug ->
852
+
(* Strip leading : or @ from slug before lookup *)
853
+
let normalized_slug = strip_handle slug in
854
+
match Bushel_entry.lookup entries normalized_slug with
855
+
| Some (`Paper p) ->
856
+
(match Bushel_paper.doi p with
857
+
| Some doi ->
858
+
let authors = Bushel_paper.authors p in
859
+
let year = Bushel_paper.year p in
860
+
let title = Bushel_paper.title p in
861
+
let publisher = Some (Bushel_paper.publisher p) in
862
+
let citation = format_citation ~authors ~year ~title ~publisher in
863
+
(* Check if doi already exists in refs *)
864
+
if not (List.exists (fun (d, _, _) -> d = doi) !refs) then
865
+
refs := (doi, citation, Paper) :: !refs
866
+
| None -> ())
867
+
| Some (`Note n) ->
868
+
(match Bushel_note.doi n with
869
+
| Some doi ->
870
+
let authors = match Bushel_note.author n with
871
+
| Some a -> [a]
872
+
| None -> [Sortal_schema.Contact.name default_author]
873
+
in
874
+
let (year, _, _) = Bushel_note.date n in
875
+
let title = Bushel_note.title n in
876
+
let publisher = None in
877
+
let citation = format_citation ~authors ~year ~title ~publisher in
878
+
(* Check if doi already exists in refs *)
879
+
if not (List.exists (fun (d, _, _) -> d = doi) !refs) then
880
+
refs := (doi, citation, Note) :: !refs
881
+
| None -> ())
882
+
| _ -> ()
883
+
) slugs;
884
+
885
+
(* Scan body for external DOI URLs and resolve from cache *)
886
+
let body = Bushel_note.body note in
887
+
let doi_url_pattern = Re.Perl.compile_pat "https?://(?:dx\\.)?doi\\.org/([^)\\s\"'>]+)" in
888
+
let doi_matches = Re.all doi_url_pattern body in
889
+
let doi_entries = Bushel_entry.doi_entries entries in
890
+
List.iter (fun group ->
891
+
try
892
+
let encoded_doi = Re.Group.get group 1 in
893
+
let doi = Uri.pct_decode encoded_doi in
894
+
if not (List.exists (fun (d, _, _) -> d = doi) !refs) then
895
+
match Bushel_doi_entry.find_by_doi doi_entries doi with
896
+
| Some doi_entry when doi_entry.status = Resolved ->
897
+
let citation = format_citation
898
+
~authors:doi_entry.authors
899
+
~year:doi_entry.year
900
+
~title:doi_entry.title
901
+
~publisher:(Some doi_entry.publisher)
902
+
in
903
+
refs := (doi, citation, External) :: !refs
904
+
| _ ->
905
+
refs := (doi, doi, External) :: !refs
906
+
with _ -> ()
907
+
) doi_matches;
908
+
909
+
(* Scan body for publisher URLs and resolve from DOI cache *)
910
+
let publisher_pattern = Re.Perl.compile_pat "https?://(?:(?:www\\.)?(?:linkinghub\\.elsevier\\.com|(?:www\\.)?sciencedirect\\.com/science/article|ieeexplore\\.ieee\\.org|academic\\.oup\\.com|nature\\.com|journals\\.sagepub\\.com|garfield\\.library\\.upenn\\.edu|link\\.springer\\.com|arxiv\\.org/abs)/[^)\\s\"'>]+|(?:dl\\.acm\\.org|(?:www\\.)?tandfonline\\.com)/doi(?:/pdf)?/10\\.[^)\\s\"'>]+)" in
911
+
let publisher_matches = Re.all publisher_pattern body in
912
+
List.iter (fun group ->
913
+
try
914
+
let url = Re.Group.get group 0 in
915
+
match Bushel_doi_entry.find_by_url doi_entries url with
916
+
| Some doi_entry when doi_entry.status = Resolved ->
917
+
let doi = doi_entry.doi in
918
+
if not (List.exists (fun (d, _, _) -> d = doi) !refs) then
919
+
let citation = format_citation
920
+
~authors:doi_entry.authors
921
+
~year:doi_entry.year
922
+
~title:doi_entry.title
923
+
~publisher:(Some doi_entry.publisher)
924
+
in
925
+
refs := (doi, citation, External) :: !refs
926
+
| _ -> ()
927
+
with _ -> ()
928
+
) publisher_matches;
929
+
930
+
(* Filter out the note's own DOI from references *)
931
+
let own_doi = Bushel_note.doi note in
932
+
let filtered_refs = List.filter (fun (doi, _, _) ->
933
+
match own_doi with
934
+
| Some own -> doi <> own
935
+
| None -> true
936
+
) !refs in
937
+
List.rev filtered_refs
+13
-1
ocaml-bushel/lib_eio/bushel_loader.ml
+13
-1
ocaml-bushel/lib_eio/bushel_loader.ml
···
139
139
| None -> []
140
140
in
141
141
Log.info (fun m -> m "Loaded %d images" (List.length images));
142
+
let doi_entries =
143
+
let doi_path = Filename.concat base "data/doi.yml" in
144
+
try
145
+
let content = Eio.Path.load Eio.Path.(fs / doi_path) in
146
+
let entries = Bushel.Doi_entry.of_yaml_string content in
147
+
Log.info (fun m -> m "Loaded %d DOI entries from %s" (List.length entries) doi_path);
148
+
entries
149
+
with
150
+
| Eio.Io (Eio.Fs.E (Eio.Fs.Not_found _), _) ->
151
+
Log.info (fun m -> m "No DOI cache found at %s" doi_path);
152
+
[]
153
+
in
142
154
let data_dir = Filename.concat base "data" in
143
-
let entries = Bushel.Entry.v ~papers ~notes ~projects ~ideas ~videos ~contacts ~images ~data_dir () in
155
+
let entries = Bushel.Entry.v ~papers ~notes ~projects ~ideas ~videos ~contacts ~images ~doi_entries ~data_dir () in
144
156
Log.info (fun m -> m "Building link graph");
145
157
let graph = build_link_graph entries in
146
158
Bushel.Link_graph.set_graph graph;
+12
-2
ocaml-frontmatter/lib/frontmatter.ml
+12
-2
ocaml-frontmatter/lib/frontmatter.ml
···
36
36
with _ -> None
37
37
else None
38
38
39
+
(** Normalize a slug to match Jekyll's slug_of_string behavior:
40
+
map all non-alphanumeric characters to hyphens and lowercase. *)
41
+
let normalize_slug s =
42
+
let mapped = String.map (fun c ->
43
+
match c with
44
+
| 'a'..'z' | 'A'..'Z' | '0'..'9' -> c
45
+
| _ -> '-'
46
+
) s in
47
+
String.lowercase_ascii mapped
48
+
39
49
let slug_of_fname fname =
40
50
let basename = Filename.basename fname in
41
51
let no_ext = Filename.chop_extension basename in
42
52
match parse_date_prefix no_ext with
43
-
| Some (date, slug) -> Ok (slug, Some date)
44
-
| None -> Ok (no_ext, None)
53
+
| Some (date, slug) -> Ok (normalize_slug slug, Some date)
54
+
| None -> Ok (normalize_slug no_ext, None)
45
55
46
56
(** Parse frontmatter using yamlrw's streaming parser.
47
57
Uses multi-document support to find the document boundary,
+12
-73
ocaml-tomlt/lib/tomlt.ml
+12
-73
ocaml-tomlt/lib/tomlt.ml
···
56
56
else kind ^ " " ^ to_string sort
57
57
end
58
58
59
-
(* ---- Helpers ---- *)
60
-
61
-
(* Result syntax for cleaner monadic chaining *)
62
-
module Result_syntax = struct
63
-
let ( let* ) = Result.bind
64
-
let ( let+ ) r f = Result.map f r
65
-
end
66
-
67
-
(* Chain comparisons: return first non-zero, or final comparison *)
68
-
let ( <?> ) c lazy_c = if c <> 0 then c else Lazy.force lazy_c
59
+
let ( <?> ) c c' = if c <> 0 then c else c'
69
60
70
61
(* Find first char matching predicate *)
71
62
let string_index_opt p s =
···
102
93
| UTC, Offset _ -> -1
103
94
| Offset _, UTC -> 1
104
95
| Offset { hours = h1; minutes = m1 }, Offset { hours = h2; minutes = m2 } ->
105
-
Int.compare h1 h2 <?> lazy (Int.compare m1 m2)
96
+
Int.compare h1 h2 <?> Int.compare m1 m2
106
97
107
98
let to_string = function
108
99
| UTC -> "Z"
···
136
127
137
128
let compare a b =
138
129
Int.compare a.year b.year
139
-
<?> lazy (Int.compare a.month b.month)
140
-
<?> lazy (Int.compare a.day b.day)
130
+
<?> Int.compare a.month b.month
131
+
<?> Int.compare a.day b.day
141
132
142
133
let to_string d = Printf.sprintf "%04d-%02d-%02d" d.year d.month d.day
143
134
···
171
162
172
163
let compare a b =
173
164
Int.compare a.hour b.hour
174
-
<?> lazy (Int.compare a.minute b.minute)
175
-
<?> lazy (Int.compare a.second b.second)
176
-
<?> lazy (Float.compare a.frac b.frac)
165
+
<?> Int.compare a.minute b.minute
166
+
<?> Int.compare a.second b.second
167
+
<?> Float.compare a.frac b.frac
177
168
178
169
(* Remove trailing zeros from a string, keeping at least one char *)
179
170
let rstrip_zeros s =
···
221
212
222
213
let compare a b =
223
214
Date.compare a.date b.date
224
-
<?> lazy (Time.compare a.time b.time)
225
-
<?> lazy (Tz.compare a.tz b.tz)
215
+
<?> Time.compare a.time b.time
216
+
<?> Tz.compare a.tz b.tz
226
217
227
218
let to_string dt =
228
219
Printf.sprintf "%sT%s%s"
···
233
224
let pp fmt dt = Format.pp_print_string fmt (to_string dt)
234
225
235
226
let of_string s =
236
-
let open Result_syntax in
227
+
let open Result.Syntax in
237
228
match find_datetime_sep s with
238
229
| None -> Error "missing date/time separator"
239
230
| Some idx ->
···
266
257
let equal a b = Date.equal a.date b.date && Time.equal a.time b.time
267
258
268
259
let compare a b =
269
-
Date.compare a.date b.date <?> lazy (Time.compare a.time b.time)
260
+
Date.compare a.date b.date <?> Time.compare a.time b.time
270
261
271
262
let to_string dt =
272
263
Printf.sprintf "%sT%s" (Date.to_string dt.date) (Time.to_string dt.time)
···
274
265
let pp fmt dt = Format.pp_print_string fmt (to_string dt)
275
266
276
267
let of_string s =
277
-
let open Result_syntax in
268
+
let open Result.Syntax in
278
269
match find_datetime_sep s with
279
270
| None -> Error "missing date/time separator"
280
271
| Some idx ->
···
442
433
| v -> type_error ~expected:"string" v);
443
434
enc = (fun i -> Toml.String (Int64.to_string i));
444
435
}
445
-
446
-
(* ---- Internal datetime codecs (for structured datetime types) ---- *)
447
-
(* These are used internally but not exposed in the mli - only ptime codecs are public *)
448
-
449
-
let datetime_ = {
450
-
kind = "datetime";
451
-
doc = "";
452
-
dec = (function
453
-
| Toml.Datetime s ->
454
-
Result.map_error (fun msg -> Value_error msg) (Datetime.of_string s)
455
-
| v -> type_error ~expected:"datetime" v);
456
-
enc = (fun dt -> Toml.Datetime (Datetime.to_string dt));
457
-
}
458
-
459
-
let datetime_local_ = {
460
-
kind = "datetime-local";
461
-
doc = "";
462
-
dec = (function
463
-
| Toml.Datetime_local s ->
464
-
Result.map_error (fun msg -> Value_error msg) (Datetime_local.of_string s)
465
-
| v -> type_error ~expected:"datetime-local" v);
466
-
enc = (fun dt -> Toml.Datetime_local (Datetime_local.to_string dt));
467
-
}
468
-
469
-
let date_local_ = {
470
-
kind = "date-local";
471
-
doc = "";
472
-
dec = (function
473
-
| Toml.Date_local s ->
474
-
Result.map_error (fun msg -> Value_error msg) (Date.of_string s)
475
-
| v -> type_error ~expected:"date-local" v);
476
-
enc = (fun d -> Toml.Date_local (Date.to_string d));
477
-
}
478
-
479
-
let time_local_ = {
480
-
kind = "time-local";
481
-
doc = "";
482
-
dec = (function
483
-
| Toml.Time_local s ->
484
-
Result.map_error (fun msg -> Value_error msg) (Time.of_string s)
485
-
| v -> type_error ~expected:"time-local" v);
486
-
enc = (fun t -> Toml.Time_local (Time.to_string t));
487
-
}
488
-
489
-
(* Silence unused warnings for internal codecs *)
490
-
let _ = datetime_
491
-
let _ = datetime_local_
492
-
let _ = date_local_
493
-
let _ = time_local_
494
436
495
437
(* ---- Ptime codecs ---- *)
496
438
···
1306
1248
| None -> failwith "any: enc not provided");
1307
1249
}
1308
1250
1309
-
(* ---- Encoding and decoding ---- *)
1310
-
1311
1251
let to_tomlt_error e =
1312
1252
Toml.Error.make (Toml.Error.Semantic (Toml.Error.Duplicate_key (codec_error_to_string e)))
1313
1253
···
1320
1260
1321
1261
let encode c v = c.enc v
1322
1262
1323
-
(* Re-export the Toml module for accessing raw TOML values *)
1324
1263
module Toml = Toml
1325
1264
module Error = Toml.Error