Monorepo management for opam overlays
1(** Changelog generation for monopam.
2
3 This module handles generating weekly and daily changelog entries using
4 Claude AI to analyze git commit history and produce user-facing change
5 summaries.
6
7 Changes are stored in a .changes directory at the monorepo root:
8 - .changes/<repo_name>.json - weekly changelog entries
9 - .changes/<repo_name>-<YYYY-MM-DD>.json - daily changelog entries (one file
10 per day per repo)
11 - .changes/YYYYMMDD.json - aggregated daily changes for broadcasting
12
13 {1 Submodules}
14
15 - {!Aggregated} - Types and I/O for aggregated daily changes (YYYYMMDD.json)
16 - {!Daily} - Types and I/O for per-day-per-repo changes
17 (repo-YYYY-MM-DD.json)
18 - {!Query} - High-level query interface for changes *)
19
20module Aggregated = Changes_aggregated
21(** Re-export submodules for querying changes *)
22
23module Daily = Changes_daily
24module Query = Changes_query
25
26(** {1 Error Helpers} *)
27
28let err_parse name e =
29 Error (Fmt.str "Failed to parse %s: %s" name (Json.Error.to_string e))
30
31let err_claude_parse e =
32 Error (Fmt.str "Failed to parse Claude response: %s" (Json.Error.to_string e))
33
34let err_decode e =
35 Error (Fmt.str "Failed to decode response: %s" (Json.Error.to_string e))
36
37type commit_range = { from_hash : string; to_hash : string; count : int }
38
39type weekly_entry = {
40 week_start : string; (* ISO date YYYY-MM-DD, Monday *)
41 week_end : string; (* ISO date YYYY-MM-DD, Sunday *)
42 summary : string; (* One-line summary *)
43 changes : string list; (* Bullet points *)
44 commit_range : commit_range;
45}
46
47type daily_entry = {
48 date : string; (* ISO date YYYY-MM-DD *)
49 hour : int; (* Hour of day 0-23 *)
50 timestamp : Ptime.t; (* RFC3339 timestamp for precise ordering *)
51 summary : string; (* One-line summary *)
52 changes : string list; (* Bullet points *)
53 commit_range : commit_range;
54 contributors : string list; (* List of contributors for this entry *)
55 repo_url : string option; (* Upstream repository URL *)
56}
57
58type file = { repository : string; entries : weekly_entry list }
59type daily_file = { repository : string; entries : daily_entry list }
60
61(** Mode for changelog generation *)
62type mode = Weekly | Daily
63
64(* Jsont codecs *)
65
66let commit_range_jsont =
67 let open Json.Codec in
68 let make from_hash to_hash count = { from_hash; to_hash; count } in
69 Object.map ~kind:"commit_range" make
70 |> Object.member "from" string ~enc:(fun r -> r.from_hash)
71 |> Object.member "to" string ~enc:(fun r -> r.to_hash)
72 |> Object.member "count" int ~enc:(fun r -> r.count)
73 |> Object.seal
74
75let weekly_entry_jsont : weekly_entry Json.codec =
76 let open Json.Codec in
77 let make week_start week_end summary changes commit_range : weekly_entry =
78 { week_start; week_end; summary; changes; commit_range }
79 in
80 Object.map ~kind:"weekly_entry" make
81 |> Object.member "week_start" string ~enc:(fun (e : weekly_entry) ->
82 e.week_start)
83 |> Object.member "week_end" string ~enc:(fun (e : weekly_entry) -> e.week_end)
84 |> Object.member "summary" string ~enc:(fun (e : weekly_entry) -> e.summary)
85 |> Object.member "changes" (list string) ~enc:(fun (e : weekly_entry) ->
86 e.changes)
87 |> Object.member "commit_range" commit_range_jsont
88 ~enc:(fun (e : weekly_entry) -> e.commit_range)
89 |> Object.seal
90
91let file_jsont : file Json.codec =
92 let open Json.Codec in
93 let make repository entries : file = { repository; entries } in
94 Object.map ~kind:"changes_file" make
95 |> Object.member "repository" string ~enc:(fun (f : file) -> f.repository)
96 |> Object.member "entries" (list weekly_entry_jsont) ~enc:(fun (f : file) ->
97 f.entries)
98 |> Object.seal
99
100let ptime_jsont =
101 let open Json.Codec in
102 let enc t = Ptime.to_rfc3339 t ~tz_offset_s:0 in
103 let dec s =
104 match Ptime.of_rfc3339 s with
105 | Ok (t, _, _) -> t
106 | Error _ -> failwith ("Invalid timestamp: " ^ s)
107 in
108 map ~dec ~enc string
109
110let daily_entry_jsont : daily_entry Json.codec =
111 let open Json.Codec in
112 let make date hour timestamp summary changes commit_range contributors
113 repo_url : daily_entry =
114 {
115 date;
116 hour;
117 timestamp;
118 summary;
119 changes;
120 commit_range;
121 contributors;
122 repo_url;
123 }
124 in
125 (* Default hour and timestamp for backwards compat when reading old files *)
126 let default_hour = 0 in
127 let default_timestamp = Ptime.epoch in
128 Object.map ~kind:"daily_entry" make
129 |> Object.member "date" string ~enc:(fun (e : daily_entry) -> e.date)
130 |> Object.member "hour" int ~dec_absent:default_hour
131 ~enc:(fun (e : daily_entry) -> e.hour)
132 |> Object.member "timestamp" ptime_jsont ~dec_absent:default_timestamp
133 ~enc:(fun (e : daily_entry) -> e.timestamp)
134 |> Object.member "summary" string ~enc:(fun (e : daily_entry) -> e.summary)
135 |> Object.member "changes" (list string) ~enc:(fun (e : daily_entry) ->
136 e.changes)
137 |> Object.member "commit_range" commit_range_jsont
138 ~enc:(fun (e : daily_entry) -> e.commit_range)
139 |> Object.member "contributors" (list string) ~dec_absent:[]
140 ~enc:(fun (e : daily_entry) -> e.contributors)
141 |> Object.member "repo_url" (option string) ~dec_absent:None
142 ~enc:(fun (e : daily_entry) -> e.repo_url)
143 |> Object.seal
144
145let daily_file_jsont : daily_file Json.codec =
146 let open Json.Codec in
147 let make repository entries : daily_file = { repository; entries } in
148 Object.map ~kind:"daily_changes_file" make
149 |> Object.member "repository" string ~enc:(fun (f : daily_file) ->
150 f.repository)
151 |> Object.member "entries" (list daily_entry_jsont)
152 ~enc:(fun (f : daily_file) -> f.entries)
153 |> Object.seal
154
155(* File I/O *)
156
157(* Helper to ensure .changes directory exists *)
158let ensure_changes_dir ~fs monorepo =
159 let changes_dir = Eio.Path.(fs / Fpath.to_string monorepo / ".changes") in
160 match Eio.Path.kind ~follow:true changes_dir with
161 | `Directory -> ()
162 | _ -> Eio.Path.mkdir ~perm:0o755 changes_dir
163 | exception Eio.Io _ -> Eio.Path.mkdir ~perm:0o755 changes_dir
164
165(* Load weekly changes from .changes/<repo>.json in monorepo *)
166let load ~fs ~monorepo repo_name =
167 let file_path =
168 Eio.Path.(
169 fs / Fpath.to_string monorepo / ".changes" / (repo_name ^ ".json"))
170 in
171 match Eio.Path.kind ~follow:true file_path with
172 | `Regular_file -> (
173 let content = Eio.Path.load file_path in
174 match Json.of_string file_jsont content with
175 | Ok cf -> Ok cf
176 | Error e -> err_parse (repo_name ^ ".json") e)
177 | _ -> Ok { repository = repo_name; entries = [] }
178 | exception Eio.Io _ -> Ok { repository = repo_name; entries = [] }
179
180(* Save weekly changes to .changes/<repo>.json in monorepo *)
181let save ~fs ~monorepo (cf : file) =
182 ensure_changes_dir ~fs monorepo;
183 let file_path =
184 Eio.Path.(
185 fs / Fpath.to_string monorepo / ".changes" / (cf.repository ^ ".json"))
186 in
187 let content = Json.to_string ~indent:2 file_jsont cf in
188 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
189 Ok ()
190
191(* Filename for daily changes: <repo>-<YYYY-MM-DD>.json *)
192let daily_filename repo_name date = repo_name ^ "-" ^ date ^ ".json"
193
194(* Check if daily file exists on disk *)
195let daily_exists ~fs ~monorepo ~date repo_name =
196 let filename = daily_filename repo_name date in
197 let file_path =
198 Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
199 in
200 match Eio.Path.kind ~follow:true file_path with
201 | `Regular_file -> true
202 | _ -> false
203 | exception Eio.Io _ -> false
204
205(* Load daily changes from .changes/<repo>-<date>.json in monorepo *)
206let load_daily ~fs ~monorepo ~date repo_name =
207 let filename = daily_filename repo_name date in
208 let file_path =
209 Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
210 in
211 match Eio.Path.kind ~follow:true file_path with
212 | `Regular_file -> (
213 let content = Eio.Path.load file_path in
214 match Json.of_string daily_file_jsont content with
215 | Ok cf -> Ok cf
216 | Error e -> err_parse filename e)
217 | _ -> Ok { repository = repo_name; entries = [] }
218 | exception Eio.Io _ -> Ok { repository = repo_name; entries = [] }
219
220(* Save daily changes to .changes/<repo>-<date>.json in monorepo *)
221let save_daily ~fs ~monorepo ~date (cf : daily_file) =
222 ensure_changes_dir ~fs monorepo;
223 let filename = daily_filename cf.repository date in
224 let file_path =
225 Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
226 in
227 let content = Json.to_string ~indent:2 daily_file_jsont cf in
228 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
229 Ok ()
230
231(* Markdown generation *)
232
233let to_markdown (cf : file) =
234 let buf = Buffer.create 1024 in
235 Buffer.add_string buf (Fmt.str "# %s Changelog\n\n" cf.repository);
236 List.iter
237 (fun (entry : weekly_entry) ->
238 Buffer.add_string buf
239 (Fmt.str "## Week of %s to %s\n\n" entry.week_start entry.week_end);
240 Buffer.add_string buf (Fmt.str "%s\n\n" entry.summary);
241 List.iter
242 (fun change -> Buffer.add_string buf (Fmt.str "- %s\n" change))
243 entry.changes;
244 Buffer.add_string buf "\n")
245 cf.entries;
246 Buffer.contents buf
247
248let group_weekly_entries sorted =
249 let rec loop acc current_week current_group = function
250 | [] ->
251 if current_group <> [] then
252 (current_week, List.rev current_group) :: acc
253 else acc
254 | (repo, (entry : weekly_entry)) :: rest ->
255 let week_key = entry.week_start ^ " to " ^ entry.week_end in
256 if current_week = "" || current_week = week_key then
257 loop acc week_key ((repo, entry) :: current_group) rest
258 else
259 loop
260 ((current_week, List.rev current_group) :: acc)
261 week_key
262 [ (repo, entry) ]
263 rest
264 in
265 List.rev (loop [] "" [] sorted)
266
267let aggregate ~history (cfs : file list) =
268 let all_entries =
269 List.concat_map
270 (fun (cf : file) ->
271 List.map (fun (e : weekly_entry) -> (cf.repository, e)) cf.entries)
272 cfs
273 in
274 let sorted =
275 List.sort
276 (fun (_, (e1 : weekly_entry)) (_, (e2 : weekly_entry)) ->
277 String.compare e2.week_start e1.week_start)
278 all_entries
279 in
280 let grouped = group_weekly_entries sorted in
281 let limited =
282 if history > 0 then List.filteri (fun i _ -> i < history) grouped
283 else grouped
284 in
285 let buf = Buffer.create 4096 in
286 Buffer.add_string buf "# Changelog\n\n";
287 List.iter
288 (fun (week_key, entries) ->
289 Buffer.add_string buf (Fmt.str "## Week of %s\n\n" week_key);
290 List.iter
291 (fun (repo, (entry : weekly_entry)) ->
292 Buffer.add_string buf (Fmt.str "### %s\n" repo);
293 Buffer.add_string buf (Fmt.str "%s\n" entry.summary);
294 List.iter
295 (fun change -> Buffer.add_string buf (Fmt.str "- %s\n" change))
296 entry.changes;
297 Buffer.add_string buf "\n")
298 entries)
299 limited;
300 Buffer.contents buf
301
302(* Week calculation *)
303
304(* Day of week: 0 = Sunday, 1 = Monday, ... 6 = Saturday *)
305let day_of_week year month day =
306 match Ptime.of_date (year, month, day) with
307 | None -> 0
308 | Some t -> (
309 match Ptime.weekday t with
310 | `Sun -> 0
311 | `Mon -> 1
312 | `Tue -> 2
313 | `Wed -> 3
314 | `Thu -> 4
315 | `Fri -> 5
316 | `Sat -> 6)
317
318let add_days (y, m, d) n =
319 match Ptime.of_date (y, m, d) with
320 | None -> (y, m, d)
321 | Some t -> (
322 let span = Ptime.Span.of_int_s (n * 86400) in
323 match Ptime.add_span t span with
324 | Some t' ->
325 let (y', m', d'), _ = Ptime.to_date_time t' in
326 (y', m', d')
327 | None -> (y, m, d))
328
329let format_date (y, m, d) = Fmt.str "%04d-%02d-%02d" y m d
330
331let week_of_date (y, m, d) =
332 let dow = day_of_week y m d in
333 (* Monday = 1, so days to subtract to get to Monday *)
334 let days_to_monday = if dow = 0 then 6 else dow - 1 in
335 let monday = add_days (y, m, d) (-days_to_monday) in
336 let sunday = add_days monday 6 in
337 (format_date monday, format_date sunday)
338
339let week_of_ptime t =
340 let (y, m, d), _ = Ptime.to_date_time t in
341 week_of_date (y, m, d)
342
343let week_timestamps_of_ptime t =
344 let (y, m, d), _ = Ptime.to_date_time t in
345 let dow = day_of_week y m d in
346 let days_to_monday = if dow = 0 then 6 else dow - 1 in
347 let monday = add_days (y, m, d) (-days_to_monday) in
348 let sunday = add_days monday 6 in
349 let to_timestamp (y, m, d) hh mm ss =
350 match Ptime.of_date_time ((y, m, d), ((hh, mm, ss), 0)) with
351 | Some pt -> Int64.of_float (Ptime.to_float_s pt)
352 | None -> 0L
353 in
354 (to_timestamp monday 0 0 0, to_timestamp sunday 23 59 59)
355
356let day_timestamps_of_ptime t =
357 let (y, m, d), _ = Ptime.to_date_time t in
358 let to_timestamp hh mm ss =
359 match Ptime.of_date_time ((y, m, d), ((hh, mm, ss), 0)) with
360 | Some pt -> Int64.of_float (Ptime.to_float_s pt)
361 | None -> 0L
362 in
363 (to_timestamp 0 0 0, to_timestamp 23 59 59)
364
365let has_week (cf : file) ~week_start =
366 List.exists (fun (e : weekly_entry) -> e.week_start = week_start) cf.entries
367
368let date_of_ptime t =
369 let (y, m, d), _ = Ptime.to_date_time t in
370 format_date (y, m, d)
371
372let has_day (cf : daily_file) ~date:_ =
373 (* With per-day files, the file is already for a specific date.
374 This function now checks if the file has any entries. *)
375 cf.entries <> []
376
377(* Format a single daily entry for markdown *)
378let format_daily_entry buf repo (entry : daily_entry) =
379 let repo_header =
380 match entry.repo_url with
381 | Some url -> Fmt.str "[%s](%s)" repo url
382 | None -> repo
383 in
384 Buffer.add_string buf (Fmt.str "### %s\n\n" repo_header);
385 Buffer.add_string buf (Fmt.str "%s\n\n" entry.summary);
386 List.iter
387 (fun change -> Buffer.add_string buf (Fmt.str "- %s\n" change))
388 entry.changes;
389 if entry.contributors <> [] then begin
390 let contributors_str = String.concat ", " entry.contributors in
391 Buffer.add_string buf (Fmt.str "\n*Contributors: %s*\n" contributors_str)
392 end;
393 Buffer.add_string buf "\n"
394
395(* Format entries for a single date *)
396let format_date_entries buf date entries =
397 let entries_with_changes =
398 List.filter (fun (_, (entry : daily_entry)) -> entry.changes <> []) entries
399 in
400 if entries_with_changes <> [] then begin
401 Buffer.add_string buf (Fmt.str "## %s\n\n" date);
402 List.iter
403 (fun (repo, (entry : daily_entry)) -> format_daily_entry buf repo entry)
404 entries_with_changes
405 end
406
407(* Aggregate daily changes into DAILY-CHANGES.md *)
408let aggregate_daily ~history (cfs : daily_file list) =
409 (* Collect all entries from all files, tagged with repository *)
410 let all_entries =
411 List.concat_map
412 (fun (cf : daily_file) ->
413 List.map (fun (e : daily_entry) -> (cf.repository, e)) cf.entries)
414 cfs
415 in
416 (* Sort by date descending *)
417 let sorted =
418 List.sort
419 (fun (_, (e1 : daily_entry)) (_, (e2 : daily_entry)) ->
420 String.compare e2.date e1.date)
421 all_entries
422 in
423 (* Group by date *)
424 let rec group_by_date acc current_date current_group = function
425 | [] ->
426 if current_group <> [] then
427 (current_date, List.rev current_group) :: acc
428 else acc
429 | (repo, (entry : daily_entry)) :: rest ->
430 if current_date = "" || current_date = entry.date then
431 group_by_date acc entry.date ((repo, entry) :: current_group) rest
432 else
433 group_by_date
434 ((current_date, List.rev current_group) :: acc)
435 entry.date
436 [ (repo, entry) ]
437 rest
438 in
439 let grouped = List.rev (group_by_date [] "" [] sorted) in
440 (* Take only the requested number of days *)
441 let limited =
442 if history > 0 then List.filteri (fun i _ -> i < history) grouped
443 else grouped
444 in
445 (* Generate markdown - only include repos with actual changes *)
446 let buf = Buffer.create 4096 in
447 Buffer.add_string buf "# Daily Changelog\n\n";
448 List.iter
449 (fun (date, entries) -> format_date_entries buf date entries)
450 limited;
451 Buffer.contents buf
452
453(* Claude prompt generation *)
454
455let format_commit_block buf (commit : Git.Repository.log_entry) =
456 Buffer.add_string buf
457 (Fmt.str "### %s by %s (%s)\n"
458 (String.sub commit.hash 0 (min 7 (String.length commit.hash)))
459 commit.author commit.date);
460 Buffer.add_string buf (Fmt.str "%s\n\n" commit.subject);
461 if commit.body <> "" then begin
462 Buffer.add_string buf (Fmt.str "%s\n" commit.body)
463 end;
464 Buffer.add_string buf "---\n\n"
465
466let changelog_instructions =
467 {|## Instructions:
468
4691. Focus on USER-FACING changes only. Skip:
470 - Internal refactoring with no API impact
471 - CI/build system tweaks
472 - Typo fixes in code comments
473 - Dependency bumps (unless they add features)
474
4752. IMPORTANT: If there are NO user-facing changes, output a blank entry with empty
476 summary and empty changes array. Do NOT write "no changes" or similar text.
477 Example for no changes: {"summary": "", "changes": []}
478
4793. Otherwise, respond in this exact JSON format:
480{
481 "summary": "One sentence describing the most important change",
482 "changes": [
483 "First user-facing change as a bullet point",
484 "Second change",
485 "..."
486 ]
487}
488
4894. Write for developers using this library. Be:
490 - Concise (max 80 chars per bullet)
491 - Specific (mention function/module names)
492 - Action-oriented (start with verbs: Added, Fixed, Improved, Removed)
493
4945. Maximum 5 bullet points. Group related changes if needed.
495|}
496
497let generate_weekly_prompt ~repository ~week_start ~week_end commits =
498 let buf = Buffer.create 4096 in
499 Buffer.add_string buf
500 (Fmt.str "You are analyzing git commits for the OCaml library \"%s\".\n"
501 repository);
502 Buffer.add_string buf
503 (Fmt.str
504 "Generate a user-facing changelog entry for the week of %s to %s.\n\n"
505 week_start week_end);
506 Buffer.add_string buf "## Commits this week:\n\n";
507 List.iter (format_commit_block buf) commits;
508 Buffer.add_string buf changelog_instructions;
509 Buffer.contents buf
510
511let generate_daily_prompt ~repository ~date commits =
512 let buf = Buffer.create 4096 in
513 Buffer.add_string buf
514 (Fmt.str "You are analyzing git commits for the OCaml library \"%s\".\n"
515 repository);
516 Buffer.add_string buf
517 (Fmt.str "Generate a user-facing changelog entry for %s.\n\n" date);
518 Buffer.add_string buf "## Commits today:\n\n";
519 List.iter (format_commit_block buf) commits;
520 Buffer.add_string buf changelog_instructions;
521 Buffer.contents buf
522
523(* Backwards compatibility *)
524let generate_prompt = generate_weekly_prompt
525
526(* Response parsing *)
527
528type claude_response = { summary : string; changes : string list }
529
530let claude_response_jsont =
531 let open Json.Codec in
532 let make summary changes = { summary; changes } in
533 Object.map ~kind:"claude_response" make
534 |> Object.member "summary" string ~enc:(fun r -> r.summary)
535 |> Object.member "changes" (list string) ~enc:(fun r -> r.changes)
536 |> Object.seal
537
538let parse_claude_response text =
539 let text = String.trim text in
540 (* Legacy support for NO_CHANGES response *)
541 if text = "NO_CHANGES" then Ok None
542 else
543 match Json.of_string claude_response_jsont text with
544 | Ok r ->
545 (* Treat empty summary and changes as no changes *)
546 if r.summary = "" && r.changes = [] then Ok None else Ok (Some r)
547 | Error e -> err_claude_parse e
548
549(* Main analysis function *)
550
551let changelog_output_schema =
552 Json.Value.of_string_exn
553 {|{
554 "type": "object",
555 "properties": {
556 "summary": { "type": "string" },
557 "changes": { "type": "array", "items": { "type": "string" } }
558 },
559 "required": ["summary", "changes"]
560 }|}
561
562let process_claude_responses responses =
563 let result = ref None in
564 List.iter
565 (function
566 | Claude.Response.Complete c -> (
567 match Claude.Response.Complete.structured_output c with
568 | Some json -> (
569 match Json.decode claude_response_jsont json with
570 | Ok r ->
571 if r.summary = "" && r.changes = [] then
572 result := Some (Ok None)
573 else result := Some (Ok (Some r))
574 | Error e -> result := Some (err_decode e))
575 | None -> (
576 match Claude.Response.Complete.result_text c with
577 | Some text -> result := Some (parse_claude_response text)
578 | None -> result := Some (Ok None)))
579 | Claude.Response.Text t ->
580 let text = Claude.Response.Text.content t in
581 if String.trim text = "NO_CHANGES" then result := Some (Ok None)
582 | Claude.Response.Error e ->
583 result :=
584 Some
585 (Error
586 (Fmt.str "Claude error: %s" (Claude.Response.Error.message e)))
587 | _ -> ())
588 responses;
589 match !result with Some r -> r | None -> Ok None
590
591let run_claude_analysis ~sw ~process_mgr ~clock prompt =
592 let output_format =
593 Claude.Structured_output.of_json_schema changelog_output_schema
594 in
595 let options =
596 Claude.Options.default
597 |> Claude.Options.with_output_format output_format
598 |> Claude.Options.with_max_turns 1
599 in
600 let client = Claude.Client.v ~sw ~process_mgr ~clock ~options () in
601 Claude.Client.query client prompt;
602 let responses = Claude.Client.receive_all client in
603 process_claude_responses responses
604
605let analyze_commits ~sw ~process_mgr ~clock ~repository ~week_start ~week_end
606 commits =
607 if commits = [] then Ok None
608 else
609 let prompt = generate_prompt ~repository ~week_start ~week_end commits in
610 run_claude_analysis ~sw ~process_mgr ~clock prompt
611
612(* Daily analysis function *)
613let analyze_commits_daily ~sw ~process_mgr ~clock ~repository ~date commits =
614 if commits = [] then Ok None
615 else
616 let prompt = generate_daily_prompt ~repository ~date commits in
617 run_claude_analysis ~sw ~process_mgr ~clock prompt
618
619(* Refine daily changelog markdown to be more narrative *)
620let refine_daily_changelog ~sw ~process_mgr ~clock markdown =
621 let prompt =
622 Fmt.str
623 {|You are editing a daily changelog for an OCaml monorepo.
624
625Your task is to refine the following changelog to be:
6261. More narrative and human-readable - write it as a daily update that developers will want to read
6272. Grouped by related changes - if multiple repos have related changes, group them together
6283. Succinct but complete - don't lose any information, but make it more concise
6294. Well-ordered - put the most significant changes first
630
631Keep the markdown format with:
632- A main heading for each date
633- Sub-sections for related groups of changes (not necessarily by repo), such as "New Libraries", "Major Features", "Critical Bug Fixes", "Code Quality Improvements", "Documentation Updates"
634- Bullet points for individual changes
635- Preserve all contributor attributions (format: — *Contributor Name*)
636- IMPORTANT: Every repository name MUST be a markdown link. If a repo already has a link, preserve it. If not, generate one using the pattern: [repo-name](https://tangled.org/@anil.recoil.org/repo-name.git)
637- Format each bullet as: **[repo-name](url)**: Description — *Contributors* (if any)
638
639IMPORTANT: For "initial import" or "added as subtree" entries:
640- Put these in a dedicated "New Libraries" section
641- Expand the description to explain what the library does and its purpose
642- If the library relates to other libraries in the monorepo (e.g., uses ocaml-requests for HTTP, complements ocaml-imap, etc.), mention those relationships with links
643- Example: Instead of "Initial import of ocaml-jmap library", write "OCaml implementation of the JMAP protocol — a modern, JSON-based alternative to IMAP for email access. Complements the existing [ocaml-imap](https://tangled.org/@anil.recoil.org/ocaml-imap.git) library"
644
645Here is the changelog to refine:
646
647%s
648
649Output ONLY the refined markdown, no explanation or preamble.|}
650 markdown
651 in
652
653 let options = Claude.Options.default |> Claude.Options.with_max_turns 1 in
654
655 let client = Claude.Client.v ~sw ~process_mgr ~clock ~options () in
656 Claude.Client.query client prompt;
657
658 let responses = Claude.Client.receive_all client in
659 let result = ref None in
660 List.iter
661 (function
662 | Claude.Response.Complete c -> (
663 match Claude.Response.Complete.result_text c with
664 | Some text -> result := Some (Ok text)
665 | None -> result := Some (Ok markdown) (* fallback to original *))
666 | Claude.Response.Error e ->
667 result :=
668 Some
669 (Error
670 (Fmt.str "Claude error: %s" (Claude.Response.Error.message e)))
671 | _ -> ())
672 responses;
673
674 match !result with
675 | Some r -> r
676 | None -> Ok markdown (* fallback to original *)
677
678(* Simple string containment check *)
679let string_contains_s haystack needle =
680 let hlen = String.length haystack in
681 let nlen = String.length needle in
682 if nlen > hlen then false
683 else begin
684 let rec check i =
685 if i > hlen - nlen then false
686 else if String.sub haystack i nlen = needle then true
687 else check (i + 1)
688 in
689 check 0
690 end
691
692(* Infer change type from summary text *)
693let infer_change_type summary =
694 let summary_lower = String.lowercase_ascii summary in
695 if
696 String.starts_with ~prefix:"initial import" summary_lower
697 || String.starts_with ~prefix:"added as subtree" summary_lower
698 || String.starts_with ~prefix:"added" summary_lower
699 && String.ends_with ~suffix:"library" summary_lower
700 then Changes_aggregated.New_library
701 else if
702 List.exists
703 (fun kw -> string_contains_s summary_lower kw)
704 [ "fix"; "bugfix"; "bug fix"; "repair"; "patch"; "resolve"; "correct" ]
705 then Changes_aggregated.Bugfix
706 else if
707 List.exists
708 (fun kw -> string_contains_s summary_lower kw)
709 [
710 "refactor";
711 "cleanup";
712 "clean up";
713 "reorganize";
714 "restructure";
715 "simplify";
716 ]
717 then Changes_aggregated.Refactor
718 else if
719 List.exists
720 (fun kw -> string_contains_s summary_lower kw)
721 [ "doc"; "documentation"; "readme"; "comment"; "tutorial"; "guide" ]
722 then Changes_aggregated.Documentation
723 else if
724 List.exists
725 (fun kw -> string_contains_s summary_lower kw)
726 [ "add"; "new"; "feature"; "implement"; "support"; "introduce"; "enable" ]
727 then Changes_aggregated.Feature
728 else Changes_aggregated.Unknown
729
730let load_daily_entries_for_date changes_dir daily_files date_suffix_len =
731 List.concat_map
732 (fun filename ->
733 let repo_name =
734 String.sub filename 0 (String.length filename - date_suffix_len)
735 in
736 let path = Eio.Path.(changes_dir / filename) in
737 try
738 let content = Eio.Path.load path in
739 match Json.of_string daily_file_jsont content with
740 | Ok dcf ->
741 List.filter_map
742 (fun (e : daily_entry) ->
743 if e.changes <> [] then Some (repo_name, e) else None)
744 dcf.entries
745 | Error _ -> []
746 with Eio.Io _ -> [])
747 daily_files
748
749let daily_entry_to_aggregated (repo_name, (e : daily_entry)) =
750 let change_type = infer_change_type e.summary in
751 Changes_aggregated.
752 {
753 repository = repo_name;
754 hour = e.hour;
755 timestamp = e.timestamp;
756 summary = e.summary;
757 changes = e.changes;
758 commit_range =
759 {
760 from_hash = e.commit_range.from_hash;
761 to_hash = e.commit_range.to_hash;
762 count = e.commit_range.count;
763 };
764 contributors = e.contributors;
765 repo_url = e.repo_url;
766 change_type;
767 }
768
769(** Generate an aggregated daily file from individual daily json files. This
770 creates a YYYYMMDD.json file in the .changes directory. *)
771let generate_aggregated ~fs ~monorepo ~date ~git_head ~now =
772 let changes_dir = Eio.Path.(fs / Fpath.to_string monorepo / ".changes") in
773 let files = try Eio.Path.read_dir changes_dir with Eio.Io _ -> [] in
774 let date_suffix = "-" ^ date ^ ".json" in
775 let date_suffix_len = String.length date_suffix in
776 let daily_files =
777 List.filter
778 (fun f ->
779 String.ends_with ~suffix:date_suffix f
780 && String.length f > date_suffix_len)
781 files
782 in
783 let entries =
784 load_daily_entries_for_date changes_dir daily_files date_suffix_len
785 in
786 let agg_entries = List.map daily_entry_to_aggregated entries in
787 let authors =
788 entries
789 |> List.concat_map (fun (_, (e : daily_entry)) -> e.contributors)
790 |> List.sort_uniq String.compare
791 in
792 let aggregated : Changes_aggregated.t =
793 { date; generated_at = now; git_head; entries = agg_entries; authors }
794 in
795 let changes_dir_fpath = Fpath.(v (Fpath.to_string monorepo) / ".changes") in
796 Changes_aggregated.save ~fs ~changes_dir:changes_dir_fpath aggregated