forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
Fix merlint E005/E010: split long functions and flatten deep nesting
Refactored 21 functions across 17 files to bring them under merlint
thresholds. Pure structural refactoring — no behavior changes.
Packages: irmin, merlint, monopam, ocaml-btree, ocaml-cdm, ocaml-git,
ocaml-globe, ocaml-kepler, ocaml-osv, ocaml-sigstore, ocaml-stix, prune.
+111
-105
+20
-17
lib/clean.ml
+20
-17
lib/clean.ml
···
64
64
65
65
(** {1 Main Clean Operation} *)
66
66
67
+
let report_results ~total_cleaned ~dry_run ~force ~proc ~fs_t ~checkouts_path
68
+
~checkouts =
69
+
if total_cleaned = 0 then begin
70
+
Log.app (fun m -> m "No empty commits found");
71
+
Ok ()
72
+
end
73
+
else if dry_run then begin
74
+
Log.app (fun m ->
75
+
m "Would remove %d commits (use without --dry-run to apply)"
76
+
total_cleaned);
77
+
Ok ()
78
+
end
79
+
else begin
80
+
Log.app (fun m -> m "Removed %d commits" total_cleaned);
81
+
if force then force_push_checkouts ~proc ~fs_t ~checkouts_path ~checkouts;
82
+
Ok ()
83
+
end
84
+
67
85
let run ~proc ~fs ~config ~dry_run ~force () =
68
86
let fs_t = Ctx.fs_typed fs in
69
87
let mono = Config.Paths.monorepo config in
70
88
let checkouts = Config.Paths.checkouts config in
71
89
let checkouts_path = Eio.Path.(fs_t / Fpath.to_string checkouts) in
72
-
73
90
let mono_cleaned =
74
91
check_and_fix ~fs_t ~dry_run ~name:"mono"
75
92
~check_fn:(fun repo ~head -> Git.Subtree.check_mono repo ~head ())
···
87
104
try Eio.Path.read_dir checkouts_path |> List.filter_map clean_checkout
88
105
with Eio.Io _ -> []
89
106
in
90
-
91
107
let opam_repo_cleaned =
92
108
let opam_repo = Config.Paths.opam_repo config in
93
109
check_and_fix ~fs_t ~dry_run ~name:"opam-repo"
···
100
116
+ Option.value ~default:0 opam_repo_cleaned
101
117
+ List.fold_left ( + ) 0 checkout_results
102
118
in
103
-
if total_cleaned = 0 then begin
104
-
Log.app (fun m -> m "No empty commits found");
105
-
Ok ()
106
-
end
107
-
else if dry_run then begin
108
-
Log.app (fun m ->
109
-
m "Would remove %d commits (use without --dry-run to apply)"
110
-
total_cleaned);
111
-
Ok ()
112
-
end
113
-
else begin
114
-
Log.app (fun m -> m "Removed %d commits" total_cleaned);
115
-
if force then force_push_checkouts ~proc ~fs_t ~checkouts_path ~checkouts;
116
-
Ok ()
117
-
end
119
+
report_results ~total_cleaned ~dry_run ~force ~proc ~fs_t ~checkouts_path
120
+
~checkouts
+84
-81
lib/lint.ml
+84
-81
lib/lint.ml
···
268
268
269
269
(* ---- Core algorithm ---- *)
270
270
271
+
let list_subdirs ~fs ~monorepo =
272
+
let mono_eio = Eio.Path.(fs / Fpath.to_string monorepo) in
273
+
(try Eio.Path.read_dir mono_eio with Eio.Io _ -> [])
274
+
|> List.filter (fun name ->
275
+
name <> ""
276
+
&& (not (String.starts_with ~prefix:"_" name))
277
+
&& (not (String.starts_with ~prefix:"." name))
278
+
&&
279
+
match Eio.Path.kind ~follow:false Eio.Path.(mono_eio / name) with
280
+
| `Directory -> true
281
+
| _ -> false
282
+
| exception _ -> false)
283
+
|> List.sort String.compare
284
+
285
+
let check_package ~index ~build_lib ~dune_pkgs ~own_set ~all_deps ~subtree
286
+
(pkg_name, runtime_deps, _all_deps) ~fs =
287
+
let meta_path = Fpath.(build_lib / pkg_name / "META") in
288
+
match load_file fs meta_path with
289
+
| None ->
290
+
Log.debug (fun m -> m "%s/%s: no META file (not built?)" subtree pkg_name);
291
+
[]
292
+
| Some content -> (
293
+
match parse_meta content with
294
+
| Error msg ->
295
+
Log.warn (fun m ->
296
+
m "%s/%s: META parse error: %s" subtree pkg_name msg);
297
+
[]
298
+
| Ok expr ->
299
+
let required_libs =
300
+
collect_requires expr |> List.sort_uniq String.compare
301
+
in
302
+
let meta_pkgs =
303
+
List.fold_left
304
+
(fun acc lib ->
305
+
if is_builtin lib then acc
306
+
else
307
+
let pkg = lib_to_package index lib in
308
+
if String_set.mem pkg own_set then acc
309
+
else String_set.add pkg acc)
310
+
String_set.empty required_libs
311
+
in
312
+
let missing =
313
+
String_set.fold
314
+
(fun pkg acc ->
315
+
if not (String_set.mem pkg all_deps) then
316
+
{ subtree; kind = Missing; package = pkg } :: acc
317
+
else acc)
318
+
meta_pkgs []
319
+
in
320
+
let needed =
321
+
String_set.union meta_pkgs
322
+
(String_set.union dune_pkgs
323
+
(String_set.union own_set implicit_deps))
324
+
in
325
+
let unused =
326
+
String_set.diff runtime_deps needed
327
+
|> String_set.filter (fun p -> not (is_conf_pkg p))
328
+
in
329
+
let unused_issues =
330
+
String_set.fold
331
+
(fun pkg acc -> { subtree; kind = Unused; package = pkg } :: acc)
332
+
unused []
333
+
in
334
+
missing @ unused_issues)
335
+
336
+
let sort_issues issues =
337
+
List.sort
338
+
(fun a b ->
339
+
match String.compare a.subtree b.subtree with
340
+
| 0 ->
341
+
let ka = match a.kind with Missing -> 0 | Unused -> 1 in
342
+
let kb = match b.kind with Missing -> 0 | Unused -> 1 in
343
+
if ka <> kb then compare ka kb else String.compare a.package b.package
344
+
| n -> n)
345
+
issues
346
+
271
347
let run ~fs ~monorepo () =
272
348
let index = build_library_index ~fs ~monorepo in
273
-
let mono_eio = Eio.Path.(fs / Fpath.to_string monorepo) in
274
349
let build_lib = Fpath.(monorepo / "_build" / "install" / "default" / "lib") in
275
-
let subdirs =
276
-
(try Eio.Path.read_dir mono_eio with Eio.Io _ -> [])
277
-
|> List.filter (fun name ->
278
-
name <> ""
279
-
&& (not (String.starts_with ~prefix:"_" name))
280
-
&& (not (String.starts_with ~prefix:"." name))
281
-
&&
282
-
match Eio.Path.kind ~follow:false Eio.Path.(mono_eio / name) with
283
-
| `Directory -> true
284
-
| _ -> false
285
-
| exception _ -> false)
286
-
|> List.sort String.compare
287
-
in
288
-
350
+
let subdirs = list_subdirs ~fs ~monorepo in
289
351
let issues = ref [] in
290
352
let scanned = ref 0 in
291
-
292
353
List.iter
293
354
(fun subtree ->
294
355
let subtree_path = Fpath.(monorepo / subtree) in
···
302
363
(fun acc (_, _, all) -> String_set.union acc all)
303
364
String_set.empty pkgs
304
365
in
305
-
(* Packages referenced in any dune file (covers executables/tests) *)
306
366
let dune_pkgs = dune_needed_packages ~fs ~index subtree_path in
307
-
(* For each package, load its META and check both directions *)
308
367
List.iter
309
-
(fun (pkg_name, runtime_deps, _all_deps) ->
310
-
let meta_path = Fpath.(build_lib / pkg_name / "META") in
311
-
match load_file fs meta_path with
312
-
| None ->
313
-
Log.debug (fun m ->
314
-
m "%s/%s: no META file (not built?)" subtree pkg_name)
315
-
| Some content -> (
316
-
match parse_meta content with
317
-
| Error msg ->
318
-
Log.warn (fun m ->
319
-
m "%s/%s: META parse error: %s" subtree pkg_name msg)
320
-
| Ok expr ->
321
-
let required_libs =
322
-
collect_requires expr |> List.sort_uniq String.compare
323
-
in
324
-
let meta_pkgs =
325
-
List.fold_left
326
-
(fun acc lib ->
327
-
if is_builtin lib then acc
328
-
else
329
-
let pkg = lib_to_package index lib in
330
-
if String_set.mem pkg own_set then acc
331
-
else String_set.add pkg acc)
332
-
String_set.empty required_libs
333
-
in
334
-
(* Missing: needed by META but not declared *)
335
-
String_set.iter
336
-
(fun pkg ->
337
-
if not (String_set.mem pkg all_deps) then
338
-
issues :=
339
-
{ subtree; kind = Missing; package = pkg }
340
-
:: !issues)
341
-
meta_pkgs;
342
-
(* Unused: runtime dep not needed by META or dune files *)
343
-
let needed =
344
-
String_set.union meta_pkgs
345
-
(String_set.union dune_pkgs
346
-
(String_set.union own_set implicit_deps))
347
-
in
348
-
let unused =
349
-
String_set.diff runtime_deps needed
350
-
|> String_set.filter (fun p -> not (is_conf_pkg p))
351
-
in
352
-
String_set.iter
353
-
(fun pkg ->
354
-
issues :=
355
-
{ subtree; kind = Unused; package = pkg } :: !issues)
356
-
unused))
368
+
(fun pkg ->
369
+
let new_issues =
370
+
check_package ~index ~build_lib ~dune_pkgs ~own_set ~all_deps
371
+
~subtree pkg ~fs
372
+
in
373
+
issues := new_issues @ !issues)
357
374
pkgs
358
375
end)
359
376
subdirs;
360
-
361
-
{
362
-
issues =
363
-
List.sort
364
-
(fun a b ->
365
-
match String.compare a.subtree b.subtree with
366
-
| 0 ->
367
-
let ka = match a.kind with Missing -> 0 | Unused -> 1 in
368
-
let kb = match b.kind with Missing -> 0 | Unused -> 1 in
369
-
if ka <> kb then compare ka kb
370
-
else String.compare a.package b.package
371
-
| n -> n)
372
-
!issues;
373
-
packages_scanned = !scanned;
374
-
}
377
+
{ issues = sort_issues !issues; packages_scanned = !scanned }
+7
-7
lib/push.ml
+7
-7
lib/push.ml
···
59
59
Ctx.normalize_opam_url_string (Uri.to_string (Package.dev_repo pkg)))
60
60
| None -> Ctx.normalize_opam_url_string (Uri.to_string (Package.dev_repo pkg))
61
61
62
+
let needs_clone ~fs ~checkout_eio ~checkout_dir =
63
+
match Eio.Path.kind ~follow:true checkout_eio with
64
+
| exception Eio.Io _ -> true
65
+
| `Directory when Git.Repository.is_repo ~fs checkout_dir -> false
66
+
| _ -> true
67
+
62
68
let one ~proc ~fs ~config ~sources ~clean ~force pkg =
63
69
let ( let* ) r f =
64
70
Result.bind (Result.map_error (fun e -> Ctx.Git_error e) r) f
···
76
82
end
77
83
else begin
78
84
let checkout_eio = Eio.Path.(fs / Fpath.to_string checkout_dir) in
79
-
let needs_clone =
80
-
match Eio.Path.kind ~follow:true checkout_eio with
81
-
| exception Eio.Io _ -> true
82
-
| `Directory when Git.Repository.is_repo ~fs checkout_dir -> false
83
-
| _ -> true
84
-
in
85
85
let* () =
86
-
if needs_clone then begin
86
+
if needs_clone ~fs ~checkout_eio ~checkout_dir then begin
87
87
Log.info (fun m -> m "Creating checkout for %s" (Package.repo_name pkg));
88
88
Ctx.ensure_checkout ~proc
89
89
~fs:(fs :> _ Eio.Path.t)