Kakadu / zanuda / 18

Committed 17 Sep 2025 05:06PM UTC coverage: 85.847% (-1.5%) from 87.346%

Build # 18

Build Type

push

github

Committed by

Kakadu

Commit Message

Repair coverage testing

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

Run Details

2032 of 2367 relevant lines covered (85.85%)

477.23 hits per line

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

83.64

/src/Config.ml

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

(** Copyright 2021-2025, 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_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
  }

let opts =
  { outfile = None
  ; outgolint = 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
  }
;;

(** 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_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 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.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
;;

let is_enabled () =
  let hash = enabled_lints () in
  fun (module M : LINT.GENERAL) ->
    let ans =
      match M.level with
      | LINT.Allow when opts.skip_level_allow -> false
      | _ -> Base.Hash_set.mem hash M.lint_id
    in
    (* Format.printf "is_enabled of %s = %b\n%!" M.lint_id ans; *)
    ans
;;

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"
    ; ( "-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" )
    ; "-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 =
    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"
;;

1	[@@@ocaml.text "/*"]
2
3	(** Copyright 2021-2025, 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_rdjsonl : string option
22	(* Spec: https://github.com/reviewdog/reviewdog/tree/master/proto/rdf#rdjson *)
23	; mutable mode : mode
24	(* Below options to manage file paths. Not sure are they really required *)
25	; mutable prefix_to_cut : string option
26	; mutable prefix_to_add : string option
27	; mutable extra_includes : string list
28	; mutable verbose : bool
29	; mutable gen_replacements : bool
30	; enabled_lints : string Base.Hash_set.t
31	; all_lints : string Base.Hash_set.t
32	; mutable skip_level_allow : bool
33	; mutable check_filesystem : bool
34	}
35
36	let opts =
37	{ outfile = None
38	; outgolint = None
39	; out_rdjsonl = None
40	; mode = Unspecified
41	; prefix_to_cut = Some "_build/default/"
42	; prefix_to_add = None
43	; extra_includes = []
44	; verbose = false
45	; gen_replacements = false
46	; enabled_lints = Base.Hash_set.create (module Base.String)	50✔
47	; all_lints = Base.Hash_set.create (module Base.String)	50✔
48	; skip_level_allow = true
49	; check_filesystem = true
50	}
51	;;
52
53	(** Modes *)
54
55	let mode () = opts.mode	45✔
56	let set_mode m = opts.mode <- m	43✔
57	let set_dump_file s = set_mode (Dump_json s)	1✔
58	let set_dump_text () = set_mode Dump_text	2✔
59	let set_in_file s = set_mode (File s)	1✔
60	let set_in_dir s = set_mode (Dir s)	36✔
61	let set_in_unused_decls s = set_mode (UnusedDecls s)	3✔
62
63	(** Other switches *)
64	let set_fix s = set_mode (Fix s)	×
65
66	let add_include s = opts.extra_includes <- s :: opts.extra_includes	1✔
67	let set_out_file s = opts.outfile <- Some s	3✔
68	let set_out_golint s = opts.outgolint <- Some s	1✔
69	let set_out_rdjsonl s = opts.out_rdjsonl <- Some s	30✔
70	let set_prefix_to_cut s = opts.prefix_to_cut <- Some s	1✔
71	let set_prefix_to_add s = opts.prefix_to_add <- Some s	1✔
72	let includes () = opts.extra_includes	74✔
73	let prefix_to_cut () = opts.prefix_to_cut	121✔
74	let prefix_to_add () = opts.prefix_to_add	121✔
75	let is_check_filesystem () = opts.check_filesystem	39✔
76	let enabled_lints () = opts.enabled_lints	234✔
77	let all_lints () = opts.all_lints	46✔
78	let outfile () = opts.outfile	×
79	let out_golint () = opts.outgolint	×
80	let out_rdjsonl () = opts.out_rdjsonl	37✔
81	let unset_check_filesystem () = opts.check_filesystem <- false	28✔
82	let verbose () = opts.verbose	284✔
83	let gen_replacements () = opts.gen_replacements	37✔
84	let set_verbose () = opts.verbose <- true	2✔
85	let set_skip_level_allow b = opts.skip_level_allow <- b	1✔
86
87	let recover_filepath filepath =
88	let filepath =	121✔
89	match prefix_to_cut () with
90	\| Some prefix when String.starts_with filepath ~prefix ->	121✔
91	Base.String.drop_prefix filepath (String.length prefix)	22✔
92	\| Some prefix when verbose () ->	99✔
93	Format.eprintf "Can't cut prefix '%s' from '%s'\n%!" prefix filepath;	×
94	filepath	×
95	\| Some _ \| None -> filepath	×
96	in
97	let filepath =
98	match prefix_to_add () with
99	\| Some s -> Printf.sprintf "%s%s" s filepath	×
100	\| None -> filepath	121✔
101	in
102	filepath
103	;;
104
105	let is_enabled () =
106	let hash = enabled_lints () in	114✔
107	fun (module M : LINT.GENERAL) ->	114✔
108	let ans =	1,596✔
109	match M.level with
110	\| LINT.Allow when opts.skip_level_allow -> false	56✔
111	\| _ -> Base.Hash_set.mem hash M.lint_id	1,540✔
112	in
113	(* Format.printf "is_enabled of %s = %b\n%!" M.lint_id ans; *)
114	ans
115	;;
116
117	let parse_args () =
118	let standard_args =	46✔
119	[ "-o", Arg.String set_out_file, "[FILE] Set Markdown output file"
120	; "-dump", Arg.Unit set_dump_text, "Dump info about available lints to terminal"
121	; ( "-dump-lints"
122	, Arg.String set_dump_file
123	, "[FILE] Dump information about available lints to JSON" )
124	; "-dir", Arg.String set_in_dir, "[FILE] Set root directory of dune project"
125	; ( "-unused-decls"
126	, Arg.String set_in_unused_decls
127	, "[FILE] Look for unused definitions" )
128	; "-ogolint", Arg.String set_out_golint, "Set output file in golint format"
129	; "-ordjsonl", Arg.String set_out_rdjsonl, "Set output file in rdjsonl format"
130	; ( "-del-prefix"
131	, Arg.String set_prefix_to_cut
132	, "Set prefix to cut from pathes in OUTPUT file" )
133	; ( "-add-prefix"
134	, Arg.String set_prefix_to_add
135	, "Set prefix to prepend to pathes in OUTPUT file" )
136	; "-I", Arg.String add_include, "Add extra include path for type checking"
137	; ( "-skip-level-allow"
138	, Arg.Bool set_skip_level_allow
139	, "[bool] Skip lints with level = Allow" )
140	; "-v", Arg.Unit set_verbose, "More verbose output"
141	; ( "-version"
142	, Arg.Unit
143	(fun () ->
144	let open Build_info.V1 in	×
145	Printf.printf
146	"version: %s\n"
147	(Option.fold ~none:"n/a" ~some:Version.to_string (version ())))	×
148	, " Print version" )
149	; ( "-diffs-with-fixes"
150	, Arg.Unit (fun () -> opts.gen_replacements <- true)	5✔
151	, " Do generate DIFFs with replacements" )
152	; "-fix", Arg.String set_fix, "Apply all found lints available for correction"
153	]
154	in
155	let extra_args =
156	Base.Hash_set.fold
157	~init:
158	[ ( "-no-check-filesystem"
159	, Arg.Unit unset_check_filesystem
160	, " Disable checking structure of a project" )
161	]
162	~f:(fun acc x ->
163	assert (x <> "");	1,472✔
164	( Printf.sprintf "-no-%s" x	1,472✔
165	, Arg.Unit (fun () -> Base.Hash_set.remove opts.enabled_lints x)	41✔
166	, " Disable checking for this lint" )
167	:: ( Printf.sprintf "-with-%s" x	1,472✔
168	, Arg.Unit (fun () -> Base.Hash_set.add opts.enabled_lints x)	1✔
169	, " Enable checking for this lint" )
170	:: acc)
171	opts.all_lints
172	\|> List.sort (fun (a, _, _) (b, _, _) -> String.compare a b)	46✔
173	in
174	Arg.parse	46✔
175	(standard_args @ extra_args)
176	set_in_file
177	"Use -dir [PATH] to check dune-based project"
178	;;

Kakadu / zanuda / 18

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