ocaml-merge3 + monopam pull conflict resolution · gazagnaire.org/monopam@36f57f4

+18 -4

lib/ctx.ml

··· 16 16 | Dirty_state of Package.t list 17 17 | Monorepo_dirty 18 18 | Package_not_found of string 19 + | Pull_conflict of { paths : string list; hint : string } 19 20 | Claude_error of string 20 21 | Other of { msg : string; hint : string option } 21 22 ··· 31 32 pkgs 32 33 | Monorepo_dirty -> Fmt.pf ppf "Monorepo has uncommitted changes" 33 34 | Package_not_found name -> Fmt.pf ppf "Package not found: %s" name 35 + | Pull_conflict _ -> () 34 36 | Claude_error msg -> Fmt.pf ppf "Claude error: %s" msg 35 37 | Other { msg; hint = _ } -> Fmt.pf ppf "%s" msg 36 38 ··· 62 64 || Astring.String.is_infix ~affix:"fetch first" result.Git_cli.stderr 63 65 then 64 66 Some 65 - "Use 'monopam push --force' to overwrite diverged history (e.g. \ 66 - after git filter-repo)." 67 + "Run 'monopam pull' to merge the upstream changes, resolve any \ 68 + conflicts, and push again." 67 69 else Some "Check your network connection and git credentials." 68 70 | Git_error _ -> None 69 71 | Dirty_state _ -> ··· 76 78 commit" 77 79 | Package_not_found _ -> 78 80 Some "Check available packages: ls opam-repo/packages/" 81 + | Pull_conflict { hint; _ } -> Some hint 79 82 | Claude_error msg when String.starts_with ~prefix:"Failed to decode" msg -> 80 83 Some "The Claude API may have returned an unexpected response. Try again." 81 84 | Claude_error _ -> ··· 97 100 | Dirty_state _ -> 2 98 101 | Monorepo_dirty -> 2 99 102 | Package_not_found _ -> 2 103 + | Pull_conflict _ -> 4 100 104 | Claude_error _ -> 5 101 105 | Other _ -> 2 102 106 | Git_error g -> ( ··· 243 247 Log.info (fun m -> m "Fetching %s" (Package.repo_name pkg)); 244 248 match Git_cli.fetch ~proc ~fs checkout_dir with 245 249 | Error e -> Error e 246 - | Ok () -> 250 + | Ok () -> ( 247 251 Log.info (fun m -> m "Updating %s to %s" (Package.repo_name pkg) branch); 248 - Git_cli.merge_ff ~proc ~fs ~branch checkout_dir 252 + match Git_cli.merge_ff ~proc ~fs ~branch checkout_dir with 253 + | Ok () -> Ok () 254 + | Error _ -> 255 + (* Checkout diverged from upstream (e.g. after a failed push where 256 + the split was pushed to the checkout but the upstream had a 257 + different commit). Reset to the upstream's HEAD — the checkout 258 + is a derived cache, the monorepo is authoritative. *) 259 + Log.info (fun m -> 260 + m "Fast-forward failed for %s, resetting to upstream" 261 + (Package.repo_name pkg)); 262 + Git_cli.fetch_and_reset ~proc ~fs ~branch checkout_dir) 249 263 end 250 264 251 265 let checkout_exists ~fs ~config pkg =

+2

lib/ctx.mli

