+100 -1

monopam/bin/main.ml

··· 1543 in 1544 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)) 1545 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1546 (* Site command *) 1547 1548 let site_cmd = ··· 1742 in 1743 let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in 1744 Cmd.group info 1745 - [ 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; devcontainer_cmd; site_cmd ] 1746 1747 let () = exit (Cmd.eval main_cmd)

··· 1543 in 1544 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)) 1545 1546 + (* Rejoin command *) 1547 + 1548 + let rejoin_cmd = 1549 + let doc = "Add a source checkout back into the monorepo as a subtree" in 1550 + let man = 1551 + [ 1552 + `S Manpage.s_description; 1553 + `P 1554 + "Adds an existing src/<name>/ repository back into mono/<name>/ as a \ 1555 + subtree. This is useful after forking a package and removing it from \ 1556 + the monorepo with $(b,git rm)."; 1557 + `S "WORKFLOW"; 1558 + `P "Typical workflow for removing and re-adding a package:"; 1559 + `I ("1.", "Fork the package: $(b,monopam fork my-lib)"); 1560 + `I ("2.", "Remove from monorepo: $(b,git rm -r mono/my-lib && git commit)"); 1561 + `I ("3.", "Work on it in src/my-lib/"); 1562 + `I ("4.", "Re-add to monorepo: $(b,monopam rejoin my-lib)"); 1563 + `S "REQUIREMENTS"; 1564 + `P "For rejoin to work:"; 1565 + `I ("-", "src/<name>/ must exist and be a git repository"); 1566 + `I ("-", "mono/<name>/ must NOT exist (was removed)"); 1567 + `S "WHAT IT DOES"; 1568 + `P "The rejoin command:"; 1569 + `I ("1.", "Verifies src/<name>/ exists and is a git repo"); 1570 + `I ("2.", "Verifies mono/<name>/ does not exist"); 1571 + `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)"); 1572 + `I ("4.", "Uses $(b,git subtree add) to bring src/<name>/ into mono/<name>/"); 1573 + `S Manpage.s_examples; 1574 + `P "Re-add a package from src/:"; 1575 + `Pre "monopam rejoin my-lib"; 1576 + `P "Preview what would be done:"; 1577 + `Pre "monopam rejoin my-lib --dry-run"; 1578 + `P "Rejoin without confirmation:"; 1579 + `Pre "monopam rejoin my-lib --yes"; 1580 + ] 1581 + in 1582 + let info = Cmd.info "rejoin" ~doc ~man in 1583 + let name_arg = 1584 + let doc = "Name of the subtree to rejoin (directory name under src/)" in 1585 + Arg.(required & pos 0 (some string) None & info [] ~docv:"NAME" ~doc) 1586 + in 1587 + let dry_run_arg = 1588 + let doc = "Show what would be done without making changes" in 1589 + Arg.(value & flag & info [ "dry-run"; "n" ] ~doc) 1590 + in 1591 + let yes_arg = 1592 + let doc = "Assume yes to all prompts (for automation)" in 1593 + Arg.(value & flag & info [ "yes"; "y" ] ~doc) 1594 + in 1595 + let run name dry_run yes () = 1596 + Eio_main.run @@ fun env -> 1597 + with_verse_config env @@ fun config -> 1598 + let fs = Eio.Stdenv.fs env in 1599 + let proc = Eio.Stdenv.process_mgr env in 1600 + (* Build the plan *) 1601 + match Monopam.Fork_join.plan_rejoin ~proc ~fs ~config ~name ~dry_run () with 1602 + | Error e -> 1603 + Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1604 + `Error (false, "rejoin failed") 1605 + | Ok plan -> 1606 + (* Print discovery and actions *) 1607 + Fmt.pr "Analyzing rejoin request for '%s'...@.@." name; 1608 + Fmt.pr "Discovery:@.%a@." Monopam.Fork_join.pp_discovery plan.discovery; 1609 + Fmt.pr "@.Actions to perform:@."; 1610 + List.iteri (fun i action -> 1611 + Fmt.pr " %d. %a@." (i + 1) Monopam.Fork_join.pp_action action 1612 + ) plan.actions; 1613 + Fmt.pr "@."; 1614 + (* Prompt for confirmation unless --yes or --dry-run *) 1615 + let proceed = 1616 + if dry_run then begin 1617 + Fmt.pr "(dry-run mode - no changes will be made)@."; 1618 + true 1619 + end else if yes then 1620 + true 1621 + else 1622 + confirm "Proceed?" 1623 + in 1624 + if not proceed then begin 1625 + Fmt.pr "Cancelled.@."; 1626 + `Ok () 1627 + end else begin 1628 + (* Execute the plan *) 1629 + match Monopam.Fork_join.execute_join_plan ~proc ~fs plan with 1630 + | Ok result -> 1631 + if not dry_run then begin 1632 + Fmt.pr "%a@." Monopam.Fork_join.pp_join_result result; 1633 + Fmt.pr "@.Next steps:@."; 1634 + Fmt.pr " 1. Commit the changes: git add -A && git commit@."; 1635 + Fmt.pr " 2. Run $(b,monopam sync) to synchronize@." 1636 + end; 1637 + `Ok () 1638 + | Error e -> 1639 + Fmt.epr "Error: %a@." Monopam.Fork_join.pp_error_with_hint e; 1640 + `Error (false, "rejoin failed") 1641 + end 1642 + in 1643 + Cmd.v info Term.(ret (const run $ name_arg $ dry_run_arg $ yes_arg $ logging_term)) 1644 + 1645 (* Site command *) 1646 1647 let site_cmd = ··· 1841 in 1842 let info = Cmd.info "monopam" ~version:"%%VERSION%%" ~doc ~man in 1843 Cmd.group info 1844 + [ 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 ] 1845 1846 let () = exit (Cmd.eval main_cmd)

+50

monopam/lib/fork_join.ml

··· 5 | Git_error of Git.error 6 | Subtree_not_found of string 7 | Src_already_exists of string 0 8 | Subtree_already_exists of string 9 | No_opam_files of string 10 | Verse_error of Verse.error ··· 52 | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 53 | Subtree_not_found name -> Fmt.pf ppf "Subtree not found in monorepo: %s" name 54 | Src_already_exists name -> Fmt.pf ppf "Source checkout already exists: src/%s" name 0 55 | Subtree_already_exists name -> Fmt.pf ppf "Subtree already exists in monorepo: mono/%s" name 56 | No_opam_files name -> Fmt.pf ppf "No .opam files found in subtree: %s" name 57 | Verse_error e -> Fmt.pf ppf "Verse error: %a" Verse.pp_error e ··· 67 Some (Fmt.str "Check that mono/%s exists in your monorepo" name) 68 | Src_already_exists name -> 69 Some (Fmt.str "Remove or rename src/%s first, or choose a different name" name) 0 0 70 | Subtree_already_exists name -> 71 Some (Fmt.str "Remove mono/%s first, or use a different name with --as" name) 72 | No_opam_files name -> ··· 488 } in 489 490 Ok { discovery = { discovery with opam_files = opam_preview }; actions; result; dry_run } 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 491 end 492 493 (** {1 Plan Execution} *)

··· 5 | Git_error of Git.error 6 | Subtree_not_found of string 7 | Src_already_exists of string 8 + | Src_not_found of string 9 | Subtree_already_exists of string 10 | No_opam_files of string 11 | Verse_error of Verse.error ··· 53 | Git_error e -> Fmt.pf ppf "Git error: %a" Git.pp_error e 54 | Subtree_not_found name -> Fmt.pf ppf "Subtree not found in monorepo: %s" name 55 | Src_already_exists name -> Fmt.pf ppf "Source checkout already exists: src/%s" name 56 + | Src_not_found name -> Fmt.pf ppf "Source checkout not found: src/%s" name 57 | Subtree_already_exists name -> Fmt.pf ppf "Subtree already exists in monorepo: mono/%s" name 58 | No_opam_files name -> Fmt.pf ppf "No .opam files found in subtree: %s" name 59 | Verse_error e -> Fmt.pf ppf "Verse error: %a" Verse.pp_error e ··· 69 Some (Fmt.str "Check that mono/%s exists in your monorepo" name) 70 | Src_already_exists name -> 71 Some (Fmt.str "Remove or rename src/%s first, or choose a different name" name) 72 + | Src_not_found name -> 73 + Some (Fmt.str "Run 'monopam fork %s' first to create src/%s" name name) 74 | Subtree_already_exists name -> 75 Some (Fmt.str "Remove mono/%s first, or use a different name with --as" name) 76 | No_opam_files name -> ··· 492 } in 493 494 Ok { discovery = { discovery with opam_files = opam_preview }; actions; result; dry_run } 495 + end 496 + 497 + (** Build a rejoin plan - add existing src/<name> back into mono/<name> *) 498 + let plan_rejoin ~proc ~fs ~config ~name ?(dry_run = false) () = 499 + let monorepo = Verse_config.mono_path config in 500 + let checkouts = Verse_config.src_path config in 501 + let prefix = name in 502 + let src_path = Fpath.(checkouts / name) in 503 + 504 + (* Gather discovery information *) 505 + let subtree_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in 506 + let src_exists = is_directory ~fs src_path in 507 + let src_is_repo = if src_exists then Git.is_repo ~proc ~fs src_path else false in 508 + let opam_files = if src_exists then find_opam_files ~fs src_path else [] in 509 + 510 + let discovery = { 511 + mono_exists = subtree_exists; 512 + src_exists; 513 + has_subtree_history = false; 514 + remote_accessible = None; 515 + opam_files; 516 + local_path_is_repo = Some src_is_repo; 517 + } in 518 + 519 + (* Validation *) 520 + if subtree_exists then 521 + Error (Subtree_already_exists name) 522 + else if not src_exists then 523 + Error (Src_not_found name) 524 + else if not src_is_repo then 525 + Error (Config_error (Fmt.str "src/%s exists but is not a git repository" name)) 526 + else begin 527 + let branch = Verse_config.default_branch in 528 + let actions = [ 529 + Git_subtree_add { repo = monorepo; prefix; url = Uri.of_string (Fpath.to_string src_path); branch }; 530 + ] in 531 + 532 + let result = { 533 + name; 534 + source_url = Fpath.to_string src_path; 535 + upstream_url = None; 536 + packages_added = opam_files; 537 + from_handle = None; 538 + } in 539 + 540 + Ok { discovery; actions; result; dry_run } 541 end 542 543 (** {1 Plan Execution} *)

+23

monopam/lib/fork_join.mli

··· 20 | Git_error of Git.error (** Git operation failed *) 21 | Subtree_not_found of string (** Subtree not found in monorepo *) 22 | Src_already_exists of string (** Source checkout already exists *) 0 23 | Subtree_already_exists of string (** Subtree already exists in monorepo *) 24 | No_opam_files of string (** No .opam files found in subtree *) 25 | Verse_error of Verse.error (** Error from verse operations *) ··· 156 @param source Git URL or local filesystem path to join 157 @param name Override the subtree directory name (default: derived from source) 158 @param upstream Original upstream URL if this is your fork 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 159 @param dry_run If true, mark plan as dry-run (execute will skip actions) *) 160 161 (** {1 Plan Execution} *)

··· 20 | Git_error of Git.error (** Git operation failed *) 21 | Subtree_not_found of string (** Subtree not found in monorepo *) 22 | Src_already_exists of string (** Source checkout already exists *) 23 + | Src_not_found of string (** Source checkout not found *) 24 | Subtree_already_exists of string (** Subtree already exists in monorepo *) 25 | No_opam_files of string (** No .opam files found in subtree *) 26 | Verse_error of Verse.error (** Error from verse operations *) ··· 157 @param source Git URL or local filesystem path to join 158 @param name Override the subtree directory name (default: derived from source) 159 @param upstream Original upstream URL if this is your fork 160 + @param dry_run If true, mark plan as dry-run (execute will skip actions) *) 161 + 162 + val plan_rejoin : 163 + proc:_ Eio.Process.mgr -> 164 + fs:Eio.Fs.dir_ty Eio.Path.t -> 165 + config:Verse_config.t -> 166 + name:string -> 167 + ?dry_run:bool -> 168 + unit -> 169 + (join_result action_plan, error) result 170 + (** [plan_rejoin ~proc ~fs ~config ~name ?dry_run ()] builds a rejoin plan. 171 + 172 + This is used to add an existing src/<name>/ repository back into mono/<name>/ 173 + as a subtree. Useful after forking a package and removing it from the monorepo. 174 + 175 + Requires: 176 + - src/<name>/ must exist and be a git repository 177 + - mono/<name>/ must not exist 178 + 179 + The plan can be displayed to the user and executed with [execute_join_plan]. 180 + 181 + @param name Name of the subtree (directory name under src/ and mono/) 182 @param dry_run If true, mark plan as dry-run (execute will skip actions) *) 183 184 (** {1 Plan Execution} *)