anil.recoil.org
My aggregated monorepo of OCaml code, automaintained
wip website
+3
-1
arod/bin/dune
+3
-1
arod/bin/dune
+348
-245
arod/bin/main.ml
+348
-245
arod/bin/main.ml
···
6
6
(** Arod webserver - a tiny_httpd based server for Bushel content *)
7
7
8
8
open Tiny_httpd
9
-
open Htmlit
9
+
open Arod.Entries
10
10
11
11
(** {1 Logging} *)
12
12
13
13
let src = Logs.Src.create "arod" ~doc:"Arod webserver"
14
14
module Log = (val Logs.src_log src : Logs.LOG)
15
15
16
-
(** {1 Request Handlers} *)
16
+
(** {1 Query Helpers} *)
17
17
18
-
let index_handler _req =
19
-
let cfg = Arod.Model.get_config () in
20
-
let page_content =
21
-
El.div [
22
-
El.h1 [El.txt cfg.site.name];
23
-
El.p [El.txt cfg.site.description];
24
-
El.h2 [El.txt "Recent Notes"];
25
-
El.ul (
26
-
List.map (fun note ->
27
-
El.li [
28
-
El.a ~at:[At.href (Arod.Model.Entry.site_url (`Note note))] [
29
-
El.txt (Arod.Model.Note.title note)
30
-
]
31
-
]
32
-
) (List.filteri (fun i _ -> i < 10) (Arod.Model.notes ()))
33
-
)
34
-
]
35
-
in
36
-
let html = Arod.Html.(to_page (page
37
-
~page_title:cfg.site.name
38
-
~description:cfg.site.description
39
-
~page_content
40
-
())) in
41
-
Response.make_string (Ok html)
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} *)
42
38
43
-
let notes_handler _req =
44
-
let cfg = Arod.Model.get_config () in
45
-
let notes = Arod.Model.notes () in
46
-
let page_content =
47
-
El.div [
48
-
El.h1 [El.txt "Notes"];
49
-
El.div ~at:[At.class' "entries-list"] (
50
-
List.map (fun note ->
51
-
let ent = `Note note in
52
-
El.article ~at:[At.class' "entry-card"] [
53
-
Arod.Html.entry_href ent;
54
-
Arod.Html.tags_meta ent;
55
-
El.div ~at:[At.class' "entry-synopsis"] [
56
-
match Arod.Model.Note.synopsis note with
57
-
| Some s -> El.p [El.txt s]
58
-
| None -> El.splice []
59
-
]
60
-
]
61
-
) notes
62
-
)
63
-
]
64
-
in
65
-
let html = Arod.Html.(to_page (page
66
-
~page_title:"Notes"
67
-
~description:(Printf.sprintf "Notes from %s" cfg.site.name)
68
-
~page_content
69
-
())) in
70
-
Response.make_string (Ok html)
39
+
let html_response content =
40
+
Response.make_string ~headers:[("content-type", "text/html; charset=utf-8")] (Ok content)
71
41
72
-
let papers_handler _req =
73
-
let cfg = Arod.Model.get_config () in
74
-
let papers = Arod.Model.papers () in
75
-
let page_content =
76
-
El.div [
77
-
El.h1 [El.txt "Papers"];
78
-
El.div ~at:[At.class' "entries-list"] (
79
-
List.map (fun paper ->
80
-
let ent = `Paper paper in
81
-
El.article ~at:[At.class' "entry-card"] [
82
-
Arod.Html.entry_href ent;
83
-
Arod.Html.tags_meta ent;
84
-
]
85
-
) papers
86
-
)
87
-
]
88
-
in
89
-
let html = Arod.Html.(to_page (page
90
-
~page_title:"Papers"
91
-
~description:(Printf.sprintf "Papers by %s" cfg.site.author_name)
92
-
~page_content
93
-
())) in
94
-
Response.make_string (Ok html)
42
+
let not_found_response = Response.fail ~code:404 "Not Found"
95
43
96
-
let projects_handler _req =
97
-
let cfg = Arod.Model.get_config () in
98
-
let projects = Arod.Model.projects () in
99
-
let page_content =
100
-
El.div [
101
-
El.h1 [El.txt "Projects"];
102
-
El.div ~at:[At.class' "entries-list"] (
103
-
List.map (fun project ->
104
-
let ent = `Project project in
105
-
El.article ~at:[At.class' "entry-card"] [
106
-
Arod.Html.entry_href ent;
107
-
Arod.Html.tags_meta ent;
108
-
Arod.Html.full_body ent
109
-
]
110
-
) projects
111
-
)
112
-
]
113
-
in
114
-
let html = Arod.Html.(to_page (page
115
-
~page_title:"Projects"
116
-
~description:(Printf.sprintf "Projects from %s" cfg.site.name)
117
-
~page_content
118
-
())) in
119
-
Response.make_string (Ok html)
44
+
let plain_response content =
45
+
Response.make_string ~headers:[("content-type", "text/plain")] (Ok content)
120
46
121
-
let ideas_handler _req =
122
-
let cfg = Arod.Model.get_config () in
123
-
let ideas = Arod.Model.ideas () in
124
-
let page_content =
125
-
El.div [
126
-
El.h1 [El.txt "Ideas"];
127
-
El.div ~at:[At.class' "entries-list"] (
128
-
List.map (fun idea ->
129
-
let ent = `Idea idea in
130
-
El.article ~at:[At.class' "entry-card"] [
131
-
Arod.Html.entry_href ent;
132
-
Arod.Html.tags_meta ent;
133
-
Arod.Html.full_body ent
134
-
]
135
-
) ideas
136
-
)
137
-
]
138
-
in
139
-
let html = Arod.Html.(to_page (page
140
-
~page_title:"Ideas"
141
-
~description:(Printf.sprintf "Ideas from %s" cfg.site.name)
142
-
~page_content
143
-
())) in
144
-
Response.make_string (Ok html)
47
+
let atom_response content =
48
+
Response.make_string ~headers:[("content-type", "application/atom+xml; charset=utf-8")] (Ok content)
145
49
146
-
let videos_handler _req =
147
-
let cfg = Arod.Model.get_config () in
148
-
let videos = Arod.Model.videos () in
149
-
let page_content =
150
-
El.div [
151
-
El.h1 [El.txt "Talks & Videos"];
152
-
El.div ~at:[At.class' "entries-list"] (
153
-
List.map (fun video ->
154
-
let ent = `Video video in
155
-
El.article ~at:[At.class' "entry-card"] [
156
-
Arod.Html.entry_href ent;
157
-
Arod.Html.tags_meta ent;
158
-
]
159
-
) videos
160
-
)
161
-
]
162
-
in
163
-
let html = Arod.Html.(to_page (page
164
-
~page_title:"Talks & Videos"
165
-
~description:(Printf.sprintf "Talks and videos by %s" cfg.site.author_name)
166
-
~page_content
167
-
())) in
168
-
Response.make_string (Ok html)
50
+
let xml_response content =
51
+
Response.make_string ~headers:[("content-type", "application/xml")] (Ok content)
169
52
170
-
let entry_handler slug _req =
171
-
match Arod.Model.lookup slug with
172
-
| None ->
173
-
Response.make_string ~code:404 (Ok "Not found")
174
-
| Some ent ->
175
-
let cfg = Arod.Model.get_config () in
176
-
let page_content =
177
-
El.article ~at:[At.class' "entry-full"] [
178
-
Arod.Html.entry_href ~tag:"h1" ent;
179
-
Arod.Html.tags_meta ent;
180
-
Arod.Html.full_body ent
181
-
]
182
-
in
183
-
let html = Arod.Html.(to_page (page
184
-
~page_title:(Arod.Model.Entry.title ent)
185
-
~description:(match Arod.Model.Entry.synopsis ent with Some s -> s | None -> cfg.site.description)
186
-
~page_content
187
-
())) in
188
-
Response.make_string (Ok html)
53
+
let json_response content =
54
+
Response.make_string ~headers:[("content-type", "application/json; charset=utf-8")] (Ok content)
189
55
190
-
(** {1 Static File Handlers} *)
56
+
(** {1 File Serving} *)
191
57
192
-
let static_file_handler ~dir path _req =
193
-
(* Remove any .. to prevent directory traversal *)
58
+
let serve_file ~dir path =
194
59
let clean_path =
195
60
let parts = String.split_on_char '/' path in
196
61
let safe_parts = List.filter (fun s -> s <> ".." && s <> ".") parts in
197
62
String.concat "/" safe_parts
198
63
in
199
64
let file_path = Filename.concat dir clean_path in
200
-
if Sys.file_exists file_path && not (Sys.is_directory file_path) then begin
201
-
let ext = Filename.extension file_path in
202
-
let content_type = match ext with
203
-
| ".css" -> "text/css"
204
-
| ".js" -> "text/javascript"
205
-
| ".svg" -> "image/svg+xml"
206
-
| ".png" -> "image/png"
207
-
| ".jpg" | ".jpeg" -> "image/jpeg"
208
-
| ".webp" -> "image/webp"
209
-
| ".ico" -> "image/x-icon"
210
-
| ".woff" -> "font/woff"
211
-
| ".woff2" -> "font/woff2"
212
-
| ".pdf" -> "application/pdf"
213
-
| ".json" -> "application/json"
214
-
| ".xml" -> "application/xml"
215
-
| ".html" -> "text/html"
216
-
| _ -> "application/octet-stream"
217
-
in
218
-
let ic = open_in_bin file_path in
219
-
let content = really_input_string ic (in_channel_length ic) in
220
-
close_in ic;
221
-
Response.make_string ~headers:[("Content-Type", content_type)] (Ok content)
222
-
end else
223
-
Response.make_string ~code:404 (Ok "Not found")
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"
224
159
225
160
(** {1 Feed Handlers} *)
226
161
227
-
let atom_handler _req =
228
-
(* TODO: implement Atom feed generation *)
229
-
Response.make_string
230
-
~headers:[("Content-Type", "application/atom+xml")]
231
-
(Ok {|<?xml version="1.0" encoding="utf-8"?><feed xmlns="http://www.w3.org/2005/Atom"><title>Feed</title></feed>|})
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
232
169
233
-
let json_feed_handler _req =
234
-
(* TODO: implement JSON feed generation *)
235
-
Response.make_string
236
-
~headers:[("Content-Type", "application/feed+json")]
237
-
(Ok {|{"version":"https://jsonfeed.org/version/1.1","title":"Feed","items":[]}|})
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
238
178
239
-
(** {1 Logging Middleware} *)
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
240
185
241
-
let logging_middleware handler req =
242
-
let start = Unix.gettimeofday () in
243
-
let resp = handler req in
244
-
let elapsed = Unix.gettimeofday () -. start in
245
-
Log.info (fun m -> m "%s %s %.3fs"
246
-
(Tiny_httpd.Meth.to_string (Request.meth req))
247
-
(Request.path req)
248
-
elapsed);
249
-
resp
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
250
292
251
293
(** {1 Server Setup} *)
252
294
253
295
let setup_routes server cfg =
254
-
(* Index *)
255
-
Server.add_route_handler server Route.(exact "/" @/ return) index_handler;
296
+
let open Route in
256
297
257
-
(* Entry lists *)
258
-
Server.add_route_handler server Route.(exact "/notes" @/ return) notes_handler;
259
-
Server.add_route_handler server Route.(exact "/papers" @/ return) papers_handler;
260
-
Server.add_route_handler server Route.(exact "/projects" @/ return) projects_handler;
261
-
Server.add_route_handler server Route.(exact "/ideas" @/ return) ideas_handler;
262
-
Server.add_route_handler server Route.(exact "/videos" @/ return) videos_handler;
263
-
Server.add_route_handler server Route.(exact "/talks" @/ return) videos_handler;
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;
264
302
265
-
(* Individual entries *)
266
-
Server.add_route_handler server Route.(exact "/notes" @/ string_urlencoded @/ return) entry_handler;
267
-
Server.add_route_handler server Route.(exact "/papers" @/ string_urlencoded @/ return) entry_handler;
268
-
Server.add_route_handler server Route.(exact "/projects" @/ string_urlencoded @/ return) entry_handler;
269
-
Server.add_route_handler server Route.(exact "/ideas" @/ string_urlencoded @/ return) entry_handler;
270
-
Server.add_route_handler server Route.(exact "/videos" @/ string_urlencoded @/ return) entry_handler;
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);
271
309
272
-
(* Static files *)
273
-
Server.add_route_handler server
274
-
Route.(exact_path "/assets" rest_of_path_urlencoded)
275
-
(static_file_handler ~dir:cfg.Arod.Config.paths.assets_dir);
276
-
Server.add_route_handler server
277
-
Route.(exact_path "/images" rest_of_path_urlencoded)
278
-
(static_file_handler ~dir:cfg.paths.images_dir);
279
-
Server.add_route_handler server
280
-
Route.(exact_path "/static" rest_of_path_urlencoded)
281
-
(static_file_handler ~dir:cfg.paths.static_dir);
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);
282
315
283
-
(* Feeds *)
284
-
Server.add_route_handler server Route.(exact "/news.xml" @/ return) atom_handler;
285
-
Server.add_route_handler server Route.(exact "/feed.json" @/ return) json_feed_handler;
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);
286
380
287
381
()
288
382
···
312
406
Eio_main.run @@ fun env ->
313
407
let fs = Eio.Stdenv.fs env in
314
408
315
-
(* Load entries *)
316
409
Log.info (fun m -> m "Loading entries from %s" cfg.paths.data_dir);
317
410
let _entries = Arod.Model.init ~cfg fs in
318
411
Log.info (fun m -> m "Loaded %d notes, %d papers, %d projects, %d ideas, %d videos, %d images"
···
323
416
(List.length (Arod.Model.videos ()))
324
417
(List.length (Arod.Model.images ())));
325
418
326
-
(* Create server *)
327
419
let server = Tiny_httpd.create ~addr:cfg.server.host ~port:cfg.server.port () in
328
-
Tiny_httpd.add_middleware server ~stage:(`Stage 0) logging_middleware;
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
+
329
432
setup_routes server cfg;
330
433
331
434
Log.app (fun m -> m "Listening on http://%s:%d" cfg.server.host cfg.server.port);
+40
-2
arod/lib/arod.ml
+40
-2
arod/lib/arod.ml
···
12
12
13
13
- {!Config} - TOML configuration
14
14
- {!Model} - Bushel bridge layer
15
-
- {!Html} - HTML generation with htmlit *)
15
+
- {!View} - Core rendering utilities
16
+
- {!Page} - Page layout
17
+
- {!Entries} - Entry type filtering and rendering *)
16
18
17
19
module Config = Arod_config
18
20
(** TOML-based configuration for the webserver. *)
···
20
22
module Model = Arod_model
21
23
(** Model layer bridging Bushel to the webserver. *)
22
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
+
23
61
module Html = Arod_html
24
-
(** HTML generation using htmlit. *)
62
+
(** Legacy HTML generation (for compatibility). *)
+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, 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
+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 ()
+194
arod/lib/arod_jsonfeed.ml
+194
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
+
(match P.best_url p with
118
+
| Some url when String.ends_with ~suffix:".pdf" url ->
119
+
let pdf_url = form_uri cfg url in
120
+
let pdf_title = P.title p in
121
+
[J.Attachment.create ~url:pdf_url ~mime_type:"application/pdf" ~title:pdf_title ()]
122
+
| _ -> [])
123
+
| _ -> [])
124
+
| None -> []
125
+
in
126
+
127
+
let references =
128
+
let me = match Arod_model.lookup_by_handle cfg.Arod_config.site.author_handle with
129
+
| Some c -> c
130
+
| None -> failwith "Author not found"
131
+
in
132
+
Bushel.Md.note_references (Arod_model.get_entries ()) me note
133
+
|> List.map (fun (doi, _citation, ref_source) ->
134
+
let doi_url = Printf.sprintf "https://doi.org/%s" doi in
135
+
let cito = match ref_source with
136
+
| Bushel.Md.Paper -> [`CitesAsSourceDocument]
137
+
| Bushel.Md.Note -> [`CitesAsRelated]
138
+
| Bushel.Md.External -> [`Cites]
139
+
in
140
+
J.Reference.create ~url:doi_url ~doi ~cito ()
141
+
)
142
+
in
143
+
144
+
let json_author = author cfg (Arod_model.lookup_by_handle cfg.site.author_handle |> Option.get) in
145
+
146
+
Jsonfeed.Item.create
147
+
~id
148
+
~content
149
+
~url
150
+
?external_url
151
+
?image
152
+
?summary
153
+
~title
154
+
~date_published
155
+
~date_modified
156
+
~authors:[json_author]
157
+
~tags
158
+
~attachments
159
+
~references
160
+
()
161
+
162
+
let item_of_entry cfg (e:Arod_model.Entry.entry) =
163
+
match e with
164
+
| `Note n -> Some (item_of_note cfg n)
165
+
| _ -> None
166
+
167
+
let feed cfg uri entries =
168
+
let title = cfg.Arod_config.site.name ^ "'s feed" in
169
+
let home_page_url = cfg.site.base_url in
170
+
let feed_url = form_uri cfg uri in
171
+
let icon = cfg.site.base_url ^ "/assets/favicon.ico" in
172
+
let json_author = author cfg (Arod_model.lookup_by_handle cfg.site.author_handle |> Option.get) in
173
+
let authors = [json_author] in
174
+
let language = "en-US" in
175
+
176
+
let items = List.filter_map (item_of_entry cfg) entries in
177
+
178
+
Jsonfeed.create
179
+
~title
180
+
~home_page_url
181
+
~feed_url
182
+
~icon
183
+
~authors
184
+
~language
185
+
~items
186
+
()
187
+
188
+
let feed_string cfg uri entries =
189
+
let f = feed cfg uri entries in
190
+
match Jsonfeed.to_string f with
191
+
| Ok s -> s
192
+
| Error e ->
193
+
let msg = Fmt.str "Failed to encode JSON Feed: %a" Jsont.Error.pp e in
194
+
failwith msg
+39
-24
arod/lib/arod_model.ml
+39
-24
arod/lib/arod_model.ml
···
16
16
module Md = Bushel.Md
17
17
module Util = Bushel.Util
18
18
module Img = Srcsetter
19
+
module Contact = Sortal_schema.Contact
19
20
20
21
(** {1 Global State} *)
21
22
···
100
101
let open Cmarkit_renderer.Context in
101
102
let inline c = function
102
103
| Inline.Image (img, _meta) ->
103
-
(* Handle bushel image syntax *)
104
+
(* Handle bushel image syntax - :slug format *)
104
105
(match Inline.Link.reference img with
105
106
| `Inline (ld, _) ->
106
107
(match Link_definition.dest ld with
···
138
139
| Some img -> "/images/" ^ Img.name img
139
140
| None -> "/images/" ^ slug ^ ".webp"
140
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
141
152
(* Check for positioning directive *)
142
153
(match caption with
143
154
| "%c" | "%r" | "%lc" | "%rc" ->
···
148
159
| "%rc" -> "image-right-float"
149
160
| _ -> "image-center"
150
161
in
151
-
let srcset_attr = match img_info with
152
-
| Some img ->
153
-
let variants = Img.variants img in
154
-
let parts = Img.MS.fold (fun name (w, _) acc ->
155
-
Printf.sprintf "/images/%s %dw" name w :: acc
156
-
) variants [] in
157
-
if parts = [] then ""
158
-
else Printf.sprintf " srcset=\"%s\"" (String.concat ", " parts)
159
-
| None -> ""
160
-
in
161
162
let html = Printf.sprintf
162
-
{|<figure class="%s"><img src="%s" alt="%s" title="%s" loading="lazy"%s><figcaption>%s</figcaption></figure>|}
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>|}
163
164
fig_class dest title title srcset_attr title
164
165
in
165
166
string c html;
166
167
true
167
168
| _ ->
168
-
(* Regular image *)
169
-
let srcset_attr = match img_info with
170
-
| Some img ->
171
-
let variants = Img.variants img in
172
-
let parts = Img.MS.fold (fun name (w, _) acc ->
173
-
Printf.sprintf "/images/%s %dw" name w :: acc
174
-
) variants [] in
175
-
if parts = [] then ""
176
-
else Printf.sprintf " srcset=\"%s\"" (String.concat ", " parts)
177
-
| None -> ""
178
-
in
169
+
(* Regular image with content-image class for lightbox *)
179
170
let html = Printf.sprintf
180
-
{|<img src="%s" alt="%s" title="%s" loading="lazy"%s>|}
171
+
{|<img class="content-image" src="%s" alt="%s" title="%s" loading="lazy"%s sizes="(max-width: 768px) 100vw, 33vw">|}
181
172
dest caption title srcset_attr
182
173
in
183
174
string c html;
···
205
196
206
197
let concat_tags tags1 tags2 =
207
198
tags1 @ (List.filter (fun t -> not (List.mem t 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
+
]
+303
arod/lib/arod_page.ml
+303
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="M3 2 L3 30 29 30 29 10 21 2 Z M21 2 L21 10 29 10 M7 14 L17 14 M7 18 L25 18 M7 22 L25 22 M7 26 L17 26" /></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="M2 26 L30 26 30 8 2 8 Z M2 8 L10 8 12 4 20 4 22 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="M16 7 C16 7 2 11 2 22 L2 30 10 30 C10 30 22 30 30 22 M16 7 L30 22 M16 7 L30 4 30 22 M30 4 L16 4 10 10" /></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.title [El.txt page_title];
91
+
El.meta ~at:[At.charset "UTF-8"] ();
92
+
El.meta ~at:[At.name "viewport"; At.content "width=device-width, initial-scale=1.0"] ();
93
+
El.meta ~at:[At.v "http-equiv" "X-UA-Compatible"; At.content "ie=edge"] ();
94
+
El.meta ~at:[At.name "description"; At.content description] ();
95
+
El.meta ~at:[At.v "property" "og:image"; At.content image] ();
96
+
El.meta ~at:[At.v "property" "og:site_name"; At.content cfg.site.name] ();
97
+
El.meta ~at:[At.v "property" "og:type"; At.content "object"] ();
98
+
El.meta ~at:[At.v "property" "og:title"; At.content page_title] ();
99
+
El.meta ~at:[At.v "property" "og:description"; At.content description] ();
100
+
El.meta ~at:[At.name "twitter:card"; At.content "summary_large_image"] ();
101
+
El.meta ~at:[At.name "twitter:title"; At.content page_title] ();
102
+
El.meta ~at:[At.name "twitter:description"; At.content description] ();
103
+
El.meta ~at:[At.name "twitter:image"; At.content image] ();
104
+
El.meta ~at:[At.name "theme-color"; At.content "#fff"] ();
105
+
El.meta ~at:[At.name "color-scheme"; At.content "white"] ();
106
+
El.link ~at:[At.rel "apple-touch-icon"; At.v "sizes" "180x180"; At.href "/assets/apple-touch-icon.png"] ();
107
+
El.link ~at:[At.rel "icon"; At.type' "image/png"; At.v "sizes" "32x32"; At.href "/assets/favicon-32x32.png"] ();
108
+
El.link ~at:[At.rel "icon"; At.type' "image/png"; At.v "sizes" "16x16"; At.href "/assets/favicon-16x16.png"] ();
109
+
El.link ~at:[At.rel "alternate"; At.type' "application/atom+xml"; At.title "Atom Feed"; At.href "/news.xml"] ();
110
+
El.link ~at:[At.rel "alternate"; At.type' "application/atom+xml"; At.title "Perma Feed (Significant Articles)"; At.href "/perma.xml"] ();
111
+
El.link ~at:[At.rel "alternate"; At.type' "application/feed+json"; At.title "JSON Feed"; At.href "/feed.json"] ();
112
+
El.link ~at:[At.rel "alternate"; At.type' "application/feed+json"; At.title "Perma JSON Feed (Significant Articles)"; At.href "/perma.json"] ();
113
+
El.link ~at:[At.rel "stylesheet"; At.href "/assets/site.css"] ();
114
+
El.link ~at:[At.rel "stylesheet"; At.href "/assets/highlight.min.css"] ();
115
+
El.unsafe_raw jsonld;
116
+
El.script ~at:[At.src "/assets/highlight.min.js"] [];
117
+
El.script [El.txt "hljs.highlightAll();"]
118
+
] in
119
+
120
+
(* Add standardsite link if present *)
121
+
let head_els = match standardsite with
122
+
| Some url -> head_els @ [El.link ~at:[At.rel "site.standard.document"; At.href url] ()]
123
+
| None -> head_els
124
+
in
125
+
126
+
let header_el = El.header ~at:[At.class' "site-header"] [
127
+
El.div ~at:[At.class' "header-content"] [
128
+
(* Site name on the left *)
129
+
El.h1 ~at:[At.class' "site-name"] [
130
+
El.a ~at:[At.href "/"] [El.txt cfg.site.name]
131
+
];
132
+
(* Navigation links *)
133
+
El.nav ~at:[At.class' "main-nav"] [
134
+
El.a ~at:[At.class' "nav-link"; At.href "/papers"] [
135
+
svg_icon_paper;
136
+
El.txt "Papers"
137
+
];
138
+
El.a ~at:[At.class' "nav-link"; At.href "/projects"] [
139
+
svg_icon_project;
140
+
El.txt "Projects"
141
+
];
142
+
El.a ~at:[At.class' "nav-link"; At.href "/notes"] [
143
+
svg_icon_note;
144
+
El.txt "Notes"
145
+
];
146
+
El.a ~at:[At.class' "nav-link"; At.href "/videos"] [
147
+
svg_icon_video;
148
+
El.txt "Talks"
149
+
];
150
+
El.a ~at:[At.class' "nav-link"; At.href "/ideas"] [
151
+
svg_icon_idea;
152
+
El.txt "Ideas"
153
+
]
154
+
];
155
+
(* Right side: Search *)
156
+
El.div ~at:[At.class' "header-right"] [
157
+
El.div ~at:[At.class' "search-container"] [
158
+
El.button ~at:[
159
+
At.class' "search-toggle";
160
+
At.v "aria-label" "Search";
161
+
At.id "search-toggle-btn"
162
+
] [
163
+
svg_icon_search;
164
+
El.span ~at:[At.class' "search-label"] [El.txt "Search"]
165
+
]
166
+
]
167
+
]
168
+
]
169
+
] in
170
+
171
+
let footer_el = El.footer [page_footer] in
172
+
173
+
let body_el = El.body ~at:[At.class' "light"] [
174
+
header_el;
175
+
El.div ~at:[At.class' "content-grid"] [content];
176
+
footer_el;
177
+
search_modal;
178
+
El.script ~at:[At.src "/assets/site.js"] []
179
+
] in
180
+
181
+
El.page ~lang:"en" ~title:title ~more_head:(El.splice head_els) body_el
182
+
183
+
let bushel_graph () =
184
+
let title = "Bushel Link Graph" in
185
+
let description = "Interactive force-directed graph visualization of links and backlinks in the Bushel dataset" in
186
+
187
+
let graph_html = El.div [
188
+
El.h1 [El.txt "Bushel Link Graph"];
189
+
190
+
El.div ~at:[At.id "controls"; At.style "margin: 20px 0; padding: 15px; background: #f5f5f5; border-radius: 5px;"] [
191
+
El.div ~at:[At.style "margin-bottom: 10px;"] [
192
+
El.strong [El.txt "Filter by type: "];
193
+
El.label ~at:[At.style "margin: 0 10px;"] [
194
+
El.input ~at:[At.type' "checkbox"; At.id "filter-paper"; At.checked; At.class' "type-filter"] ();
195
+
El.txt " Papers"
196
+
];
197
+
El.label ~at:[At.style "margin: 0 10px;"] [
198
+
El.input ~at:[At.type' "checkbox"; At.id "filter-project"; At.checked; At.class' "type-filter"] ();
199
+
El.txt " Projects"
200
+
];
201
+
El.label ~at:[At.style "margin: 0 10px;"] [
202
+
El.input ~at:[At.type' "checkbox"; At.id "filter-note"; At.checked; At.class' "type-filter"] ();
203
+
El.txt " Notes"
204
+
];
205
+
El.label ~at:[At.style "margin: 0 10px;"] [
206
+
El.input ~at:[At.type' "checkbox"; At.id "filter-idea"; At.checked; At.class' "type-filter"] ();
207
+
El.txt " Ideas"
208
+
];
209
+
El.label ~at:[At.style "margin: 0 10px;"] [
210
+
El.input ~at:[At.type' "checkbox"; At.id "filter-video"; At.checked; At.class' "type-filter"] ();
211
+
El.txt " Videos"
212
+
];
213
+
El.label ~at:[At.style "margin: 0 10px;"] [
214
+
El.input ~at:[At.type' "checkbox"; At.id "filter-contact"; At.checked; At.class' "type-filter"] ();
215
+
El.txt " Contacts"
216
+
];
217
+
El.label ~at:[At.style "margin: 0 10px;"] [
218
+
El.input ~at:[At.type' "checkbox"; At.id "filter-domain"; At.checked; At.class' "type-filter"] ();
219
+
El.txt " Domains"
220
+
]
221
+
];
222
+
El.div ~at:[At.style "margin-bottom: 10px;"] [
223
+
El.strong [El.txt "Link type: "];
224
+
El.label ~at:[At.style "margin: 0 10px;"] [
225
+
El.input ~at:[At.type' "checkbox"; At.id "filter-internal"; At.checked; At.class' "link-filter"] ();
226
+
El.txt " Internal"
227
+
];
228
+
El.label ~at:[At.style "margin: 0 10px;"] [
229
+
El.input ~at:[At.type' "checkbox"; At.id "filter-external"; At.checked; At.class' "link-filter"] ();
230
+
El.txt " External"
231
+
]
232
+
];
233
+
El.div [
234
+
El.button ~at:[At.id "reset-filters"; At.style "padding: 5px 15px; cursor: pointer;"] [El.txt "Reset Filters"]
235
+
]
236
+
];
237
+
238
+
El.div ~at:[At.id "graph"; At.style "width: 100%; height: 800px; border: 1px solid #ddd;"] [];
239
+
240
+
El.script ~at:[At.src "https://d3js.org/d3.v7.min.js"] [];
241
+
242
+
El.script [El.unsafe_raw {|
243
+
fetch('/bushel/graph.json')
244
+
.then(response => response.json())
245
+
.then(data => { initGraph(data); })
246
+
.catch(error => {
247
+
console.error('Error loading graph data:', error);
248
+
document.getElementById('graph').innerHTML = '<p style="color: red;">Error loading graph data</p>';
249
+
});
250
+
251
+
function initGraph(graphData) {
252
+
const width = document.getElementById('graph').offsetWidth;
253
+
const height = 800;
254
+
const colors = {
255
+
'paper': '#4285f4', 'project': '#ea4335', 'note': '#fbbc04',
256
+
'idea': '#34a853', 'video': '#ff6d00', 'contact': '#9c27b0', 'domain': '#607d8b'
257
+
};
258
+
const svg = d3.select('#graph').append('svg').attr('width', width).attr('height', height);
259
+
const g = svg.append('g');
260
+
svg.call(d3.zoom().scaleExtent([0.1, 4]).on('zoom', (event) => g.attr('transform', event.transform)));
261
+
const simulation = d3.forceSimulation(graphData.nodes)
262
+
.force('link', d3.forceLink(graphData.links).id(d => d.id).distance(d => d.type === 'external' ? 150 : 100))
263
+
.force('charge', d3.forceManyBody().strength(-300))
264
+
.force('center', d3.forceCenter(width / 2, height / 2))
265
+
.force('collision', d3.forceCollide().radius(30));
266
+
const link = g.append('g').selectAll('line').data(graphData.links).join('line')
267
+
.attr('class', d => 'link link-' + d.type)
268
+
.attr('stroke', d => d.type === 'internal' ? '#999' : '#ccc')
269
+
.attr('stroke-opacity', 0.6).attr('stroke-width', 1);
270
+
const node = g.append('g').selectAll('g').data(graphData.nodes).join('g')
271
+
.attr('class', d => 'node node-' + d.type).style('cursor', 'pointer')
272
+
.call(d3.drag().on('start', dragstarted).on('drag', dragged).on('end', dragended));
273
+
node.append('circle').attr('r', d => d.group === 'domain' ? 8 : 10)
274
+
.attr('fill', d => colors[d.type] || '#999').attr('stroke', '#fff').attr('stroke-width', 2);
275
+
node.append('text').text(d => d.group === 'domain' ? d.title : d.id)
276
+
.attr('x', 12).attr('y', 4).attr('font-size', '10px').attr('fill', '#333');
277
+
node.append('title').text(d => d.title + '\nType: ' + d.type);
278
+
simulation.on('tick', () => {
279
+
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);
280
+
node.attr('transform', d => 'translate(' + d.x + ',' + d.y + ')');
281
+
});
282
+
function dragstarted(event) { if (!event.active) simulation.alphaTarget(0.3).restart(); event.subject.fx = event.subject.x; event.subject.fy = event.subject.y; }
283
+
function dragged(event) { event.subject.fx = event.x; event.subject.fy = event.y; }
284
+
function dragended(event) { if (!event.active) simulation.alphaTarget(0); event.subject.fx = null; event.subject.fy = null; }
285
+
function updateFilters() {
286
+
const activeTypes = new Set();
287
+
document.querySelectorAll('.type-filter').forEach(cb => { if (cb.checked) activeTypes.add(cb.id.replace('filter-', '')); });
288
+
const activeLinks = new Set();
289
+
document.querySelectorAll('.link-filter').forEach(cb => { if (cb.checked) activeLinks.add(cb.id.replace('filter-', '')); });
290
+
node.style('display', d => activeTypes.has(d.type) ? null : 'none');
291
+
link.style('display', d => (activeTypes.has(d.source.type) && activeTypes.has(d.target.type) && activeLinks.has(d.type)) ? null : 'none');
292
+
simulation.alpha(0.3).restart();
293
+
}
294
+
document.querySelectorAll('.type-filter, .link-filter').forEach(cb => cb.addEventListener('change', updateFilters));
295
+
document.getElementById('reset-filters').addEventListener('click', () => {
296
+
document.querySelectorAll('.type-filter, .link-filter').forEach(cb => cb.checked = true);
297
+
updateFilters();
298
+
});
299
+
}
300
+
|}]
301
+
] in
302
+
303
+
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
+905
arod/lib/arod_view.ml
+905
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">#%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">#%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 hash_span = El.span ~at:[At.class' "hash-prefix"] [El.txt "#"] in
788
+
let link_el = match link with
789
+
| None -> El.a ~at:[At.href (Arod_model.Entry.site_url ent)] [hash_span]
790
+
| Some l -> El.a ~at:[At.href l] [hash_span]
791
+
in
792
+
793
+
let date_str = ptime_date ~with_d:true
794
+
(match date with None -> Arod_model.Entry.date ent | Some d -> d) in
795
+
796
+
let bullet = El.span ~at:[At.class' "meta-bullet"] [El.txt "•"] in
797
+
798
+
let sections = [] in
799
+
let sections = sections @ [[link_el; El.txt " "; El.txt date_str]] in
800
+
801
+
let sections = match ent with
802
+
| `Note n when Arod_model.Note.perma n ->
803
+
(match Arod_model.Note.doi n with
804
+
| Some doi_str ->
805
+
let doi_section = [
806
+
El.txt "DOI: ";
807
+
El.a ~at:[At.href ("https://doi.org/" ^ doi_str)] [El.txt doi_str]
808
+
] in
809
+
sections @ [doi_section]
810
+
| None -> sections)
811
+
| _ -> sections
812
+
in
813
+
814
+
let sections = match extra with
815
+
| Some v -> sections @ [[El.txt v]]
816
+
| None -> sections
817
+
in
818
+
819
+
let sections = match backlinks_content with
820
+
| Some content ->
821
+
let entry_slug = Arod_model.Entry.slug ent in
822
+
let checkbox_id = "sidenote__checkbox--backlinks-" ^ entry_slug in
823
+
let content_id = "sidenote-backlinks-" ^ entry_slug in
824
+
let backlinks_section = [
825
+
El.span ~at:[At.class' "sidenote"; At.v "role" "note"] [
826
+
El.input ~at:[
827
+
At.type' "checkbox";
828
+
At.id checkbox_id;
829
+
At.class' "sidenote__checkbox";
830
+
At.v "aria-label" "Show backlinks";
831
+
At.v "aria-hidden" "true";
832
+
At.v "hidden" ""
833
+
] ();
834
+
El.label ~at:[
835
+
At.v "for" checkbox_id;
836
+
At.class' "sidenote__button";
837
+
At.v "data-sidenote-number" "↑";
838
+
At.v "aria-describedby" content_id;
839
+
At.v "tabindex" "0"
840
+
] [El.txt "backlinks"];
841
+
El.span ~at:[
842
+
At.id content_id;
843
+
At.class' "sidenote__content";
844
+
At.v "aria-hidden" "true";
845
+
At.v "hidden" "";
846
+
At.v "data-sidenote-number" "↑"
847
+
] [content]
848
+
]
849
+
] in
850
+
sections @ [backlinks_section]
851
+
| None -> sections
852
+
in
853
+
854
+
let all_tags = Arod_model.concat_tags tags (Arod_model.tags_of_ent ent) in
855
+
let sections = match all_tags with
856
+
| [] -> sections
857
+
| tags ->
858
+
let tag_elements = List.map (fun tag ->
859
+
let tag_str = Arod_model.Tags.to_raw_string tag in
860
+
El.span ~at:[At.v "data-tag" tag_str; At.class' "tag-label"] [
861
+
El.txt tag_str
862
+
]
863
+
) tags in
864
+
let tags_section = List.fold_left (fun acc el ->
865
+
if acc = [] then [el]
866
+
else acc @ [El.txt ", "; el]
867
+
) [] tag_elements in
868
+
sections @ [tags_section]
869
+
in
870
+
871
+
let meta_parts = List.fold_left (fun acc section ->
872
+
if acc = [] then section
873
+
else acc @ [bullet] @ section
874
+
) [] sections in
875
+
876
+
El.div ~at:[At.class' "note-meta"] meta_parts
877
+
878
+
(** {1 References Section} *)
879
+
880
+
let note_references_html note =
881
+
let is_perma = Arod_model.Note.perma note in
882
+
let has_doi = match Arod_model.Note.doi note with Some _ -> true | None -> false in
883
+
if not (is_perma || has_doi) then
884
+
El.splice []
885
+
else
886
+
let cfg = Arod_model.get_config () in
887
+
let me = Arod_model.lookup_by_handle cfg.site.author_handle in
888
+
match me with
889
+
| None -> El.splice []
890
+
| Some author_contact ->
891
+
let references = Bushel.Md.note_references (Arod_model.get_entries ()) author_contact note in
892
+
if List.length references > 0 then
893
+
let ref_items = List.map (fun (doi, citation, _is_paper) ->
894
+
let doi_url = Printf.sprintf "https://doi.org/%s" doi in
895
+
El.li [
896
+
El.txt citation;
897
+
El.a ~at:[At.href doi_url; At.v "target" "_blank"] [El.i [El.txt doi]];
898
+
]
899
+
) references in
900
+
El.div ~at:[At.class' "references-section"] [
901
+
El.h3 ~at:[At.class' "references-heading"] [El.txt "References"];
902
+
El.ul ~at:[At.class' "references-list"] ref_items
903
+
]
904
+
else
905
+
El.splice []
+4
arod/lib/dune
+4
arod/lib/dune
+74
ocaml-bushel/lib/bushel_entry.ml
+74
ocaml-bushel/lib/bushel_entry.ml
···
194
194
| `Slug t -> lk t
195
195
| _ -> None
196
196
) tags
197
+
198
+
(** {1 Thumbnail Functions} *)
199
+
200
+
(** Get the smallest webp variant from a srcsetter image - prefers size just above 480px *)
201
+
let smallest_webp_variant img =
202
+
let variants = Srcsetter.variants img in
203
+
let webp_variants =
204
+
Srcsetter.MS.bindings variants
205
+
|> List.filter (fun (name, _) -> String.ends_with ~suffix:".webp" name)
206
+
in
207
+
match webp_variants with
208
+
| [] ->
209
+
(* No webp variants - use the name field which is always webp *)
210
+
"/images/" ^ Srcsetter.name img
211
+
| variants ->
212
+
(* Prefer variants with width > 480px, choosing the smallest one above 480 *)
213
+
let large_variants = List.filter (fun (_, (w, _)) -> w > 480) variants in
214
+
let candidates = if large_variants = [] then variants else large_variants in
215
+
(* Find the smallest variant from candidates *)
216
+
let smallest = List.fold_left (fun acc (name, (w, h)) ->
217
+
match acc with
218
+
| None -> Some (name, w, h)
219
+
| Some (_, min_w, _) when w < min_w -> Some (name, w, h)
220
+
| _ -> acc
221
+
) None candidates in
222
+
match smallest with
223
+
| Some (name, _, _) -> "/images/" ^ name
224
+
| None -> "/images/" ^ Srcsetter.name img
225
+
226
+
(** Get thumbnail slug for a contact *)
227
+
let contact_thumbnail_slug contact =
228
+
(* Contact images use just the handle as slug *)
229
+
Some (Sortal_schema.Contact.handle contact)
230
+
231
+
(** Get thumbnail URL for a contact - resolved through srcsetter *)
232
+
let contact_thumbnail entries contact =
233
+
match contact_thumbnail_slug contact with
234
+
| None -> None
235
+
| Some thumb_slug ->
236
+
match lookup_image entries thumb_slug with
237
+
| Some img -> Some (smallest_webp_variant img)
238
+
| None -> None
239
+
240
+
(** Get thumbnail slug for an entry - simple version *)
241
+
let rec thumbnail_slug entries = function
242
+
| `Paper p -> Some (Bushel_paper.slug p)
243
+
| `Video v -> Some (Bushel_video.uuid v)
244
+
| `Project p -> Some (Printf.sprintf "project-%s" (Bushel_project.slug p))
245
+
| `Idea i ->
246
+
(* Use project thumbnail for ideas *)
247
+
let project_slug = Bushel_idea.project i in
248
+
(match lookup entries project_slug with
249
+
| Some p -> thumbnail_slug entries p
250
+
| None -> None)
251
+
| `Note n ->
252
+
(* Use titleimage if set, otherwise try slug_ent's thumbnail *)
253
+
(match Bushel_note.titleimage n with
254
+
| Some slug -> Some slug
255
+
| None ->
256
+
match Bushel_note.slug_ent n with
257
+
| Some slug_ent ->
258
+
(match lookup entries slug_ent with
259
+
| Some entry -> thumbnail_slug entries entry
260
+
| None -> None)
261
+
| None -> None)
262
+
263
+
(** Get thumbnail URL for an entry with fallbacks - resolved through srcsetter *)
264
+
let thumbnail entries entry =
265
+
match thumbnail_slug entries entry with
266
+
| None -> None
267
+
| Some thumb_slug ->
268
+
match lookup_image entries thumb_slug with
269
+
| Some img -> Some (smallest_webp_variant img)
270
+
| None -> None
+17
ocaml-bushel/lib/bushel_entry.mli
+17
ocaml-bushel/lib/bushel_entry.mli
···
127
127
128
128
val mention_entries : t -> Bushel_tags.t list -> entry list
129
129
(** [mention_entries entries tags] returns entries mentioned in the tags. *)
130
+
131
+
(** {1 Thumbnail Functions} *)
132
+
133
+
val smallest_webp_variant : Srcsetter.t -> string
134
+
(** [smallest_webp_variant img] returns URL path to smallest webp variant above 480px. *)
135
+
136
+
val contact_thumbnail_slug : Sortal_schema.Contact.t -> string option
137
+
(** [contact_thumbnail_slug contact] returns the image slug for a contact. *)
138
+
139
+
val contact_thumbnail : t -> Sortal_schema.Contact.t -> string option
140
+
(** [contact_thumbnail entries contact] returns the thumbnail URL for a contact. *)
141
+
142
+
val thumbnail_slug : t -> entry -> string option
143
+
(** [thumbnail_slug entries entry] returns the image slug for an entry. *)
144
+
145
+
val thumbnail : t -> entry -> string option
146
+
(** [thumbnail entries entry] returns the thumbnail URL for an entry. *)
+263
ocaml-bushel/lib/bushel_md.ml
+263
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 title = Inline.Link.text lb |> text_of_inline in
220
+
let txt = Inline.Text (title, meta) in
221
+
let ld = Link_definition.make ~dest:(slug, 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
+
(* TODO: Add external DOI URL scanning and publisher URL resolution *)
886
+
(* This requires DOI caching infrastructure which is not yet ported *)
887
+
888
+
List.rev !refs