mbarbin / dunolint / 150

Committed 24 May 2025 08:13AM UTC coverage: 92.441% (+0.8%) from 91.663%

Build # 150

Build Type

Pull #72

github

Committed by

web-flow

Commit Message

Merge 1b235f20b into cb9f8ab27

Pull Request Pull Request #72: Refactor enforce functions

Run Details

331 of 494 new or added lines in 26 files covered. (67.0%)

2 existing lines in 2 files now uncovered.

4121 of 4458 relevant lines covered (92.44%)

14.2 hits per line

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

64.86

/lib/dune_linter/src/executable.ml

(*********************************************************************************)
(*  Dunolint - A tool to lint and help manage files in dune projects             *)
(*  Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com>            *)
(*                                                                               *)
(*  This file is part of Dunolint.                                               *)
(*                                                                               *)
(*  Dunolint is free software; you can redistribute it and/or modify it          *)
(*  under the terms of the GNU Lesser General Public License as published by     *)
(*  the Free Software Foundation either version 3 of the License, or any later   *)
(*  version, with the LGPL-3.0 Linking Exception.                                *)
(*                                                                               *)
(*  Dunolint is distributed in the hope that it will be useful, but WITHOUT      *)
(*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or        *)
(*  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License  *)
(*  and the file `NOTICE.md` at the root of this repository for more details.    *)
(*                                                                               *)
(*  You should have received a copy of the GNU Lesser General Public License     *)
(*  and the LGPL-3.0 Linking Exception along with this library. If not, see      *)
(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.         *)
(*********************************************************************************)

module Name = Executable__name
module Public_name = Executable__public_name

let field_name = "executable"

