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
let maybe_autoformat_file ~previous_contents ~new_contents =
if String.equal previous_contents new_contents
then new_contents
else (
let was_originally_well_formatted =
try
let formatted =
Dunolint_engine.format_dune_file ~new_contents:previous_contents
in
String.equal formatted previous_contents
with
| _ -> false
in
if was_originally_well_formatted
then Dunolint_engine.format_dune_file ~new_contents
else new_contents)
;;
module Visitor_decision = struct
type t =
| Continue
| Skip_subtree
end
let lint_stanza ~rules ~stanza ~(return : _ With_return.return) =
let loc =
Sexps_rewriter.loc
(Dunolinter.sexps_rewriter stanza)
(Dunolinter.original_sexp stanza)
in
Dunolinter.Handler.emit_error_and_resume () ~loc ~f:(fun () ->
match Dunolinter.linter stanza with
| Unhandled -> ()
| T { eval; enforce } ->
List.iter rules ~f:(fun rule ->
match Dunolint.Rule.eval rule ~f:eval with
| `return -> ()
| `enforce condition -> enforce condition
| `skip_subtree -> return.return ()))
;;
module Lint_file (Linter : Dunolinter.S) = struct
let lint_file ~dunolint_engine ~rules ~(path : Relative_path.t) =
let previous_contents_ref = ref "" in
let visitor_decision = ref Visitor_decision.Continue in
Dunolint_engine.lint_file
dunolint_engine
~path
?create_file:None
~rewrite_file:(fun ~previous_contents ->
previous_contents_ref := previous_contents;
match Linter.create ~path ~original_contents:previous_contents with
| Error { loc; message } ->
Err.error ~loc [ Pp.textf "%s" message ];
previous_contents
| Ok linter ->
let () =
With_return.with_return (fun return ->
Linter.visit linter ~f:(fun stanza -> lint_stanza ~rules ~stanza ~return))
in
Linter.contents linter)
~autoformat_file:(fun ~new_contents ->
let previous_contents = !previous_contents_ref in
maybe_autoformat_file ~previous_contents ~new_contents);
!visitor_decision
;;
end
module Dune_lint = Lint_file (Dune_linter)
module Dune_project_lint = Lint_file (Dune_project_linter)
let visit_directory ~dunolint_engine ~config ~parent_dir ~files =
match
match Dunolint.Config.skip_subtree config with
| None -> `return
| Some condition ->
Dunolint.Rule.eval condition ~f:(fun (`path condition) ->
Dunolinter.eval_path ~path:parent_dir ~condition)
with
| `enforce nothing -> Nothing.unreachable_code nothing [@coverage off]
| `skip_subtree -> Dunolint_engine.Visitor_decision.Skip_subtree
| `return ->
let rules = Dunolint.Config.rules config in
let rec loop = function
| [] -> Dunolint_engine.Visitor_decision.Continue
| file :: files ->
let path = Relative_path.extend parent_dir (Fsegment.v file) in
(match
match Dunolint.Linted_file_kind.of_string file with
| Error (`Msg _) -> Visitor_decision.Continue
| Ok linted_file_kind ->
(match linted_file_kind with
| `dune -> Dune_lint.lint_file ~dunolint_engine ~rules ~path
| `dune_project -> Dune_project_lint.lint_file ~dunolint_engine ~rules ~path)
with
| Continue -> loop files
| Skip_subtree -> Dunolint_engine.Visitor_decision.Skip_subtree)
in
loop files
;;