jon.recoil.org
forked from
anil.recoil.org/monopam-myspace
My aggregated monorepo of OCaml code, automaintained
1(* Generate blog index.mld files and recent entries list *)
2
3let month_name = function
4 | 1 -> "January" | 2 -> "February" | 3 -> "March" | 4 -> "April"
5 | 5 -> "May" | 6 -> "June" | 7 -> "July" | 8 -> "August"
6 | 9 -> "September" | 10 -> "October" | 11 -> "November" | 12 -> "December"
7 | _ -> "Unknown"
8
9type post = {
10 year : int;
11 month : int;
12 slug : string; (* e.g., "claude-and-dune" *)
13 title : string;
14 published : string; (* e.g., "2025-12-18" *)
15 tags : string list;
16}
17
18let parse_post path =
19 let ic = open_in path in
20 let content = really_input_string ic (in_channel_length ic) in
21 close_in ic;
22
23 (* Extract title from {0 ...} *)
24 let title =
25 let re = Str.regexp "{0 \\([^}]+\\)}" in
26 if Str.string_match re content 0 then
27 Str.matched_group 1 content
28 else
29 Filename.basename path |> Filename.remove_extension
30 in
31
32 (* Extract published date from @published ... *)
33 let published =
34 let re = Str.regexp "@published \\([0-9-]+\\)" in
35 try
36 ignore (Str.search_forward re content 0);
37 Str.matched_group 1 content
38 with Not_found -> ""
39 in
40
41 (* Extract tags from @page-tags ... *)
42 let tags =
43 let re = Str.regexp "@page-tags \\([^\n]+\\)" in
44 try
45 ignore (Str.search_forward re content 0);
46 Str.matched_group 1 content
47 |> String.split_on_char ' '
48 |> List.filter (fun s -> s <> "")
49 |> List.map String.lowercase_ascii
50 with Not_found -> []
51 in
52
53 (* Parse path to get year/month/slug *)
54 let parts = String.split_on_char '/' path in
55 match parts with
56 | _ :: _ :: year_s :: month_s :: filename :: [] | _ :: year_s :: month_s :: filename :: [] ->
57 let year = int_of_string year_s in
58 let month = int_of_string month_s in
59 let slug = Filename.remove_extension filename in
60 Some { year; month; slug; title; published; tags }
61 | _ -> None
62
63let find_posts () =
64 let posts = ref [] in
65 let rec scan_dir dir =
66 let entries = Sys.readdir dir in
67 Array.iter (fun entry ->
68 let path = Filename.concat dir entry in
69 if entry.[0] <> '.' && Sys.is_directory path then
70 scan_dir path
71 else if Filename.extension entry = ".mld" && entry <> "index.mld"
72 && entry.[0] <> '.' then
73 match parse_post path with
74 | Some post when post.published <> "" -> posts := post :: !posts
75 | _ -> ()
76 ) entries
77 in
78 scan_dir "blog";
79 (* Sort by published date descending *)
80 List.sort (fun a b -> String.compare b.published a.published) !posts
81
82let post_link post =
83 let slug_needs_quotes =
84 String.exists (fun c -> c = '-' || c = '_') post.slug
85 in
86 let slug_fmt =
87 if slug_needs_quotes then
88 Printf.sprintf "page-\"%s\"" post.slug
89 else
90 Printf.sprintf "page-%s" post.slug
91 in
92 Printf.sprintf "{{!//blog/%04d/%02d/%s}%s}"
93 post.year post.month slug_fmt post.title
94
95let generate_month_index year month posts =
96 let month_posts = List.filter (fun p -> p.year = year && p.month = month) posts in
97 if month_posts = [] then None
98 else
99 let children =
100 month_posts
101 |> List.map (fun p -> p.slug)
102 |> String.concat " "
103 in
104 let post_links =
105 month_posts
106 |> List.map (fun p -> "- " ^ post_link p)
107 |> String.concat "\n"
108 in
109 let content = Printf.sprintf "@children_order %s\n\n{0 %s}\n\n%s\n"
110 children (month_name month) post_links
111 in
112 Some content
113
114let generate_year_index year posts =
115 let year_posts = List.filter (fun p -> p.year = year) posts in
116 if year_posts = [] then None
117 else
118 (* Get unique months, sorted descending *)
119 let months =
120 year_posts
121 |> List.map (fun p -> p.month)
122 |> List.sort_uniq (fun a b -> compare b a)
123 in
124 let children_order =
125 months
126 |> List.map (Printf.sprintf "%02d/")
127 |> String.concat " "
128 in
129 let post_links =
130 year_posts
131 |> List.map (fun p -> "- " ^ post_link p)
132 |> String.concat "\n"
133 in
134 let content = Printf.sprintf "@children_order %s\n\n{0 %d}\n\n%s\n"
135 children_order year post_links
136 in
137 Some content
138
139let generate_blog_index posts =
140 (* Get unique years, sorted descending *)
141 let years =
142 posts
143 |> List.map (fun p -> p.year)
144 |> List.sort_uniq (fun a b -> compare b a)
145 in
146 let children_order =
147 years
148 |> List.map (fun y -> Printf.sprintf "%d/" y)
149 |> String.concat " "
150 in
151 let post_items =
152 posts
153 |> List.map (fun p ->
154 Printf.sprintf "{- %s %s}" (post_link p) p.published)
155 |> String.concat "\n"
156 in
157 Printf.sprintf "@children_order %s\n\n{0 Blog}\n\n@recent-posts\n{ul\n%s\n}\n"
158 children_order post_items
159
160let ensure_dir path =
161 let dir = Filename.dirname path in
162 let rec mkdir_p d =
163 if d <> "." && d <> "/" && not (Sys.file_exists d) then begin
164 mkdir_p (Filename.dirname d);
165 Sys.mkdir d 0o755
166 end
167 in
168 mkdir_p dir
169
170let write_file path content =
171 let gen_path = Filename.concat "_blog_gen" path in
172 ensure_dir gen_path;
173 let oc = open_out gen_path in
174 output_string oc content;
175 close_out oc;
176 Printf.eprintf "Wrote %s\n" gen_path
177
178let () =
179 let posts = find_posts () in
180 Printf.eprintf "Found %d posts\n\n" (List.length posts);
181
182 (* Get unique year/month combinations *)
183 let year_months =
184 posts
185 |> List.map (fun p -> (p.year, p.month))
186 |> List.sort_uniq compare
187 in
188
189 (* Generate month indexes *)
190 List.iter (fun (year, month) ->
191 match generate_month_index year month posts with
192 | Some content ->
193 let dir = Printf.sprintf "blog/%04d/%02d" year month in
194 let path = Filename.concat dir "index.mld" in
195 write_file path content
196 | None -> ()
197 ) year_months;
198
199 (* Get unique years *)
200 let years =
201 posts
202 |> List.map (fun p -> p.year)
203 |> List.sort_uniq (fun a b -> compare b a)
204 in
205
206 (* Generate year indexes *)
207 List.iter (fun year ->
208 match generate_year_index year posts with
209 | Some content ->
210 let path = Printf.sprintf "blog/%04d/index.mld" year in
211 write_file path content
212 | None -> ()
213 ) years;
214
215 (* Generate main blog index *)
216 let blog_index = generate_blog_index posts in
217 write_file "blog/index.mld" blog_index;
218
219 (* Generate tag pages *)
220 let all_tags =
221 posts
222 |> List.concat_map (fun p -> p.tags)
223 |> List.sort_uniq String.compare
224 in
225 List.iter (fun tag ->
226 let tagged = List.filter (fun p -> List.mem tag p.tags) posts in
227 (* Already sorted newest-first from find_posts *)
228 let post_items =
229 tagged
230 |> List.map (fun p -> Printf.sprintf "{- %s %s}" (post_link p) p.published)
231 |> String.concat "\n"
232 in
233 let content = Printf.sprintf
234 "{0 Tag: %s}\n\n@tagged-pages %s\n\n{ul\n%s\n}\n" tag tag post_items
235 in
236 write_file (Printf.sprintf "tags/%s.mld" tag) content
237 ) all_tags;
238
239 (* Generate tag index *)
240 let tag_links =
241 all_tags
242 |> List.map (fun tag ->
243 let needs_quotes = String.exists (fun c -> c = '-' || c = '_') tag in
244 let ref_fmt =
245 if needs_quotes then Printf.sprintf "page-\"%s\"" tag
246 else Printf.sprintf "page-%s" tag
247 in
248 Printf.sprintf "{- {{!%s}%s}}" ref_fmt tag)
249 |> String.concat "\n"
250 in
251 let tag_index = Printf.sprintf "{0 Tags}\n\nPages grouped by tag.\n\n{ul\n%s\n}\n"
252 tag_links
253 in
254 write_file "tags/index.mld" tag_index