Kakadu / zanuda / 93

Committed 04 Jul 2026 12:24PM UTC coverage: 85.254% (+0.1%) from 85.105%

Build # 93

Build Type

push

github

Committed by

Kakadu

Commit Message

CHANGES

Signed-off-by: Kakadu <Kakadu@pm.me>

Coverage Stats

2301 of 2699 relevant lines covered (85.25%)

603.05 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

87.5

/src/Config.ml

[@@@ocaml.text "/*"]

(** Copyright 2021-2026, Kakadu. *)

(** SPDX-License-Identifier: LGPL-3.0-or-later *)

[@@@ocaml.text "/*"]

type mode =
  | Unspecified
  | Dump_json of string
  | Dump_text
  | File of string
  | Dir of string
  | Fix of string
  | UnusedDecls of string

type t =
  { mutable outfile : string option
  ; mutable outgolint : string option
  ; mutable out_sarif : 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 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 Base.Hash_set.t
  ; all_lints : string Base.Hash_set.t
  ; mutable skip_level_allow : bool
  ; mutable check_filesystem : bool
  ; mutable plugin_name_suffix : string option
  ; mutable build_info: string
  }

let opts =
  { outfile = None
  ; outgolint = None
  ; out_sarif = None
  ; out_rdjsonl = None
  ; mode = Unspecified
  ; prefix_to_cut = Some "_build/default/"
  ; prefix_to_add = None
  ; extra_includes = []
  ; verbose = false
  ; gen_replacements = false
  ; enabled_lints = Base.Hash_set.create (module Base.String)
  ; all_lints = Base.Hash_set.create (module Base.String)
  ; skip_level_allow = true
  ; check_filesystem = true
  ; plugin_name_suffix = None
  ; build_info = "No loaded yet"
  }
;;

