Add hidden attribute

src/loader/doc_attr.ml

@@ -78,6 +78,7 @@ type parsed_attribute =
   [ `Text of payload  (* Standalone comment. *)
   | `Doc of payload  (* Attached comment. *)
   | `Stop of Location.t  (* [(**/**)]. *)
+  | `Hidden of Location.t
   | `Alert of  string * payload option * Location.t
     (* [`Alert (name, payload, loc)] is for [\[@@alert name "payload"\]] attributes. *) ]
 
@@ -96,6 +97,7 @@ let parse_attribute : Parsetree.attribute -> parsed_attribute option =
       match load_payload attr_payload with
       | Some p -> Some (`Doc p)
       | None -> None)
+  | "hidden" | "ocaml.hidden" -> Some (`Hidden attr_loc)
   | "deprecated" | "ocaml.deprecated" ->
       Some (`Alert ("deprecated", (load_payload attr_payload), attr_loc))
   | "alert" | "ocaml.alert" ->
@@ -108,6 +110,9 @@ let parse_attribute : Parsetree.attribute -> parsed_attribute option =
 let is_stop_comment attr =
   match parse_attribute attr with Some (`Stop _) -> true | _ -> false
 
+let is_hidden attr =
+  match parse_attribute attr with Some (`Hidden _) -> true | _ -> false
+
 let pad_loc loc =
   { loc.Location.loc_start with pos_cnum = loc.loc_start.pos_cnum + 3 }
 
@@ -135,7 +140,7 @@ let attached internal_tags parent attrs =
         | Some (`Alert (name, p, loc)) ->
             let elt = mk_alert_payload ~loc name p in
             loop acc_docs (elt :: acc_alerts) rest
-        | Some (`Text _ | `Stop _) | None -> loop acc_docs acc_alerts rest)
+        | Some (`Text _ | `Stop _ | `Hidden _) | None -> loop acc_docs acc_alerts rest)
     | [] -> (List.rev acc_docs, List.rev acc_alerts)
   in
   let ast_docs, alerts = loop [] [] attrs in
@@ -212,7 +217,7 @@ let extract_top_comment internal_tags ~classify parent items =
             let p = match p with Some (p, _) -> Some p | None -> None in
             let attr_loc = read_location attr_loc in
             `Alert (Location_.at attr_loc (`Tag (`Alert (name, p))))
