forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
Skip unavailable upstream repos during push; report at end
When a remote repo doesn't exist yet (clone fails with "not found"),
skip it and continue pushing the remaining repos. After all pushes
complete, report the missing repos with their URLs and package
synopses so the user can create them in one batch.
Previously, a single missing repo would abort the entire push.
+75
-36
+75
-36
lib/push.ml
+75
-36
lib/push.ml
···
65
65
| `Directory when Git.Repository.is_repo ~fs checkout_dir -> false
66
66
| _ -> true
67
67
68
+
type push_result =
69
+
| Pushed (** Subtree was exported and pushed to checkout *)
70
+
| Skipped (** Nothing to push (up-to-date or not in monorepo) *)
71
+
| Clone_failed of string (** Remote repo doesn't exist or is unreachable *)
72
+
68
73
let one ~proc ~fs ~config ~sources ~clean ~force pkg =
69
74
let ( let* ) r f =
70
75
Result.bind (Result.map_error (fun e -> Ctx.Git_error e) r) f
···
78
83
let clone_url = resolve_fetch_url ~sources pkg in
79
84
if not (Ctx.is_directory ~fs Fpath.(monorepo / prefix)) then begin
80
85
Log.debug (fun m -> m "Subtree %s not in monorepo, skipping" prefix);
81
-
Ok false
86
+
Ok Skipped
82
87
end
83
88
else begin
84
89
let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in
85
90
let freshly_cloned = needs_clone ~fs ~checkout_eio ~checkout_dir in
86
-
let* () =
91
+
let clone_ok =
87
92
if freshly_cloned then begin
88
93
Log.info (fun m -> m "Creating checkout for %s" (Package.repo_name pkg));
89
-
Ctx.ensure_checkout ~proc
90
-
~fs:(fs :> _ Eio.Path.t)
91
-
~config ~url:clone_url pkg
94
+
match
95
+
Ctx.ensure_checkout ~proc
96
+
~fs:(fs :> _ Eio.Path.t)
97
+
~config ~url:clone_url pkg
98
+
with
99
+
| Ok () -> true
100
+
| Error _ ->
101
+
Log.warn (fun m ->
102
+
m "Could not clone %s from %s — skipping" prefix clone_url);
103
+
false
92
104
end
93
-
else Ok ()
94
-
in
95
-
let checkout_url = Fpath.to_string checkout_dir in
96
-
let git_repo = Git.Repository.open_repo ~fs monorepo in
97
-
let mono_tree =
98
-
Git.Repository.tree_hash_at_path git_repo ~rev:"HEAD" ~path:prefix
105
+
else true
99
106
in
100
-
let checkout_tree = checkout_tree_hash ~fs checkout_dir in
101
-
if mono_tree = checkout_tree && mono_tree <> None then begin
102
-
Log.debug (fun m -> m "Skipping %s (trees match)" prefix);
103
-
Ok true
104
-
end
105
-
else begin
106
-
Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir);
107
-
let* () =
108
-
Git_cli.ensure_receive_config ~proc
109
-
~fs:(fs :> _ Eio.Path.t)
110
-
checkout_dir
107
+
if not clone_ok then Ok (Clone_failed clone_url)
108
+
else
109
+
let* () = Ok () in
110
+
let checkout_url = Fpath.to_string checkout_dir in
111
+
let git_repo = Git.Repository.open_repo ~fs monorepo in
112
+
let mono_tree =
113
+
Git.Repository.tree_hash_at_path git_repo ~rev:"HEAD" ~path:prefix
111
114
in
112
-
let* () =
113
-
Git_cli.clean_untracked ~proc ~fs:(fs :> _ Eio.Path.t) checkout_dir
114
-
in
115
-
(* Force-push when we just cloned the checkout: the remote's history
115
+
let checkout_tree = checkout_tree_hash ~fs checkout_dir in
116
+
if mono_tree = checkout_tree && mono_tree <> None then begin
117
+
Log.debug (fun m -> m "Skipping %s (trees match)" prefix);
118
+
Ok Skipped
119
+
end
120
+
else begin
121
+
Log.info (fun m ->
122
+
m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir);
123
+
let* () =
124
+
Git_cli.ensure_receive_config ~proc
125
+
~fs:(fs :> _ Eio.Path.t)
126
+
checkout_dir
127
+
in
128
+
let* () =
129
+
Git_cli.clean_untracked ~proc ~fs:(fs :> _ Eio.Path.t) checkout_dir
130
+
in
131
+
(* Force-push when we just cloned the checkout: the remote's history
116
132
and the monorepo's subtree history are independent lineages, so a
117
133
normal push will always be non-fast-forward. *)
118
-
split_and_push ~proc ~fs ~monorepo ~git_repo ~prefix ~checkout_url ~clean
119
-
~force:(force || freshly_cloned) ~branch
120
-
|> Result.map (fun () -> true)
121
-
end
134
+
split_and_push ~proc ~fs ~monorepo ~git_repo ~prefix ~checkout_url
135
+
~clean ~force:(force || freshly_cloned) ~branch
136
+
|> Result.map (fun () -> Pushed)
137
+
end
122
138
end
123
139
124
140
(** {1 Workspace Repo Push} *)
···
187
203
188
204
(** {1 Main Push Operation} *)
189
205
206
+
type missing_repo = { pkg : Package.t; url : string }
207
+
190
208
let export_repos ~proc ~fs ~config ~sources ~clean ~force ~progress repos =
191
209
let update_progress name =
192
210
Tty.Progress.update progress ~phase:"Export" ~msg:name
193
211
in
194
-
let rec loop pushed_repos = function
195
-
| [] -> Ok (List.rev pushed_repos)
212
+
let rec loop pushed_repos missing = function
213
+
| [] -> Ok (List.rev pushed_repos, List.rev missing)
196
214
| pkg :: rest -> (
197
215
let name = Package.subtree_prefix pkg in
198
216
update_progress name;
199
217
Log.debug (fun m -> m "Subtree push %s" name);
200
218
match one ~proc ~fs ~config ~sources ~clean ~force pkg with
201
-
| Ok true -> loop (pkg :: pushed_repos) rest
202
-
| Ok false -> loop pushed_repos rest
219
+
| Ok Pushed -> loop (pkg :: pushed_repos) missing rest
220
+
| Ok Skipped -> loop pushed_repos missing rest
221
+
| Ok (Clone_failed url) ->
222
+
loop pushed_repos ({ pkg; url } :: missing) rest
203
223
| Error e ->
204
224
Tty.Progress.clear progress;
205
225
Error e)
206
226
in
207
-
loop [] repos
227
+
loop [] [] repos
208
228
209
229
let to_upstream ~proc ~fs ~config ~sources ~force ~progress pushed_repos =
210
230
Log.info (fun m ->
···
372
392
mono
373
393
end
374
394
395
+
let log_missing_repos missing =
396
+
if missing <> [] then begin
397
+
Log.app (fun m ->
398
+
m "\n%d repo(s) could not be cloned (remote not found):"
399
+
(List.length missing));
400
+
Log.app (fun m ->
401
+
m "Create them and re-run push. Suggested descriptions:\n");
402
+
List.iter
403
+
(fun { pkg; url } ->
404
+
let name = Package.repo_name pkg in
405
+
let synopsis =
406
+
Option.value ~default:"OCaml library" (Package.synopsis pkg)
407
+
in
408
+
Log.app (fun m -> m " %s %s" url name);
409
+
Log.app (fun m -> m " %s" synopsis))
410
+
missing
411
+
end
412
+
375
413
let export_and_push ~proc ~fs ~fs_t ~config ~sources ~upstream ~push_mono ~clean
376
414
~force repos =
377
415
let n_repos = List.length repos in
···
381
419
export_repos ~proc ~fs ~config ~sources ~clean ~force ~progress repos
382
420
with
383
421
| Error e -> Error e
384
-
| Ok pushed_repos -> (
422
+
| Ok (pushed_repos, missing) -> (
385
423
let push_results =
386
424
if upstream && pushed_repos <> [] then
387
425
to_upstream ~proc ~fs:fs_t ~config ~sources ~force ~progress
···
389
427
else List.map (fun p -> Ok (Package.repo_name p)) pushed_repos
390
428
in
391
429
Tty.Progress.clear progress;
430
+
log_missing_repos missing;
392
431
match log_push_results push_results with
393
432
| Error e -> Error e
394
433
| Ok () ->