module Field_name = struct
  module T0 = struct
    type t =
      [ `name
      | `public_name
      | `instrumentation
      | `lint
      | `preprocess
      ]
    [@@deriving compare, hash, sexp_of]
  end

  include T0
  include Comparable.Make (T0)
end

type t =
  { mutable name : Name.t option
  ; mutable public_name : Public_name.t option
  ; flags : Flags.t
  ; libraries : Libraries.t
  ; mutable instrumentation : Instrumentation.t option
  ; mutable lint : Lint.t option
  ; mutable preprocess : Preprocess.t option
  ; marked_for_removal : Hash_set.M(Field_name).t
  }
[@@deriving sexp_of]

let indicative_field_ordering =
  [ "name"
  ; "public_name"
  ; "package"
  ; "inline_tests"
  ; "flags"
  ; "libraries"
  ; "instrumentation"
  ; "lint"
  ; "preprocess"
  ]
;;

let normalize t = Libraries.dedup_and_sort t.libraries

let create
      ?name
      ?public_name
      ?(flags = [])
      ?(libraries = [])
      ?instrumentation
      ?lint
      ?preprocess
      ()
  =
  let name = Option.map name ~f:(fun name -> Name.create ~name) in
  let public_name =
    Option.map public_name ~f:(fun public_name -> Public_name.create ~public_name)
  in
  let flags = Flags.create ~flags in
  let libraries = Libraries.create ~libraries in
  let t =
    { name
    ; public_name
    ; flags
    ; libraries
    ; instrumentation
    ; lint
    ; preprocess
    ; marked_for_removal = Hash_set.create (module Field_name)
    }
  in
  normalize t;
  t
;;

let read ~sexps_rewriter ~field =
  let fields = Dunolinter.Sexp_handler.get_args ~field_name ~sexps_rewriter ~field in
  let name = ref None in
  let public_name = ref None in
  let flags = ref None in
  let libraries = ref None in
  let instrumentation = ref None in
  let lint = ref None in
  let preprocess = ref None in
  List.iter fields ~f:(fun field ->
    match (field : Sexp.t) with
    | List (Atom "name" :: _) -> name := Some (Name.read ~sexps_rewriter ~field)
    | List (Atom "public_name" :: _) ->
      public_name := Some (Public_name.read ~sexps_rewriter ~field)
    | List (Atom "flags" :: _) -> flags := Some (Flags.read ~sexps_rewriter ~field)
    | List (Atom "libraries" :: _) ->
      libraries := Some (Libraries.read ~sexps_rewriter ~field)
    | List (Atom "instrumentation" :: _) ->
      instrumentation := Some (Instrumentation.read ~sexps_rewriter ~field)
    | List (Atom "lint" :: _) -> lint := Some (Lint.read ~sexps_rewriter ~field)
    | List (Atom "preprocess" :: _) ->
      preprocess := Some (Preprocess.read ~sexps_rewriter ~field)
    | List _ | Atom _ -> ());
  let libraries =
    match !libraries with
    | Some libraries -> libraries
    | None -> Libraries.create ~libraries:[]
  in
  let flags =
    match !flags with
    | Some flags -> flags
    | None -> Flags.create ~flags:[]
  in
  { name = !name
  ; public_name = !public_name
  ; flags
  ; libraries
  ; instrumentation = !instrumentation
  ; lint = !lint
  ; preprocess = !preprocess
  ; marked_for_removal = Hash_set.create (module Field_name)
  }
;;

let write_fields
      ({ name
       ; public_name
       ; flags
       ; libraries
       ; instrumentation
       ; lint
       ; preprocess
       ; marked_for_removal = _
       } as t)
  =
  normalize t;
  List.filter_opt
    [ Option.map name ~f:Name.write
    ; Option.map public_name ~f:Public_name.write
    ; (if Flags.is_empty flags then None else Some (Flags.write flags))
    ; (if Libraries.is_empty libraries then None else Some (Libraries.write libraries))
    ; Option.map instrumentation ~f:Instrumentation.write
    ; Option.map lint ~f:Lint.write
    ; Option.map preprocess ~f:Preprocess.write
    ]
;;

let write t = Sexp.List (Atom field_name :: write_fields t)

let rewrite t ~sexps_rewriter ~field ~load_existing_libraries =
  let fields = Dunolinter.Sexp_handler.get_args ~field_name ~sexps_rewriter ~field in
  let () =
    if load_existing_libraries
    then (
      let existing_entries =
        Dunolinter.Sexp_handler.find (module Libraries) ~sexps_rewriter ~fields
        |> Option.value_map ~default:[] ~f:Libraries.entries
      in
      Libraries.add_entries t.libraries ~entries:existing_entries)
  in
  normalize t;
  let new_fields = write_fields t in
  (* First we insert all the missing fields. *)
  Dunolinter.Sexp_handler.insert_new_fields
    ~sexps_rewriter
    ~indicative_field_ordering
    ~fields
    ~new_fields;
  (* Then we edit them in place those that are present. *)
  let file_rewriter = Sexps_rewriter.file_rewriter sexps_rewriter in
  let maybe_remove state field_name field =
    if Option.is_none state && Hash_set.mem t.marked_for_removal field_name
    then (
      let range = Sexps_rewriter.range sexps_rewriter field in
      File_rewriter.remove file_rewriter ~range)
  in
  List.iter fields ~f:(fun field ->
    match (field : Sexp.t) with
    | List (Atom "name" :: _) ->
      Option.iter t.name ~f:(fun t -> Name.rewrite t ~sexps_rewriter ~field);
      maybe_remove t.name `name field
    | List (Atom "public_name" :: _) ->
      Option.iter t.public_name ~f:(fun t -> Public_name.rewrite t ~sexps_rewriter ~field);
      maybe_remove t.public_name `public_name field
    | List (Atom "flags" :: _) -> Flags.rewrite t.flags ~sexps_rewriter ~field
    | List (Atom "libraries" :: _) -> Libraries.rewrite t.libraries ~sexps_rewriter ~field
    | List (Atom "instrumentation" :: _) ->
      Option.iter t.instrumentation ~f:(fun t ->
        Instrumentation.rewrite t ~sexps_rewriter ~field);
      maybe_remove t.instrumentation `instrumentation field
    | List (Atom "lint" :: _) ->
      Option.iter t.lint ~f:(fun t -> Lint.rewrite t ~sexps_rewriter ~field);
      maybe_remove t.lint `lint field
    | List (Atom "preprocess" :: _) ->
      Option.iter t.preprocess ~f:(fun t -> Preprocess.rewrite t ~sexps_rewriter ~field);
      maybe_remove t.preprocess `preprocess field
    | _ -> ())
;;

type predicate = Dune.Executable.Predicate.t