-        | Some (`Stop _) -> `Return (* Stop at stop-comments. *)
+        | Some (`Stop _) | Some (`Hidden _) -> `Return (* Stop at stop-comments and hidden attrs. *)
         | None -> `Skip (* Skip unrecognized attributes. *))
     | Some `Open -> `Skip (* Skip open statements *)
     | None -> `Return

src/loader/doc_attr.mli

@@ -21,6 +21,8 @@ val empty : Odoc_model.Comment.docs
 
 val is_stop_comment : Parsetree.attribute -> bool
 
+val is_hidden : Parsetree.attribute -> bool
+
 val attached :
   'tags Semantics.handle_internal_tags ->
   Paths.Identifier.LabelParent.t ->

src/loader/ident_env.cppo.ml

@@ -164,6 +164,8 @@ let filter_map f x =
 
 let rec extract_signature_tree_items hide_item items =
   let open Typedtree in
+  let is_hidden (attrs: attribute list) =
+    hide_item || List.exists Doc_attr.is_hidden attrs in
   match items with
 #if OCAML_VERSION < (4,3,0)
   | { sig_desc = Tsig_type decls; _} :: rest ->
@@ -177,32 +179,33 @@ let rec extract_signature_tree_items hide_item items =
       decls @ extract_signature_tree_items hide_item rest
 
 #if OCAML_VERSION >= (4,10,0)
-  | { sig_desc = Tsig_module { md_id = Some id; _ }; _} :: rest ->
-      [`Module (id, hide_item)] @ extract_signature_tree_items hide_item rest
-  | { sig_desc = Tsig_module _; _ } :: rest ->
-      extract_signature_tree_items hide_item rest
+  | { sig_desc = Tsig_module { md_id = Some id; md_attributes; _ }; _} :: rest ->
+      [`Module (id, is_hidden md_attributes)] @ extract_signature_tree_items hide_item rest
+  | { sig_desc = Tsig_module { md_attributes; _ }; _ } :: rest ->
+      extract_signature_tree_items (is_hidden md_attributes)  rest
   | { sig_desc = Tsig_recmodule mds; _} :: rest ->
     List.fold_right (
       fun md items ->
         match md.md_id with
-        | Some id -> `Module (id, hide_item) :: items
+        | Some id -> `Module (id, is_hidden md.md_attributes) :: items
         | None -> items)
       mds [] @ extract_signature_tree_items hide_item rest
 #else 
-  | { sig_desc = Tsig_module{ md_id; _}; _} :: rest ->
-      [`Module (md_id, hide_item)] @ extract_signature_tree_items hide_item rest
+  | { sig_desc = Tsig_module{ md_id; md_attributes; _}; _} :: rest ->
+      [`Module (md_id, is_hidden md_attributes)] @ extract_signature_tree_items hide_item rest
   | { sig_desc = Tsig_recmodule mds; _ } :: rest ->
-    List.map (fun md -> `Module (md.md_id, hide_item))
+    List.map (fun md -> `Module (md.md_id, is_hidden md.md_attributes))
       mds @ extract_signature_tree_items hide_item rest
 #endif
-  | { sig_desc = Tsig_value {val_id; _}; _ } :: rest->
-      [`Value (val_id, hide_item)] @ extract_signature_tree_items hide_item rest 
+  | { sig_desc = Tsig_value {val_id; val_attributes; _}; _ } :: rest->
+      [`Value (val_id, is_hidden val_attributes)] @ extract_signature_tree_items hide_item rest
   | { sig_desc = Tsig_modtype mtd; _} :: rest ->
-      [`ModuleType (mtd.mtd_id, hide_item)] @ extract_signature_tree_items hide_item rest
+      [`ModuleType (mtd.mtd_id, is_hidden mtd.mtd_attributes)] @ extract_signature_tree_items hide_item rest
   | {sig_desc = Tsig_include incl; _ } :: rest ->
-      [`Include (extract_signature_type_items (Compat.signature incl.incl_type))] @ extract_signature_tree_items hide_item rest
+      [`Include (extract_signature_type_items (Compat.signature incl.incl_type))]
+      @ extract_signature_tree_items (is_hidden incl.incl_attributes) rest
   | {sig_desc = Tsig_attribute attr; _ } :: rest ->
-      let hide_item = if Doc_attr.is_stop_comment attr then not hide_item else hide_item in
+      let hide_item = if Doc_attr.is_stop_comment attr || Doc_attr.is_hidden attr then not hide_item else hide_item in
       extract_signature_tree_items hide_item rest
   | {sig_desc = Tsig_class cls; _} :: rest ->
       List.map
@@ -214,7 +217,7 @@ let rec extract_signature_tree_items hide_item items =
             cld.ci_id_typehash
 #endif
           in
-          `Class (cld.ci_id_class, cld.ci_id_class_type, cld.ci_id_object, typehash, hide_item))
+          `Class (cld.ci_id_class, cld.ci_id_class_type, cld.ci_id_object, typehash, is_hidden cld.ci_attributes))
             cls @ extract_signature_tree_items hide_item rest
   | { sig_desc = Tsig_class_type cltyps; _ } :: rest ->
     List.map
@@ -227,18 +230,18 @@ let rec extract_signature_tree_items hide_item items =
 #endif
             in
 
-            `ClassType (clty.ci_id_class_type, clty.ci_id_object, typehash, hide_item))
+            `ClassType (clty.ci_id_class_type, clty.ci_id_object, typehash, is_hidden clty.ci_attributes))
               cltyps @ extract_signature_tree_items hide_item rest
 #if OCAML_VERSION >= (4,8,0)
     | { sig_desc = Tsig_modsubst ms; _} :: rest ->
-      [`Module (ms.ms_id, hide_item)] @ extract_signature_tree_items hide_item rest
+      [`Module (ms.ms_id, is_hidden ms.ms_attributes)] @ extract_signature_tree_items hide_item rest
     | { sig_desc = Tsig_typesubst ts; _} :: rest ->
-      List.map (fun decl -> `Type (decl.typ_id, hide_item)) 
+      List.map (fun decl -> `Type (decl.typ_id, is_hidden decl.typ_attributes))
         ts @ extract_signature_tree_items hide_item rest
 #endif
 #if OCAML_VERSION >= (4,13,0)
     | { sig_desc = Tsig_modtypesubst mtd; _ } :: rest ->
-      [`ModuleType (mtd.mtd_id, hide_item)] @ extract_signature_tree_items hide_item rest
+      [`ModuleType (mtd.mtd_id, is_hidden mtd.mtd_attributes)] @ extract_signature_tree_items hide_item rest
 #endif
     | { sig_desc = Tsig_typext _; _} :: rest
     | { sig_desc = Tsig_exception _; _} :: rest
@@ -247,6 +250,8 @@ let rec extract_signature_tree_items hide_item items =
 
 let rec read_pattern hide_item pat =
   let open Typedtree in
+  let hide_item =
+    hide_item || List.exists Doc_attr.is_hidden pat.pat_attributes in
   match pat.pat_desc with
   | Tpat_var(id, _) -> [`Value(id, hide_item)]
   | Tpat_alias(pat, id, _) -> `Value(id, hide_item) :: read_pattern hide_item pat
@@ -269,13 +274,15 @@ let rec read_pattern hide_item pat =
 
 let rec extract_structure_tree_items hide_item items =
   let open Typedtree in
+  let is_hidden (attrs: attribute list) =
+    hide_item || List.exists Doc_attr.is_hidden attrs in
     match items with
 #if OCAML_VERSION < (4,3,0)
     | { str_desc = Tstr_type decls; _ } :: rest ->
 #else
     | { str_desc = Tstr_type (_, decls); _ } :: rest -> (* TODO: handle rec_flag *)
 #endif
-        List.map (fun decl -> `Type (decl.typ_id, hide_item))
+        List.map (fun decl -> `Type (decl.typ_id, is_hidden decl.typ_attributes))
           decls @ extract_structure_tree_items hide_item rest
 
 
@@ -284,32 +291,32 @@ let rec extract_structure_tree_items hide_item items =
 #else
     | { str_desc = Tstr_value (_, vbs); _ } :: rest -> (*TODO: handle rec_flag *)
 #endif
-   ( List.map (fun vb -> read_pattern hide_item vb.vb_pat) vbs
+  ( List.map (fun vb -> read_pattern (is_hidden vb.vb_attributes) vb.vb_pat) vbs
       |> List.flatten) @ extract_structure_tree_items hide_item rest
 
 #if OCAML_VERSION >= (4,10,0)
-    | { str_desc = Tstr_module { mb_id = Some id; _}; _} :: rest ->
-      [`Module (id, hide_item)] @ extract_structure_tree_items hide_item rest
+    | { str_desc = Tstr_module { mb_id = Some id; mb_attributes; _}; _} :: rest ->
+      [`Module (id, (is_hidden mb_attributes))] @ extract_structure_tree_items hide_item rest
     | { str_desc = Tstr_module _; _} :: rest -> extract_structure_tree_items hide_item rest
     | { str_desc = Tstr_recmodule mbs; _ } :: rest ->
         List.fold_right 
           (fun mb items ->
             match mb.mb_id with
-            | Some id -> `Module (id, hide_item) :: items
+            | Some id -> `Module (id, is_hidden mb.mb_attributes) :: items
             | None -> items) mbs [] @ extract_structure_tree_items hide_item rest
 #else
-    | { str_desc = Tstr_module { mb_id; _}; _} :: rest ->
-        [`Module (mb_id, hide_item)] @ extract_structure_tree_items hide_item rest
+    | { str_desc = Tstr_module { mb_id; mb_attributes; _}; _} :: rest ->
+        [`Module (mb_id, is_hidden mb_attributes)] @ extract_structure_tree_items hide_item rest
     | { str_desc = Tstr_recmodule mbs; _} :: rest ->
-        List.map (fun mb -> `Module (mb.mb_id, hide_item))
+        List.map (fun mb -> `Module (mb.mb_id, is_hidden mb.mb_attributes))
           mbs @ extract_structure_tree_items hide_item rest
 #endif
     | { str_desc = Tstr_modtype mtd; _ } :: rest ->
-        [`ModuleType (mtd.mtd_id, hide_item)] @ extract_structure_tree_items hide_item rest
+        [`ModuleType (mtd.mtd_id, is_hidden mtd.mtd_attributes)] @ extract_structure_tree_items hide_item rest
     | { str_desc = Tstr_include incl; _ } :: rest ->
         [`Include (extract_signature_type_items (Compat.signature incl.incl_type))] @ extract_structure_tree_items hide_item rest
     | { str_desc = Tstr_attribute attr; _} :: rest ->