··· 12 12 | Dirty_state of Package.t list 13 13 | Monorepo_dirty 14 14 | Package_not_found of string 15 + | Pull_conflict of { paths : string list; hint : string } 16 + (** Pull conflict: merge produced conflict markers. Exit code 4. *) 15 17 | Claude_error of string 16 18 | Other of { msg : string; hint : string option } 17 19 (** Catch-all for one-off errors from add / deps / init / publish that

+96 -31

lib/pull.ml

··· 13 13 cloned : bool; 14 14 commits_pulled : int; 15 15 subtree_added : bool; 16 + conflicts : Git.Merge.conflict list; 16 17 } 17 18 18 19 (** {1 Subtree Operations} *) 19 20 21 + type subtree_result = Added | Merged | Conflict of Git.Merge.conflict list 22 + 23 + let checkout_prefix_after git_repo new_head ~prefix ~verb = 24 + let ( let* ) = Result.bind in 25 + let wrap_err r = 26 + Result.map_error 27 + (fun (`Msg msg) -> 28 + Ctx.Git_error 29 + (Git_cli.Io_error 30 + (Fmt.str "checkout after subtree %s of %s: %s" 31 + (String.lowercase_ascii verb) 32 + prefix msg))) 33 + r 34 + in 35 + let* () = 36 + wrap_err (Git.Repository.checkout_prefix git_repo new_head ~prefix) 37 + in 38 + (* The merge advanced HEAD and wrote the merged tree to the working 39 + directory, but the index is still in the pre-merge state. Subsequent 40 + commits (e.g. write_readme, write_dune_project) would otherwise 41 + overwrite the merged file with the index's stale content. Sync the 42 + index to the working tree. *) 43 + wrap_err (Git.Repository.add_all git_repo) 44 + 20 45 let subtree_merge_or_add ~git_repo ~prefix ~commit ~user ~url ~hash_hex 21 46 ~subtree_exists = 22 - let verb, fn, added = 23 - if subtree_exists then ("Merge", Git.Subtree.merge, false) 24 - else ("Add", Git.Subtree.add, true) 25 - in 26 - let message = 27 - Fmt.str 28 - "%s '%s/' from %s\n\ngit-subtree-dir: %s\ngit-subtree-mainline: %s\n" verb 29 - prefix url prefix hash_hex 47 + let _ = hash_hex in 48 + let message verb = 49 + Fmt.str "%s '%s/' from %s\n\ngit-subtree-dir: %s\n" verb prefix url prefix 30 50 in 31 - match 32 - fn git_repo ~prefix ~commit ~author:user ~committer:user ~message () 33 - with 34 - | Error (`Msg msg) -> Error (Ctx.Git_error (Git_cli.Io_error msg)) 35 - | Ok new_head -> ( 36 - (* Git.Subtree.{add,merge} only update HEAD and the object database; 37 - the working tree still has the pre-merge files. Check the 38 - updated prefix out so the user sees the pulled content on 39 - disk (not just in `git log`). *) 40 - match Git.Repository.checkout_prefix git_repo new_head ~prefix with 41 - | Ok () -> Ok added 42 - | Error (`Msg msg) -> 43 - Error 44 - (Ctx.Git_error 45 - (Git_cli.Io_error 46 - (Fmt.str "checkout after subtree %s of %s: %s" 47 - (String.lowercase_ascii verb) 48 - prefix msg)))) 51 + if subtree_exists then 52 + match 53 + Git.Subtree.merge git_repo ~prefix ~commit ~author:user ~committer:user 54 + ~message:(message "Merge") () 55 + with 56 + | Error (`Msg msg) -> Error (Ctx.Git_error (Git_cli.Io_error msg)) 57 + | Ok (Git.Subtree.Merged new_head) -> 58 + let ( let* ) = Result.bind in 59 + let* () = 60 + checkout_prefix_after git_repo new_head ~prefix ~verb:"merge" 61 + in 62 + Ok Merged 63 + | Ok (Git.Subtree.Conflicts (new_head, conflicts)) -> 64 + let ( let* ) = Result.bind in 65 + let* () = 66 + checkout_prefix_after git_repo new_head ~prefix ~verb:"merge" 67 + in 68 + Ok (Conflict conflicts) 69 + else 70 + match 71 + Git.Subtree.add git_repo ~prefix ~commit ~author:user ~committer:user 72 + ~message:(message "Add") () 73 + with 74 + | Error (`Msg msg) -> Error (Ctx.Git_error (Git_cli.Io_error msg)) 75 + | Ok new_head -> 76 + let ( let* ) = Result.bind in 77 + let* () = checkout_prefix_after git_repo new_head ~prefix ~verb:"add" in 78 + Ok Added 49 79 50 80 (** Look up the sources.toml entry for a package. See the identical helper in 51 81 [push.ml] for the rationale — sources.toml is keyed by the local subtree ··· 227 257 cloned = not existed; 228 258 commits_pulled; 229 259 subtree_added = false; 260 + conflicts = []; 230 261 } 231 262 in 232 263 loop (result :: acc) rest) ··· 249 280 total); 250 281 Log.info (fun m -> m "Subtree %s" name); 251 282 match subtree ~sw ~proc ~fs ~config ?sources pkg with 252 - | Ok subtree_added -> 283 + | Ok Added -> 253 284 Tty.Progress.tick progress; 254 - let result = { cr with subtree_added } in 285 + let result = { cr with subtree_added = true; conflicts = [] } in 286 + loop (result :: results_acc) rest_repos rest_cr 287 + | Ok Merged -> 288 + Tty.Progress.tick progress; 289 + let result = { cr with subtree_added = false; conflicts = [] } in 290 + loop (result :: results_acc) rest_repos rest_cr 291 + | Ok (Conflict conflicts) -> 292 + Tty.Progress.tick progress; 293 + let result = { cr with subtree_added = false; conflicts } in 255 294 loop (result :: results_acc) rest_repos rest_cr 256 295 | Error e -> 257 296 Tty.Progress.clear progress; ··· 268 307 List.filter (fun r -> (not r.cloned) && r.commits_pulled > 0) results 269 308 in 270 309 let added = List.filter (fun r -> r.subtree_added) results in 310 + let conflicted = List.filter (fun r -> r.conflicts <> []) results in 271 311 List.iter (fun r -> Log.app (fun m -> m " + %s (cloned)" r.repo_name)) cloned; 272 312 List.iter 273 313 (fun r -> 274 314 Log.app (fun m -> m " ✓ %s (%d commits)" r.repo_name r.commits_pulled)) 275 315 updated; 276 316 List.iter (fun r -> Log.app (fun m -> m " + %s (added)" r.repo_name)) added; 317 + List.iter 318 + (fun r -> 319 + List.iter 320 + (fun (c : Git.Merge.conflict) -> 321 + Log.app (fun m -> m "CONFLICT in %s/%s" r.repo_name c.path)) 322 + r.conflicts) 323 + conflicted; 277 324 let unchanged = 278 325 List.length results - List.length cloned - List.length updated 279 - - List.length added 326 + - List.length added - List.length conflicted 280 327 in 281 - if cloned = [] && updated = [] && added = [] then 328 + if cloned = [] && updated = [] && added = [] && conflicted = [] then 282 329 Log.app (fun m -> 283 330 m " All %d repositories up to date." (List.length results)) 284 331 else if unchanged > 0 then Log.app (fun m -> m " %d unchanged." unchanged) ··· 459 506 Init.write_readme ~proc ~fs:fs_t ~config all_pkgs; 460 507 Init.write_claude_md ~proc ~fs:fs_t ~config; 461 508 Init.write_dune_project ~proc ~fs:fs_t ~config all_pkgs; 462 - Ok () 509 + (* Check for merge conflicts *) 510 + let all_conflicts = 511 + List.concat_map 512 + (fun r -> 513 + List.map 514 + (fun (c : Git.Merge.conflict) -> r.repo_name ^ "/" ^ c.path) 515 + r.conflicts) 516 + results 517 + in 518 + if all_conflicts <> [] then 519 + Error 520 + (Ctx.Pull_conflict 521 + { 522 + paths = all_conflicts; 523 + hint = 524 + "Edit the conflicted files under mono/, stage the resolution \ 525 + with 'git add', 'git commit', and run 'monopam push' again."; 526 + }) 527 + else Ok () 463 528 end 464 529 end

+6 -5

lib/pull.mli

··· 5 5 cloned : bool; 6 6 commits_pulled : int; 7 7 subtree_added : bool; 8 + conflicts : Git.Merge.conflict list; 8 9 } 9 10 (** Result of a pull operation for a single repository. *) 11 + 12 + type subtree_result = Added | Merged | Conflict of Git.Merge.conflict list 10 13 11 14 val subtree : 12 15 sw:Eio.Switch.t -> ··· 15 18 config:Config.t -> 16 19 ?sources:Sources_registry.t -> 17 20 Package.t -> 18 - (bool, Ctx.error) Stdlib.result 21 + (subtree_result, Ctx.error) Stdlib.result 19 22 (** [subtree ~sw ~proc ~fs ~config ?sources pkg] merges or adds the subtree for 20 - [pkg]. Returns [true] if the subtree was newly added. When [sources] carries 21 - a [path] override for this subtree, the checkout is treated as a clone of an 22 - upstream monorepo and the split at that path is merged instead of the whole 23 - checkout. *) 23 + [pkg]. Returns [Added] if newly added, [Merged] for a clean merge, or 24 + [Conflict conflicts] when the merge produced conflict markers. *) 24 25 25 26 val run : 26 27 sw:Eio.Switch.t ->

+3 -8

lib/push.ml

··· 154 154 in 155 155 let message = 156 156 Fmt.str 157 - "Merge '%s/' from monorepo split of '%s'\n\n\ 158 - git-subtree-dir: %s\n\ 159 - git-subtree-mainline: %s\n" 157 + "Merge '%s/' from monorepo split of '%s'\n\ngit-subtree-dir: %s\n" 160 158 path prefix path 161 - (Git.Hash.to_hex split_hash) 162 159 in 163 160 let merge_or_add () = 164 161 match 165 162 Git.Subtree.merge checkout_repo ~prefix:path ~commit:split_hash 166 163 ~author:user ~committer:user ~message () 167 164 with 168 - | Ok h -> Ok h 165 + | Ok (Git.Subtree.Merged h) -> Ok h 166 + | Ok (Git.Subtree.Conflicts (h, _)) -> Ok h 169 167 | Error (`Msg msg) 170 168 when String.length msg >= 20 171 169 && String.sub msg 0 20 = "Subtree not found at" -> 172 - (* Fresh source that doesn't have this subtree yet. 173 - Fall back to [Subtree.add] so the first push creates 174 - the prefix in the source. *) 175 170 Git.Subtree.add checkout_repo ~prefix:path ~commit:split_hash 176 171 ~author:user ~committer:user ~message () 177 172 | Error (`Msg _) as e -> e

+180

test/pull_conflict.t/run.t

··· 1 + monopam pull: conflict resolution after divergent upstream edit 2 + ================================================================= 3 + 4 + Alice has a monorepo with the lib subtree at commit A. While she 5 + edits the banner line locally, an unrelated developer pushes a 6 + different value for the same line directly to lib.git. Alice's 7 + push then fails because the upstream has diverged. 8 + 9 + The correct recovery is a merge: Alice runs `monopam pull` which 10 + brings the upstream into her mono and leaves git's conflict markers 11 + in the subtree file. She edits the file, picks the resolution, and 12 + `git commit`s. Then `monopam push` succeeds — the merge commit is a 13 + fast-forward descendant of the upstream's tip. 14 + 15 + This test pins the workflow down end to end. The single-developer 16 + push.t and pull.t can't catch it because nothing else ever touches 17 + the upstream while monopam is running. 18 + 19 + Setup 20 + ----- 21 + 22 + $ export NO_COLOR=1 23 + $ export GIT_AUTHOR_NAME="Alice" 24 + $ export GIT_AUTHOR_EMAIL="alice@example.com" 25 + $ export GIT_AUTHOR_DATE="2025-01-01T00:00:00+00:00" 26 + $ export GIT_COMMITTER_NAME="Alice" 27 + $ export GIT_COMMITTER_EMAIL="alice@example.com" 28 + $ export GIT_COMMITTER_DATE="2025-01-01T00:00:00+00:00" 29 + $ export HOME="$PWD/home" 30 + $ mkdir -p "$HOME" 31 + $ export GIT_CONFIG_GLOBAL="$HOME/.gitconfig" 32 + $ printf '[init]\n\tdefaultBranch = main\n[user]\n\tname = Alice\n\temail = alice@example.com\n' > "$GIT_CONFIG_GLOBAL" 33 + $ TROOT=$(pwd) 34 + 35 + Stage 1: empty lib upstream 36 + ---------------------------- 37 + 38 + An empty bare repo — no initial commit — so the first push from 39 + the monorepo establishes the chain (same pattern as push.t). If 40 + the upstream already had history, the split chain would diverge 41 + from it on the first push, which is a separate feature gap and 42 + not what we're testing here. 43 + 44 + $ git init -q --bare lib.git 45 + $ cat > lib.opam << OPAM 46 + > opam-version: "2.0" 47 + > name: "lib" 48 + > version: "dev" 49 + > synopsis: "L" 50 + > dev-repo: "git+file://$TROOT/lib.git" 51 + > OPAM 52 + 53 + Stage 2: Alice's workspace with lib materialized 54 + -------------------------------------------------- 55 + 56 + $ mkdir -p opam-repo/packages/lib/lib.dev 57 + $ cp lib.opam opam-repo/packages/lib/lib.dev/opam 58 + $ cd opam-repo && git init -q && git add . && git commit -q -m "init" && cd "$TROOT" 59 + $ cat > opamverse.toml << EOF 60 + > [workspace] 61 + > root = "$TROOT" 62 + > [identity] 63 + > handle = "alice.example.org" 64 + > knot = "git.example.org" 65 + > EOF 66 + $ mkdir -p mono && cd mono 67 + $ git init -q 68 + $ mkdir -p lib/src 69 + $ cp "$TROOT/lib.opam" lib/lib.opam 70 + $ printf 'let banner = "v1"\n' > lib/src/main.ml 71 + $ git add . && git commit -q -m "initial mono" 72 + $ monopam push lib > /dev/null 2>&1 73 + 74 + Confirm the workspace is in sync with the upstream now that the 75 + first push has populated lib.git: 76 + 77 + $ monopam status 2>&1 | grep -F "Packages:" 78 + Packages: 1 total, all synced 79 + 80 + Stage 3: Alice edits the banner locally 81 + ----------------------------------------- 82 + 83 + $ export GIT_AUTHOR_DATE="2025-02-01T00:00:00+00:00" 84 + $ export GIT_COMMITTER_DATE="2025-02-01T00:00:00+00:00" 85 + $ printf 'let banner = "v2-alice"\n' > lib/src/main.ml 86 + $ git add -A && git commit -q -m "lib: alice's banner" 87 + 88 + Stage 4: someone else pushes a divergent edit to lib.git 89 + ---------------------------------------------------------- 90 + 91 + A second developer (or Alice from another machine) clones the 92 + upstream and pushes a different value for the same line. This 93 + happens entirely outside the monopam workspace. 94 + 95 + $ cd "$TROOT" 96 + $ git clone -q lib.git lib-other 2>/dev/null 97 + $ cd lib-other 98 + $ export GIT_AUTHOR_NAME="Bob" 99 + $ export GIT_AUTHOR_EMAIL="bob@example.com" 100 + $ export GIT_AUTHOR_DATE="2025-02-01T01:00:00+00:00" 101 + $ export GIT_COMMITTER_NAME="Bob" 102 + $ export GIT_COMMITTER_EMAIL="bob@example.com" 103 + $ export GIT_COMMITTER_DATE="2025-02-01T01:00:00+00:00" 104 + $ printf 'let banner = "v2-bob"\n' > src/main.ml 105 + $ git add -A && git commit -q -m "lib: bob's banner" 106 + $ git push -q origin main 2>/dev/null 107 + $ cd "$TROOT/mono" 108 + 109 + Stage 5: Alice's push fails with exit code 4 110 + ----------------------------------------------- 111 + 112 + Exit code 4 is monopam's "push conflict" code, distinct from the 113 + generic user-error code 2 and network code 3. A shell script can 114 + react to it by running recovery automation without scraping stderr. 115 + The hint tells Alice to pull and merge. 116 + 117 + $ export GIT_AUTHOR_NAME="Alice" 118 + $ export GIT_AUTHOR_EMAIL="alice@example.com" 119 + $ export GIT_COMMITTER_NAME="Alice" 120 + $ export GIT_COMMITTER_EMAIL="alice@example.com" 121 + $ monopam push lib > /tmp/push.out 2>&1 122 + [4] 123 + $ grep -F "Hint:" /tmp/push.out 124 + Hint: Run 'monopam pull' to merge the upstream changes, resolve any conflicts, and push again. 125 + 126 + The monorepo subtree still has Alice's local edit — nothing was 127 + rolled back: 128 + 129 + $ cat lib/src/main.ml 130 + let banner = "v2-alice" 131 + 132 + Stage 6: Alice pulls and gets a merge conflict 133 + ------------------------------------------------ 134 + 135 + $ monopam pull lib > /tmp/pull.out 2>&1 136 + [4] 137 + $ grep -E "CONFLICT|Hint:" /tmp/pull.out 138 + CONFLICT in lib/src/main.ml 139 + Hint: Edit the conflicted files under mono/, stage the resolution with 'git add', 'git commit', and run 'monopam push' again. 140 + 141 + The monorepo subtree file has standard git conflict markers: 142 + 143 + $ grep -c "<<<<<<< " lib/src/main.ml 144 + 1 145 + $ grep -c "=======" lib/src/main.ml 146 + 1 147 + $ grep -c ">>>>>>> " lib/src/main.ml 148 + 1 149 + $ grep "v2-alice" lib/src/main.ml 150 + let banner = "v2-alice" 151 + $ grep "v2-bob" lib/src/main.ml 152 + let banner = "v2-bob" 153 + 154 + Stage 7: Alice resolves and commits 155 + ------------------------------------- 156 + 157 + $ printf 'let banner = "v2-alice+bob"\n' > lib/src/main.ml 158 + $ git add lib/src/main.ml 159 + $ git commit -q -m "lib: resolve banner conflict" 160 + 161 + Stage 8: the second push is a fast-forward 162 + -------------------------------------------- 163 + 164 + $ monopam push lib 2>&1 \ 165 + > | grep -F "Changes pushed" \ 166 + > | sed 's/ ([0-9.]*s)//' 167 + ✓ Changes pushed to your remotes. 168 + 169 + The upstream has Alice's resolution layered on top of Bob's commit — 170 + both developers' work is preserved: 171 + 172 + $ rm -rf "$TROOT/verify" && git clone -q "$TROOT/lib.git" "$TROOT/verify" 2>/dev/null 173 + $ cd "$TROOT/verify" && git log --format="%s" 174 + lib: resolve banner conflict 175 + Merge 'lib/' from $TESTCASE_ROOT/src/lib 176 + lib: bob's banner 177 + lib: alice's banner 178 + initial mono 179 + $ cat src/main.ml 180 + let banner = "v2-alice+bob"

Configure Feed

Configure Feed