let eval t ~predicate =
  match (predicate : predicate) with
  | `name condition ->
    (match t.name with
     | None -> Dunolint.Trilang.Undefined
     | Some name ->
       Dunolint.Trilang.eval condition ~f:(fun predicate -> Name.eval name ~predicate))
  | `public_name condition ->
    (match t.public_name with
     | None -> Dunolint.Trilang.Undefined
     | Some public_name ->
       Dunolint.Trilang.eval condition ~f:(fun predicate ->
         Public_name.eval public_name ~predicate))
  | `instrumentation condition ->
    (match t.instrumentation with
     | None -> Dunolint.Trilang.Undefined
     | Some instrumentation ->
       Dunolint.Trilang.eval condition ~f:(fun predicate ->
         Instrumentation.eval instrumentation ~predicate))
  | `lint condition ->
    (match t.lint with
     | None -> Dunolint.Trilang.Undefined
     | Some lint ->
       Dunolint.Trilang.eval condition ~f:(fun predicate -> Lint.eval lint ~predicate))
  | `preprocess condition ->
    (match t.preprocess with
     | None -> Dunolint.Trilang.Undefined
     | Some preprocess ->
       Dunolint.Trilang.eval condition ~f:(fun predicate ->
         Preprocess.eval preprocess ~predicate))
  | `has_field field ->
    (match field with
     | `name -> Option.is_some t.name
     | `public_name -> Option.is_some t.public_name
     | `lint -> Option.is_some t.lint
     | `instrumentation -> Option.is_some t.instrumentation
     | `preprocess -> Option.is_some t.preprocess)
    |> Dunolint.Trilang.const
;;

let enforce =
  Dunolinter.Linter.enforce
    (module Dune.Executable.Predicate)
    ~eval
    ~enforce:(fun t predicate ->
      match predicate with
      | Not (`instrumentation _ | `public_name _ | `preprocess _ | `name _ | `lint _) ->
        Eval
      | T (`has_field `name) ->
        (match t.name with
         | Some _ -> Ok
         | None -> Fail)
      | Not (`has_field (`name as to_mark)) ->
        Hash_set.add t.marked_for_removal to_mark;
        t.name <- None;
        Ok
      | T (`name condition) ->
        (match t.name with
         | Some name ->
           Name.enforce name ~condition;
           Ok
         | None ->
           (match
              List.find_map
                (Dunolinter.Linter.at_positive_enforcing_position condition)
                ~f:(function
                | `equals name -> Some name
                | `is_prefix _ | `is_suffix _ -> None)
            with
            | None -> Eval
            | Some name ->
              let name = Name.create ~name in
              t.name <- Some name;
              Name.enforce name ~condition;
              Ok))
      | T (`has_field `public_name) ->
        (match t.public_name with
         | Some _ -> Ok
         | None -> Fail)
      | Not (`has_field (`public_name as to_mark)) ->
        Hash_set.add t.marked_for_removal to_mark;
        t.public_name <- None;
        Ok
      | T (`public_name condition) ->
        (match t.public_name with
         | Some public_name ->
           Public_name.enforce public_name ~condition;
           Ok
         | None ->
           (match
              List.find_map
                (Dunolinter.Linter.at_positive_enforcing_position condition)
                ~f:(function
                | `equals public_name -> Some public_name
                | `is_prefix _ | `is_suffix _ -> None)
            with
            | None -> Eval
            | Some public_name ->
              let public_name = Public_name.create ~public_name in
              t.public_name <- Some public_name;
              Public_name.enforce public_name ~condition;
              Ok))
      | T (`has_field `instrumentation) ->
        (match t.instrumentation with
         | Some _ -> Ok
         | None ->
           t.instrumentation <- Some (Instrumentation.initialize ~condition:Blang.true_);
           Ok)
      | Not (`has_field (`instrumentation as to_mark)) ->
        Hash_set.add t.marked_for_removal to_mark;
        t.instrumentation <- None;
        Ok
      | T (`instrumentation condition) ->
        let instrumentation =
          match t.instrumentation with
          | Some instrumentation -> instrumentation
          | None ->
            let instrumentation = Instrumentation.initialize ~condition in
            t.instrumentation <- Some instrumentation;
            instrumentation
        in
        Instrumentation.enforce instrumentation ~condition;
        Ok
      | T (`has_field `lint) ->
        (match t.lint with
         | Some _ -> Ok
         | None ->
           t.lint <- Some (Lint.create ());
           Ok)
      | Not (`has_field (`lint as to_mark)) ->
        Hash_set.add t.marked_for_removal to_mark;
        t.lint <- None;
        Ok
      | T (`lint condition) ->
        let lint =
          match t.lint with
          | Some lint -> lint
          | None ->
            let lint = Lint.create () in
            t.lint <- Some lint;
            lint
        in
        Lint.enforce lint ~condition;
        Ok
      | T (`has_field `preprocess) ->
        (match t.preprocess with
         | Some _ -> Ok
         | None ->
           t.preprocess <- Some (Preprocess.create ());
           Ok)
      | Not (`has_field (`preprocess as to_mark)) ->
        Hash_set.add t.marked_for_removal to_mark;
        t.preprocess <- None;
        Ok
      | T (`preprocess condition) ->
        let preprocess =
          match t.preprocess with
          | Some preprocess -> preprocess
          | None ->
            let preprocess = Preprocess.create () in
            t.preprocess <- Some preprocess;
            preprocess
        in
        Preprocess.enforce preprocess ~condition;
        Ok)
;;

module Top = struct
  type nonrec t = t

  let eval = eval
  let enforce = enforce
end

module Linter = struct
  type t = Top.t
  type predicate = Dune.Predicate.t

  let eval (t : t) ~predicate =
    match (predicate : Dune.Predicate.t) with
    | `stanza stanza ->
      Blang.eval stanza (fun stanza ->
        match stanza with
        | `executable -> true
        | `include_subdirs | `library | `executables -> false)
      |> Dunolint.Trilang.const
    | `include_subdirs _ | `library _ -> Dunolint.Trilang.Undefined
    | `executable condition ->
      Dunolint.Trilang.eval condition ~f:(fun predicate -> Top.eval t ~predicate)
    | (`instrumentation _ | `lint _ | `preprocess _ | `has_field _) as predicate ->
      Top.eval t ~predicate
  ;;

  let enforce =
    Dunolinter.Linter.enforce
      (module Dune.Predicate)
      ~eval
      ~enforce:(fun t predicate ->
        match predicate with
        | Not _ -> Eval
        | T (`include_subdirs _ | `library _ | `stanza _) -> Unapplicable
        | T (`executable condition) ->
          Top.enforce t ~condition;
          Ok
        | T ((`instrumentation _ | `lint _ | `preprocess _ | `has_field _) as predicate)
          ->
          Top.enforce t ~condition:(Blang.base predicate);
          Ok)
  ;;
end

module Private = struct
  let rewrite = rewrite
end

let rewrite t ~sexps_rewriter ~field =
  rewrite t ~sexps_rewriter ~field ~load_existing_libraries:false
;;

1	(*********************************************************************************)
2	(* Dunolint - A tool to lint and help manage files in dune projects *)
3	(* Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com> *)
4	(* *)
5	(* This file is part of Dunolint. *)
6	(* *)
7	(* Dunolint is free software; you can redistribute it and/or modify it *)
8	(* under the terms of the GNU Lesser General Public License as published by *)
9	(* the Free Software Foundation either version 3 of the License, or any later *)
10	(* version, with the LGPL-3.0 Linking Exception. *)
11	(* *)
12	(* Dunolint is distributed in the hope that it will be useful, but WITHOUT *)
13	(* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or *)
14	(* FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License *)
15	(* and the file `NOTICE.md` at the root of this repository for more details. *)
16	(* *)
17	(* You should have received a copy of the GNU Lesser General Public License *)
18	(* and the LGPL-3.0 Linking Exception along with this library. If not, see *)
19	(* <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively. *)
20	(*********************************************************************************)
21
22	module Name = Executable__name
23	module Public_name = Executable__public_name
24
25	let field_name = "executable"
26
27	module Field_name = struct
28	module T0 = struct
29	type t =	21✔
30	[ `name
31	\| `public_name
32	\| `instrumentation
33	\| `lint
34	\| `preprocess
35	]
36	[@@deriving compare, hash, sexp_of]
37	end
38
39	include T0
40	include Comparable.Make (T0)
41	end
42
43	type t =	1✔
44	{ mutable name : Name.t option	1✔
45	; mutable public_name : Public_name.t option	1✔
46	; flags : Flags.t	1✔
47	; libraries : Libraries.t	1✔
48	; mutable instrumentation : Instrumentation.t option	1✔
49	; mutable lint : Lint.t option	1✔
50	; mutable preprocess : Preprocess.t option	1✔
51	; marked_for_removal : Hash_set.M(Field_name).t	1✔
52	}
53	[@@deriving sexp_of]
54
55	let indicative_field_ordering =
56	[ "name"
57	; "public_name"
58	; "package"
59	; "inline_tests"
60	; "flags"
61	; "libraries"
62	; "instrumentation"
63	; "lint"
64	; "preprocess"
65	]
66	;;
67
68	let normalize t = Libraries.dedup_and_sort t.libraries	41✔
69
70	let create
71	?name
72	?public_name
73	?(flags = [])	3✔
74	?(libraries = [])	1✔
75	?instrumentation
76	?lint
77	?preprocess
78	()
79	=
80	let name = Option.map name ~f:(fun name -> Name.create ~name) in	1✔
81	let public_name =	3✔
82	Option.map public_name ~f:(fun public_name -> Public_name.create ~public_name)	2✔
83	in
84	let flags = Flags.create ~flags in	3✔
85	let libraries = Libraries.create ~libraries in
86	let t =
87	{ name
88	; public_name
89	; flags
90	; libraries
91	; instrumentation
92	; lint
93	; preprocess
94	; marked_for_removal = Hash_set.create (module Field_name)	3✔
95	}
96	in
97	normalize t;
98	t	3✔
99	;;
100
101	let read ~sexps_rewriter ~field =
102	let fields = Dunolinter.Sexp_handler.get_args ~field_name ~sexps_rewriter ~field in	22✔
103	let name = ref None in
104	let public_name = ref None in
105	let flags = ref None in
106	let libraries = ref None in
107	let instrumentation = ref None in
108	let lint = ref None in
109	let preprocess = ref None in
110	List.iter fields ~f:(fun field ->
111	match (field : Sexp.t) with	44✔
112	\| List (Atom "name" :: _) -> name := Some (Name.read ~sexps_rewriter ~field)	16✔
113	\| List (Atom "public_name" :: _) ->	6✔
114	public_name := Some (Public_name.read ~sexps_rewriter ~field)
115	\| List (Atom "flags" :: _) -> flags := Some (Flags.read ~sexps_rewriter ~field)	2✔
116	\| List (Atom "libraries" :: _) ->	2✔
117	libraries := Some (Libraries.read ~sexps_rewriter ~field)
118	\| List (Atom "instrumentation" :: _) ->	4✔
119	instrumentation := Some (Instrumentation.read ~sexps_rewriter ~field)
120	\| List (Atom "lint" :: _) -> lint := Some (Lint.read ~sexps_rewriter ~field)	4✔
121	\| List (Atom "preprocess" :: _) ->	4✔
122	preprocess := Some (Preprocess.read ~sexps_rewriter ~field)
123	\| List _ \| Atom _ -> ());	2✔
124	let libraries =	20✔
125	match !libraries with
126	\| Some libraries -> libraries	2✔
127	\| None -> Libraries.create ~libraries:[]	18✔
128	in
129	let flags =
130	match !flags with
131	\| Some flags -> flags	2✔
132	\| None -> Flags.create ~flags:[]	18✔
133	in
134	{ name = !name
135	; public_name = !public_name
136	; flags
137	; libraries
138	; instrumentation = !instrumentation
139	; lint = !lint
140	; preprocess = !preprocess
141	; marked_for_removal = Hash_set.create (module Field_name)	20✔
142	}
143	;;
144
145	let write_fields
146	({ name
147	; public_name
148	; flags
149	; libraries
150	; instrumentation
151	; lint
152	; preprocess
153	; marked_for_removal = _
154	} as t)
155	=
156	normalize t;	21✔
157	List.filter_opt	21✔
158	[ Option.map name ~f:Name.write	21✔
159	; Option.map public_name ~f:Public_name.write	21✔
160	; (if Flags.is_empty flags then None else Some (Flags.write flags))	2✔
161	; (if Libraries.is_empty libraries then None else Some (Libraries.write libraries))	5✔
162	; Option.map instrumentation ~f:Instrumentation.write	21✔
163	; Option.map lint ~f:Lint.write	21✔
164	; Option.map preprocess ~f:Preprocess.write	21✔
165	]
166	;;
167
168	let write t = Sexp.List (Atom field_name :: write_fields t)	4✔
169
170	let rewrite t ~sexps_rewriter ~field ~load_existing_libraries =
171	let fields = Dunolinter.Sexp_handler.get_args ~field_name ~sexps_rewriter ~field in	17✔
172	let () =
173	if load_existing_libraries
174	then (	1✔
175	let existing_entries =
176	Dunolinter.Sexp_handler.find (module Libraries) ~sexps_rewriter ~fields
177	\|> Option.value_map ~default:[] ~f:Libraries.entries	1✔
178	in
179	Libraries.add_entries t.libraries ~entries:existing_entries)	1✔
180	in
181	normalize t;
182	let new_fields = write_fields t in	17✔
183	(* First we insert all the missing fields. *)
184	Dunolinter.Sexp_handler.insert_new_fields	17✔
185	~sexps_rewriter
186	~indicative_field_ordering
187	~fields
188	~new_fields;
189	(* Then we edit them in place those that are present. *)
190	let file_rewriter = Sexps_rewriter.file_rewriter sexps_rewriter in
191	let maybe_remove state field_name field =	17✔
192	if Option.is_none state && Hash_set.mem t.marked_for_removal field_name	4✔
193	then (	2✔
194	let range = Sexps_rewriter.range sexps_rewriter field in
195	File_rewriter.remove file_rewriter ~range)	2✔
196	in
197	List.iter fields ~f:(fun field ->
198	match (field : Sexp.t) with	31✔
199	\| List (Atom "name" :: _) ->	15✔
200	Option.iter t.name ~f:(fun t -> Name.rewrite t ~sexps_rewriter ~field);	13✔
201	maybe_remove t.name `name field	15✔
202	\| List (Atom "public_name" :: _) ->	2✔
203	Option.iter t.public_name ~f:(fun t -> Public_name.rewrite t ~sexps_rewriter ~field);	2✔
204	maybe_remove t.public_name `public_name field	2✔
205	\| List (Atom "flags" :: _) -> Flags.rewrite t.flags ~sexps_rewriter ~field	1✔
206	\| List (Atom "libraries" :: _) -> Libraries.rewrite t.libraries ~sexps_rewriter ~field	4✔
207	\| List (Atom "instrumentation" :: _) ->	2✔
208	Option.iter t.instrumentation ~f:(fun t ->
209	Instrumentation.rewrite t ~sexps_rewriter ~field);	1✔
210	maybe_remove t.instrumentation `instrumentation field	2✔
211	\| List (Atom "lint" :: _) ->	2✔
212	Option.iter t.lint ~f:(fun t -> Lint.rewrite t ~sexps_rewriter ~field);	2✔
213	maybe_remove t.lint `lint field	2✔
214	\| List (Atom "preprocess" :: _) ->	2✔
215	Option.iter t.preprocess ~f:(fun t -> Preprocess.rewrite t ~sexps_rewriter ~field);	1✔
216	maybe_remove t.preprocess `preprocess field	2✔
217	\| _ -> ())	3✔
218	;;
219
220	type predicate = Dune.Executable.Predicate.t
221
222	let eval t ~predicate =
223	match (predicate : predicate) with	20✔
224	\| `name condition ->	3✔
225	(match t.name with
226	\| None -> Dunolint.Trilang.Undefined	1✔
227	\| Some name ->	2✔
228	Dunolint.Trilang.eval condition ~f:(fun predicate -> Name.eval name ~predicate))	2✔
229	\| `public_name condition ->	4✔
230	(match t.public_name with
231	\| None -> Dunolint.Trilang.Undefined	2✔
232	\| Some public_name ->	2✔
233	Dunolint.Trilang.eval condition ~f:(fun predicate ->
234	Public_name.eval public_name ~predicate))	2✔
235	\| `instrumentation condition ->	2✔
236	(match t.instrumentation with
237	\| None -> Dunolint.Trilang.Undefined	1✔
238	\| Some instrumentation ->	1✔
239	Dunolint.Trilang.eval condition ~f:(fun predicate ->
240	Instrumentation.eval instrumentation ~predicate))	1✔
241	\| `lint condition ->	3✔
242	(match t.lint with
243	\| None -> Dunolint.Trilang.Undefined	1✔
244	\| Some lint ->	2✔
245	Dunolint.Trilang.eval condition ~f:(fun predicate -> Lint.eval lint ~predicate))	2✔
246	\| `preprocess condition ->	2✔
247	(match t.preprocess with
248	\| None -> Dunolint.Trilang.Undefined	1✔
249	\| Some preprocess ->	1✔
250	Dunolint.Trilang.eval condition ~f:(fun predicate ->
251	Preprocess.eval preprocess ~predicate))	1✔
252	\| `has_field field ->	6✔
253	(match field with
254	\| `name -> Option.is_some t.name	1✔
255	\| `public_name -> Option.is_some t.public_name	1✔
256	\| `lint -> Option.is_some t.lint	1✔
257	\| `instrumentation -> Option.is_some t.instrumentation	2✔
258	\| `preprocess -> Option.is_some t.preprocess)	1✔
259	\|> Dunolint.Trilang.const
260	;;
261
262	let enforce =
263	Dunolinter.Linter.enforce	90✔
264	(module Dune.Executable.Predicate)
265	~eval
266	~enforce:(fun t predicate ->
267	match predicate with	8✔
NEW 268	\| Not (`instrumentation _ \| `public_name _ \| `preprocess _ \| `name _ \| `lint _) ->	×
269	Eval
NEW 270	\| T (`has_field `name) ->	×
271	(match t.name with
NEW 272	\| Some _ -> Ok	×
NEW 273	\| None -> Fail)	×
NEW 274	\| Not (`has_field (`name as to_mark)) ->	×
275	Hash_set.add t.marked_for_removal to_mark;
NEW 276	t.name <- None;	×
277	Ok
278	\| T (`name condition) ->	4✔
279	(match t.name with
280	\| Some name ->	4✔
281	Name.enforce name ~condition;
282	Ok	3✔
NEW 283	\| None ->	×
284	(match
285	List.find_map
NEW 286	(Dunolinter.Linter.at_positive_enforcing_position condition)	×
287	~f:(function
NEW 288	\| `equals name -> Some name	×
NEW 289	\| `is_prefix _ \| `is_suffix _ -> None)	×
290	with
NEW 291	\| None -> Eval	×
NEW 292	\| Some name ->	×
293	let name = Name.create ~name in
294	t.name <- Some name;
295	Name.enforce name ~condition;
NEW 296	Ok))	×
NEW 297	\| T (`has_field `public_name) ->	×
298	(match t.public_name with
NEW 299	\| Some _ -> Ok	×
NEW 300	\| None -> Fail)	×
NEW 301	\| Not (`has_field (`public_name as to_mark)) ->	×
302	Hash_set.add t.marked_for_removal to_mark;
NEW 303	t.public_name <- None;	×
304	Ok
305	\| T (`public_name condition) ->	2✔
306	(match t.public_name with
NEW 307	\| Some public_name ->	×
308	Public_name.enforce public_name ~condition;
NEW 309	Ok	×
310	\| None ->	2✔
311	(match
312	List.find_map
313	(Dunolinter.Linter.at_positive_enforcing_position condition)	2✔
314	~f:(function
315	\| `equals public_name -> Some public_name	1✔
NEW 316	\| `is_prefix _ \| `is_suffix _ -> None)	×
317	with
318	\| None -> Eval	1✔
319	\| Some public_name ->	1✔
320	let public_name = Public_name.create ~public_name in
321	t.public_name <- Some public_name;
322	Public_name.enforce public_name ~condition;
323	Ok))	1✔
NEW 324	\| T (`has_field `instrumentation) ->	×
325	(match t.instrumentation with
NEW 326	\| Some _ -> Ok	×
NEW 327	\| None ->	×
328	t.instrumentation <- Some (Instrumentation.initialize ~condition:Blang.true_);
329	Ok)
330	\| Not (`has_field (`instrumentation as to_mark)) ->	1✔
331	Hash_set.add t.marked_for_removal to_mark;
332	t.instrumentation <- None;	1✔
333	Ok
NEW 334	\| T (`instrumentation condition) ->	×
335	let instrumentation =
336	match t.instrumentation with
NEW 337	\| Some instrumentation -> instrumentation	×
NEW 338	\| None ->	×
339	let instrumentation = Instrumentation.initialize ~condition in
340	t.instrumentation <- Some instrumentation;
341	instrumentation
342	in
343	Instrumentation.enforce instrumentation ~condition;
NEW 344	Ok	×
NEW 345	\| T (`has_field `lint) ->	×
346	(match t.lint with
NEW 347	\| Some _ -> Ok	×
NEW 348	\| None ->	×
NEW 349	t.lint <- Some (Lint.create ());	×
350	Ok)
NEW 351	\| Not (`has_field (`lint as to_mark)) ->	×
352	Hash_set.add t.marked_for_removal to_mark;
NEW 353	t.lint <- None;	×
354	Ok
NEW 355	\| T (`lint condition) ->	×
356	let lint =
357	match t.lint with
NEW 358	\| Some lint -> lint	×
NEW 359	\| None ->	×
360	let lint = Lint.create () in
NEW 361	t.lint <- Some lint;	×
362	lint
363	in
364	Lint.enforce lint ~condition;
NEW 365	Ok	×
NEW 366	\| T (`has_field `preprocess) ->	×
367	(match t.preprocess with
NEW 368	\| Some _ -> Ok	×
NEW 369	\| None ->	×
NEW 370	t.preprocess <- Some (Preprocess.create ());	×
371	Ok)
372	\| Not (`has_field (`preprocess as to_mark)) ->	1✔
373	Hash_set.add t.marked_for_removal to_mark;
374	t.preprocess <- None;	1✔
375	Ok
NEW 376	\| T (`preprocess condition) ->	×
377	let preprocess =
378	match t.preprocess with
NEW 379	\| Some preprocess -> preprocess	×
NEW 380	\| None ->	×
381	let preprocess = Preprocess.create () in
NEW 382	t.preprocess <- Some preprocess;	×
383	preprocess
384	in
385	Preprocess.enforce preprocess ~condition;
NEW 386	Ok)	×
387	;;
388
389	module Top = struct
390	type nonrec t = t
391
392	let eval = eval
393	let enforce = enforce
394	end
395
396	module Linter = struct
397	type t = Top.t
398	type predicate = Dune.Predicate.t
399
400	let eval (t : t) ~predicate =
401	match (predicate : Dune.Predicate.t) with	1✔
402	\| `stanza stanza ->	×
403	Blang.eval stanza (fun stanza ->
404	match stanza with	×
405	\| `executable -> true	×
406	\| `include_subdirs \| `library \| `executables -> false)	×
407	\|> Dunolint.Trilang.const	×
408	\| `include_subdirs _ \| `library _ -> Dunolint.Trilang.Undefined	×
409	\| `executable condition ->	×
410	Dunolint.Trilang.eval condition ~f:(fun predicate -> Top.eval t ~predicate)	×
411	\| (`instrumentation _ \| `lint _ \| `preprocess _ \| `has_field _) as predicate ->	×
412	Top.eval t ~predicate
413	;;
414
415	let enforce =
416	Dunolinter.Linter.enforce	90✔
417	(module Dune.Predicate)
418	~eval
419	~enforce:(fun t predicate ->
NEW 420	match predicate with	×
NEW 421	\| Not _ -> Eval	×
NEW 422	\| T (`include_subdirs _ \| `library _ \| `stanza _) -> Unapplicable	×
NEW 423	\| T (`executable condition) ->	×
424	Top.enforce t ~condition;
NEW 425	Ok	×
NEW 426	\| T ((`instrumentation _ \| `lint _ \| `preprocess _ \| `has_field _) as predicate)	×
427	->
NEW 428	Top.enforce t ~condition:(Blang.base predicate);	×
NEW 429	Ok)	×
430	;;
431	end
432
433	module Private = struct
434	let rewrite = rewrite
435	end
436
437	let rewrite t ~sexps_rewriter ~field =
438	rewrite t ~sexps_rewriter ~field ~load_existing_libraries:false	15✔
439	;;

mbarbin / dunolint / 150

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