-        let hide_item = if Doc_attr.is_stop_comment attr then not hide_item else hide_item in
+        let hide_item = if Doc_attr.is_stop_comment attr || Doc_attr.is_hidden attr then not hide_item else hide_item in
         extract_structure_tree_items hide_item rest
     | { str_desc = Tstr_class cls; _ } :: rest ->
         List.map
@@ -325,7 +332,7 @@ let rec extract_structure_tree_items hide_item items =
 #else
                cld.ci_id_typehash,
 #endif
-              hide_item
+              is_hidden cld.ci_attributes
              )) cls @ extract_structure_tree_items hide_item rest
     | {str_desc = Tstr_class_type cltyps; _ } :: rest ->
         List.map
@@ -337,7 +344,7 @@ let rec extract_structure_tree_items hide_item items =
 #else
                clty.ci_id_typehash,
 #endif
-              hide_item
+              is_hidden clty.ci_attributes
              )) cltyps @ extract_structure_tree_items hide_item rest
 #if OCAML_VERSION < (4,8,0)
     | { str_desc = Tstr_open _; _} :: rest -> extract_structure_tree_items hide_item rest

test/generators/cases/hidden.mli

@@ -0,0 +1,21 @@
+(** This test cases exercise hidden attribute. *)
+
+val foo : int
+(** This is normal commented text. *)
+
+val bar : int [@@hidden]
+
+module M :
+sig
+  val baz : int
+
+end [@@hidden]
+
+module N :
+sig
+  val quux : int
+
+  [@@@hidden]
+
+  val omg : int
+end

