···2828 issues;
2929 (groups, List.rev !order)
30303131-let group_kind kind issues =
3232- List.filter_map
3333- (fun (i : Monopam.Lint.issue) ->
3434- if i.kind = kind then Some i.package else None)
3535- issues
3636- |> List.sort_uniq String.compare
3737-3831let pp_table issues =
3932 let groups, order = group_by_subtree issues in
4033 let columns =
···4235 Tty.Table.column "Package";
4336 Tty.Table.column ~max_width:50 "Missing";
4437 Tty.Table.column ~max_width:50 "Unused";
4545- Tty.Table.column ~max_width:50 "Dead lib";
4638 ]
4739 in
4840 let rows =
4941 List.map
5042 (fun subtree ->
5143 let issues = List.rev (Hashtbl.find groups subtree) in
5252- let missing = group_kind Monopam.Lint.Missing issues in
5353- let unused = group_kind Monopam.Lint.Unused issues in
5454- let dead = group_kind Monopam.Lint.Dead_lib issues in
4444+ let missing =
4545+ List.filter_map
4646+ (fun (i : Monopam.Lint.issue) ->
4747+ match i.kind with Missing -> Some i.package | _ -> None)
4848+ issues
4949+ |> List.sort_uniq String.compare
5050+ in
5151+ let unused =
5252+ List.filter_map
5353+ (fun (i : Monopam.Lint.issue) ->
5454+ match i.kind with Unused -> Some i.package | _ -> None)
5555+ issues
5656+ |> List.sort_uniq String.compare
5757+ in
5558 [
5659 Tty.Span.text subtree;
5760 Tty.Span.styled
···6063 Tty.Span.styled
6164 Tty.Style.(fg (Tty.Color.ansi `Cyan))
6265 (String.concat " " unused);
6363- Tty.Span.styled
6464- Tty.Style.(fg (Tty.Color.ansi `Magenta))
6565- (String.concat " " dead);
6666 ])
6767 order
6868 in
···7474 List.iter
7575 (fun subtree ->
7676 let issues = List.rev (Hashtbl.find groups subtree) in
7777- let missing = group_kind Monopam.Lint.Missing issues in
7878- let unused = group_kind Monopam.Lint.Unused issues in
7979- let dead = group_kind Monopam.Lint.Dead_lib issues in
7777+ let missing =
7878+ List.filter_map
7979+ (fun (i : Monopam.Lint.issue) ->
8080+ match i.kind with Missing -> Some i.package | _ -> None)
8181+ issues
8282+ |> List.sort_uniq String.compare
8383+ in
8484+ let unused =
8585+ List.filter_map
8686+ (fun (i : Monopam.Lint.issue) ->
8787+ match i.kind with Unused -> Some i.package | _ -> None)
8888+ issues
8989+ |> List.sort_uniq String.compare
9090+ in
8091 if missing <> [] then
8192 Fmt.pr "%s missing: %s@." subtree (String.concat " " missing);
8293 if unused <> [] then
8383- Fmt.pr "%s unused: %s@." subtree (String.concat " " unused);
8484- if dead <> [] then
8585- Fmt.pr "%s dead lib: %s@." subtree (String.concat " " dead))
9494+ Fmt.pr "%s unused: %s@." subtree (String.concat " " unused))
8695 order
87968897let pp_source_issues source_issues =
···172181let summary_parts ~issues ~source_issues ~dune_warning_issues =
173182 let n_missing = count_kind Monopam.Lint.Missing issues in
174183 let n_unused = count_kind Monopam.Lint.Unused issues in
175175- let n_dead = count_kind Monopam.Lint.Dead_lib issues in
176184 let n_source = List.length source_issues in
177185 let n_warn = List.length dune_warning_issues in
178186 List.filter_map Fun.id
179187 [
180188 (if n_missing > 0 then Some (Fmt.str "%d missing" n_missing) else None);
181189 (if n_unused > 0 then Some (Fmt.str "%d unused" n_unused) else None);
182182- (if n_dead > 0 then Some (Fmt.str "%d dead-lib" n_dead) else None);
183190 (if n_source > 0 then Some (Fmt.str "%d source" n_source) else None);
184191 (if n_warn > 0 then Some (Fmt.str "%d dune-warnings" n_warn) else None);
185192 ]
+4-234
lib/lint.ml
···100100let index_meta ~opam_pkg ~prefix (f : Meta.Value.file) index =
101101 index_items ~opam_pkg ~prefix f.items index
102102103103-(** Index module names exposed by each library (and its sub-packages) by
104104- parsing each META's [archive] field. An archive named [foo.cma]
105105- exposes a top-level module [Foo]. The same library can have several
106106- archives across predicates; we collect them all. *)
107107-let module_name_of_archive s =
108108- let base = try Filename.chop_extension s with Invalid_argument _ -> s in
109109- if base = "" then None
110110- else
111111- let head = String.uppercase_ascii (String.sub base 0 1) in
112112- Some (head ^ String.sub base 1 (String.length base - 1))
113113-114114-let rec index_archive_items ~prefix items tbl =
115115- let archives = collect_field "archive" items in
116116- let modules = List.filter_map module_name_of_archive archives in
117117- let modules = List.sort_uniq String.compare modules in
118118- if modules <> [] then Hashtbl.replace tbl prefix modules;
119119- List.iter
120120- (function
121121- | Meta.Value.Subpackage sub ->
122122- index_archive_items
123123- ~prefix:(prefix ^ "." ^ sub.Meta.Value.name)
124124- sub.items tbl
125125- | _ -> ())
126126- items
127127-128103(* ---- Library index ---- *)
129104130105let load_file fs path =
···164139 scan_meta_dir opam_lib index;
165140 Log.debug (fun m -> m "Library index: %d entries" (Hashtbl.length index));
166141 index
167167-168168-(** Scan each lib directory's META and record the [archive]-derived module
169169- names per library prefix. *)
170170-let scan_archive_dir dir tbl =
171171- let entries = try Eio.Path.read_dir dir with Eio.Io _ -> [] in
172172- List.iter
173173- (fun pkg ->
174174- let meta = Eio.Path.(dir / pkg / "META") in
175175- try
176176- Eio.Path.with_open_in meta (fun flow ->
177177- let r = Bytesrw_eio.bytes_reader_of_flow flow in
178178- match Meta_bytesrw.of_reader r with
179179- | expr -> index_archive_items ~prefix:pkg expr.items tbl
180180- | exception Meta.Error _ -> ())
181181- with Eio.Io _ -> ())
182182- entries
183183-184184-let build_archive_modules ~fs ~monorepo =
185185- let tbl = Hashtbl.create 256 in
186186- let build_lib =
187187- Eio.Path.(
188188- fs
189189- / Fpath.to_string
190190- Fpath.(monorepo / "_build" / "install" / "default" / "lib"))
191191- in
192192- let opam_lib =
193193- Eio.Path.(fs / Fpath.to_string Fpath.(monorepo / "_opam" / "lib"))
194194- in
195195- scan_archive_dir build_lib tbl;
196196- scan_archive_dir opam_lib tbl;
197197- tbl
198142199143let lib_to_package index lib =
200144 match Hashtbl.find_opt index lib with
···474418 stanzas;
475419 fun pkg -> try Hashtbl.find tbl pkg with Not_found -> String_set.empty
476420477477-let normalise_to_module_alphabet s =
478478- let buf = Buffer.create (String.length s) in
479479- String.iter
480480- (fun c ->
481481- match c with
482482- | '-' | '.' -> Buffer.add_char buf '_'
483483- | _ -> Buffer.add_char buf c)
484484- s;
485485- Buffer.contents buf
486486-487487-let capitalize s =
488488- if s = "" then s
489489- else
490490- String.uppercase_ascii (String.sub s 0 1)
491491- ^ String.sub s 1 (String.length s - 1)
492492-493493-(** Build a [public_name -> internal name] map by scanning every
494494- [(library (name X) (public_name Y))] in the monorepo. Used to convert a
495495- [(libraries Y)] reference to its real OCaml module name. *)
496496-let build_public_to_internal ~fs ~monorepo subdirs =
497497- let tbl = Hashtbl.create 256 in
498498- List.iter
499499- (fun subtree ->
500500- let subtree_path = Fpath.(monorepo / subtree) in
501501- let dune_files = dune_files_in ~fs subtree_path in
502502- List.iter
503503- (fun df ->
504504- match load_file fs df with
505505- | None -> ()
506506- | Some content ->
507507- List.iter
508508- (function
509509- | Sexp.List (Sexp.Atom "library" :: fields) -> (
510510- match
511511- (field "name" fields, field "public_name" fields)
512512- with
513513- | Some (Sexp.Atom n :: _), Some (Sexp.Atom pn :: _) -> (
514514- Hashtbl.replace tbl pn n;
515515- match String.index_opt pn '.' with
516516- | Some i ->
517517- let head = String.sub pn 0 i in
518518- if not (Hashtbl.mem tbl head) then
519519- Hashtbl.replace tbl head n
520520- | None -> ())
521521- | _ -> ())
522522- | _ -> ())
523523- (parse_sexps content))
524524- dune_files)
525525- subdirs;
526526- tbl
527527-528528-(** Module names a [(libraries X)] entry might expose. *)
529529-let module_candidates ~public_to_internal ~archive_modules lib =
530530- let main = capitalize (normalise_to_module_alphabet lib) in
531531- let internal_candidate =
532532- match Hashtbl.find_opt public_to_internal lib with
533533- | Some n -> Some (capitalize (normalise_to_module_alphabet n))
534534- | None -> None
535535- in
536536- let last_segment =
537537- match String.rindex_opt lib '.' with
538538- | Some i ->
539539- let s = String.sub lib (i + 1) (String.length lib - i - 1) in
540540- Some (capitalize (normalise_to_module_alphabet s))
541541- | None -> None
542542- in
543543- let archive_candidates =
544544- Hashtbl.find_opt archive_modules lib |> Option.value ~default:[]
545545- in
546546- List.filter_map Fun.id [ Some main; internal_candidate; last_segment ]
547547- @ archive_candidates
548548- |> List.sort_uniq String.compare
549549-550550-let module_ref_re =
551551- Re.compile
552552- (Re.seq
553553- [
554554- Re.bow;
555555- Re.set "ABCDEFGHIJKLMNOPQRSTUVWXYZ";
556556- Re.rep
557557- (Re.set
558558- "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789'");
559559- ])
560560-561561-let module_refs_in_text text =
562562- Re.all module_ref_re text
563563- |> List.map (fun g -> Re.Group.get g 0)
564564- |> String_set.of_list
565565-566566-(** Concatenate every [.ml] / [.mli] in [dir] into one blob. *)
567567-let source_files_text ~fs dir =
568568- let eio_dir = Eio.Path.(fs / Fpath.to_string dir) in
569569- let entries = try Eio.Path.read_dir eio_dir with Eio.Io _ -> [] in
570570- List.fold_left
571571- (fun acc entry ->
572572- if Filename.check_suffix entry ".mli" || Filename.check_suffix entry ".ml"
573573- then
574574- match load_file fs Fpath.(dir / entry) with
575575- | Some s -> acc ^ "\n" ^ s
576576- | None -> acc
577577- else acc)
578578- "" entries
579579-580421(* ---- Types ---- *)
581422582582-type kind = Missing | Unused | Dead_lib
423423+type kind = Missing | Unused
583424type issue = { subtree : string; kind : kind; package : string }
584584-585585-(* ---- Dead-lib detection ----
586586-587587- A [(libraries X)] entry whose modules are never referenced from any
588588- [.ml] / [.mli] in the same directory is dead. Detected per-stanza
589589- using a regex scan for capitalised-prefix identifiers in the source
590590- files; module-name candidates are derived from the library name plus
591591- its dune [(name ...)] internal alias when one exists. *)
592592-593593-(** Libraries that exist only for link-time or setup side-effects: CLI
594594- output styling, OS-specific clocks, C stubs registered via the runtime,
595595- and similar. They are routinely declared in [(libraries ...)] without
596596- ever opening a module, so the textual Dead_lib check always flags them
597597- as false positives. *)
598598-let is_setup_only_sublib lib =
599599- match lib with
600600- | "fmt.tty" | "fmt.cli" | "fmt.top" | "logs.cli" | "logs.fmt"
601601- | "logs.threaded" | "eio.runtime_events" | "eio.unix" | "eio_main"
602602- | "ptime.clock.os" | "ptime.clock.jsoo" | "wire.stubs" | "wire.3d"
603603- | "dune-build-info" | "dune-configurator" | "nox-crypto.ocaml" ->
604604- true
605605- | _ -> false
606606-607607-let dead_libs_in_subtree ~fs ~public_to_internal ~archive_modules ~subtree
608608- subtree_path =
609609- let dune_files = dune_files_in ~fs subtree_path in
610610- List.concat_map
611611- (fun df ->
612612- let dir = Fpath.parent df in
613613- match load_file fs df with
614614- | None -> []
615615- | Some content ->
616616- let stanzas = parse_sexps content in
617617- let refs = module_refs_in_text (source_files_text ~fs dir) in
618618- List.concat_map
619619- (function
620620- | Sexp.List (Sexp.Atom kind :: fields)
621621- when List.mem kind [ "library"; "executable"; "executables" ] ->
622622- let libs = libs_of_fields fields in
623623- List.filter_map
624624- (fun lib ->
625625- if is_builtin lib || is_setup_only_sublib lib then None
626626- else
627627- let candidates =
628628- module_candidates ~public_to_internal
629629- ~archive_modules lib
630630- in
631631- if
632632- List.exists
633633- (fun c -> String_set.mem c refs)
634634- candidates
635635- then None
636636- else
637637- (* Report the exact dune library entry, not the
638638- collapsed opam package — a Dead_lib report on
639639- [fmt.tty] is actionable; one on [fmt] looks
640640- wrong when [fmt] is alive in a sibling dir. *)
641641- Some { subtree; kind = Dead_lib; package = lib })
642642- libs
643643- | _ -> [])
644644- stanzas)
645645- dune_files
646425647426type source_issue = {
648427 subtree : string;
···867646 (fun (a : issue) (b : issue) ->
868647 match String.compare a.subtree b.subtree with
869648 | 0 ->
870870- let rank = function Missing -> 0 | Unused -> 1 | Dead_lib -> 2 in
871871- let ka = rank a.kind in
872872- let kb = rank b.kind in
649649+ let ka = match a.kind with Missing -> 0 | Unused -> 1 in
650650+ let kb = match b.kind with Missing -> 0 | Unused -> 1 in
873651 if ka <> kb then compare ka kb else String.compare a.package b.package
874652 | n -> n)
875653 issues
···907685 let build_lib = Fpath.(monorepo / "_build" / "install" / "default" / "lib") in
908686 let subdirs = list_subdirs ~fs ~monorepo in
909687 let sources = load_sources ~fs ~monorepo in
910910- let public_to_internal = build_public_to_internal ~fs ~monorepo subdirs in
911911- let archive_modules = build_archive_modules ~fs ~monorepo in
912688 let source_issues =
913689 compute_source_issues ~fs ~monorepo ~sources subdirs |> sort_source_issues
914690 in
···950726 ~own_set ~all_deps ~subtree pkg ~fs
951727 in
952728 issues := new_issues @ !issues)
953953- pkgs;
954954- let dead =
955955- dead_libs_in_subtree ~fs ~public_to_internal ~archive_modules
956956- ~subtree
957957- subtree_path
958958- in
959959- issues := dead @ !issues
729729+ pkgs
960730 end)
961731 subdirs;
962732 let root_diffs = Root.check ~fs ~monorepo () in
+1-7
lib/lint.mli
···1313 [(env (dev (flags :standard %{dune-warnings})))], so the warning set is
1414 uniform across the monorepo. *)
15151616-(** The kind of dependency issue. *)
1717-type kind =
1818- | Missing (** Library is referenced from a dune stanza but not in opam. *)
1919- | Unused (** Package is in opam runtime depends but no dune file uses it. *)
2020- | Dead_lib
2121- (** Library is in a stanza's [(libraries ...)] but no [.ml] / [.mli] in
2222- that stanza's directory references its modules. *)
1616+type kind = Missing | Unused (** The kind of dependency issue. *)
23172418type issue = {
2519 subtree : string; (** Monorepo subdirectory *)
+18-80
test/test_lint.ml
···7878 in
7979 build_subtrees ~mkdir ~write;
8080 let result =
8181- Monopam.Lint.run ~fs:(Eio.Stdenv.fs env) ~monorepo:(Fpath.v root) ()
8181+ Monopam.Lint.run
8282+ ~fs:(Eio.Stdenv.fs env)
8383+ ~monorepo:(Fpath.v root) ()
8284 in
8385 f result)
8486···8688 i.subtree = subtree && i.kind = Monopam.Lint.Missing && i.package = package
87898890(** A subtree whose only opam package is [test-pkg]. The library proper has no
8989- extra deps, but a sibling private [(executable)] in [gen/] uses [re]. Since
9090- [re] is not in [test-pkg.opam], the lint should flag it. *)
9191+ extra deps, but a sibling private [(executable)] in [gen/] uses [re].
9292+ Since [re] is not in [test-pkg.opam], the lint should flag it. *)
9193let test_missing_dep_via_private_executable () =
9294 with_temp_monorepo
9395 (fun ~mkdir ~write ->
···98100 "opam-version: \"2.0\"\ndepends: [ \"dune\" {>= \"3.21\"} ]\n";
99101 write "test-pkg/lib/dune"
100102 "(library\n (name test_pkg)\n (public_name test-pkg))\n";
101101- write "test-pkg/gen/dune" "(executable\n (name gen)\n (libraries re))\n")
103103+ write "test-pkg/gen/dune"
104104+ "(executable\n (name gen)\n (libraries re))\n")
102105 (fun (result : Monopam.Lint.result) ->
103106 Alcotest.(check bool)
104107 "private executable's library deps are attributed to the subtree's \
105108 single opam package"
106109 true
107107- (List.exists
108108- (issue_for ~subtree:"test-pkg" ~package:"re")
110110+ (List.exists (issue_for ~subtree:"test-pkg" ~package:"re")
109111 result.issues))
110112111111-(** A private executable in [fuzz/] still references a library, and that library
112112- still needs to be declared somewhere in opam (with-test, build, or runtime).
113113- The lint must flag it like any other missing dep. *)
113113+(** A private executable in [fuzz/] still references a library, and that
114114+ library still needs to be declared somewhere in opam (with-test, build,
115115+ or runtime). The lint must flag it like any other missing dep. *)
114116let test_missing_dep_via_fuzz_executable () =
115117 with_temp_monorepo
116118 (fun ~mkdir ~write ->
···125127 "(executable\n (name fuzz)\n (libraries alcobar))\n")
126128 (fun (result : Monopam.Lint.result) ->
127129 Alcotest.(check bool)
128128- "fuzz exec's libs are flagged when missing from opam" true
129129- (List.exists
130130- (issue_for ~subtree:"test-pkg" ~package:"alcobar")
131131- result.issues))
132132-133133-(** When a stanza's [(libraries ...)] list contains a library that no [.ml] /
134134- [.mli] in the same directory ever opens or references, the lint should flag
135135- the entry as a dead lib. This is the [hermest]-in-irmin case: declared in
136136- dune, never used in source, slipped past every check. *)
137137-let test_dead_lib_in_dune_libraries () =
138138- with_temp_monorepo
139139- (fun ~mkdir ~write ->
140140- mkdir "test-pkg";
141141- mkdir "test-pkg/lib";
142142- write "test-pkg/test-pkg.opam"
143143- "opam-version: \"2.0\"\n\
144144- depends: [\n\
145145- \ \"dune\" {>= \"3.21\"}\n\
146146- \ \"hermest\"\n\
147147- ]\n";
148148- write "test-pkg/lib/dune"
149149- "(library\n\
150150- \ (name test_pkg)\n\
151151- \ (public_name test-pkg)\n\
152152- \ (libraries hermest))\n";
153153- write "test-pkg/lib/test_pkg.ml" "let v = 1\n")
154154- (fun (result : Monopam.Lint.result) ->
155155- Alcotest.(check bool)
156156- "library declared in dune but never referenced in source is flagged as \
157157- dead"
130130+ "fuzz exec's libs are flagged when missing from opam"
158131 true
159159- (List.exists
160160- (fun (i : Monopam.Lint.issue) ->
161161- i.subtree = "test-pkg"
162162- && i.kind = Monopam.Lint.Dead_lib
163163- && i.package = "hermest")
132132+ (List.exists (issue_for ~subtree:"test-pkg" ~package:"alcobar")
164133 result.issues))
165134166166-(** Mirror case: when a library is declared AND actually referenced in source,
167167- the lint must NOT flag it. *)
168168-let test_live_lib_not_flagged_as_dead () =
169169- with_temp_monorepo
170170- (fun ~mkdir ~write ->
171171- mkdir "test-pkg";
172172- mkdir "test-pkg/lib";
173173- write "test-pkg/test-pkg.opam"
174174- "opam-version: \"2.0\"\n\
175175- depends: [\n\
176176- \ \"dune\" {>= \"3.21\"}\n\
177177- \ \"hermest\"\n\
178178- ]\n";
179179- write "test-pkg/lib/dune"
180180- "(library\n\
181181- \ (name test_pkg)\n\
182182- \ (public_name test-pkg)\n\
183183- \ (libraries hermest))\n";
184184- write "test-pkg/lib/test_pkg.ml" "let v = Hermest.foo ()\n")
185185- (fun (result : Monopam.Lint.result) ->
186186- Alcotest.(check bool)
187187- "library referenced in source is not flagged as dead" false
188188- (List.exists
189189- (fun (i : Monopam.Lint.issue) ->
190190- i.kind = Monopam.Lint.Dead_lib && i.package = "hermest")
191191- result.issues))
192192-193193-(** When a library referenced from any private stanza IS declared in opam (even
194194- as [{with-test}]), the lint must NOT flag it. *)
135135+(** When a library referenced from any private stanza IS declared in opam
136136+ (even as [{with-test}]), the lint must NOT flag it. *)
195137let test_with_test_dep_not_flagged () =
196138 with_temp_monorepo
197139 (fun ~mkdir ~write ->
···210152 "(executable\n (name fuzz)\n (libraries alcobar))\n")
211153 (fun (result : Monopam.Lint.result) ->
212154 Alcotest.(check bool)
213213- "with-test dep declared in opam is not flagged as missing" false
214214- (List.exists
215215- (issue_for ~subtree:"test-pkg" ~package:"alcobar")
155155+ "with-test dep declared in opam is not flagged as missing"
156156+ false
157157+ (List.exists (issue_for ~subtree:"test-pkg" ~package:"alcobar")
216158 result.issues))
217159218160let suite =
···229171 test_missing_dep_via_fuzz_executable;
230172 Alcotest.test_case "with-test dep not flagged" `Quick
231173 test_with_test_dep_not_flagged;
232232- Alcotest.test_case "dead lib in dune libraries" `Quick
233233- test_dead_lib_in_dune_libraries;
234234- Alcotest.test_case "live lib not flagged as dead" `Quick
235235- test_live_lib_not_flagged_as_dead;
236174 ] )