Monorepo management for opam overlays
0
fork

Configure Feed

Select the types of activity you want to include in your feed.

Revert "monopam: detect Dead_lib — libraries declared in dune but unused in source"

This reverts commit c26b6fe8c3e656c757822e0387fe6e1c45f74a5c.

+52 -343
+29 -22
bin/cmd_lint.ml
··· 28 28 issues; 29 29 (groups, List.rev !order) 30 30 31 - let group_kind kind issues = 32 - List.filter_map 33 - (fun (i : Monopam.Lint.issue) -> 34 - if i.kind = kind then Some i.package else None) 35 - issues 36 - |> List.sort_uniq String.compare 37 - 38 31 let pp_table issues = 39 32 let groups, order = group_by_subtree issues in 40 33 let columns = ··· 42 35 Tty.Table.column "Package"; 43 36 Tty.Table.column ~max_width:50 "Missing"; 44 37 Tty.Table.column ~max_width:50 "Unused"; 45 - Tty.Table.column ~max_width:50 "Dead lib"; 46 38 ] 47 39 in 48 40 let rows = 49 41 List.map 50 42 (fun subtree -> 51 43 let issues = List.rev (Hashtbl.find groups subtree) in 52 - let missing = group_kind Monopam.Lint.Missing issues in 53 - let unused = group_kind Monopam.Lint.Unused issues in 54 - let dead = group_kind Monopam.Lint.Dead_lib issues in 44 + let missing = 45 + List.filter_map 46 + (fun (i : Monopam.Lint.issue) -> 47 + match i.kind with Missing -> Some i.package | _ -> None) 48 + issues 49 + |> List.sort_uniq String.compare 50 + in 51 + let unused = 52 + List.filter_map 53 + (fun (i : Monopam.Lint.issue) -> 54 + match i.kind with Unused -> Some i.package | _ -> None) 55 + issues 56 + |> List.sort_uniq String.compare 57 + in 55 58 [ 56 59 Tty.Span.text subtree; 57 60 Tty.Span.styled ··· 60 63 Tty.Span.styled 61 64 Tty.Style.(fg (Tty.Color.ansi `Cyan)) 62 65 (String.concat " " unused); 63 - Tty.Span.styled 64 - Tty.Style.(fg (Tty.Color.ansi `Magenta)) 65 - (String.concat " " dead); 66 66 ]) 67 67 order 68 68 in ··· 74 74 List.iter 75 75 (fun subtree -> 76 76 let issues = List.rev (Hashtbl.find groups subtree) in 77 - let missing = group_kind Monopam.Lint.Missing issues in 78 - let unused = group_kind Monopam.Lint.Unused issues in 79 - let dead = group_kind Monopam.Lint.Dead_lib issues in 77 + let missing = 78 + List.filter_map 79 + (fun (i : Monopam.Lint.issue) -> 80 + match i.kind with Missing -> Some i.package | _ -> None) 81 + issues 82 + |> List.sort_uniq String.compare 83 + in 84 + let unused = 85 + List.filter_map 86 + (fun (i : Monopam.Lint.issue) -> 87 + match i.kind with Unused -> Some i.package | _ -> None) 88 + issues 89 + |> List.sort_uniq String.compare 90 + in 80 91 if missing <> [] then 81 92 Fmt.pr "%s missing: %s@." subtree (String.concat " " missing); 82 93 if unused <> [] then 83 - Fmt.pr "%s unused: %s@." subtree (String.concat " " unused); 84 - if dead <> [] then 85 - Fmt.pr "%s dead lib: %s@." subtree (String.concat " " dead)) 94 + Fmt.pr "%s unused: %s@." subtree (String.concat " " unused)) 86 95 order 87 96 88 97 let pp_source_issues source_issues = ··· 172 181 let summary_parts ~issues ~source_issues ~dune_warning_issues = 173 182 let n_missing = count_kind Monopam.Lint.Missing issues in 174 183 let n_unused = count_kind Monopam.Lint.Unused issues in 175 - let n_dead = count_kind Monopam.Lint.Dead_lib issues in 176 184 let n_source = List.length source_issues in 177 185 let n_warn = List.length dune_warning_issues in 178 186 List.filter_map Fun.id 179 187 [ 180 188 (if n_missing > 0 then Some (Fmt.str "%d missing" n_missing) else None); 181 189 (if n_unused > 0 then Some (Fmt.str "%d unused" n_unused) else None); 182 - (if n_dead > 0 then Some (Fmt.str "%d dead-lib" n_dead) else None); 183 190 (if n_source > 0 then Some (Fmt.str "%d source" n_source) else None); 184 191 (if n_warn > 0 then Some (Fmt.str "%d dune-warnings" n_warn) else None); 185 192 ]
+4 -234
lib/lint.ml
··· 100 100 let index_meta ~opam_pkg ~prefix (f : Meta.Value.file) index = 101 101 index_items ~opam_pkg ~prefix f.items index 102 102 103 - (** Index module names exposed by each library (and its sub-packages) by 104 - parsing each META's [archive] field. An archive named [foo.cma] 105 - exposes a top-level module [Foo]. The same library can have several 106 - archives across predicates; we collect them all. *) 107 - let module_name_of_archive s = 108 - let base = try Filename.chop_extension s with Invalid_argument _ -> s in 109 - if base = "" then None 110 - else 111 - let head = String.uppercase_ascii (String.sub base 0 1) in 112 - Some (head ^ String.sub base 1 (String.length base - 1)) 113 - 114 - let rec index_archive_items ~prefix items tbl = 115 - let archives = collect_field "archive" items in 116 - let modules = List.filter_map module_name_of_archive archives in 117 - let modules = List.sort_uniq String.compare modules in 118 - if modules <> [] then Hashtbl.replace tbl prefix modules; 119 - List.iter 120 - (function 121 - | Meta.Value.Subpackage sub -> 122 - index_archive_items 123 - ~prefix:(prefix ^ "." ^ sub.Meta.Value.name) 124 - sub.items tbl 125 - | _ -> ()) 126 - items 127 - 128 103 (* ---- Library index ---- *) 129 104 130 105 let load_file fs path = ··· 164 139 scan_meta_dir opam_lib index; 165 140 Log.debug (fun m -> m "Library index: %d entries" (Hashtbl.length index)); 166 141 index 167 - 168 - (** Scan each lib directory's META and record the [archive]-derived module 169 - names per library prefix. *) 170 - let scan_archive_dir dir tbl = 171 - let entries = try Eio.Path.read_dir dir with Eio.Io _ -> [] in 172 - List.iter 173 - (fun pkg -> 174 - let meta = Eio.Path.(dir / pkg / "META") in 175 - try 176 - Eio.Path.with_open_in meta (fun flow -> 177 - let r = Bytesrw_eio.bytes_reader_of_flow flow in 178 - match Meta_bytesrw.of_reader r with 179 - | expr -> index_archive_items ~prefix:pkg expr.items tbl 180 - | exception Meta.Error _ -> ()) 181 - with Eio.Io _ -> ()) 182 - entries 183 - 184 - let build_archive_modules ~fs ~monorepo = 185 - let tbl = Hashtbl.create 256 in 186 - let build_lib = 187 - Eio.Path.( 188 - fs 189 - / Fpath.to_string 190 - Fpath.(monorepo / "_build" / "install" / "default" / "lib")) 191 - in 192 - let opam_lib = 193 - Eio.Path.(fs / Fpath.to_string Fpath.(monorepo / "_opam" / "lib")) 194 - in 195 - scan_archive_dir build_lib tbl; 196 - scan_archive_dir opam_lib tbl; 197 - tbl 198 142 199 143 let lib_to_package index lib = 200 144 match Hashtbl.find_opt index lib with ··· 474 418 stanzas; 475 419 fun pkg -> try Hashtbl.find tbl pkg with Not_found -> String_set.empty 476 420 477 - let normalise_to_module_alphabet s = 478 - let buf = Buffer.create (String.length s) in 479 - String.iter 480 - (fun c -> 481 - match c with 482 - | '-' | '.' -> Buffer.add_char buf '_' 483 - | _ -> Buffer.add_char buf c) 484 - s; 485 - Buffer.contents buf 486 - 487 - let capitalize s = 488 - if s = "" then s 489 - else 490 - String.uppercase_ascii (String.sub s 0 1) 491 - ^ String.sub s 1 (String.length s - 1) 492 - 493 - (** Build a [public_name -> internal name] map by scanning every 494 - [(library (name X) (public_name Y))] in the monorepo. Used to convert a 495 - [(libraries Y)] reference to its real OCaml module name. *) 496 - let build_public_to_internal ~fs ~monorepo subdirs = 497 - let tbl = Hashtbl.create 256 in 498 - List.iter 499 - (fun subtree -> 500 - let subtree_path = Fpath.(monorepo / subtree) in 501 - let dune_files = dune_files_in ~fs subtree_path in 502 - List.iter 503 - (fun df -> 504 - match load_file fs df with 505 - | None -> () 506 - | Some content -> 507 - List.iter 508 - (function 509 - | Sexp.List (Sexp.Atom "library" :: fields) -> ( 510 - match 511 - (field "name" fields, field "public_name" fields) 512 - with 513 - | Some (Sexp.Atom n :: _), Some (Sexp.Atom pn :: _) -> ( 514 - Hashtbl.replace tbl pn n; 515 - match String.index_opt pn '.' with 516 - | Some i -> 517 - let head = String.sub pn 0 i in 518 - if not (Hashtbl.mem tbl head) then 519 - Hashtbl.replace tbl head n 520 - | None -> ()) 521 - | _ -> ()) 522 - | _ -> ()) 523 - (parse_sexps content)) 524 - dune_files) 525 - subdirs; 526 - tbl 527 - 528 - (** Module names a [(libraries X)] entry might expose. *) 529 - let module_candidates ~public_to_internal ~archive_modules lib = 530 - let main = capitalize (normalise_to_module_alphabet lib) in 531 - let internal_candidate = 532 - match Hashtbl.find_opt public_to_internal lib with 533 - | Some n -> Some (capitalize (normalise_to_module_alphabet n)) 534 - | None -> None 535 - in 536 - let last_segment = 537 - match String.rindex_opt lib '.' with 538 - | Some i -> 539 - let s = String.sub lib (i + 1) (String.length lib - i - 1) in 540 - Some (capitalize (normalise_to_module_alphabet s)) 541 - | None -> None 542 - in 543 - let archive_candidates = 544 - Hashtbl.find_opt archive_modules lib |> Option.value ~default:[] 545 - in 546 - List.filter_map Fun.id [ Some main; internal_candidate; last_segment ] 547 - @ archive_candidates 548 - |> List.sort_uniq String.compare 549 - 550 - let module_ref_re = 551 - Re.compile 552 - (Re.seq 553 - [ 554 - Re.bow; 555 - Re.set "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; 556 - Re.rep 557 - (Re.set 558 - "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789'"); 559 - ]) 560 - 561 - let module_refs_in_text text = 562 - Re.all module_ref_re text 563 - |> List.map (fun g -> Re.Group.get g 0) 564 - |> String_set.of_list 565 - 566 - (** Concatenate every [.ml] / [.mli] in [dir] into one blob. *) 567 - let source_files_text ~fs dir = 568 - let eio_dir = Eio.Path.(fs / Fpath.to_string dir) in 569 - let entries = try Eio.Path.read_dir eio_dir with Eio.Io _ -> [] in 570 - List.fold_left 571 - (fun acc entry -> 572 - if Filename.check_suffix entry ".mli" || Filename.check_suffix entry ".ml" 573 - then 574 - match load_file fs Fpath.(dir / entry) with 575 - | Some s -> acc ^ "\n" ^ s 576 - | None -> acc 577 - else acc) 578 - "" entries 579 - 580 421 (* ---- Types ---- *) 581 422 582 - type kind = Missing | Unused | Dead_lib 423 + type kind = Missing | Unused 583 424 type issue = { subtree : string; kind : kind; package : string } 584 - 585 - (* ---- Dead-lib detection ---- 586 - 587 - A [(libraries X)] entry whose modules are never referenced from any 588 - [.ml] / [.mli] in the same directory is dead. Detected per-stanza 589 - using a regex scan for capitalised-prefix identifiers in the source 590 - files; module-name candidates are derived from the library name plus 591 - its dune [(name ...)] internal alias when one exists. *) 592 - 593 - (** Libraries that exist only for link-time or setup side-effects: CLI 594 - output styling, OS-specific clocks, C stubs registered via the runtime, 595 - and similar. They are routinely declared in [(libraries ...)] without 596 - ever opening a module, so the textual Dead_lib check always flags them 597 - as false positives. *) 598 - let is_setup_only_sublib lib = 599 - match lib with 600 - | "fmt.tty" | "fmt.cli" | "fmt.top" | "logs.cli" | "logs.fmt" 601 - | "logs.threaded" | "eio.runtime_events" | "eio.unix" | "eio_main" 602 - | "ptime.clock.os" | "ptime.clock.jsoo" | "wire.stubs" | "wire.3d" 603 - | "dune-build-info" | "dune-configurator" | "nox-crypto.ocaml" -> 604 - true 605 - | _ -> false 606 - 607 - let dead_libs_in_subtree ~fs ~public_to_internal ~archive_modules ~subtree 608 - subtree_path = 609 - let dune_files = dune_files_in ~fs subtree_path in 610 - List.concat_map 611 - (fun df -> 612 - let dir = Fpath.parent df in 613 - match load_file fs df with 614 - | None -> [] 615 - | Some content -> 616 - let stanzas = parse_sexps content in 617 - let refs = module_refs_in_text (source_files_text ~fs dir) in 618 - List.concat_map 619 - (function 620 - | Sexp.List (Sexp.Atom kind :: fields) 621 - when List.mem kind [ "library"; "executable"; "executables" ] -> 622 - let libs = libs_of_fields fields in 623 - List.filter_map 624 - (fun lib -> 625 - if is_builtin lib || is_setup_only_sublib lib then None 626 - else 627 - let candidates = 628 - module_candidates ~public_to_internal 629 - ~archive_modules lib 630 - in 631 - if 632 - List.exists 633 - (fun c -> String_set.mem c refs) 634 - candidates 635 - then None 636 - else 637 - (* Report the exact dune library entry, not the 638 - collapsed opam package — a Dead_lib report on 639 - [fmt.tty] is actionable; one on [fmt] looks 640 - wrong when [fmt] is alive in a sibling dir. *) 641 - Some { subtree; kind = Dead_lib; package = lib }) 642 - libs 643 - | _ -> []) 644 - stanzas) 645 - dune_files 646 425 647 426 type source_issue = { 648 427 subtree : string; ··· 867 646 (fun (a : issue) (b : issue) -> 868 647 match String.compare a.subtree b.subtree with 869 648 | 0 -> 870 - let rank = function Missing -> 0 | Unused -> 1 | Dead_lib -> 2 in 871 - let ka = rank a.kind in 872 - let kb = rank b.kind in 649 + let ka = match a.kind with Missing -> 0 | Unused -> 1 in 650 + let kb = match b.kind with Missing -> 0 | Unused -> 1 in 873 651 if ka <> kb then compare ka kb else String.compare a.package b.package 874 652 | n -> n) 875 653 issues ··· 907 685 let build_lib = Fpath.(monorepo / "_build" / "install" / "default" / "lib") in 908 686 let subdirs = list_subdirs ~fs ~monorepo in 909 687 let sources = load_sources ~fs ~monorepo in 910 - let public_to_internal = build_public_to_internal ~fs ~monorepo subdirs in 911 - let archive_modules = build_archive_modules ~fs ~monorepo in 912 688 let source_issues = 913 689 compute_source_issues ~fs ~monorepo ~sources subdirs |> sort_source_issues 914 690 in ··· 950 726 ~own_set ~all_deps ~subtree pkg ~fs 951 727 in 952 728 issues := new_issues @ !issues) 953 - pkgs; 954 - let dead = 955 - dead_libs_in_subtree ~fs ~public_to_internal ~archive_modules 956 - ~subtree 957 - subtree_path 958 - in 959 - issues := dead @ !issues 729 + pkgs 960 730 end) 961 731 subdirs; 962 732 let root_diffs = Root.check ~fs ~monorepo () in
+1 -7
lib/lint.mli
··· 13 13 [(env (dev (flags :standard %{dune-warnings})))], so the warning set is 14 14 uniform across the monorepo. *) 15 15 16 - (** The kind of dependency issue. *) 17 - type kind = 18 - | Missing (** Library is referenced from a dune stanza but not in opam. *) 19 - | Unused (** Package is in opam runtime depends but no dune file uses it. *) 20 - | Dead_lib 21 - (** Library is in a stanza's [(libraries ...)] but no [.ml] / [.mli] in 22 - that stanza's directory references its modules. *) 16 + type kind = Missing | Unused (** The kind of dependency issue. *) 23 17 24 18 type issue = { 25 19 subtree : string; (** Monorepo subdirectory *)
+18 -80
test/test_lint.ml
··· 78 78 in 79 79 build_subtrees ~mkdir ~write; 80 80 let result = 81 - Monopam.Lint.run ~fs:(Eio.Stdenv.fs env) ~monorepo:(Fpath.v root) () 81 + Monopam.Lint.run 82 + ~fs:(Eio.Stdenv.fs env) 83 + ~monorepo:(Fpath.v root) () 82 84 in 83 85 f result) 84 86 ··· 86 88 i.subtree = subtree && i.kind = Monopam.Lint.Missing && i.package = package 87 89 88 90 (** A subtree whose only opam package is [test-pkg]. The library proper has no 89 - extra deps, but a sibling private [(executable)] in [gen/] uses [re]. Since 90 - [re] is not in [test-pkg.opam], the lint should flag it. *) 91 + extra deps, but a sibling private [(executable)] in [gen/] uses [re]. 92 + Since [re] is not in [test-pkg.opam], the lint should flag it. *) 91 93 let test_missing_dep_via_private_executable () = 92 94 with_temp_monorepo 93 95 (fun ~mkdir ~write -> ··· 98 100 "opam-version: \"2.0\"\ndepends: [ \"dune\" {>= \"3.21\"} ]\n"; 99 101 write "test-pkg/lib/dune" 100 102 "(library\n (name test_pkg)\n (public_name test-pkg))\n"; 101 - write "test-pkg/gen/dune" "(executable\n (name gen)\n (libraries re))\n") 103 + write "test-pkg/gen/dune" 104 + "(executable\n (name gen)\n (libraries re))\n") 102 105 (fun (result : Monopam.Lint.result) -> 103 106 Alcotest.(check bool) 104 107 "private executable's library deps are attributed to the subtree's \ 105 108 single opam package" 106 109 true 107 - (List.exists 108 - (issue_for ~subtree:"test-pkg" ~package:"re") 110 + (List.exists (issue_for ~subtree:"test-pkg" ~package:"re") 109 111 result.issues)) 110 112 111 - (** A private executable in [fuzz/] still references a library, and that library 112 - still needs to be declared somewhere in opam (with-test, build, or runtime). 113 - The lint must flag it like any other missing dep. *) 113 + (** A private executable in [fuzz/] still references a library, and that 114 + library still needs to be declared somewhere in opam (with-test, build, 115 + or runtime). The lint must flag it like any other missing dep. *) 114 116 let test_missing_dep_via_fuzz_executable () = 115 117 with_temp_monorepo 116 118 (fun ~mkdir ~write -> ··· 125 127 "(executable\n (name fuzz)\n (libraries alcobar))\n") 126 128 (fun (result : Monopam.Lint.result) -> 127 129 Alcotest.(check bool) 128 - "fuzz exec's libs are flagged when missing from opam" true 129 - (List.exists 130 - (issue_for ~subtree:"test-pkg" ~package:"alcobar") 131 - result.issues)) 132 - 133 - (** When a stanza's [(libraries ...)] list contains a library that no [.ml] / 134 - [.mli] in the same directory ever opens or references, the lint should flag 135 - the entry as a dead lib. This is the [hermest]-in-irmin case: declared in 136 - dune, never used in source, slipped past every check. *) 137 - let test_dead_lib_in_dune_libraries () = 138 - with_temp_monorepo 139 - (fun ~mkdir ~write -> 140 - mkdir "test-pkg"; 141 - mkdir "test-pkg/lib"; 142 - write "test-pkg/test-pkg.opam" 143 - "opam-version: \"2.0\"\n\ 144 - depends: [\n\ 145 - \ \"dune\" {>= \"3.21\"}\n\ 146 - \ \"hermest\"\n\ 147 - ]\n"; 148 - write "test-pkg/lib/dune" 149 - "(library\n\ 150 - \ (name test_pkg)\n\ 151 - \ (public_name test-pkg)\n\ 152 - \ (libraries hermest))\n"; 153 - write "test-pkg/lib/test_pkg.ml" "let v = 1\n") 154 - (fun (result : Monopam.Lint.result) -> 155 - Alcotest.(check bool) 156 - "library declared in dune but never referenced in source is flagged as \ 157 - dead" 130 + "fuzz exec's libs are flagged when missing from opam" 158 131 true 159 - (List.exists 160 - (fun (i : Monopam.Lint.issue) -> 161 - i.subtree = "test-pkg" 162 - && i.kind = Monopam.Lint.Dead_lib 163 - && i.package = "hermest") 132 + (List.exists (issue_for ~subtree:"test-pkg" ~package:"alcobar") 164 133 result.issues)) 165 134 166 - (** Mirror case: when a library is declared AND actually referenced in source, 167 - the lint must NOT flag it. *) 168 - let test_live_lib_not_flagged_as_dead () = 169 - with_temp_monorepo 170 - (fun ~mkdir ~write -> 171 - mkdir "test-pkg"; 172 - mkdir "test-pkg/lib"; 173 - write "test-pkg/test-pkg.opam" 174 - "opam-version: \"2.0\"\n\ 175 - depends: [\n\ 176 - \ \"dune\" {>= \"3.21\"}\n\ 177 - \ \"hermest\"\n\ 178 - ]\n"; 179 - write "test-pkg/lib/dune" 180 - "(library\n\ 181 - \ (name test_pkg)\n\ 182 - \ (public_name test-pkg)\n\ 183 - \ (libraries hermest))\n"; 184 - write "test-pkg/lib/test_pkg.ml" "let v = Hermest.foo ()\n") 185 - (fun (result : Monopam.Lint.result) -> 186 - Alcotest.(check bool) 187 - "library referenced in source is not flagged as dead" false 188 - (List.exists 189 - (fun (i : Monopam.Lint.issue) -> 190 - i.kind = Monopam.Lint.Dead_lib && i.package = "hermest") 191 - result.issues)) 192 - 193 - (** When a library referenced from any private stanza IS declared in opam (even 194 - as [{with-test}]), the lint must NOT flag it. *) 135 + (** When a library referenced from any private stanza IS declared in opam 136 + (even as [{with-test}]), the lint must NOT flag it. *) 195 137 let test_with_test_dep_not_flagged () = 196 138 with_temp_monorepo 197 139 (fun ~mkdir ~write -> ··· 210 152 "(executable\n (name fuzz)\n (libraries alcobar))\n") 211 153 (fun (result : Monopam.Lint.result) -> 212 154 Alcotest.(check bool) 213 - "with-test dep declared in opam is not flagged as missing" false 214 - (List.exists 215 - (issue_for ~subtree:"test-pkg" ~package:"alcobar") 155 + "with-test dep declared in opam is not flagged as missing" 156 + false 157 + (List.exists (issue_for ~subtree:"test-pkg" ~package:"alcobar") 216 158 result.issues)) 217 159 218 160 let suite = ··· 229 171 test_missing_dep_via_fuzz_executable; 230 172 Alcotest.test_case "with-test dep not flagged" `Quick 231 173 test_with_test_dep_not_flagged; 232 - Alcotest.test_case "dead lib in dune libraries" `Quick 233 - test_dead_lib_in_dune_libraries; 234 - Alcotest.test_case "live lib not flagged as dead" `Quick 235 - test_live_lib_not_flagged_as_dead; 236 174 ] )