forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
fix(monopam): make --force flag apply to subtree-to-checkout push
Previously --force only controlled the checkout-to-upstream push, while
the subtree-to-checkout push used ~force:clean (tied to --clean). This
meant --force alone couldn't resolve non-fast-forward rejections when
pushing to checkouts.
+17
-15
+17
-15
lib/push.ml
+17
-15
lib/push.ml
···
19
19
| _ -> None)
20
20
21
21
let split_and_push ~proc ~fs ~monorepo ~git_repo ~prefix ~checkout_url ~clean
22
-
~branch =
22
+
~force ~branch =
23
23
let _checked, errors = Git.Subtree.verify git_repo ~prefix () in
24
24
if errors <> [] then begin
25
25
Log.info (fun m ->
···
49
49
let refspec = Git.Hash.to_hex final_hash ^ ":refs/heads/" ^ branch in
50
50
match
51
51
Git_cli.push_refspec ~proc ~fs ~repo:monorepo ~url:checkout_url
52
-
~refspec ~force:clean ()
52
+
~refspec ~force:(clean || force) ()
53
53
with
54
54
| Ok () -> Ok ()
55
55
| Error e -> Error (Ctx.Git_error e)))
···
66
66
Ctx.normalize_opam_url_string (Uri.to_string (Package.dev_repo pkg)))
67
67
| None -> Ctx.normalize_opam_url_string (Uri.to_string (Package.dev_repo pkg))
68
68
69
-
let one ~proc ~fs ~config ~sources ~clean pkg =
69
+
let one ~proc ~fs ~config ~sources ~clean ~force pkg =
70
70
let ( let* ) r f =
71
71
Result.bind (Result.map_error (fun e -> Ctx.Git_error e) r) f
72
72
in
···
116
116
checkout_dir
117
117
in
118
118
split_and_push ~proc ~fs ~monorepo ~git_repo ~prefix ~checkout_url ~clean
119
-
~branch
119
+
~force ~branch
120
120
|> Result.map (fun () -> true)
121
121
end
122
122
end
···
187
187
188
188
(** {1 Main Push Operation} *)
189
189
190
-
let export_repos ~proc ~fs ~config ~sources ~clean ~progress repos =
190
+
let export_repos ~proc ~fs ~config ~sources ~clean ~force ~progress repos =
191
191
let update_progress name =
192
192
Tty.Progress.update progress ~phase:"Export" ~msg:name
193
193
in
···
197
197
let name = Package.subtree_prefix pkg in
198
198
update_progress name;
199
199
Log.debug (fun m -> m "Subtree push %s" name);
200
-
match one ~proc ~fs ~config ~sources ~clean pkg with
200
+
match one ~proc ~fs ~config ~sources ~clean ~force pkg with
201
201
| Ok true -> loop (pkg :: pushed_repos) rest
202
202
| Ok false -> loop pushed_repos rest
203
203
| Error e ->
···
298
298
299
299
(** Configure a checkout and push a subtree split to it. *)
300
300
let inner_subtree ~proc ~fs_t ~monorepo ~git_repo ~prefix ~checkout_dir ~name
301
-
~clean ~branch =
301
+
~clean ~force ~branch =
302
302
(match
303
303
Git_cli.ensure_receive_config ~proc ~fs:(fs_t :> _ Eio.Path.t) checkout_dir
304
304
with
···
308
308
let checkout_url = Fpath.to_string checkout_dir in
309
309
match
310
310
split_and_push ~proc ~fs:fs_t ~monorepo ~git_repo ~prefix ~checkout_url
311
-
~clean ~branch
311
+
~clean ~force ~branch
312
312
with
313
313
| Ok () -> Log.info (fun m -> m "Pushed mono inner subtree %s" prefix)
314
314
| Error e ->
···
318
318
319
319
(** Process one mono entry: load its inner sources.toml and push each inner
320
320
subtree. *)
321
-
let mono_inner ~proc ~fs_t ~monorepo ~checkouts_root ~git_repo ~clean mono_name
322
-
=
321
+
let mono_inner ~proc ~fs_t ~monorepo ~checkouts_root ~git_repo ~clean ~force
322
+
mono_name =
323
323
let inner_sources_path = Fpath.(monorepo / mono_name / "sources.toml") in
324
324
match Sources_registry.load ~fs:(fs_t :> _ Eio.Path.t) inner_sources_path with
325
325
| Error msg ->
···
345
345
if cloned then
346
346
inner_subtree ~proc ~fs_t ~monorepo ~git_repo
347
347
~prefix:nested_prefix ~checkout_dir ~name:inner_name ~clean
348
-
~branch
348
+
~force ~branch
349
349
end)
350
350
inner_entries
351
351
352
352
(** Push inner subtrees of mono=true entries. For each entry in the inner
353
353
sources.toml, splits at the nested prefix and pushes to a shared checkout.
354
354
*)
355
-
let mono_entries ~proc ~fs ~config ~sources ~clean =
355
+
let mono_entries ~proc ~fs ~config ~sources ~clean ~force =
356
356
let fs_t = Ctx.fs_typed fs in
357
357
let monorepo = Config.Paths.monorepo config in
358
358
let checkouts_root = Config.Paths.checkouts config in
···
368
368
List.iter
369
369
(fun (mono_name, _mono_entry) ->
370
370
mono_inner ~proc ~fs_t ~monorepo ~checkouts_root ~git_repo ~clean
371
-
mono_name)
371
+
~force mono_name)
372
372
mono
373
373
end
374
374
···
377
377
let n_repos = List.length repos in
378
378
let total = if upstream then n_repos * 2 else n_repos in
379
379
let progress = Tty.Progress.v ~total "Push" in
380
-
match export_repos ~proc ~fs ~config ~sources ~clean ~progress repos with
380
+
match
381
+
export_repos ~proc ~fs ~config ~sources ~clean ~force ~progress repos
382
+
with
381
383
| Error e -> Error e
382
384
| Ok pushed_repos -> (
383
385
let push_results =
···
437
439
Log.warn (fun m -> m "Opam sync failed: %s" msg));
438
440
let sources = load_sources ~fs:fs_t ~config in
439
441
(* Push mono inner subtrees first (depth-first) *)
440
-
mono_entries ~proc ~fs ~config ~sources ~clean;
442
+
mono_entries ~proc ~fs ~config ~sources ~clean ~force;
441
443
let to_push = repos_to_push statuses pkgs in
442
444
Log.info (fun m -> m "Pushing %d unique repos" (List.length to_push));
443
445
let push_mono = packages = [] in