package zanuda

  1. Overview
  2. Docs
Linter for OCaml+dune projects

Install 

dune-project
 Dependency

github.com Readme Changelog Edit opam file Versions (4)

Authors

  1. K
    Kakadu

Maintainers

  1. K
    kakadu.hafanana@gmail.com

Sources

zanuda-2.1.0.tbz
sha256=9f6f5684ff7329cf84086e6239f02060e711c369fac1553a55e1cd53d8aa8234
sha512=d90e36fc67ba2f1adc13a964a39c46ec354201ea1ff400c5dfe5ab384e07edcc8d2ec42dc053cdc091e217c4183d97a2d33ac12d3977b65defbac506a0b3418e

doc/src/zanuda.core/Collected_lints.ml.html

Source file Collected_lints.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
[@@@ocaml.text "/*"]

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

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

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

type config = { mutable files_to_skip : string list }

let config = { files_to_skip = [] }

let process_switches = function
  | files ->
    config.files_to_skip <- Stdlib.String.split_on_char ',' files @ config.files_to_skip
;;

open Utils

include struct
  let found_Lints : (Location.t * (module LINT.REPORTER)) Queue.t = Queue.create ()
  let clear () = Queue.clear found_Lints
  let is_empty () = Queue.is_empty found_Lints

  let add ~loc m =
    if
      List.exists
        (fun prefix ->
          let fname = loc.Warnings.loc_start.Lexing.pos_fname in
          String.starts_with ~prefix fname
          || String.starts_with ~prefix:("_build/default/" ^ prefix) fname)
        config.files_to_skip
    then ()
    else Queue.add (loc, m) found_Lints
  ;;

  let loc_lints f = Queue.fold (fun acc x -> f x :: acc) [] found_Lints
end

let make_sarif_json results : Utils.json =
  let tool =
    `Assoc
      [ "driver", `Assoc [ "name", `String "zanuda"; "semanticVersion", `String "1.0.0" ]
      ]
  in
  `Assoc
    [ "version", `String "2.1.0"
    ; "runs", `List [ `Assoc [ "tool", tool; "results", `List results ] ]
    ]
;;

let report () =
  let touch filename = Unix.close (Unix.openfile filename [ Unix.O_CREAT ] 0o640) in
  let iter_lints =
    let arr = Queue.to_seq found_Lints |> Array.of_seq in
    let cmp : Location.t * _ -> _ -> _ = fun (a, _) (b, _) -> Stdlib.compare a b in
    Array.sort cmp arr;
    fun f ->
      if Array.length arr = 0
      then ()
      else (
        f arr.(0);
        for i = 1 to Array.length arr - 1 do
          if cmp arr.(i) arr.(i - 1) <> 0 then f arr.(i)
        done)
  in
  iter_lints (fun (_loc, (module M : LINT.REPORTER)) -> M.txt Format.std_formatter ());
  Format.pp_print_flush Format.std_formatter ();
  let maybe_report config f = config () |> Option.iter f in
  maybe_report Config.out_sarif (fun filename ->
    if String.equal filename Filename.null
    then ()
    else (
      let () = touch filename in
      let json =
        let jsons = ref [] in
        iter_lints (fun (_loc, (module M : LINT.REPORTER)) ->
          match M.sarif () with
          | None ->
            Format.eprintf
              "Sarif output is not implemented for something. Message is:\n%a"
              M.txt
              ();
            ()
          | Some j -> if M.is_valid () then jsons := j :: !jsons);
        make_sarif_json (List.rev !jsons)
      in
      Out_channel.with_open_text filename (fun ch ->
        Yojson.Safe.pretty_to_channel ch json)));
  maybe_report Config.out_rdjsonl (fun filename ->
    if String.equal filename Filename.null
    then ()
    else (
      let () = touch filename in
      Out_channel.with_open_text filename (fun ch ->
        let ppf = Format.formatter_of_out_channel ch in
        iter_lints (fun (_loc, (module M : LINT.REPORTER)) -> M.rdjsonl ppf ());
        Format.fprintf ppf "%!")))
;;

let tdecls : (Location.t, unit) Hashtbl.t = Hashtbl.create 123
let clear_tdecls () = Hashtbl.clear tdecls
let add_tdecl key = Hashtbl.add tdecls key ()
let has_tdecl_at key = Hashtbl.mem tdecls key