Improve monopam sync and doctor commands · jon.recoil.org/monopam@ecdba6a

+367 -191

lib/doctor.ml

··· 337 337 338 338 (** {1 Claude Analysis} *) 339 339 340 - (** JSON type for Claude's response about commits *) 341 - type claude_commit_response = { 342 - category : string; 343 - cr_priority : string; 344 - cr_recommendation : string; 345 - cr_conflict_risk : string; 346 - cr_summary : string; 340 + (** Information about a single remote's status *) 341 + type remote_status = { 342 + remote_name : string; 343 + url : string; 344 + ahead : int; [@warning "-69"] (** Commits we have that remote doesn't *) 345 + behind : int; (** Commits remote has that we don't *) 346 + incoming_commits : Git.log_entry list; (** Commits from remote we don't have *) 347 347 } 348 348 349 - let claude_commit_response_jsont = 350 - let make category cr_priority cr_recommendation cr_conflict_risk cr_summary = 351 - { category; cr_priority; cr_recommendation; cr_conflict_risk; cr_summary } 349 + (** Analyze a single remote for a checkout *) 350 + let analyze_remote ~proc ~fs ~checkout_dir ~remote_name = 351 + let url = match Git.get_remote_url ~proc ~fs ~remote:remote_name checkout_dir with 352 + | Some u -> u 353 + | None -> "(unknown)" 354 + in 355 + (* Try to get ahead/behind for this remote *) 356 + let (ahead, behind) = match Git.ahead_behind ~proc ~fs ~remote:remote_name checkout_dir with 357 + | Ok ab -> (ab.ahead, ab.behind) 358 + | Error _ -> (0, 0) 352 359 in 353 - Jsont.Object.map ~kind:"claude_commit_response" make 354 - |> Jsont.Object.mem "category" Jsont.string ~enc:(fun c -> c.category) 355 - |> Jsont.Object.mem "priority" Jsont.string ~enc:(fun c -> c.cr_priority) 356 - |> Jsont.Object.mem "recommendation" Jsont.string ~enc:(fun c -> c.cr_recommendation) 357 - |> Jsont.Object.mem "conflict_risk" Jsont.string ~enc:(fun c -> c.cr_conflict_risk) 358 - |> Jsont.Object.mem "summary" Jsont.string ~enc:(fun c -> c.cr_summary) 359 - |> Jsont.Object.finish 360 + (* Get commits from remote that we don't have *) 361 + let incoming_commits = 362 + if behind > 0 then 363 + let tip = Printf.sprintf "%s/main" remote_name in 364 + match Git.log_range ~proc ~fs ~base:"HEAD" ~tip ~max_count:20 checkout_dir with 365 + | Ok commits -> commits 366 + | Error _ -> 367 + (* Try with master branch *) 368 + (match Git.log_range ~proc ~fs ~base:"HEAD" ~tip:(Printf.sprintf "%s/master" remote_name) 369 + ~max_count:20 checkout_dir with 370 + | Ok commits -> commits 371 + | Error _ -> []) 372 + else [] 373 + in 374 + { remote_name; url; ahead; behind; incoming_commits } 360 375 361 - (** Analyze commits using Claude *) 362 - let analyze_verse_commits 363 - ~sw ~process_mgr ~clock 364 - ~repo_name ~handle 365 - (commits : Git.log_entry list) = 366 - if commits = [] then { handle; commits = []; suggested_action = None } 367 - else begin 368 - let prompt = Buffer.create 2048 in 369 - Buffer.add_string prompt (Printf.sprintf 370 - "You are analyzing git commits from a verse collaborator's repository.\n\n"); 371 - Buffer.add_string prompt (Printf.sprintf 372 - "Repository: %s\nCollaborator: %s\n\n" repo_name handle); 373 - Buffer.add_string prompt "Commits to analyze:\n\n"; 374 - List.iter (fun (c : Git.log_entry) -> 375 - Buffer.add_string prompt (Printf.sprintf "### %s by %s (%s)\n%s\n\n%s\n---\n\n" 376 - (String.sub c.hash 0 (min 7 (String.length c.hash))) 377 - c.author c.date c.subject c.body)) 378 - commits; 379 - Buffer.add_string prompt {| 380 - For each commit, provide JSON analysis: 381 - - category: security-fix, bug-fix, feature, refactor, docs, test, other 382 - - priority: critical (security issues), high (important fixes), medium (nice to have), low (minor) 383 - - recommendation: merge-now, review-first, skip, needs-discussion 384 - - conflict_risk: none, low, medium, high 385 - - summary: one-line description of what the commit does (max 80 chars) 376 + (** Analyze all remotes for a checkout *) 377 + let analyze_checkout_remotes ~proc ~fs ~checkout_dir = 378 + let remotes = Git.list_remotes ~proc ~fs checkout_dir in 379 + List.map (fun remote_name -> 380 + analyze_remote ~proc ~fs ~checkout_dir ~remote_name) 381 + remotes 382 + 383 + (** Build status summary for prompt *) 384 + let build_status_summary statuses = 385 + let buf = Buffer.create 4096 in 386 + Buffer.add_string buf "## Current Monorepo Status\n\n"; 387 + List.iter (fun (status : Status.t) -> 388 + let name = Package.repo_name status.package in 389 + let local_str = match status.subtree_sync with 390 + | Status.In_sync -> "local:=" 391 + | Status.Subtree_behind n -> Printf.sprintf "local:-%d" n 392 + | Status.Subtree_ahead n -> Printf.sprintf "local:+%d" n 393 + | Status.Trees_differ -> "local:sync" 394 + | Status.Unknown -> "local:?" 395 + in 396 + let remote_str = match status.checkout with 397 + | Status.Clean ab -> 398 + if ab.ahead > 0 && ab.behind > 0 then 399 + Printf.sprintf "remote:+%d/-%d" ab.ahead ab.behind 400 + else if ab.ahead > 0 then 401 + Printf.sprintf "remote:+%d" ab.ahead 402 + else if ab.behind > 0 then 403 + Printf.sprintf "remote:-%d" ab.behind 404 + else "remote:=" 405 + | Status.Dirty -> "remote:dirty" 406 + | Status.Missing -> "remote:missing" 407 + | Status.Not_a_repo -> "remote:not-repo" 408 + in 409 + Buffer.add_string buf (Printf.sprintf "- %s: %s %s\n" name local_str remote_str)) 410 + statuses; 411 + Buffer.contents buf 412 + 413 + (** Build incoming commits summary for prompt *) 414 + let build_incoming_summary remotes_by_repo = 415 + let buf = Buffer.create 8192 in 416 + Buffer.add_string buf "\n## Incoming Commits from Remotes\n\n"; 417 + List.iter (fun (repo_name, remotes) -> 418 + let has_incoming = List.exists (fun r -> r.behind > 0) remotes in 419 + if has_incoming then begin 420 + Buffer.add_string buf (Printf.sprintf "### %s\n\n" repo_name); 421 + List.iter (fun r -> 422 + if r.behind > 0 then begin 423 + Buffer.add_string buf (Printf.sprintf "**%s** (%s) - %d commits behind:\n" 424 + r.remote_name r.url r.behind); 425 + List.iter (fun (c : Git.log_entry) -> 426 + let short_hash = String.sub c.hash 0 (min 7 (String.length c.hash)) in 427 + Buffer.add_string buf (Printf.sprintf " - %s %s (%s)\n" 428 + short_hash c.subject c.author)) 429 + r.incoming_commits; 430 + Buffer.add_string buf "\n" 431 + end) 432 + remotes 433 + end) 434 + remotes_by_repo; 435 + Buffer.contents buf 436 + 437 + (** Analyze all incoming commits using Claude *) 438 + let analyze_with_claude ~sw ~process_mgr ~clock ~status_summary ~incoming_summary = 439 + let prompt = Buffer.create 16384 in 440 + Buffer.add_string prompt {|You are analyzing a monorepo workspace to provide actionable recommendations. 441 + 442 + |}; 443 + Buffer.add_string prompt status_summary; 444 + Buffer.add_string prompt incoming_summary; 445 + Buffer.add_string prompt {| 446 + 447 + ## Instructions 448 + 449 + Analyze the workspace state and incoming commits. For each repository with incoming commits, 450 + categorize what the changes represent and provide recommendations. 386 451 387 - Respond with a JSON array of analyses, one per commit in order. 452 + Respond with JSON containing: 453 + - repos: array of repo analyses, each with: 454 + - name: repository name 455 + - verse_analyses: array of analyses per remote with incoming commits: 456 + - handle: remote name 457 + - commits: array of commit analyses: 458 + - hash: short hash 459 + - subject: commit subject 460 + - author: author name 461 + - date: commit date 462 + - category: security-fix, bug-fix, feature, refactor, docs, test, other 463 + - priority: critical, high, medium, low 464 + - recommendation: merge-now, review-first, skip, needs-discussion 465 + - conflict_risk: none, low, medium, high 466 + - summary: one-line description (max 80 chars) 467 + - suggested_action: optional command to handle these commits 468 + - recommendations: array of prioritized actions: 469 + - priority: critical, high, medium, low 470 + - action: description of what to do 471 + - command: optional command to run 472 + - warnings: array of warning strings for any issues detected 388 473 |}; 389 474 390 - (* Create schema for array of responses *) 391 - let output_schema = 392 - let open Jsont in 393 - Object ([ 394 - (("type", Meta.none), String ("array", Meta.none)); 395 - (("items", Meta.none), Object ([ 396 - (("type", Meta.none), String ("object", Meta.none)); 397 - (("properties", Meta.none), Object ([ 398 - (("category", Meta.none), Object ([ 399 - (("type", Meta.none), String ("string", Meta.none)); 400 - ], Meta.none)); 401 - (("priority", Meta.none), Object ([ 402 - (("type", Meta.none), String ("string", Meta.none)); 403 - ], Meta.none)); 404 - (("recommendation", Meta.none), Object ([ 405 - (("type", Meta.none), String ("string", Meta.none)); 406 - ], Meta.none)); 407 - (("conflict_risk", Meta.none), Object ([ 408 - (("type", Meta.none), String ("string", Meta.none)); 409 - ], Meta.none)); 410 - (("summary", Meta.none), Object ([ 411 - (("type", Meta.none), String ("string", Meta.none)); 412 - ], Meta.none)); 413 - ], Meta.none)); 414 - (("required", Meta.none), Array ([ 415 - String ("category", Meta.none); 416 - String ("priority", Meta.none); 417 - String ("recommendation", Meta.none); 418 - String ("conflict_risk", Meta.none); 419 - String ("summary", Meta.none); 420 - ], Meta.none)); 475 + let output_schema = 476 + let open Jsont in 477 + let commit_schema = Object ([ 478 + (("type", Meta.none), String ("object", Meta.none)); 479 + (("properties", Meta.none), Object ([ 480 + (("hash", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 481 + (("subject", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 482 + (("author", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 483 + (("date", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 484 + (("category", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 485 + (("priority", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 486 + (("recommendation", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 487 + (("conflict_risk", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 488 + (("summary", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 489 + ], Meta.none)); 490 + ], Meta.none) 491 + in 492 + let verse_schema = Object ([ 493 + (("type", Meta.none), String ("object", Meta.none)); 494 + (("properties", Meta.none), Object ([ 495 + (("handle", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 496 + (("commits", Meta.none), Object ([ 497 + (("type", Meta.none), String ("array", Meta.none)); 498 + (("items", Meta.none), commit_schema); 499 + ], Meta.none)); 500 + (("suggested_action", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 501 + ], Meta.none)); 502 + ], Meta.none) 503 + in 504 + let repo_schema = Object ([ 505 + (("type", Meta.none), String ("object", Meta.none)); 506 + (("properties", Meta.none), Object ([ 507 + (("name", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 508 + (("verse_analyses", Meta.none), Object ([ 509 + (("type", Meta.none), String ("array", Meta.none)); 510 + (("items", Meta.none), verse_schema); 421 511 ], Meta.none)); 422 - ], Meta.none) 512 + ], Meta.none)); 513 + ], Meta.none) 423 514 in 424 - let output_format = Claude.Proto.Structured_output.of_json_schema output_schema in 425 - let options = 426 - Claude.Options.default 427 - |> Claude.Options.with_output_format output_format 428 - |> Claude.Options.with_max_turns 1 515 + let action_schema = Object ([ 516 + (("type", Meta.none), String ("object", Meta.none)); 517 + (("properties", Meta.none), Object ([ 518 + (("priority", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 519 + (("action", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 520 + (("command", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 521 + ], Meta.none)); 522 + ], Meta.none) 429 523 in 524 + Object ([ 525 + (("type", Meta.none), String ("object", Meta.none)); 526 + (("properties", Meta.none), Object ([ 527 + (("repos", Meta.none), Object ([ 528 + (("type", Meta.none), String ("array", Meta.none)); 529 + (("items", Meta.none), repo_schema); 530 + ], Meta.none)); 531 + (("recommendations", Meta.none), Object ([ 532 + (("type", Meta.none), String ("array", Meta.none)); 533 + (("items", Meta.none), action_schema); 534 + ], Meta.none)); 535 + (("warnings", Meta.none), Object ([ 536 + (("type", Meta.none), String ("array", Meta.none)); 537 + (("items", Meta.none), Object ([(("type", Meta.none), String ("string", Meta.none))], Meta.none)); 538 + ], Meta.none)); 539 + ], Meta.none)); 540 + (("required", Meta.none), Array ([ 541 + String ("repos", Meta.none); 542 + String ("recommendations", Meta.none); 543 + String ("warnings", Meta.none); 544 + ], Meta.none)); 545 + ], Meta.none) 546 + in 547 + let output_format = Claude.Proto.Structured_output.of_json_schema output_schema in 548 + let options = 549 + Claude.Options.default 550 + |> Claude.Options.with_output_format output_format 551 + |> Claude.Options.with_max_turns 1 552 + in 430 553 431 - let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in 432 - Claude.Client.query client (Buffer.contents prompt); 554 + let client = Claude.Client.create ~sw ~process_mgr ~clock ~options () in 555 + Claude.Client.query client (Buffer.contents prompt); 433 556 434 - let responses = Claude.Client.receive_all client in 435 - let analyses = ref [] in 557 + let responses = Claude.Client.receive_all client in 436 558 437 - List.iter (function 438 - | Claude.Response.Complete c -> ( 439 - match Claude.Response.Complete.structured_output c with 440 - | Some json -> ( 441 - match Jsont.Json.decode (Jsont.list claude_commit_response_jsont) json with 442 - | Ok resps -> 443 - let commit_analyses = List.map2 (fun (commit : Git.log_entry) (resp : claude_commit_response) -> 444 - { hash = String.sub commit.hash 0 (min 7 (String.length commit.hash)); 445 - subject = commit.subject; 446 - author = commit.author; 447 - date = commit.date; 448 - category = change_category_of_string resp.category; 449 - priority = priority_of_string resp.cr_priority; 450 - recommendation = recommendation_of_string resp.cr_recommendation; 451 - conflict_risk = conflict_risk_of_string resp.cr_conflict_risk; 452 - commit_summary = resp.cr_summary; 453 - }) 454 - commits resps 455 - in 456 - analyses := commit_analyses 457 - | Error e -> 458 - Log.warn (fun m -> m "Failed to decode Claude response: %s" e)) 459 - | None -> 460 - Log.warn (fun m -> m "No structured output from Claude")) 461 - | Claude.Response.Error e -> 462 - Log.warn (fun m -> m "Claude error: %s" (Claude.Response.Error.message e)) 463 - | _ -> ()) 464 - responses; 559 + (* Parse response into our types *) 560 + let result = ref None in 561 + List.iter (function 562 + | Claude.Response.Complete c -> ( 563 + match Claude.Response.Complete.structured_output c with 564 + | Some json -> 565 + (* Parse the JSON manually since we have a complex nested structure *) 566 + result := Some json 567 + | None -> 568 + Log.warn (fun m -> m "No structured output from Claude")) 569 + | Claude.Response.Error e -> 570 + Log.warn (fun m -> m "Claude error: %s" (Claude.Response.Error.message e)) 571 + | _ -> ()) 572 + responses; 573 + 574 + !result 465 575 466 - let commit_analyses = !analyses in 576 + (** Parse Claude's JSON response into our types *) 577 + let parse_claude_response json = 578 + let repos = ref [] in 579 + let recommendations = ref [] in 580 + let warnings = ref [] in 467 581 468 - (* Generate suggested action if there are high-priority items *) 469 - let high_priority = List.filter (fun (c : commit_analysis) -> 470 - c.priority = Critical || c.priority = High) 471 - commit_analyses 472 - in 473 - let suggested_action = 474 - if high_priority <> [] then 475 - let first = List.hd high_priority in 476 - Some (Printf.sprintf "git fetch verse-%s && git cherry-pick %s" 477 - handle first.hash) 478 - else None 479 - in 582 + (* Jsont objects use (name * meta, value) pairs where name is (string * meta) *) 583 + let find_member key obj = 584 + List.find_map (fun ((k, _meta), v) -> if k = key then Some v else None) obj 585 + in 586 + let get_string_opt obj key = 587 + match find_member key obj with 588 + | Some (Jsont.String (s, _)) -> Some s 589 + | _ -> None 590 + in 591 + let get_string obj key default = 592 + Option.value ~default (get_string_opt obj key) 593 + in 594 + let get_array obj key = 595 + match find_member key obj with 596 + | Some (Jsont.Array (arr, _)) -> arr 597 + | _ -> [] 598 + in 599 + 600 + (match json with 601 + | Jsont.Object (obj, _) -> 602 + (* Parse repos *) 603 + List.iter (fun repo_json -> 604 + match repo_json with 605 + | Jsont.Object (repo_obj, _) -> 606 + let name = get_string repo_obj "name" "" in 607 + let verse_analyses = List.filter_map (fun va_json -> 608 + match va_json with 609 + | Jsont.Object (va_obj, _) -> 610 + let handle = get_string va_obj "handle" "" in 611 + let commits = List.filter_map (fun c_json -> 612 + match c_json with 613 + | Jsont.Object (c_obj, _) -> 614 + Some { 615 + hash = get_string c_obj "hash" ""; 616 + subject = get_string c_obj "subject" ""; 617 + author = get_string c_obj "author" ""; 618 + date = get_string c_obj "date" ""; 619 + category = change_category_of_string (get_string c_obj "category" "other"); 620 + priority = priority_of_string (get_string c_obj "priority" "low"); 621 + recommendation = recommendation_of_string (get_string c_obj "recommendation" "review-first"); 622 + conflict_risk = conflict_risk_of_string (get_string c_obj "conflict_risk" "low"); 623 + commit_summary = get_string c_obj "summary" ""; 624 + } 625 + | _ -> None) 626 + (get_array va_obj "commits") 627 + in 628 + let suggested_action = get_string_opt va_obj "suggested_action" in 629 + Some { handle; commits; suggested_action } 630 + | _ -> None) 631 + (get_array repo_obj "verse_analyses") 632 + in 633 + if verse_analyses <> [] then 634 + repos := { name; local_sync = `In_sync; remote_ahead = 0; remote_behind = 0; verse_analyses } :: !repos 635 + | _ -> ()) 636 + (get_array obj "repos"); 637 + 638 + (* Parse recommendations *) 639 + List.iter (fun rec_json -> 640 + match rec_json with 641 + | Jsont.Object (rec_obj, _) -> 642 + let action_priority = priority_of_string (get_string rec_obj "priority" "low") in 643 + let description = get_string rec_obj "action" "" in 644 + let command = get_string_opt rec_obj "command" in 645 + recommendations := { action_priority; description; command } :: !recommendations 646 + | _ -> ()) 647 + (get_array obj "recommendations"); 648 + 649 + (* Parse warnings *) 650 + List.iter (fun w_json -> 651 + match w_json with 652 + | Jsont.String (s, _) -> warnings := s :: !warnings 653 + | _ -> ()) 654 + (get_array obj "warnings") 655 + | _ -> ()); 480 656 481 - { handle; commits = commit_analyses; suggested_action } 482 - end 657 + (List.rev !repos, List.rev !recommendations, List.rev !warnings) 483 658 484 659 (** {1 Main Analysis} *) 485 660 ··· 496 671 let workspace = Fpath.to_string (Verse_config.root verse_config) in 497 672 498 673 (* Get status for all packages *) 499 - let statuses = match Status.compute_all ~proc ~fs ~config 500 - (match Opam_repo.scan ~fs:(fs :> _ Eio.Path.t) (Config.Paths.opam_repo config) with 501 - | Ok pkgs -> pkgs 502 - | Error _ -> []) 503 - with 504 - | statuses -> statuses 674 + let packages = match Opam_repo.scan ~fs:(fs :> _ Eio.Path.t) (Config.Paths.opam_repo config) with 675 + | Ok pkgs -> pkgs 676 + | Error _ -> [] 505 677 in 678 + let statuses = Status.compute_all ~proc ~fs ~config packages in 506 679 507 680 (* Filter by package if specified *) 508 681 let statuses = match package with 509 682 | None -> statuses 510 683 | Some name -> List.filter (fun (s : Status.t) -> Package.name s.package = name) statuses 511 684 in 512 - 513 - (* Compute fork analysis *) 514 - let forks = Forks.compute ~proc ~fs:(fs :> Eio.Fs.dir_ty Eio.Path.t) ~verse_config ~monopam_config:config () in 515 685 516 686 (* Build warnings list *) 517 687 let warnings = ref [] in ··· 526 696 if Git.is_dirty ~proc ~fs monorepo then 527 697 warnings := "monorepo has uncommitted changes" :: !warnings; 528 698 529 - (* Build repo sync info *) 530 - let repos = List.map (fun (status : Status.t) -> 699 + (* Analyze all remotes for each checkout *) 700 + Log.app (fun m -> m "Analyzing remotes for %d repositories..." (List.length statuses)); 701 + let checkouts_root = Config.Paths.checkouts config in 702 + let remotes_by_repo = List.filter_map (fun (status : Status.t) -> 703 + let name = Package.repo_name status.package in 704 + let checkout_dir = Fpath.(checkouts_root / name) in 705 + match status.checkout with 706 + | Status.Missing | Status.Not_a_repo -> None 707 + | _ -> 708 + let remotes = analyze_checkout_remotes ~proc ~fs ~checkout_dir in 709 + Some (name, remotes)) 710 + statuses 711 + in 712 + 713 + (* Count repos with incoming changes *) 714 + let repos_with_incoming = List.filter (fun (_name, remotes) -> 715 + List.exists (fun r -> r.behind > 0) remotes) 716 + remotes_by_repo 717 + in 718 + 719 + (* Build repo sync info from status *) 720 + let base_repos = List.map (fun (status : Status.t) -> 531 721 let name = Package.repo_name status.package in 532 722 let local_sync = match status.subtree_sync with 533 723 | Status.In_sync -> `In_sync ··· 540 730 | Status.Clean ab -> (ab.ahead, ab.behind) 541 731 | _ -> (0, 0) 542 732 in 733 + { name; local_sync; remote_ahead; remote_behind; verse_analyses = [] }) 734 + statuses 735 + in 543 736 544 - (* Get verse analyses for this repo *) 545 - let verse_analyses = 546 - match List.find_opt (fun (a : Forks.repo_analysis) -> a.repo_name = name) forks.repos with 547 - | None -> [] 548 - | Some analysis -> 549 - (* For each verse source where we're behind, analyze their commits *) 550 - List.filter_map (fun (handle, _src, rel) -> 551 - match rel with 552 - | Forks.I_am_behind _count -> 553 - (* Get commits from their branch that we don't have *) 554 - let checkouts_root = Config.Paths.checkouts config in 555 - let checkout_dir = Fpath.(checkouts_root / name) in 556 - let remote_ref = Printf.sprintf "verse-%s/main" handle in 557 - let base_ref = "origin/main" in 558 - (match Git.log ~proc ~fs ~since:(Printf.sprintf "%s.." base_ref) 559 - ~until:remote_ref checkout_dir with 560 - | Ok commits when commits <> [] -> 561 - let analysis = Eio.Switch.run @@ fun sw -> 562 - analyze_verse_commits ~sw ~process_mgr:proc ~clock 563 - ~repo_name:name ~handle commits 564 - in 565 - Some analysis 566 - | _ -> None) 567 - | Forks.Diverged _ -> 568 - (* Could also analyze diverged commits but skip for now *) 569 - None 570 - | _ -> None) 571 - analysis.verse_sources 572 - in 737 + (* If there are repos with incoming changes, analyze with Claude *) 738 + let (repos, claude_recommendations, claude_warnings) = 739 + if repos_with_incoming <> [] then begin 740 + Log.app (fun m -> m "Found %d repos with incoming changes, analyzing with Claude..." 741 + (List.length repos_with_incoming)); 742 + let status_summary = build_status_summary statuses in 743 + let incoming_summary = build_incoming_summary remotes_by_repo in 573 744 574 - { name; local_sync; remote_ahead; remote_behind; verse_analyses }) 575 - statuses 745 + match Eio.Switch.run (fun sw -> 746 + analyze_with_claude ~sw ~process_mgr:proc ~clock ~status_summary ~incoming_summary) 747 + with 748 + | Some json -> 749 + let (claude_repos, recs, warns) = parse_claude_response json in 750 + (* Merge Claude repos with base repos *) 751 + let merged_repos = List.map (fun base_repo -> 752 + match List.find_opt (fun cr -> cr.name = base_repo.name) claude_repos with 753 + | Some cr -> { base_repo with verse_analyses = cr.verse_analyses } 754 + | None -> base_repo) 755 + base_repos 756 + in 757 + (merged_repos, recs, warns) 758 + | None -> 759 + Log.warn (fun m -> m "Claude analysis failed, using basic status"); 760 + (base_repos, [], []) 761 + end else begin 762 + Log.app (fun m -> m "No incoming changes from remotes"); 763 + (base_repos, [], []) 764 + end 576 765 in 577 766 578 767 (* Compute summary *) ··· 586 775 verse_divergences; 587 776 } in 588 777 589 - (* Build recommendations *) 590 - let recommendations = ref [] in 778 + (* Build recommendations: start with Claude's, add our own *) 779 + let recommendations = ref claude_recommendations in 591 780 592 781 (* Add recommendations for local sync issues *) 593 - if repos_need_sync > 0 then 782 + if repos_need_sync > 0 && not (List.exists (fun r -> 783 + String.starts_with ~prefix:"Run monopam sync" r.description) !recommendations) then 594 784 recommendations := { 595 785 action_priority = Medium; 596 - description = "Run monopam sync to resolve local sync issues"; 786 + description = Printf.sprintf "Run monopam sync to resolve %d local sync issues" repos_need_sync; 597 787 command = Some "monopam sync"; 598 788 } :: !recommendations; 599 789 600 790 (* Add recommendations for repos behind upstream *) 601 - if repos_behind_upstream > 0 then 791 + if repos_behind_upstream > 0 && not (List.exists (fun r -> 792 + String.starts_with ~prefix:"Pull upstream" r.description) !recommendations) then 602 793 recommendations := { 603 794 action_priority = Medium; 604 795 description = Printf.sprintf "Pull upstream changes for %d repos" repos_behind_upstream; 605 796 command = Some "monopam sync"; 606 797 } :: !recommendations; 607 798 608 - (* Add recommendations from verse analyses *) 609 - List.iter (fun r -> 610 - List.iter (fun v -> 611 - List.iter (fun (c : commit_analysis) -> 612 - if c.priority = Critical || c.priority = High then 613 - recommendations := { 614 - action_priority = c.priority; 615 - description = Printf.sprintf "Review %s's %s in %s (%s)" 616 - v.handle c.hash r.name c.commit_summary; 617 - command = Some (Printf.sprintf "cd src/%s && git show verse-%s/%s" 618 - r.name v.handle c.hash); 619 - } :: !recommendations) 620 - v.commits) 621 - r.verse_analyses) 622 - repos; 623 - 624 799 (* Sort recommendations by priority *) 625 800 let priority_order = function 626 801 | Critical -> 0 | High -> 1 | Medium -> 2 | Low -> 3 ··· 630 805 !recommendations 631 806 in 632 807 633 - { timestamp; workspace; report_summary; repos; recommendations; warnings = List.rev !warnings } 808 + let all_warnings = List.rev !warnings @ claude_warnings in 809 + { timestamp; workspace; report_summary; repos; recommendations; warnings = all_warnings } 634 810 635 811 (** Encode report to JSON string *) 636 812 let to_json report =

+17

lib/git.ml

··· 92 92 let cwd = path_to_eio ~fs path in 93 93 run_git_ok ~proc ~cwd [ "fetch"; remote ] |> Result.map ignore 94 94 95 + let fetch_all ~proc ~fs path = 96 + let cwd = path_to_eio ~fs path in 97 + run_git_ok ~proc ~cwd [ "fetch"; "--all" ] |> Result.map ignore 98 + 95 99 let merge_ff ~proc ~fs ?(remote = "origin") ?branch path = 96 100 let cwd = path_to_eio ~fs path in 97 101 let branch = ··· 293 297 match until with Some u -> args @ [ "--until=" ^ u ] | None -> args 294 298 in 295 299 let args = match filter_path with Some p -> args @ [ "--"; p ] | None -> args in 300 + match run_git_ok ~proc ~cwd args with 301 + | Ok output -> Ok (parse_log_entries output) 302 + | Error e -> Error e 303 + 304 + let log_range ~proc ~fs ~base ~tip ?max_count repo_path = 305 + let cwd = path_to_eio ~fs repo_path in 306 + let format_arg = "--format=%H%n%an%n%aI%n%s%n%b%x00" in 307 + let range = Printf.sprintf "%s..%s" base tip in 308 + let args = [ "log"; format_arg; range ] in 309 + let args = match max_count with 310 + | Some n -> args @ [ "-n"; string_of_int n ] 311 + | None -> args 312 + in 296 313 match run_git_ok ~proc ~cwd args with 297 314 | Ok output -> Ok (parse_log_entries output) 298 315 | Error e -> Error e

+26

lib/git.mli

··· 87 87 88 88 @param remote Remote name (default: "origin") *) 89 89 90 + val fetch_all : 91 + proc:_ Eio.Process.mgr -> 92 + fs:Eio.Fs.dir_ty Eio.Path.t -> 93 + Fpath.t -> 94 + (unit, error) result 95 + (** [fetch_all ~proc ~fs path] fetches from all remotes. 96 + 97 + Runs [git fetch --all] to update all remote tracking branches. *) 98 + 90 99 val merge_ff : 91 100 proc:_ Eio.Process.mgr -> 92 101 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 350 359 @param since Include commits more recent than this date (e.g., "1 week ago") 351 360 @param until Include commits older than this date 352 361 @param path Filter to commits affecting this path (relative to repo) 362 + @param repo Path to the git repository *) 363 + 364 + val log_range : 365 + proc:_ Eio.Process.mgr -> 366 + fs:Eio.Fs.dir_ty Eio.Path.t -> 367 + base:string -> 368 + tip:string -> 369 + ?max_count:int -> 370 + Fpath.t -> 371 + (log_entry list, error) result 372 + (** [log_range ~proc ~fs ~base ~tip ?max_count repo] retrieves commits between refs. 373 + 374 + Gets commits reachable from [tip] but not from [base] (i.e., [base..tip]). 375 + 376 + @param base Base ref (commits reachable from here are excluded) 377 + @param tip Tip ref (commits reachable from here are included) 378 + @param max_count Maximum number of commits to return 353 379 @param repo Path to the git repository *) 354 380 355 381 (** {1 Subtree Commit Analysis} *)

+2 -2

lib/monopam.ml

··· 1117 1117 | Ok ab -> ab.behind 1118 1118 | Error _ -> 0 1119 1119 in 1120 - Log.info (fun m -> m "Fetching %s" (Package.repo_name pkg)); 1121 - match Git.fetch ~proc ~fs checkout_dir with 1120 + Log.info (fun m -> m "Fetching %s (all remotes)" (Package.repo_name pkg)); 1121 + match Git.fetch_all ~proc ~fs checkout_dir with 1122 1122 | Error e -> Error e 1123 1123 | Ok () -> 1124 1124 (* Get commits behind after fetching *)