Warn new lines in markup nested in light tables

New lines inside markup (such as `{e ...}`) were not detected, although it
breaks the light table format.

Add a warning for such cases.

Signed-off-by: Paul-Elliot <[email protected]>

Author: panglesd

src/lexer.mll

@@ -402,10 +402,10 @@ rule token input = parse
     { emit input (`Begin_list_item `Dash) }
 
   | "{table"
-    { emit input (`Begin_table `Heavy) }
+    { emit input (`Begin_table_heavy) }
 
   | "{t"
-    { emit input (`Begin_table `Light) }
+    { emit input (`Begin_table_light) }
 
   | "{tr"
     { emit input `Begin_table_row }

src/syntax.ml

@@ -156,6 +156,11 @@ type token_that_always_begins_an_inline_element =
 let _check_subset : token_that_always_begins_an_inline_element -> Token.t =
  fun t -> (t :> Token.t)
 
+(* The different contexts in which the inline parser [inline_element] and
+   [delimited_inline_parser] can be called. The inline parser's behavior depends
+   somewhat on the context: new lines are forbidden in light tables. *)
+type inline_context = In_light_table | Outside_light_table
+
 (* Consumes tokens that make up a single non-link inline element:
 
    - a horizontal space ([`Space], significant in inline elements),
@@ -177,8 +182,12 @@ let _check_subset : token_that_always_begins_an_inline_element -> Token.t =
 
    This function consumes exactly the tokens that make up the element. *)
 let rec inline_element :
-    input -> Loc.span -> _ -> Ast.inline_element with_location =
- fun input location next_token ->
+    input ->
+    Loc.span ->
+    context:inline_context ->
+    _ ->
+    Ast.inline_element with_location =
+ fun input location ~context next_token ->
   match next_token with
   | `Space _ as token ->
       junk input;
@@ -208,7 +217,8 @@ let rec inline_element :
       in
       let content, brace_location =
         delimited_inline_element_list ~parent_markup
-          ~parent_markup_location:location ~requires_leading_whitespace input
+          ~parent_markup_location:location ~requires_leading_whitespace ~context
+          input
       in
 
       let location = Loc.span [ location; brace_location ] in
@@ -236,7 +246,7 @@ let rec inline_element :
       let content, brace_location =
         delimited_inline_element_list ~parent_markup
           ~parent_markup_location:location ~requires_leading_whitespace:false
-          input
+          ~context input
       in
 
       let location = Loc.span [ location; brace_location ] in
@@ -274,7 +284,7 @@ let rec inline_element :
       let content, brace_location =
         delimited_inline_element_list ~parent_markup
           ~parent_markup_location:location ~requires_leading_whitespace:false
-          input
+          ~context input
       in
 
       `Link (u, content) |> Loc.at (Loc.span [ location; brace_location ])
@@ -305,9 +315,11 @@ and delimited_inline_element_list :
     parent_markup:[< Token.t ] ->
     parent_markup_location:Loc.span ->
     requires_leading_whitespace:bool ->
+    context:inline_context ->
     input ->
     Ast.inline_element with_location list * Loc.span =
- fun ~parent_markup ~parent_markup_location ~requires_leading_whitespace input ->
+ fun ~parent_markup ~parent_markup_location ~requires_leading_whitespace
+     ~context input ->
   (* [~at_start_of_line] is used to interpret [`Minus] and [`Plus]. These are
      word tokens if not the first non-whitespace tokens on their line. Then,
      they are allowed in a non-link element list. *)
@@ -330,10 +342,17 @@ and delimited_inline_element_list :
        it is an internal space, and we want to add it to the non-link inline
        element list. *)
     | (`Space _ | #token_that_always_begins_an_inline_element) as token ->
-        let acc = inline_element input next_token.location token :: acc in
+        let acc =
+          inline_element input next_token.location ~context token :: acc
+        in
         consume_elements ~at_start_of_line:false acc
-    | `Single_newline ws ->
+    | `Single_newline ws as blank ->
         junk input;
+        if context = In_light_table then
+          Parse_error.not_allowed ~what:(Token.describe blank)
+            ~in_what:(Token.describe `Begin_table_light)
+            next_token.location
+          |> add_warning input;
         let element = Loc.same next_token (`Space ws) in
         consume_elements ~at_start_of_line:true (element :: acc)
     | `Blank_line ws as blank ->
@@ -356,7 +375,9 @@ and delimited_inline_element_list :
            ~suggestion next_token.location
          |> add_warning input);
 
