jon.recoil.org
forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
Revert to git subtree push for checkout sync
The diff-based approach broke the convergence invariant by creating
synthetic "Sync X from monorepo" commits instead of preserving original
commit identity. This caused repeated syncs to never converge as each
sync created new commits.
Using git subtree push preserves commit history, ensuring that changes
pushed to checkouts can be recognized as the same commits when pulled
back via subtree pull. The push phase still runs with max_fibers:4.
Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
anil.recoil.org
+7
-45
lib/monopam.ml
+7
-45
lib/monopam.ml
···
921
921
end
922
922
end)
923
923
924
-
let run_git_in ~proc ~cwd args =
925
-
Eio.Switch.run @@ fun sw ->
926
-
let buf_stdout = Buffer.create 256 in
927
-
let buf_stderr = Buffer.create 256 in
928
-
let child =
929
-
Eio.Process.spawn proc ~sw ~cwd
930
-
~stdout:(Eio.Flow.buffer_sink buf_stdout)
931
-
~stderr:(Eio.Flow.buffer_sink buf_stderr)
932
-
("git" :: args)
933
-
in
934
-
match Eio.Process.await child with
935
-
| `Exited 0 -> Ok (Buffer.contents buf_stdout |> String.trim)
936
-
| _ ->
937
-
let result =
938
-
Git.
939
-
{
940
-
exit_code = 1;
941
-
stdout = Buffer.contents buf_stdout;
942
-
stderr = Buffer.contents buf_stderr;
943
-
}
944
-
in
945
-
Error (Git.Command_failed (String.concat " " ("git" :: args), result))
946
-
947
924
let push_one ~proc ~fs ~config pkg =
948
925
let ( let* ) r f =
949
926
Result.bind (Result.map_error (fun e -> Git_error e) r) f
···
953
930
let prefix = Package.subtree_prefix pkg in
954
931
let checkouts_root = Config.Paths.checkouts config in
955
932
let checkout_dir = Package.checkout_dir ~checkouts_root pkg in
933
+
let branch = get_branch ~config pkg in
956
934
if not (Git.Subtree.exists ~fs ~repo:monorepo ~prefix) then begin
957
935
Log.debug (fun m -> m "Subtree %s not in monorepo, skipping" prefix);
958
936
Ok ()
···
972
950
end
973
951
else Ok ()
974
952
in
975
-
(* Fast path: use diff-based approach instead of git subtree push *)
976
-
let subtree_path = Fpath.(monorepo / prefix) in
977
-
Log.info (fun m -> m "Comparing %s with checkout" prefix);
978
-
let* diff =
979
-
Git.diff_trees ~proc ~fs ~source:subtree_path ~target:checkout_dir
980
-
in
981
-
if String.length diff = 0 then begin
982
-
Log.debug (fun m -> m "No changes in %s" prefix);
983
-
Ok ()
984
-
end
985
-
else begin
986
-
(* Apply diff to checkout *)
987
-
Log.info (fun m -> m "Applying changes to %s checkout" prefix);
988
-
let* () = Git.apply_diff ~proc ~fs ~cwd:checkout_dir ~diff in
989
-
(* Stage all changes *)
990
-
let* _ = run_git_in ~proc ~cwd:checkout_eio [ "add"; "-A" ] in
991
-
(* Commit with a descriptive message *)
992
-
let repo_name = Package.repo_name pkg in
993
-
let message = Printf.sprintf "Sync %s from monorepo" repo_name in
994
-
let* _ = run_git_in ~proc ~cwd:checkout_eio [ "commit"; "-m"; message ] in
995
-
Ok ()
996
-
end
953
+
(* Use git subtree push to export commits to the checkout.
954
+
This preserves commit identity, ensuring round-trips converge. *)
955
+
let checkout_url = Uri.of_string (Fpath.to_string checkout_dir) in
956
+
Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir);
957
+
let* () = Git.Subtree.push ~proc ~fs ~repo:monorepo ~prefix ~url:checkout_url ~branch () in
958
+
Ok ()
997
959
end
998
960
999
961
let push ~proc ~fs ~config ?package ?(upstream = false) () =