My aggregated monorepo of OCaml code, automaintained
Add arod webserver for Bushel content
This is a tiny_httpd-based webserver that serves Bushel content
(notes, papers, projects, ideas, videos) as a website.
Features:
- TOML configuration via tomlt with XDG path support
- Route handlers for all entry types (notes, papers, projects, ideas, videos)
- Static file serving for assets, images, and static files
- Custom markdown rendering with Bushel link resolution
- Image srcset support via srcsetter
- Video embed handling with YouTube URL rewriting
- Logging middleware with request timing
- CLI with serve, init, and config commands
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
+1297
+44
arod/arod.opam
+44
arod/arod.opam
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Webserver for Bushel content"
4
+
description: """
5
+
Arod is a tiny_httpd-based webserver that serves Bushel content
6
+
(notes, papers, projects, ideas, videos) as a website. It uses
7
+
TOML configuration for easy deployment and includes support for
8
+
responsive images, syntax highlighting, and feeds."""
9
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
10
+
authors: ["Anil Madhavapeddy <anil@recoil.org>"]
11
+
license: "ISC"
12
+
depends: [
13
+
"dune" {>= "3.18"}
14
+
"ocaml" {>= "5.2"}
15
+
"bushel" {>= "0.1"}
16
+
"tiny_httpd" {>= "0.17"}
17
+
"htmlit" {>= "0.1"}
18
+
"cmarkit" {>= "0.3"}
19
+
"uri" {>= "4.4"}
20
+
"ptime" {>= "1.2"}
21
+
"fmt" {>= "0.9"}
22
+
"tomlt" {>= "0.1"}
23
+
"eio" {>= "1.2"}
24
+
"eio_main"
25
+
"cmdliner"
26
+
"logs"
27
+
"unix"
28
+
"odoc" {with-doc}
29
+
]
30
+
build: [
31
+
["dune" "subst"] {dev}
32
+
[
33
+
"dune"
34
+
"build"
35
+
"-p"
36
+
name
37
+
"-j"
38
+
jobs
39
+
"@install"
40
+
"@runtest" {with-test}
41
+
"@doc" {with-doc}
42
+
]
43
+
]
44
+
x-maintenance-intent: ["(latest)"]
+19
arod/bin/dune
+19
arod/bin/dune
+390
arod/bin/main.ml
+390
arod/bin/main.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Arod webserver - a tiny_httpd based server for Bushel content *)
7
+
8
+
open Tiny_httpd
9
+
open Htmlit
10
+
11
+
(** {1 Logging} *)
12
+
13
+
let src = Logs.Src.create "arod" ~doc:"Arod webserver"
14
+
module Log = (val Logs.src_log src : Logs.LOG)
15
+
16
+
(** {1 Request Handlers} *)
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)
42
+
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)
71
+
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)
95
+
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)
120
+
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)
145
+
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)
169
+
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)
189
+
190
+
(** {1 Static File Handlers} *)
191
+
192
+
let static_file_handler ~dir path _req =
193
+
(* Remove any .. to prevent directory traversal *)
194
+
let clean_path =
195
+
let parts = String.split_on_char '/' path in
196
+
let safe_parts = List.filter (fun s -> s <> ".." && s <> ".") parts in
197
+
String.concat "/" safe_parts
198
+
in
199
+
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")
224
+
225
+
(** {1 Feed Handlers} *)
226
+
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>|})
232
+
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":[]}|})
238
+
239
+
(** {1 Logging Middleware} *)
240
+
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
250
+
251
+
(** {1 Server Setup} *)
252
+
253
+
let setup_routes server cfg =
254
+
(* Index *)
255
+
Server.add_route_handler server Route.(exact "/" @/ return) index_handler;
256
+
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;
264
+
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;
271
+
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);
282
+
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;
286
+
287
+
()
288
+
289
+
(** {1 CLI} *)
290
+
291
+
open Cmdliner
292
+
293
+
let setup_logging style_renderer level =
294
+
Fmt_tty.setup_std_outputs ?style_renderer ();
295
+
Logs.set_level level;
296
+
Logs.set_reporter (Logs_fmt.reporter ())
297
+
298
+
let logging_t =
299
+
let open Cmdliner in
300
+
Term.(const setup_logging $ Fmt_cli.style_renderer () $ Logs_cli.level ())
301
+
302
+
let config_file =
303
+
let doc = "Path to config file (default: ~/.config/arod/config.toml)." in
304
+
Arg.(value & opt (some file) None & info ["c"; "config"] ~docv:"FILE" ~doc)
305
+
306
+
let serve_cmd =
307
+
let run () config_file =
308
+
let cfg = Arod.Config.load_or_default ?path:config_file () in
309
+
Log.info (fun m -> m "Starting Arod server...");
310
+
Log.info (fun m -> m "Config:@.%a" Arod.Config.pp cfg);
311
+
312
+
Eio_main.run @@ fun env ->
313
+
let fs = Eio.Stdenv.fs env in
314
+
315
+
(* Load entries *)
316
+
Log.info (fun m -> m "Loading entries from %s" cfg.paths.data_dir);
317
+
let _entries = Arod.Model.init ~cfg fs in
318
+
Log.info (fun m -> m "Loaded %d notes, %d papers, %d projects, %d ideas, %d videos, %d images"
319
+
(List.length (Arod.Model.notes ()))
320
+
(List.length (Arod.Model.papers ()))
321
+
(List.length (Arod.Model.projects ()))
322
+
(List.length (Arod.Model.ideas ()))
323
+
(List.length (Arod.Model.videos ()))
324
+
(List.length (Arod.Model.images ())));
325
+
326
+
(* Create server *)
327
+
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;
329
+
setup_routes server cfg;
330
+
331
+
Log.app (fun m -> m "Listening on http://%s:%d" cfg.server.host cfg.server.port);
332
+
match Tiny_httpd.run server with
333
+
| Ok () -> 0
334
+
| Error e ->
335
+
Log.err (fun m -> m "Server error: %s" (Printexc.to_string e));
336
+
1
337
+
in
338
+
let doc = "Start the Arod webserver." in
339
+
let info = Cmd.info "serve" ~doc in
340
+
Cmd.v info Term.(const run $ logging_t $ config_file)
341
+
342
+
let init_cmd =
343
+
let run () =
344
+
let path = Arod.Config.config_file () in
345
+
let dir = Filename.dirname path in
346
+
if not (Sys.file_exists dir) then
347
+
Unix.mkdir dir 0o755;
348
+
if Sys.file_exists path then begin
349
+
Printf.eprintf "Config file already exists: %s\n" path;
350
+
1
351
+
end else begin
352
+
let oc = open_out path in
353
+
output_string oc Arod.Config.sample_config;
354
+
close_out oc;
355
+
Printf.printf "Created config file: %s\n" path;
356
+
0
357
+
end
358
+
in
359
+
let doc = "Initialize a default configuration file." in
360
+
let info = Cmd.info "init" ~doc in
361
+
Cmd.v info Term.(const run $ const ())
362
+
363
+
let config_cmd =
364
+
let run () config_file =
365
+
let cfg = Arod.Config.load_or_default ?path:config_file () in
366
+
Fmt.pr "%a\n" Arod.Config.pp cfg;
367
+
0
368
+
in
369
+
let doc = "Show current configuration." in
370
+
let info = Cmd.info "config" ~doc in
371
+
Cmd.v info Term.(const run $ logging_t $ config_file)
372
+
373
+
let main_cmd =
374
+
let doc = "Arod - a webserver for Bushel content" in
375
+
let man = [
376
+
`S Manpage.s_description;
377
+
`P "Arod is a tiny_httpd-based webserver that serves Bushel content \
378
+
(notes, papers, projects, ideas, videos) as a website.";
379
+
`S "CONFIGURATION";
380
+
`P "Configuration is read from ~/.config/arod/config.toml";
381
+
`P "Run $(b,arod init) to create a default config file.";
382
+
] in
383
+
let info = Cmd.info "arod" ~version:"0.1.0" ~doc ~man in
384
+
Cmd.group info [serve_cmd; init_cmd; config_cmd]
385
+
386
+
let () =
387
+
match Cmd.eval_value main_cmd with
388
+
| Ok (`Ok exit_code) -> exit exit_code
389
+
| Ok `Help | Ok `Version -> exit 0
390
+
| Error _ -> exit 1
+34
arod/dune-project
+34
arod/dune-project
···
1
+
(lang dune 3.18)
2
+
(name arod)
3
+
4
+
(generate_opam_files true)
5
+
(maintenance_intent "(latest)")
6
+
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy <anil@recoil.org>")
9
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
10
+
11
+
(package
12
+
(name arod)
13
+
(synopsis "Webserver for Bushel content")
14
+
(description
15
+
"Arod is a tiny_httpd-based webserver that serves Bushel content
16
+
(notes, papers, projects, ideas, videos) as a website. It uses
17
+
TOML configuration for easy deployment and includes support for
18
+
responsive images, syntax highlighting, and feeds.")
19
+
(depends
20
+
(ocaml (>= 5.2))
21
+
(bushel (>= 0.1))
22
+
(tiny_httpd (>= 0.17))
23
+
(htmlit (>= 0.1))
24
+
(cmarkit (>= 0.3))
25
+
(uri (>= 4.4))
26
+
(ptime (>= 1.2))
27
+
(fmt (>= 0.9))
28
+
(tomlt (>= 0.1))
29
+
(eio (>= 1.2))
30
+
eio_main
31
+
cmdliner
32
+
logs
33
+
unix
34
+
(odoc :with-doc)))
+24
arod/lib/arod.ml
+24
arod/lib/arod.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Arod - Webserver for Bushel content
7
+
8
+
Arod is a tiny_httpd-based webserver that serves Bushel content
9
+
(notes, papers, projects, ideas, videos) as a website.
10
+
11
+
{1 Core Modules}
12
+
13
+
- {!Config} - TOML configuration
14
+
- {!Model} - Bushel bridge layer
15
+
- {!Html} - HTML generation with htmlit *)
16
+
17
+
module Config = Arod_config
18
+
(** TOML-based configuration for the webserver. *)
19
+
20
+
module Model = Arod_model
21
+
(** Model layer bridging Bushel to the webserver. *)
22
+
23
+
module Html = Arod_html
24
+
(** HTML generation using htmlit. *)
+244
arod/lib/arod_config.ml
+244
arod/lib/arod_config.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Configuration for the Arod webserver *)
7
+
8
+
type server = {
9
+
host : string;
10
+
port : int;
11
+
}
12
+
13
+
type paths = {
14
+
data_dir : string;
15
+
assets_dir : string;
16
+
images_dir : string;
17
+
static_dir : string;
18
+
}
19
+
20
+
type site = {
21
+
base_url : string;
22
+
name : string;
23
+
description : string;
24
+
author_handle : string;
25
+
author_name : string;
26
+
author_email : string option;
27
+
author_orcid : string option;
28
+
}
29
+
30
+
type feeds = {
31
+
title : string;
32
+
subtitle : string option;
33
+
}
34
+
35
+
type well_known_entry = {
36
+
key : string;
37
+
value : string;
38
+
}
39
+
40
+
type t = {
41
+
server : server;
42
+
paths : paths;
43
+
site : site;
44
+
feeds : feeds;
45
+
well_known : well_known_entry list;
46
+
}
47
+
48
+
(** Path expansion helper - expands ~ to home directory *)
49
+
let expand_path p =
50
+
if String.length p > 0 && p.[0] = '~' then
51
+
let home = Sys.getenv_opt "HOME" |> Option.value ~default:"/tmp" in
52
+
home ^ String.sub p 1 (String.length p - 1)
53
+
else p
54
+
55
+
(** Default configuration *)
56
+
let default =
57
+
let home = Sys.getenv_opt "HOME" |> Option.value ~default:"/tmp" in
58
+
{
59
+
server = {
60
+
host = "0.0.0.0";
61
+
port = 8080;
62
+
};
63
+
paths = {
64
+
data_dir = Filename.concat home "bushel";
65
+
assets_dir = "./assets";
66
+
images_dir = Filename.concat home "bushel/images/web";
67
+
static_dir = "./static";
68
+
};
69
+
site = {
70
+
base_url = "http://localhost:8080";
71
+
name = "My Site";
72
+
description = "A personal website powered by Bushel";
73
+
author_handle = "me";
74
+
author_name = "Site Author";
75
+
author_email = None;
76
+
author_orcid = None;
77
+
};
78
+
feeds = {
79
+
title = "Site Feed";
80
+
subtitle = None;
81
+
};
82
+
well_known = [];
83
+
}
84
+
85
+
(** {1 TOML Codecs} *)
86
+
87
+
(** String codec with path expansion *)
88
+
let path_string =
89
+
Tomlt.(map string ~dec:expand_path)
90
+
91
+
let server_codec =
92
+
Tomlt.(Table.(
93
+
obj (fun host port -> { host; port })
94
+
|> mem "host" string ~dec_absent:default.server.host ~enc:(fun s -> s.host)
95
+
|> mem "port" int ~dec_absent:default.server.port ~enc:(fun s -> s.port)
96
+
|> finish
97
+
))
98
+
99
+
let paths_codec =
100
+
Tomlt.(Table.(
101
+
obj (fun data_dir assets_dir images_dir static_dir ->
102
+
{ data_dir; assets_dir; images_dir; static_dir })
103
+
|> mem "data_dir" path_string ~dec_absent:default.paths.data_dir ~enc:(fun p -> p.data_dir)
104
+
|> mem "assets_dir" path_string ~dec_absent:default.paths.assets_dir ~enc:(fun p -> p.assets_dir)
105
+
|> mem "images_dir" path_string ~dec_absent:default.paths.images_dir ~enc:(fun p -> p.images_dir)
106
+
|> mem "static_dir" path_string ~dec_absent:default.paths.static_dir ~enc:(fun p -> p.static_dir)
107
+
|> finish
108
+
))
109
+
110
+
let site_codec =
111
+
Tomlt.(Table.(
112
+
obj (fun base_url name description author_handle author_name author_email author_orcid ->
113
+
{ base_url; name; description; author_handle; author_name; author_email; author_orcid })
114
+
|> mem "base_url" string ~dec_absent:default.site.base_url ~enc:(fun s -> s.base_url)
115
+
|> mem "name" string ~dec_absent:default.site.name ~enc:(fun s -> s.name)
116
+
|> mem "description" string ~dec_absent:default.site.description ~enc:(fun s -> s.description)
117
+
|> mem "author_handle" string ~dec_absent:default.site.author_handle ~enc:(fun s -> s.author_handle)
118
+
|> mem "author_name" string ~dec_absent:default.site.author_name ~enc:(fun s -> s.author_name)
119
+
|> opt_mem "author_email" string ~enc:(fun s -> s.author_email)
120
+
|> opt_mem "author_orcid" string ~enc:(fun s -> s.author_orcid)
121
+
|> finish
122
+
))
123
+
124
+
let feeds_codec =
125
+
Tomlt.(Table.(
126
+
obj (fun title subtitle -> { title; subtitle })
127
+
|> mem "title" string ~dec_absent:default.feeds.title ~enc:(fun f -> f.title)
128
+
|> opt_mem "subtitle" string ~enc:(fun f -> f.subtitle)
129
+
|> finish
130
+
))
131
+
132
+
let well_known_entry_codec =
133
+
Tomlt.(Table.(
134
+
obj (fun key value -> { key; value })
135
+
|> mem "key" string ~enc:(fun e -> e.key)
136
+
|> mem "value" string ~enc:(fun e -> e.value)
137
+
|> finish
138
+
))
139
+
140
+
(** Codec for well_known as a table of key-value pairs *)
141
+
let well_known_codec =
142
+
Tomlt.(Table.(
143
+
keep_unknown
144
+
~enc:(fun wk -> List.map (fun e -> (e.key, e.value)) wk)
145
+
(Mems.assoc string)
146
+
(obj (fun assoc -> List.map (fun (key, value) -> { key; value }) assoc))
147
+
|> finish
148
+
))
149
+
150
+
let config_codec =
151
+
Tomlt.(Table.(
152
+
obj (fun server paths site feeds well_known ->
153
+
{ server; paths; site; feeds; well_known })
154
+
|> mem "server" server_codec ~dec_absent:default.server ~enc:(fun c -> c.server)
155
+
|> mem "paths" paths_codec ~dec_absent:default.paths ~enc:(fun c -> c.paths)
156
+
|> mem "site" site_codec ~dec_absent:default.site ~enc:(fun c -> c.site)
157
+
|> mem "feeds" feeds_codec ~dec_absent:default.feeds ~enc:(fun c -> c.feeds)
158
+
|> mem "well_known" well_known_codec ~dec_absent:[] ~enc:(fun c -> c.well_known)
159
+
|> finish
160
+
))
161
+
162
+
let of_toml_string s =
163
+
match Tomlt_bytesrw.decode_string config_codec s with
164
+
| Ok cfg -> cfg
165
+
| Error e -> failwith (Tomlt.Error.to_string e)
166
+
167
+
let of_file path =
168
+
let ic = open_in path in
169
+
let content = really_input_string ic (in_channel_length ic) in
170
+
close_in ic;
171
+
of_toml_string content
172
+
173
+
let config_file () =
174
+
let xdg_config = Sys.getenv_opt "XDG_CONFIG_HOME" in
175
+
let home = Sys.getenv_opt "HOME" in
176
+
match xdg_config, home with
177
+
| Some xdg, _ -> Filename.concat xdg "arod/config.toml"
178
+
| None, Some h -> Filename.concat h ".config/arod/config.toml"
179
+
| None, None -> "./config.toml"
180
+
181
+
let load_or_default ?path () =
182
+
let path = match path with
183
+
| Some p -> p
184
+
| None -> config_file ()
185
+
in
186
+
if Sys.file_exists path then
187
+
of_file path
188
+
else
189
+
default
190
+
191
+
(** {1 Sample Config Generation} *)
192
+
193
+
let sample_config = {|# Arod Webserver Configuration
194
+
195
+
[server]
196
+
host = "0.0.0.0"
197
+
port = 8080
198
+
199
+
[paths]
200
+
# Bushel data directory (notes, papers, projects, etc.)
201
+
data_dir = "~/bushel"
202
+
# Static assets (CSS, JS, icons)
203
+
assets_dir = "./assets"
204
+
# Processed images from srcsetter
205
+
images_dir = "~/bushel/images/web"
206
+
# Static files (PDFs, etc.)
207
+
static_dir = "./static"
208
+
209
+
[site]
210
+
base_url = "https://example.com"
211
+
name = "My Site"
212
+
description = "A personal website powered by Bushel"
213
+
author_handle = "me"
214
+
author_name = "Your Name"
215
+
# author_email = "you@example.com"
216
+
# author_orcid = "0000-0000-0000-0000"
217
+
218
+
[feeds]
219
+
title = "Site Feed"
220
+
# subtitle = "Latest posts and updates"
221
+
222
+
# Optional: well-known endpoints for AT Protocol, etc.
223
+
# [well_known]
224
+
# "site.standard.publication" = "at://did:plc:example/app.bsky.feed.post/id"
225
+
|}
226
+
227
+
(** {1 Pretty Printing} *)
228
+
229
+
let pp ppf t =
230
+
let open Fmt in
231
+
pf ppf "@[<v>";
232
+
pf ppf "Server:@,";
233
+
pf ppf " host: %s@," t.server.host;
234
+
pf ppf " port: %d@," t.server.port;
235
+
pf ppf "@,Paths:@,";
236
+
pf ppf " data_dir: %s@," t.paths.data_dir;
237
+
pf ppf " assets_dir: %s@," t.paths.assets_dir;
238
+
pf ppf " images_dir: %s@," t.paths.images_dir;
239
+
pf ppf " static_dir: %s@," t.paths.static_dir;
240
+
pf ppf "@,Site:@,";
241
+
pf ppf " base_url: %s@," t.site.base_url;
242
+
pf ppf " name: %s@," t.site.name;
243
+
pf ppf " author: %s (@%s)@," t.site.author_name t.site.author_handle;
244
+
pf ppf "@]"
+320
arod/lib/arod_html.ml
+320
arod/lib/arod_html.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Htmlit-based HTML generation for Arod *)
7
+
8
+
open Htmlit
9
+
10
+
(** {1 Attribute Helpers} *)
11
+
12
+
let class_ c = At.class' c
13
+
let id i = At.id i
14
+
let href h = At.href h
15
+
let alt a = At.alt a
16
+
let src s = At.src s
17
+
let title t = At.title t
18
+
let name n = At.name n
19
+
let content c = At.content c
20
+
let loading l = At.v "loading" l
21
+
let sizes s = At.v "sizes" s
22
+
let srcset s = At.v "srcset" s
23
+
let data_tag t = At.v "data-tag" t
24
+
let frameborder f = At.v "frameborder" f
25
+
let allowfullscreen = At.v "allowfullscreen" ""
26
+
let sandbox s = At.v "sandbox" s
27
+
let width w = At.v "width" w
28
+
let height h = At.v "height" h
29
+
let rel r = At.rel r
30
+
let property p = At.v "property" p
31
+
let http_equiv h = At.v "http-equiv" h
32
+
let type_ t = At.type' t
33
+
let lang l = At.lang l
34
+
35
+
(** {1 SVG Icons} *)
36
+
37
+
let svg_icon_paper =
38
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M16 7 C16 7 9 1 2 6 L2 28 C9 23 16 28 16 28 16 28 23 23 30 28 L30 6 C23 1 16 7 16 7 Z M16 7 L16 28" /></svg>|}
39
+
40
+
let svg_icon_project =
41
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M30 8 L2 8 2 26 30 26 Z M20 8 C20 8 20 4 16 4 12 4 12 8 12 8 M8 26 L8 8 M24 26 L24 8" /></svg>|}
42
+
43
+
let svg_icon_note =
44
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M27 15 L27 30 2 30 2 5 17 5 M30 6 L26 2 9 19 7 25 13 23 Z M22 6 L26 10 Z M9 19 L13 23 Z" /></svg>|}
45
+
46
+
let svg_icon_video =
47
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M22 13 L30 8 30 24 22 19 Z M2 8 L2 24 22 24 22 8 Z" /></svg>|}
48
+
49
+
let svg_icon_idea =
50
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 32 32" width="18" height="18" fill="none" stroke="currentcolor" stroke-linecap="round" stroke-linejoin="round" stroke-width="2"><path d="M18 13 L26 2 8 13 14 19 6 30 24 19 Z" /></svg>|}
51
+
52
+
let svg_icon_search =
53
+
El.unsafe_raw {|<svg xmlns="http://www.w3.org/2000/svg" viewBox="0 0 24 24" width="18" height="18" fill="none" stroke="currentColor" stroke-width="2" stroke-linecap="round" stroke-linejoin="round"><circle cx="11" cy="11" r="8"/><path d="m21 21-4.35-4.35"/></svg>|}
54
+
55
+
(** {1 Date Formatting} *)
56
+
57
+
let int_to_date_suffix ~r n =
58
+
let suffix =
59
+
if n mod 10 = 1 && n mod 100 <> 11 then "st"
60
+
else if n mod 10 = 2 && n mod 100 <> 12 then "nd"
61
+
else if n mod 10 = 3 && n mod 100 <> 13 then "rd"
62
+
else "th"
63
+
in
64
+
let x = string_of_int n in
65
+
let x = if r && String.length x = 1 then " " ^ x else x in
66
+
x ^ suffix
67
+
68
+
let month_name = function
69
+
| 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr"
70
+
| 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aug"
71
+
| 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec"
72
+
| _ -> ""
73
+
74
+
let ptime_date ?(r=false) ?(with_d=false) (y, m, d) =
75
+
let ms = month_name m in
76
+
match with_d with
77
+
| false -> Printf.sprintf "%s %4d" ms y
78
+
| true -> Printf.sprintf "%s %s %4d" (int_to_date_suffix ~r d) ms y
79
+
80
+
(** {1 Image Rendering} *)
81
+
82
+
let img ?cl ?(alt_text="") ?(title_text="") img_ent =
83
+
let origin_url = Printf.sprintf "/images/%s.webp"
84
+
(Filename.chop_extension (Arod_model.Img.origin img_ent)) in
85
+
86
+
let srcsets =
87
+
let variants = Arod_model.Img.variants img_ent in
88
+
String.concat ","
89
+
(Arod_model.Img.MS.fold (fun f (w, _h) acc ->
90
+
Printf.sprintf "/images/%s %dw" f w :: acc
91
+
) variants [])
92
+
in
93
+
94
+
let base_attrs = [
95
+
loading "lazy";
96
+
src origin_url;
97
+
srcset srcsets;
98
+
sizes "(max-width: 768px) 100vw, 33vw"
99
+
] in
100
+
101
+
let attrs = match cl with
102
+
| Some c -> class_ c :: base_attrs
103
+
| None -> base_attrs
104
+
in
105
+
106
+
match alt_text with
107
+
| "%r" ->
108
+
El.figure ~at:[class_ "image-right"] [
109
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
110
+
El.figcaption [El.txt title_text]
111
+
]
112
+
| "%c" ->
113
+
El.figure ~at:[class_ "image-center"] [
114
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
115
+
El.figcaption [El.txt title_text]
116
+
]
117
+
| "%lc" ->
118
+
El.figure ~at:[class_ "image-left-float"] [
119
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
120
+
El.figcaption [El.txt title_text]
121
+
]
122
+
| "%rc" ->
123
+
El.figure ~at:[class_ "image-right-float"] [
124
+
El.img ~at:(At.alt title_text :: At.title title_text :: attrs) ();
125
+
El.figcaption [El.txt title_text]
126
+
]
127
+
| _ ->
128
+
El.img ~at:(At.alt alt_text :: At.title title_text :: attrs) ()
129
+
130
+
(** {1 Tag Rendering} *)
131
+
132
+
let render_tag ?active tag_value =
133
+
let active_cl = match active with Some true -> " tag-active" | _ -> "" in
134
+
135
+
let icon, text =
136
+
match tag_value with
137
+
| `Slug t ->
138
+
(match Arod_model.lookup t with
139
+
| Some ent ->
140
+
let icon_name = match ent with
141
+
| `Paper _ -> Some "paper.svg"
142
+
| `Note _ -> Some "note.svg"
143
+
| `Project _ -> Some "project.svg"
144
+
| `Idea _ -> Some "idea.svg"
145
+
| `Video _ -> Some "video.svg"
146
+
in
147
+
icon_name, Arod_model.Entry.slug ent
148
+
| None -> None, t)
149
+
| `Set slug ->
150
+
let icon_name = match slug with
151
+
| "papers" -> Some "paper.svg"
152
+
| "notes" -> Some "note.svg"
153
+
| "projects" -> Some "project.svg"
154
+
| "ideas" -> Some "idea.svg"
155
+
| "videos" | "talks" -> Some "video.svg"
156
+
| _ -> None
157
+
in
158
+
icon_name, slug
159
+
| _ -> None, Arod_model.Tags.to_string tag_value
160
+
in
161
+
162
+
let t = Arod_model.Tags.to_string tag_value in
163
+
let icon_el = match icon with
164
+
| None -> El.splice []
165
+
| Some icon_name ->
166
+
El.img ~at:[
167
+
alt "icon";
168
+
class_ "hide-mobile inline-icon";
169
+
src (Printf.sprintf "/assets/%s" icon_name)
170
+
] ()
171
+
in
172
+
173
+
El.span ~at:[
174
+
data_tag t;
175
+
class_ ("tag-label" ^ active_cl)
176
+
] [icon_el; El.txt text]
177
+
178
+
let render_tags tags =
179
+
let filtered_tags = List.filter (function
180
+
| `Text _ | `Set _ -> true
181
+
| _ -> false
182
+
) tags in
183
+
El.splice ~sep:(El.txt " ") (List.map render_tag filtered_tags)
184
+
185
+
(** {1 Entry Rendering} *)
186
+
187
+
let entry_href ?title_override ?(tag="h2") ent =
188
+
let title_text = match title_override with
189
+
| None -> Arod_model.Entry.title ent
190
+
| Some t -> t
191
+
in
192
+
193
+
match ent with
194
+
| `Note { Arod_model.Note.index_page = true; _ } -> El.splice []
195
+
| _ ->
196
+
let h_fn = match tag with
197
+
| "h1" -> El.h1
198
+
| "h2" -> El.h2
199
+
| "h3" -> El.h3
200
+
| "h4" -> El.h4
201
+
| _ -> El.h2
202
+
in
203
+
h_fn [
204
+
El.a ~at:[href (Arod_model.Entry.site_url ent)] [El.txt title_text];
205
+
El.span ~at:[class_ "title-date"] [
206
+
El.txt " / ";
207
+
El.txt (ptime_date ~with_d:false (Arod_model.Entry.date ent))
208
+
]
209
+
]
210
+
211
+
let tags_meta ?link ?(tags=[]) ?date ent =
212
+
let tags = List.map Arod_model.Tags.of_string tags in
213
+
let link_el = match link with
214
+
| None -> El.a ~at:[href (Arod_model.Entry.site_url ent)] [El.txt "#"]
215
+
| Some l -> El.a ~at:[href l] [El.txt "#"]
216
+
in
217
+
218
+
let date_str = ptime_date ~with_d:true
219
+
(match date with None -> Arod_model.Entry.date ent | Some d -> d) in
220
+
221
+
El.div ~at:[class_ "note-meta"] [
222
+
link_el;
223
+
El.txt " ";
224
+
El.txt date_str;
225
+
El.txt " ";
226
+
El.span ~at:[class_ "tags"] [
227
+
render_tags (Arod_model.concat_tags tags (Arod_model.tags_of_ent ent))
228
+
]
229
+
]
230
+
231
+
let full_body ent =
232
+
El.unsafe_raw (Arod_model.md_to_html (Arod_model.Entry.body ent))
233
+
234
+
(** {1 Video Embedding} *)
235
+
236
+
let embed_video ~video_title ~url =
237
+
El.div ~at:[class_ "video-center"] [
238
+
El.iframe ~at:[
239
+
title video_title;
240
+
width "100%";
241
+
height "315px";
242
+
src url;
243
+
frameborder "0";
244
+
allowfullscreen;
245
+
sandbox "allow-same-origin allow-scripts allow-popups allow-forms"
246
+
] []
247
+
]
248
+
249
+
(** {1 Page Layout} *)
250
+
251
+
let page ?(image="/assets/imagetitle-default.jpg") ?(jsonld="") ~page_title ~description ~page_content () =
252
+
let cfg = Arod_model.get_config () in
253
+
let title_text = if page_title = "" then cfg.site.name else page_title in
254
+
255
+
let head_els = [
256
+
El.meta ~at:[http_equiv "X-UA-Compatible"; content "ie=edge"] ();
257
+
El.meta ~at:[name "description"; content description] ();
258
+
El.meta ~at:[property "og:image"; content image] ();
259
+
El.meta ~at:[property "og:site_name"; content cfg.site.name] ();
260
+
El.meta ~at:[property "og:type"; content "object"] ();
261
+
El.meta ~at:[property "og:title"; content title_text] ();
262
+
El.meta ~at:[property "og:description"; content description] ();
263
+
El.meta ~at:[name "twitter:card"; content "summary_large_image"] ();
264
+
El.meta ~at:[name "twitter:title"; content title_text] ();
265
+
El.meta ~at:[name "twitter:description"; content description] ();
266
+
El.meta ~at:[name "twitter:image"; content image] ();
267
+
El.meta ~at:[name "theme-color"; content "#fff"] ();
268
+
El.meta ~at:[name "color-scheme"; content "white"] ();
269
+
El.link ~at:[rel "apple-touch-icon"; sizes "180x180"; href "/assets/apple-touch-icon.png"] ();
270
+
El.link ~at:[rel "icon"; type_ "image/png"; sizes "32x32"; href "/assets/favicon-32x32.png"] ();
271
+
El.link ~at:[rel "icon"; type_ "image/png"; sizes "16x16"; href "/assets/favicon-16x16.png"] ();
272
+
El.link ~at:[rel "alternate"; type_ "application/atom+xml"; At.title "Atom Feed"; href "/news.xml"] ();
273
+
El.link ~at:[rel "alternate"; type_ "application/feed+json"; At.title "JSON Feed"; href "/feed.json"] ();
274
+
El.link ~at:[rel "stylesheet"; href "/assets/site.css"] ();
275
+
El.link ~at:[rel "stylesheet"; href "/assets/highlight.min.css"] ();
276
+
El.unsafe_raw jsonld;
277
+
El.script ~at:[src "/assets/highlight.min.js"] [];
278
+
El.script [El.txt "hljs.highlightAll();"]
279
+
] in
280
+
281
+
let header_el = El.header ~at:[class_ "site-header"] [
282
+
El.div ~at:[class_ "header-content"] [
283
+
El.h1 ~at:[class_ "site-name"] [
284
+
El.a ~at:[href "/"] [El.txt cfg.site.name]
285
+
];
286
+
El.nav ~at:[class_ "main-nav"] [
287
+
El.a ~at:[class_ "nav-link"; href "/papers"] [svg_icon_paper; El.txt "Papers"];
288
+
El.a ~at:[class_ "nav-link"; href "/projects"] [svg_icon_project; El.txt "Projects"];
289
+
El.a ~at:[class_ "nav-link"; href "/notes"] [svg_icon_note; El.txt "Notes"];
290
+
El.a ~at:[class_ "nav-link"; href "/videos"] [svg_icon_video; El.txt "Talks"];
291
+
El.a ~at:[class_ "nav-link"; href "/ideas"] [svg_icon_idea; El.txt "Ideas"];
292
+
];
293
+
El.div ~at:[class_ "header-right"] [
294
+
El.div ~at:[class_ "search-container"] [
295
+
El.button ~at:[class_ "search-toggle"; At.v "aria-label" "Search"; id "search-toggle-btn"] [
296
+
svg_icon_search;
297
+
El.span ~at:[class_ "search-label"] [El.txt "Search"]
298
+
]
299
+
]
300
+
]
301
+
]
302
+
] in
303
+
304
+
let footer_el = El.footer [
305
+
El.txt (Printf.sprintf "Powered by Bushel | %s" cfg.site.name)
306
+
] in
307
+
308
+
let body_el = El.body ~at:[class_ "light"] [
309
+
header_el;
310
+
El.div ~at:[class_ "content-grid"] [page_content];
311
+
footer_el;
312
+
El.script ~at:[src "/assets/site.js"] [];
313
+
] in
314
+
315
+
El.page ~lang:"en" ~title:title_text ~more_head:(El.splice head_els) body_el
316
+
317
+
(** {1 Output Helpers} *)
318
+
319
+
let to_string el = El.to_string ~doctype:false el
320
+
let to_page el = El.to_string ~doctype:true el
+207
arod/lib/arod_model.ml
+207
arod/lib/arod_model.ml
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Model layer bridging Bushel to the Arod webserver *)
7
+
8
+
(** Re-export Bushel modules for convenience *)
9
+
module Paper = Bushel.Paper
10
+
module Note = Bushel.Note
11
+
module Idea = Bushel.Idea
12
+
module Project = Bushel.Project
13
+
module Video = Bushel.Video
14
+
module Entry = Bushel.Entry
15
+
module Tags = Bushel.Tags
16
+
module Md = Bushel.Md
17
+
module Util = Bushel.Util
18
+
module Img = Srcsetter
19
+
20
+
(** {1 Global State} *)
21
+
22
+
(** The loaded entries - set once at startup *)
23
+
let entries : Bushel.Entry.t option ref = ref None
24
+
25
+
(** The site configuration *)
26
+
let config : Arod_config.t option ref = ref None
27
+
28
+
(** Get the loaded entries, raising if not initialized *)
29
+
let get_entries () =
30
+
match !entries with
31
+
| Some e -> e
32
+
| None -> failwith "Arod_model: entries not loaded"
33
+
34
+
(** Get the site config *)
35
+
let get_config () =
36
+
match !config with
37
+
| Some c -> c
38
+
| None -> Arod_config.default
39
+
40
+
(** {1 Initialization} *)
41
+
42
+
(** Load entries from the configured data directory *)
43
+
let init ~cfg fs =
44
+
config := Some cfg;
45
+
let image_output_dir = cfg.Arod_config.paths.images_dir in
46
+
let data_dir = cfg.paths.data_dir in
47
+
let loaded = Bushel_eio.Bushel_loader.load ~image_output_dir fs data_dir in
48
+
entries := Some loaded;
49
+
loaded
50
+
51
+
(** {1 Lookup Functions} *)
52
+
53
+
let lookup slug =
54
+
Entry.lookup (get_entries ()) slug
55
+
56
+
let lookup_exn slug =
57
+
Entry.lookup_exn (get_entries ()) slug
58
+
59
+
let lookup_image slug =
60
+
Entry.lookup_image (get_entries ()) slug
61
+
62
+
let lookup_by_handle handle =
63
+
let contacts = Entry.contacts (get_entries ()) in
64
+
List.find_opt (fun c -> Sortal_schema.Contact.handle c = handle) contacts
65
+
66
+
let lookup_by_name name =
67
+
Entry.lookup_by_name (get_entries ()) name
68
+
69
+
(** {1 Entry Accessors} *)
70
+
71
+
let papers () = Entry.papers (get_entries ())
72
+
let notes () = Entry.notes (get_entries ())
73
+
let ideas () = Entry.ideas (get_entries ())
74
+
let projects () = Entry.projects (get_entries ())
75
+
let videos () = Entry.videos (get_entries ())
76
+
let contacts () = Entry.contacts (get_entries ())
77
+
let images () = Entry.images (get_entries ())
78
+
let all_entries () = Entry.all_entries (get_entries ())
79
+
80
+
(** {1 Author/Site Identity} *)
81
+
82
+
let author () =
83
+
let cfg = get_config () in
84
+
lookup_by_handle cfg.site.author_handle
85
+
86
+
let author_name () =
87
+
match author () with
88
+
| Some c -> Sortal_schema.Contact.name c
89
+
| None -> (get_config ()).site.author_name
90
+
91
+
let base_url () = (get_config ()).site.base_url
92
+
let site_name () = (get_config ()).site.name
93
+
let site_description () = (get_config ()).site.description
94
+
95
+
(** {1 Markdown Rendering} *)
96
+
97
+
(** Custom HTML renderer for Cmarkit that handles Bushel extensions *)
98
+
let custom_html_renderer () =
99
+
let open Cmarkit in
100
+
let open Cmarkit_renderer.Context in
101
+
let inline c = function
102
+
| Inline.Image (img, _meta) ->
103
+
(* Handle bushel image syntax *)
104
+
(match Inline.Link.reference img with
105
+
| `Inline (ld, _) ->
106
+
(match Link_definition.dest ld with
107
+
| Some (src, _) when Md.is_bushel_slug src ->
108
+
let slug = Md.strip_handle src in
109
+
let title = match Link_definition.title ld with
110
+
| Some lines -> String.concat "" (List.map Block_line.tight_to_string lines)
111
+
| None -> ""
112
+
in
113
+
let caption =
114
+
Inline.Link.text img
115
+
|> Inline.to_plain_text ~break_on_soft:false
116
+
|> fun r -> String.concat "\n" (List.map (String.concat "") r)
117
+
in
118
+
(* Check if this is a video *)
119
+
(match lookup slug with
120
+
| Some (`Video v) ->
121
+
let video_url = Video.url v in
122
+
let embed_url =
123
+
let uri = Uri.of_string video_url in
124
+
let path = Uri.path uri |> String.split_on_char '/' in
125
+
let path = List.map (function "watch" -> "embed" | p -> p) path in
126
+
Uri.with_path uri (String.concat "/" path) |> Uri.to_string
127
+
in
128
+
let html = Printf.sprintf
129
+
{|<div class="video-center"><iframe title="%s" width="100%%" height="315px" src="%s" frameborder="0" allowfullscreen sandbox="allow-same-origin allow-scripts allow-popups allow-forms"></iframe></div>|}
130
+
title embed_url
131
+
in
132
+
string c html;
133
+
true
134
+
| _ ->
135
+
(* Image handling *)
136
+
let img_info = lookup_image slug in
137
+
let dest = match img_info with
138
+
| Some img -> "/images/" ^ Img.name img
139
+
| None -> "/images/" ^ slug ^ ".webp"
140
+
in
141
+
(* Check for positioning directive *)
142
+
(match caption with
143
+
| "%c" | "%r" | "%lc" | "%rc" ->
144
+
let fig_class = match caption with
145
+
| "%c" -> "image-center"
146
+
| "%r" -> "image-right"
147
+
| "%lc" -> "image-left-float"
148
+
| "%rc" -> "image-right-float"
149
+
| _ -> "image-center"
150
+
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
+
let html = Printf.sprintf
162
+
{|<figure class="%s"><img src="%s" alt="%s" title="%s" loading="lazy"%s><figcaption>%s</figcaption></figure>|}
163
+
fig_class dest title title srcset_attr title
164
+
in
165
+
string c html;
166
+
true
167
+
| _ ->
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
179
+
let html = Printf.sprintf
180
+
{|<img src="%s" alt="%s" title="%s" loading="lazy"%s>|}
181
+
dest caption title srcset_attr
182
+
in
183
+
string c html;
184
+
true))
185
+
| _ -> false)
186
+
| _ -> false)
187
+
| _ -> false
188
+
in
189
+
let default = Cmarkit_html.renderer ~safe:false () in
190
+
Cmarkit_renderer.compose default (Cmarkit_renderer.make ~inline ())
191
+
192
+
(** Convert markdown to HTML with Bushel link resolution *)
193
+
let md_to_html ?renderer md =
194
+
let open Cmarkit in
195
+
let doc = Doc.of_string ~strict:false ~resolver:Md.with_bushel_links md in
196
+
let mapper = Mapper.make ~inline:(Md.make_link_only_mapper (get_entries ())) () in
197
+
let mapped_doc = Mapper.map_doc mapper doc in
198
+
let r = match renderer with Some r -> r | None -> custom_html_renderer () in
199
+
Cmarkit_renderer.doc_to_string r mapped_doc
200
+
201
+
(** {1 Tag Helpers} *)
202
+
203
+
let tags_of_ent ent =
204
+
Entry.tags_of_ent (get_entries ()) ent
205
+
206
+
let concat_tags tags1 tags2 =
207
+
tags1 @ (List.filter (fun t -> not (List.mem t tags1)) tags2)