-        let acc = inline_element input next_token.location bullet :: acc in
+        let acc =
+          inline_element input next_token.location ~context bullet :: acc
+        in
         consume_elements ~at_start_of_line:false acc
     | other_token ->
         Parse_error.not_allowed
@@ -438,7 +459,10 @@ let paragraph : input -> Ast.nestable_block_element with_location =
     match next_token.value with
     | (`Space _ | `Minus | `Plus | #token_that_always_begins_an_inline_element)
       as token ->
-        let element = inline_element input next_token.location token in
+        let element =
+          inline_element input next_token.location ~context:Outside_light_table
+            token
+        in
         paragraph_line (element :: acc)
     | _ -> acc
   in
@@ -703,7 +727,7 @@ let rec block_element_list :
     | { value = `Begin_table_row as token; location } ->
         let suggestion =
           Printf.sprintf "move %s into %s." (Token.print token)
-            (Token.describe (`Begin_table `Heavy))
+            (Token.describe `Begin_table_heavy)
         in
         Parse_error.not_allowed ~what:(Token.describe token)
           ~in_what:(Token.describe parent_markup)
@@ -729,7 +753,7 @@ let rec block_element_list :
     | { value = `Bar as token; location } ->
         let suggestion =
           Printf.sprintf "move %s into %s." (Token.print token)
-            (Token.describe (`Begin_table `Light))
+            (Token.describe `Begin_table_light)
         in
         Parse_error.not_allowed ~what:(Token.describe token)
           ~in_what:(Token.describe parent_markup)
@@ -942,16 +966,19 @@ let rec block_element_list :
         let block = Loc.at location block in
         let acc = block :: acc in
         consume_block_elements ~parsed_a_tag `After_text acc
-    | { value = `Begin_table syntax as token; location } as next_token ->
+    | { value = (`Begin_table_light | `Begin_table_heavy) as token; location }
+      as next_token ->
         warn_if_after_tags next_token;
         warn_if_after_text next_token;
         junk input;
         let block, brace_location =
           let parent_markup = token in
           let parent_markup_location = location in
-          match syntax with
-          | `Light -> light_table input ~parent_markup ~parent_markup_location
-          | `Heavy -> heavy_table input ~parent_markup ~parent_markup_location
+          match token with
+          | `Begin_table_light ->
+              light_table input ~parent_markup ~parent_markup_location
+          | `Begin_table_heavy ->
+              heavy_table input ~parent_markup ~parent_markup_location
         in
         let location = Loc.span [ location; brace_location ] in
         let block = accepted_in_all_contexts context (`Table block) in
@@ -995,7 +1022,7 @@ let rec block_element_list :
           let content, brace_location =
             delimited_inline_element_list ~parent_markup:token
               ~parent_markup_location:location ~requires_leading_whitespace:true
-              input
+              ~context:Outside_light_table input
           in
           let location = Loc.span [ location; brace_location ] in
           let paragraph =
@@ -1035,7 +1062,8 @@ let rec block_element_list :
             let content, brace_location =
               delimited_inline_element_list ~parent_markup:token
                 ~parent_markup_location:location
-                ~requires_leading_whitespace:true input
+                ~requires_leading_whitespace:true ~context:Outside_light_table
+                input
             in
             if content = [] then
               Parse_error.should_not_be_empty ~what:(Token.describe token)
@@ -1052,7 +1080,7 @@ let rec block_element_list :
         let content, brace_location =
           delimited_inline_element_list ~parent_markup:token
             ~parent_markup_location:location ~requires_leading_whitespace:true
-            input
+            ~context:Outside_light_table input
         in
         let location = Loc.span [ location; brace_location ] in
 
@@ -1278,7 +1306,9 @@ and light_table_row ~parent_markup ~last_loc input =
         let acc_row = if new_line then [] else List.rev acc_cell :: acc_row in
         consume_row acc_row [] ~new_line:false ~last_loc
     | #token_that_always_begins_an_inline_element as token ->
-        let i = inline_element input next_token.location token in
+        let i =
+          inline_element input next_token.location ~context:In_light_table token
+        in
         consume_row acc_row (i :: acc_cell) ~new_line:false
           ~last_loc:next_token.location
     | other_token ->

src/token.ml

@@ -70,7 +70,8 @@ type t =
     `Begin_list of [ `Unordered | `Ordered ]
   | `Begin_list_item of [ `Li | `Dash ]
   | (* Table markup. *)
-    `Begin_table of [ `Light | `Heavy ]
+    `Begin_table_light
+  | `Begin_table_heavy
   | `Begin_table_row
   | `Begin_table_cell of [ `Header | `Data ]
   | `Minus
@@ -92,9 +93,8 @@ let print : [< t ] -> string = function
   | `Begin_link_with_replacement_text _ -> "'{{:'"
   | `Begin_list_item `Li -> "'{li ...}'"
   | `Begin_list_item `Dash -> "'{- ...}'"
-  | `Begin_table syntax ->
-      let syntax = match syntax with `Light -> "t" | `Heavy -> "table" in
-      Printf.sprintf "'{%s'" syntax
+  | `Begin_table_light -> "{t"
+  | `Begin_table_heavy -> "{table"
   | `Begin_table_row -> "'{tr'"
   | `Begin_table_cell `Header -> "'{th'"
   | `Begin_table_cell `Data -> "'{td'"
@@ -154,8 +154,8 @@ let describe : [< t | `Comment ] -> string = function
   | `Begin_list `Ordered -> "'{ol ...}' (numbered list)"
   | `Begin_list_item `Li -> "'{li ...}' (list item)"
   | `Begin_list_item `Dash -> "'{- ...}' (list item)"
