jon.recoil.org
A fork of mtelver's day10 project
1(* Generate an atom feed from compiled odocl blog posts. *)
2
3let id = Uri.of_string "https://jon.recoil.org/atom.xml"
4let title : Syndic.Atom.text_construct = Syndic.Atom.Text "Jon's blog"
5
6let author =
7 Syndic.Atom.author "Jon Ludlam" ~uri:(Uri.of_string "https://jon.recoil.org/")
8
9let updated = Unix.gettimeofday () |> Ptime.of_float_s |> Option.get
10
11(** Extract the text content from a custom tag's payload.
12 Custom tags like [@published 2026-03-02] are stored in Comment.docs
13 as [`Tag (`Custom ("published", elements))]. The elements are
14 nestable block elements — typically a single paragraph containing
15 words and spaces. *)
16let text_of_tag_payload elements =
17 let buf = Buffer.create 32 in
18 List.iter
19 (fun (el : Odoc_model.Comment.nestable_block_element Odoc_model.Location_.with_location) ->
20 match el.Odoc_model.Location_.value with
21 | `Paragraph inlines ->
22 List.iter
23 (fun (il : Odoc_model.Comment.inline_element Odoc_model.Location_.with_location) ->
24 match il.value with
25 | `Word w -> Buffer.add_string buf w
26 | `Space -> Buffer.add_char buf ' '
27 | _ -> ())
28 inlines
29 | _ -> ())
30 elements;
31 String.trim (Buffer.contents buf)
32
33(** Find a custom tag by name in the page's content elements. *)
34let find_custom_tag name (docs : Odoc_model.Comment.docs) =
35 List.find_map
36 (fun (el : Odoc_model.Comment.block_element Odoc_model.Location_.with_location) ->
37 match el.value with
38 | `Tag (`Custom (n, payload)) when n = name ->
39 Some (text_of_tag_payload payload)
40 | _ -> None)
41 docs.elements
42
43let entry_of_mld odoc_file =
44 let report_error during msg =
45 Format.eprintf "Error processing file '%s' while %s: %s\n%!"
46 (Fpath.to_string odoc_file)
47 during msg;
48 None
49 in
50 let unit =
51 match Odoc_odoc.Odoc_file.load odoc_file with
52 | Ok f -> Some f
53 | Error (`Msg m) ->
54 ignore (report_error "loading file" m);
55 None
56 in
57 match unit with
58 | None -> None
59 | Some unit -> (
60 let page =
61 match unit.content with
62 | Odoc_odoc.Odoc_file.Page_content page -> Some page
63 | _ -> None
64 in
65 match page with
66 | None -> None
67 | Some page -> (
68 let document =
69 Odoc_document.Renderer.document_of_page ~syntax:OCaml page
70 in
71 let published = find_custom_tag "published" page.content in
72 match published with
73 | None -> None (* Skip posts without published date *)
74 | Some published -> (
75 match document with
76 | Odoc_document.Types.Document.Source_page _ -> None
77 | Odoc_document.Types.Document.Page p ->
78 let first_heading =
79 List.find_map
80 (function
81 | Odoc_document.Types.Item.Heading h -> Some h
82 | _ -> None)
83 p.preamble
84 in
85 match first_heading with
86 | None ->
87 ignore (report_error "parsing title" "No heading found");
88 None
89 | Some first_heading ->
90 let title =
91 List.filter_map
92 (function
93 | Odoc_document.Types.Inline.{ desc = Text t; _ } -> Some t
94 | _ -> None)
95 first_heading.title
96 in
97 let title = String.concat "" title in
98 if title = "" then None
99 else
100 let resolve = Odoc_html.Link.Current p.url in
101 let config =
102 Odoc_html.Config.v ~semantic_uris:false ~indent:false
103 ~flat:false ~open_details:false ~as_json:false ~remap:[] ()
104 in
105 let url = Odoc_html.Generator.filepath p.url ~config in
106 let url =
107 Format.asprintf "https://jon.recoil.org/%s"
108 (Fpath.to_string url)
109 in
110 (* Generate full content: preamble + items *)
111 let all_items = p.preamble @ p.items in
112 let html = Odoc_html.Generator.items ~config ~resolve all_items in
113 let content_fmt = Fmt.list (Tyxml.Html.pp_elt ()) in
114 let content = Format.asprintf "%a" content_fmt html in
115 (* Extract first paragraph for summary *)
116 let summary =
117 let first_text =
118 List.find_map
119 (function
120 | Odoc_document.Types.Item.Text blocks ->
121 List.find_map
122 (function
123 | { Odoc_document.Types.Block.desc =
124 Odoc_document.Types.Block.Paragraph inline;
125 _
126 } ->
127 let text =
128 List.filter_map
129 (function
130 | Odoc_document.Types.Inline.
131 { desc = Text t; _ } ->
132 Some t
133 | _ -> None)
134 inline
135 in
136 if text = [] then None
137 else Some (String.concat "" text)
138 | _ -> None)
139 blocks
140 | _ -> None)
141 p.preamble
142 in
143 match first_text with
144 | Some t ->
145 if String.length t > 200 then
146 String.sub t 0 200 ^ "..."
147 else t
148 | None -> title
149 in
150 let published =
151 try
152 ISO8601.Permissive.date published |> Ptime.of_float_s
153 with _ ->
154 Format.eprintf "Error parsing date '%s' for %s\n%!"
155 published (Fpath.to_string odoc_file);
156 None
157 in
158 match published with
159 | None -> None
160 | Some published ->
161 Some
162 (Syndic.Atom.entry ~id:(Uri.of_string url)
163 ~title:(Syndic.Atom.Text title)
164 ~published ~updated:published
165 ~summary:(Syndic.Atom.Text summary)
166 ~content:(Syndic.Atom.Html (None, content))
167 ~links:
168 [
169 Syndic.Atom.link ~rel:Syndic.Atom.Alternate
170 (Uri.of_string url);
171 ]
172 ~authors:(author, []) ()))))
173
174let is_blog_post path =
175 let basename = Fpath.basename path in
176 Fpath.has_ext "odocl" path
177 && String.length basename > 5
178 && String.sub basename 0 5 = "page-"
179 && basename <> "page-index.odocl"
180
181let entries =
182 let mlds =
183 Bos.OS.Dir.fold_contents
184 (fun path acc -> if is_blog_post path then path :: acc else acc)
185 []
186 (Fpath.v "_build/default/site/_odoc/blog")
187 in
188 match mlds with
189 | Ok mlds ->
190 let entries = List.filter_map entry_of_mld mlds in
191 (* Sort by published date, newest first *)
192 List.sort Syndic.Atom.descending entries
193 | Error (`Msg m) ->
194 Format.eprintf "Error finding blog posts: %s\n%!" m;
195 []
196
197let self_link =
198 Syndic.Atom.link ~rel:Self (Uri.of_string "https://jon.recoil.org/atom.xml")
199
200let alt_link =
201 Syndic.Atom.link ~rel:Alternate (Uri.of_string "https://jon.recoil.org/blog/")
202
203let feed =
204 Syndic.Atom.feed ~id ~title ~updated ~links:[ self_link; alt_link ] entries
205
206let _ =
207 Syndic.Atom.write feed "atom.xml";
208 Format.printf "Generated atom.xml with %d entries\n%!" (List.length entries)