Integrate fork workflow: create src, rm mono, rejoin as subtree

Pure OCaml xxhash implementation

Fork now performs the complete workflow in one command:
- Creates src/<name>/ with split history or copied files
- Removes mono/<name>/ from git
- Re-adds mono/<name>/ as a proper subtree from src/<name>/

This establishes the subtree relationship automatically so monopam sync
works correctly without manual git rm and rejoin steps.

Added Git.rm function for git rm operations.

Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>

anil.recoil.org 1 month ago 4fef7f60 b21734b1

+94 -59

5 changed files

expand all

unified split

monopam

bin

main.ml

lib

fork_join.ml

fork_join.mli

git.ml

git.mli

+14 -10

monopam/bin/main.ml

··· 1267 1267 [ 1268 1268 `S Manpage.s_description; 1269 1269 `P 1270 - "Splits a monorepo subdirectory into its own git repository. This \ 1271 - extracts the commit history for the subtree and creates a standalone \ 1272 - repository in src/<name>/."; 1270 + "Splits a monorepo subdirectory into its own git repository and \ 1271 + establishes a proper subtree relationship. This creates src/<name>/ \ 1272 + with the extracted history, then re-adds mono/<name>/ as a subtree."; 1273 1273 `S "FORK MODES"; 1274 1274 `P "The fork command handles two scenarios:"; 1275 1275 `I ("Subtree with history", "For subtrees added via $(b,git subtree add) or \ ··· 1279 1279 history, the command copies the files and creates an initial commit. \ 1280 1280 This is useful for new packages you've developed locally."); 1281 1281 `S "WHAT IT DOES"; 1282 - `P "The fork command:"; 1282 + `P "The fork command performs a complete workflow in one step:"; 1283 1283 `I ("1.", "Analyzes mono/<name>/ to detect fork mode"); 1284 1284 `I ("2.", "Builds an action plan and shows discovery details"); 1285 1285 `I ("3.", "Prompts for confirmation (use $(b,--yes) to skip)"); 1286 1286 `I ("4.", "Creates a new git repo at src/<name>/"); 1287 - `I ("5.", "Extracts history or copies files based on mode"); 1288 - `I ("6.", "Updates sources.toml with $(b,origin = \"fork\")"); 1287 + `I ("5.", "Extracts history (subtree split) or copies files (fresh package)"); 1288 + `I ("6.", "Removes mono/<name>/ from git and commits"); 1289 + `I ("7.", "Re-adds mono/<name>/ as a proper subtree from src/<name>/"); 1290 + `I ("8.", "Updates sources.toml with $(b,origin = \"fork\")"); 1289 1291 `S "AFTER FORKING"; 1290 - `P "After forking, the subtree will be tracked via src/<name>/:"; 1291 - `I ("1.", "Make changes in mono/<name>/ as usual"); 1292 - `I ("2.", "Run $(b,monopam sync) to push changes to src/<name>/"); 1293 - `I ("3.", "If you provided a URL, push to remote: $(b,cd src/<name> && git push)"); 1292 + `P "After forking, the subtree relationship is fully established:"; 1293 + `I ("-", "mono/<name>/ is now a proper git subtree of src/<name>/"); 1294 + `I ("-", "$(b,monopam sync) will push/pull changes correctly"); 1295 + `I ("-", "No need for manual $(b,git rm) or $(b,monopam rejoin)"); 1296 + `P "To push to a remote:"; 1297 + `Pre "cd src/<name> && git push -u origin main"; 1294 1298 `S Manpage.s_examples; 1295 1299 `P "Fork a subtree with local-only repo:"; 1296 1300 `Pre "monopam fork my-lib";

+63 -49

monopam/lib/fork_join.ml

··· 28 28 | Copy_directory of { src: Fpath.t; dest: Fpath.t } 29 29 | Git_add_all of Fpath.t 30 30 | Git_commit of { repo: Fpath.t; message: string } 31 + | Git_rm of { repo: Fpath.t; path: string; recursive: bool } (** Remove file/dir from git *) 31 32 | Update_sources_toml of { path: Fpath.t; name: string; entry: Sources_registry.entry } 32 33 33 34 (** Discovery information gathered during planning *) ··· 107 108 Fmt.pf ppf "Stage all changes in %a" Fpath.pp path 108 109 | Git_commit { repo = _; message } -> 109 110 Fmt.pf ppf "Create commit: %s" message 111 + | Git_rm { repo = _; path; recursive = _ } -> 112 + Fmt.pf ppf "Remove '%s' from git" path 110 113 | Update_sources_toml { path = _; name; entry = _ } -> 111 114 Fmt.pf ppf "Update sources.toml for '%s'" name 112 115 ··· 278 281 279 282 (** {1 Plan Builders} *) 280 283 281 - (** Build a fork plan - handles both subtree and fresh package scenarios *) 284 + (** Build a fork plan - handles both subtree and fresh package scenarios. 285 + 286 + The fork workflow: 287 + 1. Create src/<name>/ with the package content (split or copy) 288 + 2. Remove mono/<name>/ from git 289 + 3. Re-add mono/<name>/ as a proper subtree from src/<name>/ 290 + 291 + This ensures the subtree relationship is properly established for sync. *) 282 292 let plan_fork ~proc ~fs ~config ~name ?push_url ?(dry_run = false) () = 283 293 let monorepo = Verse_config.mono_path config in 284 294 let checkouts = Verse_config.src_path config in 285 295 let prefix = name in 286 296 let subtree_path = Fpath.(monorepo / prefix) in 287 297 let src_path = Fpath.(checkouts / name) in 298 + let branch = Verse_config.default_branch in 288 299 289 300 (* Gather discovery information *) 290 301 let mono_exists = Git.Subtree.exists ~fs ~repo:monorepo ~prefix in ··· 315 326 else if opam_files = [] then 316 327 Error (No_opam_files name) 317 328 else begin 318 - (* Build actions based on whether we have subtree history *) 319 - let actions = 320 - if has_subtree_hist then begin 321 - (* Subtree fork (existing behavior) *) 322 - let base_actions = [ 329 + (* Build actions for complete fork workflow: 330 + 1. Create src/<name>/ with content 331 + 2. Remove mono/<name>/ and commit 332 + 3. Re-add as subtree from src/<name>/ *) 333 + let create_src_actions = 334 + if has_subtree_hist then 335 + (* Subtree with history: split and push to new repo *) 336 + [ 323 337 Create_directory checkouts; 324 338 Git_subtree_split { repo = monorepo; prefix }; 325 339 Git_init src_path; 326 340 Git_add_remote { repo = src_path; name = "mono"; url = Fpath.to_string monorepo }; 327 341 Git_push_ref { repo = monorepo; target = Fpath.to_string src_path; ref_spec = "SPLIT_COMMIT:refs/heads/main" }; 328 - Git_checkout { repo = src_path; branch = "main" }; 329 - ] in 330 - let remote_actions = match push_url with 331 - | Some url -> [ 332 - Git_add_remote { repo = src_path; name = "origin"; url }; 333 - Update_sources_toml { 334 - path = Fpath.(monorepo / "sources.toml"); 335 - name; 336 - entry = Sources_registry.{ 337 - url = normalize_git_url url; 338 - upstream = None; 339 - branch = Some "main"; 340 - reason = None; 341 - origin = Some Fork; 342 - }; 343 - }; 344 - ] 345 - | None -> [] 346 - in 347 - base_actions @ remote_actions 348 - end else begin 349 - (* Fresh package fork (NEW behavior) *) 350 - let base_actions = [ 342 + Git_checkout { repo = src_path; branch }; 343 + ] 344 + else 345 + (* Fresh package: copy files and create initial commit *) 346 + [ 351 347 Create_directory checkouts; 352 348 Create_directory src_path; 353 349 Git_init src_path; 350 + Git_branch_rename { repo = src_path; new_name = branch }; 354 351 Copy_directory { src = subtree_path; dest = src_path }; 355 352 Git_add_all src_path; 356 353 Git_commit { repo = src_path; message = Fmt.str "Initial commit of %s" name }; 357 - ] in 358 - let remote_actions = match push_url with 359 - | Some url -> [ 360 - Git_add_remote { repo = src_path; name = "origin"; url }; 361 - Update_sources_toml { 362 - path = Fpath.(monorepo / "sources.toml"); 363 - name; 364 - entry = Sources_registry.{ 365 - url = normalize_git_url url; 366 - upstream = None; 367 - branch = Some "main"; 368 - reason = None; 369 - origin = Some Fork; 370 - }; 371 - }; 372 - ] 373 - | None -> [] 374 - in 375 - base_actions @ remote_actions 376 - end 354 + ] 355 + in 356 + 357 + (* Add remote if push_url provided *) 358 + let remote_actions = match push_url with 359 + | Some url -> [ Git_add_remote { repo = src_path; name = "origin"; url } ] 360 + | None -> [] 361 + in 362 + 363 + (* Remove from mono and re-add as subtree *) 364 + let rejoin_actions = [ 365 + Git_rm { repo = monorepo; path = prefix; recursive = true }; 366 + Git_commit { repo = monorepo; message = Fmt.str "Remove %s for fork" name }; 367 + Git_subtree_add { repo = monorepo; prefix; url = Uri.of_string (Fpath.to_string src_path); branch }; 368 + ] in 369 + 370 + (* Update sources.toml if we have a push_url *) 371 + let sources_actions = match push_url with 372 + | Some url -> [ 373 + Update_sources_toml { 374 + path = Fpath.(monorepo / "sources.toml"); 375 + name; 376 + entry = Sources_registry.{ 377 + url = normalize_git_url url; 378 + upstream = None; 379 + branch = Some branch; 380 + reason = None; 381 + origin = Some Fork; 382 + }; 383 + }; 384 + ] 385 + | None -> [] 377 386 in 387 + 388 + let actions = create_src_actions @ remote_actions @ rejoin_actions @ sources_actions in 378 389 379 390 let result = { 380 391 name; ··· 606 617 |> Result.map_error (fun e -> Git_error e) 607 618 | Git_commit { repo; message } -> 608 619 Git.commit ~proc ~fs ~message repo 620 + |> Result.map_error (fun e -> Git_error e) 621 + | Git_rm { repo; path; recursive } -> 622 + Git.rm ~proc ~fs ~recursive repo path 609 623 |> Result.map_error (fun e -> Git_error e) 610 624 | Update_sources_toml { path; name; entry } -> 611 625 let sources =

monopam/lib/fork_join.mli

··· 52 52 | Copy_directory of { src: Fpath.t; dest: Fpath.t } 53 53 | Git_add_all of Fpath.t 54 54 | Git_commit of { repo: Fpath.t; message: string } 55 + | Git_rm of { repo: Fpath.t; path: string; recursive: bool } (** Remove from git *) 55 56 | Update_sources_toml of { path: Fpath.t; name: string; entry: Sources_registry.entry } 56 57 57 58 (** Discovery information gathered during planning *)

monopam/lib/git.ml

··· 644 644 let cwd = path_to_eio ~fs path in 645 645 run_git_ok ~proc ~cwd [ "commit"; "-m"; message ] |> Result.map ignore 646 646 647 + let rm ~proc ~fs ~recursive path target = 648 + let cwd = path_to_eio ~fs path in 649 + let args = if recursive then [ "rm"; "-r"; target ] else [ "rm"; target ] in 650 + run_git_ok ~proc ~cwd args |> Result.map ignore 651 + 647 652 let has_subtree_history ~proc ~fs ~repo ~prefix () = 648 653 (* Check if there's subtree commit history for this prefix. 649 654 Returns true if we can find a subtree-related commit message. *)

+11

monopam/lib/git.mli

··· 613 613 (** [commit ~proc ~fs ~message path] creates a commit with the given message 614 614 in the repository at [path]. *) 615 615 616 + val rm : 617 + proc:_ Eio.Process.mgr -> 618 + fs:Eio.Fs.dir_ty Eio.Path.t -> 619 + recursive:bool -> 620 + Fpath.t -> 621 + string -> 622 + (unit, error) result 623 + (** [rm ~proc ~fs ~recursive path target] removes [target] from the git index 624 + in the repository at [path]. If [recursive] is true, removes directories 625 + recursively (git rm -r). *) 626 + 616 627 val has_subtree_history : 617 628 proc:_ Eio.Process.mgr -> 618 629 fs:Eio.Fs.dir_ty Eio.Path.t ->