Replace --supress-warnings logic with --warnings-tag

CHANGES.md

@@ -5,14 +5,14 @@
 - Drop support for OCaml < 4.08 (@jonludlam, #1300)
 - Added suport for overriding tmp directories in odoc_driver_monorepo
   (@jonludlam, #1304)
+- Remove `--suppress-warnings` argument in favour of `--warnings-tag`
+  which is more friendly for caching and voodoo (@jonludlam, #1304)
 
 ### Fixed
 
 - Fix bug causing stack overflow in odoc_driver_monorepo (@jonludlam, #1304)
-
-### Fixed
-
-- Fix incomplete handling of `--suppress-warnings` (@jonludlam, #1304)
+- Fix incomplete handling of `--suppress-warnings` (now `--warnings-tag`)
+  (@jonludlam, #1304)
 
 # 3.0.0~beta1
 

src/driver/bin/odoc_driver.ml

@@ -71,7 +71,7 @@ let run_inner ~odoc_dir ~odocl_dir ~index_dir ~mld_dir ~compile_grep ~link_grep
         in
         Compile.init_stats units;
         let compiled = Compile.compile ~partial_dir:odoc_dir units in
-        let linked = Compile.link ~custom_layout:false compiled in
+        let linked = Compile.link ~warnings_tags:packages ~custom_layout:false compiled in
         let occurrence_file =
           let output =
             Fpath.( / ) odoc_dir "occurrences-all.odoc-occurrences"

src/driver/bin/odoc_driver_monorepo.ml

@@ -49,7 +49,7 @@ let real_run ~odoc_dir ~odocl_dir ~index_dir ~mld_dir path extra_pkgs extra_libs
         in
         Compile.init_stats units;
         let compiled = Compile.compile ~partial_dir:odoc_dir units in
-        let linked = Compile.link ~custom_layout:true compiled in
+        let linked = Compile.link ~warnings_tags:[] ~custom_layout:true compiled in
         let occurrence_file =
           let output =
             Fpath.( / ) odoc_dir "occurrences-all.odoc-occurrences"

src/driver/bin/odoc_driver_voodoo.ml

@@ -89,7 +89,7 @@ let run package_name blessed actions odoc_dir odocl_dir
     match actions with
     | CompileOnly -> ()
     | LinkAndGen | All ->
-        let linked = Compile.link ~custom_layout:false compiled in
+        let linked = Compile.link ~warnings_tags:[package_name] ~custom_layout:false compiled in
         let occurrence_file =
           let output =
             Fpath.( / ) odoc_dir "occurrences-all.odoc-occurrences"

src/driver/compile.ml

@@ -138,7 +138,7 @@ let compile ?partial ~partial_dir (all : Odoc_unit.any list) =
           (Odoc_unit.Pkg_args.compiled_libs unit.pkg_args)
       in
       Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
-        ~includes ~suppress_warnings:(not unit.enable_warnings)
+        ~includes ~warnings_tag:unit.pkgname
         ~parent_id:unit.parent_id;
       (match unit.input_copy with
       | None -> ()
@@ -198,7 +198,7 @@ let compile ?partial ~partial_dir (all : Odoc_unit.any list) =
     | `Mld ->
         let includes = Fpath.Set.empty in
         Odoc.compile ~output_dir:unit.output_dir ~input_file:unit.input_file
-          ~includes ~suppress_warnings:false ~parent_id:unit.parent_id;
+          ~includes ~warnings_tag:None ~parent_id:unit.parent_id;
         Atomic.incr Stats.stats.compiled_mlds;
         Ok [ unit ]
     | `Md ->
@@ -216,16 +216,16 @@ let compile ?partial ~partial_dir (all : Odoc_unit.any list) =
 
 type linked = Odoc_unit.any
 
-let link : custom_layout:bool -> compiled list -> _ =
- fun ~custom_layout compiled ->
+let link : warnings_tags:string list -> custom_layout:bool -> compiled list -> _ =
+ fun ~warnings_tags ~custom_layout compiled ->
   let link : compiled -> linked =
    fun c ->
     let link input_file output_file enable_warnings =
       let libs = Odoc_unit.Pkg_args.compiled_libs c.pkg_args in
       let pages = Odoc_unit.Pkg_args.compiled_pages c.pkg_args in
       let includes = Odoc_unit.Pkg_args.includes c.pkg_args in
       Odoc.link ~custom_layout ~input_file ~output_file ~libs ~docs:pages
-        ~includes ~ignore_output:(not enable_warnings)
+        ~includes ~ignore_output:(not enable_warnings) ~warnings_tags
         ?current_package:c.pkgname ()
     in
     match c.kind with

src/driver/compile.mli

@@ -12,7 +12,7 @@ val compile :
 
 type linked
 
-val link : custom_layout:bool -> compiled list -> linked list
+val link : warnings_tags:string list -> custom_layout:bool -> compiled list -> linked list
 
 val html_generate :
   occurrence_file:Fpath.t ->

src/driver/odoc.ml

@@ -36,7 +36,7 @@ let compile_deps f =
   | [ (_, digest) ], deps -> Ok { digest; deps }
   | _ -> Error (`Msg "odd")
 
-let compile ~output_dir ~input_file:file ~includes ~suppress_warnings ~parent_id
+let compile ~output_dir ~input_file:file ~includes ~warnings_tag ~parent_id
     =
   let open Cmd in
   let includes =
@@ -54,7 +54,7 @@ let compile ~output_dir ~input_file:file ~includes ~suppress_warnings ~parent_id
     %% includes % "--enable-missing-root-warning"
   in
   let cmd = cmd % "--parent-id" % Id.to_string parent_id in
-  let cmd = if suppress_warnings then cmd % "--suppress-warnings" else cmd in
+  let cmd = match warnings_tag with None -> cmd | Some tag -> cmd % "--warnings-tag" % tag in
   let desc = Printf.sprintf "Compiling %s" (Fpath.to_string file) in
   ignore
   @@ Cmd_outputs.submit
@@ -138,7 +138,7 @@ let lib_args libs =
     Cmd.empty libs
 
 let link ?(ignore_output = false) ~custom_layout ~input_file:file ?output_file
-    ~docs ~libs ~includes ?current_package () =
+    ~docs ~libs ~includes ~warnings_tags ?current_package () =
   let open Cmd in
   let output_file =
     match output_file with Some f -> f | None -> Fpath.set_ext "odocl" file
@@ -160,6 +160,9 @@ let link ?(ignore_output = false) ~custom_layout ~input_file:file ?output_file
   let cmd =
     if Fpath.to_string file = "stdlib.odoc" then cmd % "--open=\"\"" else cmd
   in
+  let cmd =
+    List.fold_left (fun acc k -> acc % "--warnings-tags" % k) cmd
+      warnings_tags in
   let desc = Printf.sprintf "Linking %s" (Fpath.to_string file) in
   let cmd = if custom_layout then cmd % "--custom-layout" else cmd in
   let log =

src/driver/odoc.mli

@@ -25,7 +25,7 @@ val compile :
   output_dir:Fpath.t ->
   input_file:Fpath.t ->
   includes:Fpath.set ->
-  suppress_warnings:bool ->
+  warnings_tag:string option ->
   parent_id:Id.t ->
   unit
 val compile_md :
@@ -41,6 +41,7 @@ val link :
   docs:(string * Fpath.t) list ->
   libs:(string * Fpath.t) list ->
   includes:Fpath.t list ->
+  warnings_tags:string list ->
   ?current_package:string ->
   unit ->
   unit

src/loader/cmi.ml

@@ -28,10 +28,10 @@ module Paths = Odoc_model.Paths
 
 type env = {
   ident_env : Env.t;
-  suppress_warnings : bool;  (** suppress warnings *)
+  warnings_tag : string option;  (** used to suppress warnings *)
 }
 
-let empty_doc env = { Odoc_model.Comment.elements = []; suppress_warnings = env.suppress_warnings }
+let empty_doc env = { Odoc_model.Comment.elements = []; warnings_tag = env.warnings_tag }
 
 module Compat = struct
 #if OCAML_VERSION >= (4, 14, 0)
@@ -619,14 +619,14 @@ and read_object env fi nm =
     | _ -> assert false
   end
 
-let read_value_description ({ident_env ; suppress_warnings} as env) parent id vd =
+let read_value_description ({ident_env ; warnings_tag} as env) parent id vd =
   let open Signature in
   let id = Env.find_value_identifier ident_env id in
   let source_loc = None in
   let container =
     (parent : Identifier.Signature.t :> Identifier.LabelParent.t)
   in
-  let doc = Doc_attr.attached_no_tag ~suppress_warnings container vd.val_attributes in
+  let doc = Doc_attr.attached_no_tag ~warnings_tag container vd.val_attributes in
   mark_value_description vd;
   let type_ = read_type_expr env vd.val_type in
   let value =
@@ -648,7 +648,7 @@ let read_label_declaration env parent ld =
   let name = Ident.name ld.ld_id in
   let id = Identifier.Mk.field (parent, Odoc_model.Names.FieldName.make_std name) in
   let doc =
-    Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings
+    Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag
       (parent :> Identifier.LabelParent.t) ld.ld_attributes
   in
   let mutable_ = (ld.ld_mutable = Mutable) in
@@ -673,7 +673,7 @@ let read_constructor_declaration env parent cd =
   let open TypeDecl.Constructor in
   let id = Ident_env.find_constructor_identifier env.ident_env cd.cd_id in
   let container = (parent :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cd.cd_attributes in
+  let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container cd.cd_attributes in
   let args =
     read_constructor_declaration_arguments env
       (parent :> Identifier.FieldParent.t) cd.cd_args
@@ -756,7 +756,7 @@ let read_type_declaration env parent id decl =
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
   let doc, canonical =
-    Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container decl.type_attributes
+    Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_canonical container decl.type_attributes
   in
   let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_type s in
   let params = mark_type_declaration decl in
@@ -795,7 +795,7 @@ let read_extension_constructor env parent id ext =
   let id = Env.find_extension_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container ext.ext_attributes in
+  let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container ext.ext_attributes in
   let args =
     read_constructor_declaration_arguments env
       (parent : Identifier.Signature.t :> Identifier.FieldParent.t) ext.ext_args
@@ -806,7 +806,7 @@ let read_extension_constructor env parent id ext =
 let read_type_extension env parent id ext rest =
   let open Extension in
   let type_path = Env.Path.read_type env.ident_env ext.ext_type_path in
-  let doc = Doc_attr.empty env.suppress_warnings in
+  let doc = Doc_attr.empty env.warnings_tag in
   let type_params = mark_type_extension' ext rest in
   let first = read_extension_constructor env parent id ext in
   let rest =
@@ -828,7 +828,7 @@ let read_exception env parent id ext =
   let id = Env.find_exception_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container ext.ext_attributes in
+  let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container ext.ext_attributes in
     mark_exception ext;
     let args =
       read_constructor_declaration_arguments env
@@ -840,7 +840,7 @@ let read_exception env parent id ext =
 let read_method env parent concrete (name, kind, typ) =
   let open Method in
   let id = Identifier.Mk.method_(parent, Odoc_model.Names.MethodName.make_std name) in
-  let doc = Doc_attr.empty env.suppress_warnings in
+  let doc = Doc_attr.empty env.warnings_tag in
   let private_ = (Compat.field_kind_repr kind) <> Compat.field_public in
   let virtual_ = not (Compat.concr_mem name concrete) in
   let type_ = read_type_expr env typ in
@@ -849,7 +849,7 @@ let read_method env parent concrete (name, kind, typ) =
 let read_instance_variable env parent (name, mutable_, virtual_, typ) =
   let open InstanceVariable in
   let id = Identifier.Mk.instance_variable(parent, Odoc_model.Names.InstanceVariableName.make_std name) in
-  let doc = Doc_attr.empty env.suppress_warnings in
+  let doc = Doc_attr.empty env.warnings_tag in
   let mutable_ = (mutable_ = Mutable) in
   let virtual_ = (virtual_ = Virtual) in
   let type_ = read_type_expr env typ in
@@ -922,7 +922,7 @@ let read_class_type_declaration env parent id cltd =
   let id = Env.find_class_type_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cltd.clty_attributes in
+  let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container cltd.clty_attributes in
     mark_class_type_declaration cltd;
     let params =
       List.map2
@@ -960,7 +960,7 @@ let read_class_declaration env parent id cld =
   let id = Env.find_class_identifier env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc = Doc_attr.attached_no_tag ~suppress_warnings:env.suppress_warnings container cld.cty_attributes in
+  let doc = Doc_attr.attached_no_tag ~warnings_tag:env.warnings_tag container cld.cty_attributes in
     mark_class_declaration cld;
     let params =
       List.map2
@@ -1003,7 +1003,7 @@ and read_module_type_declaration env parent id (mtd : Odoc_model.Compat.modtype_
   let id = Env.find_module_type env.ident_env id in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
+  let doc, canonical = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_canonical container mtd.mtd_attributes in
   let canonical = match canonical with | None -> None | Some s -> Doc_attr.conv_canonical_module_type s in
   let expr = opt_map (read_module_type env (id :> Identifier.Signature.t)) mtd.mtd_type in
   {id; source_loc; doc; canonical; expr }
@@ -1013,7 +1013,7 @@ and read_module_declaration env parent ident (md : Odoc_model.Compat.module_decl
   let id = (Env.find_module_identifier env.ident_env ident :> Identifier.Module.t) in
   let source_loc = None in
   let container = (parent : Identifier.Signature.t :> Identifier.LabelParent.t) in
-  let doc, canonical = Doc_attr.attached ~suppress_warnings:env.suppress_warnings Odoc_model.Semantics.Expect_canonical container md.md_attributes in
+  let doc, canonical = Doc_attr.attached ~warnings_tag:env.warnings_tag Odoc_model.Semantics.Expect_canonical container md.md_attributes in
   let canonical = match canonical with | None -> None | Some s -> Some (Doc_attr.conv_canonical_module s) in
   let type_ =
     match md.md_type with
@@ -1177,13 +1177,13 @@ and read_signature env parent (items : Odoc_model.Compat.signature) =
   fst @@ read_signature_noenv env parent items
 
 
-let read_interface root name ~suppress_warnings intf =
+let read_interface root name ~warnings_tag intf =
   let id =
     Identifier.Mk.root (root, Odoc_model.Names.ModuleName.make_std name)
   in
   let items =
     read_signature
-      { ident_env = Env.empty (); suppress_warnings }
+      { ident_env = Env.empty (); warnings_tag }
       id intf
   in
   (id, items)

src/loader/cmi.mli

@@ -21,13 +21,13 @@ module Paths = Odoc_model.Paths
 
 type env = {
   ident_env : Ident_env.t; (** Environment *)
-  suppress_warnings : bool (** Suppress warnings *)
+  warnings_tag : string option (** Used to suppress warnings *)
 }
 
 val read_interface :
   Odoc_model.Paths.Identifier.ContainerPage.t option ->
   string ->
-  suppress_warnings:bool ->
+  warnings_tag:string option ->
   Odoc_model.Compat.signature ->
   Paths.Identifier.RootModule.t * Odoc_model.Lang.Signature.t