forked from
anil.recoil.org/monopam
Monorepo management for opam overlays
monopam/lint: check source URL consistency
For each subtree, compare the URL derived from dune-project's
(source (...)) stanza against sources.toml's source and upstream
fields. Flag the subtree when neither matches -- that usually means a
rename happened on one side and not the other, or the dune-project URL
was never updated after a fork.
Does not hit the network; URL normalisation strips git+ prefix,
trailing .git, and trailing slash before comparing. Added source_issue
type, extended Lint.result with source_issues, and the lint command
prints a second report block when any are present.
+169
-21
+49
-8
bin/cmd_lint.ml
+49
-8
bin/cmd_lint.ml
···
94
94
Fmt.pr "%s unused: %s@." subtree (String.concat " " unused))
95
95
order
96
96
97
+
let pp_source_issues source_issues =
98
+
if source_issues = [] then ()
99
+
else begin
100
+
Fmt.pr "%a %d subtree%s:@."
101
+
Fmt.(styled `Bold string)
102
+
"Source-URL mismatches:"
103
+
(List.length source_issues)
104
+
(if List.length source_issues = 1 then "" else "s");
105
+
List.iter
106
+
(fun (i : Monopam.Lint.source_issue) ->
107
+
let dune = Option.value ~default:"(none)" i.dune_project in
108
+
let toml = Option.value ~default:"(none)" i.sources_toml in
109
+
Fmt.pr " %-24s dune-project: %a@." i.subtree
110
+
Fmt.(styled `Yellow string)
111
+
dune;
112
+
Fmt.pr " %-24s sources.toml: %a@." "" Fmt.(styled `Cyan string) toml)
113
+
source_issues
114
+
end
115
+
97
116
let run filter () =
98
117
Eio_main.run @@ fun env ->
99
118
Common.with_config env @@ fun config ->
100
119
let fs = Eio.Stdenv.fs env in
101
120
let monorepo = Monopam.Config.Paths.monorepo config in
102
-
let { Monopam.Lint.issues; packages_scanned } =
121
+
let { Monopam.Lint.issues; source_issues; packages_scanned } =
103
122
Monopam.Lint.run ~fs:(fs :> Eio.Fs.dir_ty Eio.Path.t) ~monorepo ()
104
123
in
105
-
let issues, scanned_label =
124
+
let issues =
125
+
match filter with
126
+
| [] -> issues
127
+
| dirs ->
128
+
List.filter
129
+
(fun (i : Monopam.Lint.issue) -> List.mem i.subtree dirs)
130
+
issues
131
+
in
132
+
let source_issues =
106
133
match filter with
107
-
| [] -> (issues, Fmt.str "%d scanned" packages_scanned)
134
+
| [] -> source_issues
108
135
| dirs ->
109
-
( List.filter (fun i -> List.mem i.Monopam.Lint.subtree dirs) issues,
110
-
Fmt.str "%s" (String.concat ", " dirs) )
136
+
List.filter
137
+
(fun (i : Monopam.Lint.source_issue) -> List.mem i.subtree dirs)
138
+
source_issues
111
139
in
112
-
if issues = [] then begin
113
-
Fmt.pr "%a All dependencies correct (%s).@."
140
+
let scanned_label =
141
+
match filter with
142
+
| [] -> Fmt.str "%d scanned" packages_scanned
143
+
| dirs -> Fmt.str "%s" (String.concat ", " dirs)
144
+
in
145
+
if issues = [] && source_issues = [] then begin
146
+
Fmt.pr "%a All checks passed (%s).@."
114
147
Fmt.(styled (`Fg `Green) string)
115
148
"✓" scanned_label;
116
149
`Ok ()
117
150
end
118
151
else begin
119
-
if Tty.is_tty () then pp_table issues else pp_plain issues;
152
+
if issues <> [] then
153
+
if Tty.is_tty () then pp_table issues else pp_plain issues;
154
+
pp_source_issues source_issues;
120
155
let n_missing =
121
156
List.filter (fun i -> i.Monopam.Lint.kind = Missing) issues |> List.length
122
157
in
123
158
let n_unused =
124
159
List.filter (fun i -> i.Monopam.Lint.kind = Unused) issues |> List.length
125
160
in
161
+
let n_source = List.length source_issues in
126
162
let n_pkgs =
127
163
List.map (fun (i : Monopam.Lint.issue) -> i.subtree) issues
164
+
|> List.append
165
+
(List.map
166
+
(fun (i : Monopam.Lint.source_issue) -> i.subtree)
167
+
source_issues)
128
168
|> List.sort_uniq String.compare
129
169
|> List.length
130
170
in
···
133
173
[
134
174
(if n_missing > 0 then Some (Fmt.str "%d missing" n_missing) else None);
135
175
(if n_unused > 0 then Some (Fmt.str "%d unused" n_unused) else None);
176
+
(if n_source > 0 then Some (Fmt.str "%d source" n_source) else None);
136
177
]
137
178
in
138
179
Fmt.pr "%a %s in %d packages (%s)@."
+88
-4
lib/lint.ml
+88
-4
lib/lint.ml
···
303
303
304
304
type kind = Missing | Unused
305
305
type issue = { subtree : string; kind : kind; package : string }
306
-
type result = { issues : issue list; packages_scanned : int }
306
+
307
+
type source_issue = {
308
+
subtree : string;
309
+
dune_project : string option;
310
+
sources_toml : string option;
311
+
}
312
+
313
+
type result = {
314
+
issues : issue list;
315
+
source_issues : source_issue list;
316
+
packages_scanned : int;
317
+
}
318
+
319
+
(* ---- Source URL consistency ---- *)
320
+
321
+
(** Strip [git+], trailing [.git] and trailing slash so two URLs that agree in
322
+
substance compare as equal. *)
323
+
let normalise_url u =
324
+
let u =
325
+
if String.starts_with ~prefix:"git+" u then
326
+
String.sub u 4 (String.length u - 4)
327
+
else u
328
+
in
329
+
let u =
330
+
if String.ends_with ~suffix:"/" u then String.sub u 0 (String.length u - 1)
331
+
else u
332
+
in
333
+
if String.ends_with ~suffix:".git" u then String.sub u 0 (String.length u - 4)
334
+
else u
335
+
336
+
let load_dune_project_source ~fs subtree_path =
337
+
let dune_project_path = Fpath.(subtree_path / "dune-project") in
338
+
let eio_path = Eio.Path.(fs / Fpath.to_string dune_project_path) in
339
+
match Eio.Path.kind ~follow:false eio_path with
340
+
| `Regular_file -> (
341
+
match try Some (Eio.Path.load eio_path) with Eio.Io _ -> None with
342
+
| None -> None
343
+
| Some content -> (
344
+
match Dune_project.parse content with
345
+
| Error _ -> None
346
+
| Ok dp -> (
347
+
match Dune_project.dev_repo_url dp with
348
+
| Ok url -> Some (normalise_url url)
349
+
| Error _ -> None)))
350
+
| _ | (exception Eio.Io _) -> None
351
+
352
+
let compute_source_issues ~fs ~monorepo ~sources subdirs =
353
+
List.filter_map
354
+
(fun subtree ->
355
+
let subtree_path = Fpath.(monorepo / subtree) in
356
+
let dune = load_dune_project_source ~fs subtree_path in
357
+
let source =
358
+
Option.map normalise_url
359
+
(Sources_registry.derive_source sources ~subtree)
360
+
in
361
+
let upstream =
362
+
match Sources_registry.find sources ~subtree with
363
+
| Some e -> Option.map normalise_url e.upstream
364
+
| None -> None
365
+
in
366
+
match dune with
367
+
| None -> None
368
+
| Some d ->
369
+
let matches_source =
370
+
match source with Some s -> s = d | None -> false
371
+
in
372
+
let matches_upstream =
373
+
match upstream with Some u -> u = d | None -> false
374
+
in
375
+
if matches_source || matches_upstream then None
376
+
else Some { subtree; dune_project = Some d; sources_toml = source })
377
+
subdirs
378
+
379
+
let sort_source_issues issues =
380
+
List.sort (fun a b -> String.compare a.subtree b.subtree) issues
307
381
308
382
(* ---- Core algorithm ---- *)
309
383
···
367
441
in
368
442
missing @ unused_issues
369
443
370
-
let sort_issues issues =
444
+
let sort_issues (issues : issue list) =
371
445
List.sort
372
-
(fun a b ->
446
+
(fun (a : issue) (b : issue) ->
373
447
match String.compare a.subtree b.subtree with
374
448
| 0 ->
375
449
let ka = match a.kind with Missing -> 0 | Unused -> 1 in
···
400
474
in
401
475
String_set.remove pkg (walk String_set.empty pkg)
402
476
477
+
let load_sources ~fs ~monorepo =
478
+
let sources_path = Fpath.(monorepo / "sources.toml") in
479
+
match Sources_registry.load ~fs:(fs :> _ Eio.Path.t) sources_path with
480
+
| Ok s -> s
481
+
| Error _ -> Sources_registry.empty
482
+
403
483
let run ~fs ~monorepo () =
404
484
let index = build_library_index ~fs ~monorepo in
405
485
let build_lib = Fpath.(monorepo / "_build" / "install" / "default" / "lib") in
406
486
let subdirs = list_subdirs ~fs ~monorepo in
487
+
let sources = load_sources ~fs ~monorepo in
488
+
let source_issues =
489
+
compute_source_issues ~fs ~monorepo ~sources subdirs |> sort_source_issues
490
+
in
407
491
let issues = ref [] in
408
492
let scanned = ref 0 in
409
493
List.iter
···
438
522
pkgs
439
523
end)
440
524
subdirs;
441
-
{ issues = sort_issues !issues; packages_scanned = !scanned }
525
+
{ issues = sort_issues !issues; source_issues; packages_scanned = !scanned }
+26
-7
lib/lint.mli
+26
-7
lib/lint.mli
···
1
-
(** Dependency linting for monorepo packages.
1
+
(** Lint checks for monorepo packages.
2
2
3
-
Compares META [requires] against opam [depends] in both directions:
4
-
- Missing: libraries needed by META but not declared in opam depends
5
-
- Unused: runtime deps declared in opam but not needed by META requires *)
3
+
Two kinds of checks:
4
+
- {b Dependency} — compare META [requires] against opam [depends]
5
+
bidirectionally: missing (needed by META but not declared) and unused
6
+
(declared but not needed by META).
7
+
- {b Source URL} — compare each subtree's dune-project [(source ...)] stanza
8
+
with the [source] field in [sources.toml] (or the derived default-origin
9
+
URL when there is no entry). Mismatches usually indicate a stale rename or
10
+
a pending tangled-side rename. *)
6
11
7
12
type kind = Missing | Unused (** The kind of dependency issue. *)
8
13
···
13
18
}
14
19
(** A single dependency issue. *)
15
20
21
+
type source_issue = {
22
+
subtree : string; (** Monorepo subdirectory *)
23
+
dune_project : string option;
24
+
(** Normalised URL derived from dune-project's [(source ...)] stanza, or
25
+
[None] if absent. *)
26
+
sources_toml : string option;
27
+
(** Normalised URL configured in [sources.toml] for this subtree, either
28
+
via an explicit entry or the default origin. [None] if neither. *)
29
+
}
30
+
(** A single source-URL inconsistency. Emitted when the dune-project source and
31
+
the sources.toml source disagree on where the subtree lives. *)
32
+
16
33
type result = {
17
34
issues : issue list; (** Dependency issues found *)
35
+
source_issues : source_issue list; (** Source-URL mismatches found *)
18
36
packages_scanned : int; (** Number of subtrees checked *)
19
37
}
20
38
(** Result of a lint run. *)
21
39
22
40
val run : fs:Eio.Fs.dir_ty Eio.Path.t -> monorepo:Fpath.t -> unit -> result
23
-
(** [run ~fs ~monorepo ()] scans all subtrees under [monorepo], builds a
24
-
library-to-package index from META files, and reports both missing and
25
-
unused dependencies. *)
41
+
(** [run ~fs ~monorepo ()] scans every subtree under [monorepo], builds a
42
+
library-to-package index from META files, reports missing / unused
43
+
dependencies, and reports subtrees whose dune-project source URL disagrees
44
+
with the sources.toml entry (or default origin). *)
+6
-2
test/test_lint.ml
+6
-2
test/test_lint.ml
···
20
20
(issue.kind = Monopam.Lint.Missing)
21
21
22
22
let test_result_construction () =
23
-
let r : Monopam.Lint.result = { issues = []; packages_scanned = 0 } in
23
+
let r : Monopam.Lint.result =
24
+
{ issues = []; source_issues = []; packages_scanned = 0 }
25
+
in
24
26
Alcotest.(check int) "no issues" 0 (List.length r.issues);
25
27
Alcotest.(check int) "no packages" 0 r.packages_scanned
26
28
···
31
33
{ subtree = "b"; kind = Unused; package = "y" };
32
34
]
33
35
in
34
-
let r : Monopam.Lint.result = { issues; packages_scanned = 2 } in
36
+
let r : Monopam.Lint.result =
37
+
{ issues; source_issues = []; packages_scanned = 2 }
38
+
in
35
39
Alcotest.(check int) "two issues" 2 (List.length r.issues);
36
40
Alcotest.(check int) "two packages" 2 r.packages_scanned
37
41