(** 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)
let set_in_unused_decls s = set_mode (UnusedDecls 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_out_sarif s = opts.out_sarif <- 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 all_lints () = opts.all_lints
let outfile () = opts.outfile
let out_golint () = opts.outgolint
let out_rdjsonl () = opts.out_rdjsonl
let out_sarif () = opts.out_sarif
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 set_plugin_name_suffix s = opts.plugin_name_suffix <- Some s
let plugin_name_suffix () = opts.plugin_name_suffix

let recover_filepath filepath =
  let filepath =
    match prefix_to_cut () with
    | Some prefix when String.starts_with filepath ~prefix ->
      Base.String.drop_prefix filepath (String.length prefix)
    | Some prefix when verbose () ->
      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 -> Printf.sprintf "%s%s" s filepath
    | None -> filepath
  in
  filepath
;;

(** Is lint enabled globally, don't take to account local decorations *)
let is_enabled () =
  let hash = enabled_lints () in
  fun (module M : LINT.GENERAL) ->
    match M.level with
    | LINT.Allow when opts.skip_level_allow -> false
    | _ -> Base.Hash_set.mem hash M.lint_id
;;

let parse_args () =
  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"
    ; ( "-unused-decls"
      , Arg.String set_in_unused_decls
      , "[FILE] Look for unused definitions" )
    ; "-ogolint", Arg.String set_out_golint, "Set output file in golint format"
    ; "-ordjsonl", Arg.String set_out_rdjsonl, "Set output file in rdjsonl format"
    ; "-osarif", Arg.String set_out_sarif, "Set output file in SARIF 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"
    ; ( "-skip-level-allow"
      , Arg.Bool set_skip_level_allow
      , "[bool] Skip lints with level = Allow" )
    ; ( "-with-plugins"
      , Arg.String set_plugin_name_suffix
      , "PREFIX Try to load plugins whos name ends with PREFIX" )
    ; "-v", Arg.Unit set_verbose, "More verbose output"
    ; ( "-version"
      , Arg.Unit
          (fun () ->
            Printf.printf
              "version: %s\n" opts.build_info
            )
      , " 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 =
    Base.Hash_set.fold
      ~init:
        [ ( "-no-check-filesystem"
          , Arg.Unit unset_check_filesystem
          , " Disable checking structure of a project" )
        ]
      ~f:(fun acc x ->
        assert (x <> "");
        ( Printf.sprintf "-no-%s" x
        , Arg.Unit (fun () -> Base.Hash_set.remove opts.enabled_lints x)
        , " Disable checking for this lint" )
        :: ( Printf.sprintf "-with-%s" x
           , Arg.Unit (fun () -> Base.Hash_set.add opts.enabled_lints x)
           , " Enable checking for this lint" )
        :: acc)
      opts.all_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"
;;

include (
struct
  let hash : (string, unit) Hashtbl.t = Hashtbl.create 24

  let enable s =
    (* Format.printf "enabling lint '%s'\n%!" s; *)
    Hashtbl.remove hash s
  ;;

  let disable s =
    (* Format.printf "disabling lint '%s'\n%!" s; *)
    Hashtbl.add hash s ()
  ;;

  let is_lint_enabled s =
    match Hashtbl.find hash s with
    | exception Not_found -> true
    | _ -> false
  ;;
end :
sig
  val is_lint_enabled : string -> bool
  val enable : string -> unit
  val disable : string -> unit
end)

1	[@@@ocaml.text "/*"]
2
3	(** Copyright 2021-2026, Kakadu. *)
4
5	(** SPDX-License-Identifier: LGPL-3.0-or-later *)
6
7	[@@@ocaml.text "/*"]
8
9	type mode =
10	\| Unspecified
11	\| Dump_json of string
12	\| Dump_text
13	\| File of string
14	\| Dir of string
15	\| Fix of string
16	\| UnusedDecls of string
17
18	type t =
19	{ mutable outfile : string option
20	; mutable outgolint : string option
21	; mutable out_sarif : string option
22	; mutable out_rdjsonl : string option
23	(* Spec: https://github.com/reviewdog/reviewdog/tree/master/proto/rdf#rdjson *)
24	; mutable mode : mode
25	(* Below options to manage file paths. Not sure are they really required *)
26	; mutable prefix_to_cut : string option
27	; mutable prefix_to_add : string option
28	; mutable extra_includes : string list
29	; mutable verbose : bool
30	; mutable gen_replacements : bool
31	; enabled_lints : string Base.Hash_set.t
32	; all_lints : string Base.Hash_set.t
33	; mutable skip_level_allow : bool
34	; mutable check_filesystem : bool
35	; mutable plugin_name_suffix : string option
36	; mutable build_info: string
37	}
38
39	let opts =
40	{ outfile = None
41	; outgolint = None
42	; out_sarif = None
43	; out_rdjsonl = None
44	; mode = Unspecified
45	; prefix_to_cut = Some "_build/default/"
46	; prefix_to_add = None
47	; extra_includes = []
48	; verbose = false
49	; gen_replacements = false
50	; enabled_lints = Base.Hash_set.create (module Base.String)	53✔
51	; all_lints = Base.Hash_set.create (module Base.String)	53✔
52	; skip_level_allow = true
53	; check_filesystem = true
54	; plugin_name_suffix = None
55	; build_info = "No loaded yet"
56	}
57	;;
58
59	(** Modes *)
60
61	let mode () = opts.mode	48✔
62	let set_mode m = opts.mode <- m	46✔
63	let set_dump_file s = set_mode (Dump_json s)	1✔
64	let set_dump_text () = set_mode Dump_text	2✔
65	let set_in_file s = set_mode (File s)	1✔
66	let set_in_dir s = set_mode (Dir s)	39✔
67	let set_in_unused_decls s = set_mode (UnusedDecls s)	3✔
68
69	(** Other switches *)
70	let set_fix s = set_mode (Fix s)	×
71
72	let add_include s = opts.extra_includes <- s :: opts.extra_includes	1✔
73	let set_out_file s = opts.outfile <- Some s	3✔
74	let set_out_golint s = opts.outgolint <- Some s	1✔
75	let set_out_rdjsonl s = opts.out_rdjsonl <- Some s	33✔
76	let set_out_sarif s = opts.out_sarif <- Some s	1✔
77	let set_prefix_to_cut s = opts.prefix_to_cut <- Some s	1✔
78	let set_prefix_to_add s = opts.prefix_to_add <- Some s	1✔
79	let includes () = opts.extra_includes	82✔
80	let prefix_to_cut () = opts.prefix_to_cut	21✔
81	let prefix_to_add () = opts.prefix_to_add	21✔
82	let is_check_filesystem () = opts.check_filesystem	42✔
83	let enabled_lints () = opts.enabled_lints	261✔
84	let all_lints () = opts.all_lints	49✔
85	let outfile () = opts.outfile	×
86	let out_golint () = opts.outgolint	×
87	let out_rdjsonl () = opts.out_rdjsonl	40✔
88	let out_sarif () = opts.out_sarif	40✔
89	let unset_check_filesystem () = opts.check_filesystem <- false	28✔
90	let verbose () = opts.verbose	209✔
91	let gen_replacements () = opts.gen_replacements	67✔
92	let set_verbose () = opts.verbose <- true	2✔
93	let set_skip_level_allow b = opts.skip_level_allow <- b	1✔
94	let set_plugin_name_suffix s = opts.plugin_name_suffix <- Some s	1✔
95	let plugin_name_suffix () = opts.plugin_name_suffix	48✔
96
97	let recover_filepath filepath =
98	let filepath =	21✔
99	match prefix_to_cut () with
100	\| Some prefix when String.starts_with filepath ~prefix ->	21✔
101	Base.String.drop_prefix filepath (String.length prefix)	19✔
102	\| Some prefix when verbose () ->	2✔
103	Format.eprintf "Can't cut prefix '%s' from '%s'\n%!" prefix filepath;	×
104	filepath	×
105	\| Some _ \| None -> filepath	×
106	in
107	let filepath =
108	match prefix_to_add () with
109	\| Some s -> Printf.sprintf "%s%s" s filepath	×
110	\| None -> filepath	21✔
111	in
112	filepath
113	;;
114
115	(** Is lint enabled globally, don't take to account local decorations *)
116	let is_enabled () =
117	let hash = enabled_lints () in	130✔
118	fun (module M : LINT.GENERAL) ->	130✔
119	match M.level with	2,017✔
120	\| LINT.Allow when opts.skip_level_allow -> false	64✔
121	\| _ -> Base.Hash_set.mem hash M.lint_id	1,953✔
122	;;
123
124	let parse_args () =
125	let standard_args =	49✔
126	[ "-o", Arg.String set_out_file, "[FILE] Set Markdown output file"
127	; "-dump", Arg.Unit set_dump_text, "Dump info about available lints to terminal"
128	; ( "-dump-lints"
129	, Arg.String set_dump_file
130	, "[FILE] Dump information about available lints to JSON" )
131	; "-dir", Arg.String set_in_dir, "[FILE] Set root directory of dune project"
132	; ( "-unused-decls"
133	, Arg.String set_in_unused_decls
134	, "[FILE] Look for unused definitions" )
135	; "-ogolint", Arg.String set_out_golint, "Set output file in golint format"
136	; "-ordjsonl", Arg.String set_out_rdjsonl, "Set output file in rdjsonl format"
137	; "-osarif", Arg.String set_out_sarif, "Set output file in SARIF format"
138	; ( "-del-prefix"
139	, Arg.String set_prefix_to_cut
140	, "Set prefix to cut from pathes in OUTPUT file" )
141	; ( "-add-prefix"
142	, Arg.String set_prefix_to_add
143	, "Set prefix to prepend to pathes in OUTPUT file" )
144	; "-I", Arg.String add_include, "Add extra include path for type checking"
145	; ( "-skip-level-allow"
146	, Arg.Bool set_skip_level_allow
147	, "[bool] Skip lints with level = Allow" )
148	; ( "-with-plugins"
149	, Arg.String set_plugin_name_suffix
150	, "PREFIX Try to load plugins whos name ends with PREFIX" )
151	; "-v", Arg.Unit set_verbose, "More verbose output"
152	; ( "-version"
153	, Arg.Unit
154	(fun () ->
155	Printf.printf	×
156	"version: %s\n" opts.build_info
157	)
158	, " Print version" )
159	; ( "-diffs-with-fixes"
160	, Arg.Unit (fun () -> opts.gen_replacements <- true)	4✔
161	, " Do generate DIFFs with replacements" )
162	; "-fix", Arg.String set_fix, "Apply all found lints available for correction"
163	]
164	in
165	let extra_args =
166	Base.Hash_set.fold
167	~init:
168	[ ( "-no-check-filesystem"
169	, Arg.Unit unset_check_filesystem
170	, " Disable checking structure of a project" )
171	]
172	~f:(fun acc x ->
173	assert (x <> "");	1,715✔
174	( Printf.sprintf "-no-%s" x	1,715✔
175	, Arg.Unit (fun () -> Base.Hash_set.remove opts.enabled_lints x)	45✔
176	, " Disable checking for this lint" )
177	:: ( Printf.sprintf "-with-%s" x	1,715✔
178	, Arg.Unit (fun () -> Base.Hash_set.add opts.enabled_lints x)	1✔
179	, " Enable checking for this lint" )
180	:: acc)
181	opts.all_lints
182	\|> List.sort (fun (a, _, _) (b, _, _) -> String.compare a b)	49✔
183	in
184	Arg.parse	49✔
185	(standard_args @ extra_args)
186	set_in_file
187	"Use -dir [PATH] to check dune-based project"
188	;;
189
190	include (
191	struct
192	let hash : (string, unit) Hashtbl.t = Hashtbl.create 24	53✔
193
194	let enable s =
195	(* Format.printf "enabling lint '%s'\n%!" s; *)
196	Hashtbl.remove hash s	1✔
197	;;
198
199	let disable s =
200	(* Format.printf "disabling lint '%s'\n%!" s; *)
201	Hashtbl.add hash s ()	4✔
202	;;
203
204	let is_lint_enabled s =
205	match Hashtbl.find hash s with	35,436✔
206	\| exception Not_found -> true	35,382✔
207	\| _ -> false	54✔
208	;;
209	end :
210	sig
211	val is_lint_enabled : string -> bool
212	val enable : string -> unit
213	val disable : string -> unit
214	end)

Kakadu / zanuda / 93

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous