+461 -259

bin/main.ml

reviewed

··· 98 98 let sources = 99 99 let mono_path = Monopam.Config.Paths.monorepo config in 100 100 let sources_path = Fpath.(mono_path / "sources.toml") in 101 101 - match Monopam.Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with 101 101 + match 102 102 + Monopam.Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path 103 103 + with 102 104 | Ok s -> Some s 103 105 | Error _ -> None 104 106 in ··· 447 449 [ 448 450 `S Manpage.s_description; 449 451 `P 450 450 - "Creates a new monopam workspace for monorepo development. The workspace \ 451 451 - lets you manage your own monorepo and optionally browse and track other \ 452 452 - developers' monorepos."; 452 452 + "Creates a new monopam workspace for monorepo development. The \ 453 453 + workspace lets you manage your own monorepo and optionally browse and \ 454 454 + track other developers' monorepos."; 453 455 `S "WORKSPACE STRUCTURE"; 454 456 `P 455 457 "The init command creates the following directory structure at the \ ··· 476 478 handle = \"yourname.bsky.social\""; 477 479 `S "HANDLE VALIDATION"; 478 480 `P 479 479 - "The handle you provide identifies you in the community. \ 480 480 - It should be a valid domain name (e.g., yourname.bsky.social or \ 481 481 - your-domain.com)."; 481 481 + "The handle you provide identifies you in the community. It should be \ 482 482 + a valid domain name (e.g., yourname.bsky.social or your-domain.com)."; 482 483 `S "REGISTRY"; 483 484 `P 484 485 "The registry is a git repository containing an opamverse.toml file \ ··· 589 590 [ 590 591 `S Manpage.s_description; 591 592 `P 592 592 - "Fork a package from a verse member's opam repository into your workspace. \ 593 593 - This creates entries in your opam-repo with your fork URL as the dev-repo."; 593 593 + "Fork a package from a verse member's opam repository into your \ 594 594 + workspace. This creates entries in your opam-repo with your fork URL \ 595 595 + as the dev-repo."; 594 596 `P 595 595 - "The command finds all packages sharing the same git repository and forks \ 596 596 - them together. For example, if you fork 'cohttp', it will also fork \ 597 597 - cohttp-eio, cohttp-lwt, etc."; 597 597 + "The command finds all packages sharing the same git repository and \ 598 598 + forks them together. For example, if you fork 'cohttp', it will also \ 599 599 + fork cohttp-eio, cohttp-lwt, etc."; 598 600 `S "WHAT IT DOES"; 599 601 `P "For the specified package:"; 600 600 - `I ("1.", "Looks up the package in <handle>'s opam-repo (verse/<handle>-opam/)"); 602 602 + `I 603 603 + ( "1.", 604 604 + "Looks up the package in <handle>'s opam-repo (verse/<handle>-opam/)" 605 605 + ); 601 606 `I ("2.", "Finds all packages from the same git repository"); 602 607 `I ("3.", "Creates entries in your opam-repo with your fork URL"); 603 608 `P "After forking:"; 604 604 - `I ("1.", "Commit the new opam files: $(b,cd opam-repo && git add -A && git commit)"); 609 609 + `I 610 610 + ( "1.", 611 611 + "Commit the new opam files: $(b,cd opam-repo && git add -A && git \ 612 612 + commit)" ); 605 613 `I ("2.", "Run $(b,monopam sync) to pull the fork into your monorepo"); 606 614 `S "PREREQUISITES"; 607 615 `P "Before forking:"; 608 608 - `I ("-", "Run $(b,monopam verse pull <handle>) to sync the member's opam-repo"); 616 616 + `I 617 617 + ( "-", 618 618 + "Run $(b,monopam verse pull <handle>) to sync the member's opam-repo" 619 619 + ); 609 620 `I ("-", "Create a fork of the repository on GitHub/GitLab/etc."); 610 621 `S Manpage.s_examples; 611 622 `P "Fork a package from a verse member:"; 612 612 - `Pre "monopam fork http2 --from sadiq.bsky.social --url git@github.com:me/http2.git"; 623 623 + `Pre 624 624 + "monopam fork http2 --from sadiq.bsky.social --url \ 625 625 + git@github.com:me/http2.git"; 613 626 `P "Preview what would be forked (multi-package repos):"; 614 614 - `Pre "monopam fork cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git --dry-run\n\ 615 615 - Would fork 5 packages from cohttp repository:\n\ 616 616 - \ cohttp\n\ 617 617 - \ cohttp-eio\n\ 618 618 - \ cohttp-lwt\n\ 619 619 - \ cohttp-async\n\ 620 620 - \ cohttp-mirage"; 627 627 + `Pre 628 628 + "monopam fork cohttp --from avsm.bsky.social --url \ 629 629 + git@github.com:me/cohttp.git --dry-run\n\ 630 630 + Would fork 5 packages from cohttp repository:\n\ 631 631 + \ cohttp\n\ 632 632 + \ cohttp-eio\n\ 633 633 + \ cohttp-lwt\n\ 634 634 + \ cohttp-async\n\ 635 635 + \ cohttp-mirage"; 621 636 `P "After forking, commit and sync:"; 622 622 - `Pre "cd opam-repo && git add -A && git commit -m \"Fork cohttp\"\n\ 623 623 - monopam sync"; 637 637 + `Pre 638 638 + "cd opam-repo && git add -A && git commit -m \"Fork cohttp\"\n\ 639 639 + monopam sync"; 624 640 `S "ERRORS"; 625 641 `P 626 626 - "The command will fail if any package from the source repo already exists \ 627 627 - in your opam-repo. Remove conflicting packages first with:"; 642 642 + "The command will fail if any package from the source repo already \ 643 643 + exists in your opam-repo. Remove conflicting packages first with:"; 628 644 `Pre "rm -rf opam-repo/packages/<package-name>"; 629 645 ] 630 646 in ··· 635 651 in 636 652 let from_arg = 637 653 let doc = "Verse member handle to fork from (e.g., 'avsm.bsky.social')" in 638 638 - Arg.(required & opt (some string) None & info [ "from" ] ~docv:"HANDLE" ~doc) 654 654 + Arg.( 655 655 + required & opt (some string) None & info [ "from" ] ~docv:"HANDLE" ~doc) 639 656 in 640 657 let url_arg = 641 658 let doc = "Git URL of your fork (e.g., 'git@github.com:you/repo.git')" in ··· 650 667 with_verse_config env @@ fun config -> 651 668 let fs = Eio.Stdenv.fs env in 652 669 let proc = Eio.Stdenv.process_mgr env in 653 653 - match Monopam.Verse.fork ~proc ~fs ~config ~handle ~package ~fork_url ~dry_run () with 670 670 + match 671 671 + Monopam.Verse.fork ~proc ~fs ~config ~handle ~package ~fork_url ~dry_run 672 672 + () 673 673 + with 654 674 | Ok result -> 655 675 if dry_run then begin 656 676 Fmt.pr "Would fork %d package(s) from %s:@." 657 657 - (List.length result.packages_forked) result.source_handle; 677 677 + (List.length result.packages_forked) 678 678 + result.source_handle; 658 679 List.iter (fun p -> Fmt.pr " %s@." p) result.packages_forked 659 659 - end else begin 680 680 + end 681 681 + else begin 660 682 (* Update sources.toml with fork information *) 661 683 let mono_path = Monopam.Verse_config.mono_path config in 662 684 let sources_path = Fpath.(mono_path / "sources.toml") in 663 685 let sources = 664 664 - match Monopam.Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with 686 686 + match 687 687 + Monopam.Sources_registry.load 688 688 + ~fs:(fs :> _ Eio.Path.t) 689 689 + sources_path 690 690 + with 665 691 | Ok s -> s 666 692 | Error _ -> Monopam.Sources_registry.empty 667 693 in 668 668 - let entry = Monopam.Sources_registry.{ 669 669 - url = result.fork_url; 670 670 - upstream = Some result.upstream_url; 671 671 - branch = None; 672 672 - reason = Some (Fmt.str "Forked from %s" result.source_handle); 673 673 - origin = Some Join; (* Forked from verse = joined *) 674 674 - } in 675 675 - let sources = Monopam.Sources_registry.add sources ~subtree:result.subtree_name entry in 676 676 - (match Monopam.Sources_registry.save ~fs:(fs :> _ Eio.Path.t) sources_path sources with 694 694 + let entry = 695 695 + Monopam.Sources_registry. 696 696 + { 697 697 + url = result.fork_url; 698 698 + upstream = Some result.upstream_url; 699 699 + branch = None; 700 700 + reason = Some (Fmt.str "Forked from %s" result.source_handle); 701 701 + origin = Some Join; 702 702 + (* Forked from verse = joined *) 703 703 + } 704 704 + in 705 705 + let sources = 706 706 + Monopam.Sources_registry.add sources ~subtree:result.subtree_name 707 707 + entry 708 708 + in 709 709 + (match 710 710 + Monopam.Sources_registry.save 711 711 + ~fs:(fs :> _ Eio.Path.t) 712 712 + sources_path sources 713 713 + with 677 714 | Ok () -> 678 678 - Fmt.pr "Updated sources.toml with fork entry for %s@." result.subtree_name 715 715 + Fmt.pr "Updated sources.toml with fork entry for %s@." 716 716 + result.subtree_name 679 717 | Error msg -> 680 718 Fmt.epr "Warning: Failed to update sources.toml: %s@." msg); 681 719 Fmt.pr "Forked %d package(s): %a@." 682 720 (List.length result.packages_forked) 683 683 - Fmt.(list ~sep:(any ", ") string) result.packages_forked; 721 721 + Fmt.(list ~sep:(any ", ") string) 722 722 + result.packages_forked; 684 723 Fmt.pr "@.Next steps:@."; 685 685 - Fmt.pr " 1. cd opam-repo && git add -A && git commit -m \"Fork ...\"@."; 724 724 + Fmt.pr 725 725 + " 1. cd opam-repo && git add -A && git commit -m \"Fork ...\"@."; 686 726 Fmt.pr " 2. monopam sync@." 687 727 end; 688 728 `Ok () ··· 690 730 Fmt.epr "Error: %a@." Monopam.Verse.pp_error_with_hint e; 691 731 `Error (false, "fork failed") 692 732 in 693 693 - Cmd.v info Term.(ret (const run $ package_arg $ from_arg $ url_arg $ dry_run_arg $ logging_term)) 733 733 + Cmd.v info 734 734 + Term.( 735 735 + ret 736 736 + (const run $ package_arg $ from_arg $ url_arg $ dry_run_arg 737 737 + $ logging_term)) 694 738 695 739 let verse_cmd = 696 740 let doc = "Verse member operations" in ··· 699 743 `S Manpage.s_description; 700 744 `P 701 745 "Commands for working with verse community members. The verse system \ 702 702 - enables federated collaboration across multiple developers' monorepos."; 746 746 + enables federated collaboration across multiple developers' \ 747 747 + monorepos."; 703 748 `P 704 749 "Members are identified by handles - typically domain names like \ 705 750 'yourname.bsky.social' or 'your-domain.com'."; 706 751 `S "NOTE"; 707 752 `P 708 708 - "The $(b,monopam init) command creates your workspace and \ 709 709 - $(b,monopam sync) automatically syncs verse members. These commands \ 710 710 - are for additional verse-specific operations."; 753 753 + "The $(b,monopam init) command creates your workspace and $(b,monopam \ 754 754 + sync) automatically syncs verse members. These commands are for \ 755 755 + additional verse-specific operations."; 711 756 `S "COMMANDS"; 712 757 `I ("members", "List all members in the community registry"); 713 713 - `I ("fork <pkg> --from <handle> --url <url>", "Fork a package from a verse member"); 758 758 + `I 759 759 + ( "fork <pkg> --from <handle> --url <url>", 760 760 + "Fork a package from a verse member" ); 714 761 `S Manpage.s_examples; 715 762 `P "List all community members:"; 716 763 `Pre "monopam verse members"; 717 764 `P "Fork a package from another member:"; 718 718 - `Pre "monopam verse fork cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git"; 765 765 + `Pre 766 766 + "monopam verse fork cohttp --from avsm.bsky.social --url \ 767 767 + git@github.com:me/cohttp.git"; 719 768 ] 720 769 in 721 770 let info = Cmd.info "verse" ~doc ~man in 722 722 - Cmd.group info 723 723 - [ 724 724 - verse_members_cmd; 725 725 - verse_fork_cmd; 726 726 - ] 771 771 + Cmd.group info [ verse_members_cmd; verse_fork_cmd ] 727 772 728 773 (* Diff command *) 729 774 ··· 733 778 [ 734 779 `S Manpage.s_description; 735 780 `P 736 736 - "Shows commit diffs from verse members for repositories where they have \ 737 737 - commits you don't have. This helps you see what changes are available \ 738 738 - from collaborators."; 781 781 + "Shows commit diffs from verse members for repositories where they \ 782 782 + have commits you don't have. This helps you see what changes are \ 783 783 + available from collaborators."; 739 784 `S "OUTPUT"; 740 740 - `P "First shows the verse status summary, then for each repository where \ 741 741 - a verse member is ahead:"; 785 785 + `P 786 786 + "First shows the verse status summary, then for each repository where \ 787 787 + a verse member is ahead:"; 742 788 `I ("Repository name", "With the handle and relationship"); 743 789 `I ("Commits", "List of commits they have that you don't (max 20)"); 744 790 `S "RELATIONSHIPS"; 745 791 `I ("+N", "They have N commits you don't have"); 746 792 `I ("+N/-M", "Diverged: they have N new commits, you have M new commits"); 747 793 `S "CACHING"; 748 748 - `P "Remote fetches are cached for 1 hour to improve performance. \ 749 749 - Use $(b,--refresh) to force fresh fetches from all remotes."; 794 794 + `P 795 795 + "Remote fetches are cached for 1 hour to improve performance. Use \ 796 796 + $(b,--refresh) to force fresh fetches from all remotes."; 750 797 `S Manpage.s_examples; 751 798 `P "Show diffs for all repos needing attention (uses cache):"; 752 799 `Pre "monopam diff"; ··· 762 809 in 763 810 let info = Cmd.info "diff" ~doc ~man in 764 811 let arg = 765 765 - let doc = "Repository name or commit SHA. If a 7+ character hex string, shows \ 766 766 - the patch for that commit. Otherwise filters to that repository. \ 767 767 - If not specified, shows diffs for all repos needing attention." in 812 812 + let doc = 813 813 + "Repository name or commit SHA. If a 7+ character hex string, shows the \ 814 814 + patch for that commit. Otherwise filters to that repository. If not \ 815 815 + specified, shows diffs for all repos needing attention." 816 816 + in 768 817 Arg.(value & pos 0 (some string) None & info [] ~docv:"REPO|SHA" ~doc) 769 818 in 770 819 let refresh_arg = 771 771 - let doc = "Force fresh fetches from all remotes, ignoring the 1-hour cache." in 820 820 + let doc = 821 821 + "Force fresh fetches from all remotes, ignoring the 1-hour cache." 822 822 + in 772 823 Arg.(value & flag & info [ "refresh"; "r" ] ~doc) 773 824 in 774 825 let patch_arg = ··· 783 834 let proc = Eio.Stdenv.process_mgr env in 784 835 (* Check if arg looks like a commit SHA *) 785 836 match arg with 786 786 - | Some sha when Monopam.is_commit_sha sha -> 837 837 + | Some sha when Monopam.is_commit_sha sha -> ( 787 838 (* Show patch for specific commit *) 788 788 - (match Monopam.diff_show_commit ~proc ~fs ~config ~verse_config ~sha ~refresh () with 839 839 + match 840 840 + Monopam.diff_show_commit ~proc ~fs ~config ~verse_config ~sha ~refresh 841 841 + () 842 842 + with 789 843 | Some info -> 790 790 - let short_hash = String.sub info.commit_hash 0 (min 7 (String.length info.commit_hash)) in 844 844 + let short_hash = 845 845 + String.sub info.commit_hash 0 846 846 + (min 7 (String.length info.commit_hash)) 847 847 + in 791 848 Fmt.pr "%a %s (%s/%s)@.@.%s@." 792 792 - Fmt.(styled `Yellow string) short_hash 793 793 - info.commit_subject 794 794 - info.commit_repo info.commit_handle 849 849 + Fmt.(styled `Yellow string) 850 850 + short_hash info.commit_subject info.commit_repo info.commit_handle 795 851 info.commit_patch; 796 852 `Ok () 797 853 | None -> 798 854 Fmt.epr "Commit %s not found in any verse diff@." sha; 799 855 `Error (false, "commit not found")) 800 856 | repo -> 801 801 - let result = Monopam.diff ~proc ~fs ~config ~verse_config ?repo ~refresh ~patch () in 857 857 + let result = 858 858 + Monopam.diff ~proc ~fs ~config ~verse_config ?repo ~refresh ~patch () 859 859 + in 802 860 Fmt.pr "%a" (Monopam.pp_diff_result ~show_patch:patch) result; 803 861 `Ok () 804 862 in 805 805 - Cmd.v info Term.(ret (const run $ arg $ refresh_arg $ patch_arg $ logging_term)) 863 863 + Cmd.v info 864 864 + Term.(ret (const run $ arg $ refresh_arg $ patch_arg $ logging_term)) 806 865 807 866 (* Pull command - pull from verse members *) 808 867 ··· 822 881 `I ("3.", "$(b,monopam sync) - Sync changes into your monorepo"); 823 882 `S "MERGING BEHAVIOR"; 824 883 `P "When you're behind (they have commits you don't):"; 825 825 - `I ("Fast-forward", "If your branch has no new commits, a fast-forward merge is used."); 884 884 + `I 885 885 + ( "Fast-forward", 886 886 + "If your branch has no new commits, a fast-forward merge is used." ); 826 887 `P "When branches have diverged (both have new commits):"; 827 888 `I ("Merge commit", "A merge commit is created to combine the histories."); 828 889 `S Manpage.s_examples; ··· 836 897 in 837 898 let info = Cmd.info "pull" ~doc ~man in 838 899 let handle_arg = 839 839 - let doc = "The verse member handle to pull from (e.g., avsm.bsky.social)." in 900 900 + let doc = 901 901 + "The verse member handle to pull from (e.g., avsm.bsky.social)." 902 902 + in 840 903 Arg.(required & pos 0 (some string) None & info [] ~docv:"HANDLE" ~doc) 841 904 in 842 905 let repo_arg = 843 843 - let doc = "Optional repository to pull from. If not specified, pulls from all \ 844 844 - repositories where the handle has commits you don't have." in 906 906 + let doc = 907 907 + "Optional repository to pull from. If not specified, pulls from all \ 908 908 + repositories where the handle has commits you don't have." 909 909 + in 845 910 Arg.(value & pos 1 (some string) None & info [] ~docv:"REPO" ~doc) 846 911 in 847 912 let refresh_arg = 848 848 - let doc = "Force fresh fetches from all remotes, ignoring the 1-hour cache." in 913 913 + let doc = 914 914 + "Force fresh fetches from all remotes, ignoring the 1-hour cache." 915 915 + in 849 916 Arg.(value & flag & info [ "refresh"; "r" ] ~doc) 850 917 in 851 918 let run handle repo refresh () = ··· 854 921 with_verse_config env @@ fun verse_config -> 855 922 let fs = Eio.Stdenv.fs env in 856 923 let proc = Eio.Stdenv.process_mgr env in 857 857 - match Monopam.pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo ~refresh () with 924 924 + match 925 925 + Monopam.pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo 926 926 + ~refresh () 927 927 + with 858 928 | Ok result -> 859 929 Fmt.pr "%a" Monopam.pp_handle_pull_result result; 860 930 if result.repos_failed <> [] then ··· 864 934 `Ok () 865 935 end 866 936 else begin 867 867 - Fmt.pr "@.Run $(b,monopam sync) to merge changes into your monorepo.@."; 937 937 + Fmt.pr 938 938 + "@.Run $(b,monopam sync) to merge changes into your monorepo.@."; 868 939 `Ok () 869 940 end 870 941 | Error e -> 871 942 Fmt.epr "Error: %a@." Monopam.pp_error_with_hint e; 872 943 `Error (false, "pull failed") 873 944 in 874 874 - Cmd.v info Term.(ret (const run $ handle_arg $ repo_arg $ refresh_arg $ logging_term)) 945 945 + Cmd.v info 946 946 + Term.(ret (const run $ handle_arg $ repo_arg $ refresh_arg $ logging_term)) 875 947 876 948 (* Cherrypick command *) 877 949 ··· 881 953 [ 882 954 `S Manpage.s_description; 883 955 `P 884 884 - "Applies a specific commit from a verse member's fork to your local checkout. \ 885 885 - Use $(b,monopam diff) to see available commits and their hashes."; 956 956 + "Applies a specific commit from a verse member's fork to your local \ 957 957 + checkout. Use $(b,monopam diff) to see available commits and their \ 958 958 + hashes."; 886 959 `S "WORKFLOW"; 887 960 `P "The typical workflow for cherry-picking specific commits:"; 888 961 `I ("1.", "$(b,monopam diff) - See available commits with their hashes"); ··· 899 972 in 900 973 let info = Cmd.info "cherrypick" ~doc ~man in 901 974 let sha_arg = 902 902 - let doc = "The commit SHA (or prefix) to cherry-pick. Must be at least 7 characters." in 975 975 + let doc = 976 976 + "The commit SHA (or prefix) to cherry-pick. Must be at least 7 \ 977 977 + characters." 978 978 + in 903 979 Arg.(required & pos 0 (some string) None & info [] ~docv:"SHA" ~doc) 904 980 in 905 981 let refresh_arg = 906 906 - let doc = "Force fresh fetches from all remotes, ignoring the 1-hour cache." in 982 982 + let doc = 983 983 + "Force fresh fetches from all remotes, ignoring the 1-hour cache." 984 984 + in 907 985 Arg.(value & flag & info [ "refresh"; "r" ] ~doc) 908 986 in 909 987 let run sha refresh () = ··· 912 990 with_verse_config env @@ fun verse_config -> 913 991 let fs = Eio.Stdenv.fs env in 914 992 let proc = Eio.Stdenv.process_mgr env in 915 915 - match Monopam.cherrypick ~proc ~fs ~config ~verse_config ~sha ~refresh () with 993 993 + match 994 994 + Monopam.cherrypick ~proc ~fs ~config ~verse_config ~sha ~refresh () 995 995 + with 916 996 | Ok result -> 917 997 Fmt.pr "%a" Monopam.pp_cherrypick_result result; 918 998 Fmt.pr "Run $(b,monopam sync) to merge changes into your monorepo.@."; ··· 982 1062 in 983 1063 let quiet_arg = 984 1064 let doc = 985 985 - "Quiet mode for cron jobs. Only output if issues are found. \ 986 986 - Exit code reflects health status (0=healthy, 1=warning, 2=critical)." 1065 1065 + "Quiet mode for cron jobs. Only output if issues are found. Exit code \ 1066 1066 + reflects health status (0=healthy, 1=warning, 2=critical)." 987 1067 in 988 1068 Arg.(value & flag & info [ "quiet"; "q" ] ~doc) 989 1069 in ··· 995 1075 let proc = Eio.Stdenv.process_mgr env in 996 1076 let clock = Eio.Stdenv.clock env in 997 1077 (* Run sync before analysis unless --no-sync is specified *) 998 998 - if not no_sync && not quiet then begin 1078 1078 + if (not no_sync) && not quiet then begin 999 1079 Fmt.pr "Syncing workspace before analysis...@."; 1000 1080 match Monopam.sync ~proc ~fs ~config ?package () with 1001 1081 | Ok _summary -> () ··· 1005 1085 end 1006 1086 else if not no_sync then begin 1007 1087 (* Quiet mode but still sync - just don't print progress *) 1008 1008 - let _ = Monopam.sync ~proc ~fs ~config ?package () in () 1088 1088 + let _ = Monopam.sync ~proc ~fs ~config ?package () in 1089 1089 + () 1009 1090 end; 1010 1091 let report = 1011 1092 Monopam.Doctor.analyze ~proc ~fs ~config ~verse_config ~clock ?package ··· 1029 1110 end 1030 1111 in 1031 1112 Cmd.v info 1032 1032 - Term.(ret (const run $ package_arg $ json_arg $ no_sync_arg $ quiet_arg $ logging_term)) 1113 1113 + Term.( 1114 1114 + ret 1115 1115 + (const run $ package_arg $ json_arg $ no_sync_arg $ quiet_arg 1116 1116 + $ logging_term)) 1033 1117 1034 1118 (* Feature commands *) 1035 1119 ··· 1043 1127 [ 1044 1128 `S Manpage.s_description; 1045 1129 `P 1046 1046 - "Creates a git worktree at $(b,root/work/<name>) with a new branch named \ 1047 1047 - $(b,<name>). This allows parallel development on separate branches, \ 1048 1048 - useful for having multiple Claude instances working on different features."; 1130 1130 + "Creates a git worktree at $(b,root/work/<name>) with a new branch \ 1131 1131 + named $(b,<name>). This allows parallel development on separate \ 1132 1132 + branches, useful for having multiple Claude instances working on \ 1133 1133 + different features."; 1049 1134 `S "HOW IT WORKS"; 1050 1135 `P "The command:"; 1051 1136 `I ("1.", "Creates the $(b,work/) directory if it doesn't exist"); ··· 1053 1138 `I ("3.", "Checks out a new branch named $(b,<name>)"); 1054 1139 `S Manpage.s_examples; 1055 1140 `P "Create a feature worktree:"; 1056 1056 - `Pre "monopam feature add my-feature\n\ 1057 1057 - cd work/my-feature\n\ 1058 1058 - # Now you can work here independently"; 1141 1141 + `Pre 1142 1142 + "monopam feature add my-feature\n\ 1143 1143 + cd work/my-feature\n\ 1144 1144 + # Now you can work here independently"; 1059 1145 `P "Have multiple Claudes work in parallel:"; 1060 1060 - `Pre "# Terminal 1\n\ 1061 1061 - monopam feature add auth-system\n\ 1062 1062 - cd work/auth-system && claude\n\n\ 1063 1063 - # Terminal 2\n\ 1064 1064 - monopam feature add api-refactor\n\ 1065 1065 - cd work/api-refactor && claude"; 1146 1146 + `Pre 1147 1147 + "# Terminal 1\n\ 1148 1148 + monopam feature add auth-system\n\ 1149 1149 + cd work/auth-system && claude\n\n\ 1150 1150 + # Terminal 2\n\ 1151 1151 + monopam feature add api-refactor\n\ 1152 1152 + cd work/api-refactor && claude"; 1066 1153 ] 1067 1154 in 1068 1155 let info = Cmd.info "add" ~doc ~man in ··· 1073 1160 let proc = Eio.Stdenv.process_mgr env in 1074 1161 match Monopam.Feature.add ~proc ~fs ~config:verse_config ~name () with 1075 1162 | Ok entry -> 1076 1076 - Fmt.pr "Created feature worktree '%s' at %a@." entry.name Fpath.pp entry.path; 1163 1163 + Fmt.pr "Created feature worktree '%s' at %a@." entry.name Fpath.pp 1164 1164 + entry.path; 1077 1165 Fmt.pr "@.To start working:@."; 1078 1166 Fmt.pr " cd %a@." Fpath.pp entry.path; 1079 1167 `Ok () ··· 1110 1198 with_verse_config env @@ fun verse_config -> 1111 1199 let fs = Eio.Stdenv.fs env in 1112 1200 let proc = Eio.Stdenv.process_mgr env in 1113 1113 - match Monopam.Feature.remove ~proc ~fs ~config:verse_config ~name ~force () with 1201 1201 + match 1202 1202 + Monopam.Feature.remove ~proc ~fs ~config:verse_config ~name ~force () 1203 1203 + with 1114 1204 | Ok () -> 1115 1205 Fmt.pr "Removed feature worktree '%s'.@." name; 1116 1206 `Ok () ··· 1118 1208 Fmt.epr "Error: %a@." Monopam.Feature.pp_error_with_hint e; 1119 1209 `Error (false, "feature remove failed") 1120 1210 in 1121 1121 - Cmd.v info Term.(ret (const run $ feature_name_arg $ force_arg $ logging_term)) 1211 1211 + Cmd.v info 1212 1212 + Term.(ret (const run $ feature_name_arg $ force_arg $ logging_term)) 1122 1213 1123 1214 let feature_list_cmd = 1124 1215 let doc = "List all feature worktrees" in ··· 1137 1228 let fs = Eio.Stdenv.fs env in 1138 1229 let proc = Eio.Stdenv.process_mgr env in 1139 1230 let entries = Monopam.Feature.list ~proc ~fs ~config:verse_config () in 1140 1140 - if entries = [] then 1141 1141 - Fmt.pr "No feature worktrees found.@." 1231 1231 + if entries = [] then Fmt.pr "No feature worktrees found.@." 1142 1232 else begin 1143 1233 Fmt.pr "Feature worktrees:@."; 1144 1144 - List.iter (fun entry -> 1145 1145 - Fmt.pr " %s -> %a (branch: %s)@." 1146 1146 - entry.Monopam.Feature.name 1147 1147 - Fpath.pp entry.Monopam.Feature.path 1148 1148 - entry.Monopam.Feature.branch 1149 1149 - ) entries 1234 1234 + List.iter 1235 1235 + (fun entry -> 1236 1236 + Fmt.pr " %s -> %a (branch: %s)@." entry.Monopam.Feature.name Fpath.pp 1237 1237 + entry.Monopam.Feature.path entry.Monopam.Feature.branch) 1238 1238 + entries 1150 1239 end; 1151 1240 `Ok () 1152 1241 in ··· 1163 1252 working on different features simultaneously."; 1164 1253 `S "WORKSPACE STRUCTURE"; 1165 1254 `P "Feature worktrees are created in the $(b,work/) directory:"; 1166 1166 - `Pre "root/\n\ 1167 1167 - ├── mono/ # Main monorepo\n\ 1168 1168 - ├── work/\n\ 1169 1169 - │ ├── feature-a/ # Worktree on branch 'feature-a'\n\ 1170 1170 - │ └── feature-b/ # Worktree on branch 'feature-b'\n\ 1171 1171 - └── ..."; 1255 1255 + `Pre 1256 1256 + "root/\n\ 1257 1257 + ├── mono/ # Main monorepo\n\ 1258 1258 + ├── work/\n\ 1259 1259 + │ ├── feature-a/ # Worktree on branch 'feature-a'\n\ 1260 1260 + │ └── feature-b/ # Worktree on branch 'feature-b'\n\ 1261 1261 + └── ..."; 1172 1262 `S "COMMANDS"; 1173 1263 `I ("add <name>", "Create a new feature worktree"); 1174 1264 `I ("remove <name>", "Remove a feature worktree"); 1175 1265 `I ("list", "List all feature worktrees"); 1176 1266 `S "WORKFLOW"; 1177 1267 `P "Typical workflow for parallel development:"; 1178 1178 - `Pre "# Create feature worktrees\n\ 1179 1179 - monopam feature add auth-system\n\ 1180 1180 - monopam feature add api-cleanup\n\n\ 1181 1181 - # Work in each worktree independently\n\ 1182 1182 - cd work/auth-system && claude\n\ 1183 1183 - cd work/api-cleanup && claude\n\n\ 1184 1184 - # When done, merge branches back to main\n\ 1185 1185 - cd mono\n\ 1186 1186 - git merge auth-system\n\ 1187 1187 - git merge api-cleanup\n\n\ 1188 1188 - # Clean up worktrees\n\ 1189 1189 - monopam feature remove auth-system\n\ 1190 1190 - monopam feature remove api-cleanup"; 1268 1268 + `Pre 1269 1269 + "# Create feature worktrees\n\ 1270 1270 + monopam feature add auth-system\n\ 1271 1271 + monopam feature add api-cleanup\n\n\ 1272 1272 + # Work in each worktree independently\n\ 1273 1273 + cd work/auth-system && claude\n\ 1274 1274 + cd work/api-cleanup && claude\n\n\ 1275 1275 + # When done, merge branches back to main\n\ 1276 1276 + cd mono\n\ 1277 1277 + git merge auth-system\n\ 1278 1278 + git merge api-cleanup\n\n\ 1279 1279 + # Clean up worktrees\n\ 1280 1280 + monopam feature remove auth-system\n\ 1281 1281 + monopam feature remove api-cleanup"; 1191 1282 ] 1192 1283 in 1193 1284 let info = Cmd.info "feature" ~doc ~man in ··· 1209 1300 .devcontainer configuration, it will be created automatically."; 1210 1301 `P 1211 1302 "This is the recommended way to get started with monopam. The \ 1212 1212 - devcontainer provides a consistent environment with OCaml, opam, \ 1213 1213 - and all required tools pre-installed."; 1303 1303 + devcontainer provides a consistent environment with OCaml, opam, and \ 1304 1304 + all required tools pre-installed."; 1214 1305 `S "WHAT IT DOES"; 1215 1306 `P "For a new directory (no .devcontainer/):"; 1216 1307 `I ("1.", "Creates the target directory if needed"); ··· 1222 1313 `I ("1.", "Starts the devcontainer if not running"); 1223 1314 `I ("2.", "Opens an interactive shell inside the container"); 1224 1315 `S Manpage.s_options; 1225 1225 - `P "Use $(b,--url) to specify a custom devcontainer.json URL if you want \ 1226 1226 - to use a different base configuration."; 1316 1316 + `P 1317 1317 + "Use $(b,--url) to specify a custom devcontainer.json URL if you want \ 1318 1318 + to use a different base configuration."; 1227 1319 `S Manpage.s_examples; 1228 1320 `P "Create a new devcontainer workspace:"; 1229 1321 `Pre "monopam devcontainer ~/my-ocaml-project"; 1230 1322 `P "Enter an existing devcontainer:"; 1231 1323 `Pre "monopam devcontainer ~/my-ocaml-project"; 1232 1324 `P "Use a custom devcontainer.json:"; 1233 1233 - `Pre "monopam devcontainer --url https://example.com/devcontainer.json ~/project"; 1325 1325 + `Pre 1326 1326 + "monopam devcontainer --url https://example.com/devcontainer.json \ 1327 1327 + ~/project"; 1234 1328 ] 1235 1329 in 1236 1330 let info = Cmd.info "devcontainer" ~doc ~man in ··· 1239 1333 Arg.(required & pos 0 (some string) None & info [] ~docv:"PATH" ~doc) 1240 1334 in 1241 1335 let url_arg = 1242 1242 - let doc = "URL to fetch devcontainer.json from. Defaults to the claude-ocaml-devcontainer template." in 1243 1243 - Arg.(value & opt string default_devcontainer_url & info ["url"] ~docv:"URL" ~doc) 1336 1336 + let doc = 1337 1337 + "URL to fetch devcontainer.json from. Defaults to the \ 1338 1338 + claude-ocaml-devcontainer template." 1339 1339 + in 1340 1340 + Arg.( 1341 1341 + value 1342 1342 + & opt string default_devcontainer_url 1343 1343 + & info [ "url" ] ~docv:"URL" ~doc) 1244 1344 in 1245 1345 let run path url () = 1246 1346 (* Resolve to absolute path *) 1247 1347 let abs_path = 1248 1248 - if Filename.is_relative path then 1249 1249 - Filename.concat (Sys.getcwd ()) path 1348 1348 + if Filename.is_relative path then Filename.concat (Sys.getcwd ()) path 1250 1349 else path 1251 1350 in 1252 1351 let devcontainer_dir = Filename.concat abs_path ".devcontainer" in 1253 1253 - let devcontainer_json = Filename.concat devcontainer_dir "devcontainer.json" in 1352 1352 + let devcontainer_json = 1353 1353 + Filename.concat devcontainer_dir "devcontainer.json" 1354 1354 + in 1254 1355 (* Check if .devcontainer exists *) 1255 1255 - let needs_init = not (Sys.file_exists devcontainer_dir && Sys.is_directory devcontainer_dir) in 1356 1356 + let needs_init = 1357 1357 + not (Sys.file_exists devcontainer_dir && Sys.is_directory devcontainer_dir) 1358 1358 + in 1256 1359 if needs_init then begin 1257 1360 Fmt.pr "Initializing devcontainer in %s...@." abs_path; 1258 1361 (* Create directories *) 1259 1259 - (try Unix.mkdir abs_path 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 1260 1260 - (try Unix.mkdir devcontainer_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 1362 1362 + (try Unix.mkdir abs_path 0o755 1363 1363 + with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 1364 1364 + (try Unix.mkdir devcontainer_dir 0o755 1365 1365 + with Unix.Unix_error (Unix.EEXIST, _, _) -> ()); 1261 1366 (* Fetch devcontainer.json using curl *) 1262 1367 Fmt.pr "Fetching devcontainer.json from %s...@." url; 1263 1263 - let curl_cmd = Printf.sprintf "curl -fsSL '%s' -o '%s'" url devcontainer_json in 1368 1368 + let curl_cmd = 1369 1369 + Printf.sprintf "curl -fsSL '%s' -o '%s'" url devcontainer_json 1370 1370 + in 1264 1371 let ret = Sys.command curl_cmd in 1265 1372 if ret <> 0 then begin 1266 1266 - Fmt.epr "Error: Failed to fetch devcontainer.json (curl exit code %d)@." ret; 1373 1373 + Fmt.epr "Error: Failed to fetch devcontainer.json (curl exit code %d)@." 1374 1374 + ret; 1267 1375 exit 1 1268 1376 end; 1269 1377 Fmt.pr "Created %s@." devcontainer_json; 1270 1378 (* Build and start the devcontainer *) 1271 1379 Fmt.pr "Building devcontainer (this may take a while on first run)...@."; 1272 1272 - let up_cmd = Printf.sprintf "npx @devcontainers/cli up --workspace-folder '%s' --remove-existing-container" abs_path in 1380 1380 + let up_cmd = 1381 1381 + Printf.sprintf 1382 1382 + "npx @devcontainers/cli up --workspace-folder '%s' \ 1383 1383 + --remove-existing-container" 1384 1384 + abs_path 1385 1385 + in 1273 1386 let ret = Sys.command up_cmd in 1274 1387 if ret <> 0 then begin 1275 1388 Fmt.epr "Error: Failed to start devcontainer (exit code %d)@." ret; ··· 1278 1391 end; 1279 1392 (* Exec into the devcontainer *) 1280 1393 Fmt.pr "Entering devcontainer...@."; 1281 1281 - let exec_cmd = Printf.sprintf "npx @devcontainers/cli exec --workspace-folder '%s' bash -l" abs_path in 1394 1394 + let exec_cmd = 1395 1395 + Printf.sprintf 1396 1396 + "npx @devcontainers/cli exec --workspace-folder '%s' bash -l" abs_path 1397 1397 + in 1282 1398 let ret = Sys.command exec_cmd in 1283 1399 if ret <> 0 then 1284 1400 `Error (false, Printf.sprintf "devcontainer exec failed with code %d" ret) 1285 1285 - else 1286 1286 - `Ok () 1401 1401 + else `Ok () 1287 1402 in 1288 1403 Cmd.v info Term.(ret (const run $ path_arg $ url_arg $ logging_term)) 1289 1404 ··· 1316 1431 with the extracted history, then re-adds mono/<name>/ as a subtree."; 1317 1432 `S "FORK MODES"; 1318 1433 `P "The fork command handles two scenarios:"; 1319 1319 - `I ("Subtree with history", "For subtrees added via $(b,git subtree add) or \ 1320 1320 - $(b,monopam join), the command uses $(b,git subtree split) to extract \ 1321 1321 - the full commit history into the new repository."); 1322 1322 - `I ("Fresh package", "For packages created directly in mono/ without subtree \ 1323 1323 - history, the command copies the files and creates an initial commit. \ 1324 1324 - This is useful for new packages you've developed locally."); 1434 1434 + `I 1435 1435 + ( "Subtree with history", 1436 1436 + "For subtrees added via $(b,git subtree add) or $(b,monopam join), \ 1437 1437 + the command uses $(b,git subtree split) to extract the full commit \ 1438 1438 + history into the new repository." ); 1439 1439 + `I 1440 1440 + ( "Fresh package", 1441 1441 + "For packages created directly in mono/ without subtree history, the \ 1442 1442 + command copies the files and creates an initial commit. This is \ 1443 1443 + useful for new packages you've developed locally." ); 1325 1444 `S "WHAT IT DOES"; 1326 1445 `P "The fork command performs a complete workflow in one step:"; 1327 1446 `I ("1.", "Analyzes mono/<name>/ to detect fork mode"); 1328 1447 `I ("2.", "Builds an action plan and shows discovery details"); 1329 1448 `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)"); 1330 1449 `I ("4.", "Creates a new git repo at src/<name>/"); 1331 1331 - `I ("5.", "Extracts history (subtree split) or copies files (fresh package)"); 1450 1450 + `I 1451 1451 + ( "5.", 1452 1452 + "Extracts history (subtree split) or copies files (fresh package)" ); 1332 1453 `I ("6.", "Removes mono/<name>/ from git and commits"); 1333 1454 `I ("7.", "Re-adds mono/<name>/ as a proper subtree from src/<name>/"); 1334 1455 `I ("8.", "Updates sources.toml with $(b,origin = \"fork\")"); ··· 1381 1502 let mono_path = Monopam.Config.mono_path config in 1382 1503 let subtree_path = Fpath.(mono_path / name) in 1383 1504 let knot = Monopam.Config.knot config in 1384 1384 - let suggested = Monopam.Fork_join.suggest_push_url ~fs ~knot subtree_path in 1385 1385 - if yes || dry_run then 1386 1386 - suggested (* Use suggested or None without prompting *) 1505 1505 + let suggested = 1506 1506 + Monopam.Fork_join.suggest_push_url ~fs ~knot subtree_path 1507 1507 + in 1508 1508 + if yes || dry_run then suggested 1509 1509 + (* Use suggested or None without prompting *) 1387 1510 else begin 1388 1511 match suggested with 1389 1389 - | Some default_url -> 1512 1512 + | Some default_url -> ( 1390 1513 Fmt.pr "Remote push URL [%s]: %!" default_url; 1391 1391 - (match prompt_string "" with 1392 1392 - | None -> Some default_url (* User pressed enter, use default *) 1393 1393 - | Some entered -> Some entered) 1514 1514 + match prompt_string "" with 1515 1515 + | None -> Some default_url (* User pressed enter, use default *) 1516 1516 + | Some entered -> Some entered) 1394 1517 | None -> 1395 1518 Fmt.pr "Remote push URL (leave empty to skip): %!"; 1396 1519 prompt_string "" 1397 1520 end 1398 1521 in 1399 1522 (* Build the plan *) 1400 1400 - match Monopam.Fork_join.plan_fork ~proc ~fs ~config ~name ?push_url:url ~dry_run () with 1523 1523 + match 1524 1524 + Monopam.Fork_join.plan_fork ~proc ~fs ~config ~name ?push_url:url ~dry_run 1525 1525 + () 1526 1526 + with 1401 1527 | Error e -> 1402 1528 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1403 1529 `Error (false, "fork failed") ··· 1405 1531 (* Print discovery and actions *) 1406 1532 Fmt.pr "Analyzing fork request for '%s'...@.@." name; 1407 1533 Fmt.pr "Discovery:@.%a@." Monopam.Fork_join.pp_discovery plan.discovery; 1408 1408 - (match url with 1409 1409 - | Some u -> Fmt.pr " Remote URL: %s@." u 1410 1410 - | None -> ()); 1534 1534 + (match url with Some u -> Fmt.pr " Remote URL: %s@." u | None -> ()); 1411 1535 Fmt.pr "@.Actions to perform:@."; 1412 1412 - List.iteri (fun i action -> 1413 1413 - Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action 1414 1414 - ) plan.actions; 1536 1536 + List.iteri 1537 1537 + (fun i action -> 1538 1538 + Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action) 1539 1539 + plan.actions; 1415 1540 Fmt.pr "@."; 1416 1541 (* Prompt for confirmation unless --yes or --dry-run *) 1417 1542 let proceed = 1418 1543 if dry_run then begin 1419 1544 Fmt.pr "(dry-run mode - no changes will be made)@."; 1420 1545 true 1421 1421 - end else if yes then 1422 1422 - true 1423 1423 - else 1424 1424 - confirm "Proceed?" 1546 1546 + end 1547 1547 + else if yes then true 1548 1548 + else confirm "Proceed?" 1425 1549 in 1426 1550 if not proceed then begin 1427 1551 Fmt.pr "Cancelled.@."; 1428 1552 `Ok () 1429 1429 - end else begin 1553 1553 + end 1554 1554 + else begin 1430 1555 (* Execute the plan *) 1431 1556 match Monopam.Fork_join.execute_fork_plan ~proc ~fs plan with 1432 1557 | Ok result -> ··· 1435 1560 Fmt.pr "@.Next steps:@."; 1436 1561 Fmt.pr " 1. Review the new repo: cd src/%s@." result.name; 1437 1562 match url with 1438 1438 - | Some _ -> Fmt.pr " 2. Push to remote: git push -u origin main@." 1439 1439 - | None -> Fmt.pr " 2. Add a remote: git remote add origin <url>@." 1563 1563 + | Some _ -> 1564 1564 + Fmt.pr " 2. Push to remote: git push -u origin main@." 1565 1565 + | None -> 1566 1566 + Fmt.pr " 2. Add a remote: git remote add origin <url>@." 1440 1567 end; 1441 1568 `Ok () 1442 1569 | Error e -> ··· 1444 1571 `Error (false, "fork failed") 1445 1572 end 1446 1573 in 1447 1447 - Cmd.v info Term.(ret (const run $ name_arg $ url_arg $ dry_run_arg $ yes_arg $ logging_term)) 1574 1574 + Cmd.v info 1575 1575 + Term.( 1576 1576 + ret (const run $ name_arg $ url_arg $ dry_run_arg $ yes_arg $ logging_term)) 1448 1577 1449 1578 (* Join command *) 1450 1579 ··· 1459 1588 `S "JOIN MODES"; 1460 1589 `P "The join command handles multiple scenarios:"; 1461 1590 `I ("URL join", "Clone from a git URL and add as subtree (default)."); 1462 1462 - `I ("Local directory join", "Import from a local filesystem path. If the \ 1463 1463 - path is a git repo, uses it directly. If not, initializes a new repo."); 1464 1464 - `I ("Verse join", "Join from a verse member's repository using $(b,--from)."); 1591 1591 + `I 1592 1592 + ( "Local directory join", 1593 1593 + "Import from a local filesystem path. If the path is a git repo, \ 1594 1594 + uses it directly. If not, initializes a new repo." ); 1595 1595 + `I 1596 1596 + ( "Verse join", 1597 1597 + "Join from a verse member's repository using $(b,--from)." ); 1465 1598 `S "WHAT IT DOES"; 1466 1599 `P "The join command:"; 1467 1600 `I ("1.", "Analyzes the source (URL or local path)"); ··· 1472 1605 `I ("6.", "Updates sources.toml with $(b,origin = \"join\")"); 1473 1606 `S "JOINING FROM VERSE"; 1474 1607 `P "To join a package from a verse member, use $(b,--from):"; 1475 1475 - `Pre "monopam join --from avsm.bsky.social --url git@github.com:me/cohttp.git cohttp"; 1608 1608 + `Pre 1609 1609 + "monopam join --from avsm.bsky.social --url \ 1610 1610 + git@github.com:me/cohttp.git cohttp"; 1476 1611 `P "This will:"; 1477 1612 `I ("-", "Look up the package in their opam-repo"); 1478 1613 `I ("-", "Find all packages from the same git repository"); ··· 1493 1628 `P "Join with a custom name using --as:"; 1494 1629 `Pre "monopam join https://github.com/someone/some-lib --as my-lib"; 1495 1630 `P "Join with upstream tracking (for forks):"; 1496 1496 - `Pre "monopam join https://github.com/me/cohttp --upstream https://github.com/mirage/cohttp"; 1631 1631 + `Pre 1632 1632 + "monopam join https://github.com/me/cohttp --upstream \ 1633 1633 + https://github.com/mirage/cohttp"; 1497 1634 `P "Join from a verse member:"; 1498 1498 - `Pre "monopam join cohttp --from avsm.bsky.social --url git@github.com:me/cohttp.git"; 1635 1635 + `Pre 1636 1636 + "monopam join cohttp --from avsm.bsky.social --url \ 1637 1637 + git@github.com:me/cohttp.git"; 1499 1638 `P "Preview what would be done:"; 1500 1639 `Pre "monopam join https://github.com/someone/lib --dry-run"; 1501 1640 `P "Join without confirmation:"; ··· 1537 1676 let fs = Eio.Stdenv.fs env in 1538 1677 let proc = Eio.Stdenv.process_mgr env in 1539 1678 match from with 1540 1540 - | Some handle -> 1679 1679 + | Some handle -> ( 1541 1680 (* Join from verse member - requires --url for your fork *) 1542 1681 (* Uses legacy API as it involves verse-specific operations *) 1543 1543 - (match fork_url with 1544 1544 - | None -> 1545 1545 - Fmt.epr "Error: --url is required when using --from@."; 1546 1546 - `Error (false, "--url required") 1547 1547 - | Some fork_url -> 1548 1548 - match Monopam.Fork_join.join_from_verse ~proc ~fs ~config ~verse_config:config 1549 1549 - ~package:url_or_pkg ~handle ~fork_url ~dry_run () with 1550 1550 - | Ok result -> 1551 1551 - if dry_run then begin 1552 1552 - Fmt.pr "Would join '%s' from %s:@." result.name (Option.value ~default:"verse" result.from_handle); 1553 1553 - Fmt.pr " Source: %s@." result.source_url; 1554 1554 - Option.iter (fun u -> Fmt.pr " Upstream: %s@." u) result.upstream_url; 1555 1555 - Fmt.pr " Packages: %a@." Fmt.(list ~sep:(any ", ") string) result.packages_added 1556 1556 - end else begin 1557 1557 - Fmt.pr "%a@." Monopam.Fork_join.pp_join_result result; 1558 1558 - Fmt.pr "@.Next steps:@."; 1559 1559 - Fmt.pr " 1. Commit the opam changes: cd opam-repo && git add -A && git commit@."; 1560 1560 - Fmt.pr " 2. Run $(b,monopam sync) to synchronize@." 1561 1561 - end; 1562 1562 - `Ok () 1563 1563 - | Error e -> 1564 1564 - Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1565 1565 - `Error (false, "join failed")) 1566 1566 - | None -> 1682 1682 + match fork_url with 1683 1683 + | None -> 1684 1684 + Fmt.epr "Error: --url is required when using --from@."; 1685 1685 + `Error (false, "--url required") 1686 1686 + | Some fork_url -> ( 1687 1687 + match 1688 1688 + Monopam.Fork_join.join_from_verse ~proc ~fs ~config 1689 1689 + ~verse_config:config ~package:url_or_pkg ~handle ~fork_url 1690 1690 + ~dry_run () 1691 1691 + with 1692 1692 + | Ok result -> 1693 1693 + if dry_run then begin 1694 1694 + Fmt.pr "Would join '%s' from %s:@." result.name 1695 1695 + (Option.value ~default:"verse" result.from_handle); 1696 1696 + Fmt.pr " Source: %s@." result.source_url; 1697 1697 + Option.iter 1698 1698 + (fun u -> Fmt.pr " Upstream: %s@." u) 1699 1699 + result.upstream_url; 1700 1700 + Fmt.pr " Packages: %a@." 1701 1701 + Fmt.(list ~sep:(any ", ") string) 1702 1702 + result.packages_added 1703 1703 + end 1704 1704 + else begin 1705 1705 + Fmt.pr "%a@." Monopam.Fork_join.pp_join_result result; 1706 1706 + Fmt.pr "@.Next steps:@."; 1707 1707 + Fmt.pr 1708 1708 + " 1. Commit the opam changes: cd opam-repo && git add -A \ 1709 1709 + && git commit@."; 1710 1710 + Fmt.pr " 2. Run $(b,monopam sync) to synchronize@." 1711 1711 + end; 1712 1712 + `Ok () 1713 1713 + | Error e -> 1714 1714 + Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1715 1715 + `Error (false, "join failed"))) 1716 1716 + | None -> ( 1567 1717 (* Normal join from URL or local path - use plan-based workflow *) 1568 1718 let source = match fork_url with Some u -> u | None -> url_or_pkg in 1569 1569 - let name = match fork_url with Some _ -> Some url_or_pkg | None -> as_name in 1719 1719 + let name = 1720 1720 + match fork_url with Some _ -> Some url_or_pkg | None -> as_name 1721 1721 + in 1570 1722 (* Build the plan *) 1571 1571 - match Monopam.Fork_join.plan_join ~proc ~fs ~config ~source ?name ?upstream ~dry_run () with 1723 1723 + match 1724 1724 + Monopam.Fork_join.plan_join ~proc ~fs ~config ~source ?name ?upstream 1725 1725 + ~dry_run () 1726 1726 + with 1572 1727 | Error e -> 1573 1728 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1574 1729 `Error (false, "join failed") ··· 1581 1736 (if is_local then "local directory" else "remote URL"); 1582 1737 Fmt.pr "%a" Monopam.Fork_join.pp_discovery plan.discovery; 1583 1738 Fmt.pr "@.Actions to perform:@."; 1584 1584 - List.iteri (fun i action -> 1585 1585 - Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action 1586 1586 - ) plan.actions; 1739 1739 + List.iteri 1740 1740 + (fun i action -> 1741 1741 + Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action) 1742 1742 + plan.actions; 1587 1743 Fmt.pr "@."; 1588 1744 (* Prompt for confirmation unless --yes or --dry-run *) 1589 1745 let proceed = 1590 1746 if dry_run then begin 1591 1747 Fmt.pr "(dry-run mode - no changes will be made)@."; 1592 1748 true 1593 1593 - end else if yes then 1594 1594 - true 1595 1595 - else 1596 1596 - confirm "Proceed?" 1749 1749 + end 1750 1750 + else if yes then true 1751 1751 + else confirm "Proceed?" 1597 1752 in 1598 1753 if not proceed then begin 1599 1754 Fmt.pr "Cancelled.@."; 1600 1755 `Ok () 1601 1601 - end else begin 1756 1756 + end 1757 1757 + else begin 1602 1758 (* Execute the plan *) 1603 1759 match Monopam.Fork_join.execute_join_plan ~proc ~fs plan with 1604 1760 | Ok result -> ··· 1611 1767 | Error e -> 1612 1768 Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1613 1769 `Error (false, "join failed") 1614 1614 - end 1770 1770 + end) 1615 1771 in 1616 1616 - Cmd.v info Term.(ret (const run $ url_or_pkg_arg $ as_arg $ upstream_arg $ from_arg $ fork_url_arg $ dry_run_arg $ yes_arg $ logging_term)) 1772 1772 + Cmd.v info 1773 1773 + Term.( 1774 1774 + ret 1775 1775 + (const run $ url_or_pkg_arg $ as_arg $ upstream_arg $ from_arg 1776 1776 + $ fork_url_arg $ dry_run_arg $ yes_arg $ logging_term)) 1617 1777 1618 1778 (* Rejoin command *) 1619 1779 ··· 1641 1801 `I ("1.", "Verifies src/<name>/ exists and is a git repo"); 1642 1802 `I ("2.", "Verifies mono/<name>/ does not exist"); 1643 1803 `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)"); 1644 1644 - `I ("4.", "Uses $(b,git subtree add) to bring src/<name>/ into mono/<name>/"); 1804 1804 + `I 1805 1805 + ( "4.", 1806 1806 + "Uses $(b,git subtree add) to bring src/<name>/ into mono/<name>/" ); 1645 1807 `S Manpage.s_examples; 1646 1808 `P "Re-add a package from src/:"; 1647 1809 `Pre "monopam rejoin my-lib"; ··· 1679 1841 Fmt.pr "Analyzing rejoin request for '%s'...@.@." name; 1680 1842 Fmt.pr "Discovery:@.%a@." Monopam.Fork_join.pp_discovery plan.discovery; 1681 1843 Fmt.pr "@.Actions to perform:@."; 1682 1682 - List.iteri (fun i action -> 1683 1683 - Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action 1684 1684 - ) plan.actions; 1844 1844 + List.iteri 1845 1845 + (fun i action -> 1846 1846 + Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action) 1847 1847 + plan.actions; 1685 1848 Fmt.pr "@."; 1686 1849 (* Prompt for confirmation unless --yes or --dry-run *) 1687 1850 let proceed = 1688 1851 if dry_run then begin 1689 1852 Fmt.pr "(dry-run mode - no changes will be made)@."; 1690 1853 true 1691 1691 - end else if yes then 1692 1692 - true 1693 1693 - else 1694 1694 - confirm "Proceed?" 1854 1854 + end 1855 1855 + else if yes then true 1856 1856 + else confirm "Proceed?" 1695 1857 in 1696 1858 if not proceed then begin 1697 1859 Fmt.pr "Cancelled.@."; 1698 1860 `Ok () 1699 1699 - end else begin 1861 1861 + end 1862 1862 + else begin 1700 1863 (* Execute the plan *) 1701 1864 match Monopam.Fork_join.execute_join_plan ~proc ~fs plan with 1702 1865 | Ok result -> ··· 1712 1875 `Error (false, "rejoin failed") 1713 1876 end 1714 1877 in 1715 1715 - Cmd.v info Term.(ret (const run $ name_arg $ dry_run_arg $ yes_arg $ logging_term)) 1878 1878 + Cmd.v info 1879 1879 + Term.(ret (const run $ name_arg $ dry_run_arg $ yes_arg $ logging_term)) 1716 1880 1717 1881 (* Site command *) 1718 1882 ··· 1722 1886 [ 1723 1887 `S Manpage.s_description; 1724 1888 `P 1725 1725 - "Generates a static index.html file that maps the monoverse, showing all \ 1726 1726 - verse members, their packages, and the relationships between them."; 1889 1889 + "Generates a static index.html file that maps the monoverse, showing \ 1890 1890 + all verse members, their packages, and the relationships between \ 1891 1891 + them."; 1727 1892 `S "OUTPUT"; 1728 1893 `P "The generated site includes:"; 1729 1729 - `I ("Members", "All verse members with links to their monorepo and opam repos"); 1894 1894 + `I 1895 1895 + ( "Members", 1896 1896 + "All verse members with links to their monorepo and opam repos" ); 1730 1897 `I ("Summary", "Overview of common libraries and member-specific packages"); 1731 1898 `I ("Repository Details", "Each shared repo with packages and fork status"); 1732 1899 `S "FORK STATUS"; ··· 1754 1921 let info = Cmd.info "site" ~doc ~man in 1755 1922 let output_arg = 1756 1923 let doc = "Output file path. Defaults to mono/index.html." in 1757 1757 - Arg.(value & opt (some string) None & info [ "o"; "output" ] ~docv:"FILE" ~doc) 1924 1924 + Arg.( 1925 1925 + value & opt (some string) None & info [ "o"; "output" ] ~docv:"FILE" ~doc) 1758 1926 in 1759 1927 let stdout_arg = 1760 1928 let doc = "Print HTML to stdout instead of writing to file." in 1761 1929 Arg.(value & flag & info [ "stdout" ] ~doc) 1762 1930 in 1763 1931 let status_arg = 1764 1764 - let doc = "Include fork status (ahead/behind) for each repository. \ 1765 1765 - This fetches from remotes and may be slower." in 1932 1932 + let doc = 1933 1933 + "Include fork status (ahead/behind) for each repository. This fetches \ 1934 1934 + from remotes and may be slower." 1935 1935 + in 1766 1936 Arg.(value & flag & info [ "status"; "s" ] ~doc) 1767 1937 in 1768 1938 let run output to_stdout with_status () = ··· 1774 1944 (* Pull/clone registry to get latest metadata *) 1775 1945 Fmt.pr "Syncing registry...@."; 1776 1946 let registry = 1777 1777 - match Monopam.Verse_registry.clone_or_pull ~proc ~fs:(fs :> _ Eio.Path.t) ~config:verse_config () with 1947 1947 + match 1948 1948 + Monopam.Verse_registry.clone_or_pull ~proc 1949 1949 + ~fs:(fs :> _ Eio.Path.t) 1950 1950 + ~config:verse_config () 1951 1951 + with 1778 1952 | Ok r -> r 1779 1953 | Error msg -> 1780 1954 Fmt.epr "Warning: Could not sync registry: %s@." msg; 1781 1781 - Monopam.Verse_registry.{ name = "opamverse"; description = None; members = [] } 1955 1955 + Monopam.Verse_registry. 1956 1956 + { name = "opamverse"; description = None; members = [] } 1782 1957 in 1783 1958 (* Compute forks if --status is requested *) 1784 1959 let forks = 1785 1960 if with_status then begin 1786 1961 Fmt.pr "Computing fork status...@."; 1787 1787 - Some (Monopam.Forks.compute ~proc ~fs:(fs :> _ Eio.Path.t) 1788 1788 - ~verse_config ~monopam_config ()) 1789 1789 - end else None 1962 1962 + Some 1963 1963 + (Monopam.Forks.compute ~proc 1964 1964 + ~fs:(fs :> _ Eio.Path.t) 1965 1965 + ~verse_config ~monopam_config ()) 1966 1966 + end 1967 1967 + else None 1790 1968 in 1791 1969 if to_stdout then begin 1792 1792 - let html = Monopam.Site.generate ~fs:(fs :> _ Eio.Path.t) ~config:verse_config ?forks ~registry () in 1970 1970 + let html = 1971 1971 + Monopam.Site.generate 1972 1972 + ~fs:(fs :> _ Eio.Path.t) 1973 1973 + ~config:verse_config ?forks ~registry () 1974 1974 + in 1793 1975 print_string html; 1794 1976 `Ok () 1795 1795 - end else begin 1977 1977 + end 1978 1978 + else begin 1796 1979 let output_path = 1797 1980 match output with 1798 1981 | Some p -> ( 1799 1982 match Fpath.of_string p with 1800 1983 | Ok fp -> fp 1801 1984 | Error (`Msg _) -> Fpath.v p) 1802 1802 - | None -> Fpath.(Monopam.Verse_config.mono_path verse_config / "index.html") 1985 1985 + | None -> 1986 1986 + Fpath.(Monopam.Verse_config.mono_path verse_config / "index.html") 1803 1987 in 1804 1804 - match Monopam.Site.write ~fs:(fs :> _ Eio.Path.t) ~config:verse_config ?forks ~registry ~output_path () with 1988 1988 + match 1989 1989 + Monopam.Site.write 1990 1990 + ~fs:(fs :> _ Eio.Path.t) 1991 1991 + ~config:verse_config ?forks ~registry ~output_path () 1992 1992 + with 1805 1993 | Ok () -> 1806 1994 Fmt.pr "Site generated: %a@." Fpath.pp output_path; 1807 1995 `Ok () ··· 1810 1998 `Error (false, "site generation failed") 1811 1999 end 1812 2000 in 1813 1813 - Cmd.v info Term.(ret (const run $ output_arg $ stdout_arg $ status_arg $ logging_term)) 2001 2001 + Cmd.v info 2002 2002 + Term.(ret (const run $ output_arg $ stdout_arg $ status_arg $ logging_term)) 1814 2003 1815 2004 (* Main command group *) 1816 2005 ··· 1828 2017 pre-installed."; 1829 2018 `S "QUICK START"; 1830 2019 `P "Start by creating a devcontainer workspace:"; 1831 1831 - `Pre 1832 1832 - "monopam devcontainer ~/tangled"; 2020 2020 + `Pre "monopam devcontainer ~/tangled"; 1833 2021 `P "Inside the devcontainer, initialize your workspace:"; 1834 1834 - `Pre 1835 1835 - "cd ~/tangled\n\ 1836 1836 - monopam init --handle yourname.bsky.social\n\ 1837 1837 - cd mono"; 2022 2022 + `Pre "cd ~/tangled\nmonopam init --handle yourname.bsky.social\ncd mono"; 1838 2023 `P "Daily workflow:"; 1839 2024 `Pre 1840 2025 "cd ~/tangled/mono\n\ ··· 1913 2098 in 1914 2099 let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in 1915 2100 Cmd.group info 1916 1916 - [ init_cmd; status_cmd; diff_cmd; pull_cmd; cherrypick_cmd; sync_cmd; changes_cmd; opam_cmd; doctor_cmd; verse_cmd; feature_cmd; fork_cmd; join_cmd; rejoin_cmd; devcontainer_cmd; site_cmd ] 2101 2101 + [ 2102 2102 + init_cmd; 2103 2103 + status_cmd; 2104 2104 + diff_cmd; 2105 2105 + pull_cmd; 2106 2106 + cherrypick_cmd; 2107 2107 + sync_cmd; 2108 2108 + changes_cmd; 2109 2109 + opam_cmd; 2110 2110 + doctor_cmd; 2111 2111 + verse_cmd; 2112 2112 + feature_cmd; 2113 2113 + fork_cmd; 2114 2114 + join_cmd; 2115 2115 + rejoin_cmd; 2116 2116 + devcontainer_cmd; 2117 2117 + site_cmd; 2118 2118 + ] 1917 2119 1918 2120 let () = exit (Cmd.eval main_cmd)

+35 -22

lib/config.ml

reviewed

··· 1 1 (** Unified configuration for monopam. 2 2 3 3 - Configuration is stored in TOML format at ~/.config/monopam/opamverse.toml *) 3 3 + Configuration is stored in TOML format at ~/.config/monopam/opamverse.toml 4 4 + *) 4 5 5 6 let app_name = "monopam" 6 7 ··· 22 23 (** {1 Paths Configuration} *) 23 24 24 25 type paths = { 25 25 - mono : string; (** Monorepo directory (default: "mono") *) 26 26 - src : string; (** Source checkouts directory (default: "src") *) 26 26 + mono : string; (** Monorepo directory (default: "mono") *) 27 27 + src : string; (** Source checkouts directory (default: "src") *) 27 28 verse : string; (** Verse directory (default: "verse") *) 28 29 } 29 30 ··· 86 87 let xdg_cache_home () = 87 88 match Sys.getenv_opt "XDG_CACHE_HOME" with 88 89 | Some dir when dir <> "" -> Fpath.v dir 89 89 - | _ -> 90 90 + | _ -> ( 90 91 match Sys.getenv_opt "HOME" with 91 92 | Some home -> Fpath.(v home / ".cache") 92 92 - | None -> Fpath.v "/tmp" 93 93 + | None -> Fpath.v "/tmp") 93 94 94 95 let config_dir () = Fpath.(xdg_config_home () / app_name) 95 96 let data_dir () = Fpath.(xdg_data_home () / app_name) ··· 99 100 100 101 (** {1 Construction} *) 101 102 102 102 - (** Derive knot (git push server) from handle. 103 103 - E.g., "anil.recoil.org" -> "git.recoil.org" *) 103 103 + (** Derive knot (git push server) from handle. E.g., "anil.recoil.org" -> 104 104 + "git.recoil.org" *) 104 105 let default_knot_from_handle handle = 105 106 match String.index_opt handle '.' with 106 107 | None -> "git." ^ handle (* fallback *) ··· 109 110 "git." ^ domain 110 111 111 112 let create ~root ~handle ?knot ?(packages = []) ?(paths = default_paths) () = 112 112 - let knot = match knot with Some k -> k | None -> default_knot_from_handle handle in 113 113 + let knot = 114 114 + match knot with Some k -> k | None -> default_knot_from_handle handle 115 115 + in 113 116 { root; handle; knot; packages; paths } 114 117 115 118 let with_package_override t ~name ?branch:branch_opt () = ··· 145 148 Tomlt.( 146 149 Table.( 147 150 obj (fun mono src verse -> 148 148 - { mono = Option.value ~default:default_paths.mono mono; 149 149 - src = Option.value ~default:default_paths.src src; 150 150 - verse = Option.value ~default:default_paths.verse verse }) 151 151 + { 152 152 + mono = Option.value ~default:default_paths.mono mono; 153 153 + src = Option.value ~default:default_paths.src src; 154 154 + verse = Option.value ~default:default_paths.verse verse; 155 155 + }) 151 156 |> opt_mem "mono" string ~enc:(fun p -> Some p.mono) 152 157 |> opt_mem "src" string ~enc:(fun p -> Some p.src) 153 158 |> opt_mem "verse" string ~enc:(fun p -> Some p.verse) ··· 194 199 Tomlt.( 195 200 Table.( 196 201 obj (fun pkgs -> pkgs) 197 197 - |> keep_unknown ~enc:(fun pkgs -> pkgs) 198 198 - (Mems.assoc Package_config.codec) 202 202 + |> keep_unknown ~enc:(fun pkgs -> pkgs) (Mems.assoc Package_config.codec) 199 203 |> finish)) 200 204 201 205 let codec : t Tomlt.t = ··· 205 209 let packages = Option.value ~default:[] packages in 206 210 let paths = Option.value ~default:default_paths paths in 207 211 let knot = Option.value ~default:default_knot identity.i_knot in 208 208 - { root = workspace.w_root; handle = identity.i_handle; knot; packages; paths }) 212 212 + { 213 213 + root = workspace.w_root; 214 214 + handle = identity.i_handle; 215 215 + knot; 216 216 + packages; 217 217 + paths; 218 218 + }) 209 219 |> mem "workspace" workspace_codec ~enc:(fun t -> { w_root = t.root }) 210 210 - |> mem "identity" identity_codec ~enc:(fun t -> { i_handle = t.handle; i_knot = Some t.knot }) 211 211 - |> opt_mem "packages" packages_table_codec 212 212 - ~enc:(fun t -> if t.packages = [] then None else Some t.packages) 213 213 - |> opt_mem "paths" paths_codec 214 214 - ~enc:(fun t -> if t.paths = default_paths then None else Some t.paths) 220 220 + |> mem "identity" identity_codec ~enc:(fun t -> 221 221 + { i_handle = t.handle; i_knot = Some t.knot }) 222 222 + |> opt_mem "packages" packages_table_codec ~enc:(fun t -> 223 223 + if t.packages = [] then None else Some t.packages) 224 224 + |> opt_mem "paths" paths_codec ~enc:(fun t -> 225 225 + if t.paths = default_paths then None else Some t.paths) 215 226 |> finish)) 216 227 217 228 (** {1 Validation} *) ··· 250 261 | `Regular_file -> ( 251 262 try Ok (Tomlt_eio.decode_path_exn codec ~fs path_str) with 252 263 | Failure msg -> Error (Printf.sprintf "Invalid config: %s" msg) 253 253 - | exn -> Error (Printf.sprintf "Error loading config: %s" (Printexc.to_string exn))) 264 264 + | exn -> 265 265 + Error 266 266 + (Printf.sprintf "Error loading config: %s" (Printexc.to_string exn)) 267 267 + ) 254 268 | _ -> Error (Printf.sprintf "Config file not found: %s" path_str) 255 269 | exception _ -> Error (Printf.sprintf "Config file not found: %s" path_str) 256 270 ··· 273 287 @[<hov 2>identity:@ handle=%s@ knot=%s@]@,\ 274 288 @[<hov 2>paths:@ mono=%s@ src=%s@ verse=%s@]@,\ 275 289 packages=%d@]" 276 276 - Fpath.pp t.root t.handle t.knot 277 277 - t.paths.mono t.paths.src t.paths.verse 290 290 + Fpath.pp t.root t.handle t.knot t.paths.mono t.paths.src t.paths.verse 278 291 (List.length t.packages)

+13 -11

lib/config.mli

reviewed

··· 1 1 (** Unified configuration for monopam. 2 2 3 3 - Configuration is stored in TOML format at [~/.config/monopam/opamverse.toml]. 3 3 + Configuration is stored in TOML format at 4 4 + [~/.config/monopam/opamverse.toml]. 4 5 5 6 The config stores: 6 7 - Workspace root and custom paths ··· 24 25 (** [branch t] returns the branch override for this package, if set. *) 25 26 end 26 27 28 28 + type paths = { 29 29 + mono : string; (** Monorepo directory (default: "mono") *) 30 30 + src : string; (** Source checkouts directory (default: "src") *) 31 31 + verse : string; (** Verse directory (default: "verse") *) 32 32 + } 27 33 (** Configurable paths within the workspace. 28 34 29 35 By default, paths are: ··· 32 38 - [verse = "verse"] - verse directory 33 39 34 40 Set [mono = "."] to have packages at the root level. *) 35 35 - type paths = { 36 36 - mono : string; (** Monorepo directory (default: "mono") *) 37 37 - src : string; (** Source checkouts directory (default: "src") *) 38 38 - verse : string; (** Verse directory (default: "verse") *) 39 39 - } 40 41 41 42 val default_paths : paths 42 43 (** Default paths configuration. *) ··· 53 54 (** [handle t] returns the user's handle. *) 54 55 55 56 val knot : t -> string 56 56 - (** [knot t] returns the git push server hostname (e.g., "git.recoil.org"). 57 57 - Used for converting tangled URLs to SSH push URLs. *) 57 57 + (** [knot t] returns the git push server hostname (e.g., "git.recoil.org"). Used 58 58 + for converting tangled URLs to SSH push URLs. *) 58 59 59 60 val paths : t -> paths 60 61 (** [paths t] returns the paths configuration. *) ··· 129 130 ?paths:paths -> 130 131 unit -> 131 132 t 132 132 - (** [create ~root ~handle ?knot ?packages ?paths ()] creates a new configuration. 133 133 + (** [create ~root ~handle ?knot ?packages ?paths ()] creates a new 134 134 + configuration. 133 135 134 136 @param root Workspace root directory (absolute path) 135 137 @param handle User's handle ··· 138 140 @param paths Optional custom paths configuration *) 139 141 140 142 val with_package_override : t -> name:string -> ?branch:string -> unit -> t 141 141 - (** [with_package_override t ~name ?branch ()] returns a new config 142 142 - with overrides for the named package. *) 143 143 + (** [with_package_override t ~name ?branch ()] returns a new config with 144 144 + overrides for the named package. *) 143 145 144 146 (** {1 Validation} *) 145 147

+1 -4

lib/doctor.ml

reviewed

··· 1132 1132 (** Health status for cron-job style exit codes *) 1133 1133 type health = Healthy | Warning | Critical 1134 1134 1135 1135 - let health_to_exit_code = function 1136 1136 - | Healthy -> 0 1137 1137 - | Warning -> 1 1138 1138 - | Critical -> 2 1135 1135 + let health_to_exit_code = function Healthy -> 0 | Warning -> 1 | Critical -> 2 1139 1136 1140 1137 (** Compute overall health status from a report. 1141 1138 - Critical: has critical/high priority issues or warnings

+14 -19

lib/dune_project.ml

reviewed

··· 3 3 type source_info = 4 4 | Github of { user : string; repo : string } 5 5 | Gitlab of { user : string; repo : string } 6 6 - | Tangled of { host : string; repo : string } (** tangled.org style sources *) 6 6 + | Tangled of { host : string; repo : string } 7 7 + (** tangled.org style sources *) 7 8 | Uri of { url : string; branch : string option } 8 9 9 10 type t = { ··· 16 17 module Sexp = Sexplib0.Sexp 17 18 18 19 (** Extract string from a Sexp.Atom, or None if it's a List *) 19 19 - let atom_string = function 20 20 - | Sexp.Atom s -> Some s 21 21 - | Sexp.List _ -> None 20 20 + let atom_string = function Sexp.Atom s -> Some s | Sexp.List _ -> None 22 21 23 22 (** Parse source stanza: (source (github user/repo)) or (source (uri "url")) *) 24 23 let parse_source_inner sexp = ··· 36 35 match String.index_opt host_repo '/' with 37 36 | Some i -> 38 37 let host = String.sub host_repo 0 i in 39 39 - let repo = String.sub host_repo (i + 1) (String.length host_repo - i - 1) in 38 38 + let repo = 39 39 + String.sub host_repo (i + 1) (String.length host_repo - i - 1) 40 40 + in 40 41 Some (Tangled { host; repo }) 41 42 | None -> None) 42 43 | Sexp.List [ Sexp.Atom "uri"; Sexp.Atom url ] -> 43 44 (* Check for branch in URI fragment *) 44 45 let uri = Uri.of_string url in 45 46 let branch = Uri.fragment uri in 46 46 - let url_without_fragment = 47 47 - Uri.with_fragment uri None |> Uri.to_string 48 48 - in 47 47 + let url_without_fragment = Uri.with_fragment uri None |> Uri.to_string in 49 48 Some (Uri { url = url_without_fragment; branch }) 50 49 | Sexp.Atom url -> 51 50 (* Single atom URL (unlikely but handle it) *) 52 51 let uri = Uri.of_string url in 53 52 let branch = Uri.fragment uri in 54 54 - let url_without_fragment = 55 55 - Uri.with_fragment uri None |> Uri.to_string 56 56 - in 53 53 + let url_without_fragment = Uri.with_fragment uri None |> Uri.to_string in 57 54 Some (Uri { url = url_without_fragment; branch }) 58 55 | _ -> None 59 56 ··· 90 87 let parse content = 91 88 match Parsexp.Many.parse_string content with 92 89 | Error err -> 93 93 - Error (Printf.sprintf "S-expression parse error: %s" 94 94 - (Parsexp.Parse_error.message err)) 90 90 + Error 91 91 + (Printf.sprintf "S-expression parse error: %s" 92 92 + (Parsexp.Parse_error.message err)) 95 93 | Ok sexps -> ( 96 94 match find_string_field "name" sexps with 97 95 | None -> Error "dune-project missing (name ...) stanza" ··· 112 110 113 111 (** Ensure URL ends with .git *) 114 112 let ensure_git_suffix url = 115 115 - if String.ends_with ~suffix:".git" url then url 116 116 - else url ^ ".git" 113 113 + if String.ends_with ~suffix:".git" url then url else url ^ ".git" 117 114 118 115 let dev_repo_url t = 119 116 match t.source with ··· 124 121 | Some (Tangled { host; repo }) -> 125 122 (* Tangled sources: https://tangled.sh/@handle/repo *) 126 123 Ok (Printf.sprintf "git+https://tangled.sh/@%s/%s.git" host repo) 127 127 - | Some (Uri { url; _ }) -> 128 128 - Ok (normalize_git_url (ensure_git_suffix url)) 124 124 + | Some (Uri { url; _ }) -> Ok (normalize_git_url (ensure_git_suffix url)) 129 125 | None -> ( 130 126 match t.homepage with 131 131 - | Some homepage -> 132 132 - Ok (normalize_git_url (ensure_git_suffix homepage)) 127 127 + | Some homepage -> Ok (normalize_git_url (ensure_git_suffix homepage)) 133 128 | None -> 134 129 Error 135 130 (Printf.sprintf

+7 -6

lib/dune_project.mli

reviewed

··· 1 1 (** Dune project file parsing. 2 2 3 3 - Parse dune-project s-expressions to extract package metadata needed 4 4 - for generating opam-repo entries. *) 3 3 + Parse dune-project s-expressions to extract package metadata needed for 4 4 + generating opam-repo entries. *) 5 5 6 6 (** Source information from dune-project. *) 7 7 type source_info = ··· 10 10 | Tangled of { host : string; repo : string } (** tangled.sh style sources *) 11 11 | Uri of { url : string; branch : string option } 12 12 13 13 - (** Parsed dune-project file. *) 14 13 type t = { 15 14 name : string; (** Project name from (name ...) stanza *) 16 15 source : source_info option; (** Source from (source ...) stanza *) 17 16 homepage : string option; (** Homepage from (homepage ...) stanza *) 18 17 packages : string list; (** Package names from (package (name ...)) stanzas *) 19 18 } 19 19 + (** Parsed dune-project file. *) 20 20 21 21 val parse : string -> (t, string) result 22 22 (** [parse content] parses a dune-project file content and extracts metadata. ··· 24 24 25 25 val dev_repo_url : t -> (string, string) result 26 26 (** [dev_repo_url t] derives the dev-repo URL from the parsed dune-project. 27 27 - Returns a URL suitable for the opam dev-repo field (e.g., "git+https://..."). 27 27 + Returns a URL suitable for the opam dev-repo field (e.g., 28 28 + "git+https://..."). 28 29 29 30 URL derivation logic: 30 31 - [Github {user; repo}] -> "git+https://github.com/user/repo.git" ··· 34 35 - Neither source nor homepage -> Error *) 35 36 36 37 val url_with_branch : t -> (string, string) result 37 37 - (** [url_with_branch t] derives the URL with branch fragment for the opam url section. 38 38 - Returns a URL with #branch suffix (e.g., "git+https://...#main"). 38 38 + (** [url_with_branch t] derives the URL with branch fragment for the opam url 39 39 + section. Returns a URL with #branch suffix (e.g., "git+https://...#main"). 39 40 40 41 Branch derivation: 41 42 - [Uri {url; branch = Some b}] -> url#b

+26 -20

lib/feature.ml

reviewed

··· 13 13 let error_hint = function 14 14 | Git_error _ -> Some "Check that the monorepo is properly initialized" 15 15 | Feature_exists name -> 16 16 - Some (Printf.sprintf "Run 'monopam feature remove %s' first if you want to recreate it" name) 16 16 + Some 17 17 + (Printf.sprintf 18 18 + "Run 'monopam feature remove %s' first if you want to recreate it" 19 19 + name) 17 20 | Feature_not_found name -> 18 18 - Some (Printf.sprintf "Run 'monopam feature list' to see available features, or 'monopam feature add %s' to create it" name) 19 19 - | Config_error _ -> Some "Run 'monopam init' to create a workspace configuration" 21 21 + Some 22 22 + (Printf.sprintf 23 23 + "Run 'monopam feature list' to see available features, or 'monopam \ 24 24 + feature add %s' to create it" 25 25 + name) 26 26 + | Config_error _ -> 27 27 + Some "Run 'monopam init' to create a workspace configuration" 20 28 21 29 let pp_error_with_hint ppf e = 22 30 pp_error ppf e; ··· 24 32 | Some hint -> Fmt.pf ppf "@.Hint: %s" hint 25 33 | None -> () 26 34 27 27 - type entry = { 28 28 - name : string; 29 29 - path : Fpath.t; 30 30 - branch : string; 31 31 - } 35 35 + type entry = { name : string; path : Fpath.t; branch : string } 32 36 33 37 let pp_entry ppf e = 34 38 Fmt.pf ppf "%s -> %a (branch: %s)" e.name Fpath.pp e.path e.branch ··· 51 55 let work_eio = Eio.Path.(fs / Fpath.to_string work_dir) in 52 56 (try Eio.Path.mkdirs ~perm:0o755 work_eio with Eio.Io _ -> ()); 53 57 (* Create the worktree with a new branch *) 54 54 - match Git.Worktree.add ~proc ~fs ~repo:mono ~path:wt_path ~branch:name () with 58 58 + match 59 59 + Git.Worktree.add ~proc ~fs ~repo:mono ~path:wt_path ~branch:name () 60 60 + with 55 61 | Error e -> Error (Git_error e) 56 62 | Ok () -> Ok { name; path = wt_path; branch = name } 57 63 end ··· 72 78 let work_dir = work_path config in 73 79 let all_worktrees = Git.Worktree.list ~proc ~fs mono in 74 80 (* Filter to only worktrees under work/ directory *) 75 75 - List.filter_map (fun (wt : Git.Worktree.entry) -> 76 76 - (* Check if this worktree is under the work directory *) 77 77 - let wt_str = Fpath.to_string wt.path in 78 78 - let work_str = Fpath.to_string work_dir in 79 79 - if String.starts_with ~prefix:work_str wt_str then 80 80 - let name = Fpath.basename wt.path in 81 81 - let branch = Option.value ~default:name wt.branch in 82 82 - Some { name; path = wt.path; branch } 83 83 - else 84 84 - None 85 85 - ) all_worktrees 81 81 + List.filter_map 82 82 + (fun (wt : Git.Worktree.entry) -> 83 83 + (* Check if this worktree is under the work directory *) 84 84 + let wt_str = Fpath.to_string wt.path in 85 85 + let work_str = Fpath.to_string work_dir in 86 86 + if String.starts_with ~prefix:work_str wt_str then 87 87 + let name = Fpath.basename wt.path in 88 88 + let branch = Option.value ~default:name wt.branch in 89 89 + Some { name; path = wt.path; branch } 90 90 + else None) 91 91 + all_worktrees

+1 -1

lib/feature.mli

reviewed

··· 18 18 val pp_error_with_hint : error Fmt.t 19 19 (** [pp_error_with_hint] formats errors with a helpful hint. *) 20 20 21 21 - (** A feature worktree entry. *) 22 21 type entry = { 23 22 name : string; (** Feature name *) 24 23 path : Fpath.t; (** Path to the worktree *) 25 24 branch : string; (** Branch name *) 26 25 } 26 26 + (** A feature worktree entry. *) 27 27 28 28 val pp_entry : entry Fmt.t 29 29 (** [pp_entry] formats a feature entry. *)

+540 -344

lib/fork_join.ml

reviewed

··· 18 18 | Check_remote_exists of string (** URL - informational check *) 19 19 | Create_directory of Fpath.t 20 20 | Git_init of Fpath.t 21 21 - | Git_config of { repo: Fpath.t; key: string; value: string } (** Set git config *) 22 22 - | Git_clone of { url: string; dest: Fpath.t; branch: string } 23 23 - | Git_subtree_split of { repo: Fpath.t; prefix: string } 24 24 - | Git_subtree_add of { repo: Fpath.t; prefix: string; url: Uri.t; branch: string } 25 25 - | Git_add_remote of { repo: Fpath.t; name: string; url: string } 26 26 - | Git_push_ref of { repo: Fpath.t; target: string; ref_spec: string } 27 27 - | Git_checkout of { repo: Fpath.t; branch: string } 28 28 - | Git_branch_rename of { repo: Fpath.t; new_name: string } (** Rename current branch *) 29 29 - | Copy_directory of { src: Fpath.t; dest: Fpath.t } 21 21 + | Git_config of { repo : Fpath.t; key : string; value : string } 22 22 + (** Set git config *) 23 23 + | Git_clone of { url : string; dest : Fpath.t; branch : string } 24 24 + | Git_subtree_split of { repo : Fpath.t; prefix : string } 25 25 + | Git_subtree_add of { 26 26 + repo : Fpath.t; 27 27 + prefix : string; 28 28 + url : Uri.t; 29 29 + branch : string; 30 30 + } 31 31 + | Git_add_remote of { repo : Fpath.t; name : string; url : string } 32 32 + | Git_push_ref of { repo : Fpath.t; target : string; ref_spec : string } 33 33 + | Git_checkout of { repo : Fpath.t; branch : string } 34 34 + | Git_branch_rename of { repo : Fpath.t; new_name : string } 35 35 + (** Rename current branch *) 36 36 + | Copy_directory of { src : Fpath.t; dest : Fpath.t } 30 37 | Git_add_all of Fpath.t 31 31 - | Git_commit of { repo: Fpath.t; message: string } 32 32 - | Git_rm of { repo: Fpath.t; path: string; recursive: bool } (** Remove file/dir from git *) 33 33 - | Update_sources_toml of { path: Fpath.t; name: string; entry: Sources_registry.entry } 38 38 + | Git_commit of { repo : Fpath.t; message : string } 39 39 + | Git_rm of { repo : Fpath.t; path : string; recursive : bool } 40 40 + (** Remove file/dir from git *) 41 41 + | Update_sources_toml of { 42 42 + path : Fpath.t; 43 43 + name : string; 44 44 + entry : Sources_registry.entry; 45 45 + } 34 46 35 35 - (** Discovery information gathered during planning *) 36 47 type discovery = { 37 37 - mono_exists: bool; 38 38 - src_exists: bool; 39 39 - has_subtree_history: bool; (** Can we git subtree split? *) 40 40 - remote_accessible: bool option; (** None = not checked, Some = result *) 41 41 - opam_files: string list; 42 42 - local_path_is_repo: bool option; (** For join from local dir *) 48 48 + mono_exists : bool; 49 49 + src_exists : bool; 50 50 + has_subtree_history : bool; (** Can we git subtree split? *) 51 51 + remote_accessible : bool option; (** None = not checked, Some = result *) 52 52 + opam_files : string list; 53 53 + local_path_is_repo : bool option; (** For join from local dir *) 43 54 } 55 55 + (** Discovery information gathered during planning *) 44 56 45 45 - (** A complete action plan *) 46 57 type 'a action_plan = { 47 47 - discovery: discovery; 48 48 - actions: action list; 49 49 - result: 'a; (** What we'll return on success *) 50 50 - dry_run: bool; 58 58 + discovery : discovery; 59 59 + actions : action list; 60 60 + result : 'a; (** What we'll return on success *) 61 61 + dry_run : bool; 51 62 } 63 63 + (** A complete action plan *) 52 64 53 65 let pp_error ppf = function 54 66 | Config_error msg -> Fmt.pf ppf "Configuration error: %s" msg 55 67 | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 56 56 - | Subtree_not_found name -> Fmt.pf ppf "Subtree not found in monorepo: %s" name 57 57 - | Src_already_exists name -> Fmt.pf ppf "Source checkout already exists: src/%s" name 68 68 + | Subtree_not_found name -> 69 69 + Fmt.pf ppf "Subtree not found in monorepo: %s" name 70 70 + | Src_already_exists name -> 71 71 + Fmt.pf ppf "Source checkout already exists: src/%s" name 58 72 | Src_not_found name -> Fmt.pf ppf "Source checkout not found: src/%s" name 59 59 - | Subtree_already_exists name -> Fmt.pf ppf "Subtree already exists in monorepo: mono/%s" name 73 73 + | Subtree_already_exists name -> 74 74 + Fmt.pf ppf "Subtree already exists in monorepo: mono/%s" name 60 75 | No_opam_files name -> Fmt.pf ppf "No .opam files found in subtree: %s" name 61 76 | Verse_error e -> Fmt.pf ppf "Verse error: %a" Verse.pp_error e 62 77 | User_cancelled -> Fmt.pf ppf "Operation cancelled by user" ··· 70 85 | Subtree_not_found name -> 71 86 Some (Fmt.str "Check that mono/%s exists in your monorepo" name) 72 87 | Src_already_exists name -> 73 73 - Some (Fmt.str "Remove or rename src/%s first, or choose a different name" name) 88 88 + Some 89 89 + (Fmt.str "Remove or rename src/%s first, or choose a different name" 90 90 + name) 74 91 | Src_not_found name -> 75 92 Some (Fmt.str "Run 'monopam fork %s' first to create src/%s" name name) 76 93 | Subtree_already_exists name -> 77 77 - Some (Fmt.str "Remove mono/%s first, or use a different name with --as" name) 94 94 + Some 95 95 + (Fmt.str "Remove mono/%s first, or use a different name with --as" name) 78 96 | No_opam_files name -> 79 97 Some (Fmt.str "Add a .opam file to mono/%s before forking" name) 80 98 | Verse_error e -> Verse.error_hint e ··· 83 101 (** {1 Pretty Printers for Actions and Discovery} *) 84 102 85 103 let pp_action ppf = function 86 86 - | Check_remote_exists url -> 87 87 - Fmt.pf ppf "Check remote accessible: %s" url 88 88 - | Create_directory path -> 89 89 - Fmt.pf ppf "Create directory: %a" Fpath.pp path 90 90 - | Git_init path -> 91 91 - Fmt.pf ppf "Initialize git repository: %a" Fpath.pp path 104 104 + | Check_remote_exists url -> Fmt.pf ppf "Check remote accessible: %s" url 105 105 + | Create_directory path -> Fmt.pf ppf "Create directory: %a" Fpath.pp path 106 106 + | Git_init path -> Fmt.pf ppf "Initialize git repository: %a" Fpath.pp path 92 107 | Git_config { repo = _; key; value } -> 93 108 Fmt.pf ppf "Set git config %s = %s" key value 94 109 | Git_clone { url; dest; branch } -> ··· 96 111 | Git_subtree_split { repo = _; prefix } -> 97 112 Fmt.pf ppf "Split subtree history for '%s'" prefix 98 113 | Git_subtree_add { repo = _; prefix; url; branch } -> 99 99 - Fmt.pf ppf "Add subtree '%s' from %s (branch: %s)" prefix (Uri.to_string url) branch 114 114 + Fmt.pf ppf "Add subtree '%s' from %s (branch: %s)" prefix 115 115 + (Uri.to_string url) branch 100 116 | Git_add_remote { repo = _; name; url } -> 101 117 Fmt.pf ppf "Add remote '%s' -> %s" name url 102 118 | Git_push_ref { repo = _; target; ref_spec } -> ··· 107 123 Fmt.pf ppf "Rename current branch to '%s'" new_name 108 124 | Copy_directory { src; dest } -> 109 125 Fmt.pf ppf "Copy files from %a to %a" Fpath.pp src Fpath.pp dest 110 110 - | Git_add_all path -> 111 111 - Fmt.pf ppf "Stage all changes in %a" Fpath.pp path 112 112 - | Git_commit { repo = _; message } -> 113 113 - Fmt.pf ppf "Create commit: %s" message 126 126 + | Git_add_all path -> Fmt.pf ppf "Stage all changes in %a" Fpath.pp path 127 127 + | Git_commit { repo = _; message } -> Fmt.pf ppf "Create commit: %s" message 114 128 | Git_rm { repo = _; path; recursive = _ } -> 115 129 Fmt.pf ppf "Remove '%s' from git" path 116 130 | Update_sources_toml { path = _; name; entry = _ } -> ··· 125 139 Fmt.pf ppf " Subtree history: %s@," 126 140 (if d.has_subtree_history then "present" else "none (fresh package)"); 127 141 (match d.remote_accessible with 128 128 - | None -> () 129 129 - | Some true -> Fmt.pf ppf " Remote accessible: yes@," 130 130 - | Some false -> Fmt.pf ppf " Remote accessible: no@,"); 142 142 + | None -> () 143 143 + | Some true -> Fmt.pf ppf " Remote accessible: yes@," 144 144 + | Some false -> Fmt.pf ppf " Remote accessible: no@,"); 131 145 (match d.local_path_is_repo with 132 132 - | None -> () 133 133 - | Some true -> Fmt.pf ppf " Is git repo: yes@," 134 134 - | Some false -> Fmt.pf ppf " Is git repo: no@,"); 146 146 + | None -> () 147 147 + | Some true -> Fmt.pf ppf " Is git repo: yes@," 148 148 + | Some false -> Fmt.pf ppf " Is git repo: no@,"); 135 149 if d.opam_files <> [] then 136 136 - Fmt.pf ppf " Packages found: %a@," Fmt.(list ~sep:(any ", ") string) d.opam_files; 150 150 + Fmt.pf ppf " Packages found: %a@," 151 151 + Fmt.(list ~sep:(any ", ") string) 152 152 + d.opam_files; 137 153 Fmt.pf ppf "@]" 138 154 139 139 - let pp_action_plan : type a. a Fmt.t -> a action_plan Fmt.t = fun pp_result ppf plan -> 140 140 - Fmt.pf ppf "@[<v>Discovery:@,%a@,@,Actions to perform:@," pp_discovery plan.discovery; 141 141 - List.iteri (fun i action -> 142 142 - Fmt.pf ppf " %d. %a@," (i + 1) pp_action action 143 143 - ) plan.actions; 144 144 - if plan.dry_run then 145 145 - Fmt.pf ppf "@,(dry-run mode - no changes will be made)@,"; 155 155 + let pp_action_plan : type a. a Fmt.t -> a action_plan Fmt.t = 156 156 + fun pp_result ppf plan -> 157 157 + Fmt.pf ppf "@[<v>Discovery:@,%a@,@,Actions to perform:@," pp_discovery 158 158 + plan.discovery; 159 159 + List.iteri 160 160 + (fun i action -> Fmt.pf ppf " %d. %a@," (i + 1) pp_action action) 161 161 + plan.actions; 162 162 + if plan.dry_run then Fmt.pf ppf "@,(dry-run mode - no changes will be made)@,"; 146 163 Fmt.pf ppf "@,Expected result:@, %a@]" pp_result plan.result 147 164 148 165 let pp_error_with_hint ppf e = ··· 170 187 let pp_fork_result ppf (r : fork_result) = 171 188 (* Only truncate if it looks like a git SHA (40 hex chars), otherwise show full string *) 172 189 let commit_display = 173 173 - if String.length r.split_commit = 40 && 174 174 - String.for_all (fun c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f')) r.split_commit 190 190 + if 191 191 + String.length r.split_commit = 40 192 192 + && String.for_all 193 193 + (fun c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f')) 194 194 + r.split_commit 175 195 then String.sub r.split_commit 0 7 176 196 else r.split_commit 177 197 in 178 198 Fmt.pf ppf "@[<v>Forked subtree '%s':@, Split commit: %s@, Local repo: %a@," 179 199 r.name commit_display Fpath.pp r.src_path; 180 200 (match r.push_url with 181 181 - | Some url -> Fmt.pf ppf " Push URL: %s@," url 182 182 - | None -> ()); 201 201 + | Some url -> Fmt.pf ppf " Push URL: %s@," url 202 202 + | None -> ()); 183 203 if r.packages_created <> [] then 184 184 - Fmt.pf ppf " Packages: %a@]" Fmt.(list ~sep:(any ", ") string) r.packages_created 185 185 - else 186 186 - Fmt.pf ppf "@]" 204 204 + Fmt.pf ppf " Packages: %a@]" 205 205 + Fmt.(list ~sep:(any ", ") string) 206 206 + r.packages_created 207 207 + else Fmt.pf ppf "@]" 187 208 188 209 let pp_join_result ppf (r : join_result) = 189 189 - Fmt.pf ppf "@[<v>Joined repository '%s':@, Source: %s@," 190 190 - r.name r.source_url; 210 210 + Fmt.pf ppf "@[<v>Joined repository '%s':@, Source: %s@," r.name r.source_url; 191 211 (match r.upstream_url with 192 192 - | Some url -> Fmt.pf ppf " Upstream: %s@," url 193 193 - | None -> ()); 212 212 + | Some url -> Fmt.pf ppf " Upstream: %s@," url 213 213 + | None -> ()); 194 214 (match r.from_handle with 195 195 - | Some h -> Fmt.pf ppf " From verse: %s@," h 196 196 - | None -> ()); 215 215 + | Some h -> Fmt.pf ppf " From verse: %s@," h 216 216 + | None -> ()); 197 217 if r.packages_added <> [] then 198 198 - Fmt.pf ppf " Packages: %a@]" Fmt.(list ~sep:(any ", ") string) r.packages_added 199 199 - else 200 200 - Fmt.pf ppf "@]" 218 218 + Fmt.pf ppf " Packages: %a@]" 219 219 + Fmt.(list ~sep:(any ", ") string) 220 220 + r.packages_added 221 221 + else Fmt.pf ppf "@]" 201 222 202 223 (** Helper to check if a path is a directory *) 203 224 let is_directory ~fs path = ··· 236 257 | Some "tangled.org" | Some "tangled.sh" -> true 237 258 | _ -> false 238 259 239 239 - (** Convert a dev-repo URL to a push URL (SSH format for github/gitlab/tangled) *) 260 260 + (** Convert a dev-repo URL to a push URL (SSH format for github/gitlab/tangled) 261 261 + *) 240 262 let url_to_push_url ?knot url = 241 263 (* Strip git+ prefix if present *) 242 264 let url = ··· 302 324 (* For SSH URLs like git@github.com:user/repo.git *) 303 325 if String.starts_with ~prefix:"git@" url then 304 326 match String.index_opt url ':' with 305 305 - | Some i -> 327 327 + | Some i -> ( 306 328 let path = String.sub url (i + 1) (String.length url - i - 1) in 307 329 (* path is like "user/repo.git" or "handle/repo" *) 308 308 - (match String.index_opt path '/' with 309 309 - | Some j -> 310 310 - let user = String.sub path 0 j in 311 311 - (* Handle may be like "avsm" or "avsm.bsky.social" - compare first component *) 312 312 - let handle_first = 313 313 - match String.index_opt handle '.' with 314 314 - | Some k -> String.sub handle 0 k 315 315 - | None -> handle 316 316 - in 317 317 - String.equal user handle_first || String.equal user handle 318 318 - | None -> false) 330 330 + match String.index_opt path '/' with 331 331 + | Some j -> 332 332 + let user = String.sub path 0 j in 333 333 + (* Handle may be like "avsm" or "avsm.bsky.social" - compare first component *) 334 334 + let handle_first = 335 335 + match String.index_opt handle '.' with 336 336 + | Some k -> String.sub handle 0 k 337 337 + | None -> handle 338 338 + in 339 339 + String.equal user handle_first || String.equal user handle 340 340 + | None -> false) 319 341 | None -> false 320 342 else 321 343 (* For HTTPS URLs like https://github.com/user/repo.git *) ··· 351 373 let content = Eio.Path.load eio_path in 352 374 match Dune_project.parse content with 353 375 | Error _ -> None 354 354 - | Ok dune_proj -> 376 376 + | Ok dune_proj -> ( 355 377 match Dune_project.dev_repo_url dune_proj with 356 378 | Error _ -> None 357 357 - | Ok dev_repo -> Some (url_to_push_url ?knot dev_repo) 379 379 + | Ok dev_repo -> Some (url_to_push_url ?knot dev_repo)) 358 380 with Eio.Io _ -> None 359 381 360 382 (** Extract name from URL (last path component without .git suffix) *) ··· 362 384 let uri = Uri.of_string url in 363 385 let path = Uri.path uri in 364 386 (* Remove leading slash and .git suffix *) 365 365 - let path = if String.length path > 0 && path.[0] = '/' then 366 366 - String.sub path 1 (String.length path - 1) 367 367 - else path in 368 368 - let path = if String.ends_with ~suffix:".git" path then 369 369 - String.sub path 0 (String.length path - 4) 370 370 - else path in 387 387 + let path = 388 388 + if String.length path > 0 && path.[0] = '/' then 389 389 + String.sub path 1 (String.length path - 1) 390 390 + else path 391 391 + in 392 392 + let path = 393 393 + if String.ends_with ~suffix:".git" path then 394 394 + String.sub path 0 (String.length path - 4) 395 395 + else path 396 396 + in 371 397 (* Get last component *) 372 398 match String.rindex_opt path '/' with 373 399 | Some i -> String.sub path (i + 1) (String.length path - i - 1) ··· 378 404 (** Determine if input is a local path or URL *) 379 405 let is_local_path s = 380 406 (* It's a URL if it starts with a scheme or looks like SSH URL *) 381 381 - not (String.starts_with ~prefix:"http://" s || 382 382 - String.starts_with ~prefix:"https://" s || 383 383 - String.starts_with ~prefix:"git://" s || 384 384 - String.starts_with ~prefix:"git@" s || 385 385 - String.starts_with ~prefix:"ssh://" s || 386 386 - String.starts_with ~prefix:"git+" s) 407 407 + not 408 408 + (String.starts_with ~prefix:"http://" s 409 409 + || String.starts_with ~prefix:"https://" s 410 410 + || String.starts_with ~prefix:"git://" s 411 411 + || String.starts_with ~prefix:"git@" s 412 412 + || String.starts_with ~prefix:"ssh://" s 413 413 + || String.starts_with ~prefix:"git+" s) 387 414 388 415 (** Copy a directory tree recursively *) 389 416 let copy_directory ~fs ~src ~dest = ··· 393 420 match Eio.Path.kind ~follow:false src_path with 394 421 | `Directory -> 395 422 (try Eio.Path.mkdirs ~perm:0o755 dest_path with Eio.Io _ -> ()); 396 396 - List.iter (fun name -> 397 397 - (* Skip .git directory to avoid copying git internals *) 398 398 - if name <> ".git" then begin 399 399 - let src_child = Eio.Path.(src_path / name) in 400 400 - let dest_child = Eio.Path.(dest_path / name) in 401 401 - copy_rec src_child dest_child 402 402 - end 403 403 - ) (Eio.Path.read_dir src_path) 423 423 + List.iter 424 424 + (fun name -> 425 425 + (* Skip .git directory to avoid copying git internals *) 426 426 + if name <> ".git" then begin 427 427 + let src_child = Eio.Path.(src_path / name) in 428 428 + let dest_child = Eio.Path.(dest_path / name) in 429 429 + copy_rec src_child dest_child 430 430 + end) 431 431 + (Eio.Path.read_dir src_path) 404 432 | `Regular_file -> 405 433 let content = Eio.Path.load src_path in 406 434 Eio.Path.save ~create:(`Or_truncate 0o644) dest_path content 407 407 - | `Symbolic_link -> 435 435 + | `Symbolic_link -> ( 408 436 (* Read symlink target and recreate it *) 409 437 let target = Eio.Path.read_link src_path in 410 410 - (try Unix.symlink target (snd dest_path) with _ -> ()) 411 411 - | _ -> () (* Skip other file types *) 438 438 + try Unix.symlink target (snd dest_path) with _ -> ()) 439 439 + | _ -> () (* Skip other file types *) 412 440 | exception _ -> () 413 441 in 414 442 copy_rec src_eio dest_eio ··· 417 445 418 446 (** Build a fork plan - handles both subtree and fresh package scenarios. 419 447 420 420 - The fork workflow: 421 421 - 1. Create src/<name>/ with the package content (split or copy) 422 422 - 2. Remove mono/<name>/ from git 423 423 - 3. Re-add mono/<name>/ as a proper subtree from src/<name>/ 448 448 + The fork workflow: 1. Create src/<name>/ with the package content (split or 449 449 + copy) 2. Remove mono/<name>/ from git 3. Re-add mono/<name>/ as a proper 450 450 + subtree from src/<name>/ 424 451 425 452 This ensures the subtree relationship is properly established for sync. *) 426 453 let plan_fork ~proc ~fs ~config ~name ?push_url ?(dry_run = false) () = ··· 435 462 let mono_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in 436 463 let src_exists = is_directory ~fs src_path in 437 464 let has_subtree_hist = 438 438 - if mono_exists then Git.has_subtree_history ~proc ~fs ~repo:monorepo ~prefix () 465 465 + if mono_exists then 466 466 + Git.has_subtree_history ~proc ~fs ~repo:monorepo ~prefix () 439 467 else false 440 468 in 441 469 let opam_files = 442 442 - if mono_exists then find_opam_files ~fs subtree_path 443 443 - else [] 470 470 + if mono_exists then find_opam_files ~fs subtree_path else [] 444 471 in 445 472 446 446 - let discovery = { 447 447 - mono_exists; 448 448 - src_exists; 449 449 - has_subtree_history = has_subtree_hist; 450 450 - remote_accessible = None; (* Could check if push_url is accessible *) 451 451 - opam_files; 452 452 - local_path_is_repo = None; 453 453 - } in 473 473 + let discovery = 474 474 + { 475 475 + mono_exists; 476 476 + src_exists; 477 477 + has_subtree_history = has_subtree_hist; 478 478 + remote_accessible = None; 479 479 + (* Could check if push_url is accessible *) 480 480 + opam_files; 481 481 + local_path_is_repo = None; 482 482 + } 483 483 + in 454 484 455 485 (* Validation *) 456 456 - if not mono_exists then 457 457 - Error (Subtree_not_found name) 458 458 - else if src_exists then 459 459 - Error (Src_already_exists name) 460 460 - else if opam_files = [] then 461 461 - Error (No_opam_files name) 486 486 + if not mono_exists then Error (Subtree_not_found name) 487 487 + else if src_exists then Error (Src_already_exists name) 488 488 + else if opam_files = [] then Error (No_opam_files name) 462 489 else begin 463 490 (* Build actions for complete fork workflow: 464 491 1. Create src/<name>/ with content ··· 472 499 Git_subtree_split { repo = monorepo; prefix }; 473 500 Git_init src_path; 474 501 (* Allow pushing to checked-out branch (for monopam sync) *) 475 475 - Git_config { repo = src_path; key = "receive.denyCurrentBranch"; value = "updateInstead" }; 476 476 - Git_add_remote { repo = src_path; name = "mono"; url = Fpath.to_string monorepo }; 477 477 - Git_push_ref { repo = monorepo; target = Fpath.to_string src_path; ref_spec = "SPLIT_COMMIT:refs/heads/main" }; 502 502 + Git_config 503 503 + { 504 504 + repo = src_path; 505 505 + key = "receive.denyCurrentBranch"; 506 506 + value = "updateInstead"; 507 507 + }; 508 508 + Git_add_remote 509 509 + { repo = src_path; name = "mono"; url = Fpath.to_string monorepo }; 510 510 + Git_push_ref 511 511 + { 512 512 + repo = monorepo; 513 513 + target = Fpath.to_string src_path; 514 514 + ref_spec = "SPLIT_COMMIT:refs/heads/main"; 515 515 + }; 478 516 Git_checkout { repo = src_path; branch }; 479 517 ] 480 518 else ··· 484 522 Create_directory src_path; 485 523 Git_init src_path; 486 524 (* Allow pushing to checked-out branch (for monopam sync) *) 487 487 - Git_config { repo = src_path; key = "receive.denyCurrentBranch"; value = "updateInstead" }; 525 525 + Git_config 526 526 + { 527 527 + repo = src_path; 528 528 + key = "receive.denyCurrentBranch"; 529 529 + value = "updateInstead"; 530 530 + }; 488 531 Git_branch_rename { repo = src_path; new_name = branch }; 489 532 Copy_directory { src = subtree_path; dest = src_path }; 490 533 Git_add_all src_path; 491 491 - Git_commit { repo = src_path; message = Fmt.str "Initial commit of %s" name }; 534 534 + Git_commit 535 535 + { repo = src_path; message = Fmt.str "Initial commit of %s" name }; 492 536 ] 493 537 in 494 538 495 539 (* Add remote if push_url provided *) 496 496 - let remote_actions = match push_url with 540 540 + let remote_actions = 541 541 + match push_url with 497 542 | Some url -> [ Git_add_remote { repo = src_path; name = "origin"; url } ] 498 543 | None -> [] 499 544 in 500 545 501 546 (* Remove from mono and re-add as subtree *) 502 502 - let rejoin_actions = [ 503 503 - Git_rm { repo = monorepo; path = prefix; recursive = true }; 504 504 - Git_commit { repo = monorepo; message = Fmt.str "Remove %s for fork" name }; 505 505 - Git_subtree_add { repo = monorepo; prefix; url = Uri.of_string (Fpath.to_string src_path); branch }; 506 506 - ] in 547 547 + let rejoin_actions = 548 548 + [ 549 549 + Git_rm { repo = monorepo; path = prefix; recursive = true }; 550 550 + Git_commit 551 551 + { repo = monorepo; message = Fmt.str "Remove %s for fork" name }; 552 552 + Git_subtree_add 553 553 + { 554 554 + repo = monorepo; 555 555 + prefix; 556 556 + url = Uri.of_string (Fpath.to_string src_path); 557 557 + branch; 558 558 + }; 559 559 + ] 560 560 + in 507 561 508 562 (* Update sources.toml only if push_url is a true fork (different namespace) *) 509 563 let handle = Verse_config.handle config in 510 510 - let sources_actions = match push_url with 511 511 - | Some url when not (is_own_namespace ~handle url) -> [ 512 512 - Update_sources_toml { 513 513 - path = Fpath.(monorepo / "sources.toml"); 514 514 - name; 515 515 - entry = Sources_registry.{ 516 516 - url = normalize_git_url url; 517 517 - upstream = None; 518 518 - branch = Some branch; 519 519 - reason = None; 520 520 - origin = Some Fork; 521 521 - }; 522 522 - }; 523 523 - ] 524 524 - | Some _ -> [] (* Own namespace - no sources.toml entry needed *) 564 564 + let sources_actions = 565 565 + match push_url with 566 566 + | Some url when not (is_own_namespace ~handle url) -> 567 567 + [ 568 568 + Update_sources_toml 569 569 + { 570 570 + path = Fpath.(monorepo / "sources.toml"); 571 571 + name; 572 572 + entry = 573 573 + Sources_registry. 574 574 + { 575 575 + url = normalize_git_url url; 576 576 + upstream = None; 577 577 + branch = Some branch; 578 578 + reason = None; 579 579 + origin = Some Fork; 580 580 + }; 581 581 + }; 582 582 + ] 583 583 + | Some _ -> [] (* Own namespace - no sources.toml entry needed *) 525 584 | None -> [] 526 585 in 527 586 528 528 - let actions = create_src_actions @ remote_actions @ rejoin_actions @ sources_actions in 587 587 + let actions = 588 588 + create_src_actions @ remote_actions @ rejoin_actions @ sources_actions 589 589 + in 529 590 530 530 - let result = { 531 531 - name; 532 532 - split_commit = if has_subtree_hist then "(will be computed)" else "(fresh package)"; 533 533 - src_path; 534 534 - push_url; 535 535 - packages_created = opam_files; 536 536 - } in 591 591 + let result = 592 592 + { 593 593 + name; 594 594 + split_commit = 595 595 + (if has_subtree_hist then "(will be computed)" else "(fresh package)"); 596 596 + src_path; 597 597 + push_url; 598 598 + packages_created = opam_files; 599 599 + } 600 600 + in 537 601 538 602 Ok { discovery; actions; result; dry_run } 539 603 end ··· 555 619 match Fpath.of_string source with 556 620 | Ok path -> Some (Git.is_repo ~proc ~fs path) 557 621 | Error _ -> Some false 558 558 - end else None 622 622 + end 623 623 + else None 559 624 in 560 625 561 561 - let discovery = { 562 562 - mono_exists = subtree_exists; 563 563 - src_exists; 564 564 - has_subtree_history = false; 565 565 - remote_accessible = None; 566 566 - opam_files = []; (* Will be discovered after join *) 567 567 - local_path_is_repo = local_is_repo; 568 568 - } in 626 626 + let discovery = 627 627 + { 628 628 + mono_exists = subtree_exists; 629 629 + src_exists; 630 630 + has_subtree_history = false; 631 631 + remote_accessible = None; 632 632 + opam_files = []; 633 633 + (* Will be discovered after join *) 634 634 + local_path_is_repo = local_is_repo; 635 635 + } 636 636 + in 569 637 570 638 (* Validation *) 571 571 - if subtree_exists then 572 572 - Error (Subtree_already_exists name) 639 639 + if subtree_exists then Error (Subtree_already_exists name) 573 640 else begin 574 641 let branch = Verse_config.default_branch in 575 642 let actions = ··· 584 651 [ 585 652 Create_directory checkouts; 586 653 Copy_directory { src = local_path; dest = src_path }; 587 587 - Git_subtree_add { repo = monorepo; prefix; url = Uri.of_string (Fpath.to_string src_path); branch }; 654 654 + Git_subtree_add 655 655 + { 656 656 + repo = monorepo; 657 657 + prefix; 658 658 + url = Uri.of_string (Fpath.to_string src_path); 659 659 + branch; 660 660 + }; 588 661 ] 589 662 else 590 663 (* Local directory without git - init and commit first *) ··· 594 667 Git_init src_path; 595 668 Copy_directory { src = local_path; dest = src_path }; 596 669 Git_add_all src_path; 597 597 - Git_commit { repo = src_path; message = Fmt.str "Initial commit of %s" name }; 598 598 - Git_branch_rename { repo = src_path; new_name = branch }; (* Ensure branch is named correctly *) 599 599 - Git_subtree_add { repo = monorepo; prefix; url = Uri.of_string (Fpath.to_string src_path); branch }; 670 670 + Git_commit 671 671 + { 672 672 + repo = src_path; 673 673 + message = Fmt.str "Initial commit of %s" name; 674 674 + }; 675 675 + Git_branch_rename { repo = src_path; new_name = branch }; 676 676 + (* Ensure branch is named correctly *) 677 677 + Git_subtree_add 678 678 + { 679 679 + repo = monorepo; 680 680 + prefix; 681 681 + url = Uri.of_string (Fpath.to_string src_path); 682 682 + branch; 683 683 + }; 600 684 ] 601 601 - end else begin 685 685 + end 686 686 + else begin 602 687 (* Join from URL (existing behavior) *) 603 688 let url_uri = Uri.of_string source in 604 604 - let base_actions = [ 605 605 - Create_directory checkouts; 606 606 - Git_clone { url = source; dest = src_path; branch }; 607 607 - Git_subtree_add { repo = monorepo; prefix; url = url_uri; branch }; 608 608 - ] in 609 609 - let sources_actions = match upstream with 689 689 + let base_actions = 690 690 + [ 691 691 + Create_directory checkouts; 692 692 + Git_clone { url = source; dest = src_path; branch }; 693 693 + Git_subtree_add { repo = monorepo; prefix; url = url_uri; branch }; 694 694 + ] 695 695 + in 696 696 + let sources_actions = 697 697 + match upstream with 610 698 | Some _ -> 611 611 - [Update_sources_toml { 612 612 - path = Fpath.(monorepo / "sources.toml"); 613 613 - name; 614 614 - entry = Sources_registry.{ 615 615 - url = normalize_git_url source; 616 616 - upstream = Option.map normalize_git_url upstream; 617 617 - branch = Some branch; 618 618 - reason = None; 619 619 - origin = Some Join; 620 620 - }; 621 621 - }] 699 699 + [ 700 700 + Update_sources_toml 701 701 + { 702 702 + path = Fpath.(monorepo / "sources.toml"); 703 703 + name; 704 704 + entry = 705 705 + Sources_registry. 706 706 + { 707 707 + url = normalize_git_url source; 708 708 + upstream = Option.map normalize_git_url upstream; 709 709 + branch = Some branch; 710 710 + reason = None; 711 711 + origin = Some Join; 712 712 + }; 713 713 + }; 714 714 + ] 622 715 | None -> [] 623 716 in 624 717 base_actions @ sources_actions ··· 634 727 else [] 635 728 in 636 729 637 637 - let result = { 638 638 - name; 639 639 - source_url = source; 640 640 - upstream_url = upstream; 641 641 - packages_added = opam_preview; 642 642 - from_handle = None; 643 643 - } in 730 730 + let result = 731 731 + { 732 732 + name; 733 733 + source_url = source; 734 734 + upstream_url = upstream; 735 735 + packages_added = opam_preview; 736 736 + from_handle = None; 737 737 + } 738 738 + in 644 739 645 645 - Ok { discovery = { discovery with opam_files = opam_preview }; actions; result; dry_run } 740 740 + Ok 741 741 + { 742 742 + discovery = { discovery with opam_files = opam_preview }; 743 743 + actions; 744 744 + result; 745 745 + dry_run; 746 746 + } 646 747 end 647 748 648 749 (** Build a rejoin plan - add existing src/<name> back into mono/<name> *) ··· 655 756 (* Gather discovery information *) 656 757 let subtree_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in 657 758 let src_exists = is_directory ~fs src_path in 658 658 - let src_is_repo = if src_exists then Git.is_repo ~proc ~fs src_path else false in 759 759 + let src_is_repo = 760 760 + if src_exists then Git.is_repo ~proc ~fs src_path else false 761 761 + in 659 762 let opam_files = if src_exists then find_opam_files ~fs src_path else [] in 660 763 661 661 - let discovery = { 662 662 - mono_exists = subtree_exists; 663 663 - src_exists; 664 664 - has_subtree_history = false; 665 665 - remote_accessible = None; 666 666 - opam_files; 667 667 - local_path_is_repo = Some src_is_repo; 668 668 - } in 764 764 + let discovery = 765 765 + { 766 766 + mono_exists = subtree_exists; 767 767 + src_exists; 768 768 + has_subtree_history = false; 769 769 + remote_accessible = None; 770 770 + opam_files; 771 771 + local_path_is_repo = Some src_is_repo; 772 772 + } 773 773 + in 669 774 670 775 (* Validation *) 671 671 - if subtree_exists then 672 672 - Error (Subtree_already_exists name) 673 673 - else if not src_exists then 674 674 - Error (Src_not_found name) 776 776 + if subtree_exists then Error (Subtree_already_exists name) 777 777 + else if not src_exists then Error (Src_not_found name) 675 778 else if not src_is_repo then 676 676 - Error (Config_error (Fmt.str "src/%s exists but is not a git repository" name)) 779 779 + Error 780 780 + (Config_error (Fmt.str "src/%s exists but is not a git repository" name)) 677 781 else begin 678 782 let branch = Verse_config.default_branch in 679 679 - let actions = [ 680 680 - Git_subtree_add { repo = monorepo; prefix; url = Uri.of_string (Fpath.to_string src_path); branch }; 681 681 - ] in 783 783 + let actions = 784 784 + [ 785 785 + Git_subtree_add 786 786 + { 787 787 + repo = monorepo; 788 788 + prefix; 789 789 + url = Uri.of_string (Fpath.to_string src_path); 790 790 + branch; 791 791 + }; 792 792 + ] 793 793 + in 682 794 683 683 - let result = { 684 684 - name; 685 685 - source_url = Fpath.to_string src_path; 686 686 - upstream_url = None; 687 687 - packages_added = opam_files; 688 688 - from_handle = None; 689 689 - } in 795 795 + let result = 796 796 + { 797 797 + name; 798 798 + source_url = Fpath.to_string src_path; 799 799 + upstream_url = None; 800 800 + packages_added = opam_files; 801 801 + from_handle = None; 802 802 + } 803 803 + in 690 804 691 805 Ok { discovery; actions; result; dry_run } 692 806 end 693 807 694 808 (** {1 Plan Execution} *) 695 809 810 810 + type exec_state = { mutable split_commit : string option } 696 811 (** State tracked during plan execution *) 697 697 - type exec_state = { 698 698 - mutable split_commit: string option; 699 699 - } 700 812 701 813 (** Execute a single action *) 702 814 let execute_action ~proc ~fs ~state action = ··· 710 822 | Git_init path -> 711 823 Git.init ~proc ~fs path |> Result.map_error (fun e -> Git_error e) 712 824 | Git_config { repo; key; value } -> 713 713 - Git.config ~proc ~fs ~key ~value repo |> Result.map_error (fun e -> Git_error e) 825 825 + Git.config ~proc ~fs ~key ~value repo 826 826 + |> Result.map_error (fun e -> Git_error e) 714 827 | Git_clone { url; dest; branch } -> 715 828 Git.clone ~proc ~fs ~url:(Uri.of_string url) ~branch dest 716 829 |> Result.map_error (fun e -> Git_error e) ··· 728 841 (* Replace SPLIT_COMMIT placeholder with actual commit if available *) 729 842 let ref_spec = 730 843 match state.split_commit with 731 731 - | Some commit -> String.concat "" (String.split_on_char 'S' (String.concat commit (String.split_on_char 'S' ref_spec))) 732 732 - |> fun s -> if String.starts_with ~prefix:"PLIT_COMMIT" s then 733 733 - Option.value ~default:ref_spec state.split_commit ^ String.sub s 11 (String.length s - 11) 734 734 - else s 844 844 + | Some commit -> 845 845 + String.concat "" 846 846 + (String.split_on_char 'S' 847 847 + (String.concat commit (String.split_on_char 'S' ref_spec))) 848 848 + |> fun s -> 849 849 + if String.starts_with ~prefix:"PLIT_COMMIT" s then 850 850 + Option.value ~default:ref_spec state.split_commit 851 851 + ^ String.sub s 11 (String.length s - 11) 852 852 + else s 735 853 | None -> ref_spec 736 854 in 737 855 (* Better replacement: look for SPLIT_COMMIT literal *) 738 856 let ref_spec = 739 857 match state.split_commit with 740 858 | Some commit -> 741 741 - if String.length ref_spec >= 12 && String.sub ref_spec 0 12 = "SPLIT_COMMIT" then 742 742 - commit ^ String.sub ref_spec 12 (String.length ref_spec - 12) 859 859 + if 860 860 + String.length ref_spec >= 12 861 861 + && String.sub ref_spec 0 12 = "SPLIT_COMMIT" 862 862 + then commit ^ String.sub ref_spec 12 (String.length ref_spec - 12) 743 863 else ref_spec 744 864 | None -> ref_spec 745 865 in ··· 755 875 copy_directory ~fs ~src ~dest; 756 876 Ok () 757 877 | Git_add_all path -> 758 758 - Git.add_all ~proc ~fs path 759 759 - |> Result.map_error (fun e -> Git_error e) 878 878 + Git.add_all ~proc ~fs path |> Result.map_error (fun e -> Git_error e) 760 879 | Git_commit { repo; message } -> 761 880 Git.commit ~proc ~fs ~message repo 762 881 |> Result.map_error (fun e -> Git_error e) 763 882 | Git_rm { repo; path; recursive } -> 764 883 Git.rm ~proc ~fs ~recursive repo path 765 884 |> Result.map_error (fun e -> Git_error e) 766 766 - | Update_sources_toml { path; name; entry } -> 885 885 + | Update_sources_toml { path; name; entry } -> ( 767 886 let sources = 768 887 match Sources_registry.load ~fs:(fs :> _ Eio.Path.t) path with 769 888 | Ok s -> s 770 889 | Error _ -> Sources_registry.empty 771 890 in 772 891 let sources = Sources_registry.add sources ~subtree:name entry in 773 773 - (match Sources_registry.save ~fs:(fs :> _ Eio.Path.t) path sources with 774 774 - | Ok () -> Ok () 775 775 - | Error msg -> Error (Config_error (Fmt.str "Failed to update sources.toml: %s" msg))) 892 892 + match Sources_registry.save ~fs:(fs :> _ Eio.Path.t) path sources with 893 893 + | Ok () -> Ok () 894 894 + | Error msg -> 895 895 + Error (Config_error (Fmt.str "Failed to update sources.toml: %s" msg)) 896 896 + ) 776 897 777 898 (** Execute a complete fork action plan *) 778 899 let execute_fork_plan ~proc ~fs plan = 779 779 - if plan.dry_run then 780 780 - Ok plan.result 900 900 + if plan.dry_run then Ok plan.result 781 901 else begin 782 902 let state = { split_commit = None } in 783 903 let rec run_actions = function 784 904 | [] -> Ok () 785 785 - | action :: rest -> 905 905 + | action :: rest -> ( 786 906 match execute_action ~proc ~fs ~state action with 787 907 | Error e -> Error e 788 788 - | Ok () -> run_actions rest 908 908 + | Ok () -> run_actions rest) 789 909 in 790 910 match run_actions plan.actions with 791 911 | Error e -> Error e ··· 801 921 802 922 (** Execute a complete join action plan *) 803 923 let execute_join_plan ~proc ~fs plan = 804 804 - if plan.dry_run then 805 805 - Ok plan.result 924 924 + if plan.dry_run then Ok plan.result 806 925 else begin 807 926 let state = { split_commit = None } in 808 927 let rec run_actions = function 809 928 | [] -> Ok () 810 810 - | action :: rest -> 929 929 + | action :: rest -> ( 811 930 match execute_action ~proc ~fs ~state action with 812 931 | Error e -> Error e 813 813 - | Ok () -> run_actions rest 932 932 + | Ok () -> run_actions rest) 814 933 in 815 934 match run_actions plan.actions with 816 935 | Error e -> Error e ··· 827 946 let src_path = Fpath.(checkouts / name) in 828 947 (* Validate: mono/<name>/ must exist *) 829 948 if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then 830 830 - Error (Subtree_not_found name) 831 831 - (* Validate: src/<name>/ must not exist *) 832 832 - else if is_directory ~fs src_path then 833 833 - Error (Src_already_exists name) 949 949 + Error (Subtree_not_found name) (* Validate: src/<name>/ must not exist *) 950 950 + else if is_directory ~fs src_path then Error (Src_already_exists name) 834 951 else begin 835 952 (* Find .opam files in subtree *) 836 953 let packages = find_opam_files ~fs subtree_path in 837 837 - if packages = [] then 838 838 - Error (No_opam_files name) 954 954 + if packages = [] then Error (No_opam_files name) 839 955 else if dry_run then 840 840 - Ok { name; split_commit = "(dry-run)"; src_path; push_url; packages_created = packages } 956 956 + Ok 957 957 + { 958 958 + name; 959 959 + split_commit = "(dry-run)"; 960 960 + src_path; 961 961 + push_url; 962 962 + packages_created = packages; 963 963 + } 841 964 else begin 842 965 (* Split the subtree to get history *) 843 966 match Git.Subtree.split ~proc ~fs ~repo:monorepo ~prefix () with 844 967 | Error e -> Error (Git_error e) 845 845 - | Ok split_commit -> 968 968 + | Ok split_commit -> ( 846 969 (* Ensure src/ exists *) 847 970 ensure_dir ~fs checkouts; 848 971 (* Initialize new git repo at src/<name>/ *) 849 972 match Git.init ~proc ~fs src_path with 850 973 | Error e -> Error (Git_error e) 851 851 - | Ok () -> 974 974 + | Ok () -> ( 852 975 (* Add 'origin' remote pointing to monorepo path temporarily *) 853 976 let mono_str = Fpath.to_string monorepo in 854 854 - (match Git.add_remote ~proc ~fs ~name:"mono" ~url:mono_str src_path with 855 855 - | Error e -> Error (Git_error e) 856 856 - | Ok () -> 857 857 - (* Push split commit to local repo *) 858 858 - let ref_spec = split_commit ^ ":refs/heads/main" in 859 859 - match Git.push_ref ~proc ~fs ~repo:monorepo ~target:(Fpath.to_string src_path) ~ref_spec () with 860 860 - | Error e -> Error (Git_error e) 861 861 - | Ok () -> 862 862 - (* Checkout main branch *) 863 863 - (match Git.checkout ~proc ~fs ~branch:"main" src_path with 864 864 - | Error e -> Error (Git_error e) 865 865 - | Ok () -> 866 866 - (* Set push URL if provided *) 867 867 - let push_result = 868 868 - match push_url with 869 869 - | Some url -> 870 870 - (match Git.add_remote ~proc ~fs ~name:"origin" ~url src_path with 871 871 - | Error e -> Error (Git_error e) 872 872 - | Ok () -> Ok ()) 873 873 - | None -> Ok () 874 874 - in 875 875 - match push_result with 876 876 - | Error _ as e -> e 877 877 - | Ok () -> 878 878 - (* Only update sources.toml if there's a push URL *) 879 879 - (match push_url with 880 880 - | Some url -> 881 881 - let sources_path = Fpath.(monorepo / "sources.toml") in 882 882 - let sources = 883 883 - match Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with 884 884 - | Ok s -> s 885 885 - | Error _ -> Sources_registry.empty 886 886 - in 887 887 - let entry = Sources_registry.{ 888 888 - url = normalize_git_url url; 889 889 - upstream = None; 890 890 - branch = Some "main"; 891 891 - reason = None; 892 892 - origin = Some Fork; 893 893 - } in 894 894 - let sources = Sources_registry.add sources ~subtree:name entry in 895 895 - (match Sources_registry.save ~fs:(fs :> _ Eio.Path.t) sources_path sources with 896 896 - | Ok () -> () 897 897 - | Error msg -> Logs.warn (fun m -> m "Failed to update sources.toml: %s" msg)) 898 898 - | None -> ()); 899 899 - Ok { name; split_commit; src_path; push_url; packages_created = packages })) 977 977 + match 978 978 + Git.add_remote ~proc ~fs ~name:"mono" ~url:mono_str src_path 979 979 + with 980 980 + | Error e -> Error (Git_error e) 981 981 + | Ok () -> ( 982 982 + (* Push split commit to local repo *) 983 983 + let ref_spec = split_commit ^ ":refs/heads/main" in 984 984 + match 985 985 + Git.push_ref ~proc ~fs ~repo:monorepo 986 986 + ~target:(Fpath.to_string src_path) ~ref_spec () 987 987 + with 988 988 + | Error e -> Error (Git_error e) 989 989 + | Ok () -> ( 990 990 + (* Checkout main branch *) 991 991 + match Git.checkout ~proc ~fs ~branch:"main" src_path with 992 992 + | Error e -> Error (Git_error e) 993 993 + | Ok () -> ( 994 994 + (* Set push URL if provided *) 995 995 + let push_result = 996 996 + match push_url with 997 997 + | Some url -> ( 998 998 + match 999 999 + Git.add_remote ~proc ~fs ~name:"origin" ~url 1000 1000 + src_path 1001 1001 + with 1002 1002 + | Error e -> Error (Git_error e) 1003 1003 + | Ok () -> Ok ()) 1004 1004 + | None -> Ok () 1005 1005 + in 1006 1006 + match push_result with 1007 1007 + | Error _ as e -> e 1008 1008 + | Ok () -> 1009 1009 + (* Only update sources.toml if there's a push URL *) 1010 1010 + (match push_url with 1011 1011 + | Some url -> ( 1012 1012 + let sources_path = 1013 1013 + Fpath.(monorepo / "sources.toml") 1014 1014 + in 1015 1015 + let sources = 1016 1016 + match 1017 1017 + Sources_registry.load 1018 1018 + ~fs:(fs :> _ Eio.Path.t) 1019 1019 + sources_path 1020 1020 + with 1021 1021 + | Ok s -> s 1022 1022 + | Error _ -> Sources_registry.empty 1023 1023 + in 1024 1024 + let entry = 1025 1025 + Sources_registry. 1026 1026 + { 1027 1027 + url = normalize_git_url url; 1028 1028 + upstream = None; 1029 1029 + branch = Some "main"; 1030 1030 + reason = None; 1031 1031 + origin = Some Fork; 1032 1032 + } 1033 1033 + in 1034 1034 + let sources = 1035 1035 + Sources_registry.add sources ~subtree:name 1036 1036 + entry 1037 1037 + in 1038 1038 + match 1039 1039 + Sources_registry.save 1040 1040 + ~fs:(fs :> _ Eio.Path.t) 1041 1041 + sources_path sources 1042 1042 + with 1043 1043 + | Ok () -> () 1044 1044 + | Error msg -> 1045 1045 + Logs.warn (fun m -> 1046 1046 + m "Failed to update sources.toml: %s" 1047 1047 + msg)) 1048 1048 + | None -> ()); 1049 1049 + Ok 1050 1050 + { 1051 1051 + name; 1052 1052 + split_commit; 1053 1053 + src_path; 1054 1054 + push_url; 1055 1055 + packages_created = packages; 1056 1056 + }))))) 900 1057 end 901 1058 end 902 1059 ··· 911 1068 if Git.Subtree.exists ~fs ~repo:monorepo ~prefix then 912 1069 Error (Subtree_already_exists name) 913 1070 else if dry_run then 914 914 - Ok { name; source_url = url; upstream_url = upstream; packages_added = []; from_handle = None } 1071 1071 + Ok 1072 1072 + { 1073 1073 + name; 1074 1074 + source_url = url; 1075 1075 + upstream_url = upstream; 1076 1076 + packages_added = []; 1077 1077 + from_handle = None; 1078 1078 + } 915 1079 else begin 916 1080 (* Ensure src/ exists *) 917 1081 ensure_dir ~fs checkouts; ··· 920 1084 let uri = Uri.of_string url in 921 1085 match Git.clone ~proc ~fs ~url:uri ~branch src_path with 922 1086 | Error e -> Error (Git_error e) 923 923 - | Ok () -> 1087 1087 + | Ok () -> ( 924 1088 (* Add subtree to monorepo *) 925 925 - match Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url:uri ~branch () with 1089 1089 + match 1090 1090 + Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url:uri ~branch () 1091 1091 + with 926 1092 | Error e -> Error (Git_error e) 927 1093 | Ok () -> 928 1094 (* Find .opam files in the new subtree *) 929 1095 let packages = find_opam_files ~fs subtree_path in 930 1096 (* Only update sources.toml if there's an upstream to track *) 931 1097 (match upstream with 932 932 - | Some _ -> 933 933 - let sources_path = Fpath.(monorepo / "sources.toml") in 934 934 - let sources = 935 935 - match Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with 936 936 - | Ok s -> s 937 937 - | Error _ -> Sources_registry.empty 938 938 - in 939 939 - let entry = Sources_registry.{ 940 940 - url = normalize_git_url url; 941 941 - upstream = Option.map normalize_git_url upstream; 942 942 - branch = Some branch; 943 943 - reason = None; 944 944 - origin = Some Join; 945 945 - } in 946 946 - let sources = Sources_registry.add sources ~subtree:name entry in 947 947 - (match Sources_registry.save ~fs:(fs :> _ Eio.Path.t) sources_path sources with 948 948 - | Ok () -> () 949 949 - | Error msg -> Logs.warn (fun m -> m "Failed to update sources.toml: %s" msg)) 950 950 - | None -> ()); 951 951 - Ok { name; source_url = url; upstream_url = upstream; packages_added = packages; from_handle = None } 1098 1098 + | Some _ -> ( 1099 1099 + let sources_path = Fpath.(monorepo / "sources.toml") in 1100 1100 + let sources = 1101 1101 + match 1102 1102 + Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path 1103 1103 + with 1104 1104 + | Ok s -> s 1105 1105 + | Error _ -> Sources_registry.empty 1106 1106 + in 1107 1107 + let entry = 1108 1108 + Sources_registry. 1109 1109 + { 1110 1110 + url = normalize_git_url url; 1111 1111 + upstream = Option.map normalize_git_url upstream; 1112 1112 + branch = Some branch; 1113 1113 + reason = None; 1114 1114 + origin = Some Join; 1115 1115 + } 1116 1116 + in 1117 1117 + let sources = 1118 1118 + Sources_registry.add sources ~subtree:name entry 1119 1119 + in 1120 1120 + match 1121 1121 + Sources_registry.save 1122 1122 + ~fs:(fs :> _ Eio.Path.t) 1123 1123 + sources_path sources 1124 1124 + with 1125 1125 + | Ok () -> () 1126 1126 + | Error msg -> 1127 1127 + Logs.warn (fun m -> 1128 1128 + m "Failed to update sources.toml: %s" msg)) 1129 1129 + | None -> ()); 1130 1130 + Ok 1131 1131 + { 1132 1132 + name; 1133 1133 + source_url = url; 1134 1134 + upstream_url = upstream; 1135 1135 + packages_added = packages; 1136 1136 + from_handle = None; 1137 1137 + }) 952 1138 end 953 1139 954 954 - let join_from_verse ~proc ~fs ~config ~verse_config ~package ~handle ~fork_url ?(dry_run = false) () = 1140 1140 + let join_from_verse ~proc ~fs ~config ~verse_config ~package ~handle ~fork_url 1141 1141 + ?(dry_run = false) () = 955 1142 (* First use verse fork to set up the opam entries *) 956 956 - match Verse.fork ~proc ~fs ~config:verse_config ~handle ~package ~fork_url ~dry_run () with 1143 1143 + match 1144 1144 + Verse.fork ~proc ~fs ~config:verse_config ~handle ~package ~fork_url 1145 1145 + ~dry_run () 1146 1146 + with 957 1147 | Error e -> Error (Verse_error e) 958 1148 | Ok fork_result -> 959 1149 if dry_run then 960 960 - Ok { 961 961 - name = fork_result.subtree_name; 962 962 - source_url = fork_url; 963 963 - upstream_url = Some fork_result.upstream_url; 964 964 - packages_added = fork_result.packages_forked; 965 965 - from_handle = Some handle; 966 966 - } 1150 1150 + Ok 1151 1151 + { 1152 1152 + name = fork_result.subtree_name; 1153 1153 + source_url = fork_url; 1154 1154 + upstream_url = Some fork_result.upstream_url; 1155 1155 + packages_added = fork_result.packages_forked; 1156 1156 + from_handle = Some handle; 1157 1157 + } 967 1158 else begin 968 1159 (* Now join the repository *) 969 1160 let name = fork_result.subtree_name in 970 970 - match join ~proc ~fs ~config ~url:fork_url ~name ~upstream:fork_result.upstream_url ~dry_run () with 1161 1161 + match 1162 1162 + join ~proc ~fs ~config ~url:fork_url ~name 1163 1163 + ~upstream:fork_result.upstream_url ~dry_run () 1164 1164 + with 971 1165 | Error e -> Error e 972 1166 | Ok join_result -> 973 973 - Ok { join_result with 974 974 - packages_added = fork_result.packages_forked; 975 975 - from_handle = Some handle; 976 976 - } 1167 1167 + Ok 1168 1168 + { 1169 1169 + join_result with 1170 1170 + packages_added = fork_result.packages_forked; 1171 1171 + from_handle = Some handle; 1172 1172 + } 977 1173 end

+77 -66

lib/fork_join.mli

reviewed

··· 6 6 7 7 Both operations update sources.toml to track the origin of each source. 8 8 9 9 - The module supports an action-based workflow where commands: 10 10 - 1. Analyze current state 11 11 - 2. Build a list of actions with reasoning 12 12 - 3. Display the plan with discovery details 13 13 - 4. Prompt for confirmation (or skip with [--yes]) 14 14 - 5. Execute actions sequentially *) 9 9 + The module supports an action-based workflow where commands: 1. Analyze 10 10 + current state 2. Build a list of actions with reasoning 3. Display the plan 11 11 + with discovery details 4. Prompt for confirmation (or skip with [--yes]) 5. 12 12 + Execute actions sequentially *) 15 13 16 14 (** {1 Error Types} *) 17 15 ··· 42 40 | Check_remote_exists of string (** URL - informational check *) 43 41 | Create_directory of Fpath.t 44 42 | Git_init of Fpath.t 45 45 - | Git_config of { repo: Fpath.t; key: string; value: string } (** Set git config *) 46 46 - | Git_clone of { url: string; dest: Fpath.t; branch: string } 47 47 - | Git_subtree_split of { repo: Fpath.t; prefix: string } 48 48 - | Git_subtree_add of { repo: Fpath.t; prefix: string; url: Uri.t; branch: string } 49 49 - | Git_add_remote of { repo: Fpath.t; name: string; url: string } 50 50 - | Git_push_ref of { repo: Fpath.t; target: string; ref_spec: string } 51 51 - | Git_checkout of { repo: Fpath.t; branch: string } 52 52 - | Git_branch_rename of { repo: Fpath.t; new_name: string } (** Rename current branch *) 53 53 - | Copy_directory of { src: Fpath.t; dest: Fpath.t } 43 43 + | Git_config of { repo : Fpath.t; key : string; value : string } 44 44 + (** Set git config *) 45 45 + | Git_clone of { url : string; dest : Fpath.t; branch : string } 46 46 + | Git_subtree_split of { repo : Fpath.t; prefix : string } 47 47 + | Git_subtree_add of { 48 48 + repo : Fpath.t; 49 49 + prefix : string; 50 50 + url : Uri.t; 51 51 + branch : string; 52 52 + } 53 53 + | Git_add_remote of { repo : Fpath.t; name : string; url : string } 54 54 + | Git_push_ref of { repo : Fpath.t; target : string; ref_spec : string } 55 55 + | Git_checkout of { repo : Fpath.t; branch : string } 56 56 + | Git_branch_rename of { repo : Fpath.t; new_name : string } 57 57 + (** Rename current branch *) 58 58 + | Copy_directory of { src : Fpath.t; dest : Fpath.t } 54 59 | Git_add_all of Fpath.t 55 55 - | Git_commit of { repo: Fpath.t; message: string } 56 56 - | Git_rm of { repo: Fpath.t; path: string; recursive: bool } (** Remove from git *) 57 57 - | Update_sources_toml of { path: Fpath.t; name: string; entry: Sources_registry.entry } 60 60 + | Git_commit of { repo : Fpath.t; message : string } 61 61 + | Git_rm of { repo : Fpath.t; path : string; recursive : bool } 62 62 + (** Remove from git *) 63 63 + | Update_sources_toml of { 64 64 + path : Fpath.t; 65 65 + name : string; 66 66 + entry : Sources_registry.entry; 67 67 + } 58 68 59 59 - (** Discovery information gathered during planning *) 60 69 type discovery = { 61 61 - mono_exists: bool; (** Does mono/<name>/ exist? *) 62 62 - src_exists: bool; (** Does src/<name>/ exist? *) 63 63 - has_subtree_history: bool; (** Can we git subtree split? *) 64 64 - remote_accessible: bool option; (** None = not checked, Some = result *) 65 65 - opam_files: string list; (** Package names found from .opam files *) 66 66 - local_path_is_repo: bool option; (** For join from local dir *) 70 70 + mono_exists : bool; (** Does mono/<name>/ exist? *) 71 71 + src_exists : bool; (** Does src/<name>/ exist? *) 72 72 + has_subtree_history : bool; (** Can we git subtree split? *) 73 73 + remote_accessible : bool option; (** None = not checked, Some = result *) 74 74 + opam_files : string list; (** Package names found from .opam files *) 75 75 + local_path_is_repo : bool option; (** For join from local dir *) 67 76 } 77 77 + (** Discovery information gathered during planning *) 68 78 69 69 - (** A complete action plan *) 70 79 type 'a action_plan = { 71 71 - discovery: discovery; 72 72 - actions: action list; 73 73 - result: 'a; (** What we'll return on success *) 74 74 - dry_run: bool; 80 80 + discovery : discovery; 81 81 + actions : action list; 82 82 + result : 'a; (** What we'll return on success *) 83 83 + dry_run : bool; 75 84 } 85 85 + (** A complete action plan *) 76 86 77 87 val pp_action : action Fmt.t 78 88 (** [pp_action] formats a single action. *) ··· 89 99 (** [is_local_path s] returns true if [s] looks like a local filesystem path 90 100 rather than a URL. *) 91 101 92 92 - val suggest_push_url : fs:Eio.Fs.dir_ty Eio.Path.t -> ?knot:string -> Fpath.t -> string option 93 93 - (** [suggest_push_url ~fs ?knot subtree_path] tries to derive a push URL from the 94 94 - dune-project file in the subtree. Returns [Some url] if a source URL can 102 102 + val suggest_push_url : 103 103 + fs:Eio.Fs.dir_ty Eio.Path.t -> ?knot:string -> Fpath.t -> string option 104 104 + (** [suggest_push_url ~fs ?knot subtree_path] tries to derive a push URL from 105 105 + the dune-project file in the subtree. Returns [Some url] if a source URL can 95 106 be found and converted to SSH push format, [None] otherwise. 96 107 97 97 - @param knot Optional git push server for tangled URLs (default: git.recoil.org) *) 108 108 + @param knot 109 109 + Optional git push server for tangled URLs (default: git.recoil.org) *) 98 110 99 111 (** {1 Result Types} *) 100 112 101 101 - (** Result of a fork operation. *) 102 113 type fork_result = { 103 114 name : string; (** Subtree/repository name *) 104 115 split_commit : string; (** Git commit SHA from subtree split *) ··· 106 117 push_url : string option; (** Remote push URL if provided *) 107 118 packages_created : string list; (** Package names from .opam files *) 108 119 } 120 120 + (** Result of a fork operation. *) 109 121 110 122 val pp_fork_result : fork_result Fmt.t 111 123 (** [pp_fork_result] formats a fork result. *) 112 124 113 113 - (** Result of a join operation. *) 114 125 type join_result = { 115 126 name : string; (** Subtree/repository name *) 116 127 source_url : string; (** URL the repository was cloned from *) ··· 118 129 packages_added : string list; (** Package names from .opam files *) 119 130 from_handle : string option; (** Verse handle if joined from verse *) 120 131 } 132 132 + (** Result of a join operation. *) 121 133 122 134 val pp_join_result : join_result Fmt.t 123 135 (** [pp_join_result] formats a join result. *) ··· 133 145 ?dry_run:bool -> 134 146 unit -> 135 147 (fork_result action_plan, error) result 136 136 - (** [plan_fork ~proc ~fs ~config ~name ?push_url ?dry_run ()] builds a fork plan. 148 148 + (** [plan_fork ~proc ~fs ~config ~name ?push_url ?dry_run ()] builds a fork 149 149 + plan. 137 150 138 151 This analyzes the current state and builds a list of actions to: 139 152 - For subtrees with history: split subtree, create repo, push history ··· 155 168 ?dry_run:bool -> 156 169 unit -> 157 170 (join_result action_plan, error) result 158 158 - (** [plan_join ~proc ~fs ~config ~source ?name ?upstream ?dry_run ()] builds a join plan. 171 171 + (** [plan_join ~proc ~fs ~config ~source ?name ?upstream ?dry_run ()] builds a 172 172 + join plan. 159 173 160 160 - This analyzes the source (URL or local path) and builds a list of actions to: 174 174 + This analyzes the source (URL or local path) and builds a list of actions 175 175 + to: 161 176 - For URLs: clone repo, add subtree 162 177 - For local directories: copy/init repo, add subtree 163 178 164 179 The plan can be displayed to the user and executed with [execute_join_plan]. 165 180 166 181 @param source Git URL or local filesystem path to join 167 167 - @param name Override the subtree directory name (default: derived from source) 182 182 + @param name 183 183 + Override the subtree directory name (default: derived from source) 168 184 @param upstream Original upstream URL if this is your fork 169 185 @param dry_run If true, mark plan as dry-run (execute will skip actions) *) 170 186 ··· 178 194 (join_result action_plan, error) result 179 195 (** [plan_rejoin ~proc ~fs ~config ~name ?dry_run ()] builds a rejoin plan. 180 196 181 181 - This is used to add an existing src/<name>/ repository back into mono/<name>/ 182 182 - as a subtree. Useful after forking a package and removing it from the monorepo. 197 197 + This is used to add an existing src/<name>/ repository back into 198 198 + mono/<name>/ as a subtree. Useful after forking a package and removing it 199 199 + from the monorepo. 183 200 184 201 Requires: 185 202 - src/<name>/ must exist and be a git repository ··· 199 216 (fork_result, error) result 200 217 (** [execute_fork_plan ~proc ~fs plan] executes a fork action plan. 201 218 202 202 - Returns the fork result with the actual split commit (if applicable). 203 203 - If the plan is marked as dry-run, returns the plan's result without 204 204 - executing any actions. *) 219 219 + Returns the fork result with the actual split commit (if applicable). If the 220 220 + plan is marked as dry-run, returns the plan's result without executing any 221 221 + actions. *) 205 222 206 223 val execute_join_plan : 207 224 proc:_ Eio.Process.mgr -> ··· 227 244 (** [fork ~proc ~fs ~config ~name ?push_url ?dry_run ()] splits a monorepo 228 245 subtree into its own repository. 229 246 230 230 - This operation: 231 231 - 1. Validates mono/<name>/ exists 232 232 - 2. Validates src/<name>/ does not exist 233 233 - 3. Uses [git subtree split] to extract history 234 234 - 4. Creates a new git repo at src/<name>/ 235 235 - 5. Pushes the split commit to the new repo 236 236 - 6. Updates sources.toml with [origin = "fork"] 237 237 - 7. Auto-discovers packages from .opam files 247 247 + This operation: 1. Validates mono/<name>/ exists 2. Validates src/<name>/ 248 248 + does not exist 3. Uses [git subtree split] to extract history 4. Creates a 249 249 + new git repo at src/<name>/ 5. Pushes the split commit to the new repo 6. 250 250 + Updates sources.toml with [origin = "fork"] 7. Auto-discovers packages from 251 251 + .opam files 238 252 239 253 @param name Name of the subtree to fork (directory name under mono/) 240 254 @param push_url Optional remote URL to add as origin for pushing ··· 255 269 (** [join ~proc ~fs ~config ~url ?name ?upstream ?dry_run ()] brings an external 256 270 repository into the monorepo. 257 271 258 258 - This operation: 259 259 - 1. Derives name from URL if not provided 260 260 - 2. Validates mono/<name>/ does not exist 261 261 - 3. Clones the repository to src/<name>/ 262 262 - 4. Uses [git subtree add] to bring into monorepo 263 263 - 5. Updates sources.toml with [origin = "join"] 264 264 - 6. Auto-discovers packages from .opam files 272 272 + This operation: 1. Derives name from URL if not provided 2. Validates 273 273 + mono/<name>/ does not exist 3. Clones the repository to src/<name>/ 4. Uses 274 274 + [git subtree add] to bring into monorepo 5. Updates sources.toml with 275 275 + [origin = "join"] 6. Auto-discovers packages from .opam files 265 276 266 277 @param url Git URL to clone from 267 278 @param name Override the subtree directory name (default: derived from URL) 268 268 - @param upstream Original upstream URL if this is your fork of another project 279 279 + @param upstream 280 280 + Original upstream URL if this is your fork of another project 269 281 @param dry_run If true, validate and report what would be done *) 270 282 271 283 val join_from_verse : ··· 282 294 (** [join_from_verse ~proc ~fs ~config ~verse_config ~package ~handle ~fork_url 283 295 ?dry_run ()] joins a package from a verse member's repository. 284 296 285 285 - This combines [Verse.fork] (to set up opam entries) with [join]: 286 286 - 1. Looks up the package in verse/<handle>-opam/ 287 287 - 2. Finds all packages sharing the same git repository 288 288 - 3. Creates opam entries pointing to your fork 289 289 - 4. Clones and adds the subtree 297 297 + This combines [Verse.fork] (to set up opam entries) with [join]: 1. Looks up 298 298 + the package in verse/<handle>-opam/ 2. Finds all packages sharing the same 299 299 + git repository 3. Creates opam entries pointing to your fork 4. Clones and 300 300 + adds the subtree 290 301 291 302 @param verse_config Verse configuration (for accessing verse/ directory) 292 303 @param package Package name to look up

+71 -45

lib/forks.ml

reviewed

··· 30 30 if String.length content > 2 then begin 31 31 let inner = String.sub content 1 (String.length content - 2) in 32 32 let pairs = String.split_on_char ',' inner in 33 33 - List.iter (fun pair -> 34 34 - let pair = String.trim pair in 35 35 - match String.split_on_char ':' pair with 36 36 - | [key; value] -> 37 37 - let key = String.trim key in 38 38 - let value = String.trim value in 39 39 - (* Strip quotes from key *) 40 40 - let key = if String.length key > 2 && key.[0] = '"' then 41 41 - String.sub key 1 (String.length key - 2) 42 42 - else key 43 43 - in 44 44 - (match float_of_string_opt value with 45 45 - | Some ts -> Hashtbl.replace fetch_cache key ts 46 46 - | None -> ()) 47 47 - | _ -> ()) 33 33 + List.iter 34 34 + (fun pair -> 35 35 + let pair = String.trim pair in 36 36 + match String.split_on_char ':' pair with 37 37 + | [ key; value ] -> ( 38 38 + let key = String.trim key in 39 39 + let value = String.trim value in 40 40 + (* Strip quotes from key *) 41 41 + let key = 42 42 + if String.length key > 2 && key.[0] = '"' then 43 43 + String.sub key 1 (String.length key - 2) 44 44 + else key 45 45 + in 46 46 + match float_of_string_opt value with 47 47 + | Some ts -> Hashtbl.replace fetch_cache key ts 48 48 + | None -> ()) 49 49 + | _ -> ()) 48 50 pairs 49 51 end 50 52 with _ -> () ··· 60 62 ignore (Sys.command (Printf.sprintf "mkdir -p %s" (Filename.quote dir))); 61 63 (* Write cache as JSON *) 62 64 Out_channel.with_open_text path (fun oc -> 63 63 - output_string oc "{\n"; 64 64 - let first = ref true in 65 65 - Hashtbl.iter (fun key ts -> 66 66 - if not !first then output_string oc ",\n"; 67 67 - first := false; 68 68 - Printf.fprintf oc " \"%s\": %.0f" key ts) 69 69 - fetch_cache; 70 70 - output_string oc "\n}\n") 65 65 + output_string oc "{\n"; 66 66 + let first = ref true in 67 67 + Hashtbl.iter 68 68 + (fun key ts -> 69 69 + if not !first then output_string oc ",\n"; 70 70 + first := false; 71 71 + Printf.fprintf oc " \"%s\": %.0f" key ts) 72 72 + fetch_cache; 73 73 + output_string oc "\n}\n") 71 74 with _ -> () 72 75 73 76 (** Check if a fetch is needed for a cache key *) ··· 326 329 (* Generic git.<domain>: pattern - convert git@git.<domain>:path to https://git.<domain>/path *) 327 330 match String.index_opt s ':' with 328 331 | Some colon_pos -> 329 329 - let host = String.sub s 4 (colon_pos - 4) in (* "git.<domain>" *) 330 330 - let path = String.sub s (colon_pos + 1) (String.length s - colon_pos - 1) in 332 332 + let host = String.sub s 4 (colon_pos - 4) in 333 333 + (* "git.<domain>" *) 334 334 + let path = 335 335 + String.sub s (colon_pos + 1) (String.length s - colon_pos - 1) 336 336 + in 331 337 "https://" ^ host ^ "/" ^ path 332 338 | None -> s 333 339 else s ··· 397 403 if not (needs_fetch ~refresh ~timeout:default_cache_timeout cache_key) then begin 398 404 Log.debug (fun m -> m "Skipping fetch for %a (cached)" Fpath.pp path); 399 405 () 400 400 - end else begin 406 406 + end 407 407 + else begin 401 408 let cwd = Eio.Path.(fs / Fpath.to_string path) in 402 402 - let cmd = ["git"; "fetch"; "--quiet"] in 403 403 - Log.debug (fun m -> m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp path); 409 409 + let cmd = [ "git"; "fetch"; "--quiet" ] in 410 410 + Log.debug (fun m -> 411 411 + m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp path); 404 412 Eio.Switch.run @@ fun sw -> 405 405 - let child = Eio.Process.spawn proc ~sw ~cwd 413 413 + let child = 414 414 + Eio.Process.spawn proc ~sw ~cwd 406 415 ~stdout:(Eio.Flow.buffer_sink (Buffer.create 16)) 407 416 ~stderr:(Eio.Flow.buffer_sink (Buffer.create 16)) 408 417 cmd ··· 412 421 | _ -> Log.debug (fun m -> m "Failed to fetch %a" Fpath.pp path) 413 422 end 414 423 415 415 - (** Scan all verse opam repos and build a map: repo_basename -> [(handle, url, [packages])] *) 424 424 + (** Scan all verse opam repos and build a map: repo_basename -> 425 425 + [(handle, url, [packages])] *) 416 426 let scan_all_verse_opam_repos ~proc ~fs ~verse_path ~refresh () = 417 427 let eio_verse = Eio.Path.(fs / Fpath.to_string verse_path) in 418 428 let entries = try Eio.Path.read_dir eio_verse with _ -> [] in 419 429 (* Find opam repo directories (ending in -opam) *) 420 420 - let opam_dirs = List.filter (fun name -> String.ends_with ~suffix:"-opam" name) entries in 430 430 + let opam_dirs = 431 431 + List.filter (fun name -> String.ends_with ~suffix:"-opam" name) entries 432 432 + in 421 433 (* Fetch each opam repo first (respecting cache unless refresh) *) 422 434 Log.info (fun m -> m "Checking %d verse opam repos" (List.length opam_dirs)); 423 423 - List.iter (fun opam_dir -> 424 424 - let opam_path = Fpath.(verse_path / opam_dir) in 425 425 - fetch_verse_opam_repo ~proc ~fs ~refresh opam_path) 435 435 + List.iter 436 436 + (fun opam_dir -> 437 437 + let opam_path = Fpath.(verse_path / opam_dir) in 438 438 + fetch_verse_opam_repo ~proc ~fs ~refresh opam_path) 426 439 opam_dirs; 427 440 (* Build map: repo_basename -> [(handle, url, [packages])] *) 428 441 let repo_map = Hashtbl.create 64 in ··· 510 523 511 524 (** Fetch a remote (with caching) *) 512 525 let fetch_remote ~proc ~fs ~repo ~remote ~refresh () = 513 513 - let cache_key = Printf.sprintf "checkout/%s/%s" (Fpath.to_string repo) remote in 526 526 + let cache_key = 527 527 + Printf.sprintf "checkout/%s/%s" (Fpath.to_string repo) remote 528 528 + in 514 529 if not (needs_fetch ~refresh ~timeout:default_cache_timeout cache_key) then begin 515 515 - Log.debug (fun m -> m "Skipping fetch for %s in %a (cached)" remote Fpath.pp repo); 516 516 - Ok () (* Return Ok since we have cached data *) 517 517 - end else begin 530 530 + Log.debug (fun m -> 531 531 + m "Skipping fetch for %s in %a (cached)" remote Fpath.pp repo); 532 532 + Ok () (* Return Ok since we have cached data *) 533 533 + end 534 534 + else begin 518 535 let cwd = Eio.Path.(fs / Fpath.to_string repo) in 519 519 - let cmd = ["git"; "fetch"; remote] in 536 536 + let cmd = [ "git"; "fetch"; remote ] in 520 537 Log.info (fun m -> m "Fetching %s in %a" remote Fpath.pp repo); 521 521 - Log.debug (fun m -> m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp repo); 538 538 + Log.debug (fun m -> 539 539 + m "Running: %s (in %a)" (String.concat " " cmd) Fpath.pp repo); 522 540 Eio.Switch.run @@ fun sw -> 523 523 - let child = Eio.Process.spawn proc ~sw ~cwd 541 541 + let child = 542 542 + Eio.Process.spawn proc ~sw ~cwd 524 543 ~stdout:(Eio.Flow.buffer_sink (Buffer.create 256)) 525 544 ~stderr:(Eio.Flow.buffer_sink (Buffer.create 256)) 526 545 cmd 527 546 in 528 547 match Eio.Process.await child with 529 529 - | `Exited 0 -> record_fetch cache_key; Ok () 548 548 + | `Exited 0 -> 549 549 + record_fetch cache_key; 550 550 + Ok () 530 551 | _ -> Error "Failed to fetch remote" 531 552 end 532 553 ··· 623 644 Diverged { common_ancestor = base; my_ahead; their_ahead })) 624 645 625 646 (** Compute fork analysis for all repos *) 626 626 - let compute ~proc ~fs ~verse_config ~monopam_config ?(refresh=false) () = 647 647 + let compute ~proc ~fs ~verse_config ~monopam_config ?(refresh = false) () = 627 648 let verse_path = Verse_config.verse_path verse_config in 628 649 let opam_repo_path = Config.Paths.opam_repo monopam_config in 629 650 let checkouts_path = Config.Paths.checkouts monopam_config in ··· 634 655 635 656 (* Scan verse opam repos *) 636 657 Log.info (fun m -> m "Scanning verse opam repos"); 637 637 - let verse_repos = scan_all_verse_opam_repos ~proc ~fs ~verse_path ~refresh () in 658 658 + let verse_repos = 659 659 + scan_all_verse_opam_repos ~proc ~fs ~verse_path ~refresh () 660 660 + in 638 661 639 662 (* Build combined list of all repo names *) 640 663 let all_repos = Hashtbl.create 64 in ··· 687 710 ~name:remote_name ~url:src.url ()) 688 711 end; 689 712 (* Fetch remote (respecting cache unless refresh) *) 690 690 - match fetch_remote ~proc ~fs ~repo:checkout_path ~remote:remote_name ~refresh () with 713 713 + match 714 714 + fetch_remote ~proc ~fs ~repo:checkout_path 715 715 + ~remote:remote_name ~refresh () 716 716 + with 691 717 | Error _ -> Not_fetched 692 718 | Ok () -> 693 719 (* Compare refs *)

+6 -8

lib/forks.mli

reviewed

··· 76 76 ?refresh:bool -> 77 77 unit -> 78 78 t 79 79 - (** [compute ~proc ~fs ~verse_config ~monopam_config ?refresh ()] performs full fork 80 80 - analysis by: 81 81 - 1. Scanning my opam repo for dev-repo URLs 82 82 - 2. Scanning all verse opam repos for dev-repo URLs 83 83 - 3. Adding git remotes to my checkouts for each member's fork 84 84 - 4. Fetching remotes and comparing commit histories 79 79 + (** [compute ~proc ~fs ~verse_config ~monopam_config ?refresh ()] performs full 80 80 + fork analysis by: 1. Scanning my opam repo for dev-repo URLs 2. Scanning all 81 81 + verse opam repos for dev-repo URLs 3. Adding git remotes to my checkouts for 82 82 + each member's fork 4. Fetching remotes and comparing commit histories 85 83 86 86 - Fetches are cached for 1 hour by default. Use [~refresh:true] to force 87 87 - fresh fetches from all remotes. *) 84 84 + Fetches are cached for 1 hour by default. Use [~refresh:true] to force fresh 85 85 + fetches from all remotes. *)

+72 -41

lib/git.ml

reviewed

··· 68 68 let retryable_error_patterns = 69 69 [ 70 70 (* HTTP 5xx errors *) 71 71 - "500"; "502"; "503"; "504"; "HTTP 5"; "http 5"; 72 72 - "Internal Server Error"; "Bad Gateway"; "Service Unavailable"; "Gateway Timeout"; 71 71 + "500"; 72 72 + "502"; 73 73 + "503"; 74 74 + "504"; 75 75 + "HTTP 5"; 76 76 + "http 5"; 77 77 + "Internal Server Error"; 78 78 + "Bad Gateway"; 79 79 + "Service Unavailable"; 80 80 + "Gateway Timeout"; 73 81 (* RPC failures (common git smart HTTP errors) *) 74 74 - "RPC failed"; "curl"; "unexpected disconnect"; 75 75 - "the remote end hung up"; "early EOF"; 82 82 + "RPC failed"; 83 83 + "curl"; 84 84 + "unexpected disconnect"; 85 85 + "the remote end hung up"; 86 86 + "early EOF"; 76 87 (* Connection errors *) 77 77 - "Connection refused"; "Connection reset"; "Connection timed out"; 78 78 - "Could not resolve host"; "Failed to connect"; 79 79 - "Network is unreachable"; "Temporary failure"; 88 88 + "Connection refused"; 89 89 + "Connection reset"; 90 90 + "Connection timed out"; 91 91 + "Could not resolve host"; 92 92 + "Failed to connect"; 93 93 + "Network is unreachable"; 94 94 + "Temporary failure"; 80 95 ] 81 96 82 97 (** Check if an error is a retryable HTTP server error (5xx) or network error *) 83 98 let is_retryable_error result = 84 99 let stderr = result.stderr in 85 100 String.length stderr > 0 86 86 - && List.exists (fun needle -> string_contains ~needle stderr) retryable_error_patterns 101 101 + && List.exists 102 102 + (fun needle -> string_contains ~needle stderr) 103 103 + retryable_error_patterns 87 104 88 88 - (** Run a git command with retry logic for network errors. 89 89 - Retries up to [max_retries] times with exponential backoff starting at [initial_delay_ms]. *) 90 90 - let run_git_ok_with_retry ~proc ~cwd ?(max_retries = 3) ?(initial_delay_ms = 2000) args = 105 105 + (** Run a git command with retry logic for network errors. Retries up to 106 106 + [max_retries] times with exponential backoff starting at [initial_delay_ms]. 107 107 + *) 108 108 + let run_git_ok_with_retry ~proc ~cwd ?(max_retries = 3) 109 109 + ?(initial_delay_ms = 2000) args = 91 110 let rec attempt n delay_ms = 92 111 let result = run_git ~proc ~cwd args in 93 112 if result.exit_code = 0 then Ok result.stdout 94 113 else if n < max_retries && is_retryable_error result then begin 95 114 (* Log the retry *) 96 115 Logs.warn (fun m -> 97 97 - m "Git command failed with retryable error, retrying in %dms (%d/%d): %s" 116 116 + m 117 117 + "Git command failed with retryable error, retrying in %dms \ 118 118 + (%d/%d): %s" 98 119 delay_ms (n + 1) max_retries result.stderr); 99 120 (* Sleep before retry - convert ms to seconds for Unix.sleepf *) 100 121 Unix.sleepf (float_of_int delay_ms /. 1000.0); ··· 139 160 let cwd = Eio.Path.(fs / Fpath.to_string parent) in 140 161 let target_name = Fpath.basename target in 141 162 let url_str = Uri.to_string url in 142 142 - run_git_ok_with_retry ~proc ~cwd [ "clone"; "--branch"; branch; url_str; target_name ] 163 163 + run_git_ok_with_retry ~proc ~cwd 164 164 + [ "clone"; "--branch"; branch; url_str; target_name ] 143 165 |> Result.map ignore 144 166 145 167 let fetch ~proc ~fs ?(remote = "origin") path = ··· 261 283 | Some b -> b 262 284 | None -> Option.value ~default:"main" (current_branch ~proc ~fs path) 263 285 in 264 264 - run_git_ok_with_retry ~proc ~cwd [ "push"; remote; branch ] |> Result.map ignore 286 286 + run_git_ok_with_retry ~proc ~cwd [ "push"; remote; branch ] 287 287 + |> Result.map ignore 265 288 266 289 let push_ref ~proc ~fs ~repo ~target ~ref_spec () = 267 290 let cwd = path_to_eio ~fs repo in ··· 383 406 let cwd = path_to_eio ~fs repo_path in 384 407 run_git_ok ~proc ~cwd [ "show"; "--patch"; "--stat"; commit ] 385 408 386 386 - (** Parse a subtree merge/squash commit message to extract the upstream commit range. 387 387 - Messages look like: "Squashed 'prefix/' changes from abc123..def456" 388 388 - or "Squashed 'prefix/' content from commit abc123" 389 389 - Returns the end commit (most recent) if found. *) 409 409 + (** Parse a subtree merge/squash commit message to extract the upstream commit 410 410 + range. Messages look like: "Squashed 'prefix/' changes from abc123..def456" 411 411 + or "Squashed 'prefix/' content from commit abc123" Returns the end commit 412 412 + (most recent) if found. *) 390 413 let parse_subtree_message subject = 391 414 (* Helper to extract hex commit hash starting at position *) 392 415 let extract_hex s start = ··· 471 494 (** {1 Worktree Operations} *) 472 495 473 496 module Worktree = struct 474 474 - type entry = { 475 475 - path : Fpath.t; 476 476 - head : string; 477 477 - branch : string option; 478 478 - } 497 497 + type entry = { path : Fpath.t; head : string; branch : string option } 479 498 480 499 let add ~proc ~fs ~repo ~path ~branch () = 481 500 let cwd = path_to_eio ~fs repo in 482 501 let path_str = Fpath.to_string path in 483 483 - run_git_ok ~proc ~cwd 484 484 - [ "worktree"; "add"; "-b"; branch; path_str ] 502 502 + run_git_ok ~proc ~cwd [ "worktree"; "add"; "-b"; branch; path_str ] 485 503 |> Result.map ignore 486 504 487 505 let remove ~proc ~fs ~repo ~path ~force () = ··· 506 524 HEAD abc123... 507 525 branch refs/heads/branchname (or detached) *) 508 526 let lines = String.split_on_char '\n' output in 509 509 - let rec parse_entries acc current_path current_head current_branch = function 510 510 - | [] -> 527 527 + let rec parse_entries acc current_path current_head current_branch = 528 528 + function 529 529 + | [] -> ( 511 530 (* Finalize last entry if we have one *) 512 512 - (match current_path, current_head with 531 531 + match (current_path, current_head) with 513 532 | Some p, Some h -> 514 514 - let entry = { path = p; head = h; branch = current_branch } in 533 533 + let entry = 534 534 + { path = p; head = h; branch = current_branch } 535 535 + in 515 536 List.rev (entry :: acc) 516 537 | _ -> List.rev acc) 517 517 - | "" :: rest -> 538 538 + | "" :: rest -> ( 518 539 (* End of entry block *) 519 519 - (match current_path, current_head with 540 540 + match (current_path, current_head) with 520 541 | Some p, Some h -> 521 521 - let entry = { path = p; head = h; branch = current_branch } in 542 542 + let entry = 543 543 + { path = p; head = h; branch = current_branch } 544 544 + in 522 545 parse_entries (entry :: acc) None None None rest 523 546 | _ -> parse_entries acc None None None rest) 524 547 | line :: rest -> 525 548 if String.starts_with ~prefix:"worktree " line then 526 549 let path_str = String.sub line 9 (String.length line - 9) in 527 527 - (match Fpath.of_string path_str with 528 528 - | Ok p -> parse_entries acc (Some p) current_head current_branch rest 529 529 - | Error _ -> parse_entries acc current_path current_head current_branch rest) 550 550 + match Fpath.of_string path_str with 551 551 + | Ok p -> 552 552 + parse_entries acc (Some p) current_head current_branch 553 553 + rest 554 554 + | Error _ -> 555 555 + parse_entries acc current_path current_head current_branch 556 556 + rest 530 557 else if String.starts_with ~prefix:"HEAD " line then 531 558 let head = String.sub line 5 (String.length line - 5) in 532 559 parse_entries acc current_path (Some head) current_branch rest ··· 535 562 (* Extract branch name from refs/heads/... *) 536 563 let branch = 537 564 if String.starts_with ~prefix:"refs/heads/" branch_ref then 538 538 - Some (String.sub branch_ref 11 (String.length branch_ref - 11)) 539 539 - else 540 540 - Some branch_ref 565 565 + Some 566 566 + (String.sub branch_ref 11 567 567 + (String.length branch_ref - 11)) 568 568 + else Some branch_ref 541 569 in 542 570 parse_entries acc current_path current_head branch rest 543 571 else if line = "detached" then 544 572 parse_entries acc current_path current_head None rest 545 573 else 546 546 - parse_entries acc current_path current_head current_branch rest 574 574 + parse_entries acc current_path current_head current_branch 575 575 + rest 547 576 in 548 577 parse_entries [] None None None lines 549 578 ··· 556 585 let cwd = path_to_eio ~fs path in 557 586 run_git_ok ~proc ~cwd [ "cherry-pick"; commit ] |> Result.map ignore 558 587 559 559 - let merge ~proc ~fs ~ref_name ?(ff_only=false) path = 588 588 + let merge ~proc ~fs ~ref_name ?(ff_only = false) path = 560 589 let cwd = path_to_eio ~fs path in 561 561 - let args = ["merge"] @ (if ff_only then ["--ff-only"] else []) @ [ref_name] in 590 590 + let args = 591 591 + [ "merge" ] @ (if ff_only then [ "--ff-only" ] else []) @ [ ref_name ] 592 592 + in 562 593 run_git_ok ~proc ~cwd args |> Result.map ignore 563 594 564 595 (** {1 Diff Operations} *)

+18 -15

lib/git.mli

reviewed

··· 128 128 branch:string -> 129 129 Fpath.t -> 130 130 (unit, error) result 131 131 - (** [fetch_and_reset ~proc ~fs ?remote ~branch path] fetches from the remote 132 132 - and resets the local branch to match the remote. 131 131 + (** [fetch_and_reset ~proc ~fs ?remote ~branch path] fetches from the remote and 132 132 + resets the local branch to match the remote. 133 133 134 134 This is useful for repositories that should not have local changes, as it 135 135 discards any local modifications and sets the working tree to exactly match ··· 490 490 491 491 (** Operations for git worktree management. *) 492 492 module Worktree : sig 493 493 - (** A git worktree entry. *) 494 493 type entry = { 495 494 path : Fpath.t; (** Absolute path to the worktree *) 496 495 head : string; (** HEAD commit hash *) 497 496 branch : string option; (** Branch name if not detached *) 498 497 } 498 498 + (** A git worktree entry. *) 499 499 500 500 val add : 501 501 proc:_ Eio.Process.mgr -> ··· 539 539 repo:Fpath.t -> 540 540 path:Fpath.t -> 541 541 bool 542 542 - (** [exists ~proc ~fs ~repo ~path] returns true if a worktree exists at [path]. *) 542 542 + (** [exists ~proc ~fs ~repo ~path] returns true if a worktree exists at 543 543 + [path]. *) 543 544 end 544 545 545 546 (** {1 Cherry-pick Operations} *) ··· 550 551 commit:string -> 551 552 Fpath.t -> 552 553 (unit, error) result 553 553 - (** [cherry_pick ~proc ~fs ~commit path] applies a single commit to the current branch. 554 554 + (** [cherry_pick ~proc ~fs ~commit path] applies a single commit to the current 555 555 + branch. 554 556 555 557 @param commit The commit hash to cherry-pick 556 558 @param path Path to the repository *) ··· 562 564 ?ff_only:bool -> 563 565 Fpath.t -> 564 566 (unit, error) result 565 565 - (** [merge ~proc ~fs ~ref_name ?ff_only path] merges a ref into the current branch. 567 567 + (** [merge ~proc ~fs ~ref_name ?ff_only path] merges a ref into the current 568 568 + branch. 566 569 567 570 @param ref_name The ref to merge (e.g., "verse/handle/main") 568 571 @param ff_only If true, only allow fast-forward merges (default: false) ··· 610 613 message:string -> 611 614 Fpath.t -> 612 615 (unit, error) result 613 613 - (** [commit ~proc ~fs ~message path] creates a commit with the given message 614 614 - in the repository at [path]. *) 616 616 + (** [commit ~proc ~fs ~message path] creates a commit with the given message in 617 617 + the repository at [path]. *) 615 618 616 619 val rm : 617 620 proc:_ Eio.Process.mgr -> ··· 620 623 Fpath.t -> 621 624 string -> 622 625 (unit, error) result 623 623 - (** [rm ~proc ~fs ~recursive path target] removes [target] from the git index 624 624 - in the repository at [path]. If [recursive] is true, removes directories 626 626 + (** [rm ~proc ~fs ~recursive path target] removes [target] from the git index in 627 627 + the repository at [path]. If [recursive] is true, removes directories 625 628 recursively (git rm -r). *) 626 629 627 630 val config : ··· 641 644 prefix:string -> 642 645 unit -> 643 646 bool 644 644 - (** [has_subtree_history ~proc ~fs ~repo ~prefix ()] returns true if the 645 645 - prefix has subtree commit history (i.e., was added via git subtree add). 646 646 - Returns false for fresh local packages that were never part of a subtree. *) 647 647 + (** [has_subtree_history ~proc ~fs ~repo ~prefix ()] returns true if the prefix 648 648 + has subtree commit history (i.e., was added via git subtree add). Returns 649 649 + false for fresh local packages that were never part of a subtree. *) 647 650 648 651 val branch_rename : 649 652 proc:_ Eio.Process.mgr -> ··· 651 654 new_name:string -> 652 655 Fpath.t -> 653 656 (unit, error) result 654 654 - (** [branch_rename ~proc ~fs ~new_name path] renames the current branch 655 655 - to [new_name] in the repository at [path]. Uses [git branch -M]. *) 657 657 + (** [branch_rename ~proc ~fs ~new_name path] renames the current branch to 658 658 + [new_name] in the repository at [path]. Uses [git branch -M]. *)

+715 -556

lib/monopam.ml

reviewed

··· 46 46 *) 47 47 let error_hint = function 48 48 | Config_error _ -> 49 49 - Some 50 50 - "Run 'monopam init --handle <your-handle>' to create a workspace." 49 49 + Some "Run 'monopam init --handle <your-handle>' to create a workspace." 51 50 | Repo_error (Opam_repo.No_dev_repo _) -> 52 51 Some 53 52 "Add a 'dev-repo' field to the package's opam file pointing to a git \ ··· 77 76 "Commit changes in the monorepo first: cd mono && git add -A && git \ 78 77 commit" 79 78 | Monorepo_dirty -> 80 80 - Some "Commit or stash your changes first: git status && git add -A && git commit" 79 79 + Some 80 80 + "Commit or stash your changes first: git status && git add -A && git \ 81 81 + commit" 81 82 | Package_not_found _ -> 82 83 Some "Check available packages: ls opam-repo/packages/" 83 84 | Claude_error msg when String.starts_with ~prefix:"Failed to decode" msg -> ··· 187 188 with Eio.Io _ -> []) 188 189 repos 189 190 190 190 - (** Information about a package discovered from the monorepo. *) 191 191 type monorepo_package = { 192 192 pkg_name : string; 193 193 subtree : string; ··· 195 195 url_src : string; 196 196 opam_content : string; 197 197 } 198 198 + (** Information about a package discovered from the monorepo. *) 198 199 199 199 - (** Discover packages from monorepo subtrees by parsing dune-project files. 200 200 - If [sources] is provided, it overrides the dev-repo URL for matching subtrees. *) 201 201 - let discover_packages_from_monorepo ~fs ~config ?(sources = Sources_registry.empty) () = 200 200 + (** Discover packages from monorepo subtrees by parsing dune-project files. If 201 201 + [sources] is provided, it overrides the dev-repo URL for matching subtrees. 202 202 + *) 203 203 + let discover_packages_from_monorepo ~fs ~config 204 204 + ?(sources = Sources_registry.empty) () = 202 205 let fs = fs_typed fs in 203 206 let monorepo = Config.Paths.monorepo config in 204 207 let monorepo_eio = Eio.Path.(fs / Fpath.to_string monorepo) in ··· 215 218 with Eio.Io _ -> [] 216 219 in 217 220 218 218 - Log.debug (fun m -> m "Found %d subdirectories in monorepo" (List.length subdirs)); 221 221 + Log.debug (fun m -> 222 222 + m "Found %d subdirectories in monorepo" (List.length subdirs)); 219 223 220 224 (* Process each subdirectory *) 221 225 let packages, errors = ··· 229 233 | `Regular_file -> ( 230 234 (* Parse dune-project *) 231 235 let content = 232 232 - try Some (Eio.Path.load dune_project_path) 233 233 - with Eio.Io _ -> None 236 236 + try Some (Eio.Path.load dune_project_path) with Eio.Io _ -> None 234 237 in 235 238 match content with 236 239 | None -> (pkgs, errs) ··· 254 257 1. Explicit sources.toml entry for this subtree 255 258 2. dune-project source/homepage 256 259 3. sources.toml default_url_base + subtree name *) 257 257 - let sources_override = Sources_registry.find sources ~subtree in 260 260 + let sources_override = 261 261 + Sources_registry.find sources ~subtree 262 262 + in 258 263 259 264 let derive_from_dune () = 260 265 match ··· 270 275 match Sources_registry.derive_url sources ~subtree with 271 276 | Some dev_repo -> 272 277 Log.debug (fun m -> 273 273 - m "Using default_url_base for %s: %s" subtree dev_repo); 278 278 + m "Using default_url_base for %s: %s" subtree 279 279 + dev_repo); 274 280 Some (dev_repo, dev_repo ^ "#main") 275 281 | None -> None 276 282 in ··· 286 292 | None -> ( 287 293 (* Try to get branch from dune-project, default to main *) 288 294 match dune_proj.source with 289 289 - | Some (Dune_project.Uri { branch = Some b; _ }) -> b 295 295 + | Some (Dune_project.Uri { branch = Some b; _ }) 296 296 + -> 297 297 + b 290 298 | _ -> "main") 291 299 in 292 300 Log.debug (fun m -> 293 293 - m "Using sources.toml entry for %s: %s" subtree dev_repo); 301 301 + m "Using sources.toml entry for %s: %s" subtree 302 302 + dev_repo); 294 303 Some (dev_repo, dev_repo ^ "#" ^ branch) 295 304 | None -> ( 296 305 match derive_from_dune () with ··· 300 309 | Some result -> Some result 301 310 | None -> 302 311 Log.warn (fun m -> 303 303 - m "Cannot derive dev-repo for %s (no source in dune-project or sources.toml)" subtree); 312 312 + m 313 313 + "Cannot derive dev-repo for %s (no \ 314 314 + source in dune-project or \ 315 315 + sources.toml)" 316 316 + subtree); 304 317 None)) 305 318 in 306 319 match dev_repo_and_url with 307 320 | None -> (pkgs, "Cannot derive dev-repo" :: errs) 308 321 | Some (dev_repo, url_src) -> 309 322 Log.debug (fun m -> 310 310 - m "Found %d opam files in %s" (List.length opam_files) 311 311 - subtree); 323 323 + m "Found %d opam files in %s" 324 324 + (List.length opam_files) subtree); 312 325 (* Transform each opam file *) 313 326 let new_pkgs = 314 327 List.filter_map ··· 326 339 ~dev_repo ~url_src 327 340 in 328 341 Some 329 329 - { pkg_name; subtree; dev_repo; url_src; opam_content } 342 342 + { 343 343 + pkg_name; 344 344 + subtree; 345 345 + dev_repo; 346 346 + url_src; 347 347 + opam_content; 348 348 + } 330 349 with Eio.Io _ -> None) 331 350 opam_files 332 351 in ··· 335 354 (* No dune-project, skip *) 336 355 Log.debug (fun m -> m "No dune-project in %s, skipping" subtree); 337 356 (pkgs, errs) 338 338 - | exception Eio.Io _ -> 339 339 - (pkgs, errs)) 357 357 + | exception Eio.Io _ -> (pkgs, errs)) 340 358 ([], []) subdirs 341 359 in 342 360 ··· 805 823 806 824 (** Convert a clone URL to a push URL. 807 825 - GitHub HTTPS URLs are converted to SSH format 808 808 - - Tangled URLs (tangled.org/tangled.sh) are converted to SSH format using the knot server 826 826 + - Tangled URLs (tangled.org/tangled.sh) are converted to SSH format using 827 827 + the knot server 809 828 - Other URLs are returned unchanged 810 810 - @param knot Git push server hostname. Defaults to git.recoil.org if not provided. *) 829 829 + 830 830 + @param knot 831 831 + Git push server hostname. Defaults to git.recoil.org if not provided. *) 811 832 let url_to_push_url ?knot uri = 812 833 let scheme = Uri.scheme uri in 813 834 let host = Uri.host uri in ··· 897 918 let checkout_dir = Package.checkout_dir ~checkouts_root pkg in 898 919 let url = Uri.of_string (Fpath.to_string checkout_dir) in 899 920 if Git.Subtree.exists ~fs ~repo:monorepo ~prefix then begin 900 900 - Log.info (fun m -> m "Pulling subtree %s from %a" prefix Fpath.pp checkout_dir); 921 921 + Log.info (fun m -> 922 922 + m "Pulling subtree %s from %a" prefix Fpath.pp checkout_dir); 901 923 match Git.Subtree.pull ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 902 924 | Ok () -> Ok false (* not newly added *) 903 925 | Error e -> Error (Git_error e) 904 926 end 905 927 else begin 906 906 - Log.info (fun m -> m "Adding subtree %s from %a" prefix Fpath.pp checkout_dir); 928 928 + Log.info (fun m -> 929 929 + m "Adding subtree %s from %a" prefix Fpath.pp checkout_dir); 907 930 match Git.Subtree.add ~proc ~fs ~repo:monorepo ~prefix ~url ~branch () with 908 931 | Ok () -> Ok true (* newly added *) 909 932 | Error e -> Error (Git_error e) ··· 1135 1158 This preserves commit identity, ensuring round-trips converge. *) 1136 1159 let checkout_url = Uri.of_string (Fpath.to_string checkout_dir) in 1137 1160 Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir); 1138 1138 - let* () = Git.Subtree.push ~proc ~fs ~repo:monorepo ~prefix ~url:checkout_url ~branch () in 1161 1161 + let* () = 1162 1162 + Git.Subtree.push ~proc ~fs ~repo:monorepo ~prefix ~url:checkout_url 1163 1163 + ~branch () 1164 1164 + in 1139 1165 Ok () 1140 1166 end 1141 1167 ··· 1287 1313 Eio.Switch.run (fun sw -> 1288 1314 let child = 1289 1315 Eio.Process.spawn proc ~sw ~cwd 1290 1290 - [ "git"; "config"; "receive.denyCurrentBranch"; "updateInstead" ] 1316 1316 + [ 1317 1317 + "git"; "config"; "receive.denyCurrentBranch"; "updateInstead"; 1318 1318 + ] 1291 1319 in 1292 1320 ignore (Eio.Process.await child)); 1293 1321 Ok (true, 0) ··· 1469 1497 List.iter 1470 1498 (fun pkg -> 1471 1499 let pkg_dir = 1472 1472 - Fpath.(opam_repo / "packages" / pkg.pkg_name / (pkg.pkg_name ^ ".dev")) 1500 1500 + Fpath.( 1501 1501 + opam_repo / "packages" / pkg.pkg_name / (pkg.pkg_name ^ ".dev")) 1473 1502 in 1474 1503 let dst_path = Eio.Path.(fs / Fpath.to_string pkg_dir / "opam") in 1475 1504 let dst_content = read_file_opt dst_path in ··· 1481 1510 end) 1482 1511 pkgs; 1483 1512 if !updated > 0 then 1484 1484 - Log.info (fun m -> m "Regenerated %d opam-repo entries from monorepo" !updated) 1513 1513 + Log.info (fun m -> 1514 1514 + m "Regenerated %d opam-repo entries from monorepo" !updated) 1485 1515 1486 1486 - (** Clone monorepo and opam-repo from verse registry if they don't exist locally. 1487 1487 - This enables `monopam sync` to work in a fresh devcontainer. *) 1516 1516 + (** Clone monorepo and opam-repo from verse registry if they don't exist 1517 1517 + locally. This enables `monopam sync` to work in a fresh devcontainer. *) 1488 1518 let clone_from_verse_if_needed ~proc ~fs ~config () = 1489 1519 let monorepo = Config.Paths.monorepo config in 1490 1520 let opam_repo = Config.Paths.opam_repo config in ··· 1498 1528 match Verse_config.load ~fs () with 1499 1529 | Error _ -> 1500 1530 (* No verse config - can't clone from registry *) 1501 1501 - Log.debug (fun m -> m "No verse config found, will initialize fresh repos"); 1531 1531 + Log.debug (fun m -> 1532 1532 + m "No verse config found, will initialize fresh repos"); 1502 1533 Ok () 1503 1503 - | Ok verse_config -> 1534 1534 + | Ok verse_config -> ( 1504 1535 let handle = Verse_config.handle verse_config in 1505 1536 Log.info (fun m -> m "Found verse config for handle: %s" handle); 1506 1537 (* Load registry to look up URLs *) 1507 1507 - match Verse_registry.clone_or_pull ~proc ~fs ~config:verse_config () with 1538 1538 + match 1539 1539 + Verse_registry.clone_or_pull ~proc ~fs ~config:verse_config () 1540 1540 + with 1508 1541 | Error msg -> 1509 1542 Log.warn (fun m -> m "Could not load verse registry: %s" msg); 1510 1510 - Ok () (* Continue without cloning - will init fresh *) 1511 1511 - | Ok registry -> 1543 1543 + Ok () (* Continue without cloning - will init fresh *) 1544 1544 + | Ok registry -> ( 1512 1545 match Verse_registry.find_member registry ~handle with 1513 1546 | None -> 1514 1547 Log.warn (fun m -> m "Handle %s not found in registry" handle); 1515 1548 Ok () 1516 1516 - | Some member -> 1549 1549 + | Some member -> ( 1517 1550 (* Clone monorepo if needed *) 1518 1551 let result = 1519 1552 if monorepo_exists then Ok () 1520 1553 else begin 1521 1521 - Log.app (fun m -> m "Cloning monorepo from %s..." member.monorepo); 1554 1554 + Log.app (fun m -> 1555 1555 + m "Cloning monorepo from %s..." member.monorepo); 1522 1556 let url = Uri.of_string member.monorepo in 1523 1523 - let branch = Option.value ~default:"main" member.monorepo_branch in 1557 1557 + let branch = 1558 1558 + Option.value ~default:"main" member.monorepo_branch 1559 1559 + in 1524 1560 match Git.clone ~proc ~fs ~url ~branch monorepo with 1525 1561 | Ok () -> 1526 1562 Log.app (fun m -> m "Monorepo cloned successfully"); 1527 1563 Ok () 1528 1564 | Error e -> 1529 1529 - Log.err (fun m -> m "Failed to clone monorepo: %a" Git.pp_error e); 1565 1565 + Log.err (fun m -> 1566 1566 + m "Failed to clone monorepo: %a" Git.pp_error e); 1530 1567 Error (Git_error e) 1531 1568 end 1532 1569 in ··· 1536 1573 (* Clone opam-repo if needed *) 1537 1574 if opam_repo_exists then Ok () 1538 1575 else begin 1539 1539 - Log.app (fun m -> m "Cloning opam-repo from %s..." member.opamrepo); 1576 1576 + Log.app (fun m -> 1577 1577 + m "Cloning opam-repo from %s..." member.opamrepo); 1540 1578 let url = Uri.of_string member.opamrepo in 1541 1541 - let branch = Option.value ~default:"main" member.opamrepo_branch in 1579 1579 + let branch = 1580 1580 + Option.value ~default:"main" member.opamrepo_branch 1581 1581 + in 1542 1582 match Git.clone ~proc ~fs ~url ~branch opam_repo with 1543 1583 | Ok () -> 1544 1584 Log.app (fun m -> m "Opam-repo cloned successfully"); 1545 1585 Ok () 1546 1586 | Error e -> 1547 1547 - Log.err (fun m -> m "Failed to clone opam-repo: %a" Git.pp_error e); 1587 1587 + Log.err (fun m -> 1588 1588 + m "Failed to clone opam-repo: %a" Git.pp_error e); 1548 1589 Error (Git_error e) 1549 1549 - end 1590 1590 + end))) 1550 1591 1551 1592 let sync ~proc ~fs ~config ?package ?(remote = false) ?(skip_push = false) 1552 1593 ?(skip_pull = false) () = ··· 1554 1595 1555 1596 (* Step 0: Sync verse members if verse config exists and not skipping pull *) 1556 1597 (if not skip_pull then 1557 1557 - match Verse_config.load ~fs:fs_t () with 1558 1558 - | Error _ -> () (* No verse config = skip *) 1559 1559 - | Ok verse_config -> 1560 1560 - Log.app (fun m -> m "Syncing verse members..."); 1561 1561 - match Verse.pull ~proc ~fs:fs_t ~config:verse_config () with 1562 1562 - | Ok () -> () 1563 1563 - | Error e -> Log.warn (fun m -> m "Verse sync: %a" Verse.pp_error e)); 1598 1598 + match Verse_config.load ~fs:fs_t () with 1599 1599 + | Error _ -> () (* No verse config = skip *) 1600 1600 + | Ok verse_config -> ( 1601 1601 + Log.app (fun m -> m "Syncing verse members..."); 1602 1602 + match Verse.pull ~proc ~fs:fs_t ~config:verse_config () with 1603 1603 + | Ok () -> () 1604 1604 + | Error e -> Log.warn (fun m -> m "Verse sync: %a" Verse.pp_error e))); 1564 1605 1565 1606 (* Clone from verse registry if repos don't exist *) 1566 1607 match clone_from_verse_if_needed ~proc ~fs:fs_t ~config () with 1567 1608 | Error e -> Error e 1568 1568 - | Ok () -> 1569 1569 - 1570 1570 - (* Update the opam repo first - clone if needed *) 1571 1571 - let opam_repo = Config.Paths.opam_repo config in 1572 1572 - if (not skip_pull) && Git.is_repo ~proc ~fs:fs_t opam_repo then begin 1573 1573 - Log.info (fun m -> m "Updating opam repo at %a" Fpath.pp opam_repo); 1574 1574 - let result = 1575 1575 - let ( let* ) = Result.bind in 1576 1576 - let* () = Git.fetch ~proc ~fs:fs_t opam_repo in 1577 1577 - Git.merge_ff ~proc ~fs:fs_t opam_repo 1578 1578 - in 1579 1579 - match result with 1580 1580 - | Ok () -> () 1581 1581 - | Error e -> 1582 1582 - Log.warn (fun m -> m "Failed to update opam repo: %a" Git.pp_error e) 1583 1583 - end; 1584 1584 - (* Ensure directories exist *) 1585 1585 - ensure_checkouts_dir ~fs:fs_t ~config; 1586 1586 - match ensure_monorepo_initialized ~proc ~fs:fs_t ~config with 1587 1587 - | Error e -> Error e 1588 1609 | Ok () -> ( 1589 1589 - (* Check for uncommitted changes in monorepo *) 1590 1590 - let monorepo = Config.Paths.monorepo config in 1591 1591 - if Git.is_dirty ~proc ~fs:fs_t monorepo then begin 1592 1592 - Log.err (fun m -> m "Monorepo has uncommitted changes"); 1593 1593 - Error Monorepo_dirty 1594 1594 - end 1595 1595 - else begin 1596 1596 - (* Regenerate opam-repo from monorepo to ensure URLs are up to date *) 1597 1597 - regenerate_opam_repo ~fs:(fs_t :> _ Eio.Path.t) ~config (); 1598 1598 - match discover_packages ~fs:(fs_t :> _ Eio.Path.t) ~config () with 1610 1610 + (* Update the opam repo first - clone if needed *) 1611 1611 + let opam_repo = Config.Paths.opam_repo config in 1612 1612 + if (not skip_pull) && Git.is_repo ~proc ~fs:fs_t opam_repo then begin 1613 1613 + Log.info (fun m -> m "Updating opam repo at %a" Fpath.pp opam_repo); 1614 1614 + let result = 1615 1615 + let ( let* ) = Result.bind in 1616 1616 + let* () = Git.fetch ~proc ~fs:fs_t opam_repo in 1617 1617 + Git.merge_ff ~proc ~fs:fs_t opam_repo 1618 1618 + in 1619 1619 + match result with 1620 1620 + | Ok () -> () 1621 1621 + | Error e -> 1622 1622 + Log.warn (fun m -> 1623 1623 + m "Failed to update opam repo: %a" Git.pp_error e) 1624 1624 + end; 1625 1625 + (* Ensure directories exist *) 1626 1626 + ensure_checkouts_dir ~fs:fs_t ~config; 1627 1627 + match ensure_monorepo_initialized ~proc ~fs:fs_t ~config with 1599 1628 | Error e -> Error e 1600 1600 - | Ok all_pkgs -> 1601 1601 - let pkgs = 1602 1602 - match package with 1603 1603 - | None -> all_pkgs 1604 1604 - | Some name -> List.filter (fun p -> Package.name p = name) all_pkgs 1605 1605 - in 1606 1606 - if pkgs = [] && package <> None then 1607 1607 - Error (Package_not_found (Option.get package)) 1629 1629 + | Ok () -> 1630 1630 + (* Check for uncommitted changes in monorepo *) 1631 1631 + let monorepo = Config.Paths.monorepo config in 1632 1632 + if Git.is_dirty ~proc ~fs:fs_t monorepo then begin 1633 1633 + Log.err (fun m -> m "Monorepo has uncommitted changes"); 1634 1634 + Error Monorepo_dirty 1635 1635 + end 1608 1636 else begin 1609 1609 - (* Step 1: Validate - check for dirty state *) 1610 1610 - Log.info (fun m -> 1611 1611 - m "Checking status of %d packages" (List.length pkgs)); 1612 1612 - let statuses = Status.compute_all ~proc ~fs:fs_t ~config pkgs in 1613 1613 - let dirty = 1614 1614 - List.filter Status.has_local_changes statuses 1615 1615 - |> List.map (fun s -> s.Status.package) 1616 1616 - in 1617 1617 - if dirty <> [] then Error (Dirty_state dirty) 1618 1618 - else begin 1619 1619 - let repos = unique_repos pkgs in 1620 1620 - let total = List.length repos in 1621 1621 - Log.app (fun m -> m "Syncing %d repositories..." total); 1622 1622 - 1623 1623 - (* Build status lookup for optimization *) 1624 1624 - let status_by_name = 1625 1625 - List.map (fun s -> (Package.name s.Status.package, s)) statuses 1626 1626 - in 1627 1627 - let sync_needs_push = function 1628 1628 - | Status.Subtree_ahead _ | Status.Trees_differ -> true 1629 1629 - | Status.In_sync | Status.Subtree_behind _ | Status.Unknown -> 1630 1630 - false 1631 1631 - in 1632 1632 - let needs_push pkg = 1633 1633 - List.assoc_opt (Package.name pkg) status_by_name 1634 1634 - |> Option.fold ~none:true ~some:(fun s -> 1635 1635 - sync_needs_push s.Status.subtree_sync) 1636 1636 - in 1637 1637 - let sync_needs_pull = function 1638 1638 - | Status.Subtree_behind _ | Status.Trees_differ -> true 1639 1639 - | Status.In_sync | Status.Subtree_ahead _ | Status.Unknown -> 1640 1640 - false 1641 1641 - in 1642 1642 - let needs_pull pkg = 1643 1643 - List.assoc_opt (Package.name pkg) status_by_name 1644 1644 - |> Option.fold ~none:true ~some:(fun s -> 1645 1645 - sync_needs_pull s.Status.subtree_sync) 1646 1646 - in 1647 1647 - 1648 1648 - (* Step 2: Push phase - export monorepo changes to checkouts (PARALLEL) *) 1649 1649 - (* git subtree push is read-only on the monorepo, so safe to parallelize *) 1650 1650 - (* OPTIMIZATION: skip packages already in sync *) 1651 1651 - let push_results = 1652 1652 - if skip_push then begin 1653 1653 - Log.app (fun m -> 1654 1654 - m " Skipping push to checkouts (--skip-push)"); 1655 1655 - List.map (fun pkg -> Ok (Package.repo_name pkg)) repos 1656 1656 - end 1637 1637 + (* Regenerate opam-repo from monorepo to ensure URLs are up to date *) 1638 1638 + regenerate_opam_repo ~fs:(fs_t :> _ Eio.Path.t) ~config (); 1639 1639 + match discover_packages ~fs:(fs_t :> _ Eio.Path.t) ~config () with 1640 1640 + | Error e -> Error e 1641 1641 + | Ok all_pkgs -> 1642 1642 + let pkgs = 1643 1643 + match package with 1644 1644 + | None -> all_pkgs 1645 1645 + | Some name -> 1646 1646 + List.filter (fun p -> Package.name p = name) all_pkgs 1647 1647 + in 1648 1648 + if pkgs = [] && package <> None then 1649 1649 + Error (Package_not_found (Option.get package)) 1657 1650 else begin 1658 1658 - let to_push, to_skip = List.partition needs_push repos in 1659 1659 - Log.app (fun m -> 1660 1660 - m " Pushing monorepo changes to checkouts (parallel)..."); 1661 1661 - if to_skip <> [] then 1662 1662 - Log.app (fun m -> 1663 1663 - m " Skipping %d already-synced packages" 1664 1664 - (List.length to_skip)); 1665 1665 - (* Local git subtree push - no parallelism limit needed *) 1666 1666 - let pushed = 1667 1667 - Eio.Fiber.List.map 1668 1668 - (fun pkg -> 1669 1669 - let repo_name = Package.repo_name pkg in 1670 1670 - Log.info (fun m -> m "Push to checkout: %s" repo_name); 1671 1671 - match push_one ~proc ~fs ~config pkg with 1672 1672 - | Ok () -> Ok repo_name 1673 1673 - | Error (Git_error e) -> 1674 1674 - Error 1675 1675 - { repo_name; phase = `Push_checkout; error = e } 1676 1676 - | Error _ -> Ok repo_name) 1677 1677 - to_push 1651 1651 + (* Step 1: Validate - check for dirty state *) 1652 1652 + Log.info (fun m -> 1653 1653 + m "Checking status of %d packages" (List.length pkgs)); 1654 1654 + let statuses = 1655 1655 + Status.compute_all ~proc ~fs:fs_t ~config pkgs 1678 1656 in 1679 1679 - let skipped_ok = 1680 1680 - List.map (fun pkg -> Ok (Package.repo_name pkg)) to_skip 1657 1657 + let dirty = 1658 1658 + List.filter Status.has_local_changes statuses 1659 1659 + |> List.map (fun s -> s.Status.package) 1681 1660 in 1682 1682 - pushed @ skipped_ok 1683 1683 - end 1684 1684 - in 1685 1685 - let push_errors = 1686 1686 - List.filter_map 1687 1687 - (function Error e -> Some e | Ok _ -> None) 1688 1688 - push_results 1689 1689 - in 1661 1661 + if dirty <> [] then Error (Dirty_state dirty) 1662 1662 + else begin 1663 1663 + let repos = unique_repos pkgs in 1664 1664 + let total = List.length repos in 1665 1665 + Log.app (fun m -> m "Syncing %d repositories..." total); 1690 1666 1691 1691 - (* Steps 3-5: Pull phases (fetch, merge, subtree) - skip if --skip-pull *) 1692 1692 - let ( fetch_errors, 1693 1693 - unchanged_count, 1694 1694 - total_commits_pulled, 1695 1695 - merge_errors, 1696 1696 - subtree_errors, 1697 1697 - successfully_fetched_repos ) = 1698 1698 - if skip_pull then begin 1699 1699 - Log.app (fun m -> 1700 1700 - m " Skipping pull from remotes (--skip-pull)"); 1701 1701 - ([], List.length repos, 0, ref [], ref [], repos) 1702 1702 - end 1703 1703 - else begin 1704 1704 - (* Step 3: Fetch phase - clone/fetch from remotes (PARALLEL) *) 1705 1705 - Log.app (fun m -> m " Fetching from remotes (parallel)..."); 1706 1706 - let fetch_results = 1707 1707 - Eio.Fiber.List.map ~max_fibers:4 1708 1708 - (fun pkg -> 1709 1709 - let repo_name = Package.repo_name pkg in 1710 1710 - (* First ensure checkout exists *) 1711 1711 - match 1712 1712 - ensure_checkout_safe ~proc ~fs:fs_t ~config pkg 1713 1713 - with 1714 1714 - | Error e -> 1715 1715 - Error { repo_name; phase = `Fetch; error = e } 1716 1716 - | Ok (was_cloned, _) -> ( 1717 1717 - if was_cloned then Ok (repo_name, true, 0) 1718 1718 - else 1667 1667 + (* Build status lookup for optimization *) 1668 1668 + let status_by_name = 1669 1669 + List.map 1670 1670 + (fun s -> (Package.name s.Status.package, s)) 1671 1671 + statuses 1672 1672 + in 1673 1673 + let sync_needs_push = function 1674 1674 + | Status.Subtree_ahead _ | Status.Trees_differ -> true 1675 1675 + | Status.In_sync | Status.Subtree_behind _ 1676 1676 + | Status.Unknown -> 1677 1677 + false 1678 1678 + in 1679 1679 + let needs_push pkg = 1680 1680 + List.assoc_opt (Package.name pkg) status_by_name 1681 1681 + |> Option.fold ~none:true ~some:(fun s -> 1682 1682 + sync_needs_push s.Status.subtree_sync) 1683 1683 + in 1684 1684 + let sync_needs_pull = function 1685 1685 + | Status.Subtree_behind _ | Status.Trees_differ -> true 1686 1686 + | Status.In_sync | Status.Subtree_ahead _ | Status.Unknown 1687 1687 + -> 1688 1688 + false 1689 1689 + in 1690 1690 + let needs_pull pkg = 1691 1691 + List.assoc_opt (Package.name pkg) status_by_name 1692 1692 + |> Option.fold ~none:true ~some:(fun s -> 1693 1693 + sync_needs_pull s.Status.subtree_sync) 1694 1694 + in 1695 1695 + 1696 1696 + (* Step 2: Push phase - export monorepo changes to checkouts (PARALLEL) *) 1697 1697 + (* git subtree push is read-only on the monorepo, so safe to parallelize *) 1698 1698 + (* OPTIMIZATION: skip packages already in sync *) 1699 1699 + let push_results = 1700 1700 + if skip_push then begin 1701 1701 + Log.app (fun m -> 1702 1702 + m " Skipping push to checkouts (--skip-push)"); 1703 1703 + List.map (fun pkg -> Ok (Package.repo_name pkg)) repos 1704 1704 + end 1705 1705 + else begin 1706 1706 + let to_push, to_skip = 1707 1707 + List.partition needs_push repos 1708 1708 + in 1709 1709 + Log.app (fun m -> 1710 1710 + m 1711 1711 + " Pushing monorepo changes to checkouts \ 1712 1712 + (parallel)..."); 1713 1713 + if to_skip <> [] then 1714 1714 + Log.app (fun m -> 1715 1715 + m " Skipping %d already-synced packages" 1716 1716 + (List.length to_skip)); 1717 1717 + (* Local git subtree push - no parallelism limit needed *) 1718 1718 + let pushed = 1719 1719 + Eio.Fiber.List.map 1720 1720 + (fun pkg -> 1721 1721 + let repo_name = Package.repo_name pkg in 1722 1722 + Log.info (fun m -> 1723 1723 + m "Push to checkout: %s" repo_name); 1724 1724 + match push_one ~proc ~fs ~config pkg with 1725 1725 + | Ok () -> Ok repo_name 1726 1726 + | Error (Git_error e) -> 1727 1727 + Error 1728 1728 + { 1729 1729 + repo_name; 1730 1730 + phase = `Push_checkout; 1731 1731 + error = e; 1732 1732 + } 1733 1733 + | Error _ -> Ok repo_name) 1734 1734 + to_push 1735 1735 + in 1736 1736 + let skipped_ok = 1737 1737 + List.map 1738 1738 + (fun pkg -> Ok (Package.repo_name pkg)) 1739 1739 + to_skip 1740 1740 + in 1741 1741 + pushed @ skipped_ok 1742 1742 + end 1743 1743 + in 1744 1744 + let push_errors = 1745 1745 + List.filter_map 1746 1746 + (function Error e -> Some e | Ok _ -> None) 1747 1747 + push_results 1748 1748 + in 1749 1749 + 1750 1750 + (* Steps 3-5: Pull phases (fetch, merge, subtree) - skip if --skip-pull *) 1751 1751 + let ( fetch_errors, 1752 1752 + unchanged_count, 1753 1753 + total_commits_pulled, 1754 1754 + merge_errors, 1755 1755 + subtree_errors, 1756 1756 + successfully_fetched_repos ) = 1757 1757 + if skip_pull then begin 1758 1758 + Log.app (fun m -> 1759 1759 + m " Skipping pull from remotes (--skip-pull)"); 1760 1760 + ([], List.length repos, 0, ref [], ref [], repos) 1761 1761 + end 1762 1762 + else begin 1763 1763 + (* Step 3: Fetch phase - clone/fetch from remotes (PARALLEL) *) 1764 1764 + Log.app (fun m -> 1765 1765 + m " Fetching from remotes (parallel)..."); 1766 1766 + let fetch_results = 1767 1767 + Eio.Fiber.List.map ~max_fibers:4 1768 1768 + (fun pkg -> 1769 1769 + let repo_name = Package.repo_name pkg in 1770 1770 + (* First ensure checkout exists *) 1719 1771 match 1720 1720 - fetch_checkout_safe ~proc ~fs:fs_t ~config pkg 1772 1772 + ensure_checkout_safe ~proc ~fs:fs_t ~config pkg 1721 1773 with 1722 1774 | Error e -> 1723 1775 Error { repo_name; phase = `Fetch; error = e } 1724 1724 - | Ok commits -> Ok (repo_name, false, commits))) 1725 1725 - repos 1726 1726 - in 1727 1727 - let fetch_errs, fetch_successes = 1728 1728 - List.partition_map 1729 1729 - (function Error e -> Left e | Ok r -> Right r) 1730 1730 - fetch_results 1731 1731 - in 1732 1732 - let cloned = 1733 1733 - List.filter (fun (_, c, _) -> c) fetch_successes 1734 1734 - in 1735 1735 - let updated = 1736 1736 - List.filter 1737 1737 - (fun (_, c, commits) -> (not c) && commits > 0) 1738 1738 - fetch_successes 1739 1739 - in 1740 1740 - let unchanged = 1741 1741 - List.length fetch_successes 1742 1742 - - List.length cloned - List.length updated 1743 1743 - in 1744 1744 - let commits_pulled = 1745 1745 - List.fold_left 1746 1746 - (fun acc (_, _, c) -> acc + c) 1747 1747 - 0 fetch_successes 1748 1748 - in 1749 1749 - Log.app (fun m -> 1750 1750 - m " Pulled: %d cloned, %d updated, %d unchanged" 1751 1751 - (List.length cloned) (List.length updated) unchanged); 1776 1776 + | Ok (was_cloned, _) -> ( 1777 1777 + if was_cloned then Ok (repo_name, true, 0) 1778 1778 + else 1779 1779 + match 1780 1780 + fetch_checkout_safe ~proc ~fs:fs_t ~config 1781 1781 + pkg 1782 1782 + with 1783 1783 + | Error e -> 1784 1784 + Error 1785 1785 + { 1786 1786 + repo_name; 1787 1787 + phase = `Fetch; 1788 1788 + error = e; 1789 1789 + } 1790 1790 + | Ok commits -> 1791 1791 + Ok (repo_name, false, commits))) 1792 1792 + repos 1793 1793 + in 1794 1794 + let fetch_errs, fetch_successes = 1795 1795 + List.partition_map 1796 1796 + (function Error e -> Left e | Ok r -> Right r) 1797 1797 + fetch_results 1798 1798 + in 1799 1799 + let cloned = 1800 1800 + List.filter (fun (_, c, _) -> c) fetch_successes 1801 1801 + in 1802 1802 + let updated = 1803 1803 + List.filter 1804 1804 + (fun (_, c, commits) -> (not c) && commits > 0) 1805 1805 + fetch_successes 1806 1806 + in 1807 1807 + let unchanged = 1808 1808 + List.length fetch_successes 1809 1809 + - List.length cloned - List.length updated 1810 1810 + in 1811 1811 + let commits_pulled = 1812 1812 + List.fold_left 1813 1813 + (fun acc (_, _, c) -> acc + c) 1814 1814 + 0 fetch_successes 1815 1815 + in 1816 1816 + Log.app (fun m -> 1817 1817 + m " Pulled: %d cloned, %d updated, %d unchanged" 1818 1818 + (List.length cloned) (List.length updated) 1819 1819 + unchanged); 1752 1820 1753 1753 - (* Filter repos to only those that were successfully fetched *) 1754 1754 - let success_names = 1755 1755 - List.map (fun (name, _, _) -> name) fetch_successes 1756 1756 - in 1757 1757 - let successfully_fetched = 1758 1758 - List.filter 1759 1759 - (fun pkg -> List.mem (Package.repo_name pkg) success_names) 1760 1760 - repos 1761 1761 - in 1821 1821 + (* Filter repos to only those that were successfully fetched *) 1822 1822 + let success_names = 1823 1823 + List.map (fun (name, _, _) -> name) fetch_successes 1824 1824 + in 1825 1825 + let successfully_fetched = 1826 1826 + List.filter 1827 1827 + (fun pkg -> 1828 1828 + List.mem (Package.repo_name pkg) success_names) 1829 1829 + repos 1830 1830 + in 1831 1831 + 1832 1832 + (* Step 4: Merge phase - fast-forward merge checkouts (SEQUENTIAL) *) 1833 1833 + Log.app (fun m -> m " Merging checkouts..."); 1834 1834 + let merge_errs = ref [] in 1835 1835 + List.iter 1836 1836 + (fun pkg -> 1837 1837 + match 1838 1838 + merge_checkout_safe ~proc ~fs:fs_t ~config pkg 1839 1839 + with 1840 1840 + | Ok () -> () 1841 1841 + | Error e -> 1842 1842 + merge_errs := 1843 1843 + { 1844 1844 + repo_name = Package.repo_name pkg; 1845 1845 + phase = `Merge; 1846 1846 + error = e; 1847 1847 + } 1848 1848 + :: !merge_errs) 1849 1849 + successfully_fetched; 1850 1850 + 1851 1851 + (* Step 5: Subtree phase - pull subtrees into monorepo (SEQUENTIAL) *) 1852 1852 + (* Check if monorepo has local modifications first *) 1853 1853 + let monorepo = Config.Paths.monorepo config in 1854 1854 + let monorepo_dirty = 1855 1855 + Git.is_dirty ~proc ~fs:fs_t monorepo 1856 1856 + in 1857 1857 + let subtree_errs = ref [] in 1858 1858 + if monorepo_dirty then begin 1859 1859 + Log.warn (fun m -> 1860 1860 + m 1861 1861 + "Monorepo has uncommitted changes, skipping \ 1862 1862 + subtree pulls"); 1863 1863 + Log.app (fun m -> 1864 1864 + m 1865 1865 + " Skipping subtree updates (local \ 1866 1866 + modifications)...") 1867 1867 + end 1868 1868 + else begin 1869 1869 + (* OPTIMIZATION: skip packages already in sync *) 1870 1870 + (* But always pull repos that received commits from fetch *) 1871 1871 + let repos_updated_by_fetch = 1872 1872 + List.filter_map 1873 1873 + (fun (name, was_cloned, commits) -> 1874 1874 + if was_cloned || commits > 0 then Some name 1875 1875 + else None) 1876 1876 + fetch_successes 1877 1877 + in 1878 1878 + let needs_pull_after_fetch pkg = 1879 1879 + needs_pull pkg 1880 1880 + || List.mem (Package.repo_name pkg) 1881 1881 + repos_updated_by_fetch 1882 1882 + in 1883 1883 + let to_pull, to_skip = 1884 1884 + List.partition needs_pull_after_fetch 1885 1885 + successfully_fetched 1886 1886 + in 1887 1887 + Log.app (fun m -> m " Updating subtrees..."); 1888 1888 + if to_skip <> [] then 1889 1889 + Log.app (fun m -> 1890 1890 + m " Skipping %d already-synced subtrees" 1891 1891 + (List.length to_skip)); 1892 1892 + let pull_count = List.length to_pull in 1893 1893 + List.iteri 1894 1894 + (fun i pkg -> 1895 1895 + Log.info (fun m -> 1896 1896 + m "[%d/%d] Subtree %s" (i + 1) pull_count 1897 1897 + (Package.subtree_prefix pkg)); 1898 1898 + match pull_subtree ~proc ~fs ~config pkg with 1899 1899 + | Ok _ -> () 1900 1900 + | Error (Git_error e) -> 1901 1901 + subtree_errs := 1902 1902 + { 1903 1903 + repo_name = Package.repo_name pkg; 1904 1904 + phase = `Subtree; 1905 1905 + error = e; 1906 1906 + } 1907 1907 + :: !subtree_errs 1908 1908 + | Error _ -> ()) 1909 1909 + to_pull 1910 1910 + end; 1911 1911 + ( fetch_errs, 1912 1912 + unchanged, 1913 1913 + commits_pulled, 1914 1914 + merge_errs, 1915 1915 + subtree_errs, 1916 1916 + successfully_fetched ) 1917 1917 + end 1918 1918 + in 1762 1919 1763 1763 - (* Step 4: Merge phase - fast-forward merge checkouts (SEQUENTIAL) *) 1764 1764 - Log.app (fun m -> m " Merging checkouts..."); 1765 1765 - let merge_errs = ref [] in 1766 1766 - List.iter 1767 1767 - (fun pkg -> 1768 1768 - match merge_checkout_safe ~proc ~fs:fs_t ~config pkg with 1769 1769 - | Ok () -> () 1770 1770 - | Error e -> 1771 1771 - merge_errs := 1772 1772 - { 1773 1773 - repo_name = Package.repo_name pkg; 1774 1774 - phase = `Merge; 1775 1775 - error = e; 1776 1776 - } 1777 1777 - :: !merge_errs) 1778 1778 - successfully_fetched; 1920 1920 + (* Step 5.5: Verse remotes - update and fetch from verse members *) 1921 1921 + (* Only operate on successfully fetched repos to avoid missing directory errors *) 1922 1922 + (match Verse_config.load ~fs:(fs_t :> _ Eio.Path.t) () with 1923 1923 + | Error _ -> () (* No verse config, skip verse remotes *) 1924 1924 + | Ok verse_config -> 1925 1925 + sync_verse_remotes ~proc ~fs:fs_t ~config ~verse_config 1926 1926 + successfully_fetched_repos; 1927 1927 + (* Fetch from verse remotes in parallel *) 1928 1928 + Log.app (fun m -> m " Fetching from verse remotes..."); 1929 1929 + Eio.Fiber.List.iter ~max_fibers:4 1930 1930 + (fun pkg -> 1931 1931 + fetch_verse_remotes ~proc ~fs:fs_t ~config pkg) 1932 1932 + successfully_fetched_repos); 1779 1933 1780 1780 - (* Step 5: Subtree phase - pull subtrees into monorepo (SEQUENTIAL) *) 1781 1781 - (* Check if monorepo has local modifications first *) 1782 1782 - let monorepo = Config.Paths.monorepo config in 1783 1783 - let monorepo_dirty = Git.is_dirty ~proc ~fs:fs_t monorepo in 1784 1784 - let subtree_errs = ref [] in 1785 1785 - if monorepo_dirty then begin 1786 1786 - Log.warn (fun m -> 1787 1787 - m 1788 1788 - "Monorepo has uncommitted changes, skipping subtree \ 1789 1789 - pulls"); 1934 1934 + (* Step 6: Finalize - write README.md, CLAUDE.md, and dune-project (SEQUENTIAL) *) 1790 1935 Log.app (fun m -> 1791 1791 - m " Skipping subtree updates (local modifications)...") 1792 1792 - end 1793 1793 - else begin 1794 1794 - (* OPTIMIZATION: skip packages already in sync *) 1795 1795 - (* But always pull repos that received commits from fetch *) 1796 1796 - let repos_updated_by_fetch = 1797 1797 - List.filter_map 1798 1798 - (fun (name, was_cloned, commits) -> 1799 1799 - if was_cloned || commits > 0 then Some name else None) 1800 1800 - fetch_successes 1936 1936 + m " Writing README.md, CLAUDE.md, and dune-project..."); 1937 1937 + write_readme ~proc ~fs:fs_t ~config all_pkgs; 1938 1938 + write_claude_md ~proc ~fs:fs_t ~config; 1939 1939 + write_dune_project ~proc ~fs:fs_t ~config all_pkgs; 1940 1940 + 1941 1941 + (* Step 7: Remote phase - push to upstream remotes if --remote (LIMITED PARALLEL) *) 1942 1942 + (* Only push repos that were successfully fetched *) 1943 1943 + let remote_errors = 1944 1944 + if remote then begin 1945 1945 + Log.app (fun m -> m " Pushing to upstream remotes..."); 1946 1946 + (* Limit to 2 concurrent pushes to avoid overwhelming remotes *) 1947 1947 + let push_results = 1948 1948 + Eio.Fiber.List.map ~max_fibers:2 1949 1949 + (fun pkg -> 1950 1950 + let repo_name = Package.repo_name pkg in 1951 1951 + match 1952 1952 + push_remote_safe ~proc ~fs:fs_t ~config pkg 1953 1953 + with 1954 1954 + | Error e -> 1955 1955 + Error 1956 1956 + { 1957 1957 + repo_name; 1958 1958 + phase = `Push_remote; 1959 1959 + error = e; 1960 1960 + } 1961 1961 + | Ok () -> 1962 1962 + Log.app (fun m -> m " Pushed %s" repo_name); 1963 1963 + Ok repo_name) 1964 1964 + successfully_fetched_repos 1965 1965 + in 1966 1966 + let errors, successes = 1967 1967 + List.partition_map 1968 1968 + (function Error e -> Left e | Ok r -> Right r) 1969 1969 + push_results 1970 1970 + in 1971 1971 + Log.app (fun m -> 1972 1972 + m " Pushed: %d repos to upstream" 1973 1973 + (List.length successes)); 1974 1974 + errors 1975 1975 + end 1976 1976 + else [] 1801 1977 in 1802 1802 - let needs_pull_after_fetch pkg = 1803 1803 - needs_pull pkg 1804 1804 - || List.mem (Package.repo_name pkg) repos_updated_by_fetch 1978 1978 + 1979 1979 + (* Collect all errors *) 1980 1980 + let all_errors = 1981 1981 + push_errors @ fetch_errors @ !merge_errors 1982 1982 + @ !subtree_errors @ remote_errors 1805 1983 in 1806 1806 - let to_pull, to_skip = 1807 1807 - List.partition needs_pull_after_fetch successfully_fetched 1984 1984 + let summary = 1985 1985 + { 1986 1986 + repos_synced = 1987 1987 + List.length repos - List.length all_errors; 1988 1988 + repos_unchanged = unchanged_count; 1989 1989 + commits_pulled = total_commits_pulled; 1990 1990 + commits_pushed = 0; 1991 1991 + (* TODO: track this *) 1992 1992 + errors = all_errors; 1993 1993 + } 1808 1994 in 1809 1809 - Log.app (fun m -> m " Updating subtrees..."); 1810 1810 - if to_skip <> [] then 1811 1811 - Log.app (fun m -> 1812 1812 - m " Skipping %d already-synced subtrees" 1813 1813 - (List.length to_skip)); 1814 1814 - let pull_count = List.length to_pull in 1815 1815 - List.iteri 1816 1816 - (fun i pkg -> 1817 1817 - Log.info (fun m -> 1818 1818 - m "[%d/%d] Subtree %s" (i + 1) pull_count 1819 1819 - (Package.subtree_prefix pkg)); 1820 1820 - match pull_subtree ~proc ~fs ~config pkg with 1821 1821 - | Ok _ -> () 1822 1822 - | Error (Git_error e) -> 1823 1823 - subtree_errs := 1824 1824 - { 1825 1825 - repo_name = Package.repo_name pkg; 1826 1826 - phase = `Subtree; 1827 1827 - error = e; 1828 1828 - } 1829 1829 - :: !subtree_errs 1830 1830 - | Error _ -> ()) 1831 1831 - to_pull 1832 1832 - end; 1833 1833 - ( fetch_errs, 1834 1834 - unchanged, 1835 1835 - commits_pulled, 1836 1836 - merge_errs, 1837 1837 - subtree_errs, 1838 1838 - successfully_fetched ) 1839 1839 - end 1840 1840 - in 1841 1995 1842 1842 - (* Step 5.5: Verse remotes - update and fetch from verse members *) 1843 1843 - (* Only operate on successfully fetched repos to avoid missing directory errors *) 1844 1844 - (match Verse_config.load ~fs:(fs_t :> _ Eio.Path.t) () with 1845 1845 - | Error _ -> () (* No verse config, skip verse remotes *) 1846 1846 - | Ok verse_config -> 1847 1847 - sync_verse_remotes ~proc ~fs:fs_t ~config ~verse_config successfully_fetched_repos; 1848 1848 - (* Fetch from verse remotes in parallel *) 1849 1849 - Log.app (fun m -> m " Fetching from verse remotes..."); 1850 1850 - Eio.Fiber.List.iter ~max_fibers:4 1851 1851 - (fun pkg -> fetch_verse_remotes ~proc ~fs:fs_t ~config pkg) 1852 1852 - successfully_fetched_repos); 1853 1853 - 1854 1854 - (* Step 6: Finalize - write README.md, CLAUDE.md, and dune-project (SEQUENTIAL) *) 1855 1855 - Log.app (fun m -> 1856 1856 - m " Writing README.md, CLAUDE.md, and dune-project..."); 1857 1857 - write_readme ~proc ~fs:fs_t ~config all_pkgs; 1858 1858 - write_claude_md ~proc ~fs:fs_t ~config; 1859 1859 - write_dune_project ~proc ~fs:fs_t ~config all_pkgs; 1996 1996 + (* Print summary *) 1997 1997 + Log.app (fun m -> 1998 1998 + m "@.Summary: %d synced, %d errors" summary.repos_synced 1999 1999 + (List.length summary.errors)); 2000 2000 + if summary.errors <> [] then 2001 2001 + List.iter 2002 2002 + (fun e -> 2003 2003 + Log.warn (fun m -> m " %a" pp_sync_failure e)) 2004 2004 + summary.errors; 1860 2005 1861 1861 - (* Step 7: Remote phase - push to upstream remotes if --remote (LIMITED PARALLEL) *) 1862 1862 - (* Only push repos that were successfully fetched *) 1863 1863 - let remote_errors = 1864 1864 - if remote then begin 1865 1865 - Log.app (fun m -> m " Pushing to upstream remotes..."); 1866 1866 - (* Limit to 2 concurrent pushes to avoid overwhelming remotes *) 1867 1867 - let push_results = 1868 1868 - Eio.Fiber.List.map ~max_fibers:2 1869 1869 - (fun pkg -> 1870 1870 - let repo_name = Package.repo_name pkg in 1871 1871 - match push_remote_safe ~proc ~fs:fs_t ~config pkg with 1872 1872 - | Error e -> 1873 1873 - Error { repo_name; phase = `Push_remote; error = e } 1874 1874 - | Ok () -> 1875 1875 - Log.app (fun m -> m " Pushed %s" repo_name); 1876 1876 - Ok repo_name) 1877 1877 - successfully_fetched_repos 1878 1878 - in 1879 1879 - let errors, successes = 1880 1880 - List.partition_map 1881 1881 - (function Error e -> Left e | Ok r -> Right r) 1882 1882 - push_results 1883 1883 - in 1884 1884 - Log.app (fun m -> 1885 1885 - m " Pushed: %d repos to upstream" (List.length successes)); 1886 1886 - errors 2006 2006 + Ok summary 2007 2007 + end 1887 2008 end 1888 1888 - else [] 1889 1889 - in 1890 1890 - 1891 1891 - (* Collect all errors *) 1892 1892 - let all_errors = 1893 1893 - push_errors @ fetch_errors @ !merge_errors @ !subtree_errors 1894 1894 - @ remote_errors 1895 1895 - in 1896 1896 - let summary = 1897 1897 - { 1898 1898 - repos_synced = List.length repos - List.length all_errors; 1899 1899 - repos_unchanged = unchanged_count; 1900 1900 - commits_pulled = total_commits_pulled; 1901 1901 - commits_pushed = 0; 1902 1902 - (* TODO: track this *) 1903 1903 - errors = all_errors; 1904 1904 - } 1905 1905 - in 1906 1906 - 1907 1907 - (* Print summary *) 1908 1908 - Log.app (fun m -> 1909 1909 - m "@.Summary: %d synced, %d errors" summary.repos_synced 1910 1910 - (List.length summary.errors)); 1911 1911 - if summary.errors <> [] then 1912 1912 - List.iter 1913 1913 - (fun e -> Log.warn (fun m -> m " %a" pp_sync_failure e)) 1914 1914 - summary.errors; 1915 1915 - 1916 1916 - Ok summary 1917 1917 - end 1918 1918 - end 1919 1919 - end) 2009 2009 + end) 1920 2010 1921 2011 (* Opam metadata sync: copy .opam files from monorepo subtrees to opam-repo *) 1922 2012 ··· 1979 2069 | Ok s -> 1980 2070 let count = List.length (Sources_registry.to_list s) in 1981 2071 if count > 0 then 1982 1982 - Log.info (fun m -> m "Loaded %d source overrides from sources.toml" count); 2072 2072 + Log.info (fun m -> 2073 2073 + m "Loaded %d source overrides from sources.toml" count); 1983 2074 s 1984 2075 | Error msg -> 1985 2076 Log.warn (fun m -> m "Failed to load sources.toml: %s" msg); ··· 1987 2078 in 1988 2079 1989 2080 (* Discover packages from monorepo *) 1990 1990 - match discover_packages_from_monorepo ~fs:(fs :> _ Eio.Path.t) ~config ~sources () with 2081 2081 + match 2082 2082 + discover_packages_from_monorepo ~fs:(fs :> _ Eio.Path.t) ~config ~sources () 2083 2083 + with 1991 2084 | Error e -> Error e 1992 2085 | Ok all_pkgs -> 1993 2086 (* Filter to specific package/subtree if requested *) ··· 2012 2105 (fun pkg -> 2013 2106 (* Destination: opam-repo/packages/<name>/<name>.dev/opam *) 2014 2107 let pkg_dir = 2015 2015 - Fpath.(opam_repo / "packages" / pkg.pkg_name / (pkg.pkg_name ^ ".dev")) 2108 2108 + Fpath.( 2109 2109 + opam_repo / "packages" / pkg.pkg_name / (pkg.pkg_name ^ ".dev")) 2016 2110 in 2017 2111 let dst_path = Eio.Path.(fs / Fpath.to_string pkg_dir / "opam") in 2018 2112 ··· 2043 2137 2044 2138 (* Find and delete orphaned packages *) 2045 2139 let generated_names = 2046 2046 - List.map (fun p -> p.pkg_name) pkgs 2047 2047 - |> List.sort_uniq String.compare 2140 2140 + List.map (fun p -> p.pkg_name) pkgs |> List.sort_uniq String.compare 2048 2141 in 2049 2142 let existing_packages = list_opam_repo_packages ~fs ~config in 2050 2143 let orphaned = ··· 2070 2163 { 2071 2164 synced = List.rev !synced; 2072 2165 unchanged = List.rev !unchanged; 2073 2073 - missing = []; (* No longer used in generation-based approach *) 2166 2166 + missing = []; 2167 2167 + (* No longer used in generation-based approach *) 2074 2168 orphaned = deleted; 2075 2169 } 2076 2170 in ··· 2600 2694 handle : string; 2601 2695 relationship : Forks.relationship; 2602 2696 commits : Git.log_entry list; 2603 2603 - patches : (string * string) list; (* hash -> patch content *) 2697 2697 + patches : (string * string) list; (* hash -> patch content *) 2604 2698 } 2605 2699 2606 2606 - type diff_result = { 2607 2607 - entries : diff_entry list; 2608 2608 - forks : Forks.t; 2609 2609 - } 2700 2700 + type diff_result = { entries : diff_entry list; forks : Forks.t } 2610 2701 2611 2702 let pp_diff_entry ~show_patch ppf entry = 2612 2703 let n_commits = List.length entry.commits in 2613 2704 Fmt.pf ppf "@[<v 2>%a %s (%a, %d commit%s):@," 2614 2614 - Fmt.(styled `Bold string) entry.repo_name 2615 2615 - entry.handle 2616 2616 - Forks.pp_relationship entry.relationship 2617 2617 - n_commits (if n_commits = 1 then "" else "s"); 2618 2618 - List.iter (fun (c : Git.log_entry) -> 2619 2619 - let short_hash = String.sub c.hash 0 (min 7 (String.length c.hash)) in 2620 2620 - Fmt.pf ppf " %a %s %a@," 2621 2621 - Fmt.(styled `Yellow string) short_hash 2622 2622 - c.subject 2623 2623 - Fmt.(styled `Faint string) c.author; 2624 2624 - if show_patch then 2625 2625 - match List.assoc_opt c.hash entry.patches with 2626 2626 - | Some patch -> Fmt.pf ppf "@,%s@," patch 2627 2627 - | None -> ()) 2705 2705 + Fmt.(styled `Bold string) 2706 2706 + entry.repo_name entry.handle Forks.pp_relationship entry.relationship 2707 2707 + n_commits 2708 2708 + (if n_commits = 1 then "" else "s"); 2709 2709 + List.iter 2710 2710 + (fun (c : Git.log_entry) -> 2711 2711 + let short_hash = String.sub c.hash 0 (min 7 (String.length c.hash)) in 2712 2712 + Fmt.pf ppf " %a %s %a@," 2713 2713 + Fmt.(styled `Yellow string) 2714 2714 + short_hash c.subject 2715 2715 + Fmt.(styled `Faint string) 2716 2716 + c.author; 2717 2717 + if show_patch then 2718 2718 + match List.assoc_opt c.hash entry.patches with 2719 2719 + | Some patch -> Fmt.pf ppf "@,%s@," patch 2720 2720 + | None -> ()) 2628 2721 entry.commits; 2629 2722 Fmt.pf ppf "@]" 2630 2723 ··· 2634 2727 (* Then show diffs for each entry *) 2635 2728 if result.entries <> [] then begin 2636 2729 Fmt.pf ppf "@[<v>%a@]@." 2637 2637 - Fmt.(list ~sep:(any "@,@,") (pp_diff_entry ~show_patch)) result.entries 2730 2730 + Fmt.(list ~sep:(any "@,@,") (pp_diff_entry ~show_patch)) 2731 2731 + result.entries 2638 2732 end 2639 2733 2640 2734 (** Check if a string looks like a git commit hash (7+ hex chars) *) 2641 2735 let is_commit_sha s = 2642 2642 - String.length s >= 7 && 2643 2643 - String.for_all (function '0'..'9' | 'a'..'f' | 'A'..'F' -> true | _ -> false) s 2736 2736 + String.length s >= 7 2737 2737 + && String.for_all 2738 2738 + (function '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false) 2739 2739 + s 2644 2740 2645 2645 - let diff ~proc ~fs ~config ~verse_config ?repo ?(refresh=false) ?(patch=false) () = 2741 2741 + let diff ~proc ~fs ~config ~verse_config ?repo ?(refresh = false) 2742 2742 + ?(patch = false) () = 2646 2743 let checkouts_path = Config.Paths.checkouts config in 2647 2744 2648 2745 (* Compute fork analysis *) 2649 2649 - let forks = Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () in 2746 2746 + let forks = 2747 2747 + Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () 2748 2748 + in 2650 2749 2651 2750 (* Filter repos if specific one requested *) 2652 2652 - let repos_to_check = match repo with 2751 2751 + let repos_to_check = 2752 2752 + match repo with 2653 2753 | None -> forks.repos 2654 2754 | Some name -> List.filter (fun r -> r.Forks.repo_name = name) forks.repos 2655 2755 in 2656 2756 2657 2757 (* For each repo with actionable status, get commits *) 2658 2758 let entries = 2659 2659 - List.filter_map (fun (r : Forks.repo_analysis) -> 2660 2660 - (* Find actionable verse sources *) 2661 2661 - let actionable = List.filter (fun (_, _, rel) -> 2662 2662 - match rel with 2663 2663 - | Forks.I_am_behind _ -> true 2664 2664 - | Forks.Diverged _ -> true 2665 2665 - | _ -> false) 2666 2666 - r.verse_sources 2667 2667 - in 2668 2668 - match actionable with 2669 2669 - | [] -> None 2670 2670 - | sources -> 2671 2671 - (* Get commits for each actionable source *) 2672 2672 - let entries = List.filter_map (fun (handle, _src, rel) -> 2673 2673 - let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2674 2674 - if not (Git.is_repo ~proc ~fs checkout_path) then None 2675 2675 - else begin 2676 2676 - let remote_name = "verse/" ^ handle in 2677 2677 - let my_ref = "origin/main" in 2678 2678 - let their_ref = remote_name ^ "/main" in 2679 2679 - (* Get commits they have that I don't *) 2680 2680 - match Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref ~max_count:20 checkout_path with 2681 2681 - | Error _ -> None 2682 2682 - | Ok commits when commits = [] -> None 2683 2683 - | Ok commits -> 2684 2684 - (* Fetch patches if requested *) 2685 2685 - let patches = 2686 2686 - if patch then 2687 2687 - List.filter_map (fun (c : Git.log_entry) -> 2688 2688 - match Git.show_patch ~proc ~fs ~commit:c.hash checkout_path with 2689 2689 - | Ok p -> Some (c.hash, p) 2690 2690 - | Error _ -> None) 2691 2691 - commits 2692 2692 - else [] 2693 2693 - in 2694 2694 - Some { repo_name = r.repo_name; handle; relationship = rel; commits; patches } 2695 2695 - end) 2696 2696 - sources 2697 2697 - in 2698 2698 - match entries with 2699 2699 - | [] -> None 2700 2700 - | _ -> Some entries) 2759 2759 + List.filter_map 2760 2760 + (fun (r : Forks.repo_analysis) -> 2761 2761 + (* Find actionable verse sources *) 2762 2762 + let actionable = 2763 2763 + List.filter 2764 2764 + (fun (_, _, rel) -> 2765 2765 + match rel with 2766 2766 + | Forks.I_am_behind _ -> true 2767 2767 + | Forks.Diverged _ -> true 2768 2768 + | _ -> false) 2769 2769 + r.verse_sources 2770 2770 + in 2771 2771 + match actionable with 2772 2772 + | [] -> None 2773 2773 + | sources -> ( 2774 2774 + (* Get commits for each actionable source *) 2775 2775 + let entries = 2776 2776 + List.filter_map 2777 2777 + (fun (handle, _src, rel) -> 2778 2778 + let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2779 2779 + if not (Git.is_repo ~proc ~fs checkout_path) then None 2780 2780 + else begin 2781 2781 + let remote_name = "verse/" ^ handle in 2782 2782 + let my_ref = "origin/main" in 2783 2783 + let their_ref = remote_name ^ "/main" in 2784 2784 + (* Get commits they have that I don't *) 2785 2785 + match 2786 2786 + Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref 2787 2787 + ~max_count:20 checkout_path 2788 2788 + with 2789 2789 + | Error _ -> None 2790 2790 + | Ok commits when commits = [] -> None 2791 2791 + | Ok commits -> 2792 2792 + (* Fetch patches if requested *) 2793 2793 + let patches = 2794 2794 + if patch then 2795 2795 + List.filter_map 2796 2796 + (fun (c : Git.log_entry) -> 2797 2797 + match 2798 2798 + Git.show_patch ~proc ~fs ~commit:c.hash 2799 2799 + checkout_path 2800 2800 + with 2801 2801 + | Ok p -> Some (c.hash, p) 2802 2802 + | Error _ -> None) 2803 2803 + commits 2804 2804 + else [] 2805 2805 + in 2806 2806 + Some 2807 2807 + { 2808 2808 + repo_name = r.repo_name; 2809 2809 + handle; 2810 2810 + relationship = rel; 2811 2811 + commits; 2812 2812 + patches; 2813 2813 + } 2814 2814 + end) 2815 2815 + sources 2816 2816 + in 2817 2817 + match entries with [] -> None | _ -> Some entries)) 2701 2818 repos_to_check 2702 2819 |> List.flatten 2703 2820 in 2704 2821 { entries; forks } 2705 2822 2706 2706 - (** Result of looking up a specific commit *) 2707 2823 type commit_info = { 2708 2824 commit_repo : string; 2709 2825 commit_handle : string; ··· 2712 2828 commit_author : string; 2713 2829 commit_patch : string; 2714 2830 } 2831 2831 + (** Result of looking up a specific commit *) 2715 2832 2716 2833 (** Show patch for a specific commit SHA from diff output *) 2717 2717 - let diff_show_commit ~proc ~fs ~config ~verse_config ~sha ?(refresh=false) () = 2834 2834 + let diff_show_commit ~proc ~fs ~config ~verse_config ~sha ?(refresh = false) () 2835 2835 + = 2718 2836 let checkouts_path = Config.Paths.checkouts config in 2719 2837 2720 2838 (* Compute fork analysis to find which repo has this commit *) 2721 2721 - let forks = Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () in 2839 2839 + let forks = 2840 2840 + Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () 2841 2841 + in 2722 2842 2723 2843 (* Search through repos for this commit *) 2724 2724 - let result = List.find_map (fun (r : Forks.repo_analysis) -> 2725 2725 - let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2726 2726 - if not (Git.is_repo ~proc ~fs checkout_path) then None 2727 2727 - else 2728 2728 - (* Check each verse source *) 2729 2729 - List.find_map (fun (handle, _src, rel) -> 2730 2730 - match rel with 2731 2731 - | Forks.I_am_behind _ | Forks.Diverged _ -> 2732 2732 - let remote_name = "verse/" ^ handle in 2733 2733 - let my_ref = "origin/main" in 2734 2734 - let their_ref = remote_name ^ "/main" in 2735 2735 - (* Get commits they have that I don't *) 2736 2736 - (match Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref ~max_count:50 checkout_path with 2737 2737 - | Error _ -> None 2738 2738 - | Ok commits -> 2739 2739 - (* Check if our sha matches any commit *) 2740 2740 - let matching = List.find_opt (fun (c : Git.log_entry) -> 2741 2741 - String.starts_with ~prefix:sha c.hash || 2742 2742 - String.starts_with ~prefix:(String.lowercase_ascii sha) (String.lowercase_ascii c.hash)) 2743 2743 - commits 2744 2744 - in 2745 2745 - match matching with 2746 2746 - | None -> None 2747 2747 - | Some c -> 2748 2748 - match Git.show_patch ~proc ~fs ~commit:c.hash checkout_path with 2749 2749 - | Ok patch -> Some { 2750 2750 - commit_repo = r.repo_name; 2751 2751 - commit_handle = handle; 2752 2752 - commit_hash = c.hash; 2753 2753 - commit_subject = c.subject; 2754 2754 - commit_author = c.author; 2755 2755 - commit_patch = patch; 2756 2756 - } 2757 2757 - | Error _ -> None) 2758 2758 - | _ -> None) 2759 2759 - r.verse_sources) 2760 2760 - forks.repos 2844 2844 + let result = 2845 2845 + List.find_map 2846 2846 + (fun (r : Forks.repo_analysis) -> 2847 2847 + let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2848 2848 + if not (Git.is_repo ~proc ~fs checkout_path) then None 2849 2849 + else 2850 2850 + (* Check each verse source *) 2851 2851 + List.find_map 2852 2852 + (fun (handle, _src, rel) -> 2853 2853 + match rel with 2854 2854 + | Forks.I_am_behind _ | Forks.Diverged _ -> ( 2855 2855 + let remote_name = "verse/" ^ handle in 2856 2856 + let my_ref = "origin/main" in 2857 2857 + let their_ref = remote_name ^ "/main" in 2858 2858 + (* Get commits they have that I don't *) 2859 2859 + match 2860 2860 + Git.log_range ~proc ~fs ~base:my_ref ~tip:their_ref 2861 2861 + ~max_count:50 checkout_path 2862 2862 + with 2863 2863 + | Error _ -> None 2864 2864 + | Ok commits -> ( 2865 2865 + (* Check if our sha matches any commit *) 2866 2866 + let matching = 2867 2867 + List.find_opt 2868 2868 + (fun (c : Git.log_entry) -> 2869 2869 + String.starts_with ~prefix:sha c.hash 2870 2870 + || String.starts_with 2871 2871 + ~prefix:(String.lowercase_ascii sha) 2872 2872 + (String.lowercase_ascii c.hash)) 2873 2873 + commits 2874 2874 + in 2875 2875 + match matching with 2876 2876 + | None -> None 2877 2877 + | Some c -> ( 2878 2878 + match 2879 2879 + Git.show_patch ~proc ~fs ~commit:c.hash 2880 2880 + checkout_path 2881 2881 + with 2882 2882 + | Ok patch -> 2883 2883 + Some 2884 2884 + { 2885 2885 + commit_repo = r.repo_name; 2886 2886 + commit_handle = handle; 2887 2887 + commit_hash = c.hash; 2888 2888 + commit_subject = c.subject; 2889 2889 + commit_author = c.author; 2890 2890 + commit_patch = patch; 2891 2891 + } 2892 2892 + | Error _ -> None))) 2893 2893 + | _ -> None) 2894 2894 + r.verse_sources) 2895 2895 + forks.repos 2761 2896 in 2762 2897 result 2763 2898 ··· 2772 2907 let pp_handle_pull_result ppf result = 2773 2908 if result.repos_pulled <> [] then begin 2774 2909 Fmt.pf ppf "@[<v>%a@," Fmt.(styled `Bold string) "Pulled:"; 2775 2775 - List.iter (fun (repo, count) -> 2776 2776 - Fmt.pf ppf " %s: %d commits@," repo count) 2910 2910 + List.iter 2911 2911 + (fun (repo, count) -> Fmt.pf ppf " %s: %d commits@," repo count) 2777 2912 result.repos_pulled; 2778 2913 Fmt.pf ppf "@]" 2779 2914 end; 2780 2915 if result.repos_skipped <> [] then 2781 2916 Fmt.pf ppf "%a %s@," 2782 2782 - Fmt.(styled `Faint string) "Skipped:" 2917 2917 + Fmt.(styled `Faint string) 2918 2918 + "Skipped:" 2783 2919 (String.concat ", " result.repos_skipped); 2784 2920 if result.repos_failed <> [] then begin 2785 2921 Fmt.pf ppf "@[<v>%a@," Fmt.(styled `Red string) "Failed:"; 2786 2786 - List.iter (fun (repo, err) -> 2787 2787 - Fmt.pf ppf " %s: %s@," repo err) 2922 2922 + List.iter 2923 2923 + (fun (repo, err) -> Fmt.pf ppf " %s: %s@," repo err) 2788 2924 result.repos_failed; 2789 2925 Fmt.pf ppf "@]" 2790 2926 end 2791 2927 2792 2792 - let pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo ?(refresh=false) () = 2928 2928 + let pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo 2929 2929 + ?(refresh = false) () = 2793 2930 let checkouts_path = Config.Paths.checkouts config in 2794 2931 2795 2932 (* Compute fork analysis *) 2796 2796 - let forks = Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () in 2933 2933 + let forks = 2934 2934 + Forks.compute ~proc ~fs ~verse_config ~monopam_config:config ~refresh () 2935 2935 + in 2797 2936 2798 2937 (* Filter repos if specific one requested *) 2799 2799 - let repos_to_check = match repo with 2938 2938 + let repos_to_check = 2939 2939 + match repo with 2800 2940 | None -> forks.repos 2801 2941 | Some name -> List.filter (fun r -> r.Forks.repo_name = name) forks.repos 2802 2942 in ··· 2806 2946 let repos_skipped = ref [] in 2807 2947 let repos_failed = ref [] in 2808 2948 2809 2809 - List.iter (fun (r : Forks.repo_analysis) -> 2810 2810 - (* Check if this handle has commits for this repo *) 2811 2811 - let handle_source = List.find_opt (fun (h, _, _) -> h = handle) r.verse_sources in 2812 2812 - match handle_source with 2813 2813 - | None -> 2814 2814 - (* Handle doesn't have this repo *) 2815 2815 - () 2816 2816 - | Some (_, _, rel) -> 2817 2817 - let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2818 2818 - if not (Git.is_repo ~proc ~fs checkout_path) then 2819 2819 - repos_skipped := r.repo_name :: !repos_skipped 2820 2820 - else begin 2821 2821 - match rel with 2822 2822 - | Forks.Same_url | Forks.Same_commit | Forks.I_am_ahead _ -> 2823 2823 - repos_skipped := r.repo_name :: !repos_skipped 2824 2824 - | Forks.Not_fetched | Forks.Unrelated -> 2825 2825 - repos_skipped := r.repo_name :: !repos_skipped 2826 2826 - | Forks.I_am_behind count -> 2827 2827 - (* Merge their changes *) 2828 2828 - let remote_ref = "verse/" ^ handle ^ "/main" in 2829 2829 - (match Git.merge ~proc ~fs ~ref_name:remote_ref ~ff_only:true checkout_path with 2830 2830 - | Ok () -> 2831 2831 - repos_pulled := (r.repo_name, count) :: !repos_pulled 2832 2832 - | Error e -> 2833 2833 - repos_failed := (r.repo_name, Fmt.str "%a" Git.pp_error e) :: !repos_failed) 2834 2834 - | Forks.Diverged { their_ahead; _ } -> 2835 2835 - (* Merge their changes (may create a merge commit) *) 2836 2836 - let remote_ref = "verse/" ^ handle ^ "/main" in 2837 2837 - (match Git.merge ~proc ~fs ~ref_name:remote_ref checkout_path with 2838 2838 - | Ok () -> 2839 2839 - repos_pulled := (r.repo_name, their_ahead) :: !repos_pulled 2840 2840 - | Error e -> 2841 2841 - repos_failed := (r.repo_name, Fmt.str "%a" Git.pp_error e) :: !repos_failed) 2842 2842 - end) 2949 2949 + List.iter 2950 2950 + (fun (r : Forks.repo_analysis) -> 2951 2951 + (* Check if this handle has commits for this repo *) 2952 2952 + let handle_source = 2953 2953 + List.find_opt (fun (h, _, _) -> h = handle) r.verse_sources 2954 2954 + in 2955 2955 + match handle_source with 2956 2956 + | None -> 2957 2957 + (* Handle doesn't have this repo *) 2958 2958 + () 2959 2959 + | Some (_, _, rel) -> 2960 2960 + let checkout_path = Fpath.(checkouts_path / r.repo_name) in 2961 2961 + if not (Git.is_repo ~proc ~fs checkout_path) then 2962 2962 + repos_skipped := r.repo_name :: !repos_skipped 2963 2963 + else begin 2964 2964 + match rel with 2965 2965 + | Forks.Same_url | Forks.Same_commit | Forks.I_am_ahead _ -> 2966 2966 + repos_skipped := r.repo_name :: !repos_skipped 2967 2967 + | Forks.Not_fetched | Forks.Unrelated -> 2968 2968 + repos_skipped := r.repo_name :: !repos_skipped 2969 2969 + | Forks.I_am_behind count -> ( 2970 2970 + (* Merge their changes *) 2971 2971 + let remote_ref = "verse/" ^ handle ^ "/main" in 2972 2972 + match 2973 2973 + Git.merge ~proc ~fs ~ref_name:remote_ref ~ff_only:true 2974 2974 + checkout_path 2975 2975 + with 2976 2976 + | Ok () -> repos_pulled := (r.repo_name, count) :: !repos_pulled 2977 2977 + | Error e -> 2978 2978 + repos_failed := 2979 2979 + (r.repo_name, Fmt.str "%a" Git.pp_error e) 2980 2980 + :: !repos_failed) 2981 2981 + | Forks.Diverged { their_ahead; _ } -> ( 2982 2982 + (* Merge their changes (may create a merge commit) *) 2983 2983 + let remote_ref = "verse/" ^ handle ^ "/main" in 2984 2984 + match 2985 2985 + Git.merge ~proc ~fs ~ref_name:remote_ref checkout_path 2986 2986 + with 2987 2987 + | Ok () -> 2988 2988 + repos_pulled := (r.repo_name, their_ahead) :: !repos_pulled 2989 2989 + | Error e -> 2990 2990 + repos_failed := 2991 2991 + (r.repo_name, Fmt.str "%a" Git.pp_error e) 2992 2992 + :: !repos_failed) 2993 2993 + end) 2843 2994 repos_to_check; 2844 2995 2845 2845 - Ok { 2846 2846 - repos_pulled = List.rev !repos_pulled; 2847 2847 - repos_skipped = List.rev !repos_skipped; 2848 2848 - repos_failed = List.rev !repos_failed; 2849 2849 - } 2996 2996 + Ok 2997 2997 + { 2998 2998 + repos_pulled = List.rev !repos_pulled; 2999 2999 + repos_skipped = List.rev !repos_skipped; 3000 3000 + repos_failed = List.rev !repos_failed; 3001 3001 + } 2850 3002 2851 3003 (* ==================== Cherry-pick ==================== *) 2852 3004 ··· 2857 3009 } 2858 3010 2859 3011 let pp_cherrypick_result ppf result = 2860 2860 - let short_hash = String.sub result.commit_hash 0 (min 7 (String.length result.commit_hash)) in 3012 3012 + let short_hash = 3013 3013 + String.sub result.commit_hash 0 (min 7 (String.length result.commit_hash)) 3014 3014 + in 2861 3015 Fmt.pf ppf "Cherry-picked %a %s into %s@." 2862 2862 - Fmt.(styled `Yellow string) short_hash 2863 2863 - result.commit_subject 2864 2864 - result.repo_name 3016 3016 + Fmt.(styled `Yellow string) 3017 3017 + short_hash result.commit_subject result.repo_name 2865 3018 2866 2866 - let cherrypick ~proc ~fs ~config ~verse_config ~sha ?(refresh=false) () = 3019 3019 + let cherrypick ~proc ~fs ~config ~verse_config ~sha ?(refresh = false) () = 2867 3020 let checkouts_path = Config.Paths.checkouts config in 2868 3021 2869 3022 (* First, find the commit *) 2870 3023 match diff_show_commit ~proc ~fs ~config ~verse_config ~sha ~refresh () with 2871 3024 | None -> 2872 2872 - Error (Config_error (Printf.sprintf "Commit %s not found in any verse diff" sha)) 3025 3025 + Error 3026 3026 + (Config_error 3027 3027 + (Printf.sprintf "Commit %s not found in any verse diff" sha)) 2873 3028 | Some info -> 2874 3029 let checkout_path = Fpath.(checkouts_path / info.commit_repo) in 2875 3030 if not (Git.is_repo ~proc ~fs checkout_path) then 2876 2876 - Error (Config_error (Printf.sprintf "No checkout for repository %s" info.commit_repo)) 3031 3031 + Error 3032 3032 + (Config_error 3033 3033 + (Printf.sprintf "No checkout for repository %s" info.commit_repo)) 2877 3034 else begin 2878 2878 - match Git.cherry_pick ~proc ~fs ~commit:info.commit_hash checkout_path with 3035 3035 + match 3036 3036 + Git.cherry_pick ~proc ~fs ~commit:info.commit_hash checkout_path 3037 3037 + with 2879 3038 | Ok () -> 2880 2880 - Ok { 2881 2881 - repo_name = info.commit_repo; 2882 2882 - commit_hash = info.commit_hash; 2883 2883 - commit_subject = info.commit_subject; 2884 2884 - } 2885 2885 - | Error e -> 2886 2886 - Error (Git_error e) 3039 3039 + Ok 3040 3040 + { 3041 3041 + repo_name = info.commit_repo; 3042 3042 + commit_hash = info.commit_hash; 3043 3043 + commit_subject = info.commit_subject; 3044 3044 + } 3045 3045 + | Error e -> Error (Git_error e) 2887 3046 end

+49 -45

lib/monopam.mli

reviewed

··· 221 221 (** [sync_opam_files ~proc ~fs ~config ?package ()] generates opam-repo entries 222 222 from monorepo dune-project files. 223 223 224 224 - For each subtree directory in the monorepo: 225 225 - 1. Parses the dune-project to extract source/homepage URL 226 226 - 2. For each .opam file in the subtree: 227 227 - - Transforms it by removing dune-generated comment 228 228 - - Adds dev-repo and url fields derived from dune-project 229 229 - - Writes to opam-repo/packages/<name>/<name>.dev/opam 230 230 - 3. Deletes any orphaned packages in opam-repo not found in monorepo 231 231 - 4. Stages and commits changes in opam-repo 224 224 + For each subtree directory in the monorepo: 1. Parses the dune-project to 225 225 + extract source/homepage URL 2. For each .opam file in the subtree: 226 226 + - Transforms it by removing dune-generated comment 227 227 + - Adds dev-repo and url fields derived from dune-project 228 228 + - Writes to opam-repo/packages/<name>/<name>.dev/opam 3. Deletes any 229 229 + orphaned packages in opam-repo not found in monorepo 4. Stages and commits 230 230 + changes in opam-repo 232 231 233 232 This is a generation-based approach - opam-repo is derived entirely from 234 233 monorepo dune-project and .opam files. ··· 312 311 @param config Monopam configuration 313 312 @param pkgs List of packages discovered from the opam overlay *) 314 313 315 315 - (** Information about a package discovered from the monorepo. *) 316 314 type monorepo_package = { 317 315 pkg_name : string; (** Package name (from .opam filename) *) 318 316 subtree : string; (** Subtree directory name *) ··· 320 318 url_src : string; (** url src with branch (e.g., "git+https://...#main") *) 321 319 opam_content : string; (** Transformed opam file content ready to write *) 322 320 } 321 321 + (** Information about a package discovered from the monorepo. *) 323 322 324 323 val discover_packages_from_monorepo : 325 324 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 330 329 (** [discover_packages_from_monorepo ~fs ~config ?sources ()] scans monorepo 331 330 subtrees and discovers packages from dune-project files. 332 331 333 333 - For each subdirectory of the monorepo with a dune-project file: 334 334 - 1. Checks sources.toml for URL override 335 335 - 2. Falls back to dune-project source/homepage URL 336 336 - 3. For each .opam file in that directory, transforms it with dev-repo and url 332 332 + For each subdirectory of the monorepo with a dune-project file: 1. Checks 333 333 + sources.toml for URL override 2. Falls back to dune-project source/homepage 334 334 + URL 3. For each .opam file in that directory, transforms it with dev-repo 335 335 + and url 337 336 338 337 @param fs Eio filesystem 339 338 @param config Monopam configuration ··· 411 410 412 411 (** {1 Diff} *) 413 412 414 414 - (** A diff entry for a single repository showing commits from a verse member. *) 415 413 type diff_entry = { 416 414 repo_name : string; 417 415 handle : string; ··· 419 417 commits : Git.log_entry list; 420 418 patches : (string * string) list; (** hash -> patch content *) 421 419 } 420 420 + (** A diff entry for a single repository showing commits from a verse member. *) 422 421 422 422 + type diff_result = { entries : diff_entry list; forks : Forks.t } 423 423 (** Result of computing diffs for repos needing attention. *) 424 424 - type diff_result = { 425 425 - entries : diff_entry list; 426 426 - forks : Forks.t; 427 427 - } 428 424 429 425 val pp_diff_entry : show_patch:bool -> diff_entry Fmt.t 430 430 - (** [pp_diff_entry ~show_patch] formats a single diff entry. 431 431 - If [show_patch] is true, includes the patch content for each commit. *) 426 426 + (** [pp_diff_entry ~show_patch] formats a single diff entry. If [show_patch] is 427 427 + true, includes the patch content for each commit. *) 432 428 433 429 val pp_diff_result : show_patch:bool -> diff_result Fmt.t 434 430 (** [pp_diff_result ~show_patch] formats the full diff result. *) 435 431 436 432 val is_commit_sha : string -> bool 437 437 - (** [is_commit_sha s] returns true if [s] looks like a git commit hash 438 438 - (7+ hexadecimal characters). *) 433 433 + (** [is_commit_sha s] returns true if [s] looks like a git commit hash (7+ 434 434 + hexadecimal characters). *) 439 435 440 436 val diff : 441 437 proc:_ Eio.Process.mgr -> ··· 447 443 ?patch:bool -> 448 444 unit -> 449 445 diff_result 450 450 - (** [diff ~proc ~fs ~config ~verse_config ?repo ?refresh ?patch ()] computes and displays diffs 451 451 - for repositories that need attention from verse members. 446 446 + (** [diff ~proc ~fs ~config ~verse_config ?repo ?refresh ?patch ()] computes and 447 447 + displays diffs for repositories that need attention from verse members. 452 448 453 449 For each repository where a verse member is ahead (I_am_behind or Diverged), 454 450 retrieves the commit log showing what commits they have that you don't. ··· 462 458 @param verse_config Verse configuration 463 459 @param repo Optional specific repository to show diff for 464 460 @param refresh If true, force fresh fetches ignoring cache (default: false) 465 465 - @param patch If true, fetch and include patch content for each commit (default: false) *) 461 461 + @param patch 462 462 + If true, fetch and include patch content for each commit (default: false) 463 463 + *) 466 464 467 467 - (** Result of looking up a specific commit *) 468 465 type commit_info = { 469 466 commit_repo : string; 470 467 commit_handle : string; ··· 473 470 commit_author : string; 474 471 commit_patch : string; 475 472 } 473 473 + (** Result of looking up a specific commit *) 476 474 477 475 val diff_show_commit : 478 476 proc:_ Eio.Process.mgr -> ··· 483 481 ?refresh:bool -> 484 482 unit -> 485 483 commit_info option 486 486 - (** [diff_show_commit ~proc ~fs ~config ~verse_config ~sha ?refresh ()] finds and shows 487 487 - the patch for a specific commit SHA from the diff output. 484 484 + (** [diff_show_commit ~proc ~fs ~config ~verse_config ~sha ?refresh ()] finds 485 485 + and shows the patch for a specific commit SHA from the diff output. 488 486 489 487 Searches through all repos with actionable verse sources to find a commit 490 490 - matching the given SHA prefix. Returns [Some commit_info] if found, [None] otherwise. 488 488 + matching the given SHA prefix. Returns [Some commit_info] if found, [None] 489 489 + otherwise. 491 490 492 491 @param sha Commit SHA prefix (7+ characters) to look up *) 493 492 494 493 (** {1 Pull from Verse Members} *) 495 494 496 496 - (** Result of pulling from a handle. *) 497 495 type handle_pull_result = { 498 498 - repos_pulled : (string * int) list; (** (repo_name, commit_count) for each repo pulled *) 499 499 - repos_skipped : string list; (** Repos skipped (already in sync or no checkout) *) 500 500 - repos_failed : (string * string) list; (** (repo_name, error_message) for failures *) 496 496 + repos_pulled : (string * int) list; 497 497 + (** (repo_name, commit_count) for each repo pulled *) 498 498 + repos_skipped : string list; 499 499 + (** Repos skipped (already in sync or no checkout) *) 500 500 + repos_failed : (string * string) list; 501 501 + (** (repo_name, error_message) for failures *) 501 502 } 503 503 + (** Result of pulling from a handle. *) 502 504 503 505 val pp_handle_pull_result : handle_pull_result Fmt.t 504 506 (** [pp_handle_pull_result] formats a pull result. *) ··· 516 518 (** [pull_from_handle ~proc ~fs ~config ~verse_config ~handle ?repo ?refresh ()] 517 519 pulls commits from a verse member's forks into your local checkouts. 518 520 519 519 - For each repository where the handle has commits you don't have: 520 520 - 1. Merges their commits into your checkout's main branch 521 521 - 2. The changes are then ready to be synced to the monorepo via [sync] 521 521 + For each repository where the handle has commits you don't have: 1. Merges 522 522 + their commits into your checkout's main branch 2. The changes are then ready 523 523 + to be synced to the monorepo via [sync] 522 524 523 523 - If [repo] is specified, only pulls from that repository. 524 524 - Otherwise, pulls from all repositories where the handle is ahead. 525 525 + If [repo] is specified, only pulls from that repository. Otherwise, pulls 526 526 + from all repositories where the handle is ahead. 525 527 526 528 @param handle The verse member handle (e.g., "avsm.bsky.social") 527 529 @param repo Optional specific repository to pull from 528 528 - @param refresh If true, force fresh fetches ignoring cache (default: false) *) 530 530 + @param refresh If true, force fresh fetches ignoring cache (default: false) 531 531 + *) 529 532 530 533 (** {1 Cherry-pick} *) 531 534 532 532 - (** Result of cherry-picking a commit. *) 533 535 type cherrypick_result = { 534 536 repo_name : string; 535 537 commit_hash : string; 536 538 commit_subject : string; 537 539 } 540 540 + (** Result of cherry-picking a commit. *) 538 541 539 542 val pp_cherrypick_result : cherrypick_result Fmt.t 540 543 (** [pp_cherrypick_result] formats a cherry-pick result. *) ··· 548 551 ?refresh:bool -> 549 552 unit -> 550 553 (cherrypick_result, error) result 551 551 - (** [cherrypick ~proc ~fs ~config ~verse_config ~sha ?refresh ()] 552 552 - applies a specific commit from a verse member's fork to your local checkout. 554 554 + (** [cherrypick ~proc ~fs ~config ~verse_config ~sha ?refresh ()] applies a 555 555 + specific commit from a verse member's fork to your local checkout. 553 556 554 557 Finds the commit in the verse diff output and cherry-picks it into the 555 555 - appropriate local checkout. The changes are then ready to be synced to 556 556 - the monorepo via [sync]. 558 558 + appropriate local checkout. The changes are then ready to be synced to the 559 559 + monorepo via [sync]. 557 560 558 561 @param sha Commit SHA prefix (7+ characters) to cherry-pick 559 559 - @param refresh If true, force fresh fetches ignoring cache (default: false) *) 562 562 + @param refresh If true, force fresh fetches ignoring cache (default: false) 563 563 + *)

+16 -9

lib/opam_repo.ml

reviewed

··· 188 188 (** Read the raw content of an opam file. *) 189 189 let read_opam_file ~fs opam_file_path = 190 190 let eio_path = Eio.Path.(fs / Fpath.to_string opam_file_path) in 191 191 - try Ok (Eio.Path.load eio_path) with Eio.Io _ as e -> Error (Io_error (Printexc.to_string e)) 191 191 + try Ok (Eio.Path.load eio_path) 192 192 + with Eio.Io _ as e -> Error (Io_error (Printexc.to_string e)) 192 193 193 193 - (** Replace dev-repo line in content. Looks for 'dev-repo: "..."' and replaces the URL. *) 194 194 + (** Replace dev-repo line in content. Looks for 'dev-repo: "..."' and replaces 195 195 + the URL. *) 194 196 let replace_dev_repo_line content ~new_url = 195 197 let lines = String.split_on_char '\n' content in 196 198 let dev_repo_url = ··· 215 217 let url_src = 216 218 let base = 217 219 if String.starts_with ~prefix:"git@" new_url then "git+" ^ new_url 218 218 - else if String.starts_with ~prefix:"https://" new_url then "git+" ^ new_url 220 220 + else if String.starts_with ~prefix:"https://" new_url then 221 221 + "git+" ^ new_url 219 222 else if String.starts_with ~prefix:"git+" new_url then new_url 220 223 else "git+" ^ new_url 221 224 in ··· 239 242 else 240 243 (* Skip this line, it's part of the old url block *) 241 244 process rest true acc 242 242 - else if trimmed = "url {" || String.starts_with ~prefix:"url {" trimmed then 245 245 + else if trimmed = "url {" || String.starts_with ~prefix:"url {" trimmed 246 246 + then 243 247 (* Start of url block *) 244 248 if String.ends_with ~suffix:"}" trimmed then 245 249 (* Single-line url block *) ··· 252 256 in 253 257 String.concat "\n" (process lines false []) 254 258 255 255 - (** Replace the dev-repo and url fields in an opam file content with a new git URL. 256 256 - The new URL should be a plain git URL (e.g., "git@github.com:user/repo.git"). *) 259 259 + (** Replace the dev-repo and url fields in an opam file content with a new git 260 260 + URL. The new URL should be a plain git URL (e.g., 261 261 + "git@github.com:user/repo.git"). *) 257 262 let replace_dev_repo_url content ~new_url = 258 263 let content = replace_dev_repo_line content ~new_url in 259 264 let content = replace_url_section content ~new_url in 260 265 content 261 266 262 262 - (** Write an opam package to the opam-repo overlay. 263 263 - Creates the directory structure: packages/<name>/<name.version>/opam *) 267 267 + (** Write an opam package to the opam-repo overlay. Creates the directory 268 268 + structure: packages/<name>/<name.version>/opam *) 264 269 let write_package ~fs ~repo_path ~name ~version ~content = 265 265 - let pkg_dir = Fpath.(repo_path / "packages" / name / (name ^ "." ^ version)) in 270 270 + let pkg_dir = 271 271 + Fpath.(repo_path / "packages" / name / (name ^ "." ^ version)) 272 272 + in 266 273 let opam_path = Fpath.(pkg_dir / "opam") in 267 274 let eio_pkg_dir = Eio.Path.(fs / Fpath.to_string pkg_dir) in 268 275 let eio_opam_path = Eio.Path.(fs / Fpath.to_string opam_path) in

+8 -5

lib/opam_repo.mli

reviewed

··· 90 90 (** {1 Low-level Opam File Parsing} *) 91 91 92 92 val find_dev_repo : OpamParserTypes.FullPos.opamfile_item list -> string option 93 93 - (** [find_dev_repo items] extracts the dev-repo field from parsed opam file items. *) 93 93 + (** [find_dev_repo items] extracts the dev-repo field from parsed opam file 94 94 + items. *) 94 95 95 96 (** {1 Writing Packages} *) 96 97 ··· 100 101 val replace_dev_repo_url : string -> new_url:string -> string 101 102 (** [replace_dev_repo_url content ~new_url] replaces the dev-repo and url fields 102 103 in an opam file content with a new git URL. The new URL should be a plain 103 103 - git URL (e.g., "git@github.com:user/repo.git" or "https://github.com/user/repo.git"). *) 104 104 + git URL (e.g., "git@github.com:user/repo.git" or 105 105 + "https://github.com/user/repo.git"). *) 104 106 105 107 val write_package : 106 108 fs:_ Eio.Path.t -> ··· 109 111 version:string -> 110 112 content:string -> 111 113 (unit, error) result 112 112 - (** [write_package ~fs ~repo_path ~name ~version ~content] writes an opam package 113 113 - to the opam-repo overlay. 114 114 + (** [write_package ~fs ~repo_path ~name ~version ~content] writes an opam 115 115 + package to the opam-repo overlay. 114 116 115 117 Creates the directory structure: [packages/<name>/<name.version>/opam] *) 116 118 117 119 val package_exists : fs:_ Eio.Path.t -> repo_path:Fpath.t -> name:string -> bool 118 118 - (** [package_exists ~fs ~repo_path ~name] checks if a package exists in the opam-repo. *) 120 120 + (** [package_exists ~fs ~repo_path ~name] checks if a package exists in the 121 121 + opam-repo. *)

+2 -5

lib/opam_transform.ml

reviewed

··· 32 32 let trimmed = String.trim line in 33 33 if in_url_block then 34 34 (* Inside url { ... }, skip until we see } *) 35 35 - if String.starts_with ~prefix:"}" trimmed then 36 36 - process rest false acc 35 35 + if String.starts_with ~prefix:"}" trimmed then process rest false acc 37 36 else process rest true acc 38 37 else if trimmed = "url {" || String.starts_with ~prefix:"url {" trimmed 39 38 then ··· 72 71 73 72 (* Step 4: Append dev-repo and url section *) 74 73 let dev_repo_line = Printf.sprintf {|dev-repo: "%s"|} dev_repo in 75 75 - let url_section = 76 76 - Printf.sprintf "url {\n src: \"%s\"\n}" url_src 77 77 - in 74 74 + let url_section = Printf.sprintf "url {\n src: \"%s\"\n}" url_src in 78 75 content ^ "\n" ^ dev_repo_line ^ "\n" ^ url_section ^ "\n"

+4 -2

lib/opam_transform.mli

reviewed

··· 7 7 - Add url section with source URL and branch *) 8 8 9 9 val transform : content:string -> dev_repo:string -> url_src:string -> string 10 10 - (** [transform ~content ~dev_repo ~url_src] transforms a dune-generated opam file. 10 10 + (** [transform ~content ~dev_repo ~url_src] transforms a dune-generated opam 11 11 + file. 11 12 12 13 - Removes the "# This file is generated by dune" comment if present 13 14 - Adds or replaces the [dev-repo] field with [dev_repo] 14 15 - Adds or replaces the [url { src: "..." }] section with [url_src] 15 16 16 17 @param content The original opam file content 17 17 - @param dev_repo The dev-repo URL (e.g., "git+https://github.com/user/repo.git") 18 18 + @param dev_repo 19 19 + The dev-repo URL (e.g., "git+https://github.com/user/repo.git") 18 20 @param url_src The url src URL with branch (e.g., "git+https://...#main") *)

+361 -240

lib/site.ml

reviewed

··· 1 1 (** Generate a static HTML site representing the monoverse map. *) 2 2 3 3 - (** Information about a package in the verse *) 4 3 type pkg_info = { 5 4 name : string; 6 5 synopsis : string option; ··· 9 8 owners : string list; (** List of handles that have this package *) 10 9 depends : string list; (** Package dependencies *) 11 10 } 11 11 + (** Information about a package in the verse *) 12 12 13 13 - (** Information about a repository (group of packages) *) 14 13 type repo_info = { 15 14 ri_name : string; 16 15 ri_dev_repo : string; 17 16 ri_packages : pkg_info list; 18 18 - ri_owners : string list; (** All handles that have any package from this repo *) 19 19 - ri_fork_status : (string * Forks.relationship) list; (** (handle, relationship) *) 17 17 + ri_owners : string list; 18 18 + (** All handles that have any package from this repo *) 19 19 + ri_fork_status : (string * Forks.relationship) list; 20 20 + (** (handle, relationship) *) 20 21 ri_dep_count : int; (** Number of dependencies (for sorting) *) 21 22 } 23 23 + (** Information about a repository (group of packages) *) 22 24 23 23 - (** Information about a verse member *) 24 25 type member_info = { 25 26 handle : string; 26 27 display_name : string; (** Name to display (from registry or handle) *) ··· 29 30 package_count : int; 30 31 unique_packages : string list; (** Packages unique to this member *) 31 32 } 33 33 + (** Information about a verse member *) 32 34 33 33 - (** Aggregated site data *) 34 35 type site_data = { 35 36 local_handle : string; 36 37 registry_name : string; ··· 40 41 unique_repos : repo_info list; (** Repos unique to one member *) 41 42 all_packages : pkg_info list; (** All packages *) 42 43 } 44 44 + (** Aggregated site data *) 43 45 44 46 (** Scan a member's opam repo and return package info *) 45 47 let scan_member_packages ~fs opam_repo_path = 46 48 let pkgs, _errors = Opam_repo.scan_all ~fs opam_repo_path in 47 47 - List.map (fun pkg -> 48 48 - { 49 49 - name = Package.name pkg; 50 50 - synopsis = Package.synopsis pkg; 51 51 - repo_name = Package.repo_name pkg; 52 52 - dev_repo = Uri.to_string (Package.dev_repo pkg); 53 53 - owners = []; 54 54 - depends = Package.depends pkg; 55 55 - } 56 56 - ) pkgs 49 49 + List.map 50 50 + (fun pkg -> 51 51 + { 52 52 + name = Package.name pkg; 53 53 + synopsis = Package.synopsis pkg; 54 54 + repo_name = Package.repo_name pkg; 55 55 + dev_repo = Uri.to_string (Package.dev_repo pkg); 56 56 + owners = []; 57 57 + depends = Package.depends pkg; 58 58 + }) 59 59 + pkgs 57 60 58 61 (** Check if a directory exists *) 59 62 let dir_exists ~fs path = ··· 77 80 in 78 81 79 82 (* Build a map: package name -> list of (handle, pkg_info) *) 80 80 - let pkg_map : (string, (string * pkg_info) list) Hashtbl.t = Hashtbl.create 256 in 83 83 + let pkg_map : (string, (string * pkg_info) list) Hashtbl.t = 84 84 + Hashtbl.create 256 85 85 + in 81 86 82 87 (* Add local packages *) 83 83 - List.iter (fun pkg -> 84 84 - let existing = try Hashtbl.find pkg_map pkg.name with Not_found -> [] in 85 85 - Hashtbl.replace pkg_map pkg.name ((local_handle, pkg) :: existing) 86 86 - ) local_pkgs; 88 88 + List.iter 89 89 + (fun pkg -> 90 90 + let existing = try Hashtbl.find pkg_map pkg.name with Not_found -> [] in 91 91 + Hashtbl.replace pkg_map pkg.name ((local_handle, pkg) :: existing)) 92 92 + local_pkgs; 87 93 88 94 let registry_name = registry.Verse_registry.name in 89 95 let registry_description = registry.Verse_registry.description in 90 96 91 97 (* Build handle -> display name lookup *) 92 98 let handle_to_name = Hashtbl.create 16 in 93 93 - List.iter (fun (m : Verse_registry.member) -> 94 94 - let display = match m.name with Some n -> n | None -> m.handle in 95 95 - Hashtbl.replace handle_to_name m.handle display 96 96 - ) registry.Verse_registry.members; 99 99 + List.iter 100 100 + (fun (m : Verse_registry.member) -> 101 101 + let display = match m.name with Some n -> n | None -> m.handle in 102 102 + Hashtbl.replace handle_to_name m.handle display) 103 103 + registry.Verse_registry.members; 97 104 98 105 (* Get tracked handles from verse directory, excluding local handle *) 99 106 let tracked_handles = ··· 102 109 try 103 110 Eio.Path.read_dir eio_path 104 111 |> List.filter (fun name -> 105 105 - not (String.ends_with ~suffix:"-opam" name) && 106 106 - name <> local_handle && 107 107 - dir_exists ~fs Fpath.(verse_path / name)) 112 112 + (not (String.ends_with ~suffix:"-opam" name)) 113 113 + && name <> local_handle 114 114 + && dir_exists ~fs Fpath.(verse_path / name)) 108 115 with Eio.Io _ -> [] 109 116 else [] 110 117 in 111 118 112 119 (* Scan each tracked member's opam repo *) 113 120 let member_infos = 114 114 - List.filter_map (fun handle -> 115 115 - let opam_path = Fpath.(verse_path / (handle ^ "-opam")) in 116 116 - if dir_exists ~fs opam_path then begin 117 117 - let pkgs = scan_member_packages ~fs opam_path in 118 118 - (* Add to package map *) 119 119 - List.iter (fun pkg -> 120 120 - let existing = try Hashtbl.find pkg_map pkg.name with Not_found -> [] in 121 121 - Hashtbl.replace pkg_map pkg.name ((handle, pkg) :: existing) 122 122 - ) pkgs; 123 123 - (* Look up member in registry for URLs *) 124 124 - let member = Verse_registry.find_member registry ~handle in 125 125 - let display_name = 126 126 - try Hashtbl.find handle_to_name handle 127 127 - with Not_found -> handle 128 128 - in 129 129 - Some { 130 130 - handle; 131 131 - display_name; 132 132 - monorepo_url = (match member with Some m -> m.monorepo | None -> ""); 133 133 - opam_url = (match member with Some m -> m.opamrepo | None -> ""); 134 134 - package_count = List.length pkgs; 135 135 - unique_packages = []; (* Will be filled in later *) 136 136 - } 137 137 - end else None 138 138 - ) tracked_handles 121 121 + List.filter_map 122 122 + (fun handle -> 123 123 + let opam_path = Fpath.(verse_path / (handle ^ "-opam")) in 124 124 + if dir_exists ~fs opam_path then begin 125 125 + let pkgs = scan_member_packages ~fs opam_path in 126 126 + (* Add to package map *) 127 127 + List.iter 128 128 + (fun pkg -> 129 129 + let existing = 130 130 + try Hashtbl.find pkg_map pkg.name with Not_found -> [] 131 131 + in 132 132 + Hashtbl.replace pkg_map pkg.name ((handle, pkg) :: existing)) 133 133 + pkgs; 134 134 + (* Look up member in registry for URLs *) 135 135 + let member = Verse_registry.find_member registry ~handle in 136 136 + let display_name = 137 137 + try Hashtbl.find handle_to_name handle with Not_found -> handle 138 138 + in 139 139 + Some 140 140 + { 141 141 + handle; 142 142 + display_name; 143 143 + monorepo_url = 144 144 + (match member with Some m -> m.monorepo | None -> ""); 145 145 + opam_url = (match member with Some m -> m.opamrepo | None -> ""); 146 146 + package_count = List.length pkgs; 147 147 + unique_packages = []; 148 148 + (* Will be filled in later *) 149 149 + } 150 150 + end 151 151 + else None) 152 152 + tracked_handles 139 153 in 140 154 141 155 (* Add local member info *) ··· 157 171 158 172 (* Build final package list with owners *) 159 173 let all_packages = 160 160 - Hashtbl.fold (fun _name entries acc -> 161 161 - match entries with 162 162 - | [] -> acc 163 163 - | (_, pkg) :: _ as all -> 164 164 - let owners = List.map fst all in 165 165 - (* Pick the best synopsis (first non-None) *) 166 166 - let synopsis = 167 167 - List.find_map (fun (_, p) -> p.synopsis) all 168 168 - in 169 169 - (* Merge depends from all sources *) 170 170 - let depends = 171 171 - List.concat_map (fun (_, p) -> p.depends) all 172 172 - |> List.sort_uniq String.compare 173 173 - in 174 174 - { pkg with owners; synopsis; depends } :: acc 175 175 - ) pkg_map [] 174 174 + Hashtbl.fold 175 175 + (fun _name entries acc -> 176 176 + match entries with 177 177 + | [] -> acc 178 178 + | (_, pkg) :: _ as all -> 179 179 + let owners = List.map fst all in 180 180 + (* Pick the best synopsis (first non-None) *) 181 181 + let synopsis = List.find_map (fun (_, p) -> p.synopsis) all in 182 182 + (* Merge depends from all sources *) 183 183 + let depends = 184 184 + List.concat_map (fun (_, p) -> p.depends) all 185 185 + |> List.sort_uniq String.compare 186 186 + in 187 187 + { pkg with owners; synopsis; depends } :: acc) 188 188 + pkg_map [] 176 189 |> List.sort (fun a b -> String.compare a.name b.name) 177 190 in 178 191 179 192 (* Build set of all package names for dependency counting *) 180 193 let all_pkg_names = 181 181 - List.fold_left (fun s p -> Hashtbl.replace s p.name (); s) 194 194 + List.fold_left 195 195 + (fun s p -> 196 196 + Hashtbl.replace s p.name (); 197 197 + s) 182 198 (Hashtbl.create 256) all_packages 183 199 in 184 200 185 201 (* Group packages by repo *) 186 202 let repos_map : (string, pkg_info list) Hashtbl.t = Hashtbl.create 64 in 187 187 - List.iter (fun (pkg : pkg_info) -> 188 188 - let existing = try Hashtbl.find repos_map pkg.repo_name with Not_found -> [] in 189 189 - Hashtbl.replace repos_map pkg.repo_name (pkg :: existing) 190 190 - ) all_packages; 203 203 + List.iter 204 204 + (fun (pkg : pkg_info) -> 205 205 + let existing = 206 206 + try Hashtbl.find repos_map pkg.repo_name with Not_found -> [] 207 207 + in 208 208 + Hashtbl.replace repos_map pkg.repo_name (pkg :: existing)) 209 209 + all_packages; 191 210 192 211 (* Build forks status lookup from forks data if provided *) 193 193 - let forks_by_repo : (string, (string * Forks.relationship) list) Hashtbl.t = Hashtbl.create 64 in 212 212 + let forks_by_repo : (string, (string * Forks.relationship) list) Hashtbl.t = 213 213 + Hashtbl.create 64 214 214 + in 194 215 (match forks with 195 195 - | Some f -> 196 196 - List.iter (fun (ra : Forks.repo_analysis) -> 197 197 - let statuses = List.map (fun (h, _src, rel) -> (h, rel)) ra.verse_sources in 198 198 - Hashtbl.replace forks_by_repo ra.repo_name statuses 199 199 - ) f.Forks.repos 200 200 - | None -> ()); 216 216 + | Some f -> 217 217 + List.iter 218 218 + (fun (ra : Forks.repo_analysis) -> 219 219 + let statuses = 220 220 + List.map (fun (h, _src, rel) -> (h, rel)) ra.verse_sources 221 221 + in 222 222 + Hashtbl.replace forks_by_repo ra.repo_name statuses) 223 223 + f.Forks.repos 224 224 + | None -> ()); 201 225 202 226 (* Build repo_info list with dependency counts *) 203 227 let all_repos = 204 204 - Hashtbl.fold (fun repo_name pkgs acc -> 205 205 - let dev_repo = (List.hd pkgs).dev_repo in 206 206 - let owners = 207 207 - List.sort_uniq String.compare (List.concat_map (fun (p : pkg_info) -> p.owners) pkgs) 208 208 - in 209 209 - let fork_status = 210 210 - try Hashtbl.find forks_by_repo repo_name with Not_found -> [] 211 211 - in 212 212 - (* Count dependencies that are in our package set *) 213 213 - let dep_count = 214 214 - List.concat_map (fun (p : pkg_info) -> p.depends) pkgs 215 215 - |> List.filter (fun d -> Hashtbl.mem all_pkg_names d) 216 216 - |> List.sort_uniq String.compare 217 217 - |> List.length 218 218 - in 219 219 - { ri_name = repo_name; 220 220 - ri_dev_repo = dev_repo; 221 221 - ri_packages = List.sort (fun a b -> String.compare a.name b.name) pkgs; 222 222 - ri_owners = owners; 223 223 - ri_fork_status = fork_status; 224 224 - ri_dep_count = dep_count } :: acc 225 225 - ) repos_map [] 228 228 + Hashtbl.fold 229 229 + (fun repo_name pkgs acc -> 230 230 + let dev_repo = (List.hd pkgs).dev_repo in 231 231 + let owners = 232 232 + List.sort_uniq String.compare 233 233 + (List.concat_map (fun (p : pkg_info) -> p.owners) pkgs) 234 234 + in 235 235 + let fork_status = 236 236 + try Hashtbl.find forks_by_repo repo_name with Not_found -> [] 237 237 + in 238 238 + (* Count dependencies that are in our package set *) 239 239 + let dep_count = 240 240 + List.concat_map (fun (p : pkg_info) -> p.depends) pkgs 241 241 + |> List.filter (fun d -> Hashtbl.mem all_pkg_names d) 242 242 + |> List.sort_uniq String.compare 243 243 + |> List.length 244 244 + in 245 245 + { 246 246 + ri_name = repo_name; 247 247 + ri_dev_repo = dev_repo; 248 248 + ri_packages = List.sort (fun a b -> String.compare a.name b.name) pkgs; 249 249 + ri_owners = owners; 250 250 + ri_fork_status = fork_status; 251 251 + ri_dep_count = dep_count; 252 252 + } 253 253 + :: acc) 254 254 + repos_map [] 226 255 (* Sort by dependency count descending (apps with most deps first), then by name *) 227 256 |> List.sort (fun a b -> 228 257 let cmp = compare b.ri_dep_count a.ri_dep_count in ··· 230 259 in 231 260 232 261 (* Separate common and unique repos *) 233 233 - let common_repos = List.filter (fun r -> List.length r.ri_owners > 1) all_repos in 234 234 - let unique_repos = List.filter (fun r -> List.length r.ri_owners = 1) all_repos in 262 262 + let common_repos = 263 263 + List.filter (fun r -> List.length r.ri_owners > 1) all_repos 264 264 + in 265 265 + let unique_repos = 266 266 + List.filter (fun r -> List.length r.ri_owners = 1) all_repos 267 267 + in 235 268 236 269 (* Compute unique packages per member *) 237 270 let unique_by_handle = Hashtbl.create 32 in 238 238 - List.iter (fun (pkg : pkg_info) -> 239 239 - if List.length pkg.owners = 1 then begin 240 240 - let handle = List.hd pkg.owners in 241 241 - let existing = try Hashtbl.find unique_by_handle handle with Not_found -> [] in 242 242 - Hashtbl.replace unique_by_handle handle (pkg.name :: existing) 243 243 - end 244 244 - ) all_packages; 271 271 + List.iter 272 272 + (fun (pkg : pkg_info) -> 273 273 + if List.length pkg.owners = 1 then begin 274 274 + let handle = List.hd pkg.owners in 275 275 + let existing = 276 276 + try Hashtbl.find unique_by_handle handle with Not_found -> [] 277 277 + in 278 278 + Hashtbl.replace unique_by_handle handle (pkg.name :: existing) 279 279 + end) 280 280 + all_packages; 245 281 246 282 (* Update member infos with unique packages *) 247 283 let update_member m = 248 248 - let unique = try Hashtbl.find unique_by_handle m.handle with Not_found -> [] in 284 284 + let unique = 285 285 + try Hashtbl.find unique_by_handle m.handle with Not_found -> [] 286 286 + in 249 287 { m with unique_packages = List.sort String.compare unique } 250 288 in 251 289 252 290 let all_members = local_member :: member_infos in 253 291 let members = List.map update_member all_members in 254 292 255 255 - { local_handle; registry_name; registry_description; members; common_repos; unique_repos; all_packages } 293 293 + { 294 294 + local_handle; 295 295 + registry_name; 296 296 + registry_description; 297 297 + members; 298 298 + common_repos; 299 299 + unique_repos; 300 300 + all_packages; 301 301 + } 256 302 257 303 (** Escape HTML special characters *) 258 304 let html_escape s = 259 305 let buf = Buffer.create (String.length s) in 260 260 - String.iter (function 261 261 - | '<' -> Buffer.add_string buf "&lt;" 262 262 - | '>' -> Buffer.add_string buf "&gt;" 263 263 - | '&' -> Buffer.add_string buf "&amp;" 264 264 - | '"' -> Buffer.add_string buf "&quot;" 265 265 - | c -> Buffer.add_char buf c 266 266 - ) s; 306 306 + String.iter 307 307 + (function 308 308 + | '<' -> Buffer.add_string buf "&lt;" 309 309 + | '>' -> Buffer.add_string buf "&gt;" 310 310 + | '&' -> Buffer.add_string buf "&amp;" 311 311 + | '"' -> Buffer.add_string buf "&quot;" 312 312 + | c -> Buffer.add_char buf c) 313 313 + s; 267 314 Buffer.contents buf 268 315 269 316 (** External link SVG icon *) ··· 276 323 | Forks.Same_commit -> "sync" 277 324 | Forks.I_am_ahead n -> Printf.sprintf "+%d" n 278 325 | Forks.I_am_behind n -> Printf.sprintf "-%d" n 279 279 - | Forks.Diverged { my_ahead; their_ahead; _ } -> Printf.sprintf "+%d/-%d" my_ahead their_ahead 326 326 + | Forks.Diverged { my_ahead; their_ahead; _ } -> 327 327 + Printf.sprintf "+%d/-%d" my_ahead their_ahead 280 328 | Forks.Unrelated -> "unrel" 281 329 | Forks.Not_fetched -> "?" 282 330 ··· 288 336 (* Build member lookups *) 289 337 let member_urls = Hashtbl.create 16 in 290 338 let member_names = Hashtbl.create 16 in 291 291 - List.iter (fun m -> 292 292 - Hashtbl.replace member_urls m.handle (m.monorepo_url, m.opam_url); 293 293 - Hashtbl.replace member_names m.handle m.display_name 294 294 - ) data.members; 339 339 + List.iter 340 340 + (fun m -> 341 341 + Hashtbl.replace member_urls m.handle (m.monorepo_url, m.opam_url); 342 342 + Hashtbl.replace member_names m.handle m.display_name) 343 343 + data.members; 295 344 296 345 (* Helper to get display name for handle *) 297 346 let get_name handle = 298 347 try Hashtbl.find member_names handle with Not_found -> handle 299 348 in 300 349 301 301 - add {|<!DOCTYPE html> 350 350 + add 351 351 + {|<!DOCTYPE html> 302 352 <html lang="en"> 303 353 <head> 304 354 <meta charset="UTF-8"> 305 355 <meta name="viewport" content="width=device-width, initial-scale=1.0"> 306 356 <title>|}; 307 357 add (html_escape data.registry_name); 308 308 - add {|</title> 358 358 + add 359 359 + {|</title> 309 360 <style> 310 361 * { margin: 0; padding: 0; box-sizing: border-box; } 311 362 body { font: 10pt/1.4 -apple-system, BlinkMacSystemFont, "Segoe UI", Roboto, sans-serif; color: #333; max-width: 900px; margin: 0 auto; padding: 12px; } ··· 365 416 (* Title and description *) 366 417 add (Printf.sprintf "<h1>%s</h1>\n" (html_escape data.registry_name)); 367 418 (match data.registry_description with 368 368 - | Some desc -> add (Printf.sprintf "<div class=\"subtitle\">%s</div>\n" (html_escape desc)) 369 369 - | None -> add "<div class=\"subtitle\"></div>\n"); 419 419 + | Some desc -> 420 420 + add 421 421 + (Printf.sprintf "<div class=\"subtitle\">%s</div>\n" (html_escape desc)) 422 422 + | None -> add "<div class=\"subtitle\"></div>\n"); 370 423 371 424 (* Intro section *) 372 372 - add {|<div class="intro"> 425 425 + add 426 426 + {|<div class="intro"> 373 427 This is an experiment in large-scale agentic coding using OCaml and OxCaml, where we're building environments to exchange vibe code at scale. 374 374 - Managed by <a class="ext" href="https://tangled.org/anil.recoil.org/monopam">monopam|}; add external_link_icon; add {|</a>, 375 375 - with the central registry at <a class="ext" href="https://tangled.org/eeg.cl.cam.ac.uk/opamverse">opamverse|}; add external_link_icon; add {|</a>. 428 428 + Managed by <a class="ext" href="https://tangled.org/anil.recoil.org/monopam">monopam|}; 429 429 + add external_link_icon; 430 430 + add 431 431 + {|</a>, 432 432 + with the central registry at <a class="ext" href="https://tangled.org/eeg.cl.cam.ac.uk/opamverse">opamverse|}; 433 433 + add external_link_icon; 434 434 + add {|</a>. 376 435 </div> 377 436 |}; 378 437 379 438 (* Members section *) 380 439 add "<div class=\"section\">\n<h2>Members</h2>\n<div class=\"members\">\n"; 381 381 - List.iter (fun m -> 382 382 - add "<div class=\"member\">\n"; 383 383 - add (Printf.sprintf "<div class=\"member-name\"><a href=\"https://%s\">%s</a></div>\n" 384 384 - (html_escape m.handle) (html_escape m.display_name)); 385 385 - if m.display_name <> m.handle then 386 386 - add (Printf.sprintf "<div class=\"member-handle\">%s</div>\n" (html_escape m.handle)); 387 387 - add (Printf.sprintf "<div class=\"member-stats\">%d packages" m.package_count); 388 388 - if m.unique_packages <> [] then 389 389 - add (Printf.sprintf ", %d unique" (List.length m.unique_packages)); 390 390 - add "</div>\n"; 391 391 - if m.monorepo_url <> "" || m.opam_url <> "" then begin 392 392 - add "<div class=\"member-links\">"; 393 393 - if m.monorepo_url <> "" then 394 394 - add (Printf.sprintf "<a class=\"ext\" href=\"%s\">mono%s</a>" (html_escape m.monorepo_url) external_link_icon); 395 395 - if m.opam_url <> "" then 396 396 - add (Printf.sprintf "<a class=\"ext\" href=\"%s\">opam%s</a>" (html_escape m.opam_url) external_link_icon); 397 397 - add "</div>\n" 398 398 - end; 399 399 - add "</div>\n" 400 400 - ) data.members; 440 440 + List.iter 441 441 + (fun m -> 442 442 + add "<div class=\"member\">\n"; 443 443 + add 444 444 + (Printf.sprintf 445 445 + "<div class=\"member-name\"><a href=\"https://%s\">%s</a></div>\n" 446 446 + (html_escape m.handle) 447 447 + (html_escape m.display_name)); 448 448 + if m.display_name <> m.handle then 449 449 + add 450 450 + (Printf.sprintf "<div class=\"member-handle\">%s</div>\n" 451 451 + (html_escape m.handle)); 452 452 + add 453 453 + (Printf.sprintf "<div class=\"member-stats\">%d packages" 454 454 + m.package_count); 455 455 + if m.unique_packages <> [] then 456 456 + add (Printf.sprintf ", %d unique" (List.length m.unique_packages)); 457 457 + add "</div>\n"; 458 458 + if m.monorepo_url <> "" || m.opam_url <> "" then begin 459 459 + add "<div class=\"member-links\">"; 460 460 + if m.monorepo_url <> "" then 461 461 + add 462 462 + (Printf.sprintf "<a class=\"ext\" href=\"%s\">mono%s</a>" 463 463 + (html_escape m.monorepo_url) 464 464 + external_link_icon); 465 465 + if m.opam_url <> "" then 466 466 + add 467 467 + (Printf.sprintf "<a class=\"ext\" href=\"%s\">opam%s</a>" 468 468 + (html_escape m.opam_url) external_link_icon); 469 469 + add "</div>\n" 470 470 + end; 471 471 + add "</div>\n") 472 472 + data.members; 401 473 add "</div>\n</div>\n"; 402 474 403 475 (* Summary section *) 404 476 add "<div class=\"section\">\n"; 405 477 add "<div class=\"summary\">\n"; 406 406 - add (Printf.sprintf "<div class=\"summary-title\">Common Libraries (%d repos, %d packages)</div>\n" 407 407 - (List.length data.common_repos) 408 408 - (List.fold_left (fun acc r -> acc + List.length r.ri_packages) 0 data.common_repos)); 478 478 + add 479 479 + (Printf.sprintf 480 480 + "<div class=\"summary-title\">Common Libraries (%d repos, %d \ 481 481 + packages)</div>\n" 482 482 + (List.length data.common_repos) 483 483 + (List.fold_left 484 484 + (fun acc r -> acc + List.length r.ri_packages) 485 485 + 0 data.common_repos)); 409 486 add "<div class=\"summary-list\">\n"; 410 410 - List.iter (fun r -> 411 411 - add (Printf.sprintf "<span class=\"summary-item\"><a href=\"#%s\">%s</a> <span style=\"color:#888\">(%d)</span></span>\n" 412 412 - (html_escape r.ri_name) (html_escape r.ri_name) (List.length r.ri_packages)) 413 413 - ) data.common_repos; 487 487 + List.iter 488 488 + (fun r -> 489 489 + add 490 490 + (Printf.sprintf 491 491 + "<span class=\"summary-item\"><a href=\"#%s\">%s</a> <span \ 492 492 + style=\"color:#888\">(%d)</span></span>\n" 493 493 + (html_escape r.ri_name) (html_escape r.ri_name) 494 494 + (List.length r.ri_packages))) 495 495 + data.common_repos; 414 496 add "</div>\n</div>\n"; 415 497 416 498 (* Member-specific summary *) 417 417 - let members_with_unique = List.filter (fun m -> m.unique_packages <> []) data.members in 499 499 + let members_with_unique = 500 500 + List.filter (fun m -> m.unique_packages <> []) data.members 501 501 + in 418 502 if members_with_unique <> [] then begin 419 503 add "<div class=\"summary\">\n"; 420 504 add "<div class=\"summary-title\">Member-Specific Packages</div>\n"; 421 505 add "<div class=\"unique-section\">\n"; 422 422 - List.iter (fun m -> 423 423 - add "<div class=\"unique-member\">\n"; 424 424 - add (Printf.sprintf "<span class=\"unique-member-name\"><a href=\"https://%s\">%s</a>:</span> " 425 425 - (html_escape m.handle) (html_escape m.display_name)); 426 426 - add "<span class=\"unique-list\">"; 427 427 - add (String.concat ", " (List.map html_escape m.unique_packages)); 428 428 - add "</span>\n"; 429 429 - add "</div>\n" 430 430 - ) members_with_unique; 506 506 + List.iter 507 507 + (fun m -> 508 508 + add "<div class=\"unique-member\">\n"; 509 509 + add 510 510 + (Printf.sprintf 511 511 + "<span class=\"unique-member-name\"><a \ 512 512 + href=\"https://%s\">%s</a>:</span> " 513 513 + (html_escape m.handle) 514 514 + (html_escape m.display_name)); 515 515 + add "<span class=\"unique-list\">"; 516 516 + add (String.concat ", " (List.map html_escape m.unique_packages)); 517 517 + add "</span>\n"; 518 518 + add "</div>\n") 519 519 + members_with_unique; 431 520 add "</div>\n</div>\n" 432 521 end; 433 522 add "</div>\n"; ··· 436 525 if data.common_repos <> [] then begin 437 526 add "<div class=\"section\">\n<h2>Repository Details</h2>\n"; 438 527 439 439 - List.iter (fun r -> 440 440 - add (Printf.sprintf "<div class=\"repo\" id=\"%s\">\n" (html_escape r.ri_name)); 441 441 - add "<div class=\"repo-header\">"; 442 442 - add (Printf.sprintf "<span class=\"repo-name\"><a class=\"ext\" href=\"%s\">%s%s</a></span>" 443 443 - (html_escape r.ri_dev_repo) (html_escape r.ri_name) external_link_icon); 444 444 - add "</div>\n"; 528 528 + List.iter 529 529 + (fun r -> 530 530 + add 531 531 + (Printf.sprintf "<div class=\"repo\" id=\"%s\">\n" 532 532 + (html_escape r.ri_name)); 533 533 + add "<div class=\"repo-header\">"; 534 534 + add 535 535 + (Printf.sprintf 536 536 + "<span class=\"repo-name\"><a class=\"ext\" \ 537 537 + href=\"%s\">%s%s</a></span>" 538 538 + (html_escape r.ri_dev_repo) 539 539 + (html_escape r.ri_name) external_link_icon); 540 540 + add "</div>\n"; 445 541 446 446 - (* Packages list - compact with names *) 447 447 - add "<div class=\"repo-packages\">"; 448 448 - let pkg_names = List.map (fun (p : pkg_info) -> p.name) r.ri_packages in 449 449 - add (String.concat ", " (List.map html_escape pkg_names)); 450 450 - add "</div>\n"; 542 542 + (* Packages list - compact with names *) 543 543 + add "<div class=\"repo-packages\">"; 544 544 + let pkg_names = List.map (fun (p : pkg_info) -> p.name) r.ri_packages in 545 545 + add (String.concat ", " (List.map html_escape pkg_names)); 546 546 + add "</div>\n"; 451 547 452 452 - (* Package descriptions as bullet list *) 453 453 - let pkg_descs = List.filter_map (fun (p : pkg_info) -> 454 454 - match p.synopsis with 455 455 - | Some s -> Some (p.name, s) 456 456 - | None -> None 457 457 - ) r.ri_packages in 458 458 - if pkg_descs <> [] then begin 459 459 - add "<ul class=\"pkg-list\">\n"; 460 460 - List.iter (fun (name, desc) -> 461 461 - add (Printf.sprintf "<li><b>%s</b>: %s</li>\n" (html_escape name) (html_escape desc)) 462 462 - ) pkg_descs; 463 463 - add "</ul>\n" 464 464 - end; 548 548 + (* Package descriptions as bullet list *) 549 549 + let pkg_descs = 550 550 + List.filter_map 551 551 + (fun (p : pkg_info) -> 552 552 + match p.synopsis with Some s -> Some (p.name, s) | None -> None) 553 553 + r.ri_packages 554 554 + in 555 555 + if pkg_descs <> [] then begin 556 556 + add "<ul class=\"pkg-list\">\n"; 557 557 + List.iter 558 558 + (fun (name, desc) -> 559 559 + add 560 560 + (Printf.sprintf "<li><b>%s</b>: %s</li>\n" (html_escape name) 561 561 + (html_escape desc))) 562 562 + pkg_descs; 563 563 + add "</ul>\n" 564 564 + end; 465 565 466 466 - (* Forks - at repo level with names *) 467 467 - if List.length r.ri_owners > 1 then begin 468 468 - let owner_links = List.map (fun h -> 469 469 - Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape h) (html_escape (get_name h)) 470 470 - ) (List.sort String.compare r.ri_owners) in 471 471 - add "<details class=\"repo-forks\">\n"; 472 472 - add (Printf.sprintf "<summary>%d members (%s)</summary>\n" 473 473 - (List.length r.ri_owners) 474 474 - (String.concat ", " owner_links)); 475 475 - add "<div class=\"fork-list\">\n"; 476 476 - List.iter (fun handle -> 477 477 - let mono_url, _opam_url = 478 478 - try Hashtbl.find member_urls handle 479 479 - with Not_found -> ("", "") 566 566 + (* Forks - at repo level with names *) 567 567 + if List.length r.ri_owners > 1 then begin 568 568 + let owner_links = 569 569 + List.map 570 570 + (fun h -> 571 571 + Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape h) 572 572 + (html_escape (get_name h))) 573 573 + (List.sort String.compare r.ri_owners) 480 574 in 481 481 - add "<span class=\"fork-item\">"; 482 482 - add (Printf.sprintf "<a href=\"https://%s\">%s</a>" (html_escape handle) (html_escape (get_name handle))); 483 483 - (* Add status if available *) 484 484 - (match List.assoc_opt handle r.ri_fork_status with 485 485 - | Some rel -> 486 486 - let status_str = format_relationship rel in 487 487 - let status_class = 488 488 - match rel with 489 489 - | Forks.Same_url | Forks.Same_commit -> "sync" 490 490 - | Forks.I_am_ahead _ -> "ahead" 491 491 - | Forks.I_am_behind _ -> "behind" 492 492 - | Forks.Diverged _ -> "diverged" 493 493 - | _ -> "" 494 494 - in 495 495 - if status_class <> "" then 496 496 - add (Printf.sprintf "<span class=\"fork-status %s\">%s</span>" status_class status_str) 497 497 - else 498 498 - add (Printf.sprintf "<span class=\"fork-status\">%s</span>" status_str) 499 499 - | None -> ()); 500 500 - if mono_url <> "" then 501 501 - add (Printf.sprintf "<a class=\"ext\" href=\"%s/%s\">mono%s</a>" 502 502 - (html_escape mono_url) (html_escape r.ri_name) external_link_icon); 503 503 - add "</span>\n" 504 504 - ) (List.sort String.compare r.ri_owners); 505 505 - add "</div>\n</details>\n" 506 506 - end; 575 575 + add "<details class=\"repo-forks\">\n"; 576 576 + add 577 577 + (Printf.sprintf "<summary>%d members (%s)</summary>\n" 578 578 + (List.length r.ri_owners) 579 579 + (String.concat ", " owner_links)); 580 580 + add "<div class=\"fork-list\">\n"; 581 581 + List.iter 582 582 + (fun handle -> 583 583 + let mono_url, _opam_url = 584 584 + try Hashtbl.find member_urls handle with Not_found -> ("", "") 585 585 + in 586 586 + add "<span class=\"fork-item\">"; 587 587 + add 588 588 + (Printf.sprintf "<a href=\"https://%s\">%s</a>" 589 589 + (html_escape handle) 590 590 + (html_escape (get_name handle))); 591 591 + (* Add status if available *) 592 592 + (match List.assoc_opt handle r.ri_fork_status with 593 593 + | Some rel -> 594 594 + let status_str = format_relationship rel in 595 595 + let status_class = 596 596 + match rel with 597 597 + | Forks.Same_url | Forks.Same_commit -> "sync" 598 598 + | Forks.I_am_ahead _ -> "ahead" 599 599 + | Forks.I_am_behind _ -> "behind" 600 600 + | Forks.Diverged _ -> "diverged" 601 601 + | _ -> "" 602 602 + in 603 603 + if status_class <> "" then 604 604 + add 605 605 + (Printf.sprintf "<span class=\"fork-status %s\">%s</span>" 606 606 + status_class status_str) 607 607 + else 608 608 + add 609 609 + (Printf.sprintf "<span class=\"fork-status\">%s</span>" 610 610 + status_str) 611 611 + | None -> ()); 612 612 + if mono_url <> "" then 613 613 + add 614 614 + (Printf.sprintf "<a class=\"ext\" href=\"%s/%s\">mono%s</a>" 615 615 + (html_escape mono_url) (html_escape r.ri_name) 616 616 + external_link_icon); 617 617 + add "</span>\n") 618 618 + (List.sort String.compare r.ri_owners); 619 619 + add "</div>\n</details>\n" 620 620 + end; 507 621 508 508 - add "</div>\n" 509 509 - ) data.common_repos; 622 622 + add "</div>\n") 623 623 + data.common_repos; 510 624 511 625 add "</div>\n" 512 626 end; ··· 514 628 (* Footer with generation date *) 515 629 let now = Unix.gettimeofday () in 516 630 let tm = Unix.gmtime now in 517 517 - let date_str = Printf.sprintf "%04d-%02d-%02d" 518 518 - (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday in 519 519 - add (Printf.sprintf "<footer>Generated by monopam on %s | %d members | %d repos | %d packages</footer>\n" 520 520 - date_str (List.length data.members) (List.length data.common_repos + List.length data.unique_repos) (List.length data.all_packages)); 631 631 + let date_str = 632 632 + Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900) 633 633 + (tm.Unix.tm_mon + 1) tm.Unix.tm_mday 634 634 + in 635 635 + add 636 636 + (Printf.sprintf 637 637 + "<footer>Generated by monopam on %s | %d members | %d repos | %d \ 638 638 + packages</footer>\n" 639 639 + date_str (List.length data.members) 640 640 + (List.length data.common_repos + List.length data.unique_repos) 641 641 + (List.length data.all_packages)); 521 642 522 643 add "</body>\n</html>\n"; 523 644 Buffer.contents buf

+14 -11

lib/site.mli

reviewed

··· 7 7 8 8 (** {1 Types} *) 9 9 10 10 - (** Information about a package in the verse *) 11 10 type pkg_info = { 12 11 name : string; 13 12 synopsis : string option; ··· 16 15 owners : string list; (** List of handles that have this package *) 17 16 depends : string list; (** Package dependencies *) 18 17 } 18 18 + (** Information about a package in the verse *) 19 19 20 20 - (** Information about a repository (group of packages) *) 21 20 type repo_info = { 22 21 ri_name : string; 23 22 ri_dev_repo : string; 24 23 ri_packages : pkg_info list; 25 25 - ri_owners : string list; (** All handles that have any package from this repo *) 26 26 - ri_fork_status : (string * Forks.relationship) list; (** (handle, relationship) *) 24 24 + ri_owners : string list; 25 25 + (** All handles that have any package from this repo *) 26 26 + ri_fork_status : (string * Forks.relationship) list; 27 27 + (** (handle, relationship) *) 27 28 ri_dep_count : int; (** Number of dependencies (for sorting) *) 28 29 } 30 30 + (** Information about a repository (group of packages) *) 29 31 30 30 - (** Information about a verse member *) 31 32 type member_info = { 32 33 handle : string; 33 34 display_name : string; (** Name to display (from registry or handle) *) ··· 36 37 package_count : int; 37 38 unique_packages : string list; (** Packages unique to this member *) 38 39 } 40 40 + (** Information about a verse member *) 39 41 40 40 - (** Aggregated site data *) 41 42 type site_data = { 42 43 local_handle : string; 43 44 registry_name : string; ··· 47 48 unique_repos : repo_info list; (** Repos unique to one member *) 48 49 all_packages : pkg_info list; (** All packages *) 49 50 } 51 51 + (** Aggregated site data *) 50 52 51 53 (** {1 Generation} *) 52 54 ··· 57 59 registry:Verse_registry.t -> 58 60 unit -> 59 61 site_data 60 60 - (** [collect_data ~fs ~config ?forks ~registry ()] scans the workspace and verse members 61 61 - to collect package information for the site. If [forks] is provided, 62 62 + (** [collect_data ~fs ~config ?forks ~registry ()] scans the workspace and verse 63 63 + members to collect package information for the site. If [forks] is provided, 62 64 includes fork status information for each repository. *) 63 65 64 66 val generate : ··· 68 70 registry:Verse_registry.t -> 69 71 unit -> 70 72 string 71 71 - (** [generate ~fs ~config ?forks ~registry ()] generates the HTML content for the site. *) 73 73 + (** [generate ~fs ~config ?forks ~registry ()] generates the HTML content for 74 74 + the site. *) 72 75 73 76 val write : 74 77 fs:Eio.Fs.dir_ty Eio.Path.t -> ··· 78 81 output_path:Fpath.t -> 79 82 unit -> 80 83 (unit, string) result 81 81 - (** [write ~fs ~config ?forks ~registry ~output_path ()] generates and writes the site 82 82 - to the specified output path. *) 84 84 + (** [write ~fs ~config ?forks ~registry ~output_path ()] generates and writes 85 85 + the site to the specified output path. *)

+23 -27

lib/sources_registry.ml

reviewed

··· 10 10 origin : origin option; 11 11 } 12 12 13 13 - type t = { 14 14 - default_url_base : string option; 15 15 - entries : (string * entry) list; 16 16 - } 13 13 + type t = { default_url_base : string option; entries : (string * entry) list } 17 14 18 15 let empty = { default_url_base = None; entries = [] } 19 19 - 20 16 let default_url_base t = t.default_url_base 21 21 - 22 22 - let with_default_url_base t base = 23 23 - { t with default_url_base = Some base } 24 24 - 17 17 + let with_default_url_base t base = { t with default_url_base = Some base } 25 18 let find t ~subtree = List.assoc_opt subtree t.entries 26 19 27 20 let derive_url t ~subtree = ··· 29 22 | Some entry -> Some entry.url 30 23 | None -> 31 24 (* Use default_url_base to construct URL from subtree name *) 32 32 - Option.map (fun base -> 33 33 - let base = 34 34 - if String.ends_with ~suffix:"/" base then 35 35 - String.sub base 0 (String.length base - 1) 36 36 - else base 37 37 - in 38 38 - base ^ "/" ^ subtree 39 39 - ) t.default_url_base 25 25 + Option.map 26 26 + (fun base -> 27 27 + let base = 28 28 + if String.ends_with ~suffix:"/" base then 29 29 + String.sub base 0 (String.length base - 1) 30 30 + else base 31 31 + in 32 32 + base ^ "/" ^ subtree) 33 33 + t.default_url_base 40 34 41 35 let add t ~subtree entry = 42 36 { t with entries = (subtree, entry) :: List.remove_assoc subtree t.entries } 43 37 44 44 - let remove t ~subtree = 45 45 - { t with entries = List.remove_assoc subtree t.entries } 46 46 - 38 38 + let remove t ~subtree = { t with entries = List.remove_assoc subtree t.entries } 47 39 let to_list t = t.entries 48 48 - 49 40 let of_list entries = { default_url_base = None; entries } 50 41 51 42 (* TOML structure: ··· 66 57 ~dec:(function 67 58 | "fork" -> Fork 68 59 | "join" -> Join 69 69 - | s -> failwith (Printf.sprintf "Invalid origin: %s (expected 'fork' or 'join')" s)) 60 60 + | s -> 61 61 + failwith 62 62 + (Printf.sprintf "Invalid origin: %s (expected 'fork' or 'join')" s)) 70 63 ~enc:(function Fork -> "fork" | Join -> "join") 71 64 Tomlt.string 72 65 73 66 let entry_codec : entry Tomlt.t = 74 67 Tomlt.( 75 68 Table.( 76 76 - obj (fun url upstream branch reason origin -> { url; upstream; branch; reason; origin }) 69 69 + obj (fun url upstream branch reason origin -> 70 70 + { url; upstream; branch; reason; origin }) 77 71 |> mem "url" string ~enc:(fun e -> e.url) 78 72 |> opt_mem "upstream" string ~enc:(fun e -> e.upstream) 79 73 |> opt_mem "branch" string ~enc:(fun e -> e.branch) ··· 84 78 let codec : t Tomlt.t = 85 79 Tomlt.( 86 80 Table.( 87 87 - obj (fun default_url_base entries -> 88 88 - { default_url_base; entries }) 81 81 + obj (fun default_url_base entries -> { default_url_base; entries }) 89 82 |> opt_mem "default_url_base" string ~enc:(fun t -> t.default_url_base) 90 83 |> keep_unknown ~enc:(fun t -> t.entries) (Mems.assoc entry_codec) 91 84 |> finish)) ··· 98 91 | `Regular_file -> ( 99 92 try Ok (Tomlt_eio.decode_path_exn codec ~fs path_str) with 100 93 | Failure msg -> Error (Printf.sprintf "Invalid sources.toml: %s" msg) 101 101 - | exn -> Error (Printf.sprintf "Error loading sources.toml: %s" (Printexc.to_string exn))) 102 102 - | _ -> Ok empty (* File doesn't exist, return empty registry *) 94 94 + | exn -> 95 95 + Error 96 96 + (Printf.sprintf "Error loading sources.toml: %s" 97 97 + (Printexc.to_string exn))) 98 98 + | _ -> Ok empty (* File doesn't exist, return empty registry *) 103 99 | exception _ -> Ok empty 104 100 105 101 let save ~fs path t =

+15 -13

lib/sources_registry.mli

reviewed

··· 1 1 (** Sources registry for tracking forked/vendored package URLs. 2 2 3 3 - The sources.toml file in the monorepo root tracks packages where 4 4 - the dev-repo URL differs from what's declared in dune-project. 5 5 - This is typically used for: 3 3 + The sources.toml file in the monorepo root tracks packages where the 4 4 + dev-repo URL differs from what's declared in dune-project. This is typically 5 5 + used for: 6 6 - Forked packages (our fork URL vs upstream) 7 7 - Vendored packages (local copy, custom URL) 8 8 - Packages without source in dune-project 9 9 10 10 - The registry also supports a [default_url_base] field that is used 11 11 - to derive URLs for subtrees without explicit entries: 10 10 + The registry also supports a [default_url_base] field that is used to derive 11 11 + URLs for subtrees without explicit entries: 12 12 {v 13 13 default_url_base = "git+https://tangled.org/anil.recoil.org" 14 14 v} ··· 18 18 (** How a source entry was created. *) 19 19 type origin = 20 20 | Fork (** Created via [monopam fork] - subtree split from monorepo *) 21 21 - | Join (** Created via [monopam join] - external repo brought into monorepo *) 21 21 + | Join 22 22 + (** Created via [monopam join] - external repo brought into monorepo *) 22 23 23 23 - (** A source entry for a subtree. *) 24 24 type entry = { 25 25 - url : string; (** Our dev-repo URL (e.g., "git+https://github.com/avsm/braid") *) 25 25 + url : string; 26 26 + (** Our dev-repo URL (e.g., "git+https://github.com/avsm/braid") *) 26 27 upstream : string option; (** Original upstream URL if this is a fork *) 27 28 branch : string option; (** Override branch (default: main) *) 28 29 reason : string option; (** Why we have a custom source *) 29 30 origin : origin option; (** How this entry was created *) 30 31 } 32 32 + (** A source entry for a subtree. *) 31 33 34 34 + type t 32 35 (** The sources registry - maps subtree names to source entries. *) 33 33 - type t 34 36 35 37 val empty : t 36 38 (** Empty registry. *) ··· 45 47 (** [find t ~subtree] looks up the source entry for a subtree. *) 46 48 47 49 val derive_url : t -> subtree:string -> string option 48 48 - (** [derive_url t ~subtree] derives a URL for a subtree. 49 49 - First checks for an explicit entry, then uses default_url_base if set. *) 50 50 + (** [derive_url t ~subtree] derives a URL for a subtree. First checks for an 51 51 + explicit entry, then uses default_url_base if set. *) 50 52 51 53 val add : t -> subtree:string -> entry -> t 52 54 (** [add t ~subtree entry] adds or replaces an entry. *) ··· 61 63 (** [of_list entries] creates a registry from an association list. *) 62 64 63 65 val load : fs:_ Eio.Path.t -> Fpath.t -> (t, string) result 64 64 - (** [load ~fs path] loads a sources.toml file. Returns empty registry 65 65 - if file doesn't exist. *) 66 66 + (** [load ~fs path] loads a sources.toml file. Returns empty registry if file 67 67 + doesn't exist. *) 66 68 67 69 val save : fs:_ Eio.Path.t -> Fpath.t -> t -> (unit, string) result 68 70 (** [save ~fs path t] writes the registry to a TOML file. *)

+34 -22

lib/status.ml

reviewed

··· 160 160 Fmt.pf ppf "@[<h>%-20s checkout: %a subtree: %a@]" (Package.name t.package) 161 161 pp_checkout_status t.checkout pp_subtree_status t.subtree 162 162 163 163 - (** Extract handle from a tangled.org URL like "git+https://tangled.org/handle/repo" *) 163 163 + (** Extract handle from a tangled.org URL like 164 164 + "git+https://tangled.org/handle/repo" *) 164 165 let extract_handle_from_url url = 165 165 - let url = if String.starts_with ~prefix:"git+" url then 166 166 - String.sub url 4 (String.length url - 4) 167 167 - else url in 166 166 + let url = 167 167 + if String.starts_with ~prefix:"git+" url then 168 168 + String.sub url 4 (String.length url - 4) 169 169 + else url 170 170 + in 168 171 let uri = Uri.of_string url in 169 172 match Uri.host uri with 170 170 - | Some "tangled.org" -> 173 173 + | Some "tangled.org" -> ( 171 174 let path = Uri.path uri in 172 175 (* Path is like "/handle/repo" - extract first component *) 173 173 - let path = if String.length path > 0 && path.[0] = '/' then 174 174 - String.sub path 1 (String.length path - 1) 175 175 - else path in 176 176 - (match String.index_opt path '/' with 177 177 - | Some i -> Some (String.sub path 0 i) 178 178 - | None -> Some path) 176 176 + let path = 177 177 + if String.length path > 0 && path.[0] = '/' then 178 178 + String.sub path 1 (String.length path - 1) 179 179 + else path 180 180 + in 181 181 + match String.index_opt path '/' with 182 182 + | Some i -> Some (String.sub path 0 i) 183 183 + | None -> Some path) 179 184 | _ -> None 180 185 181 186 (** Format origin indicator from sources registry entry *) ··· 184 189 | None -> () 185 190 | Some Sources_registry.{ origin = Some Sources_registry.Fork; _ } -> 186 191 Fmt.pf ppf " %a" Fmt.(styled `Magenta string) "^" 187 187 - | Some Sources_registry.{ origin = Some Sources_registry.Join; upstream = Some url; _ } -> 188 188 - (match extract_handle_from_url url with 189 189 - | Some handle -> 190 190 - (* Abbreviate handle - take first part before dot, max 8 chars *) 191 191 - let abbrev = match String.index_opt handle '.' with 192 192 - | Some i -> String.sub handle 0 i 193 193 - | None -> handle 194 194 - in 195 195 - let abbrev = if String.length abbrev > 8 then String.sub abbrev 0 8 else abbrev in 196 196 - Fmt.pf ppf " %a" Fmt.(styled `Cyan (fun ppf s -> pf ppf "v:%s" s)) abbrev 197 197 - | None -> Fmt.pf ppf " %a" Fmt.(styled `Cyan string) "v:") 192 192 + | Some 193 193 + Sources_registry. 194 194 + { origin = Some Sources_registry.Join; upstream = Some url; _ } -> ( 195 195 + match extract_handle_from_url url with 196 196 + | Some handle -> 197 197 + (* Abbreviate handle - take first part before dot, max 8 chars *) 198 198 + let abbrev = 199 199 + match String.index_opt handle '.' with 200 200 + | Some i -> String.sub handle 0 i 201 201 + | None -> handle 202 202 + in 203 203 + let abbrev = 204 204 + if String.length abbrev > 8 then String.sub abbrev 0 8 else abbrev 205 205 + in 206 206 + Fmt.pf ppf " %a" 207 207 + Fmt.(styled `Cyan (fun ppf s -> pf ppf "v:%s" s)) 208 208 + abbrev 209 209 + | None -> Fmt.pf ppf " %a" Fmt.(styled `Cyan string) "v:") 198 210 | Some Sources_registry.{ origin = Some Sources_registry.Join; _ } -> 199 211 Fmt.pf ppf " %a" Fmt.(styled `Cyan string) "v:" 200 212 | Some _ -> ()

+5 -4

lib/status.mli

reviewed

··· 113 113 (** [pp] formats a single package status. *) 114 114 115 115 val pp_compact : ?sources:Sources_registry.t -> t Fmt.t 116 116 - (** [pp_compact ?sources] formats a single package status in compact form with colors. 117 117 - If [sources] is provided, displays origin indicators (^ for fork, v:handle for join). *) 116 116 + (** [pp_compact ?sources] formats a single package status in compact form with 117 117 + colors. If [sources] is provided, displays origin indicators (^ for fork, 118 118 + v:handle for join). *) 118 119 119 120 val pp_summary : ?sources:Sources_registry.t -> t list Fmt.t 120 120 - (** [pp_summary ?sources] formats a summary of all package statuses. 121 121 - If [sources] is provided, displays origin indicators for each package. *) 121 121 + (** [pp_summary ?sources] formats a summary of all package statuses. If 122 122 + [sources] is provided, displays origin indicators for each package. *)

+92 -40

lib/verse.ml

reviewed

··· 6 6 | Workspace_exists of Fpath.t 7 7 | Not_a_workspace of Fpath.t 8 8 | Package_not_found of string * string (** (package, handle) *) 9 9 - | Package_already_exists of string list (** List of conflicting package names *) 9 9 + | Package_already_exists of string list 10 10 + (** List of conflicting package names *) 10 11 | Opam_repo_error of Opam_repo.error 11 12 12 13 let pp_error ppf = function ··· 20 21 Fmt.pf ppf "Package %s not found in %s's opam repo" pkg handle 21 22 | Package_already_exists pkgs -> 22 23 Fmt.pf ppf "Packages already exist in your opam repo: %a" 23 23 - Fmt.(list ~sep:comma string) pkgs 24 24 + Fmt.(list ~sep:comma string) 25 25 + pkgs 24 26 | Opam_repo_error e -> Fmt.pf ppf "Opam repo error: %a" Opam_repo.pp_error e 25 27 26 28 let error_hint = function 27 29 | Config_error _ -> 28 28 - Some 29 29 - "Run 'monopam init --handle <your-handle>' to create a workspace." 30 30 + Some "Run 'monopam init --handle <your-handle>' to create a workspace." 30 31 | Git_error (Git.Dirty_worktree _) -> 31 32 Some "Commit or stash your changes first: git status" 32 33 | Git_error (Git.Command_failed (cmd, _)) ··· 45 46 | Workspace_exists _ -> 46 47 Some "Use a different directory, or remove the existing workspace." 47 48 | Not_a_workspace _ -> 48 48 - Some "Run 'monopam init --handle <your-handle>' to create a workspace here." 49 49 + Some 50 50 + "Run 'monopam init --handle <your-handle>' to create a workspace here." 49 51 | Package_not_found (pkg, handle) -> 50 50 - Some (Fmt.str "Run 'monopam verse pull %s' to sync their opam repo, then check package name: %s" handle pkg) 52 52 + Some 53 53 + (Fmt.str 54 54 + "Run 'monopam verse pull %s' to sync their opam repo, then check \ 55 55 + package name: %s" 56 56 + handle pkg) 51 57 | Package_already_exists pkgs -> 52 52 - Some (Fmt.str "Remove conflicting packages first:\n %s" 53 53 - (String.concat "\n " (List.map (fun p -> "rm -rf opam-repo/packages/" ^ p) pkgs))) 58 58 + Some 59 59 + (Fmt.str "Remove conflicting packages first:\n %s" 60 60 + (String.concat "\n " 61 61 + (List.map (fun p -> "rm -rf opam-repo/packages/" ^ p) pkgs))) 54 62 | Opam_repo_error _ -> None 55 63 56 64 let pp_error_with_hint ppf e = ··· 277 285 | Error msg -> Error (Registry_error msg) 278 286 | Ok registry -> Ok registry.members 279 287 280 280 - (** Clone or fetch+reset a single git repo. Returns Ok true if cloned, Ok false if reset. 281 281 - Uses fetch+reset instead of pull since verse repos should not have local changes. *) 288 288 + (** Clone or fetch+reset a single git repo. Returns Ok true if cloned, Ok false 289 289 + if reset. Uses fetch+reset instead of pull since verse repos should not have 290 290 + local changes. *) 282 291 let clone_or_reset_repo ~proc ~fs ~url ~branch path = 283 292 if Git.is_repo ~proc ~fs path then begin 284 293 match Git.fetch_and_reset ~proc ~fs ~branch path with ··· 320 329 (* Clone or fetch+reset monorepo *) 321 330 Logs.info (fun m -> m "Syncing %s monorepo" h); 322 331 let mono_branch = 323 323 - Option.value ~default:Verse_config.default_branch member.monorepo_branch 332 332 + Option.value ~default:Verse_config.default_branch 333 333 + member.monorepo_branch 324 334 in 325 335 let mono_result = 326 336 clone_or_reset_repo ~proc ~fs ~url:member.monorepo ··· 342 352 (* Clone or fetch+reset opam repo *) 343 353 Logs.info (fun m -> m "Syncing %s opam repo" h); 344 354 let opam_branch = 345 345 - Option.value ~default:Verse_config.default_branch member.opamrepo_branch 355 355 + Option.value ~default:Verse_config.default_branch 356 356 + member.opamrepo_branch 346 357 in 347 358 let opam_result = 348 359 clone_or_reset_repo ~proc ~fs ~url:member.opamrepo ··· 414 425 tracked_handles; 415 426 subtree_map 416 427 417 417 - (** Result of a fork operation. *) 418 428 type fork_result = { 419 429 packages_forked : string list; (** Package names that were forked *) 420 430 source_handle : string; (** Handle of the verse member we forked from *) 421 431 fork_url : string; (** URL of the fork *) 422 432 upstream_url : string; (** Original dev-repo URL (upstream) *) 423 423 - subtree_name : string; (** Name for the subtree directory (derived from fork URL) *) 433 433 + subtree_name : string; 434 434 + (** Name for the subtree directory (derived from fork URL) *) 424 435 } 436 436 + (** Result of a fork operation. *) 425 437 426 438 (** Extract subtree name from a URL (last path component without .git suffix) *) 427 439 let subtree_name_from_url url = 428 440 let uri = Uri.of_string url in 429 441 let path = Uri.path uri in 430 442 (* Remove leading slash and .git suffix *) 431 431 - let path = if String.length path > 0 && path.[0] = '/' then 432 432 - String.sub path 1 (String.length path - 1) 433 433 - else path in 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 443 443 + let path = 444 444 + if String.length path > 0 && path.[0] = '/' then 445 445 + String.sub path 1 (String.length path - 1) 446 446 + else path 447 447 + in 448 448 + let path = 449 449 + if String.ends_with ~suffix:".git" path then 450 450 + String.sub path 0 (String.length path - 4) 451 451 + else path 452 452 + in 437 453 (* Get last component *) 438 454 match String.rindex_opt path '/' with 439 455 | Some i -> String.sub path (i + 1) (String.length path - i - 1) 440 456 | None -> path 441 457 442 458 let pp_fork_result ppf r = 443 443 - Fmt.pf ppf "@[<v>Forked %d package(s) from %s:@, @[<v>%a@]@,Fork URL: %s@,Upstream: %s@,Subtree: %s@]" 459 459 + Fmt.pf ppf 460 460 + "@[<v>Forked %d package(s) from %s:@,\ 461 461 + \ @[<v>%a@]@,\ 462 462 + Fork URL: %s@,\ 463 463 + Upstream: %s@,\ 464 464 + Subtree: %s@]" 444 465 (List.length r.packages_forked) 445 466 r.source_handle 446 446 - Fmt.(list ~sep:cut string) r.packages_forked 447 447 - r.fork_url 448 448 - r.upstream_url 449 449 - r.subtree_name 467 467 + Fmt.(list ~sep:cut string) 468 468 + r.packages_forked r.fork_url r.upstream_url r.subtree_name 450 469 451 470 (** Fork a package from a verse member's opam repo into your workspace. 452 471 ··· 465 484 (* Ensure the member exists and their opam-repo is synced *) 466 485 match Verse_registry.clone_or_pull ~proc ~fs ~config () with 467 486 | Error msg -> Error (Registry_error msg) 468 468 - | Ok registry -> 487 487 + | Ok registry -> ( 469 488 match Verse_registry.find_member registry ~handle with 470 489 | None -> Error (Member_not_found handle) 471 471 - | Some _member -> 490 490 + | Some _member -> ( 472 491 let verse_path = Verse_config.verse_path config in 473 492 let member_opam_repo = Fpath.(verse_path / (handle ^ "-opam")) in 474 493 (* Check if their opam repo exists locally *) 475 494 if not (is_directory ~fs member_opam_repo) then 476 476 - Error (Config_error (Fmt.str "Member's opam repo not synced. Run: monopam verse pull %s" handle)) 495 495 + Error 496 496 + (Config_error 497 497 + (Fmt.str 498 498 + "Member's opam repo not synced. Run: monopam verse pull %s" 499 499 + handle)) 477 500 else 478 501 (* Scan their opam repo to find the package *) 479 502 let pkgs, _errors = Opam_repo.scan_all ~fs member_opam_repo in ··· 493 516 let user_opam_repo = Verse_config.opam_repo_path config in 494 517 let conflicts = 495 518 List.filter 496 496 - (fun name -> Opam_repo.package_exists ~fs ~repo_path:user_opam_repo ~name) 519 519 + (fun name -> 520 520 + Opam_repo.package_exists ~fs ~repo_path:user_opam_repo 521 521 + ~name) 497 522 pkg_names 498 523 in 499 499 - if conflicts <> [] then 500 500 - Error (Package_already_exists conflicts) 524 524 + if conflicts <> [] then Error (Package_already_exists conflicts) 501 525 else if dry_run then 502 526 (* Dry run - just report what would be done *) 503 503 - Ok { packages_forked = pkg_names; source_handle = handle; fork_url; upstream_url; subtree_name } 527 527 + Ok 528 528 + { 529 529 + packages_forked = pkg_names; 530 530 + source_handle = handle; 531 531 + fork_url; 532 532 + upstream_url; 533 533 + subtree_name; 534 534 + } 504 535 else begin 505 536 (* Fork each package *) 506 537 let results = ··· 509 540 let name = Package.name p in 510 541 let version = Package.version p in 511 542 let opam_path = 512 512 - Fpath.(member_opam_repo / "packages" / name / (name ^ "." ^ version) / "opam") 543 543 + Fpath.( 544 544 + member_opam_repo / "packages" / name 545 545 + / (name ^ "." ^ version) 546 546 + / "opam") 513 547 in 514 548 match Opam_repo.read_opam_file ~fs opam_path with 515 549 | Error e -> Error (Opam_repo_error e) 516 516 - | Ok content -> 550 550 + | Ok content -> ( 517 551 (* Replace dev-repo and url with fork URL *) 518 518 - let new_content = Opam_repo.replace_dev_repo_url content ~new_url:fork_url in 552 552 + let new_content = 553 553 + Opam_repo.replace_dev_repo_url content 554 554 + ~new_url:fork_url 555 555 + in 519 556 (* Write to user's opam-repo *) 520 520 - match Opam_repo.write_package ~fs ~repo_path:user_opam_repo ~name ~version ~content:new_content with 557 557 + match 558 558 + Opam_repo.write_package ~fs 559 559 + ~repo_path:user_opam_repo ~name ~version 560 560 + ~content:new_content 561 561 + with 521 562 | Error e -> Error (Opam_repo_error e) 522 522 - | Ok () -> Ok name) 563 563 + | Ok () -> Ok name)) 523 564 related_pkgs 524 565 in 525 566 (* Check for errors *) 526 567 match List.find_opt Result.is_error results with 527 568 | Some (Error e) -> Error e 528 569 | _ -> 529 529 - let forked_names = List.filter_map (function Ok n -> Some n | Error _ -> None) results in 530 530 - Ok { packages_forked = forked_names; source_handle = handle; fork_url; upstream_url; subtree_name } 531 531 - end 570 570 + let forked_names = 571 571 + List.filter_map 572 572 + (function Ok n -> Some n | Error _ -> None) 573 573 + results 574 574 + in 575 575 + Ok 576 576 + { 577 577 + packages_forked = forked_names; 578 578 + source_handle = handle; 579 579 + fork_url; 580 580 + upstream_url; 581 581 + subtree_name; 582 582 + } 583 583 + end))

+7 -4

lib/verse.mli

reviewed

··· 12 12 | Member_not_found of string (** Handle not in registry *) 13 13 | Workspace_exists of Fpath.t (** Workspace already initialized *) 14 14 | Not_a_workspace of Fpath.t (** Not a opamverse workspace *) 15 15 - | Package_not_found of string * string (** Package not found in member's repo: (package, handle) *) 16 16 - | Package_already_exists of string list (** Packages already exist in user's opam repo *) 15 15 + | Package_not_found of string * string 16 16 + (** Package not found in member's repo: (package, handle) *) 17 17 + | Package_already_exists of string list 18 18 + (** Packages already exist in user's opam repo *) 17 19 | Opam_repo_error of Opam_repo.error (** Error reading/writing opam files *) 18 20 19 21 val pp_error : error Fmt.t ··· 149 151 150 152 (** {1 Forking} *) 151 153 152 152 - (** Result of a fork operation. *) 153 154 type fork_result = { 154 155 packages_forked : string list; (** Package names that were forked *) 155 156 source_handle : string; (** Handle of the verse member we forked from *) 156 157 fork_url : string; (** URL of the fork *) 157 158 upstream_url : string; (** Original dev-repo URL (upstream) *) 158 158 - subtree_name : string; (** Name for the subtree directory (derived from fork URL) *) 159 159 + subtree_name : string; 160 160 + (** Name for the subtree directory (derived from fork URL) *) 159 161 } 162 162 + (** Result of a fork operation. *) 160 163 161 164 val pp_fork_result : fork_result Fmt.t 162 165 (** [pp_fork_result] formats a fork result. *)

+3 -3

lib/verse_config.ml

reviewed

··· 1 1 (** Verse_config is now an alias for Config. 2 2 3 3 - This module is kept for backwards compatibility. 4 4 - All functionality has been unified into Config. *) 3 3 + This module is kept for backwards compatibility. All functionality has been 4 4 + unified into Config. *) 5 5 6 6 include Config 7 7 8 8 - (** Legacy type alias for package overrides *) 9 8 type package_override = Config.Package_config.t 9 9 + (** Legacy type alias for package overrides *)

+3 -3

lib/verse_config.mli

reviewed

··· 1 1 (** Verse_config is now an alias for Config. 2 2 3 3 - This module is kept for backwards compatibility. 4 4 - All functionality has been unified into Config. 3 3 + This module is kept for backwards compatibility. All functionality has been 4 4 + unified into Config. 5 5 6 6 @deprecated Use {!Config} directly. *) 7 7 8 8 include module type of Config 9 9 10 10 + type package_override = Config.Package_config.t 10 11 (** Legacy type alias for package overrides. 11 12 @deprecated Use {!Config.Package_config.t} instead. *) 12 12 - type package_override = Config.Package_config.t

+17 -9

lib/verse_registry.ml

reviewed

··· 6 6 opamrepo : string; 7 7 opamrepo_branch : string option; 8 8 } 9 9 + 9 10 type t = { name : string; description : string option; members : member list } 10 11 11 12 let default_url = "https://tangled.org/eeg.cl.cam.ac.uk/opamverse" ··· 21 22 22 23 (** Encode a URL with optional branch suffix. *) 23 24 let encode_url_with_branch url branch = 24 24 - match branch with 25 25 - | None -> url 26 26 - | Some b -> url ^ "#" ^ b 25 25 + match branch with None -> url | Some b -> url ^ "#" ^ b 27 26 28 27 let pp_member ppf m = 29 28 let mono_str = encode_url_with_branch m.monorepo m.monorepo_branch in 30 29 let opam_str = encode_url_with_branch m.opamrepo m.opamrepo_branch in 31 30 let name_str = match m.name with Some n -> n | None -> m.handle in 32 32 - Fmt.pf ppf "@[<hov 2>%s (%s) ->@ mono:%s@ opam:%s@]" name_str m.handle mono_str opam_str 31 31 + Fmt.pf ppf "@[<hov 2>%s (%s) ->@ mono:%s@ opam:%s@]" name_str m.handle 32 32 + mono_str opam_str 33 33 34 34 let pp ppf t = 35 35 Fmt.pf ppf "@[<v>registry: %s%a@,members:@, @[<v>%a@]@]" t.name 36 36 - Fmt.(option (fun ppf s -> pf ppf "@,description: %s" s)) t.description 36 36 + Fmt.(option (fun ppf s -> pf ppf "@,description: %s" s)) 37 37 + t.description 37 38 Fmt.(list ~sep:cut pp_member) 38 39 t.members 39 40 ··· 56 57 { handle; name; monorepo; monorepo_branch; opamrepo; opamrepo_branch }) 57 58 |> mem "handle" string ~enc:(fun (m : member) -> m.handle) 58 59 |> opt_mem "name" string ~enc:(fun (m : member) -> m.name) 59 59 - |> mem "monorepo" string ~enc:(fun (m : member) -> encode_url_with_branch m.monorepo m.monorepo_branch) 60 60 - |> mem "opamrepo" string ~enc:(fun (m : member) -> encode_url_with_branch m.opamrepo m.opamrepo_branch) 60 60 + |> mem "monorepo" string ~enc:(fun (m : member) -> 61 61 + encode_url_with_branch m.monorepo m.monorepo_branch) 62 62 + |> mem "opamrepo" string ~enc:(fun (m : member) -> 63 63 + encode_url_with_branch m.opamrepo m.opamrepo_branch) 61 64 |> finish)) 62 65 63 66 type registry_info = { r_name : string; r_description : string option } ··· 74 77 Tomlt.( 75 78 Table.( 76 79 obj (fun registry members -> 77 77 - { name = registry.r_name; description = registry.r_description; members = Option.value ~default:[] members }) 78 78 - |> mem "registry" registry_info_codec ~enc:(fun t -> { r_name = t.name; r_description = t.description }) 80 80 + { 81 81 + name = registry.r_name; 82 82 + description = registry.r_description; 83 83 + members = Option.value ~default:[] members; 84 84 + }) 85 85 + |> mem "registry" registry_info_codec ~enc:(fun t -> 86 86 + { r_name = t.name; r_description = t.description }) 79 87 |> opt_mem "members" (list member_codec) ~enc:(fun t -> 80 88 match t.members with [] -> None | ms -> Some ms) 81 89 |> finish))

+6 -4

lib/verse_registry.mli

reviewed

··· 9 9 handle : string; (** Tangled handle (e.g., "alice.bsky.social") *) 10 10 name : string option; (** Display name (e.g., "Alice Smith") *) 11 11 monorepo : string; (** Git URL of the member's monorepo *) 12 12 - monorepo_branch : string option; (** Optional branch for monorepo (from URL#branch) *) 12 12 + monorepo_branch : string option; 13 13 + (** Optional branch for monorepo (from URL#branch) *) 13 14 opamrepo : string; (** Git URL of the member's opam overlay repository *) 14 14 - opamrepo_branch : string option; (** Optional branch for opam repo (from URL#branch) *) 15 15 + opamrepo_branch : string option; 16 16 + (** Optional branch for opam repo (from URL#branch) *) 15 17 } 16 18 (** A registry member entry. 17 19 18 18 - URLs may include a [#branch] suffix to specify a non-default branch. 19 19 - For example, ["https://github.com/user/repo#develop"]. *) 20 20 + URLs may include a [#branch] suffix to specify a non-default branch. For 21 21 + example, ["https://github.com/user/repo#develop"]. *) 20 22 21 23 type t = { 22 24 name : string; (** Registry name *)