test/generators/cases/hidden_dead_link_doc.mli

@@ -0,0 +1,25 @@
+(* This tests that references to hidden items (items in no documentation mode) don't get rendered *)
+
+module Foo : sig
+  type t
+end
+
+type foo = | Bar of Foo.t
+
+type bar = | Bar of { field : Foo.t }
+
+type foo_ = Bar_ of (int * Foo.t) * int
+type bar_ = Bar__ of Foo.t option
+
+module Another_Foo : sig
+  type t
+end [@@hidden]
+
+(* this should be rendered as `type another_foo` because it contains a reference to a hidden module*)
+type another_foo = | Bar of Another_Foo.t
+
+(* this should be rendered as `type another_bar` because it contains a reference to a hidden module*)
+type another_bar = | Bar of { field : Another_Foo.t }
+
+type another_foo_ = Bar_ of (int * Another_Foo.t) * int
+type another_bar_ = Bar__ of Another_Foo.t option

test/generators/gen_rules/gen_rules.ml

@@ -47,6 +47,7 @@ let constraints =
   let open Gen_rules_lib in
   [
     ("stop_dead_link_doc.mli", Min "4.04");
+    ("hidden_dead_link_doc.mli", Min "4.04");
     ("bugs_post_406.mli", Min "4.06");
     ("ocamlary.mli", Min "4.07");
     ("recent.mli", Min "4.09");

test/generators/html/Hidden-N.html

@@ -0,0 +1,25 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>N (Hidden.N)</title><link rel="stylesheet" href="odoc.css"/>
+  <meta charset="utf-8"/><meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <nav class="odoc-nav"><a href="Hidden.html">Up</a> – 
+   <a href="Hidden.html">Hidden</a> &#x00BB; N
+  </nav>
+  <header class="odoc-preamble">
+   <h1>Module <code><span>Hidden.N</span></code></h1>
+  </header>
+  <div class="odoc-content">
+   <div class="odoc-spec">
+    <div class="spec value anchored" id="val-quux">
+     <a href="#val-quux" class="anchor"></a>
+     <code><span><span class="keyword">val</span> quux : int</span></code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>

test/generators/html/Hidden.html

@@ -0,0 +1,35 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>Hidden (Hidden)</title><link rel="stylesheet" href="odoc.css"/>
+  <meta charset="utf-8"/><meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <header class="odoc-preamble">
+   <h1>Module <code><span>Hidden</span></code></h1>
+   <p>This test cases exercise hidden attribute.</p>
+  </header>
+  <div class="odoc-content">
+   <div class="odoc-spec">
+    <div class="spec value anchored" id="val-foo">
+     <a href="#val-foo" class="anchor"></a>
+     <code><span><span class="keyword">val</span> foo : int</span></code>
+    </div><div class="spec-doc"><p>This is normal commented text.</p></div>
+   </div>
+   <div class="odoc-spec">
+    <div class="spec module anchored" id="module-N">
+     <a href="#module-N" class="anchor"></a>
+     <code>
+      <span><span class="keyword">module</span> <a href="Hidden-N.html">N</a>
+      </span>
+      <span> : <span class="keyword">sig</span> ... 
+       <span class="keyword">end</span>
+      </span>
+     </code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>

test/generators/html/Hidden_dead_link_doc-Foo.html

@@ -0,0 +1,27 @@
+<!DOCTYPE html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>Foo (Hidden_dead_link_doc.Foo)</title>
+  <link rel="stylesheet" href="odoc.css"/><meta charset="utf-8"/>
+  <meta name="generator" content="odoc %%VERSION%%"/>
+  <meta name="viewport" content="width=device-width,initial-scale=1.0"/>
+  <script src="highlight.pack.js"></script>
+  <script>hljs.initHighlightingOnLoad();</script>
+ </head>
+ <body class="odoc">
+  <nav class="odoc-nav"><a href="Hidden_dead_link_doc.html">Up</a> – 
+   <a href="Hidden_dead_link_doc.html">Hidden_dead_link_doc</a> &#x00BB;
+    Foo
+  </nav>
+  <header class="odoc-preamble">
+   <h1>Module <code><span>Hidden_dead_link_doc.Foo</span></code></h1>
+  </header>
+  <div class="odoc-content">
+   <div class="odoc-spec">
+    <div class="spec type anchored" id="type-t">
+     <a href="#type-t" class="anchor"></a>
+     <code><span><span class="keyword">type</span> t</span></code>
+    </div>
+   </div>
+  </div>
+ </body>
+</html>