Monorepo management for opam overlays
feat(monopam): add lint command to check package dependencies
Compare META requires against opam depends to find missing deps.
Uses Fl_metascanner to parse installed META files and opam-file-format
for opam depends. Also switches dune_project.ml from sexplib0+parsexp
to sexpt, and adds backslash-newline continuation preprocessing.
+423
-15
+76
bin/cmd_lint.ml
+76
bin/cmd_lint.ml
···
1
+
open Cmdliner
2
+
3
+
let man =
4
+
[
5
+
`S Manpage.s_description;
6
+
`P
7
+
"Checks that every library used in $(b,(libraries ...)) stanzas has its \
8
+
providing opam package declared in the subtree's $(b,(depends ...)) \
9
+
stanza.";
10
+
`S "HOW IT WORKS";
11
+
`P
12
+
"$(b,monopam lint) scans all subtrees in the monorepo and builds a map \
13
+
from library public names to their opam packages. It then checks each \
14
+
subtree's dune files for library usage and reports any packages missing \
15
+
from $(b,depends).";
16
+
`S "EXAMPLES";
17
+
`Pre "monopam lint";
18
+
`Pre "monopam lint ca-certs kdf";
19
+
]
20
+
21
+
let run filter () =
22
+
Eio_main.run @@ fun env ->
23
+
Common.with_config env @@ fun config ->
24
+
let fs = Eio.Stdenv.fs env in
25
+
let monorepo = Monopam.Config.Paths.monorepo config in
26
+
let { Monopam.Lint.issues; packages_scanned } =
27
+
Monopam.Lint.run ~fs:(fs :> Eio.Fs.dir_ty Eio.Path.t) ~monorepo ()
28
+
in
29
+
let issues =
30
+
match filter with
31
+
| [] -> issues
32
+
| dirs -> List.filter (fun i -> List.mem i.Monopam.Lint.subtree dirs) issues
33
+
in
34
+
if issues = [] then begin
35
+
Fmt.pr "%a All %d packages have correct dependencies.@."
36
+
Fmt.(styled (`Fg `Green) string)
37
+
"✓" packages_scanned;
38
+
`Ok ()
39
+
end
40
+
else begin
41
+
(* Group by subtree *)
42
+
let groups = Hashtbl.create 16 in
43
+
let order = ref [] in
44
+
List.iter
45
+
(fun (i : Monopam.Lint.issue) ->
46
+
if not (Hashtbl.mem groups i.subtree) then order := i.subtree :: !order;
47
+
let existing =
48
+
try Hashtbl.find groups i.subtree with Not_found -> []
49
+
in
50
+
Hashtbl.replace groups i.subtree (i :: existing))
51
+
issues;
52
+
List.iter
53
+
(fun subtree ->
54
+
let issues = List.rev (Hashtbl.find groups subtree) in
55
+
let pkgs =
56
+
List.map (fun (i : Monopam.Lint.issue) -> i.needed_package) issues
57
+
|> List.sort_uniq String.compare
58
+
in
59
+
Fmt.pr "%-22s %a@." subtree
60
+
Fmt.(list ~sep:sp (styled (`Fg `Yellow) string))
61
+
pkgs)
62
+
(List.rev !order);
63
+
Fmt.pr "@.%a %d missing deps in %d packages (%d scanned)@."
64
+
Fmt.(styled (`Fg `Red) string)
65
+
"✗" (List.length issues) (Hashtbl.length groups) packages_scanned;
66
+
`Ok ()
67
+
end
68
+
69
+
let cmd =
70
+
let doc = "Check library dependencies are declared in dune-project" in
71
+
let info = Cmd.info "lint" ~doc ~man in
72
+
let filter_arg =
73
+
let doc = "Only lint specific subtrees." in
74
+
Arg.(value & pos_all string [] & info [] ~docv:"SUBTREE" ~doc)
75
+
in
76
+
Cmd.v info Term.(ret (const run $ filter_arg $ Common.logging_term))
+1
bin/main.ml
+1
bin/main.ml
+1
-2
dune-project
+1
-2
dune-project
+2
-2
lib/dune
+2
-2
lib/dune
+57
-9
lib/dune_project.ml
+57
-9
lib/dune_project.ml
···
19
19
Fmt.(list ~sep:(any ", ") string)
20
20
t.packages
21
21
22
-
module Sexp = Sexplib0.Sexp
22
+
module Sexp = Sexpt.Sexp
23
23
24
24
(** Extract string from a Sexp.Atom, or None if it's a List *)
25
25
let atom_string = function Sexp.Atom s -> Some s | Sexp.List _ -> None
···
88
88
| _ -> None)
89
89
sexps
90
90
91
+
(** Remove backslash-newline continuation inside dune quoted strings.
92
+
93
+
In dune (and OCaml), a backslash before a newline inside a quoted string
94
+
means the string continues on the next line, skipping leading whitespace. *)
95
+
let preprocess_continuations content =
96
+
let len = String.length content in
97
+
let buf = Buffer.create len in
98
+
let i = ref 0 in
99
+
let in_string = ref false in
100
+
while !i < len do
101
+
let c = content.[!i] in
102
+
if !in_string then begin
103
+
if c = '\\' && !i + 1 < len then begin
104
+
let next = content.[!i + 1] in
105
+
if next = '\n' then begin
106
+
(* Continuation: skip \ \n and leading whitespace *)
107
+
i := !i + 2;
108
+
while !i < len && (content.[!i] = ' ' || content.[!i] = '\t') do
109
+
incr i
110
+
done
111
+
end
112
+
else begin
113
+
Buffer.add_char buf '\\';
114
+
Buffer.add_char buf next;
115
+
i := !i + 2
116
+
end
117
+
end
118
+
else begin
119
+
if c = '"' then in_string := false;
120
+
Buffer.add_char buf c;
121
+
incr i
122
+
end
123
+
end
124
+
else begin
125
+
if c = '"' then in_string := true
126
+
else if c = ';' then begin
127
+
(* Skip comments to avoid toggling in_string on quoted chars *)
128
+
while !i < len && content.[!i] <> '\n' do
129
+
Buffer.add_char buf content.[!i];
130
+
incr i
131
+
done
132
+
end;
133
+
if !i < len then begin
134
+
Buffer.add_char buf content.[!i];
135
+
incr i
136
+
end
137
+
end
138
+
done;
139
+
Buffer.contents buf
140
+
91
141
(** Preprocess dune multi-line string syntax.
92
142
93
-
Dune uses ["\|] and ["\>] prefixes for multi-line strings (see
94
-
{{:https://dune.readthedocs.io/en/stable/concepts/variables.html}Dune docs}).
95
-
These are not standard S-expressions, so we convert them to regular quoted
96
-
strings before parsing. *)
143
+
Handles two dune-specific extensions to S-expression syntax:
144
+
- Backslash-newline continuation inside quoted strings
145
+
- ["\|] and ["\>] prefixes for multi-line strings *)
97
146
let preprocess_dune_strings content =
147
+
let content = preprocess_continuations content in
98
148
let lines = String.split_on_char '\n' content in
99
149
let buf = Buffer.create (String.length content) in
100
150
let in_multiline = ref false in
···
134
184
135
185
let parse content =
136
186
let content = preprocess_dune_strings content in
137
-
match Parsexp.Many.parse_string content with
187
+
match Sexp.parse_string_many content with
138
188
| Error err ->
139
-
Error
140
-
(Fmt.str "S-expression parse error: %s"
141
-
(Parsexp.Parse_error.message err))
189
+
Error (Fmt.str "S-expression parse error: %s" (Sexp.Error.to_string err))
142
190
| Ok sexps -> (
143
191
match string_field "name" sexps with
144
192
| None -> Error "dune-project missing (name ...) stanza"
+5
lib/dune_project.mli
+5
lib/dune_project.mli
···
47
47
Branch derivation:
48
48
- [Uri \{url; branch = Some b\}] -> [url#b]
49
49
- Otherwise -> [url#main]. *)
50
+
51
+
val preprocess_dune_strings : string -> string
52
+
(** [preprocess_dune_strings content] converts dune multi-line string syntax
53
+
(["\|] and ["\>]) into regular quoted strings so that [content] can be
54
+
parsed by a standard S-expression parser. *)
+256
lib/lint.ml
+256
lib/lint.ml
···
1
+
(** Dependency linting for monorepo packages.
2
+
3
+
Compares META [requires] against opam file [depends] to find missing opam
4
+
dependencies. *)
5
+
6
+
module String_set = Set.Make (String)
7
+
8
+
let src = Logs.Src.create "monopam.lint" ~doc:"Dependency linting"
9
+
10
+
module Log = (val Logs.src_log src : Logs.LOG)
11
+
12
+
(** OCaml stdlib libraries — no opam dep needed. *)
13
+
let ocaml_builtins =
14
+
String_set.of_list
15
+
[
16
+
"unix";
17
+
"threads";
18
+
"str";
19
+
"dynlink";
20
+
"bigarray";
21
+
"stdlib";
22
+
"runtime_events";
23
+
"compiler-libs";
24
+
"ocamlfind";
25
+
"findlib";
26
+
"bytes";
27
+
]
28
+
29
+
let is_builtin lib =
30
+
let top =
31
+
match String.index_opt lib '.' with
32
+
| Some i -> String.sub lib 0 i
33
+
| None -> lib
34
+
in
35
+
String_set.mem top ocaml_builtins
36
+
37
+
(* ---- META parsing ---- *)
38
+
39
+
let parse_meta content =
40
+
try Ok (Fl_metascanner.parse_lexing (Lexing.from_string content))
41
+
with Fl_metascanner.Error msg -> Error msg
42
+
43
+
(** Collect all [requires] library names from a parsed META, recursively through
44
+
sub-packages. *)
45
+
let rec collect_requires (pkg : Fl_metascanner.pkg_expr) =
46
+
let own =
47
+
List.concat_map
48
+
(fun (def : Fl_metascanner.pkg_definition) ->
49
+
if def.def_var = "requires" then
50
+
let v = def.def_value in
51
+
let v = String.concat " " (String.split_on_char '\n' v) in
52
+
String.split_on_char ' ' v
53
+
|> List.filter (fun s -> s <> "" && s <> ",")
54
+
else [])
55
+
pkg.pkg_defs
56
+
in
57
+
let children =
58
+
List.concat_map (fun (_, child) -> collect_requires child) pkg.pkg_children
59
+
in
60
+
own @ children
61
+
62
+
(** Index all library names from a parsed META into [lib_name -> opam_pkg]. *)
63
+
let rec index_meta ~opam_pkg ~prefix (pkg : Fl_metascanner.pkg_expr) index =
64
+
Hashtbl.replace index prefix opam_pkg;
65
+
List.iter
66
+
(fun (name, child) ->
67
+
index_meta ~opam_pkg ~prefix:(prefix ^ "." ^ name) child index)
68
+
pkg.pkg_children
69
+
70
+
(* ---- Library index ---- *)
71
+
72
+
let load_file fs path =
73
+
try Some (Eio.Path.load Eio.Path.(fs / Fpath.to_string path))
74
+
with Eio.Io _ -> None
75
+
76
+
(** Scan a lib directory for META files and populate the index. *)
77
+
let scan_meta_dir ~fs dir index =
78
+
let entries = try Eio.Path.read_dir dir with Eio.Io _ -> [] in
79
+
List.iter
80
+
(fun pkg ->
81
+
let meta = Eio.Path.(dir / pkg / "META") in
82
+
match Eio.Path.load meta with
83
+
| content -> (
84
+
match parse_meta content with
85
+
| Ok expr -> index_meta ~opam_pkg:pkg ~prefix:pkg expr index
86
+
| Error msg ->
87
+
Log.debug (fun m -> m "Failed to parse %s/META: %s" pkg msg))
88
+
| exception Eio.Io _ -> ())
89
+
entries
90
+
91
+
(** Build the full library index from build install dir and opam lib. *)
92
+
let build_library_index ~fs ~monorepo =
93
+
let index = Hashtbl.create 512 in
94
+
let build_lib =
95
+
Eio.Path.(
96
+
fs
97
+
/ Fpath.to_string
98
+
Fpath.(monorepo / "_build" / "install" / "default" / "lib"))
99
+
in
100
+
let opam_lib =
101
+
Eio.Path.(fs / Fpath.to_string Fpath.(monorepo / "_opam" / "lib"))
102
+
in
103
+
scan_meta_dir ~fs build_lib index;
104
+
scan_meta_dir ~fs opam_lib index;
105
+
Log.debug (fun m -> m "Library index: %d entries" (Hashtbl.length index));
106
+
index
107
+
108
+
let lib_to_package index lib =
109
+
match Hashtbl.find_opt index lib with
110
+
| Some pkg -> pkg
111
+
| None -> (
112
+
match String.index_opt lib '.' with
113
+
| Some i -> String.sub lib 0 i
114
+
| None -> lib)
115
+
116
+
(* ---- Opam file deps parsing ---- *)
117
+
118
+
module OP = OpamParserTypes.FullPos
119
+
120
+
let rec extract_dep_name (v : OP.value) =
121
+
match v.pelem with
122
+
| OP.String s -> Some s
123
+
| OP.Option (inner, _) -> extract_dep_name inner
124
+
| _ -> None
125
+
126
+
let rec extract_dep_names (v : OP.value) =
127
+
match v.pelem with
128
+
| OP.List { pelem = items; _ } -> List.filter_map extract_dep_name items
129
+
| OP.Group { pelem = items; _ } -> List.concat_map extract_dep_names items
130
+
| OP.Logop (_, l, r) -> extract_dep_names l @ extract_dep_names r
131
+
| _ -> Option.to_list (extract_dep_name v)
132
+
133
+
(** Parse an opam file and return the set of dependency package names. *)
134
+
let opam_depends content =
135
+
try
136
+
let opam = OpamParser.FullPos.string content "opam" in
137
+
List.fold_left
138
+
(fun acc (item : OP.opamfile_item) ->
139
+
match item.pelem with
140
+
| OP.Variable (name, value) when name.pelem = "depends" ->
141
+
List.fold_left
142
+
(fun s n -> String_set.add n s)
143
+
acc (extract_dep_names value)
144
+
| _ -> acc)
145
+
String_set.empty opam.file_contents
146
+
with exn ->
147
+
Log.debug (fun m -> m "opam parse failed: %s" (Printexc.to_string exn));
148
+
String_set.empty
149
+
150
+
(** Scan a subtree directory for [*.opam] files, return [(pkg_name, deps)]. *)
151
+
let scan_opam_files ~fs subtree_path =
152
+
let eio_path = Eio.Path.(fs / Fpath.to_string subtree_path) in
153
+
let entries = try Eio.Path.read_dir eio_path with Eio.Io _ -> [] in
154
+
List.filter_map
155
+
(fun name ->
156
+
if Filename.check_suffix name ".opam" then
157
+
let pkg_name = Filename.chop_suffix name ".opam" in
158
+
match load_file fs Fpath.(subtree_path / name) with
159
+
| Some content -> Some (pkg_name, opam_depends content)
160
+
| None -> None
161
+
else None)
162
+
entries
163
+
164
+
(* ---- Types ---- *)
165
+
166
+
type issue = { subtree : string; library : string; needed_package : string }
167
+
type result = { issues : issue list; packages_scanned : int }
168
+
169
+
(* ---- Core algorithm ---- *)
170
+
171
+
let run ~fs ~monorepo () =
172
+
let index = build_library_index ~fs ~monorepo in
173
+
let mono_eio = Eio.Path.(fs / Fpath.to_string monorepo) in
174
+
let build_lib = Fpath.(monorepo / "_build" / "install" / "default" / "lib") in
175
+
let subdirs =
176
+
(try Eio.Path.read_dir mono_eio with Eio.Io _ -> [])
177
+
|> List.filter (fun name ->
178
+
name <> ""
179
+
&& (not (String.starts_with ~prefix:"_" name))
180
+
&& (not (String.starts_with ~prefix:"." name))
181
+
&&
182
+
match Eio.Path.kind ~follow:false Eio.Path.(mono_eio / name) with
183
+
| `Directory -> true
184
+
| _ -> false
185
+
| exception _ -> false)
186
+
|> List.sort String.compare
187
+
in
188
+
189
+
let issues = ref [] in
190
+
let scanned = ref 0 in
191
+
192
+
List.iter
193
+
(fun subtree ->
194
+
let subtree_path = Fpath.(monorepo / subtree) in
195
+
let pkgs = scan_opam_files ~fs subtree_path in
196
+
if pkgs = [] then Log.debug (fun m -> m "%s: no opam files" subtree)
197
+
else begin
198
+
incr scanned;
199
+
let own_set = String_set.of_list (List.map fst pkgs) in
200
+
let all_deps =
201
+
List.fold_left
202
+
(fun acc (_, deps) -> String_set.union acc deps)
203
+
String_set.empty pkgs
204
+
in
205
+
Log.debug (fun m ->
206
+
m "%s: %d packages, %d declared deps" subtree (List.length pkgs)
207
+
(String_set.cardinal all_deps));
208
+
(* For each package, load its META and check requires *)
209
+
List.iter
210
+
(fun (pkg_name, _declared_deps) ->
211
+
let meta_path = Fpath.(build_lib / pkg_name / "META") in
212
+
match load_file fs meta_path with
213
+
| None ->
214
+
Log.debug (fun m ->
215
+
m "%s/%s: no META file (not built?)" subtree pkg_name)
216
+
| Some content -> (
217
+
match parse_meta content with
218
+
| Error msg ->
219
+
Log.warn (fun m ->
220
+
m "%s/%s: META parse error: %s" subtree pkg_name msg)
221
+
| Ok expr ->
222
+
let required_libs =
223
+
collect_requires expr |> List.sort_uniq String.compare
224
+
in
225
+
List.iter
226
+
(fun lib ->
227
+
if is_builtin lib then ()
228
+
else
229
+
let needed = lib_to_package index lib in
230
+
if
231
+
String_set.mem needed own_set
232
+
|| String_set.mem needed all_deps
233
+
then ()
234
+
else
235
+
issues :=
236
+
{
237
+
subtree;
238
+
library = lib;
239
+
needed_package = needed;
240
+
}
241
+
:: !issues)
242
+
required_libs))
243
+
pkgs
244
+
end)
245
+
subdirs;
246
+
247
+
{
248
+
issues =
249
+
List.sort
250
+
(fun a b ->
251
+
match String.compare a.subtree b.subtree with
252
+
| 0 -> String.compare a.needed_package b.needed_package
253
+
| n -> n)
254
+
!issues;
255
+
packages_scanned = !scanned;
256
+
}
+22
lib/lint.mli
+22
lib/lint.mli
···
1
+
(** Dependency linting for monorepo packages.
2
+
3
+
Scans dune files to build a library-to-package map, then checks that every
4
+
library referenced in [(libraries ...)] stanzas has its providing package
5
+
declared in the subtree's [(depends ...)] stanza. *)
6
+
7
+
type issue = {
8
+
subtree : string; (** Monorepo subdirectory *)
9
+
library : string; (** Library name used in a dune file *)
10
+
needed_package : string; (** Opam package that provides [library] *)
11
+
}
12
+
(** A single missing-dependency issue. *)
13
+
14
+
type result = {
15
+
issues : issue list; (** Missing dependencies found *)
16
+
packages_scanned : int; (** Number of subtrees checked *)
17
+
}
18
+
(** Result of a lint run. *)
19
+
20
+
val run : fs:Eio.Fs.dir_ty Eio.Path.t -> monorepo:Fpath.t -> unit -> result
21
+
(** [run ~fs ~monorepo ()] scans all subtrees under [monorepo], builds a
22
+
library-to-package index, and reports missing dependencies. *)
+1
lib/monopam.ml
+1
lib/monopam.ml
+1
lib/monopam.mli
+1
lib/monopam.mli