From cc4f0937b4aaa10717e1b7df09a8e6146e1940d0 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Fri, 14 Apr 2023 15:28:20 +0200 Subject: [PATCH 1/2] Add `@hidden` tag --- src/ast.ml | 2 +- src/lexer.mll | 2 ++ src/syntax.ml | 3 ++- src/token.ml | 5 +++- test/test.ml | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 82 insertions(+), 3 deletions(-) diff --git a/src/ast.ml b/src/ast.ml index 065c19e9..cb10b9de 100644 --- a/src/ast.ml +++ b/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 *) diff --git a/src/lexer.mll b/src/lexer.mll index 9c42ed29..b3a060e9 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -468,6 +468,8 @@ rule token input = parse | "@closed" { emit input (`Tag `Closed) } + | "@hidden" + { emit input (`Tag `Hidden) } | '{' diff --git a/src/syntax.ml b/src/syntax.ml index 48be287f..311c28f0 100644 --- a/src/syntax.ml +++ b/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))) diff --git a/src/token.ml b/src/token.ml index c76b3112..eb32fefb 100644 --- a/src/token.ml +++ b/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 diff --git a/test/test.ml b/test/test.ml index 4fedc471..16234803 100644 --- a/test/test.ml +++ b/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 = From 7d3d6ca7706b7a859d6ed41fa610baf677494dbf Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Fri, 14 Apr 2023 16:46:25 +0200 Subject: [PATCH 2/2] fmt --- src/token.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/token.ml b/src/token.ml index eb32fefb..06e58e9f 100644 --- a/src/token.ml +++ b/src/token.ml @@ -21,7 +21,7 @@ type tag = | `Inline | `Open | `Closed - | `Hidden] ] + | `Hidden ] ] type t = [ (* End of input. *)