jon.recoil.org
forked from
anil.recoil.org/monopam
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
26type commit_range = { from_hash : string; to_hash : string; count : int }
27
28type weekly_entry = {
29 week_start : string; (* ISO date YYYY-MM-DD, Monday *)
30 week_end : string; (* ISO date YYYY-MM-DD, Sunday *)
31 summary : string; (* One-line summary *)
32 changes : string list; (* Bullet points *)
33 commit_range : commit_range;
34}
35
36type daily_entry = {
37 date : string; (* ISO date YYYY-MM-DD *)
38 hour : int; (* Hour of day 0-23 *)
39 timestamp : Ptime.t; (* RFC3339 timestamp for precise ordering *)
40 summary : string; (* One-line summary *)
41 changes : string list; (* Bullet points *)
42 commit_range : commit_range;
43 contributors : string list; (* List of contributors for this entry *)
44 repo_url : string option; (* Upstream repository URL *)
45}
46
47type changes_file = { repository : string; entries : weekly_entry list }
48type daily_changes_file = { repository : string; entries : daily_entry list }
49
50(** Mode for changelog generation *)
51type mode = Weekly | Daily
52
53(* Jsont codecs *)
54
55let commit_range_jsont =
56 let make from_hash to_hash count = { from_hash; to_hash; count } in
57 Jsont.Object.map ~kind:"commit_range" make
58 |> Jsont.Object.mem "from" Jsont.string ~enc:(fun r -> r.from_hash)
59 |> Jsont.Object.mem "to" Jsont.string ~enc:(fun r -> r.to_hash)
60 |> Jsont.Object.mem "count" Jsont.int ~enc:(fun r -> r.count)
61 |> Jsont.Object.finish
62
63let weekly_entry_jsont : weekly_entry Jsont.t =
64 let make week_start week_end summary changes commit_range : weekly_entry =
65 { week_start; week_end; summary; changes; commit_range }
66 in
67 Jsont.Object.map ~kind:"weekly_entry" make
68 |> Jsont.Object.mem "week_start" Jsont.string ~enc:(fun (e : weekly_entry) ->
69 e.week_start)
70 |> Jsont.Object.mem "week_end" Jsont.string ~enc:(fun (e : weekly_entry) ->
71 e.week_end)
72 |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun (e : weekly_entry) ->
73 e.summary)
74 |> Jsont.Object.mem "changes" (Jsont.list Jsont.string)
75 ~enc:(fun (e : weekly_entry) -> e.changes)
76 |> Jsont.Object.mem "commit_range" commit_range_jsont
77 ~enc:(fun (e : weekly_entry) -> e.commit_range)
78 |> Jsont.Object.finish
79
80let changes_file_jsont : changes_file Jsont.t =
81 let make repository entries : changes_file = { repository; entries } in
82 Jsont.Object.map ~kind:"changes_file" make
83 |> Jsont.Object.mem "repository" Jsont.string ~enc:(fun (f : changes_file) ->
84 f.repository)
85 |> Jsont.Object.mem "entries" (Jsont.list weekly_entry_jsont)
86 ~enc:(fun (f : changes_file) -> f.entries)
87 |> Jsont.Object.finish
88
89let ptime_jsont =
90 let enc t = Ptime.to_rfc3339 t ~tz_offset_s:0 in
91 let dec s =
92 match Ptime.of_rfc3339 s with
93 | Ok (t, _, _) -> t
94 | Error _ -> failwith ("Invalid timestamp: " ^ s)
95 in
96 Jsont.map ~dec ~enc Jsont.string
97
98let daily_entry_jsont : daily_entry Jsont.t =
99 let make date hour timestamp summary changes commit_range contributors
100 repo_url : daily_entry =
101 {
102 date;
103 hour;
104 timestamp;
105 summary;
106 changes;
107 commit_range;
108 contributors;
109 repo_url;
110 }
111 in
112 (* Default hour and timestamp for backwards compat when reading old files *)
113 let default_hour = 0 in
114 let default_timestamp = Ptime.epoch in
115 Jsont.Object.map ~kind:"daily_entry" make
116 |> Jsont.Object.mem "date" Jsont.string ~enc:(fun (e : daily_entry) -> e.date)
117 |> Jsont.Object.mem "hour" Jsont.int ~dec_absent:default_hour
118 ~enc:(fun (e : daily_entry) -> e.hour)
119 |> Jsont.Object.mem "timestamp" ptime_jsont ~dec_absent:default_timestamp
120 ~enc:(fun (e : daily_entry) -> e.timestamp)
121 |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun (e : daily_entry) ->
122 e.summary)
123 |> Jsont.Object.mem "changes" (Jsont.list Jsont.string)
124 ~enc:(fun (e : daily_entry) -> e.changes)
125 |> Jsont.Object.mem "commit_range" commit_range_jsont
126 ~enc:(fun (e : daily_entry) -> e.commit_range)
127 |> Jsont.Object.mem "contributors" (Jsont.list Jsont.string) ~dec_absent:[]
128 ~enc:(fun (e : daily_entry) -> e.contributors)
129 |> Jsont.Object.mem "repo_url" (Jsont.option Jsont.string) ~dec_absent:None
130 ~enc:(fun (e : daily_entry) -> e.repo_url)
131 |> Jsont.Object.finish
132
133let daily_changes_file_jsont : daily_changes_file Jsont.t =
134 let make repository entries : daily_changes_file = { repository; entries } in
135 Jsont.Object.map ~kind:"daily_changes_file" make
136 |> Jsont.Object.mem "repository" Jsont.string
137 ~enc:(fun (f : daily_changes_file) -> f.repository)
138 |> Jsont.Object.mem "entries" (Jsont.list daily_entry_jsont)
139 ~enc:(fun (f : daily_changes_file) -> f.entries)
140 |> Jsont.Object.finish
141
142(* File I/O *)
143
144(* Helper to ensure .changes directory exists *)
145let ensure_changes_dir ~fs monorepo =
146 let changes_dir = Eio.Path.(fs / Fpath.to_string monorepo / ".changes") in
147 match Eio.Path.kind ~follow:true changes_dir with
148 | `Directory -> ()
149 | _ -> Eio.Path.mkdir ~perm:0o755 changes_dir
150 | exception Eio.Io _ -> Eio.Path.mkdir ~perm:0o755 changes_dir
151
152(* Load weekly changes from .changes/<repo>.json in monorepo *)
153let load ~fs ~monorepo repo_name =
154 let file_path =
155 Eio.Path.(
156 fs / Fpath.to_string monorepo / ".changes" / (repo_name ^ ".json"))
157 in
158 match Eio.Path.kind ~follow:true file_path with
159 | `Regular_file -> (
160 let content = Eio.Path.load file_path in
161 match Jsont_bytesrw.decode_string changes_file_jsont content with
162 | Ok cf -> Ok cf
163 | Error e ->
164 Error (Format.sprintf "Failed to parse %s.json: %s" repo_name e))
165 | _ -> Ok { repository = repo_name; entries = [] }
166 | exception Eio.Io _ -> Ok { repository = repo_name; entries = [] }
167
168(* Save weekly changes to .changes/<repo>.json in monorepo *)
169let save ~fs ~monorepo (cf : changes_file) =
170 ensure_changes_dir ~fs monorepo;
171 let file_path =
172 Eio.Path.(
173 fs / Fpath.to_string monorepo / ".changes" / (cf.repository ^ ".json"))
174 in
175 match
176 Jsont_bytesrw.encode_string ~format:Jsont.Indent changes_file_jsont cf
177 with
178 | Ok content ->
179 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
180 Ok ()
181 | Error e ->
182 Error (Format.sprintf "Failed to encode %s.json: %s" cf.repository e)
183
184(* Filename for daily changes: <repo>-<YYYY-MM-DD>.json *)
185let daily_filename repo_name date = repo_name ^ "-" ^ date ^ ".json"
186
187(* Check if daily file exists on disk *)
188let daily_exists ~fs ~monorepo ~date repo_name =
189 let filename = daily_filename repo_name date in
190 let file_path =
191 Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
192 in
193 match Eio.Path.kind ~follow:true file_path with
194 | `Regular_file -> true
195 | _ -> false
196 | exception Eio.Io _ -> false
197
198(* Load daily changes from .changes/<repo>-<date>.json in monorepo *)
199let load_daily ~fs ~monorepo ~date repo_name =
200 let filename = daily_filename repo_name date in
201 let file_path =
202 Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
203 in
204 match Eio.Path.kind ~follow:true file_path with
205 | `Regular_file -> (
206 let content = Eio.Path.load file_path in
207 match Jsont_bytesrw.decode_string daily_changes_file_jsont content with
208 | Ok cf -> Ok cf
209 | Error e -> Error (Format.sprintf "Failed to parse %s: %s" filename e))
210 | _ -> Ok { repository = repo_name; entries = [] }
211 | exception Eio.Io _ -> Ok { repository = repo_name; entries = [] }
212
213(* Save daily changes to .changes/<repo>-<date>.json in monorepo *)
214let save_daily ~fs ~monorepo ~date (cf : daily_changes_file) =
215 ensure_changes_dir ~fs monorepo;
216 let filename = daily_filename cf.repository date in
217 let file_path =
218 Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / filename)
219 in
220 match
221 Jsont_bytesrw.encode_string ~format:Jsont.Indent daily_changes_file_jsont cf
222 with
223 | Ok content ->
224 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content;
225 Ok ()
226 | Error e -> Error (Format.sprintf "Failed to encode %s: %s" filename e)
227
228(* Markdown generation *)
229
230let to_markdown (cf : changes_file) =
231 let buf = Buffer.create 1024 in
232 Buffer.add_string buf (Printf.sprintf "# %s Changelog\n\n" cf.repository);
233 List.iter
234 (fun (entry : weekly_entry) ->
235 Buffer.add_string buf
236 (Printf.sprintf "## Week of %s to %s\n\n" entry.week_start
237 entry.week_end);
238 Buffer.add_string buf (Printf.sprintf "%s\n\n" entry.summary);
239 List.iter
240 (fun change -> Buffer.add_string buf (Printf.sprintf "- %s\n" change))
241 entry.changes;
242 Buffer.add_string buf "\n")
243 cf.entries;
244 Buffer.contents buf
245
246let aggregate ~history (cfs : changes_file list) =
247 (* Collect all entries from all files, tagged with repository *)
248 let all_entries =
249 List.concat_map
250 (fun (cf : changes_file) ->
251 List.map (fun (e : weekly_entry) -> (cf.repository, e)) cf.entries)
252 cfs
253 in
254 (* Sort by week_start descending *)
255 let sorted =
256 List.sort
257 (fun (_, (e1 : weekly_entry)) (_, (e2 : weekly_entry)) ->
258 String.compare e2.week_start e1.week_start)
259 all_entries
260 in
261 (* Group by week *)
262 let rec group_by_week acc current_week current_group = function
263 | [] ->
264 if current_group <> [] then
265 (current_week, List.rev current_group) :: acc
266 else acc
267 | (repo, (entry : weekly_entry)) :: rest ->
268 let week_key = entry.week_start ^ " to " ^ entry.week_end in
269 if current_week = "" || current_week = week_key then
270 group_by_week acc week_key ((repo, entry) :: current_group) rest
271 else
272 group_by_week
273 ((current_week, List.rev current_group) :: acc)
274 week_key
275 [ (repo, entry) ]
276 rest
277 in
278 let grouped = List.rev (group_by_week [] "" [] sorted) in
279 (* Take only the requested number of weeks *)
280 let limited =
281 if history > 0 then List.filteri (fun i _ -> i < history) grouped
282 else grouped
283 in
284 (* Generate markdown *)
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 (Printf.sprintf "## Week of %s\n\n" week_key);
290 List.iter
291 (fun (repo, (entry : weekly_entry)) ->
292 Buffer.add_string buf (Printf.sprintf "### %s\n" repo);
293 Buffer.add_string buf (Printf.sprintf "%s\n" entry.summary);
294 List.iter
295 (fun change ->
296 Buffer.add_string buf (Printf.sprintf "- %s\n" change))
297 entry.changes;
298 Buffer.add_string buf "\n")
299 entries)
300 limited;
301 Buffer.contents buf
302
303(* Week calculation *)
304
305(* Get day of week: 0 = Sunday, 1 = Monday, ... 6 = Saturday
306 Using Zeller's congruence for Gregorian calendar *)
307let day_of_week year month day =
308 let y = if month < 3 then year - 1 else year in
309 let m = if month < 3 then month + 12 else month in
310 let q = day in
311 let k = y mod 100 in
312 let j = y / 100 in
313 let h = (q + (13 * (m + 1) / 5) + k + (k / 4) + (j / 4) - (2 * j)) mod 7 in
314 (* Convert from Zeller's (0=Sat) to standard (0=Sun) *)
315 (h + 6) mod 7
316
317let add_days (y, m, d) n =
318 (* Simple day addition - handles month/year boundaries *)
319 let days_in_month year month =
320 match month with
321 | 1 | 3 | 5 | 7 | 8 | 10 | 12 -> 31
322 | 4 | 6 | 9 | 11 -> 30
323 | 2 ->
324 if (year mod 4 = 0 && year mod 100 <> 0) || year mod 400 = 0 then 29
325 else 28
326 | _ -> 30
327 in
328 let rec loop y m d n =
329 if n = 0 then (y, m, d)
330 else if n > 0 then
331 let dim = days_in_month y m in
332 if d + n <= dim then (y, m, d + n)
333 else
334 let remaining = dim - d in
335 let new_m = if m = 12 then 1 else m + 1 in
336 let new_y = if m = 12 then y + 1 else y in
337 loop new_y new_m 1 (n - remaining - 1)
338 else if
339 (* n < 0 *)
340 d + n >= 1
341 then (y, m, d + n)
342 else
343 let new_m = if m = 1 then 12 else m - 1 in
344 let new_y = if m = 1 then y - 1 else y in
345 let dim = days_in_month new_y new_m in
346 loop new_y new_m dim (n + d)
347 in
348 loop y m d n
349
350let format_date (y, m, d) = Printf.sprintf "%04d-%02d-%02d" y m d
351
352let week_of_date (y, m, d) =
353 let dow = day_of_week y m d in
354 (* Monday = 1, so days to subtract to get to Monday *)
355 let days_to_monday = if dow = 0 then 6 else dow - 1 in
356 let monday = add_days (y, m, d) (-days_to_monday) in
357 let sunday = add_days monday 6 in
358 (format_date monday, format_date sunday)
359
360let week_of_ptime t =
361 let (y, m, d), _ = Ptime.to_date_time t in
362 week_of_date (y, m, d)
363
364let has_week (cf : changes_file) ~week_start =
365 List.exists (fun (e : weekly_entry) -> e.week_start = week_start) cf.entries
366
367let date_of_ptime t =
368 let (y, m, d), _ = Ptime.to_date_time t in
369 format_date (y, m, d)
370
371let has_day (cf : daily_changes_file) ~date:_ =
372 (* With per-day files, the file is already for a specific date.
373 This function now checks if the file has any entries. *)
374 cf.entries <> []
375
376(* Aggregate daily changes into DAILY-CHANGES.md *)
377let aggregate_daily ~history (cfs : daily_changes_file list) =
378 (* Collect all entries from all files, tagged with repository *)
379 let all_entries =
380 List.concat_map
381 (fun (cf : daily_changes_file) ->
382 List.map (fun (e : daily_entry) -> (cf.repository, e)) cf.entries)
383 cfs
384 in
385 (* Sort by date descending *)
386 let sorted =
387 List.sort
388 (fun (_, (e1 : daily_entry)) (_, (e2 : daily_entry)) ->
389 String.compare e2.date e1.date)
390 all_entries
391 in
392 (* Group by date *)
393 let rec group_by_date acc current_date current_group = function
394 | [] ->
395 if current_group <> [] then
396 (current_date, List.rev current_group) :: acc
397 else acc
398 | (repo, (entry : daily_entry)) :: rest ->
399 if current_date = "" || current_date = entry.date then
400 group_by_date acc entry.date ((repo, entry) :: current_group) rest
401 else
402 group_by_date
403 ((current_date, List.rev current_group) :: acc)
404 entry.date
405 [ (repo, entry) ]
406 rest
407 in
408 let grouped = List.rev (group_by_date [] "" [] sorted) in
409 (* Take only the requested number of days *)
410 let limited =
411 if history > 0 then List.filteri (fun i _ -> i < history) grouped
412 else grouped
413 in
414 (* Generate markdown - only include repos with actual changes *)
415 let buf = Buffer.create 4096 in
416 Buffer.add_string buf "# Daily Changelog\n\n";
417 List.iter
418 (fun (date, entries) ->
419 (* Filter out entries with empty changes - these are repos with no changes *)
420 let entries_with_changes =
421 List.filter
422 (fun (_, (entry : daily_entry)) -> entry.changes <> [])
423 entries
424 in
425 if entries_with_changes <> [] then begin
426 Buffer.add_string buf (Printf.sprintf "## %s\n\n" date);
427 List.iter
428 (fun (repo, (entry : daily_entry)) ->
429 (* Format repo name with link if URL available *)
430 let repo_header =
431 match entry.repo_url with
432 | Some url -> Printf.sprintf "[%s](%s)" repo url
433 | None -> repo
434 in
435 Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_header);
436 Buffer.add_string buf (Printf.sprintf "%s\n\n" entry.summary);
437 List.iter
438 (fun change ->
439 Buffer.add_string buf (Printf.sprintf "- %s\n" change))
440 entry.changes;
441 (* Add contributors if any *)
442 if entry.contributors <> [] then begin
443 let contributors_str = String.concat ", " entry.contributors in
444 Buffer.add_string buf
445 (Printf.sprintf "\n*Contributors: %s*\n" contributors_str)
446 end;
447 Buffer.add_string buf "\n")
448 entries_with_changes
449 end)
450 limited;
451 Buffer.contents buf
452
453(* Claude prompt generation *)
454
455let generate_weekly_prompt ~repository ~week_start ~week_end commits =
456 let buf = Buffer.create 4096 in
457 Buffer.add_string buf
458 (Printf.sprintf
459 "You are analyzing git commits for the OCaml library \"%s\".\n"
460 repository);
461 Buffer.add_string buf
462 (Printf.sprintf
463 "Generate a user-facing changelog entry for the week of %s to %s.\n\n"
464 week_start week_end);
465 Buffer.add_string buf "## Commits this week:\n\n";
466 List.iter
467 (fun (commit : Git.log_entry) ->
468 Buffer.add_string buf
469 (Printf.sprintf "### %s by %s (%s)\n"
470 (String.sub commit.hash 0 (min 7 (String.length commit.hash)))
471 commit.author commit.date);
472 Buffer.add_string buf (Printf.sprintf "%s\n\n" commit.subject);
473 if commit.body <> "" then begin
474 Buffer.add_string buf (Printf.sprintf "%s\n" commit.body)
475 end;
476 Buffer.add_string buf "---\n\n")
477 commits;
478 Buffer.add_string buf
479 {|## Instructions:
480
4811. Focus on USER-FACING changes only. Skip:
482 - Internal refactoring with no API impact
483 - CI/build system tweaks
484 - Typo fixes in code comments
485 - Dependency bumps (unless they add features)
486
4872. IMPORTANT: If there are NO user-facing changes, output a blank entry with empty
488 summary and empty changes array. Do NOT write "no changes" or similar text.
489 Example for no changes: {"summary": "", "changes": []}
490
4913. Otherwise, respond in this exact JSON format:
492{
493 "summary": "One sentence describing the most important change",
494 "changes": [
495 "First user-facing change as a bullet point",
496 "Second change",
497 "..."
498 ]
499}
500
5014. Write for developers using this library. Be:
502 - Concise (max 80 chars per bullet)
503 - Specific (mention function/module names)
504 - Action-oriented (start with verbs: Added, Fixed, Improved, Removed)
505
5065. Maximum 5 bullet points. Group related changes if needed.
507|};
508 Buffer.contents buf
509
510let generate_daily_prompt ~repository ~date commits =
511 let buf = Buffer.create 4096 in
512 Buffer.add_string buf
513 (Printf.sprintf
514 "You are analyzing git commits for the OCaml library \"%s\".\n"
515 repository);
516 Buffer.add_string buf
517 (Printf.sprintf "Generate a user-facing changelog entry for %s.\n\n" date);
518 Buffer.add_string buf "## Commits today:\n\n";
519 List.iter
520 (fun (commit : Git.log_entry) ->
521 Buffer.add_string buf
522 (Printf.sprintf "### %s by %s (%s)\n"
523 (String.sub commit.hash 0 (min 7 (String.length commit.hash)))
524 commit.author commit.date);
525 Buffer.add_string buf (Printf.sprintf "%s\n\n" commit.subject);
526 if commit.body <> "" then begin
527 Buffer.add_string buf (Printf.sprintf "%s\n" commit.body)
528 end;
529 Buffer.add_string buf "---\n\n")
530 commits;
531 Buffer.add_string buf
532 {|## Instructions:
533
5341. Focus on USER-FACING changes only. Skip:
535 - Internal refactoring with no API impact
536 - CI/build system tweaks
537 - Typo fixes in code comments
538 - Dependency bumps (unless they add features)
539
5402. IMPORTANT: If there are NO user-facing changes, output a blank entry with empty
541 summary and empty changes array. Do NOT write "no changes" or similar text.
542 Example for no changes: {"summary": "", "changes": []}
543
5443. Otherwise, respond in this exact JSON format:
545{
546 "summary": "One sentence describing the most important change",
547 "changes": [
548 "First user-facing change as a bullet point",
549 "Second change",
550 "..."
551 ]
552}
553
5544. Write for developers using this library. Be:
555 - Concise (max 80 chars per bullet)
556 - Specific (mention function/module names)
557 - Action-oriented (start with verbs: Added, Fixed, Improved, Removed)
558
5595. Maximum 5 bullet points. Group related changes if needed.
560|};
561 Buffer.contents buf
562
563(* Backwards compatibility *)
564let generate_prompt = generate_weekly_prompt
565
566(* Response parsing *)
567
568type claude_response = { summary : string; changes : string list }
569
570let claude_response_jsont =
571 let make summary changes = { summary; changes } in
572 Jsont.Object.map ~kind:"claude_response" make
573 |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun r -> r.summary)
574 |> Jsont.Object.mem "changes" (Jsont.list Jsont.string) ~enc:(fun r ->
575 r.changes)
576 |> Jsont.Object.finish
577
578let parse_claude_response text =
579 let text = String.trim text in
580 (* Legacy support for NO_CHANGES response *)
581 if text = "NO_CHANGES" then Ok None
582 else
583 match Jsont_bytesrw.decode_string claude_response_jsont text with
584 | Ok r ->
585 (* Treat empty summary and changes as no changes *)
586 if r.summary = "" && r.changes = [] then Ok None else Ok (Some r)
587 | Error e -> Error (Format.sprintf "Failed to parse Claude response: %s" e)
588
589(* Main analysis function *)
590
591let analyze_commits ~sw ~process_mgr ~clock ~repository ~week_start ~week_end
592 commits =
593 if commits = [] then Ok None
594 else begin
595 let prompt = generate_prompt ~repository ~week_start ~week_end commits in
596
597 (* Create Claude options with structured output *)
598 let output_schema =
599 let open Jsont in
600 Object
601 ( [
602 (("type", Meta.none), String ("object", Meta.none));
603 ( ("properties", Meta.none),
604 Object
605 ( [
606 ( ("summary", Meta.none),
607 Object
608 ( [ (("type", Meta.none), String ("string", Meta.none)) ],
609 Meta.none ) );
610 ( ("changes", Meta.none),
611 Object
612 ( [
613 (("type", Meta.none), String ("array", Meta.none));
614 ( ("items", Meta.none),
615 Object
616 ( [
617 ( ("type", Meta.none),
618 String ("string", Meta.none) );
619 ],
620 Meta.none ) );
621 ],
622 Meta.none ) );
623 ],
624 Meta.none ) );
625 ( ("required", Meta.none),
626 Array
627 ( [
628 String ("summary", Meta.none); String ("changes", Meta.none);
629 ],
630 Meta.none ) );
631 ],
632 Meta.none )
633 in
634 let output_format =
635 Claude.Proto.Structured_output.of_json_schema output_schema
636 in
637 let options =
638 Claude.Options.default
639 |> Claude.Options.with_output_format output_format
640 |> Claude.Options.with_max_turns 1
641 in
642
643 let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in
644 Claude.Client.query client prompt;
645
646 let responses = Claude.Client.receive_all client in
647 let result = ref None in
648 List.iter
649 (function
650 | Claude.Response.Complete c -> (
651 match Claude.Response.Complete.structured_output c with
652 | Some json -> (
653 match Jsont.Json.decode claude_response_jsont json with
654 | Ok r -> result := Some (Ok (Some r))
655 | Error e ->
656 result :=
657 Some
658 (Error
659 (Format.sprintf "Failed to decode response: %s" e)))
660 | None -> (
661 (* Try to get text and parse it as fallback *)
662 match Claude.Response.Complete.result_text c with
663 | Some text -> result := Some (parse_claude_response text)
664 | None -> result := Some (Ok None)))
665 | Claude.Response.Text t ->
666 let text = Claude.Response.Text.content t in
667 if String.trim text = "NO_CHANGES" then result := Some (Ok None)
668 | Claude.Response.Error e ->
669 result :=
670 Some
671 (Error
672 (Printf.sprintf "Claude error: %s"
673 (Claude.Response.Error.message e)))
674 | _ -> ())
675 responses;
676
677 match !result with Some r -> r | None -> Ok None
678 end
679
680(* Daily analysis function *)
681let analyze_commits_daily ~sw ~process_mgr ~clock ~repository ~date commits =
682 if commits = [] then Ok None
683 else begin
684 let prompt = generate_daily_prompt ~repository ~date commits in
685
686 (* Create Claude options with structured output *)
687 let output_schema =
688 let open Jsont in
689 Object
690 ( [
691 (("type", Meta.none), String ("object", Meta.none));
692 ( ("properties", Meta.none),
693 Object
694 ( [
695 ( ("summary", Meta.none),
696 Object
697 ( [ (("type", Meta.none), String ("string", Meta.none)) ],
698 Meta.none ) );
699 ( ("changes", Meta.none),
700 Object
701 ( [
702 (("type", Meta.none), String ("array", Meta.none));
703 ( ("items", Meta.none),
704 Object
705 ( [
706 ( ("type", Meta.none),
707 String ("string", Meta.none) );
708 ],
709 Meta.none ) );
710 ],
711 Meta.none ) );
712 ],
713 Meta.none ) );
714 ( ("required", Meta.none),
715 Array
716 ( [
717 String ("summary", Meta.none); String ("changes", Meta.none);
718 ],
719 Meta.none ) );
720 ],
721 Meta.none )
722 in
723 let output_format =
724 Claude.Proto.Structured_output.of_json_schema output_schema
725 in
726 let options =
727 Claude.Options.default
728 |> Claude.Options.with_output_format output_format
729 |> Claude.Options.with_max_turns 1
730 in
731
732 let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in
733 Claude.Client.query client prompt;
734
735 let responses = Claude.Client.receive_all client in
736 let result = ref None in
737 List.iter
738 (function
739 | Claude.Response.Complete c -> (
740 match Claude.Response.Complete.structured_output c with
741 | Some json -> (
742 match Jsont.Json.decode claude_response_jsont json with
743 | Ok r ->
744 (* Treat empty response as no changes *)
745 if r.summary = "" && r.changes = [] then
746 result := Some (Ok None)
747 else result := Some (Ok (Some r))
748 | Error e ->
749 result :=
750 Some
751 (Error
752 (Format.sprintf "Failed to decode response: %s" e)))
753 | None -> (
754 (* Try to get text and parse it as fallback *)
755 match Claude.Response.Complete.result_text c with
756 | Some text -> result := Some (parse_claude_response text)
757 | None -> result := Some (Ok None)))
758 | Claude.Response.Text t ->
759 let text = Claude.Response.Text.content t in
760 if String.trim text = "NO_CHANGES" then result := Some (Ok None)
761 | Claude.Response.Error e ->
762 result :=
763 Some
764 (Error
765 (Printf.sprintf "Claude error: %s"
766 (Claude.Response.Error.message e)))
767 | _ -> ())
768 responses;
769
770 match !result with Some r -> r | None -> Ok None
771 end
772
773(* Refine daily changelog markdown to be more narrative *)
774let refine_daily_changelog ~sw ~process_mgr ~clock markdown =
775 let prompt =
776 Printf.sprintf
777 {|You are editing a daily changelog for an OCaml monorepo.
778
779Your task is to refine the following changelog to be:
7801. More narrative and human-readable - write it as a daily update that developers will want to read
7812. Grouped by related changes - if multiple repos have related changes, group them together
7823. Succinct but complete - don't lose any information, but make it more concise
7834. Well-ordered - put the most significant changes first
784
785Keep the markdown format with:
786- A main heading for each date
787- 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"
788- Bullet points for individual changes
789- Preserve all contributor attributions (format: — *Contributor Name*)
790- 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)
791- Format each bullet as: **[repo-name](url)**: Description — *Contributors* (if any)
792
793IMPORTANT: For "initial import" or "added as subtree" entries:
794- Put these in a dedicated "New Libraries" section
795- Expand the description to explain what the library does and its purpose
796- 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
797- 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"
798
799Here is the changelog to refine:
800
801%s
802
803Output ONLY the refined markdown, no explanation or preamble.|}
804 markdown
805 in
806
807 let options = Claude.Options.default |> Claude.Options.with_max_turns 1 in
808
809 let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in
810 Claude.Client.query client prompt;
811
812 let responses = Claude.Client.receive_all client in
813 let result = ref None in
814 List.iter
815 (function
816 | Claude.Response.Complete c -> (
817 match Claude.Response.Complete.result_text c with
818 | Some text -> result := Some (Ok text)
819 | None -> result := Some (Ok markdown) (* fallback to original *))
820 | Claude.Response.Error e ->
821 result :=
822 Some
823 (Error
824 (Printf.sprintf "Claude error: %s"
825 (Claude.Response.Error.message e)))
826 | _ -> ())
827 responses;
828
829 match !result with
830 | Some r -> r
831 | None -> Ok markdown (* fallback to original *)
832
833(* Simple string containment check *)
834let string_contains_s haystack needle =
835 let hlen = String.length haystack in
836 let nlen = String.length needle in
837 if nlen > hlen then false
838 else begin
839 let rec check i =
840 if i > hlen - nlen then false
841 else if String.sub haystack i nlen = needle then true
842 else check (i + 1)
843 in
844 check 0
845 end
846
847(* Infer change type from summary text *)
848let infer_change_type summary =
849 let summary_lower = String.lowercase_ascii summary in
850 if
851 String.starts_with ~prefix:"initial import" summary_lower
852 || String.starts_with ~prefix:"added as subtree" summary_lower
853 || String.starts_with ~prefix:"added" summary_lower
854 && String.ends_with ~suffix:"library" summary_lower
855 then Changes_aggregated.New_library
856 else if
857 List.exists
858 (fun kw -> string_contains_s summary_lower kw)
859 [ "fix"; "bugfix"; "bug fix"; "repair"; "patch"; "resolve"; "correct" ]
860 then Changes_aggregated.Bugfix
861 else if
862 List.exists
863 (fun kw -> string_contains_s summary_lower kw)
864 [
865 "refactor";
866 "cleanup";
867 "clean up";
868 "reorganize";
869 "restructure";
870 "simplify";
871 ]
872 then Changes_aggregated.Refactor
873 else if
874 List.exists
875 (fun kw -> string_contains_s summary_lower kw)
876 [ "doc"; "documentation"; "readme"; "comment"; "tutorial"; "guide" ]
877 then Changes_aggregated.Documentation
878 else if
879 List.exists
880 (fun kw -> string_contains_s summary_lower kw)
881 [ "add"; "new"; "feature"; "implement"; "support"; "introduce"; "enable" ]
882 then Changes_aggregated.Feature
883 else Changes_aggregated.Unknown
884
885(** Generate an aggregated daily file from individual daily json files. This
886 creates a YYYYMMDD.json file in the .changes directory. *)
887let generate_aggregated ~fs ~monorepo ~date ~git_head ~now =
888 let changes_dir = Eio.Path.(fs / Fpath.to_string monorepo / ".changes") in
889
890 (* List all *-<date>.json files (new per-day format) *)
891 let files = try Eio.Path.read_dir changes_dir with Eio.Io _ -> [] in
892 (* Match files like "<repo>-2026-01-19.json" for the given date *)
893 let date_suffix = "-" ^ date ^ ".json" in
894 let date_suffix_len = String.length date_suffix in
895 let daily_files =
896 List.filter
897 (fun f ->
898 String.ends_with ~suffix:date_suffix f
899 && String.length f > date_suffix_len)
900 files
901 in
902
903 (* Load all daily files for this date and collect entries *)
904 let entries =
905 List.concat_map
906 (fun filename ->
907 (* Extract repo name: filename is "<repo>-<date>.json" *)
908 let repo_name =
909 String.sub filename 0 (String.length filename - date_suffix_len)
910 in
911 let path = Eio.Path.(changes_dir / filename) in
912 try
913 let content = Eio.Path.load path in
914 match
915 Jsont_bytesrw.decode_string daily_changes_file_jsont content
916 with
917 | Ok dcf ->
918 List.filter_map
919 (fun (e : daily_entry) ->
920 if e.changes <> [] then Some (repo_name, e) else None)
921 dcf.entries
922 | Error _ -> []
923 with Eio.Io _ -> [])
924 daily_files
925 in
926
927 (* Convert to aggregated format *)
928 let agg_entries =
929 List.map
930 (fun (repo_name, (e : daily_entry)) ->
931 let change_type = infer_change_type e.summary in
932 Changes_aggregated.
933 {
934 repository = repo_name;
935 hour = e.hour;
936 timestamp = e.timestamp;
937 summary = e.summary;
938 changes = e.changes;
939 commit_range =
940 {
941 from_hash = e.commit_range.from_hash;
942 to_hash = e.commit_range.to_hash;
943 count = e.commit_range.count;
944 };
945 contributors = e.contributors;
946 repo_url = e.repo_url;
947 change_type;
948 })
949 entries
950 in
951
952 (* Collect all unique authors *)
953 let authors =
954 entries
955 |> List.concat_map (fun (_, (e : daily_entry)) -> e.contributors)
956 |> List.sort_uniq String.compare
957 in
958
959 (* Create the aggregated structure *)
960 let aggregated : Changes_aggregated.t =
961 { date; generated_at = now; git_head; entries = agg_entries; authors }
962 in
963
964 (* Save to YYYYMMDD.json *)
965 let changes_dir_fpath = Fpath.(v (Fpath.to_string monorepo) / ".changes") in
966 Changes_aggregated.save ~fs ~changes_dir:changes_dir_fpath aggregated