/
Config.ml
168 lines (156 loc) · 5.37 KB
/
Config.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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
(** Copyright 2021-2023, Kakadu. *)
(** SPDX-License-Identifier: LGPL-3.0-or-later *)
open Base
open Caml.Format
type mode =
| Unspecified
| Dump_json of string
| Dump_text
| File of string
| Dir of string
| Fix of string
type t =
{ mutable outfile : string option
; mutable outgolint : string option
; mutable out_rdjsonl : string option
(* Spec: https://github.com/reviewdog/reviewdog/tree/master/proto/rdf#rdjson *)
; mutable mode : mode
(* Below options to manage file paths. Not sure are they really required *)
; mutable workspace : string option
; mutable prefix_to_cut : string option
; mutable prefix_to_add : string option
; mutable extra_includes : string list
; mutable verbose : bool
; mutable gen_replacements : bool
; enabled_lints : string Hash_set.t
; mutable skip_level_allow : bool
; mutable check_filesystem : bool
}
let opts =
{ outfile = None
; outgolint = None
; out_rdjsonl = None
; mode = Unspecified
; workspace = None
; prefix_to_cut = Some "_build/default/"
; prefix_to_add = None
; extra_includes = []
; verbose = false
; gen_replacements = false
; enabled_lints = Hash_set.create (module String)
; skip_level_allow = true
; check_filesystem = true
}
;;
(** Modes *)
let mode () = opts.mode
let set_mode m = opts.mode <- m
let set_dump_file s = set_mode (Dump_json s)
let set_dump_text () = set_mode Dump_text
let set_in_file s = set_mode (File s)
let set_in_dir s = set_mode (Dir s)
(** Other switches *)
let set_fix s = set_mode (Fix s)
let add_include s = opts.extra_includes <- s :: opts.extra_includes
let set_out_file s = opts.outfile <- Some s
let set_out_golint s = opts.outgolint <- Some s
let set_out_rdjsonl s = opts.out_rdjsonl <- Some s
let set_workspace s = opts.workspace <- Some s
let set_prefix_to_cut s = opts.prefix_to_cut <- Some s
let set_prefix_to_add s = opts.prefix_to_add <- Some s
let includes () = opts.extra_includes
let prefix_to_cut () = opts.prefix_to_cut
let prefix_to_add () = opts.prefix_to_add
let is_check_filesystem () = opts.check_filesystem
let enabled_lints () = opts.enabled_lints
let outfile () = opts.outfile
let out_golint () = opts.outgolint
let out_rdjsonl () = opts.out_rdjsonl
let unset_check_filesystem () = opts.check_filesystem <- false
let verbose () = opts.verbose
let gen_replacements () = opts.gen_replacements
let set_verbose () = opts.verbose <- true
let set_skip_level_allow b = opts.skip_level_allow <- b
let recover_filepath filepath =
let filepath =
match prefix_to_cut () with
| Some prefix when String.is_prefix filepath ~prefix ->
String.drop_prefix filepath (String.length prefix)
| Some prefix when verbose () ->
Caml.Format.eprintf "Can't cut prefix '%s' from '%s'\n%!" prefix filepath;
filepath
| Some _ | None -> filepath
in
let filepath =
match prefix_to_add () with
| Some s -> sprintf "%s%s" s filepath
| None -> filepath
in
filepath
;;
let is_enabled () =
let hash = enabled_lints () in
fun (module M : LINT.GENERAL) ->
(* Format.printf "is_enabled of %s\n%!" M.lint_id; *)
match M.level with
| LINT.Allow when opts.skip_level_allow -> false
| _ -> Hash_set.mem hash M.lint_id
;;
let parse_args () =
let open Caml in
let standard_args =
[ "-o", Arg.String set_out_file, "[FILE] Set Markdown output file"
; "-dump", Arg.Unit set_dump_text, "Dump info about available lints to terminal"
; ( "-dump-lints"
, Arg.String set_dump_file
, "[FILE] Dump information about available lints to JSON" )
; "-dir", Arg.String set_in_dir, "[FILE] Set root directory of dune project"
; "-ogolint", Arg.String set_out_golint, "Set output file in golint format"
; "-ordjsonl", Arg.String set_out_rdjsonl, "Set output file in rdjsonl format"
; ( "-del-prefix"
, Arg.String set_prefix_to_cut
, "Set prefix to cut from pathes in OUTPUT file" )
; ( "-add-prefix"
, Arg.String set_prefix_to_add
, "Set prefix to prepend to pathes in OUTPUT file" )
; "-I", Arg.String add_include, "Add extra include path for type checking"
(* ; "-ws", Arg.String set_workspace, "[FILE] Set dune workspace root" *)
; ( "-skip-level-allow"
, Arg.Bool set_skip_level_allow
, "[bool] Skip lints with level = Allow" )
; "-v", Arg.Unit set_verbose, "More verbose output"
; ( "-version"
, Arg.Unit
(fun () ->
let open Build_info.V1 in
Printf.printf
"version: %s\n"
(Option.fold ~none:"n/a" ~some:Version.to_string (version ())))
, " print version" )
; ( "-diffs-with-fixes"
, Arg.Unit (fun () -> opts.gen_replacements <- true)
, " Do generate DIFFs with replacements" )
; "-fix", Arg.String set_fix, "Apply all found lints available for correction"
]
in
let extra_args =
Hash_set.fold
~init:
[ ( "-no-check-filesystem"
, Arg.Unit unset_check_filesystem
, " Disable checking structure of a project" )
]
~f:(fun acc x ->
assert (x <> "");
( sprintf "-no-%s" x
, Arg.Unit (fun () -> Hash_set.remove opts.enabled_lints x)
, " Disable checking for this lint" )
:: acc)
opts.enabled_lints
|> List.sort (fun (a, _, _) (b, _, _) -> String.compare a b)
in
Arg.parse
(standard_args @ extra_args)
set_in_file
"Use -dir [PATH] to check dune-based project"
;;