-  | `Begin_table `Light -> "'{t ...}' (table)"
-  | `Begin_table `Heavy -> "'{table ...}' (table)"
+  | `Begin_table_light -> "'{t ...}' (table)"
+  | `Begin_table_heavy -> "'{table ...}' (table)"
   | `Begin_table_row -> "'{tr ...}' (table row)"
   | `Begin_table_cell `Header -> "'{th ... }' (table header cell)"
   | `Begin_table_cell `Data -> "'{td ... }' (table data cell)"

test/test_tables.ml

@@ -470,6 +470,47 @@ let%expect_test _ =
                (align (center center center center))))))
            (warnings ())) |}]
 
+    let light_table_markup_with_newlines =
+      test
+        {|
+      {t | h1           | h2          |
+         |--------------|-------------|
+         | {e with
+              newlines} | {b d} [foo] |
+      }
+      |};
+      [%expect {|
+        ((output
+          (((f.ml (2 6) (6 7))
+            (table (syntax light)
+             (data
+              ((row
+                ((header
+                  (((f.ml (2 11) (2 13))
+                    (paragraph (((f.ml (2 11) (2 13)) (word h1)))))))
+                 (header
+                  (((f.ml (2 26) (2 28))
+                    (paragraph (((f.ml (2 26) (2 28)) (word h2)))))))))
+               (row
+                ((data
+                  (((f.ml (4 11) (5 23))
+                    (paragraph
+                     (((f.ml (4 11) (5 23))
+                       (emphasis
+                        (((f.ml (4 14) (4 18)) (word with))
+                         ((f.ml (4 18) (5 14)) space)
+                         ((f.ml (5 14) (5 22)) (word newlines))))))))))
+                 (data
+                  (((f.ml (5 26) (5 31))
+                    (paragraph
+                     (((f.ml (5 26) (5 31)) (bold (((f.ml (5 29) (5 30)) (word d))))))))
+                   ((f.ml (5 32) (5 37))
+                    (paragraph (((f.ml (5 32) (5 37)) (code_span foo)))))))))))
+             (align (center center))))))
+         (warnings
+          ( "File \"f.ml\", line 4, character 18 to line 5, character 14:\
+           \nLine break is not allowed in '{t ...}' (table)."))) |}]
+
     let no_space =
       test
         {|