Add @hidden tag

src/ast.ml

@@ -58,7 +58,7 @@ type nestable_block_element =
 and table = nestable_block_element abstract_table * [ `Light | `Heavy ]
 
 type internal_tag =
-  [ `Canonical of string with_location | `Inline | `Open | `Closed ]
+  [ `Canonical of string with_location | `Inline | `Open | `Closed | `Hidden ]
 (** Internal tags are used to exercise fine control over the output of odoc. They
     are never rendered in the output *)
 

src/lexer.mll

@@ -468,6 +468,8 @@ rule token input = parse
   | "@closed"
     { emit input (`Tag `Closed) }
 
+  | "@hidden"
+    { emit input (`Tag `Hidden) }
 
 
   | '{'

src/syntax.ml

@@ -595,6 +595,7 @@ let tag_to_words = function
   | `Inline -> [ `Word "@inline" ]
   | `Open -> [ `Word "@open" ]
   | `Closed -> [ `Word "@closed" ]
+  | `Hidden -> [ `Word "@hidden" ]
   | `Param s -> [ `Word "@param"; `Space " "; `Word s ]
   | `Raise s -> [ `Word "@raise"; `Space " "; `Word s ]
   | `Return -> [ `Word "@return" ]
@@ -843,7 +844,7 @@ let rec block_element_list :
                 let tag = Loc.at location tag in
                 consume_block_elements ~parsed_a_tag:true where_in_line
                   (tag :: acc)
-            | (`Inline | `Open | `Closed) as tag ->
+            | (`Inline | `Open | `Closed | `Hidden) as tag ->
                 let tag = Loc.at location (`Tag tag) in
                 consume_block_elements ~parsed_a_tag:true `After_text
                   (tag :: acc)))

src/token.ml

@@ -20,7 +20,8 @@ type tag =
     | `Canonical of string
     | `Inline
     | `Open
-    | `Closed ] ]
+    | `Closed
+    | `Hidden ] ]
 
 type t =
   [ (* End of input. *)
@@ -117,6 +118,7 @@ let print : [< t ] -> string = function
   | `Tag `Inline -> "'@inline'"
   | `Tag `Open -> "'@open'"
   | `Tag `Closed -> "'@closed'"
+  | `Tag `Hidden -> "'@hidden"
   | `Raw_markup (None, _) -> "'{%...%}'"
   | `Raw_markup (Some target, _) -> "'{%" ^ target ^ ":...%}'"
 
@@ -177,6 +179,7 @@ let describe : [< t | `Comment ] -> string = function
   | `Tag `Inline -> "'@inline'"
   | `Tag `Open -> "'@open'"
   | `Tag `Closed -> "'@closed'"
+  | `Tag `Hidden -> "'@hidden"
   | `Comment -> "top-level text"
 
 let describe_element = function

test/test.ml

@@ -140,6 +140,7 @@ module Ast_to_sexp = struct
     | `Inline -> Atom "@inline"
     | `Open -> Atom "@open"
     | `Closed -> Atom "@closed"
+    | `Hidden -> Atom "@hidden"
 
   let block_element at : Ast.block_element -> sexp = function
     | #Ast.nestable_block_element as e -> nestable_block_element at e
@@ -4640,6 +4641,78 @@ let%expect_test _ =
   end in
   ()
 
+let%expect_test _ =
+  let module Hidden = struct
+    let basic =
+      test "@hidden";
+      [%expect {| ((output (((f.ml (1 0) (1 7)) @hidden))) (warnings ())) |}]
+
+    let prefix =
+      test "@hiddenfoo";
+      [%expect
+        {|
+        ((output
+          (((f.ml (1 0) (1 10))
+            (paragraph (((f.ml (1 0) (1 10)) (word @hiddenfoo)))))))
+         (warnings
+          ( "File \"f.ml\", line 1, characters 0-10:\
+           \nUnknown tag '@hiddenfoo'."))) |}]
+
+    let extra_whitespace =
+      test "@hidden";
+      [%expect {| ((output (((f.ml (1 0) (1 7)) @hidden))) (warnings ())) |}]
+
+    let followed_by_junk =
+      test "@hidden foo";
+      [%expect
+        {|
+        ((output
+          (((f.ml (1 0) (1 7)) @hidden)
+           ((f.ml (1 8) (1 11)) (paragraph (((f.ml (1 8) (1 11)) (word foo)))))))
+         (warnings
+          ( "File \"f.ml\", line 1, characters 8-11:\
+           \nParagraph is not allowed in the tags section.\
+           \nSuggestion: move 'foo' before any tags."
+            "File \"f.ml\", line 1, characters 8-11:\
+           \nParagraph should begin on its own line."))) |}]
+
+    let followed_by_paragraph =
+      test "@hidden\nfoo";
+      [%expect
+        {|
+        ((output
+          (((f.ml (1 0) (1 7)) @hidden)
+           ((f.ml (2 0) (2 3)) (paragraph (((f.ml (2 0) (2 3)) (word foo)))))))
+         (warnings
+          ( "File \"f.ml\", line 2, characters 0-3:\
+           \nParagraph is not allowed in the tags section.\
+           \nSuggestion: move 'foo' before any tags."))) |}]
+
+    let followed_by_tag =
+      test "@hidden\n@deprecated";
+      [%expect
+        {|
+        ((output (((f.ml (1 0) (1 7)) @hidden) ((f.ml (2 0) (2 11)) (@deprecated))))
+         (warnings ())) |}]
+
+    let with_list =
+      test "@hidden - foo";
+      [%expect
+        {|
+        ((output
+          (((f.ml (1 0) (1 7)) @hidden)
+           ((f.ml (1 8) (1 13))
+            (unordered light
+             ((((f.ml (1 10) (1 13)) (paragraph (((f.ml (1 10) (1 13)) (word foo)))))))))))
+         (warnings
+          ( "File \"f.ml\", line 1, characters 8-9:\
+           \n'-' (bulleted list item) should begin on its own line."
+            "File \"f.ml\", line 1, characters 8-9:\
+           \n'-' (bulleted list item) is not allowed in the tags section.\
+           \nSuggestion: move '-' (bulleted list item) before any tags."))) |}]
+  end in
+  ()
+
 let%expect_test _ =
   let module Bad_markup = struct
     let left_brace =