forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
monopam: drop redundant prefixes, finish E010 nesting cleanup
Renames: import_message -> subtree_message; push_via_path -> via_path;
push_via_split -> via_split; push_results -> to_checkout_results;
make_local_results -> local_results.
Add Common.with_eio_verse to wrap the
Eio_main.run / with_config / with_verse_config / Switch.run chain so
cherrypick_run, diff_run, and pull_run in cmd_verse.ml become a single
expression instead of a 5-deep callback ladder. The wrapper itself
delegates to a [run_with_configs] helper to keep its own depth in
range.
monopam now reports zero merlint issues across 69 rules.
+34
-35
+6
-21
bin/cmd_verse.ml
+6
-21
bin/cmd_verse.ml
···
53
53
| Error e -> Common.fail_ctx e
54
54
55
55
let pull_run handle repo refresh () =
56
-
Eio_main.run @@ fun env ->
57
-
Common.with_config env @@ fun config ->
58
-
Common.with_verse_config env @@ fun verse_config ->
59
-
let fs = Eio.Stdenv.fs env in
60
-
let proc = Eio.Stdenv.process_mgr env in
61
-
Eio.Switch.run @@ fun sw ->
62
-
pull_inner ~sw ~proc ~fs ~config ~verse_config ~handle ~repo ~refresh
56
+
Common.with_eio_verse (fun ~sw ~proc ~fs ~config ~verse_config ->
57
+
pull_inner ~sw ~proc ~fs ~config ~verse_config ~handle ~repo ~refresh)
63
58
64
59
let pull_cmd =
65
60
let doc = "Pull commits from a verse member's forks" in
···
139
134
`Ok ()
140
135
141
136
let diff_run arg ~refresh ~patch () =
142
-
Eio_main.run @@ fun env ->
143
-
Common.with_config env @@ fun config ->
144
-
Common.with_verse_config env @@ fun verse_config ->
145
-
let fs = Eio.Stdenv.fs env in
146
-
let proc = Eio.Stdenv.process_mgr env in
147
-
Eio.Switch.run @@ fun sw ->
148
-
diff_inner ~sw ~proc ~fs ~config ~verse_config ~arg ~refresh ~patch
137
+
Common.with_eio_verse (fun ~sw ~proc ~fs ~config ~verse_config ->
138
+
diff_inner ~sw ~proc ~fs ~config ~verse_config ~arg ~refresh ~patch)
149
139
150
140
let diff_cmd =
151
141
let doc = "Show diffs from verse members" in
···
170
160
| Error e -> Common.fail_ctx e
171
161
172
162
let cherrypick_run sha refresh () =
173
-
Eio_main.run @@ fun env ->
174
-
Common.with_config env @@ fun config ->
175
-
Common.with_verse_config env @@ fun verse_config ->
176
-
let fs = Eio.Stdenv.fs env in
177
-
let proc = Eio.Stdenv.process_mgr env in
178
-
Eio.Switch.run @@ fun sw ->
179
-
cherrypick_inner ~sw ~proc ~fs ~config ~verse_config ~sha ~refresh
163
+
Common.with_eio_verse (fun ~sw ~proc ~fs ~config ~verse_config ->
164
+
cherrypick_inner ~sw ~proc ~fs ~config ~verse_config ~sha ~refresh)
180
165
181
166
let cherrypick_cmd =
182
167
let doc = "Cherry-pick a specific commit from a verse member" in
+14
bin/common.ml
+14
bin/common.ml
···
90
90
Fmt.str "loading verse config: %a" Monopam.Config.pp_load_error err
91
91
in
92
92
fail_ctx (Monopam.Ctx.err ~hint msg)
93
+
94
+
let run_with_configs ~env ~config ~verse_config f =
95
+
let fs = Eio.Stdenv.fs env in
96
+
let proc = Eio.Stdenv.process_mgr env in
97
+
Eio.Switch.run @@ fun sw -> f ~sw ~proc ~fs ~config ~verse_config
98
+
99
+
(** Combined eio env setup for verse commands that need both config and
100
+
verse_config plus a switch. Lets callers stay shallow rather than chaining
101
+
[Eio_main.run / with_config / with_verse_config / Switch.run] inline. *)
102
+
let with_eio_verse f =
103
+
Eio_main.run @@ fun env ->
104
+
with_config env @@ fun config ->
105
+
with_verse_config env @@ fun verse_config ->
106
+
run_with_configs ~env ~config ~verse_config f
+2
-2
lib/import.ml
+2
-2
lib/import.ml
···
223
223
Log.app (fun m ->
224
224
m "Would import %s from %s (ref: %s)" name url ref_to_use)
225
225
226
-
let import_message ~name ~fetch_url ~path =
226
+
let subtree_message ~name ~fetch_url ~path =
227
227
match path with
228
228
| None ->
229
229
Fmt.str "Add '%s' from %s\n\ngit-subtree-dir: %s\n" name fetch_url name
···
266
266
| Error msg -> Error msg
267
267
| Ok commit ->
268
268
let user = git_user ~fs () in
269
-
let message = import_message ~name ~fetch_url ~path in
269
+
let message = subtree_message ~name ~fetch_url ~path in
270
270
add_subtree git_repo ~name ~commit ~user ~message ~hash_hex)
271
271
272
272
let git_url ~sw ~proc ~fs ~target ~url ~branch ~ref_ ?path ~name ~dry_run () =
+12
-12
lib/push.ml
+12
-12
lib/push.ml
···
227
227
Log.debug (fun m -> m "Could not clone %s from %s — skipping" prefix url);
228
228
false
229
229
230
-
let push_via_path ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix ~path
230
+
let via_path ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix ~path
231
231
~branch =
232
232
Log.info (fun m ->
233
233
m "Subtree push with path %s/%s -> %a" prefix path Fpath.pp checkout_dir);
···
238
238
~prefix ~path ~branch
239
239
|> Result.map (fun () -> Pushed))
240
240
241
-
let push_via_split ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix
242
-
~branch ~clean ~force =
241
+
let via_split ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix ~branch
242
+
~clean ~force =
243
243
let checkout_url = Fpath.to_string checkout_dir in
244
244
let checkout_tree = checkout_tree_hash ~sw ~fs checkout_dir in
245
245
Log.info (fun m -> m "Subtree push %s -> %a" prefix Fpath.pp checkout_dir);
···
285
285
let git_repo = Git.Repository.open_repo ~sw ~fs monorepo in
286
286
match path_override with
287
287
| Some path ->
288
-
push_via_path ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix
289
-
~path ~branch
288
+
via_path ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix ~path
289
+
~branch
290
290
| None ->
291
-
push_via_split ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix
291
+
via_split ~sw ~proc ~fs ~monorepo ~git_repo ~checkout_dir ~prefix
292
292
~branch ~clean ~force
293
293
294
294
(** {1 Workspace Repo Push} *)
···
735
735
(Git.Subtree.split_batch git_repo ~prefixes ~head ~on_progress () : _ list);
736
736
Option.iter (fun b -> Tty.Progress.finish ~message:"split" b) !split_progress
737
737
738
-
let make_local_results ~config repos =
738
+
let local_results ~config repos =
739
739
List.map
740
740
(fun p ->
741
741
let name = Package.repo_name p in
···
744
744
Ok (name, url))
745
745
repos
746
746
747
-
let push_results ~sw ~proc ~fs_t ~config ~sources ~upstream ~force ~progress
748
-
pushed_repos =
747
+
let to_checkout_results ~sw ~proc ~fs_t ~config ~sources ~upstream ~force
748
+
~progress pushed_repos =
749
749
if upstream && pushed_repos <> [] then
750
750
to_upstream ~sw ~proc ~fs:fs_t ~config ~sources ~force ~progress
751
751
pushed_repos
752
-
else make_local_results ~config pushed_repos
752
+
else local_results ~config pushed_repos
753
753
754
754
let workspace_check ~sw ~proc ~fs_t ~config ~force ~push_mono ~upstream =
755
755
let ws_errors =
···
786
786
Error e
787
787
| Ok (pushed_repos, missing) -> (
788
788
let results =
789
-
push_results ~sw ~proc ~fs_t ~config ~sources ~upstream ~force ~progress
790
-
pushed_repos
789
+
to_checkout_results ~sw ~proc ~fs_t ~config ~sources ~upstream ~force
790
+
~progress pushed_repos
791
791
in
792
792
Tty.Progress.finish ~message:"exported" progress;
793
793
log_missing_repos ~all_pkgs missing;