+39 -13

monopam/bin/main.ml

··· 397 (* Changes command *) 398 399 let changes_cmd = 400 - let doc = "Generate weekly changelog entries using Claude AI" in 401 let man = 402 [ 403 `S Manpage.s_description; 404 `P "Analyzes git commit history and generates user-facing changelogs."; 405 `P 406 - "For each package, creates/updates a CHANGES.json file with weekly \ 407 - entries. Also generates an aggregated CHANGES.md at the monorepo root."; 408 - `P "Each weekly entry includes:"; 0 0 0 0 0 0 0 0 409 `I ("summary", "A one-line summary of the most important change"); 410 `I ("changes", "Up to 5 bullet points describing user-facing changes"); 411 `I ("commit_range", "The range of commits included in the entry"); ··· 413 "Claude AI analyzes commits and generates changelog text focused on \ 414 user-facing changes. Internal refactoring, CI tweaks, and typo fixes \ 415 are automatically filtered out."; 0 0 0 416 ] 417 in 418 let info = Cmd.info "changes" ~doc ~man in 0 0 0 0 419 let weeks = 420 - let doc = "Number of past weeks to analyze (default: 1, current week only)" in 421 Arg.(value & opt int 1 & info [ "w"; "weeks" ] ~doc) 422 in 0 0 0 0 423 let history = 424 - let doc = "Number of recent weeks to include in CHANGES.md (default: 12)" in 425 Arg.(value & opt int 12 & info [ "history" ] ~doc) 426 in 427 let dry_run = 428 let doc = "Preview changes without writing files" in 429 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc) 430 in 431 - let run config_file package weeks history dry_run () = 432 Eio_main.run @@ fun env -> 433 with_config env config_file @@ fun config -> 434 let fs = Eio.Stdenv.fs env in 435 let proc = Eio.Stdenv.process_mgr env in 436 let clock = Eio.Stdenv.clock env in 437 - match 438 - Monopam.changes ~proc ~fs ~config ~clock ?package ~weeks ~history ~dry_run 439 - () 440 - with 0 0 0 0 0 0 441 | Ok () -> 442 if dry_run then Fmt.pr "Dry run complete.@." 443 - else Fmt.pr "Changelog updated.@."; 0 444 `Ok () 445 | Error e -> 446 Fmt.epr "Error: %a@." Monopam.pp_error e; ··· 449 Cmd.v info 450 Term.( 451 ret 452 - (const run $ config_file_arg $ package_arg $ weeks $ history $ dry_run 453 $ logging_term)) 454 455 (* Main command group *)

··· 397 (* Changes command *) 398 399 let changes_cmd = 400 + let doc = "Generate changelog entries using Claude AI" in 401 let man = 402 [ 403 `S Manpage.s_description; 404 `P "Analyzes git commit history and generates user-facing changelogs."; 405 `P 406 + "By default, generates weekly entries. Use --daily to generate daily \ 407 + entries instead."; 408 + `P 409 + "Changes are stored in the .changes directory at the monorepo root:"; 410 + `I (".changes/<repo>.json", "Weekly changelog entries"); 411 + `I (".changes/<repo>-daily.json", "Daily changelog entries"); 412 + `P 413 + "Also generates aggregated markdown files at the monorepo root:"; 414 + `I ("CHANGES.md", "Aggregated weekly changelog"); 415 + `I ("DAILY-CHANGES.md", "Aggregated daily changelog"); 416 + `P "Each entry includes:"; 417 `I ("summary", "A one-line summary of the most important change"); 418 `I ("changes", "Up to 5 bullet points describing user-facing changes"); 419 `I ("commit_range", "The range of commits included in the entry"); ··· 421 "Claude AI analyzes commits and generates changelog text focused on \ 422 user-facing changes. Internal refactoring, CI tweaks, and typo fixes \ 423 are automatically filtered out."; 424 + `P 425 + "Repositories with no user-facing changes will have blank entries \ 426 + (empty summary and changes) rather than 'no changes' text."; 427 ] 428 in 429 let info = Cmd.info "changes" ~doc ~man in 430 + let daily = 431 + let doc = "Generate daily changelog entries instead of weekly" in 432 + Arg.(value & flag & info [ "daily"; "d" ] ~doc) 433 + in 434 let weeks = 435 + let doc = "Number of past weeks to analyze (default: 1, current week only). Ignored if --daily is set." in 436 Arg.(value & opt int 1 & info [ "w"; "weeks" ] ~doc) 437 in 438 + let days = 439 + let doc = "Number of past days to analyze when using --daily (default: 1, today only)" in 440 + Arg.(value & opt int 1 & info [ "days" ] ~doc) 441 + in 442 let history = 443 + let doc = "Number of recent entries to include in aggregated markdown (default: 12 for weekly, 30 for daily)" in 444 Arg.(value & opt int 12 & info [ "history" ] ~doc) 445 in 446 let dry_run = 447 let doc = "Preview changes without writing files" in 448 Arg.(value & flag & info [ "dry-run"; "n" ] ~doc) 449 in 450 + let run config_file package daily weeks days history dry_run () = 451 Eio_main.run @@ fun env -> 452 with_config env config_file @@ fun config -> 453 let fs = Eio.Stdenv.fs env in 454 let proc = Eio.Stdenv.process_mgr env in 455 let clock = Eio.Stdenv.clock env in 456 + let result = 457 + if daily then begin 458 + (* Use 30 as default history for daily if not explicitly set *) 459 + let history = if history = 12 then 30 else history in 460 + Monopam.changes_daily ~proc ~fs ~config ~clock ?package ~days ~history ~dry_run () 461 + end 462 + else 463 + Monopam.changes ~proc ~fs ~config ~clock ?package ~weeks ~history ~dry_run () 464 + in 465 + match result with 466 | Ok () -> 467 if dry_run then Fmt.pr "Dry run complete.@." 468 + else if daily then Fmt.pr "Daily changelog updated.@." 469 + else Fmt.pr "Weekly changelog updated.@."; 470 `Ok () 471 | Error e -> 472 Fmt.epr "Error: %a@." Monopam.pp_error e; ··· 475 Cmd.v info 476 Term.( 477 ret 478 + (const run $ config_file_arg $ package_arg $ daily $ weeks $ days $ history $ dry_run 479 $ logging_term)) 480 481 (* Main command group *)

+375 -34

monopam/lib/changes.ml

··· 1 (** Changelog generation for monopam. 2 3 - This module handles generating weekly changelog entries using Claude AI 4 - to analyze git commit history and produce user-facing change summaries. *) 0 0 0 0 5 6 type commit_range = { 7 from_hash : string; ··· 17 commit_range : commit_range; 18 } 19 0 0 0 0 0 0 0 0 0 20 type changes_file = { 21 repository : string; 22 entries : weekly_entry list; 23 } 24 0 0 0 0 0 0 0 0 25 (* Jsont codecs *) 26 27 let commit_range_jsont = ··· 32 |> Jsont.Object.mem "count" Jsont.int ~enc:(fun r -> r.count) 33 |> Jsont.Object.finish 34 35 - let weekly_entry_jsont = 36 - let make week_start week_end summary changes commit_range = 37 { week_start; week_end; summary; changes; commit_range } 38 in 39 Jsont.Object.map ~kind:"weekly_entry" make 40 - |> Jsont.Object.mem "week_start" Jsont.string ~enc:(fun e -> e.week_start) 41 - |> Jsont.Object.mem "week_end" Jsont.string ~enc:(fun e -> e.week_end) 42 - |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun e -> e.summary) 43 - |> Jsont.Object.mem "changes" (Jsont.list Jsont.string) ~enc:(fun e -> e.changes) 44 - |> Jsont.Object.mem "commit_range" commit_range_jsont ~enc:(fun e -> e.commit_range) 45 |> Jsont.Object.finish 46 47 - let changes_file_jsont = 48 - let make repository entries = { repository; entries } in 49 Jsont.Object.map ~kind:"changes_file" make 50 - |> Jsont.Object.mem "repository" Jsont.string ~enc:(fun f -> f.repository) 51 - |> Jsont.Object.mem "entries" (Jsont.list weekly_entry_jsont) ~enc:(fun f -> f.entries) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 52 |> Jsont.Object.finish 53 54 (* File I/O *) 55 56 - let load ~fs path = 57 - let file_path = Eio.Path.(fs / Fpath.to_string path / "CHANGES.json") in 0 0 0 0 0 0 0 0 0 58 match Eio.Path.kind ~follow:true file_path with 59 | `Regular_file -> ( 60 let content = Eio.Path.load file_path in 61 match Jsont_bytesrw.decode_string changes_file_jsont content with 62 | Ok cf -> Ok cf 63 - | Error e -> Error (Format.sprintf "Failed to parse CHANGES.json: %s" e)) 64 - | _ -> Ok { repository = Fpath.basename path; entries = [] } 65 - | exception Eio.Io _ -> Ok { repository = Fpath.basename path; entries = [] } 66 67 - let save ~fs cf path = 68 - let file_path = Eio.Path.(fs / Fpath.to_string path / "CHANGES.json") in 0 0 69 match Jsont_bytesrw.encode_string ~format:Jsont.Indent changes_file_jsont cf with 70 | Ok content -> 71 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content; 72 Ok () 73 - | Error e -> Error (Format.sprintf "Failed to encode CHANGES.json: %s" e) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 74 75 (* Markdown generation *) 76 77 - let to_markdown cf = 78 let buf = Buffer.create 1024 in 79 Buffer.add_string buf (Printf.sprintf "# %s Changelog\n\n" cf.repository); 80 - List.iter (fun entry -> 81 Buffer.add_string buf (Printf.sprintf "## Week of %s to %s\n\n" entry.week_start entry.week_end); 82 Buffer.add_string buf (Printf.sprintf "%s\n\n" entry.summary); 83 List.iter (fun change -> ··· 87 cf.entries; 88 Buffer.contents buf 89 90 - let aggregate ~history cfs = 91 (* Collect all entries from all files, tagged with repository *) 92 let all_entries = 93 - List.concat_map (fun cf -> 94 - List.map (fun e -> (cf.repository, e)) cf.entries) 95 cfs 96 in 97 (* Sort by week_start descending *) 98 - let sorted = List.sort (fun (_, e1) (_, e2) -> 99 String.compare e2.week_start e1.week_start) all_entries 100 in 101 (* Group by week *) ··· 103 | [] -> 104 if current_group <> [] then (current_week, List.rev current_group) :: acc 105 else acc 106 - | (repo, entry) :: rest -> 107 let week_key = entry.week_start ^ " to " ^ entry.week_end in 108 if current_week = "" || current_week = week_key then 109 group_by_week acc week_key ((repo, entry) :: current_group) rest ··· 126 Buffer.add_string buf "# Changelog\n\n"; 127 List.iter (fun (week_key, entries) -> 128 Buffer.add_string buf (Printf.sprintf "## Week of %s\n\n" week_key); 129 - List.iter (fun (repo, entry) -> 130 Buffer.add_string buf (Printf.sprintf "### %s\n" repo); 131 Buffer.add_string buf (Printf.sprintf "%s\n" entry.summary); 132 List.iter (fun change -> ··· 195 let (y, m, d), _ = Ptime.to_date_time t in 196 week_of_date (y, m, d) 197 198 - let has_week cf ~week_start = 199 - List.exists (fun e -> e.week_start = week_start) cf.entries 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 200 201 (* Claude prompt generation *) 202 203 - let generate_prompt ~repository ~week_start ~week_end commits = 204 let buf = Buffer.create 4096 in 205 Buffer.add_string buf (Printf.sprintf 206 "You are analyzing git commits for the OCaml library \"%s\".\n" repository); ··· 226 - Typo fixes in code comments 227 - Dependency bumps (unless they add features) 228 229 - 2. If there are NO user-facing changes, respond with exactly: NO_CHANGES 0 0 230 231 3. Otherwise, respond in this exact JSON format: 232 { ··· 247 |}; 248 Buffer.contents buf 249 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 250 (* Response parsing *) 251 252 type claude_response = { ··· 263 264 let parse_claude_response text = 265 let text = String.trim text in 0 266 if text = "NO_CHANGES" then Ok None 267 else 268 match Jsont_bytesrw.decode_string claude_response_jsont text with 269 - | Ok r -> Ok (Some r) 0 0 0 270 | Error e -> Error (Format.sprintf "Failed to parse Claude response: %s" e) 271 272 (* Main analysis function *) ··· 343 | Some r -> r 344 | None -> Ok None 345 end 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 (** Changelog generation for monopam. 2 3 + This module handles generating weekly and daily changelog entries using Claude AI 4 + to analyze git commit history and produce user-facing change summaries. 5 + 6 + Changes are stored in a .changes directory at the monorepo root: 7 + - .changes/<repo_name>.json - weekly changelog entries 8 + - .changes/<repo_name>-daily.json - daily changelog entries *) 9 10 type commit_range = { 11 from_hash : string; ··· 21 commit_range : commit_range; 22 } 23 24 + type daily_entry = { 25 + date : string; (* ISO date YYYY-MM-DD *) 26 + summary : string; (* One-line summary *) 27 + changes : string list; (* Bullet points *) 28 + commit_range : commit_range; 29 + contributors : string list; (* List of contributors for this entry *) 30 + repo_url : string option; (* Upstream repository URL *) 31 + } 32 + 33 type changes_file = { 34 repository : string; 35 entries : weekly_entry list; 36 } 37 38 + type daily_changes_file = { 39 + repository : string; 40 + entries : daily_entry list; 41 + } 42 + 43 + (** Mode for changelog generation *) 44 + type mode = Weekly | Daily 45 + 46 (* Jsont codecs *) 47 48 let commit_range_jsont = ··· 53 |> Jsont.Object.mem "count" Jsont.int ~enc:(fun r -> r.count) 54 |> Jsont.Object.finish 55 56 + let weekly_entry_jsont : weekly_entry Jsont.t = 57 + let make week_start week_end summary changes commit_range : weekly_entry = 58 { week_start; week_end; summary; changes; commit_range } 59 in 60 Jsont.Object.map ~kind:"weekly_entry" make 61 + |> Jsont.Object.mem "week_start" Jsont.string ~enc:(fun (e : weekly_entry) -> e.week_start) 62 + |> Jsont.Object.mem "week_end" Jsont.string ~enc:(fun (e : weekly_entry) -> e.week_end) 63 + |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun (e : weekly_entry) -> e.summary) 64 + |> Jsont.Object.mem "changes" (Jsont.list Jsont.string) ~enc:(fun (e : weekly_entry) -> e.changes) 65 + |> Jsont.Object.mem "commit_range" commit_range_jsont ~enc:(fun (e : weekly_entry) -> e.commit_range) 66 |> Jsont.Object.finish 67 68 + let changes_file_jsont : changes_file Jsont.t = 69 + let make repository entries : changes_file = { repository; entries } in 70 Jsont.Object.map ~kind:"changes_file" make 71 + |> Jsont.Object.mem "repository" Jsont.string ~enc:(fun (f : changes_file) -> f.repository) 72 + |> Jsont.Object.mem "entries" (Jsont.list weekly_entry_jsont) ~enc:(fun (f : changes_file) -> f.entries) 73 + |> Jsont.Object.finish 74 + 75 + let daily_entry_jsont : daily_entry Jsont.t = 76 + let make date summary changes commit_range contributors repo_url : daily_entry = 77 + { date; summary; changes; commit_range; contributors; repo_url } 78 + in 79 + Jsont.Object.map ~kind:"daily_entry" make 80 + |> Jsont.Object.mem "date" Jsont.string ~enc:(fun (e : daily_entry) -> e.date) 81 + |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun (e : daily_entry) -> e.summary) 82 + |> Jsont.Object.mem "changes" (Jsont.list Jsont.string) ~enc:(fun (e : daily_entry) -> e.changes) 83 + |> Jsont.Object.mem "commit_range" commit_range_jsont ~enc:(fun (e : daily_entry) -> e.commit_range) 84 + |> Jsont.Object.mem "contributors" (Jsont.list Jsont.string) ~dec_absent:[] ~enc:(fun (e : daily_entry) -> e.contributors) 85 + |> Jsont.Object.mem "repo_url" (Jsont.option Jsont.string) ~dec_absent:None ~enc:(fun (e : daily_entry) -> e.repo_url) 86 + |> Jsont.Object.finish 87 + 88 + let daily_changes_file_jsont : daily_changes_file Jsont.t = 89 + let make repository entries : daily_changes_file = { repository; entries } in 90 + Jsont.Object.map ~kind:"daily_changes_file" make 91 + |> Jsont.Object.mem "repository" Jsont.string ~enc:(fun (f : daily_changes_file) -> f.repository) 92 + |> Jsont.Object.mem "entries" (Jsont.list daily_entry_jsont) ~enc:(fun (f : daily_changes_file) -> f.entries) 93 |> Jsont.Object.finish 94 95 (* File I/O *) 96 97 + (* Helper to ensure .changes directory exists *) 98 + let ensure_changes_dir ~fs monorepo = 99 + let changes_dir = Eio.Path.(fs / Fpath.to_string monorepo / ".changes") in 100 + match Eio.Path.kind ~follow:true changes_dir with 101 + | `Directory -> () 102 + | _ -> Eio.Path.mkdir ~perm:0o755 changes_dir 103 + | exception Eio.Io _ -> Eio.Path.mkdir ~perm:0o755 changes_dir 104 + 105 + (* Load weekly changes from .changes/<repo>.json in monorepo *) 106 + let load ~fs ~monorepo repo_name = 107 + let file_path = Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / (repo_name ^ ".json")) in 108 match Eio.Path.kind ~follow:true file_path with 109 | `Regular_file -> ( 110 let content = Eio.Path.load file_path in 111 match Jsont_bytesrw.decode_string changes_file_jsont content with 112 | Ok cf -> Ok cf 113 + | Error e -> Error (Format.sprintf "Failed to parse %s.json: %s" repo_name e)) 114 + | _ -> Ok { repository = repo_name; entries = [] } 115 + | exception Eio.Io _ -> Ok { repository = repo_name; entries = [] } 116 117 + (* Save weekly changes to .changes/<repo>.json in monorepo *) 118 + let save ~fs ~monorepo (cf : changes_file) = 119 + ensure_changes_dir ~fs monorepo; 120 + let file_path = Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / (cf.repository ^ ".json")) in 121 match Jsont_bytesrw.encode_string ~format:Jsont.Indent changes_file_jsont cf with 122 | Ok content -> 123 Eio.Path.save ~create:(`Or_truncate 0o644) file_path content; 124 Ok () 125 + | Error e -> Error (Format.sprintf "Failed to encode %s.json: %s" cf.repository e) 126 + 127 + (* Load daily changes from .changes/<repo>-daily.json in monorepo *) 128 + let load_daily ~fs ~monorepo repo_name = 129 + let file_path = Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / (repo_name ^ "-daily.json")) in 130 + match Eio.Path.kind ~follow:true file_path with 131 + | `Regular_file -> ( 132 + let content = Eio.Path.load file_path in 133 + match Jsont_bytesrw.decode_string daily_changes_file_jsont content with 134 + | Ok cf -> Ok cf 135 + | Error e -> Error (Format.sprintf "Failed to parse %s-daily.json: %s" repo_name e)) 136 + | _ -> Ok { repository = repo_name; entries = [] } 137 + | exception Eio.Io _ -> Ok { repository = repo_name; entries = [] } 138 + 139 + (* Save daily changes to .changes/<repo>-daily.json in monorepo *) 140 + let save_daily ~fs ~monorepo (cf : daily_changes_file) = 141 + ensure_changes_dir ~fs monorepo; 142 + let file_path = Eio.Path.(fs / Fpath.to_string monorepo / ".changes" / (cf.repository ^ "-daily.json")) in 143 + match Jsont_bytesrw.encode_string ~format:Jsont.Indent daily_changes_file_jsont cf with 144 + | Ok content -> 145 + Eio.Path.save ~create:(`Or_truncate 0o644) file_path content; 146 + Ok () 147 + | Error e -> Error (Format.sprintf "Failed to encode %s-daily.json: %s" cf.repository e) 148 149 (* Markdown generation *) 150 151 + let to_markdown (cf : changes_file) = 152 let buf = Buffer.create 1024 in 153 Buffer.add_string buf (Printf.sprintf "# %s Changelog\n\n" cf.repository); 154 + List.iter (fun (entry : weekly_entry) -> 155 Buffer.add_string buf (Printf.sprintf "## Week of %s to %s\n\n" entry.week_start entry.week_end); 156 Buffer.add_string buf (Printf.sprintf "%s\n\n" entry.summary); 157 List.iter (fun change -> ··· 161 cf.entries; 162 Buffer.contents buf 163 164 + let aggregate ~history (cfs : changes_file list) = 165 (* Collect all entries from all files, tagged with repository *) 166 let all_entries = 167 + List.concat_map (fun (cf : changes_file) -> 168 + List.map (fun (e : weekly_entry) -> (cf.repository, e)) cf.entries) 169 cfs 170 in 171 (* Sort by week_start descending *) 172 + let sorted = List.sort (fun (_, (e1 : weekly_entry)) (_, (e2 : weekly_entry)) -> 173 String.compare e2.week_start e1.week_start) all_entries 174 in 175 (* Group by week *) ··· 177 | [] -> 178 if current_group <> [] then (current_week, List.rev current_group) :: acc 179 else acc 180 + | (repo, (entry : weekly_entry)) :: rest -> 181 let week_key = entry.week_start ^ " to " ^ entry.week_end in 182 if current_week = "" || current_week = week_key then 183 group_by_week acc week_key ((repo, entry) :: current_group) rest ··· 200 Buffer.add_string buf "# Changelog\n\n"; 201 List.iter (fun (week_key, entries) -> 202 Buffer.add_string buf (Printf.sprintf "## Week of %s\n\n" week_key); 203 + List.iter (fun (repo, (entry : weekly_entry)) -> 204 Buffer.add_string buf (Printf.sprintf "### %s\n" repo); 205 Buffer.add_string buf (Printf.sprintf "%s\n" entry.summary); 206 List.iter (fun change -> ··· 269 let (y, m, d), _ = Ptime.to_date_time t in 270 week_of_date (y, m, d) 271 272 + let has_week (cf : changes_file) ~week_start = 273 + List.exists (fun (e : weekly_entry) -> e.week_start = week_start) cf.entries 274 + 275 + let date_of_ptime t = 276 + let (y, m, d), _ = Ptime.to_date_time t in 277 + format_date (y, m, d) 278 + 279 + let has_day (cf : daily_changes_file) ~date = 280 + List.exists (fun (e : daily_entry) -> e.date = date) cf.entries 281 + 282 + (* Aggregate daily changes into DAILY-CHANGES.md *) 283 + let aggregate_daily ~history (cfs : daily_changes_file list) = 284 + (* Collect all entries from all files, tagged with repository *) 285 + let all_entries = 286 + List.concat_map (fun (cf : daily_changes_file) -> 287 + List.map (fun (e : daily_entry) -> (cf.repository, e)) cf.entries) 288 + cfs 289 + in 290 + (* Sort by date descending *) 291 + let sorted = List.sort (fun (_, (e1 : daily_entry)) (_, (e2 : daily_entry)) -> 292 + String.compare e2.date e1.date) all_entries 293 + in 294 + (* Group by date *) 295 + let rec group_by_date acc current_date current_group = function 296 + | [] -> 297 + if current_group <> [] then (current_date, List.rev current_group) :: acc 298 + else acc 299 + | (repo, (entry : daily_entry)) :: rest -> 300 + if current_date = "" || current_date = entry.date then 301 + group_by_date acc entry.date ((repo, entry) :: current_group) rest 302 + else 303 + group_by_date 304 + ((current_date, List.rev current_group) :: acc) 305 + entry.date 306 + [(repo, entry)] 307 + rest 308 + in 309 + let grouped = List.rev (group_by_date [] "" [] sorted) in 310 + (* Take only the requested number of days *) 311 + let limited = 312 + if history > 0 then 313 + List.filteri (fun i _ -> i < history) grouped 314 + else grouped 315 + in 316 + (* Generate markdown - only include repos with actual changes *) 317 + let buf = Buffer.create 4096 in 318 + Buffer.add_string buf "# Daily Changelog\n\n"; 319 + List.iter (fun (date, entries) -> 320 + (* Filter out entries with empty changes - these are repos with no changes *) 321 + let entries_with_changes = List.filter (fun (_, (entry : daily_entry)) -> 322 + entry.changes <> []) entries 323 + in 324 + if entries_with_changes <> [] then begin 325 + Buffer.add_string buf (Printf.sprintf "## %s\n\n" date); 326 + List.iter (fun (repo, (entry : daily_entry)) -> 327 + (* Format repo name with link if URL available *) 328 + let repo_header = match entry.repo_url with 329 + | Some url -> Printf.sprintf "[%s](%s)" repo url 330 + | None -> repo 331 + in 332 + Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_header); 333 + Buffer.add_string buf (Printf.sprintf "%s\n\n" entry.summary); 334 + List.iter (fun change -> 335 + Buffer.add_string buf (Printf.sprintf "- %s\n" change)) 336 + entry.changes; 337 + (* Add contributors if any *) 338 + if entry.contributors <> [] then begin 339 + let contributors_str = String.concat ", " entry.contributors in 340 + Buffer.add_string buf (Printf.sprintf "\n*Contributors: %s*\n" contributors_str) 341 + end; 342 + Buffer.add_string buf "\n") 343 + entries_with_changes 344 + end) 345 + limited; 346 + Buffer.contents buf 347 348 (* Claude prompt generation *) 349 350 + let generate_weekly_prompt ~repository ~week_start ~week_end commits = 351 let buf = Buffer.create 4096 in 352 Buffer.add_string buf (Printf.sprintf 353 "You are analyzing git commits for the OCaml library \"%s\".\n" repository); ··· 373 - Typo fixes in code comments 374 - Dependency bumps (unless they add features) 375 376 + 2. IMPORTANT: If there are NO user-facing changes, output a blank entry with empty 377 + summary and empty changes array. Do NOT write "no changes" or similar text. 378 + Example for no changes: {"summary": "", "changes": []} 379 380 3. Otherwise, respond in this exact JSON format: 381 { ··· 396 |}; 397 Buffer.contents buf 398 399 + let generate_daily_prompt ~repository ~date commits = 400 + let buf = Buffer.create 4096 in 401 + Buffer.add_string buf (Printf.sprintf 402 + "You are analyzing git commits for the OCaml library \"%s\".\n" repository); 403 + Buffer.add_string buf (Printf.sprintf 404 + "Generate a user-facing changelog entry for %s.\n\n" date); 405 + Buffer.add_string buf "## Commits today:\n\n"; 406 + List.iter (fun (commit : Git.log_entry) -> 407 + Buffer.add_string buf (Printf.sprintf "### %s by %s (%s)\n" 408 + (String.sub commit.hash 0 (min 7 (String.length commit.hash))) 409 + commit.author commit.date); 410 + Buffer.add_string buf (Printf.sprintf "%s\n\n" commit.subject); 411 + if commit.body <> "" then begin 412 + Buffer.add_string buf (Printf.sprintf "%s\n" commit.body) 413 + end; 414 + Buffer.add_string buf "---\n\n") 415 + commits; 416 + Buffer.add_string buf {|## Instructions: 417 + 418 + 1. Focus on USER-FACING changes only. Skip: 419 + - Internal refactoring with no API impact 420 + - CI/build system tweaks 421 + - Typo fixes in code comments 422 + - Dependency bumps (unless they add features) 423 + 424 + 2. IMPORTANT: If there are NO user-facing changes, output a blank entry with empty 425 + summary and empty changes array. Do NOT write "no changes" or similar text. 426 + Example for no changes: {"summary": "", "changes": []} 427 + 428 + 3. Otherwise, respond in this exact JSON format: 429 + { 430 + "summary": "One sentence describing the most important change", 431 + "changes": [ 432 + "First user-facing change as a bullet point", 433 + "Second change", 434 + "..." 435 + ] 436 + } 437 + 438 + 4. Write for developers using this library. Be: 439 + - Concise (max 80 chars per bullet) 440 + - Specific (mention function/module names) 441 + - Action-oriented (start with verbs: Added, Fixed, Improved, Removed) 442 + 443 + 5. Maximum 5 bullet points. Group related changes if needed. 444 + |}; 445 + Buffer.contents buf 446 + 447 + (* Backwards compatibility *) 448 + let generate_prompt = generate_weekly_prompt 449 + 450 (* Response parsing *) 451 452 type claude_response = { ··· 463 464 let parse_claude_response text = 465 let text = String.trim text in 466 + (* Legacy support for NO_CHANGES response *) 467 if text = "NO_CHANGES" then Ok None 468 else 469 match Jsont_bytesrw.decode_string claude_response_jsont text with 470 + | Ok r -> 471 + (* Treat empty summary and changes as no changes *) 472 + if r.summary = "" && r.changes = [] then Ok None 473 + else Ok (Some r) 474 | Error e -> Error (Format.sprintf "Failed to parse Claude response: %s" e) 475 476 (* Main analysis function *) ··· 547 | Some r -> r 548 | None -> Ok None 549 end 550 + 551 + (* Daily analysis function *) 552 + let analyze_commits_daily 553 + ~sw 554 + ~process_mgr 555 + ~clock 556 + ~repository 557 + ~date 558 + commits = 559 + if commits = [] then Ok None 560 + else begin 561 + let prompt = generate_daily_prompt ~repository ~date commits in 562 + 563 + (* Create Claude options with structured output *) 564 + let output_schema = 565 + let open Jsont in 566 + Object ([ 567 + (("type", Meta.none), String ("object", Meta.none)); 568 + (("properties", Meta.none), Object ([ 569 + (("summary", Meta.none), Object ([ 570 + (("type", Meta.none), String ("string", Meta.none)); 571 + ], Meta.none)); 572 + (("changes", Meta.none), Object ([ 573 + (("type", Meta.none), String ("array", Meta.none)); 574 + (("items", Meta.none), Object ([ 575 + (("type", Meta.none), String ("string", Meta.none)); 576 + ], Meta.none)); 577 + ], Meta.none)); 578 + ], Meta.none)); 579 + (("required", Meta.none), Array ([ 580 + String ("summary", Meta.none); 581 + String ("changes", Meta.none); 582 + ], Meta.none)); 583 + ], Meta.none) 584 + in 585 + let output_format = Claude.Proto.Structured_output.of_json_schema output_schema in 586 + let options = 587 + Claude.Options.default 588 + |> Claude.Options.with_output_format output_format 589 + |> Claude.Options.with_max_turns 1 590 + in 591 + 592 + let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in 593 + Claude.Client.query client prompt; 594 + 595 + let responses = Claude.Client.receive_all client in 596 + let result = ref None in 597 + List.iter (function 598 + | Claude.Response.Complete c -> ( 599 + match Claude.Response.Complete.structured_output c with 600 + | Some json -> ( 601 + match Jsont.Json.decode claude_response_jsont json with 602 + | Ok r -> 603 + (* Treat empty response as no changes *) 604 + if r.summary = "" && r.changes = [] then 605 + result := Some (Ok None) 606 + else 607 + result := Some (Ok (Some r)) 608 + | Error e -> 609 + result := Some (Error (Format.sprintf "Failed to decode response: %s" e))) 610 + | None -> 611 + (* Try to get text and parse it as fallback *) 612 + match Claude.Response.Complete.result_text c with 613 + | Some text -> result := Some (parse_claude_response text) 614 + | None -> result := Some (Ok None)) 615 + | Claude.Response.Text t -> 616 + let text = Claude.Response.Text.content t in 617 + if String.trim text = "NO_CHANGES" then 618 + result := Some (Ok None) 619 + | Claude.Response.Error e -> 620 + result := Some (Error (Printf.sprintf "Claude error: %s" (Claude.Response.Error.message e))) 621 + | _ -> ()) 622 + responses; 623 + 624 + match !result with 625 + | Some r -> r 626 + | None -> Ok None 627 + end 628 + 629 + (* Refine daily changelog markdown to be more narrative *) 630 + let refine_daily_changelog 631 + ~sw 632 + ~process_mgr 633 + ~clock 634 + markdown = 635 + let prompt = Printf.sprintf {|You are editing a daily changelog for an OCaml monorepo. 636 + 637 + Your task is to refine the following changelog to be: 638 + 1. More narrative and human-readable - write it as a daily update that developers will want to read 639 + 2. Grouped by related changes - if multiple repos have related changes, group them together 640 + 3. Succinct but complete - don't lose any information, but make it more concise 641 + 4. Well-ordered - put the most significant changes first 642 + 643 + Keep the markdown format with: 644 + - A main heading for each date 645 + - 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" 646 + - Bullet points for individual changes 647 + - Preserve all contributor attributions (format: — *Contributor Name*) 648 + - 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) 649 + - Format each bullet as: **[repo-name](url)**: Description — *Contributors* (if any) 650 + 651 + IMPORTANT: For "initial import" or "added as subtree" entries: 652 + - Put these in a dedicated "New Libraries" section 653 + - Expand the description to explain what the library does and its purpose 654 + - 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 655 + - 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" 656 + 657 + Here is the changelog to refine: 658 + 659 + %s 660 + 661 + Output ONLY the refined markdown, no explanation or preamble.|} markdown 662 + in 663 + 664 + let options = 665 + Claude.Options.default 666 + |> Claude.Options.with_max_turns 1 667 + in 668 + 669 + let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in 670 + Claude.Client.query client prompt; 671 + 672 + let responses = Claude.Client.receive_all client in 673 + let result = ref None in 674 + List.iter (function 675 + | Claude.Response.Complete c -> ( 676 + match Claude.Response.Complete.result_text c with 677 + | Some text -> result := Some (Ok text) 678 + | None -> result := Some (Ok markdown)) (* fallback to original *) 679 + | Claude.Response.Error e -> 680 + result := Some (Error (Printf.sprintf "Claude error: %s" (Claude.Response.Error.message e))) 681 + | _ -> ()) 682 + responses; 683 + 684 + match !result with 685 + | Some r -> r 686 + | None -> Ok markdown (* fallback to original *)

+107 -15

monopam/lib/changes.mli

··· 1 (** Changelog generation for monopam. 2 3 - This module handles generating weekly changelog entries using Claude AI 4 - to analyze git commit history and produce user-facing change summaries. *) 0 0 0 0 5 6 (** {1 Types} *) 7 ··· 21 } 22 (** A single week's changelog entry. *) 23 0 0 0 0 0 0 0 0 0 0 24 type changes_file = { 25 repository : string; 26 entries : weekly_entry list; 27 } 28 - (** Contents of a CHANGES.json file for a repository. *) 0 0 0 0 0 0 0 0 0 29 30 (** {1 JSON Codecs} *) 31 ··· 36 (** JSON codec for weekly entries. *) 37 38 val changes_file_jsont : changes_file Jsont.t 39 - (** JSON codec for changes files. *) 0 0 0 0 0 0 40 41 (** {1 File I/O} *) 42 43 - val load : fs:_ Eio.Path.t -> Fpath.t -> (changes_file, string) result 44 - (** [load ~fs path] loads a CHANGES.json from the given directory. 45 Returns an empty changes file if the file does not exist. *) 46 47 - val save : fs:_ Eio.Path.t -> changes_file -> Fpath.t -> (unit, string) result 48 - (** [save ~fs cf path] saves the changes file to CHANGES.json in the given directory. *) 0 0 0 0 0 0 0 49 50 (** {1 Markdown Generation} *) 51 52 val to_markdown : changes_file -> string 53 - (** [to_markdown cf] generates markdown from a single changes file. *) 54 55 val aggregate : history:int -> changes_file list -> string 56 - (** [aggregate ~history cfs] generates combined markdown from multiple changes files. 57 @param history Number of weeks to include (0 for all) *) 58 59 - (** {1 Week Calculation} *) 0 0 0 0 0 0 0 0 60 61 val week_of_date : int * int * int -> string * string 62 (** [week_of_date (year, month, day)] returns (week_start, week_end) as ISO date strings. ··· 64 65 val week_of_ptime : Ptime.t -> string * string 66 (** [week_of_ptime t] returns (week_start, week_end) for the given timestamp. *) 0 0 0 67 68 val has_week : changes_file -> week_start:string -> bool 69 (** [has_week cf ~week_start] returns true if the changes file already has an entry 70 for the week starting on the given date. *) 71 0 0 0 0 72 (** {1 Claude Integration} *) 73 74 type claude_response = { ··· 84 Git.log_entry list -> 85 string 86 (** [generate_prompt ~repository ~week_start ~week_end commits] creates the prompt 87 - to send to Claude for changelog generation. *) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 88 89 val parse_claude_response : string -> (claude_response option, string) result 90 (** [parse_claude_response text] parses Claude's response. 91 - Returns [Ok None] if the response is "NO_CHANGES". 92 - Returns [Ok (Some r)] if valid JSON was parsed. 93 Returns [Error msg] if parsing failed. *) 94 95 val analyze_commits : ··· 102 Git.log_entry list -> 103 (claude_response option, string) result 104 (** [analyze_commits ~sw ~process_mgr ~clock ~repository ~week_start ~week_end commits] 105 - sends commits to Claude for analysis and returns the parsed response. *) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 1 (** Changelog generation for monopam. 2 3 + This module handles generating weekly and daily changelog entries using Claude AI 4 + to analyze git commit history and produce user-facing change summaries. 5 + 6 + Changes are stored in a .changes directory at the monorepo root: 7 + - .changes/<repo_name>.json - weekly changelog entries 8 + - .changes/<repo_name>-daily.json - daily changelog entries *) 9 10 (** {1 Types} *) 11 ··· 25 } 26 (** A single week's changelog entry. *) 27 28 + type daily_entry = { 29 + date : string; (** ISO date YYYY-MM-DD *) 30 + summary : string; (** One-line summary *) 31 + changes : string list; (** Bullet points *) 32 + commit_range : commit_range; 33 + contributors : string list; (** List of contributors for this entry *) 34 + repo_url : string option; (** Upstream repository URL *) 35 + } 36 + (** A single day's changelog entry. *) 37 + 38 type changes_file = { 39 repository : string; 40 entries : weekly_entry list; 41 } 42 + (** Contents of a weekly changes JSON file for a repository. *) 43 + 44 + type daily_changes_file = { 45 + repository : string; 46 + entries : daily_entry list; 47 + } 48 + (** Contents of a daily changes JSON file for a repository. *) 49 + 50 + (** Mode for changelog generation. *) 51 + type mode = Weekly | Daily 52 53 (** {1 JSON Codecs} *) 54 ··· 59 (** JSON codec for weekly entries. *) 60 61 val changes_file_jsont : changes_file Jsont.t 62 + (** JSON codec for weekly changes files. *) 63 + 64 + val daily_entry_jsont : daily_entry Jsont.t 65 + (** JSON codec for daily entries. *) 66 + 67 + val daily_changes_file_jsont : daily_changes_file Jsont.t 68 + (** JSON codec for daily changes files. *) 69 70 (** {1 File I/O} *) 71 72 + val load : fs:_ Eio.Path.t -> monorepo:Fpath.t -> string -> (changes_file, string) result 73 + (** [load ~fs ~monorepo repo_name] loads weekly changes from .changes/<repo_name>.json. 74 Returns an empty changes file if the file does not exist. *) 75 76 + val save : fs:_ Eio.Path.t -> monorepo:Fpath.t -> changes_file -> (unit, string) result 77 + (** [save ~fs ~monorepo cf] saves the changes file to .changes/<repo_name>.json. *) 78 + 79 + val load_daily : fs:_ Eio.Path.t -> monorepo:Fpath.t -> string -> (daily_changes_file, string) result 80 + (** [load_daily ~fs ~monorepo repo_name] loads daily changes from .changes/<repo_name>-daily.json. 81 + Returns an empty changes file if the file does not exist. *) 82 + 83 + val save_daily : fs:_ Eio.Path.t -> monorepo:Fpath.t -> daily_changes_file -> (unit, string) result 84 + (** [save_daily ~fs ~monorepo cf] saves the changes file to .changes/<repo_name>-daily.json. *) 85 86 (** {1 Markdown Generation} *) 87 88 val to_markdown : changes_file -> string 89 + (** [to_markdown cf] generates markdown from a single weekly changes file. *) 90 91 val aggregate : history:int -> changes_file list -> string 92 + (** [aggregate ~history cfs] generates combined markdown from multiple weekly changes files. 93 @param history Number of weeks to include (0 for all) *) 94 95 + val aggregate_daily : history:int -> daily_changes_file list -> string 96 + (** [aggregate_daily ~history cfs] generates combined markdown from multiple daily changes files. 97 + Only includes repos with actual changes (filters out empty entries). 98 + @param history Number of days to include (0 for all) *) 99 + 100 + (** {1 Date Calculation} *) 101 + 102 + val format_date : int * int * int -> string 103 + (** [format_date (year, month, day)] formats a date as YYYY-MM-DD. *) 104 105 val week_of_date : int * int * int -> string * string 106 (** [week_of_date (year, month, day)] returns (week_start, week_end) as ISO date strings. ··· 108 109 val week_of_ptime : Ptime.t -> string * string 110 (** [week_of_ptime t] returns (week_start, week_end) for the given timestamp. *) 111 + 112 + val date_of_ptime : Ptime.t -> string 113 + (** [date_of_ptime t] returns the date as YYYY-MM-DD for the given timestamp. *) 114 115 val has_week : changes_file -> week_start:string -> bool 116 (** [has_week cf ~week_start] returns true if the changes file already has an entry 117 for the week starting on the given date. *) 118 119 + val has_day : daily_changes_file -> date:string -> bool 120 + (** [has_day cf ~date] returns true if the daily changes file already has an entry 121 + for the given date. *) 122 + 123 (** {1 Claude Integration} *) 124 125 type claude_response = { ··· 135 Git.log_entry list -> 136 string 137 (** [generate_prompt ~repository ~week_start ~week_end commits] creates the prompt 138 + to send to Claude for weekly changelog generation. *) 139 + 140 + val generate_weekly_prompt : 141 + repository:string -> 142 + week_start:string -> 143 + week_end:string -> 144 + Git.log_entry list -> 145 + string 146 + (** [generate_weekly_prompt ~repository ~week_start ~week_end commits] creates the prompt 147 + to send to Claude for weekly changelog generation. *) 148 + 149 + val generate_daily_prompt : 150 + repository:string -> 151 + date:string -> 152 + Git.log_entry list -> 153 + string 154 + (** [generate_daily_prompt ~repository ~date commits] creates the prompt 155 + to send to Claude for daily changelog generation. *) 156 157 val parse_claude_response : string -> (claude_response option, string) result 158 (** [parse_claude_response text] parses Claude's response. 159 + Returns [Ok None] if the response is empty (blank summary and changes) or "NO_CHANGES". 160 + Returns [Ok (Some r)] if valid JSON was parsed with actual changes. 161 Returns [Error msg] if parsing failed. *) 162 163 val analyze_commits : ··· 170 Git.log_entry list -> 171 (claude_response option, string) result 172 (** [analyze_commits ~sw ~process_mgr ~clock ~repository ~week_start ~week_end commits] 173 + sends commits to Claude for weekly analysis and returns the parsed response. *) 174 + 175 + val analyze_commits_daily : 176 + sw:Eio.Switch.t -> 177 + process_mgr:_ Eio.Process.mgr -> 178 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 179 + repository:string -> 180 + date:string -> 181 + Git.log_entry list -> 182 + (claude_response option, string) result 183 + (** [analyze_commits_daily ~sw ~process_mgr ~clock ~repository ~date commits] 184 + sends commits to Claude for daily analysis and returns the parsed response. *) 185 + 186 + val refine_daily_changelog : 187 + sw:Eio.Switch.t -> 188 + process_mgr:_ Eio.Process.mgr -> 189 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 190 + string -> 191 + (string, string) result 192 + (** [refine_daily_changelog ~sw ~process_mgr ~clock markdown] sends the raw 193 + daily changelog markdown through Claude to produce a more narrative, 194 + well-organized version. Groups related changes together and orders them 195 + by significance. Ensures all repository names are formatted as markdown 196 + links using the pattern [\[repo-name\](https://tangled.org/@anil.recoil.org/repo-name.git)]. 197 + Returns the refined markdown or the original on error. *)

+11

monopam/lib/git.ml

··· 191 in 192 run_git_ok ~proc ~cwd [ "push"; remote; branch ] |> Result.map ignore 193 0 0 0 0 0 0 0 0 0 0 0 194 type log_entry = { 195 hash : string; 196 author : string;

··· 191 in 192 run_git_ok ~proc ~cwd [ "push"; remote; branch ] |> Result.map ignore 193 194 + let set_push_url ~proc ~fs ?(remote = "origin") ~url path = 195 + let cwd = path_to_eio ~fs path in 196 + run_git_ok ~proc ~cwd [ "remote"; "set-url"; "--push"; remote; url ] 197 + |> Result.map ignore 198 + 199 + let get_push_url ~proc ~fs ?(remote = "origin") path = 200 + let cwd = path_to_eio ~fs path in 201 + match run_git_ok ~proc ~cwd [ "remote"; "get-url"; "--push"; remote ] with 202 + | Ok url -> Some url 203 + | Error _ -> None 204 + 205 type log_entry = { 206 hash : string; 207 author : string;

+24

monopam/lib/git.mli

··· 239 @param remote Remote name (default: "origin") 240 @param branch Branch to push (default: current branch) *) 241 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 242 (** {1 Commit History} *) 243 244 type log_entry = {

··· 239 @param remote Remote name (default: "origin") 240 @param branch Branch to push (default: current branch) *) 241 242 + val set_push_url : 243 + proc:_ Eio.Process.mgr -> 244 + fs:Eio.Fs.dir_ty Eio.Path.t -> 245 + ?remote:string -> 246 + url:string -> 247 + Fpath.t -> 248 + (unit, error) result 249 + (** [set_push_url ~proc ~fs ?remote ~url path] sets the push URL for a remote. 250 + This allows the fetch and push URLs to be different. 251 + 252 + @param remote Remote name (default: "origin") 253 + @param url The URL to use for pushing *) 254 + 255 + val get_push_url : 256 + proc:_ Eio.Process.mgr -> 257 + fs:Eio.Fs.dir_ty Eio.Path.t -> 258 + ?remote:string -> 259 + Fpath.t -> 260 + string option 261 + (** [get_push_url ~proc ~fs ?remote path] returns the push URL for a remote, 262 + or [None] if not set or the remote doesn't exist. 263 + 264 + @param remote Remote name (default: "origin") *) 265 + 266 (** {1 Commit History} *) 267 268 type log_entry = {

+218 -9

monopam/lib/monopam.ml

··· 410 Log.app (fun m -> m "Updated README.md with %d packages" (List.length pkgs)) 411 end 412 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 413 (* Normalize URL for comparison: extract scheme + host + path, strip trailing slashes *) 414 let normalize_url_for_comparison uri = 415 let scheme = Option.value ~default:"" (Uri.scheme uri) in ··· 769 Package.checkout_dir ~checkouts_root pkg 770 in 771 let branch = get_branch ~config pkg in 0 0 772 Log.info (fun m -> 773 - m "[%d/%d] Pushing %s to origin" i total 774 - (Package.repo_name pkg)); 0 0 0 0 0 0 775 match 776 Git.push_remote ~proc ~fs:fs_t ~branch checkout_dir 777 with 778 | Ok () -> 779 Log.app (fun m -> 780 - m " Pushed %s to origin/%s" (Package.repo_name pkg) 781 - branch); 782 push_upstream (i + 1) rest 783 | Error e -> Error (Git_error e)) 784 in ··· 848 | [] -> Ok () 849 | pkg :: rest -> 850 let repo_name = Package.repo_name pkg in 851 - let repo_path = Fpath.(monorepo / repo_name) in 852 853 Log.info (fun m -> m "Processing %s" repo_name); 854 855 - (* Load existing CHANGES.json *) 856 - match Changes.load ~fs:fs_t repo_path with 857 | Error e -> Error (Claude_error e) 858 | Ok changes_file -> 859 (* Process each week *) ··· 936 (* Save if changed and not dry run *) 937 let save_result = 938 if not dry_run && updated_cf.entries <> changes_file.entries then 939 - match Changes.save ~fs:fs_t updated_cf repo_path with 940 | Error e -> Error (Claude_error e) 941 | Ok () -> 942 - Log.app (fun m -> m "Saved CHANGES.json for %s" repo_name); 943 Ok () 944 else Ok () 945 in ··· 961 end; 962 Ok () 963 end 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 410 Log.app (fun m -> m "Updated README.md with %d packages" (List.length pkgs)) 411 end 412 413 + (** Convert a clone URL to a push URL. 414 + - GitHub HTTPS URLs are converted to SSH format 415 + - Tangled URLs (tangled.org) are converted to git.recoil.org SSH format 416 + - Other URLs are returned unchanged *) 417 + let url_to_push_url uri = 418 + let scheme = Uri.scheme uri in 419 + let host = Uri.host uri in 420 + let path = Uri.path uri in 421 + match (scheme, host) with 422 + | Some ("https" | "http"), Some "github.com" -> 423 + (* https://github.com/user/repo.git -> git@github.com:user/repo.git *) 424 + let path = if String.length path > 0 && path.[0] = '/' then 425 + String.sub path 1 (String.length path - 1) 426 + else path in 427 + Printf.sprintf "git@github.com:%s" path 428 + | Some ("https" | "http"), Some "tangled.org" -> 429 + (* https://tangled.org/anil.recoil.org/foo -> git@git.recoil.org:anil.recoil.org/foo *) 430 + let path = if String.length path > 0 && path.[0] = '/' then 431 + String.sub path 1 (String.length path - 1) 432 + else path in 433 + (* Strip .git suffix if present *) 434 + let path = if String.ends_with ~suffix:".git" path then 435 + String.sub path 0 (String.length path - 4) 436 + else path in 437 + Printf.sprintf "git@git.recoil.org:%s" path 438 + | _ -> 439 + (* Return original URL for other cases *) 440 + Uri.to_string uri 441 + 442 (* Normalize URL for comparison: extract scheme + host + path, strip trailing slashes *) 443 let normalize_url_for_comparison uri = 444 let scheme = Option.value ~default:"" (Uri.scheme uri) in ··· 798 Package.checkout_dir ~checkouts_root pkg 799 in 800 let branch = get_branch ~config pkg in 801 + (* Configure push URL (rewriting GitHub/tangled URLs to SSH) *) 802 + let push_url = url_to_push_url (Package.dev_repo pkg) in 803 Log.info (fun m -> 804 + m "[%d/%d] Pushing %s to %s" i total 805 + (Package.repo_name pkg) push_url); 806 + (* Set the push URL for origin *) 807 + (match Git.set_push_url ~proc ~fs:fs_t ~url:push_url checkout_dir with 808 + | Ok () -> () 809 + | Error e -> 810 + Log.warn (fun m -> 811 + m "Failed to set push URL: %a" Git.pp_error e)); 812 match 813 Git.push_remote ~proc ~fs:fs_t ~branch checkout_dir 814 with 815 | Ok () -> 816 Log.app (fun m -> 817 + m " Pushed %s to %s (%s)" (Package.repo_name pkg) 818 + push_url branch); 819 push_upstream (i + 1) rest 820 | Error e -> Error (Git_error e)) 821 in ··· 885 | [] -> Ok () 886 | pkg :: rest -> 887 let repo_name = Package.repo_name pkg in 0 888 889 Log.info (fun m -> m "Processing %s" repo_name); 890 891 + (* Load existing changes from .changes/<repo>.json *) 892 + match Changes.load ~fs:fs_t ~monorepo repo_name with 893 | Error e -> Error (Claude_error e) 894 | Ok changes_file -> 895 (* Process each week *) ··· 972 (* Save if changed and not dry run *) 973 let save_result = 974 if not dry_run && updated_cf.entries <> changes_file.entries then 975 + match Changes.save ~fs:fs_t ~monorepo updated_cf with 976 | Error e -> Error (Claude_error e) 977 | Ok () -> 978 + Log.app (fun m -> m "Saved .changes/%s.json" repo_name); 979 Ok () 980 else Ok () 981 in ··· 997 end; 998 Ok () 999 end 1000 + 1001 + (* Daily changes command - generate daily changelogs using Claude *) 1002 + 1003 + let changes_daily ~proc ~fs ~config ~clock ?package ?(days = 1) ?(history = 30) ?(dry_run = false) () = 1004 + let fs_t = fs_typed fs in 1005 + let monorepo = Config.Paths.monorepo config in 1006 + 1007 + (* Get current time *) 1008 + let now = Eio.Time.now clock in 1009 + let now_ptime = match Ptime.of_float_s now with 1010 + | Some t -> t 1011 + | None -> Ptime.v (0, 0L) (* fallback to epoch *) 1012 + in 1013 + 1014 + match discover_packages ~fs:(fs_t :> _ Eio.Path.t) ~config () with 1015 + | Error e -> Error e 1016 + | Ok all_pkgs -> 1017 + let repos = unique_repos all_pkgs in 1018 + let repos = match package with 1019 + | None -> repos 1020 + | Some name -> List.filter (fun p -> Package.repo_name p = name) repos 1021 + in 1022 + if repos = [] && package <> None then 1023 + Error (Package_not_found (Option.get package)) 1024 + else begin 1025 + Log.info (fun m -> m "Processing daily changelogs for %d repositories" (List.length repos)); 1026 + 1027 + (* Process each repository *) 1028 + let all_changes_files = ref [] in 1029 + let rec process_repos = function 1030 + | [] -> Ok () 1031 + | pkg :: rest -> 1032 + let repo_name = Package.repo_name pkg in 1033 + 1034 + Log.info (fun m -> m "Processing %s" repo_name); 1035 + 1036 + (* Load existing daily changes from .changes/<repo>-daily.json *) 1037 + match Changes.load_daily ~fs:fs_t ~monorepo repo_name with 1038 + | Error e -> Error (Claude_error e) 1039 + | Ok changes_file -> 1040 + (* Process each day *) 1041 + let rec process_days day_offset updated_cf = 1042 + if day_offset >= days then Ok updated_cf 1043 + else begin 1044 + (* Calculate day boundaries *) 1045 + let offset_seconds = float_of_int (day_offset * 24 * 60 * 60) in 1046 + let day_time = match Ptime.of_float_s (now -. offset_seconds) with 1047 + | Some t -> t 1048 + | None -> now_ptime 1049 + in 1050 + let date = Changes.date_of_ptime day_time in 1051 + 1052 + (* Skip if day already has an entry *) 1053 + if Changes.has_day updated_cf ~date then begin 1054 + Log.info (fun m -> m " Day %s already has entry, skipping" date); 1055 + process_days (day_offset + 1) updated_cf 1056 + end 1057 + else begin 1058 + (* Get commits for this day *) 1059 + let since = date ^ " 00:00:00" in 1060 + let until = date ^ " 23:59:59" in 1061 + match Git.log ~proc ~fs:fs_t ~since ~until ~path:repo_name monorepo with 1062 + | Error e -> Error (Git_error e) 1063 + | Ok commits -> 1064 + if commits = [] then begin 1065 + Log.info (fun m -> m " No commits for day %s" date); 1066 + process_days (day_offset + 1) updated_cf 1067 + end 1068 + else begin 1069 + Log.info (fun m -> m " Found %d commits for day %s" (List.length commits) date); 1070 + 1071 + if dry_run then begin 1072 + Log.app (fun m -> m " [DRY RUN] Would analyze %d commits for %s on %s" 1073 + (List.length commits) repo_name date); 1074 + process_days (day_offset + 1) updated_cf 1075 + end 1076 + else begin 1077 + (* Analyze commits with Claude *) 1078 + Eio.Switch.run @@ fun sw -> 1079 + match Changes.analyze_commits_daily ~sw ~process_mgr:proc ~clock 1080 + ~repository:repo_name ~date commits with 1081 + | Error e -> Error (Claude_error e) 1082 + | Ok None -> 1083 + Log.info (fun m -> m " No user-facing changes for day %s" date); 1084 + process_days (day_offset + 1) updated_cf 1085 + | Ok (Some response) -> 1086 + Log.app (fun m -> m " Generated changelog for %s on %s" repo_name date); 1087 + (* Extract unique contributors from commits *) 1088 + let contributors = 1089 + commits 1090 + |> List.map (fun (c : Git.log_entry) -> c.author) 1091 + |> List.sort_uniq String.compare 1092 + in 1093 + (* Get repo URL from package dev_repo *) 1094 + let repo_url = 1095 + let uri = Package.dev_repo pkg in 1096 + let url = Uri.to_string uri in 1097 + (* Strip git+ prefix if present for display *) 1098 + if String.starts_with ~prefix:"git+" url then 1099 + Some (String.sub url 4 (String.length url - 4)) 1100 + else 1101 + Some url 1102 + in 1103 + (* Create new entry *) 1104 + let first_hash = (List.hd commits).Git.hash in 1105 + let last_hash = (List.hd (List.rev commits)).Git.hash in 1106 + let entry : Changes.daily_entry = { 1107 + date; 1108 + summary = response.Changes.summary; 1109 + changes = response.Changes.changes; 1110 + commit_range = { 1111 + from_hash = String.sub first_hash 0 (min 7 (String.length first_hash)); 1112 + to_hash = String.sub last_hash 0 (min 7 (String.length last_hash)); 1113 + count = List.length commits; 1114 + }; 1115 + contributors; 1116 + repo_url; 1117 + } in 1118 + (* Add entry (sorted by date descending) *) 1119 + let new_entries = 1120 + entry :: updated_cf.Changes.entries 1121 + |> List.sort (fun e1 e2 -> 1122 + String.compare e2.Changes.date e1.Changes.date) 1123 + in 1124 + process_days (day_offset + 1) 1125 + { updated_cf with entries = new_entries } 1126 + end 1127 + end 1128 + end 1129 + end 1130 + in 1131 + match process_days 0 changes_file with 1132 + | Error e -> Error e 1133 + | Ok updated_cf -> 1134 + (* Save if changed and not dry run *) 1135 + let save_result = 1136 + if not dry_run && updated_cf.entries <> changes_file.entries then 1137 + match Changes.save_daily ~fs:fs_t ~monorepo updated_cf with 1138 + | Error e -> Error (Claude_error e) 1139 + | Ok () -> 1140 + Log.app (fun m -> m "Saved .changes/%s-daily.json" repo_name); 1141 + Ok () 1142 + else Ok () 1143 + in 1144 + match save_result with 1145 + | Error e -> Error e 1146 + | Ok () -> 1147 + all_changes_files := updated_cf :: !all_changes_files; 1148 + process_repos rest 1149 + in 1150 + match process_repos repos with 1151 + | Error e -> Error e 1152 + | Ok () -> 1153 + (* Generate aggregated DAILY-CHANGES.md *) 1154 + if not dry_run && !all_changes_files <> [] then begin 1155 + let raw_markdown = Changes.aggregate_daily ~history !all_changes_files in 1156 + (* Refine the markdown through Claude for better narrative *) 1157 + Log.info (fun m -> m "Refining daily changelog with Claude..."); 1158 + let markdown = Eio.Switch.run @@ fun sw -> 1159 + match Changes.refine_daily_changelog ~sw ~process_mgr:proc ~clock raw_markdown with 1160 + | Ok refined -> 1161 + Log.app (fun m -> m "Refined daily changelog for readability"); 1162 + refined 1163 + | Error e -> 1164 + Log.warn (fun m -> m "Failed to refine changelog: %s (using raw version)" e); 1165 + raw_markdown 1166 + in 1167 + let changes_md_path = Eio.Path.(fs_t / Fpath.to_string monorepo / "DAILY-CHANGES.md") in 1168 + Eio.Path.save ~create:(`Or_truncate 0o644) changes_md_path markdown; 1169 + Log.app (fun m -> m "Generated DAILY-CHANGES.md at monorepo root") 1170 + end; 1171 + Ok () 1172 + end

+34 -2

monopam/lib/monopam.mli

··· 183 generates weekly changelog entries using Claude AI. 184 185 For each repository (or the specified package's repository): 186 - 1. Loads or creates CHANGES.json 187 2. For each week that doesn't have an entry, retrieves git commits 188 3. Sends commits to Claude for analysis 189 - 4. Saves changelog entries back to CHANGES.json 190 191 Also generates an aggregated CHANGES.md at the monorepo root. 192 ··· 198 @param weeks Number of past weeks to analyze (default: 1) 199 @param history Number of recent weeks to include in CHANGES.md (default: 12) 200 @param dry_run If true, preview changes without writing files *) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

··· 183 generates weekly changelog entries using Claude AI. 184 185 For each repository (or the specified package's repository): 186 + 1. Loads or creates .changes/<repo>.json 187 2. For each week that doesn't have an entry, retrieves git commits 188 3. Sends commits to Claude for analysis 189 + 4. Saves changelog entries back to .changes/<repo>.json 190 191 Also generates an aggregated CHANGES.md at the monorepo root. 192 ··· 198 @param weeks Number of past weeks to analyze (default: 1) 199 @param history Number of recent weeks to include in CHANGES.md (default: 12) 200 @param dry_run If true, preview changes without writing files *) 201 + 202 + val changes_daily : 203 + proc:_ Eio.Process.mgr -> 204 + fs:Eio.Fs.dir_ty Eio.Path.t -> 205 + config:Config.t -> 206 + clock:float Eio.Time.clock_ty Eio.Resource.t -> 207 + ?package:string -> 208 + ?days:int -> 209 + ?history:int -> 210 + ?dry_run:bool -> 211 + unit -> 212 + (unit, error) result 213 + (** [changes_daily ~proc ~fs ~config ~clock ?package ?days ?history ?dry_run ()] 214 + generates daily changelog entries using Claude AI. 215 + 216 + For each repository (or the specified package's repository): 217 + 1. Loads or creates .changes/<repo>-daily.json 218 + 2. For each day that doesn't have an entry, retrieves git commits 219 + 3. Sends commits to Claude for analysis 220 + 4. Saves changelog entries back to .changes/<repo>-daily.json 221 + 222 + Also generates an aggregated DAILY-CHANGES.md at the monorepo root. 223 + Repositories with no user-facing changes will have blank entries. 224 + 225 + @param proc Eio process manager 226 + @param fs Eio filesystem 227 + @param config Monopam configuration 228 + @param clock Eio clock for time operations 229 + @param package Optional specific repository to process 230 + @param days Number of past days to analyze (default: 1) 231 + @param history Number of recent days to include in DAILY-CHANGES.md (default: 30) 232 + @param dry_run If true, preview changes without writing files *)