Source file dune_project_linter.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
module Dune_lang_version = Dune_lang_version
module Generate_opam_files = Generate_opam_files
module Implicit_transitive_deps = Implicit_transitive_deps
module Name = Name
type t =
{ path : Relative_path.t
; sexps_rewriter : Sexps_rewriter.t
}
let create ~(path : Relative_path.t) ~original_contents =
match Sexps_rewriter.create ~path:(path :> Fpath.t) ~original_contents with
| Error _ as error -> error
| Ok sexps_rewriter ->
let t = { path; sexps_rewriter } in
Ok t
;;
let contents t = Sexps_rewriter.contents t.sexps_rewriter
let sexps_rewriter t = t.sexps_rewriter
let path t = t.path
module Stanza = struct
type t = ..
end
type Stanza.t +=
| Dune_lang_version of Dune_lang_version.t
| Generate_opam_files of Generate_opam_files.t
| Implicit_transitive_deps of Implicit_transitive_deps.t
| Name of Name.t
| Unhandled
module Linter = struct
let of_stanza
(type m)
(module M : Dunolinter.Linter.S
with type t = m
and type predicate = Dune_project.Predicate.t)
~(inner_stanza : m)
~(stanza : Stanza.t)
~path
~original_sexp
~sexps_rewriter
=
let eval (t : m) ~path ~predicate =
match (predicate : Dunolint.Predicate.t) with
| `path condition -> Dunolinter.eval_path ~path ~condition
| `dune _ -> Dunolint.Trilang.Undefined
| `dune_project condition ->
Dunolint.Trilang.eval condition ~f:(fun predicate -> M.eval t ~predicate)
in
let enforce (m : m) ~path ~condition =
Dunolinter.Linter.enforce
(module Dunolint.Predicate)
~eval:(fun t ~predicate -> eval t ~path ~predicate)
~enforce:(fun t predicate ->
match predicate with
| Not _ -> Eval
| T (`dune _ | `path _) -> Unapplicable
| T (`dune_project condition) ->
M.enforce t ~condition;
Ok)
m
~condition
in
let eval ~path ~predicate = eval inner_stanza ~path ~predicate in
let enforce ~path ~condition = enforce inner_stanza ~path ~condition in
Dunolinter.Private.Stanza.create
{ stanza; path; original_sexp; sexps_rewriter; linter = T { eval; enforce } }
;;
module type S = sig
type t
include Dunolinter.Stanza_linter.S with type t := t
module Linter :
Dunolinter.Linter.S with type t = t and type predicate = Dune_project.Predicate.t
end
type t =
| T :
{ impl : (module S with type t = 'a)
; wrap : 'a -> Stanza.t
}
-> t
let field_name (T { impl = (module M); _ }) = M.field_name
end
let linters =
Linter.
[ T { impl = (module Dune_lang_version); wrap = (fun a -> Dune_lang_version a) }
; T { impl = (module Generate_opam_files); wrap = (fun a -> Generate_opam_files a) }
; T
{ impl = (module Implicit_transitive_deps)
; wrap = (fun a -> Implicit_transitive_deps a)
}
; T { impl = (module Name); wrap = (fun a -> Name a) }
]
|> Dunolinter.Linters.create ~field_name:Linter.field_name
;;
let visit t ~f =
let sexps_rewriter = t.sexps_rewriter in
let path = t.path in
List.iter (Sexps_rewriter.original_sexps sexps_rewriter) ~f:(fun original_sexp ->
match
match original_sexp with
| List (Atom field_name :: _) -> Dunolinter.Linters.lookup linters ~field_name
| _ -> None
with
| Some (T { impl = (module M); wrap }) ->
(match
Dunolinter.Sexp_handler.read (module M) ~sexps_rewriter ~field:original_sexp
with
| Error err -> Err.emit err ~level:Error
| Ok inner_stanza ->
f
(Linter.of_stanza
(module M.Linter)
~inner_stanza
~stanza:(wrap inner_stanza)
~path
~original_sexp
~sexps_rewriter);
M.rewrite inner_stanza ~sexps_rewriter ~field:original_sexp)
| None ->
f
(Dunolinter.Private.Stanza.create
{ stanza = Unhandled; path; original_sexp; sexps_rewriter; linter = Unhandled }))
;;