+39 -13

monopam/bin/main.ml

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

+375 -34

monopam/lib/changes.ml

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

+107 -15

monopam/lib/changes.mli

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

+11

monopam/lib/git.ml

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

+24

monopam/lib/git.mli

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

+218 -9

monopam/lib/monopam.ml

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

+34 -2

monopam/lib/monopam.mli

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