Merge pull request #511 from mbarbin/disable-deriving-warn-34-silenci…

…ng-bis

Add an -unused-type-warnings flag to the driver (bis)

CHANGES.md

@@ -14,6 +14,10 @@ details.
 
 ### Other changes
 
+- Add `-unused-type-warnings` flag to the driver to allow users to disable
+  only the generation of warning 34 silencing structure items when using
+  `[@@deriving ...]` on type declarations. (#511, @mbarbin, @NathanReb)
+
 - Make `-unused-code-warnings` flag to the driver also controls the generation
   of warning 34 silencing structure items when using `[@@deriving ...]` on type
   declarations. (#510, @mbarbin, @NathanReb)

doc/driver.mld

@@ -103,6 +103,8 @@ driver.exe [extra_args] [<files>]
                                Do not try to disable warning 60 for the generated code
   -unused-code-warnings {true|false|force}
                                Allow ppx derivers to enable unused code warnings (default: false)
+  -unused-type-warnings {true|false|force}
+                               Allow unused type warnings for types with [@@deriving ...] (default: false)
   -help                        Display this list of options
   --help                       Display this list of options
 

src/deriving.ml

@@ -63,13 +63,7 @@ let allow_unused_code_warnings = ref Options.default_allow_unused_code_warnings
 
 let () =
   Driver.add_arg "-unused-code-warnings"
-    (Symbol
-       ( [ "true"; "false"; "force" ],
-         function
-         | "true" -> allow_unused_code_warnings := True
-         | "false" -> allow_unused_code_warnings := False
-         | "force" -> allow_unused_code_warnings := Force
-         | _ -> assert false ))
+    (Options.Forcable_bool.arg allow_unused_code_warnings)
     ~doc:" Allow ppx derivers to enable unused code warnings (default: false)"
 
 let allow_unused_code_warnings ~ppx_allows_unused_code_warnings =
@@ -78,6 +72,21 @@ let allow_unused_code_warnings ~ppx_allows_unused_code_warnings =
   | False -> false
   | True -> ppx_allows_unused_code_warnings
 
+let allow_unused_type_warnings = ref Options.default_allow_unused_type_warnings
+
+let () =
+  Driver.add_arg "-unused-type-warnings"
+    (Options.Forcable_bool.arg allow_unused_type_warnings)
+    ~doc:
+      " Allow unused type warnings for types with [@@deriving ...] (default: \
+       false)"
+
+let allow_unused_type_warnings ~ppx_allows_unused_code_warnings =
+  match !allow_unused_type_warnings with
+  | Force -> true
+  | False -> false
+  | True -> ppx_allows_unused_code_warnings
+
 module Args = struct
   include (
     Ast_pattern :
@@ -712,13 +721,16 @@ let wrap_sig ~loc ~hide list =
    | Main expansion                                                  |
    +-----------------------------------------------------------------+ *)
 
-let types_used_by_deriving (tds : type_declaration list) ~unused_code_warnings :
-    structure_item list =
+let types_used_by_deriving (tds : type_declaration list)
+    ~unused_code_warnings:ppx_allows_unused_code_warnings : structure_item list
+    =
   let unused_code_warnings =
-    allow_unused_code_warnings
-      ~ppx_allows_unused_code_warnings:unused_code_warnings
+    allow_unused_code_warnings ~ppx_allows_unused_code_warnings
+  in
+  let unused_type_warnings =
+    allow_unused_type_warnings ~ppx_allows_unused_code_warnings
   in
-  if keep_w32_impl () || unused_code_warnings then []
+  if keep_w32_impl () || unused_code_warnings || unused_type_warnings then []
   else
     List.map tds ~f:(fun td ->
         let typ = Common.core_type_of_type_declaration td in

src/options.ml

@@ -1,8 +1,20 @@
 module Forcable_bool = struct
   type t = True | False | Force
+
+  let arg value =
+    Arg.Symbol
+      ( [ "true"; "false"; "force" ],
+        fun flag ->
+          value :=
+            match flag with
+            | "true" -> True
+            | "false" -> False
+            | "force" -> Force
+            | _ -> assert false )
 end
 
 let default_allow_unused_code_warnings : Forcable_bool.t = False
+let default_allow_unused_type_warnings : Forcable_bool.t = False
 let perform_checks = false
 
 (* The checks on extensions are only to get better error messages

test/deriving_warning/run.t

@@ -292,3 +292,99 @@ Same goes for .mli:
   type t = int[@@deriving alias_warn]
   include sig val unit_one : unit end[@@ocaml.doc "@inline"][@@merlin.hide ]
   include sig val unit_two : unit end[@@ocaml.doc "@inline"][@@merlin.hide ]
+
+--------------------------------------------------------------------------------
+
+Whenever a set of types has a [@@deriving ...] attached, ppxlib's driver always
+generates structure items meant to disable unused type warnings (warning 34) for
+any of those types.
+
+Let's consider the following piece of OCaml code:
+
+  $ cat > unused_types.ml << EOF
+  > type t = int
+  > and u = string
+  > [@@deriving zero_do_warn]
+  > EOF
+
+If we run the driver:
+
+  $ ./driver.exe -impl unused_types.ml
+  type t = int
+  and u = string[@@deriving zero_do_warn]
+  include struct let _ = fun (_ : t) -> ()
+                 let _ = fun (_ : u) -> () end[@@ocaml.doc "@inline"][@@merlin.hide
+                                                                      ]
+  include
+    struct
+      [@@@ocaml.warning "-60"]
+      module Zero = struct type t =
+                             | T0  end
+      let zero = Zero.T0
+      let _ = zero
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+
+We can see that the driver generated two `let _ = fun (_ : ...`, one for each type
+in the set.
+
+As we mentioned before, the driver flag (`-unused-code-warnings`) allows the
+user to disable all warnings. In addition to this more general flag, we have a
+flag that disables only this part, and allows unused type warnings to be reported
+properly. Passing that flag to the driver should remove the two previously
+mentioned items, without affecting the rest of the generated anti-warning items:
+
+  $ ./driver.exe -unused-type-warnings=true -impl unused_types.ml
+  type t = int
+  and u = string[@@deriving zero_do_warn]
+  include
+    struct
+      [@@@ocaml.warning "-60"]
+      module Zero = struct type t =
+                             | T0  end
+      let zero = Zero.T0
+      let _ = zero
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+
+Similarly to `-unused-code-warnings`, it is possible to force disabling the generation
+of this construct even when the ppx generator does not allow it.
+
+For example, consider:
+
+  $ ./driver.exe -impl one_no_warn.ml
+  type t = int[@@deriving one_no_warn]
+  include
+    struct
+      [@@@ocaml.warning "-60"]
+      let _ = fun (_ : t) -> ()
+      module One = struct type 'a t =
+                            | T1 of 'a  end
+      let one = One.T1 zero
+      let _ = one
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+
+See how `-unused-type-warnings=true` does not affect the generated code:
+
+  $ ./driver.exe -unused-type-warnings=true -impl one_no_warn.ml
+  type t = int[@@deriving one_no_warn]
+  include
+    struct
+      [@@@ocaml.warning "-60"]
+      let _ = fun (_ : t) -> ()
+      module One = struct type 'a t =
+                            | T1 of 'a  end
+      let one = One.T1 zero
+      let _ = one
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]
+
+But if we force it, the driver omits the `let _ = fun (_ : t) -> ()`:
+
+  $ ./driver.exe -unused-type-warnings=force -impl one_no_warn.ml
+  type t = int[@@deriving one_no_warn]
+  include
+    struct
+      [@@@ocaml.warning "-60"]
+      module One = struct type 'a t =
+                            | T1 of 'a  end
+      let one = One.T1 zero
+      let _ = one
+    end[@@ocaml.doc "@inline"][@@merlin.hide ]