From 82af0c32c3c3fc5e89734824829e591e60e909d3 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Fri, 9 Sep 2022 11:19:20 +0100 Subject: [PATCH 01/19] Add syntax for tables --- src/ast.ml | 11 + src/compat.ml | 30 +++ src/compat.mli | 25 +++ src/lexer.mll | 20 +- src/syntax.ml | 348 ++++++++++++++++++++++++++++++ src/token.ml | 19 ++ test/test.ml | 25 +++ test/test.mli | 1 + test/test_tables.ml | 514 ++++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 992 insertions(+), 1 deletion(-) create mode 100644 src/compat.ml create mode 100644 src/compat.mli create mode 100644 test/test.mli create mode 100644 test/test_tables.ml diff --git a/src/ast.ml b/src/ast.ml index 863f60c4..4582e7e8 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -9,6 +9,7 @@ type 'a with_location = 'a Loc.with_location type style = [ `Bold | `Italic | `Emphasis | `Superscript | `Subscript ] +type alignment = [ `Left | `Center | `Right ] type reference_kind = [ `Simple | `With_text ] (** References in doc comments can be of two kinds: [{!simple}] or [{{!ref}With text}]. *) @@ -29,6 +30,11 @@ type inline_element = text. Similarly the [`Link] constructor has the link itself as first parameter and the second is the replacement text. *) +type 'a cell = 'a with_location list +type 'a row = 'a cell list +type 'a grid = 'a row list +type 'a abstract_table = 'a row * 'a grid * alignment option list + type nestable_block_element = [ `Paragraph of inline_element with_location list | `Code_block of @@ -41,6 +47,7 @@ type nestable_block_element = [ `Unordered | `Ordered ] * [ `Light | `Heavy ] * nestable_block_element with_location list list + | `Table of table | `Math_block of string (** @since 2.0.0 *) ] (** Some block elements may be nested within lists or tags, but not all. The [`List] constructor has a parameter of type [\[`Light | `Heavy\]]. @@ -48,6 +55,10 @@ type nestable_block_element = {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html#sss:ocamldoc-list}manual}). *) +and table = + [ `Light of inline_element abstract_table + | `Heavy of nestable_block_element abstract_table ] + type internal_tag = [ `Canonical of string with_location | `Inline | `Open | `Closed ] (** Internal tags are used to exercise fine control over the output of odoc. They diff --git a/src/compat.ml b/src/compat.ml new file mode 100644 index 00000000..526b6836 --- /dev/null +++ b/src/compat.ml @@ -0,0 +1,30 @@ +module Option = struct + type 'a t = 'a option = None | Some of 'a + + let is_some = function None -> false | Some _ -> true + + let value_exn = function + | None -> failwith "Option.value_exn None" + | Some x -> x + + let join_list l = + if List.for_all is_some l then Some (List.map value_exn l) else None +end + +module Char = struct + include Char + + let equal (x : char) y = x = y +end + +module String = struct + include String + + let for_all f str = + let rec aux i = + if i >= String.length str then true + else if f (String.get str i) then aux (i + 1) + else false + in + aux 0 +end diff --git a/src/compat.mli b/src/compat.mli new file mode 100644 index 00000000..68cc0815 --- /dev/null +++ b/src/compat.mli @@ -0,0 +1,25 @@ +(** @since 4.08 *) +module Option : sig + type 'a t = 'a option = None | Some of 'a + + val is_some : 'a option -> bool + (** [is_some o] is [true] if and only if [o] is [Some o]. *) + + val join_list : 'a option list -> 'a list option +end + +module Char : sig + include module type of Char + + val equal : t -> t -> bool + (** The equal function for chars. + @since 4.03.0 *) +end + +module String : sig + include module type of String + + val for_all : (char -> bool) -> string -> bool + (** [for_all p s] checks if all characters in [s] satisfy the preficate [p]. + @since 4.13.0 *) +end diff --git a/src/lexer.mll b/src/lexer.mll index d8eac89c..576e5c61 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -244,7 +244,7 @@ let heading_level input level = let markup_char = - ['{' '}' '[' ']' '@'] + ['{' '}' '[' ']' '@' '|'] let space_char = [' ' '\t' '\n' '\r'] let bullet_char = @@ -289,6 +289,9 @@ rule token input = parse | (horizontal_space* (newline horizontal_space*)? as p) '}' { emit input `Right_brace ~adjust_start_by:p } + | '|' + { emit input `Bar } + | word_char (word_char | bullet_char | '@')* | bullet_char (word_char | bullet_char | '@')+ as w { emit input (`Word (unescape_word w)) } @@ -398,6 +401,21 @@ rule token input = parse | "{-" { emit input (`Begin_list_item `Dash) } + | "{table" + { emit input (`Begin_table `Heavy) } + + | "{t" + { emit input (`Begin_table `Light) } + + | "{tr" + { emit input `Begin_table_row } + + | "{th" + { emit input `Begin_table_header } + + | "{td" + { emit input `Begin_table_data } + | '{' (['0'-'9']+ as level) ':' (([^ '}'] # space_char)* as label) { emit input (`Begin_section_heading (heading_level input level, Some label)) } diff --git a/src/syntax.ml b/src/syntax.ml index 347ebf44..11872733 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -17,6 +17,8 @@ sequence of block elements, so [block_element_list] is the top-level parser. It is also used for list item and tag content. *) +open! Compat + type 'a with_location = 'a Loc.with_location (* {2 Input} *) @@ -36,6 +38,107 @@ let peek input = | Some token -> token | None -> assert false +module Table = struct + module Light_syntax = struct + let valid_align = function + | [ { Loc.value = `Word w; _ } ] -> ( + match String.length w with + | 0 -> Some None + | 1 -> ( + match w with + | "-" -> Some None + | ":" -> Some (Some `Center) + | _ -> None) + | len -> + if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) then + match (String.get w 0, String.get w (len - 1)) with + | ':', ':' -> Some (Some `Center) + | ':', '-' -> Some (Some `Left) + | '-', ':' -> Some (Some `Right) + | '-', '-' -> Some None + | _ -> None + else None) + | _ -> None + + let valid_align_row lx = List.map valid_align lx |> Option.join_list + let create ~header ~data ~align : Ast.table = `Light (header, data, align) + + let from_grid (grid : _ Ast.grid) : Ast.table = + match grid with + | [] -> create ~header:[] ~data:[] ~align:[] + | row1 :: rows2_N -> ( + match valid_align_row row1 with + (* If the first line is the align row, everything else is data. *) + | Some align -> create ~header:[] ~data:rows2_N ~align + | None -> ( + match rows2_N with + (* Only 1 line, if this is not the align row this is data. *) + | [] -> create ~header:[] ~data:[ row1 ] ~align:[] + | row2 :: rows3_N -> ( + match valid_align_row row2 with + (* If the second line is the align row, the first one is the + header and the rest is data. *) + | Some align -> create ~header:row1 ~data:rows3_N ~align + (* No align row in the first 2 lines, everything is considered + data. *) + | None -> create ~header:[] ~data:grid ~align:[]))) + end + + module Heavy_syntax = struct + let create ~header ~data ~align : Ast.table = `Heavy (header, data, align) + + let valid_header_row row = + List.map + (function + | `Header (Some x), y -> Some (Some x, y) + | `Header None, y -> Some (None, y) + | `Data, _ -> None) + row + |> Option.join_list + + let from_grid grid : Ast.table = + match grid with + | [] -> create ~header:[] ~data:[] ~align:[] + | row1 :: rows2_N -> + let header, data, align = + (* If the first line is the header row, everything else is data. *) + match valid_header_row row1 with + | Some header -> + let align, header = List.split header in + (header, rows2_N, align) + (* Otherwise everything is considered data. *) + | None -> ([], grid, []) + in + let data = List.map (List.map snd) data in + create ~header ~data ~align + end +end + +module Reader = struct + let until_rbrace input acc = + let rec consume () = + let next_token = peek input in + match next_token.value with + | `Right_brace -> + junk input; + `End (acc, next_token.location) + | `Space _ | `Single_newline _ | `Blank_line _ -> + junk input; + consume () + | _ -> `Token next_token + in + consume () + + module Infix = struct + let ( let>> ) consume if_token = + match consume with + | `End (ret, loc) -> (ret, loc) + | `Token t -> if_token t + end +end + +open Reader.Infix + (* The last token in the stream is always [`End], and it is never consumed by the parser, so the [None] case is impossible. *) @@ -381,6 +484,8 @@ let paragraph : input -> Ast.nestable_block_element with_location = [-], has been read, and only whitespace has been read since. - [`After_explicit_list_bullet], when a valid explicit bullet, such as [{li], has been read, and only whitespace has been read since. + - [`After_table_header], when a table header opening markup ('{th') has been read. + - [`After_table_cell], when a table cell opening markup ('{td') has been read. - [`After_text], when any other valid non-whitespace token has already been read on the current line. @@ -404,6 +509,8 @@ type where_in_line = | `After_tag | `After_shorthand_bullet | `After_explicit_list_bullet + | `After_table_header + | `After_table_cell | `After_text ] (* The block parsing loop, function [block_element_list], stops when it @@ -457,6 +564,8 @@ type ('block, 'stops_at_which_tokens) context = | Top_level : (Ast.block_element, stops_at_delimiters) context | In_shorthand_list : (Ast.nestable_block_element, stopped_implicitly) context | In_explicit_list : (Ast.nestable_block_element, stops_at_delimiters) context + | In_table_header : (Ast.nestable_block_element, stops_at_delimiters) context + | In_table_cell : (Ast.nestable_block_element, stops_at_delimiters) context | In_tag : (Ast.nestable_block_element, Token.t) context (* This is a no-op. It is needed to prove to the type system that nestable block @@ -471,6 +580,8 @@ let accepted_in_all_contexts : | Top_level -> (block :> Ast.block_element) | In_shorthand_list -> block | In_explicit_list -> block + | In_table_header -> block + | In_table_cell -> block | In_tag -> block (* Converts a tag to a series of words. This is used in error recovery, when a @@ -499,6 +610,7 @@ let tag_to_words = function - paragraphs, - code blocks, - verbatim text blocks, + - tables, - lists, and - section headings. *) let rec block_element_list : @@ -561,6 +673,8 @@ let rec block_element_list : | Top_level -> (List.rev acc, next_token, where_in_line) | In_shorthand_list -> (List.rev acc, next_token, where_in_line) | In_explicit_list -> (List.rev acc, next_token, where_in_line) + | In_table_header -> (List.rev acc, next_token, where_in_line) + | In_table_cell -> (List.rev acc, next_token, where_in_line) | In_tag -> (List.rev acc, next_token, where_in_line)) (* Whitespace. This can terminate some kinds of block elements. It is also necessary to track it to interpret [`Minus] and [`Plus] correctly, as @@ -594,6 +708,46 @@ let rec block_element_list : ~suggestion location |> add_warning input; + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc + (* Table rows ([{tr ...}]) can never appear directly + in block content. They can only appear inside [{table ...}]. *) + | { value = `Begin_table_row as token; location } -> + let suggestion = + Printf.sprintf "move %s into %s." (Token.print token) + (Token.describe (`Begin_table `Heavy)) + in + Parse_error.not_allowed ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion location + |> add_warning input; + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc + (* Table cells ([{th ...}] and [{td ...}]) can never appear directly + in block content. They can only appear inside [{tr ...}]. *) + | { value = (`Begin_table_header | `Begin_table_data) as token; location } + -> + let suggestion = + Printf.sprintf "move %s into %s." (Token.print token) + (Token.describe `Begin_table_row) + in + Parse_error.not_allowed ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion location + |> add_warning input; + junk input; + consume_block_elements ~parsed_a_tag where_in_line acc + (* Bars can never appear directly in block content. + They can only appear inside [{t ...}]. *) + | { value = `Bar as token; location } -> + let suggestion = + Printf.sprintf "move %s into %s." (Token.print token) + (Token.describe (`Begin_table `Light)) + in + Parse_error.not_allowed ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + ~suggestion location + |> add_warning input; junk input; consume_block_elements ~parsed_a_tag where_in_line acc (* Tags. These can appear at the top level only. Also, once one tag is seen, @@ -622,6 +776,8 @@ let rec block_element_list : if where_in_line = `At_start_of_line then (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context + | In_table_header -> recover_when_not_at_top_level context + | In_table_cell -> recover_when_not_at_top_level context | In_tag -> if where_in_line = `At_start_of_line then (List.rev acc, next_token, where_in_line) @@ -800,6 +956,22 @@ 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 -> + 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 + in + let location = Loc.span [ location; brace_location ] in + let block = accepted_in_all_contexts context (`Table block) in + let block = Loc.at location block in + let acc = block :: acc in + consume_block_elements ~parsed_a_tag `After_text acc | { value = (`Minus | `Plus) as token; location } as next_token -> ( (match where_in_line with | `After_text | `After_shorthand_bullet -> @@ -855,6 +1027,8 @@ let rec block_element_list : (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context | In_explicit_list -> recover_when_not_at_top_level context + | In_table_header -> recover_when_not_at_top_level context + | In_table_cell -> recover_when_not_at_top_level context | In_tag -> recover_when_not_at_top_level context | Top_level -> if where_in_line <> `At_start_of_line then @@ -914,6 +1088,8 @@ let rec block_element_list : | Top_level -> `At_start_of_line | In_shorthand_list -> `After_shorthand_bullet | In_explicit_list -> `After_explicit_list_bullet + | In_table_header -> `After_table_header + | In_table_cell -> `After_table_cell | In_tag -> `After_tag in @@ -1067,6 +1243,178 @@ and explicit_list_items : consume_list_items [] +(* Consumes a sequence of table rows that might start with [`Bar]. + + This function is called immediately after '{t' ([`Begin_table `Light]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and light_table ~parent_markup ~parent_markup_location input = + let rec consume_rows acc ~last_loc = + let>> next_token = Reader.until_rbrace input acc in + match next_token.Loc.value with + | `Bar | #token_that_always_begins_an_inline_element -> ( + let next, row, last_loc = + light_table_row ~parent_markup ~last_loc input + in + match next with + | `Continue -> consume_rows (row :: acc) ~last_loc + | `Stop -> (row :: acc, last_loc)) + | other_token -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe other_token) + ~in_what:(Token.describe parent_markup) + |> add_warning input; + junk input; + consume_rows acc ~last_loc + in + let rows, brace_location = consume_rows [] ~last_loc:parent_markup_location in + let grid = List.rev rows in + (Table.Light_syntax.from_grid grid, brace_location) + +(* Consumes a table row that might start with [`Bar]. *) +and light_table_row ~parent_markup ~last_loc input = + let rec consume_row acc_row acc_cell ~new_line ~last_loc = + let push_cells row cell = + match cell with [] -> row | _ -> List.rev cell :: row + in + let return row cell = List.rev (push_cells row cell) in + let next_token = peek input in + match next_token.value with + | `Right_brace -> + junk input; + (`Stop, return acc_row acc_cell, next_token.location) + | `Space _ -> + junk input; + consume_row acc_row acc_cell ~new_line ~last_loc + | `Single_newline _ | `Blank_line _ -> + junk input; + (`Continue, return acc_row acc_cell, last_loc) + | `Bar -> + junk 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 + consume_row acc_row (i :: acc_cell) ~new_line:false + ~last_loc:next_token.location + | other_token -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe other_token) + ~in_what:(Token.describe parent_markup) + |> add_warning input; + junk input; + consume_row acc_row acc_cell ~new_line ~last_loc + in + consume_row [] [] ~new_line:true ~last_loc + +(* Consumes a sequence of table rows (starting with '{tr ...}', which are + represented by [`Begin_table_row] tokens). + + This function is called immediately after '{table' ([`Begin_table `Heavy]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and heavy_table ~parent_markup ~parent_markup_location input = + let rec consume_rows acc ~last_loc = + let>> next_token = Reader.until_rbrace input acc in + match next_token.Loc.value with + | `Begin_table_row as token -> + junk input; + let items, last_loc = heavy_table_row ~parent_markup:token input in + consume_rows (List.rev items :: acc) ~last_loc + | token -> + Parse_error.not_allowed next_token.location ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + |> add_warning input; + junk input; + consume_rows acc ~last_loc + in + let rows, brace_location = consume_rows [] ~last_loc:parent_markup_location in + let grid = List.rev rows in + (Table.Heavy_syntax.from_grid grid, brace_location) + +(* Consumes a sequence of table cells (starting with '{th ...}' or '{td ... }', + which are represented by [`Begin_table_header] [`Begin_table_data] tokens). + + This function is called immediately after '{tr' ([`Begin_table_row]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and heavy_table_row ~parent_markup input = + let rec consume_cell_items acc = + let>> next_token = Reader.until_rbrace input acc in + match next_token.Loc.value with + | `Begin_table_header as token -> ( + junk input; + let content, _brace_location = + heavy_table_header input ~parent_markup:token + in + match content with + | None -> consume_cell_items ((`Header None, []) :: acc) + | Some (x, b) -> consume_cell_items ((`Header x, b) :: acc)) + | `Begin_table_data as token -> + junk input; + let content, token_after_list_item, _where_in_line = + block_element_list In_table_cell ~parent_markup:token input + in + (match token_after_list_item.value with + | `Right_brace -> junk input + | `End -> + Parse_error.not_allowed token_after_list_item.location + ~what:(Token.describe `End) ~in_what:(Token.describe token) + |> add_warning input); + consume_cell_items ((`Data, content) :: acc) + | token -> + Parse_error.not_allowed next_token.location ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + |> add_warning input; + junk input; + consume_cell_items acc + in + consume_cell_items [] + +(* Consumes a table header (that might start with '{L ...}', '{C ...}' or '{R ... }', + which are represented by [`Begin_paragraph_style _] tokens). + + This function is called immediately after '{th' ([`Begin_table_header]) is + read. The only "valid" way to exit is by reading a [`Right_brace] token, + which is consumed. *) +and heavy_table_header ~parent_markup input = + let rec consume_items acc = + let>> next_token = Reader.until_rbrace input acc in + match next_token.Loc.value with + | `Begin_paragraph_style style as token -> + junk input; + (match acc with + | Some _ -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + |> add_warning input + | None -> ()); + let content, token_after_list_item, _where_in_line = + block_element_list In_table_header ~parent_markup input + in + (match token_after_list_item.value with + | `Right_brace -> junk input + | `End -> + Parse_error.not_allowed token_after_list_item.location + ~what:(Token.describe `End) ~in_what:(Token.describe token) + |> add_warning input); + consume_items (Some (Some style, content)) + | token -> + (match acc with + | Some _ -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe token) + ~in_what:(Token.describe parent_markup) + |> add_warning input + | None -> ()); + let content, _token_after_list_item, _where_in_line = + block_element_list In_table_header ~parent_markup input + in + consume_items (Some (None, content)) + in + consume_items None + (* {2 Entry point} *) let parse warnings tokens = diff --git a/src/token.ml b/src/token.ml index 222820f0..6493f79b 100644 --- a/src/token.ml +++ b/src/token.ml @@ -69,8 +69,14 @@ type t = | (* List markup. *) `Begin_list of [ `Unordered | `Ordered ] | `Begin_list_item of [ `Li | `Dash ] + | (* Table markup. *) + `Begin_table of [ `Light | `Heavy ] + | `Begin_table_row + | `Begin_table_header + | `Begin_table_data | `Minus | `Plus + | `Bar | section_heading | tag ] @@ -87,8 +93,15 @@ 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_row -> "'{tr'" + | `Begin_table_header -> "'{th'" + | `Begin_table_data -> "'{td'" | `Minus -> "'-'" | `Plus -> "'+'" + | `Bar -> "'|'" | `Begin_section_heading (level, label) -> let label = match label with None -> "" | Some label -> ":" ^ label in Printf.sprintf "'{%i%s'" level label @@ -142,8 +155,14 @@ 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_row -> "'{tr ...}' (table row)" + | `Begin_table_header -> "'{th ... }' (table header cell)" + | `Begin_table_data -> "'{td ... }' (table data cell)" | `Minus -> "'-' (bulleted list item)" | `Plus -> "'+' (numbered list item)" + | `Bar -> "'|'" | `Begin_section_heading (level, _) -> Printf.sprintf "'{%i ...}' (section heading)" level | `Tag (`Author _) -> "'@author'" diff --git a/test/test.ml b/test/test.ml index c91c83c0..9fdeee60 100644 --- a/test/test.ml +++ b/test/test.ml @@ -29,6 +29,11 @@ module Ast_to_sexp = struct | `Superscript -> Atom "superscript" | `Subscript -> Atom "subscript" + let alignment : Ast.alignment -> sexp = function + | `Left -> Atom "left" + | `Center -> Atom "center" + | `Right -> Atom "right" + let reference_kind : Ast.reference_kind -> sexp = function | `Simple -> Atom "simple" | `With_text -> Atom "with_text" @@ -80,6 +85,26 @@ module Ast_to_sexp = struct |> fun items -> List items in List [ Atom kind; Atom weight; items ] + | `Table t -> ( + let map name x f = List [ Atom name; List (List.map f x) ] in + let to_sexp (type a) ((header, data, align) : a Ast.abstract_table) + ~syntax ~f = + List + [ + Atom "table"; + List [ Atom "syntax"; Atom syntax ]; + ( map "header" header @@ fun cell -> + map "cell" cell @@ at.at (f at) ); + ( map "data" data @@ fun row -> + map "row" row @@ fun cell -> map "cell" cell @@ at.at (f at) ); + (map "align" align @@ function + | Some a -> alignment a + | None -> Atom "none"); + ] + in + match t with + | `Light t -> to_sexp t ~syntax:"light" ~f:inline_element + | `Heavy t -> to_sexp t ~syntax:"heavy" ~f:nestable_block_element) let tag at : Ast.tag -> sexp = function | `Author s -> List [ Atom "@author"; Atom s ] diff --git a/test/test.mli b/test/test.mli new file mode 100644 index 00000000..4f83ff60 --- /dev/null +++ b/test/test.mli @@ -0,0 +1 @@ +val test : ?location:Odoc_parser.Loc.point -> string -> unit diff --git a/test/test_tables.ml b/test/test_tables.ml new file mode 100644 index 00000000..a88e5752 --- /dev/null +++ b/test/test_tables.ml @@ -0,0 +1,514 @@ +open Test + +[@@@ocaml.warning "-32"] + +let%expect_test _ = + let module Heavy = struct + let empty_table_heavy = + test "{table }"; + [%expect + {| + ((output + (((f.ml (1 0) (1 8)) + (table (syntax heavy) (header ()) (data ()) (align ()))))) + (warnings ())) |}] + + let empty_row = + test "{table {tr } }"; + [%expect + {| + ((output + (((f.ml (1 0) (1 14)) + (table (syntax heavy) (header ()) (data ()) (align ()))))) + (warnings ()))|}] + + let no_header = + test "{table {tr {td}}}"; + [%expect + {| + ((output + (((f.ml (1 0) (1 17)) + (table (syntax heavy) (header ()) (data ((row ((cell ()))))) (align ()))))) + (warnings ())) |}] + + let no_data = + test "{table {tr {th}}}"; + [%expect + {| + ((output + (((f.ml (1 0) (1 17)) + (table (syntax heavy) (header ((cell ()))) (data ()) (align (none)))))) + (warnings ())) |}] + + let multiple_headers = + test "{table {tr {th}} {tr {th}} {tr {td}}}"; + [%expect + {| + ((output + (((f.ml (1 0) (1 37)) + (table (syntax heavy) (header ((cell ()))) + (data ((row ((cell ()))) (row ((cell ()))))) (align (none)))))) + (warnings ())) |}] + + let complex_table = + test + {| + {table + {tr + {th xxx} + {th yyy} + } + {tr + {td aaaa bbb ccc {i ddd} + } + {td + {table {tr {td}}} + } + } + {tr + {td + - aaa + - bbb + - ccc + } + {td + {t + x | y | z + --|---|-- + 1 | 2 | 3 + } + } + } + } + |}; + [%expect + {| + ((output + (((f.ml (2 8) (28 9)) + (table (syntax heavy) + (header + ((cell + (((f.ml (4 16) (4 19)) + (paragraph (((f.ml (4 16) (4 19)) (word xxx))))))) + (cell + (((f.ml (5 16) (5 19)) + (paragraph (((f.ml (5 16) (5 19)) (word yyy))))))))) + (data + ((row + ((cell + (((f.ml (8 16) (8 36)) + (paragraph + (((f.ml (8 16) (8 20)) (word aaaa)) ((f.ml (8 20) (8 21)) space) + ((f.ml (8 21) (8 24)) (word bbb)) ((f.ml (8 24) (8 25)) space) + ((f.ml (8 25) (8 28)) (word ccc)) ((f.ml (8 28) (8 29)) space) + ((f.ml (8 29) (8 36)) + (italic (((f.ml (8 32) (8 35)) (word ddd)))))))))) + (cell + (((f.ml (11 15) (11 32)) + (table (syntax heavy) (header ()) (data ((row ((cell ()))))) + (align ()))))))) + (row + ((cell + (((f.ml (16 15) (18 20)) + (unordered light + ((((f.ml (16 17) (16 20)) + (paragraph (((f.ml (16 17) (16 20)) (word aaa)))))) + (((f.ml (17 17) (17 20)) + (paragraph (((f.ml (17 17) (17 20)) (word bbb)))))) + (((f.ml (18 17) (18 20)) + (paragraph (((f.ml (18 17) (18 20)) (word ccc))))))))))) + (cell + (((f.ml (21 14) (25 15)) + (table (syntax light) + (header + ((cell (((f.ml (22 17) (22 18)) (word x)))) + (cell (((f.ml (22 21) (22 22)) (word y)))) + (cell (((f.ml (22 25) (22 26)) (word z)))))) + (data + ((row + ((cell (((f.ml (24 17) (24 18)) (word 1)))) + (cell (((f.ml (24 21) (24 22)) (word 2)))) + (cell (((f.ml (24 25) (24 26)) (word 3)))))))) + (align (none none none)))))))))) + (align (none none)))))) + (warnings ())) |}] + + let align = + test + {| + {table + {tr + {th {L a}} + {th {C b}} + {th {R c}} + } + } + |}; + [%expect + {| + ((output + (((f.ml (2 8) (8 9)) + (table (syntax heavy) + (header + ((cell + (((f.ml (4 19) (4 20)) (paragraph (((f.ml (4 19) (4 20)) (word a))))))) + (cell + (((f.ml (5 19) (5 20)) (paragraph (((f.ml (5 19) (5 20)) (word b))))))) + (cell + (((f.ml (6 19) (6 20)) (paragraph (((f.ml (6 19) (6 20)) (word c))))))))) + (data ()) (align (left center right)))))) + (warnings ())) |}] + end in + () + +let%expect_test _ = + let module Light = struct + let empty_table_light = + test "{t }"; + [%expect + {| + ((output + (((f.ml (1 0) (1 4)) + (table (syntax light) (header ()) (data ()) (align ()))))) + (warnings ())) |}] + + let simple = + test {| + {t + | a | + } + |}; + [%expect + {| + ((output + (((f.ml (2 8) (4 9)) + (table (syntax light) (header ()) + (data ((row ((cell (((f.ml (3 12) (3 13)) (word a)))))))) (align ()))))) + (warnings ())) |}] + + let stars = + test + {| + {t + |a| *b*| + |*c| d* | + } + |}; + [%expect + {| + ((output + (((f.ml (2 8) (5 9)) + (table (syntax light) (header ()) + (data + ((row + ((cell (((f.ml (3 11) (3 12)) (word a)))) + (cell (((f.ml (3 16) (3 19)) (word *b*)))))) + (row + ((cell (((f.ml (4 11) (4 13)) (word *c)))) + (cell (((f.ml (4 15) (4 17)) (word d*)))))))) + (align ()))))) + (warnings ())) |}] + + let backquotes = + test {| + {t + | `a |` + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (4 7)) + (table (syntax light) (header ()) + (data + ((row + ((cell (((f.ml (3 11) (3 13)) (word `a)))) + (cell (((f.ml (3 15) (3 16)) (word `)))))))) + (align ()))))) + (warnings ())) |}] + + let no_header = + test {| + {t + |---|---| + | x | y | + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (5 7)) + (table (syntax light) (header ()) + (data + ((row + ((cell (((f.ml (4 9) (4 10)) (word x)))) + (cell (((f.ml (4 13) (4 14)) (word y)))))))) + (align (none none)))))) + (warnings ())) |}] + + let no_align = + test {| + {t + | x | y | + | x | y | + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (5 7)) + (table (syntax light) (header ()) + (data + ((row + ((cell (((f.ml (3 9) (3 10)) (word x)))) + (cell (((f.ml (3 13) (3 14)) (word y)))))) + (row + ((cell (((f.ml (4 9) (4 10)) (word x)))) + (cell (((f.ml (4 13) (4 14)) (word y)))))))) + (align ()))))) + (warnings ())) |}] + + let only_align = + test {| + {t + |--|--| + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (4 7)) + (table (syntax light) (header ()) (data ()) (align (none none)))))) + (warnings ())) |}] + + let no_data = + test {| + {t + | x | y | + |---|---| + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (5 7)) + (table (syntax light) + (header + ((cell (((f.ml (3 9) (3 10)) (word x)))) + (cell (((f.ml (3 13) (3 14)) (word y)))))) + (data ()) (align (none none)))))) + (warnings ())) |}] + + let alignment = + test + {| + {t + | a | b | c | d | + |---|:--|--:|:-:| + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (5 7)) + (table (syntax light) + (header + ((cell (((f.ml (3 9) (3 10)) (word a)))) + (cell (((f.ml (3 13) (3 14)) (word b)))) + (cell (((f.ml (3 17) (3 18)) (word c)))) + (cell (((f.ml (3 21) (3 22)) (word d)))))) + (data ()) (align (none left right center)))))) + (warnings ())) |}] + + let no_bars = + test + {| + {t + a | b | c | d + ---|:--|--:|:-: + a | b | c | d + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (6 7)) + (table (syntax light) + (header + ((cell (((f.ml (3 8) (3 9)) (word a)))) + (cell (((f.ml (3 12) (3 13)) (word b)))) + (cell (((f.ml (3 16) (3 17)) (word c)))) + (cell (((f.ml (3 20) (3 21)) (word d)))))) + (data + ((row + ((cell (((f.ml (5 8) (5 9)) (word a)))) + (cell (((f.ml (5 12) (5 13)) (word b)))) + (cell (((f.ml (5 16) (5 17)) (word c)))) + (cell (((f.ml (5 20) (5 21)) (word d)))))))) + (align (none left right center)))))) + (warnings ())) |}] + + let light_table_new_lines = + test + {| + {t + + | a | b | c | d | + + |---|---|---|---| + + | a | b | c | d | + + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (10 7)) + (table (syntax light) + (header + ((cell (((f.ml (4 9) (4 10)) (word a)))) + (cell (((f.ml (4 13) (4 14)) (word b)))) + (cell (((f.ml (4 17) (4 18)) (word c)))) + (cell (((f.ml (4 21) (4 22)) (word d)))))) + (data + ((row + ((cell (((f.ml (8 9) (8 10)) (word a)))) + (cell (((f.ml (8 13) (8 14)) (word b)))) + (cell (((f.ml (8 17) (8 18)) (word c)))) + (cell (((f.ml (8 21) (8 22)) (word d)))))))) + (align (none none none none)))))) + (warnings ())) |}] + + let light_table_markup = + test + {| + {t + | {i a} {:google.com} \t | | {m b} {e c} {% xyz %} | {b d} [foo] | + |---|---|---|---| + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (5 7)) + (table (syntax light) + (header + ((cell + (((f.ml (3 9) (3 14)) (italic (((f.ml (3 12) (3 13)) (word a))))) + ((f.ml (3 15) (3 28)) (google.com ())) + ((f.ml (3 29) (3 31)) (word "\\t")))) + (cell ()) + (cell + (((f.ml (3 36) (3 41)) (math_span b)) + ((f.ml (3 42) (3 47)) (emphasis (((f.ml (3 45) (3 46)) (word c))))) + ((f.ml (3 48) (3 57)) (raw_markup () " xyz ")))) + (cell + (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d))))) + ((f.ml (3 66) (3 71)) (code_span foo)))))) + (data ()) (align (none none none none)))))) + (warnings ())) |}] + + let no_space = + test + {| + {t + | a | b |c| d | + |---|--:|:--|:-:| + } + |}; + [%expect + {| + ((output + (((f.ml (2 7) (5 8)) + (table (syntax light) + (header + ((cell (((f.ml (3 11) (3 12)) (word a)))) + (cell (((f.ml (3 15) (3 16)) (word b)))) + (cell (((f.ml (3 18) (3 19)) (word c)))) + (cell (((f.ml (3 21) (3 22)) (word d)))))) + (data ()) (align (none right left center)))))) + (warnings ())) |}] + + let multiple_headers = + test + {| + {t + ||a|b| + |:-|---:| + |c|d| + |cc|dd| + |-:|:-:| + |e|f| + |g|h|| + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (10 7)) + (table (syntax light) + (header + ((cell ()) (cell (((f.ml (3 9) (3 10)) (word a)))) + (cell (((f.ml (3 11) (3 12)) (word b)))))) + (data + ((row + ((cell (((f.ml (5 8) (5 9)) (word c)))) + (cell (((f.ml (5 10) (5 11)) (word d)))))) + (row + ((cell (((f.ml (6 8) (6 10)) (word cc)))) + (cell (((f.ml (6 11) (6 13)) (word dd)))))) + (row + ((cell (((f.ml (7 8) (7 10)) (word -:)))) + (cell (((f.ml (7 11) (7 14)) (word :-:)))))) + (row + ((cell (((f.ml (8 8) (8 9)) (word e)))) + (cell (((f.ml (8 10) (8 11)) (word f)))))) + (row + ((cell (((f.ml (9 8) (9 9)) (word g)))) + (cell (((f.ml (9 10) (9 11)) (word h)))) (cell ()))))) + (align (left right)))))) + (warnings ())) |}] + + let block_element_in_cell = + test + {| + {t + | {[ a ]} | b | + |---|---| + } + |}; + [%expect + {| + ((output + (((f.ml (2 11) (5 12)) + (table (syntax light) + (header ((cell ()) (cell (((f.ml (3 23) (3 24)) (word b)))))) (data ()) + (align (none none)))))) + (warnings + ( "File \"f.ml\", line 3, characters 13-20:\ + \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] + + let block_element_in_row = + test + {| + {t + {[ a ]} + | a | b | + |---|---| + } + |}; + [%expect + {| + ((output + (((f.ml (2 11) (6 12)) + (table (syntax light) + (header + ((cell (((f.ml (4 13) (4 14)) (word a)))) + (cell (((f.ml (4 17) (4 18)) (word b)))))) + (data ()) (align (none none)))))) + (warnings + ( "File \"f.ml\", line 3, characters 11-18:\ + \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] + end in + () From 94bddbde9d9152bf0e0536c7b0ca3f813bf8185b Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 7 Feb 2023 13:29:01 +0000 Subject: [PATCH 02/19] Replace let>> with >>> --- src/syntax.ml | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/syntax.ml b/src/syntax.ml index 11872733..9e84f4c4 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -130,7 +130,7 @@ module Reader = struct consume () module Infix = struct - let ( let>> ) consume if_token = + let ( >>> ) consume if_token = match consume with | `End (ret, loc) -> (ret, loc) | `Token t -> if_token t @@ -1250,7 +1250,7 @@ and explicit_list_items : which is consumed. *) and light_table ~parent_markup ~parent_markup_location input = let rec consume_rows acc ~last_loc = - let>> next_token = Reader.until_rbrace input acc in + Reader.until_rbrace input acc >>> fun next_token -> match next_token.Loc.value with | `Bar | #token_that_always_begins_an_inline_element -> ( let next, row, last_loc = @@ -1315,7 +1315,7 @@ and light_table_row ~parent_markup ~last_loc input = which is consumed. *) and heavy_table ~parent_markup ~parent_markup_location input = let rec consume_rows acc ~last_loc = - let>> next_token = Reader.until_rbrace input acc in + Reader.until_rbrace input acc >>> fun next_token -> match next_token.Loc.value with | `Begin_table_row as token -> junk input; @@ -1340,7 +1340,7 @@ and heavy_table ~parent_markup ~parent_markup_location input = which is consumed. *) and heavy_table_row ~parent_markup input = let rec consume_cell_items acc = - let>> next_token = Reader.until_rbrace input acc in + Reader.until_rbrace input acc >>> fun next_token -> match next_token.Loc.value with | `Begin_table_header as token -> ( junk input; @@ -1379,7 +1379,7 @@ and heavy_table_row ~parent_markup input = which is consumed. *) and heavy_table_header ~parent_markup input = let rec consume_items acc = - let>> next_token = Reader.until_rbrace input acc in + Reader.until_rbrace input acc >>> fun next_token -> match next_token.Loc.value with | `Begin_paragraph_style style as token -> junk input; From cd1f507dbf743af57779fb1f7f49b731ea6c54a9 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 7 Feb 2023 13:48:08 +0000 Subject: [PATCH 03/19] Simplify alignment --- src/ast.ml | 2 +- src/compat.ml | 2 ++ src/compat.mli | 1 + src/syntax.ml | 19 ++++++++++--------- test/test.ml | 4 +--- test/test_tables.ml | 28 ++++++++++++++-------------- 6 files changed, 29 insertions(+), 27 deletions(-) diff --git a/src/ast.ml b/src/ast.ml index 4582e7e8..4a2c75ba 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -33,7 +33,7 @@ type inline_element = type 'a cell = 'a with_location list type 'a row = 'a cell list type 'a grid = 'a row list -type 'a abstract_table = 'a row * 'a grid * alignment option list +type 'a abstract_table = 'a row * 'a grid * alignment list type nestable_block_element = [ `Paragraph of inline_element with_location list diff --git a/src/compat.ml b/src/compat.ml index 526b6836..173f9b66 100644 --- a/src/compat.ml +++ b/src/compat.ml @@ -7,6 +7,8 @@ module Option = struct | None -> failwith "Option.value_exn None" | Some x -> x + let value ~default = function None -> default | Some x -> x + let join_list l = if List.for_all is_some l then Some (List.map value_exn l) else None end diff --git a/src/compat.mli b/src/compat.mli index 68cc0815..0959145c 100644 --- a/src/compat.mli +++ b/src/compat.mli @@ -5,6 +5,7 @@ module Option : sig val is_some : 'a option -> bool (** [is_some o] is [true] if and only if [o] is [Some o]. *) + val value : default:'a -> 'a option -> 'a val join_list : 'a option list -> 'a list option end diff --git a/src/syntax.ml b/src/syntax.ml index 9e84f4c4..f93c4b11 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -40,22 +40,24 @@ let peek input = module Table = struct module Light_syntax = struct + let default_align = `Center + let valid_align = function | [ { Loc.value = `Word w; _ } ] -> ( match String.length w with - | 0 -> Some None + | 0 -> Some default_align | 1 -> ( match w with - | "-" -> Some None - | ":" -> Some (Some `Center) + | "-" -> Some default_align + | ":" -> Some `Center | _ -> None) | len -> if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) then match (String.get w 0, String.get w (len - 1)) with - | ':', ':' -> Some (Some `Center) - | ':', '-' -> Some (Some `Left) - | '-', ':' -> Some (Some `Right) - | '-', '-' -> Some None + | ':', ':' -> Some `Center + | ':', '-' -> Some `Left + | '-', ':' -> Some `Right + | '-', '-' -> Some default_align | _ -> None else None) | _ -> None @@ -90,8 +92,7 @@ module Table = struct let valid_header_row row = List.map (function - | `Header (Some x), y -> Some (Some x, y) - | `Header None, y -> Some (None, y) + | `Header align, x -> Some (Option.value align ~default:`Center, x) | `Data, _ -> None) row |> Option.join_list diff --git a/test/test.ml b/test/test.ml index 9fdeee60..09d55696 100644 --- a/test/test.ml +++ b/test/test.ml @@ -97,9 +97,7 @@ module Ast_to_sexp = struct map "cell" cell @@ at.at (f at) ); ( map "data" data @@ fun row -> map "row" row @@ fun cell -> map "cell" cell @@ at.at (f at) ); - (map "align" align @@ function - | Some a -> alignment a - | None -> Atom "none"); + map "align" align @@ alignment; ] in match t with diff --git a/test/test_tables.ml b/test/test_tables.ml index a88e5752..4324571a 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -37,7 +37,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (header ((cell ()))) (data ()) (align (none)))))) + (table (syntax heavy) (header ((cell ()))) (data ()) (align (center)))))) (warnings ())) |}] let multiple_headers = @@ -47,7 +47,7 @@ let%expect_test _ = ((output (((f.ml (1 0) (1 37)) (table (syntax heavy) (header ((cell ()))) - (data ((row ((cell ()))) (row ((cell ()))))) (align (none)))))) + (data ((row ((cell ()))) (row ((cell ()))))) (align (center)))))) (warnings ())) |}] let complex_table = @@ -129,8 +129,8 @@ let%expect_test _ = ((cell (((f.ml (24 17) (24 18)) (word 1)))) (cell (((f.ml (24 21) (24 22)) (word 2)))) (cell (((f.ml (24 25) (24 26)) (word 3)))))))) - (align (none none none)))))))))) - (align (none none)))))) + (align (center center center)))))))))) + (align (center center)))))) (warnings ())) |}] let align = @@ -243,7 +243,7 @@ let%expect_test _ = ((row ((cell (((f.ml (4 9) (4 10)) (word x)))) (cell (((f.ml (4 13) (4 14)) (word y)))))))) - (align (none none)))))) + (align (center center)))))) (warnings ())) |}] let no_align = @@ -278,7 +278,7 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (4 7)) - (table (syntax light) (header ()) (data ()) (align (none none)))))) + (table (syntax light) (header ()) (data ()) (align (center center)))))) (warnings ())) |}] let no_data = @@ -296,7 +296,7 @@ let%expect_test _ = (header ((cell (((f.ml (3 9) (3 10)) (word x)))) (cell (((f.ml (3 13) (3 14)) (word y)))))) - (data ()) (align (none none)))))) + (data ()) (align (center center)))))) (warnings ())) |}] let alignment = @@ -317,7 +317,7 @@ let%expect_test _ = (cell (((f.ml (3 13) (3 14)) (word b)))) (cell (((f.ml (3 17) (3 18)) (word c)))) (cell (((f.ml (3 21) (3 22)) (word d)))))) - (data ()) (align (none left right center)))))) + (data ()) (align (center left right center)))))) (warnings ())) |}] let no_bars = @@ -345,7 +345,7 @@ let%expect_test _ = (cell (((f.ml (5 12) (5 13)) (word b)))) (cell (((f.ml (5 16) (5 17)) (word c)))) (cell (((f.ml (5 20) (5 21)) (word d)))))))) - (align (none left right center)))))) + (align (center left right center)))))) (warnings ())) |}] let light_table_new_lines = @@ -377,7 +377,7 @@ let%expect_test _ = (cell (((f.ml (8 13) (8 14)) (word b)))) (cell (((f.ml (8 17) (8 18)) (word c)))) (cell (((f.ml (8 21) (8 22)) (word d)))))))) - (align (none none none none)))))) + (align (center center center center)))))) (warnings ())) |}] let light_table_markup = @@ -406,7 +406,7 @@ let%expect_test _ = (cell (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d))))) ((f.ml (3 66) (3 71)) (code_span foo)))))) - (data ()) (align (none none none none)))))) + (data ()) (align (center center center center)))))) (warnings ())) |}] let no_space = @@ -427,7 +427,7 @@ let%expect_test _ = (cell (((f.ml (3 15) (3 16)) (word b)))) (cell (((f.ml (3 18) (3 19)) (word c)))) (cell (((f.ml (3 21) (3 22)) (word d)))))) - (data ()) (align (none right left center)))))) + (data ()) (align (center right left center)))))) (warnings ())) |}] let multiple_headers = @@ -484,7 +484,7 @@ let%expect_test _ = (((f.ml (2 11) (5 12)) (table (syntax light) (header ((cell ()) (cell (((f.ml (3 23) (3 24)) (word b)))))) (data ()) - (align (none none)))))) + (align (center center)))))) (warnings ( "File \"f.ml\", line 3, characters 13-20:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] @@ -506,7 +506,7 @@ let%expect_test _ = (header ((cell (((f.ml (4 13) (4 14)) (word a)))) (cell (((f.ml (4 17) (4 18)) (word b)))))) - (data ()) (align (none none)))))) + (data ()) (align (center center)))))) (warnings ( "File \"f.ml\", line 3, characters 11-18:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] From bca49722691bbfdb5d3d117b95ecbe727b483e32 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 7 Feb 2023 13:56:47 +0000 Subject: [PATCH 04/19] join_list without exception --- src/compat.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/compat.ml b/src/compat.ml index 173f9b66..a7b535d1 100644 --- a/src/compat.ml +++ b/src/compat.ml @@ -2,15 +2,15 @@ module Option = struct type 'a t = 'a option = None | Some of 'a let is_some = function None -> false | Some _ -> true - - let value_exn = function - | None -> failwith "Option.value_exn None" - | Some x -> x - let value ~default = function None -> default | Some x -> x let join_list l = - if List.for_all is_some l then Some (List.map value_exn l) else None + let rec loop acc = function + | [] -> Some (List.rev acc) + | Some a :: q -> loop (a :: acc) q + | None :: _ -> None + in + loop [] l end module Char = struct From 0e7e528a64dc554c81c7f2dc2dda0addd8ed6815 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 7 Feb 2023 14:43:19 +0000 Subject: [PATCH 05/19] Convert light table contents to nestable block elements --- src/ast.ml | 4 +- src/syntax.ml | 10 +- test/test.ml | 30 +++--- test/test_tables.ml | 246 +++++++++++++++++++++++++++++++------------- 4 files changed, 199 insertions(+), 91 deletions(-) diff --git a/src/ast.ml b/src/ast.ml index 4a2c75ba..fb325cad 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -55,9 +55,7 @@ type nestable_block_element = {{:https://ocaml.org/releases/4.12/htmlman/ocamldoc.html#sss:ocamldoc-list}manual}). *) -and table = - [ `Light of inline_element abstract_table - | `Heavy of nestable_block_element abstract_table ] +and table = nestable_block_element abstract_table * [ `Light | `Heavy ] type internal_tag = [ `Canonical of string with_location | `Inline | `Open | `Closed ] diff --git a/src/syntax.ml b/src/syntax.ml index f93c4b11..d1765fee 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -63,7 +63,13 @@ module Table = struct | _ -> None let valid_align_row lx = List.map valid_align lx |> Option.join_list - let create ~header ~data ~align : Ast.table = `Light (header, data, align) + + let create ~header ~data ~align : Ast.table = + let to_block x = Loc.at x.Loc.location (`Paragraph [ x ]) in + let cell_to_block = List.map to_block in + let row_to_block = List.map cell_to_block in + let grid_to_block = List.map row_to_block in + ((row_to_block header, grid_to_block data, align), `Light) let from_grid (grid : _ Ast.grid) : Ast.table = match grid with @@ -87,7 +93,7 @@ module Table = struct end module Heavy_syntax = struct - let create ~header ~data ~align : Ast.table = `Heavy (header, data, align) + let create ~header ~data ~align : Ast.table = ((header, data, align), `Heavy) let valid_header_row row = List.map diff --git a/test/test.ml b/test/test.ml index 09d55696..946c6b6f 100644 --- a/test/test.ml +++ b/test/test.ml @@ -85,24 +85,20 @@ module Ast_to_sexp = struct |> fun items -> List items in List [ Atom kind; Atom weight; items ] - | `Table t -> ( + | `Table ((header, data, align), s) -> + let syntax = function `Light -> "light" | `Heavy -> "heavy" in let map name x f = List [ Atom name; List (List.map f x) ] in - let to_sexp (type a) ((header, data, align) : a Ast.abstract_table) - ~syntax ~f = - List - [ - Atom "table"; - List [ Atom "syntax"; Atom syntax ]; - ( map "header" header @@ fun cell -> - map "cell" cell @@ at.at (f at) ); - ( map "data" data @@ fun row -> - map "row" row @@ fun cell -> map "cell" cell @@ at.at (f at) ); - map "align" align @@ alignment; - ] - in - match t with - | `Light t -> to_sexp t ~syntax:"light" ~f:inline_element - | `Heavy t -> to_sexp t ~syntax:"heavy" ~f:nestable_block_element) + List + [ + Atom "table"; + List [ Atom "syntax"; Atom (syntax s) ]; + ( map "header" header @@ fun cell -> + map "cell" cell @@ at.at (nestable_block_element at) ); + ( map "data" data @@ fun row -> + map "row" row @@ fun cell -> + map "cell" cell @@ at.at (nestable_block_element at) ); + map "align" align @@ alignment; + ] let tag at : Ast.tag -> sexp = function | `Author s -> List [ Atom "@author"; Atom s ] diff --git a/test/test_tables.ml b/test/test_tables.ml index 4324571a..4e3dcc30 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -121,14 +121,26 @@ let%expect_test _ = (((f.ml (21 14) (25 15)) (table (syntax light) (header - ((cell (((f.ml (22 17) (22 18)) (word x)))) - (cell (((f.ml (22 21) (22 22)) (word y)))) - (cell (((f.ml (22 25) (22 26)) (word z)))))) + ((cell + (((f.ml (22 17) (22 18)) + (paragraph (((f.ml (22 17) (22 18)) (word x))))))) + (cell + (((f.ml (22 21) (22 22)) + (paragraph (((f.ml (22 21) (22 22)) (word y))))))) + (cell + (((f.ml (22 25) (22 26)) + (paragraph (((f.ml (22 25) (22 26)) (word z))))))))) (data ((row - ((cell (((f.ml (24 17) (24 18)) (word 1)))) - (cell (((f.ml (24 21) (24 22)) (word 2)))) - (cell (((f.ml (24 25) (24 26)) (word 3)))))))) + ((cell + (((f.ml (24 17) (24 18)) + (paragraph (((f.ml (24 17) (24 18)) (word 1))))))) + (cell + (((f.ml (24 21) (24 22)) + (paragraph (((f.ml (24 21) (24 22)) (word 2))))))) + (cell + (((f.ml (24 25) (24 26)) + (paragraph (((f.ml (24 25) (24 26)) (word 3))))))))))) (align (center center center)))))))))) (align (center center)))))) (warnings ())) |}] @@ -183,7 +195,12 @@ let%expect_test _ = ((output (((f.ml (2 8) (4 9)) (table (syntax light) (header ()) - (data ((row ((cell (((f.ml (3 12) (3 13)) (word a)))))))) (align ()))))) + (data + ((row + ((cell + (((f.ml (3 12) (3 13)) + (paragraph (((f.ml (3 12) (3 13)) (word a))))))))))) + (align ()))))) (warnings ())) |}] let stars = @@ -201,11 +218,19 @@ let%expect_test _ = (table (syntax light) (header ()) (data ((row - ((cell (((f.ml (3 11) (3 12)) (word a)))) - (cell (((f.ml (3 16) (3 19)) (word *b*)))))) + ((cell + (((f.ml (3 11) (3 12)) + (paragraph (((f.ml (3 11) (3 12)) (word a))))))) + (cell + (((f.ml (3 16) (3 19)) + (paragraph (((f.ml (3 16) (3 19)) (word *b*))))))))) (row - ((cell (((f.ml (4 11) (4 13)) (word *c)))) - (cell (((f.ml (4 15) (4 17)) (word d*)))))))) + ((cell + (((f.ml (4 11) (4 13)) + (paragraph (((f.ml (4 11) (4 13)) (word *c))))))) + (cell + (((f.ml (4 15) (4 17)) + (paragraph (((f.ml (4 15) (4 17)) (word d*))))))))))) (align ()))))) (warnings ())) |}] @@ -222,8 +247,12 @@ let%expect_test _ = (table (syntax light) (header ()) (data ((row - ((cell (((f.ml (3 11) (3 13)) (word `a)))) - (cell (((f.ml (3 15) (3 16)) (word `)))))))) + ((cell + (((f.ml (3 11) (3 13)) + (paragraph (((f.ml (3 11) (3 13)) (word `a))))))) + (cell + (((f.ml (3 15) (3 16)) + (paragraph (((f.ml (3 15) (3 16)) (word `))))))))))) (align ()))))) (warnings ())) |}] @@ -241,8 +270,11 @@ let%expect_test _ = (table (syntax light) (header ()) (data ((row - ((cell (((f.ml (4 9) (4 10)) (word x)))) - (cell (((f.ml (4 13) (4 14)) (word y)))))))) + ((cell + (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word x))))))) + (cell + (((f.ml (4 13) (4 14)) + (paragraph (((f.ml (4 13) (4 14)) (word y))))))))))) (align (center center)))))) (warnings ())) |}] @@ -260,11 +292,17 @@ let%expect_test _ = (table (syntax light) (header ()) (data ((row - ((cell (((f.ml (3 9) (3 10)) (word x)))) - (cell (((f.ml (3 13) (3 14)) (word y)))))) + ((cell + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) + (cell + (((f.ml (3 13) (3 14)) + (paragraph (((f.ml (3 13) (3 14)) (word y))))))))) (row - ((cell (((f.ml (4 9) (4 10)) (word x)))) - (cell (((f.ml (4 13) (4 14)) (word y)))))))) + ((cell + (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word x))))))) + (cell + (((f.ml (4 13) (4 14)) + (paragraph (((f.ml (4 13) (4 14)) (word y))))))))))) (align ()))))) (warnings ())) |}] @@ -294,8 +332,10 @@ let%expect_test _ = (((f.ml (2 6) (5 7)) (table (syntax light) (header - ((cell (((f.ml (3 9) (3 10)) (word x)))) - (cell (((f.ml (3 13) (3 14)) (word y)))))) + ((cell + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) + (cell + (((f.ml (3 13) (3 14)) (paragraph (((f.ml (3 13) (3 14)) (word y))))))))) (data ()) (align (center center)))))) (warnings ())) |}] @@ -313,10 +353,14 @@ let%expect_test _ = (((f.ml (2 6) (5 7)) (table (syntax light) (header - ((cell (((f.ml (3 9) (3 10)) (word a)))) - (cell (((f.ml (3 13) (3 14)) (word b)))) - (cell (((f.ml (3 17) (3 18)) (word c)))) - (cell (((f.ml (3 21) (3 22)) (word d)))))) + ((cell + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) + (cell + (((f.ml (3 13) (3 14)) (paragraph (((f.ml (3 13) (3 14)) (word b))))))) + (cell + (((f.ml (3 17) (3 18)) (paragraph (((f.ml (3 17) (3 18)) (word c))))))) + (cell + (((f.ml (3 21) (3 22)) (paragraph (((f.ml (3 21) (3 22)) (word d))))))))) (data ()) (align (center left right center)))))) (warnings ())) |}] @@ -335,16 +379,27 @@ let%expect_test _ = (((f.ml (2 6) (6 7)) (table (syntax light) (header - ((cell (((f.ml (3 8) (3 9)) (word a)))) - (cell (((f.ml (3 12) (3 13)) (word b)))) - (cell (((f.ml (3 16) (3 17)) (word c)))) - (cell (((f.ml (3 20) (3 21)) (word d)))))) + ((cell + (((f.ml (3 8) (3 9)) (paragraph (((f.ml (3 8) (3 9)) (word a))))))) + (cell + (((f.ml (3 12) (3 13)) (paragraph (((f.ml (3 12) (3 13)) (word b))))))) + (cell + (((f.ml (3 16) (3 17)) (paragraph (((f.ml (3 16) (3 17)) (word c))))))) + (cell + (((f.ml (3 20) (3 21)) (paragraph (((f.ml (3 20) (3 21)) (word d))))))))) (data ((row - ((cell (((f.ml (5 8) (5 9)) (word a)))) - (cell (((f.ml (5 12) (5 13)) (word b)))) - (cell (((f.ml (5 16) (5 17)) (word c)))) - (cell (((f.ml (5 20) (5 21)) (word d)))))))) + ((cell + (((f.ml (5 8) (5 9)) (paragraph (((f.ml (5 8) (5 9)) (word a))))))) + (cell + (((f.ml (5 12) (5 13)) + (paragraph (((f.ml (5 12) (5 13)) (word b))))))) + (cell + (((f.ml (5 16) (5 17)) + (paragraph (((f.ml (5 16) (5 17)) (word c))))))) + (cell + (((f.ml (5 20) (5 21)) + (paragraph (((f.ml (5 20) (5 21)) (word d))))))))))) (align (center left right center)))))) (warnings ())) |}] @@ -367,16 +422,27 @@ let%expect_test _ = (((f.ml (2 6) (10 7)) (table (syntax light) (header - ((cell (((f.ml (4 9) (4 10)) (word a)))) - (cell (((f.ml (4 13) (4 14)) (word b)))) - (cell (((f.ml (4 17) (4 18)) (word c)))) - (cell (((f.ml (4 21) (4 22)) (word d)))))) + ((cell + (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word a))))))) + (cell + (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word b))))))) + (cell + (((f.ml (4 17) (4 18)) (paragraph (((f.ml (4 17) (4 18)) (word c))))))) + (cell + (((f.ml (4 21) (4 22)) (paragraph (((f.ml (4 21) (4 22)) (word d))))))))) (data ((row - ((cell (((f.ml (8 9) (8 10)) (word a)))) - (cell (((f.ml (8 13) (8 14)) (word b)))) - (cell (((f.ml (8 17) (8 18)) (word c)))) - (cell (((f.ml (8 21) (8 22)) (word d)))))))) + ((cell + (((f.ml (8 9) (8 10)) (paragraph (((f.ml (8 9) (8 10)) (word a))))))) + (cell + (((f.ml (8 13) (8 14)) + (paragraph (((f.ml (8 13) (8 14)) (word b))))))) + (cell + (((f.ml (8 17) (8 18)) + (paragraph (((f.ml (8 17) (8 18)) (word c))))))) + (cell + (((f.ml (8 21) (8 22)) + (paragraph (((f.ml (8 21) (8 22)) (word d))))))))))) (align (center center center center)))))) (warnings ())) |}] @@ -395,17 +461,29 @@ let%expect_test _ = (table (syntax light) (header ((cell - (((f.ml (3 9) (3 14)) (italic (((f.ml (3 12) (3 13)) (word a))))) - ((f.ml (3 15) (3 28)) (google.com ())) - ((f.ml (3 29) (3 31)) (word "\\t")))) + (((f.ml (3 9) (3 14)) + (paragraph + (((f.ml (3 9) (3 14)) (italic (((f.ml (3 12) (3 13)) (word a)))))))) + ((f.ml (3 15) (3 28)) + (paragraph (((f.ml (3 15) (3 28)) (google.com ()))))) + ((f.ml (3 29) (3 31)) + (paragraph (((f.ml (3 29) (3 31)) (word "\\t"))))))) (cell ()) (cell - (((f.ml (3 36) (3 41)) (math_span b)) - ((f.ml (3 42) (3 47)) (emphasis (((f.ml (3 45) (3 46)) (word c))))) - ((f.ml (3 48) (3 57)) (raw_markup () " xyz ")))) + (((f.ml (3 36) (3 41)) + (paragraph (((f.ml (3 36) (3 41)) (math_span b))))) + ((f.ml (3 42) (3 47)) + (paragraph + (((f.ml (3 42) (3 47)) + (emphasis (((f.ml (3 45) (3 46)) (word c)))))))) + ((f.ml (3 48) (3 57)) + (paragraph (((f.ml (3 48) (3 57)) (raw_markup () " xyz "))))))) (cell - (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d))))) - ((f.ml (3 66) (3 71)) (code_span foo)))))) + (((f.ml (3 60) (3 65)) + (paragraph + (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d)))))))) + ((f.ml (3 66) (3 71)) + (paragraph (((f.ml (3 66) (3 71)) (code_span foo))))))))) (data ()) (align (center center center center)))))) (warnings ())) |}] @@ -423,10 +501,14 @@ let%expect_test _ = (((f.ml (2 7) (5 8)) (table (syntax light) (header - ((cell (((f.ml (3 11) (3 12)) (word a)))) - (cell (((f.ml (3 15) (3 16)) (word b)))) - (cell (((f.ml (3 18) (3 19)) (word c)))) - (cell (((f.ml (3 21) (3 22)) (word d)))))) + ((cell + (((f.ml (3 11) (3 12)) (paragraph (((f.ml (3 11) (3 12)) (word a))))))) + (cell + (((f.ml (3 15) (3 16)) (paragraph (((f.ml (3 15) (3 16)) (word b))))))) + (cell + (((f.ml (3 18) (3 19)) (paragraph (((f.ml (3 18) (3 19)) (word c))))))) + (cell + (((f.ml (3 21) (3 22)) (paragraph (((f.ml (3 21) (3 22)) (word d))))))))) (data ()) (align (center right left center)))))) (warnings ())) |}] @@ -449,24 +531,45 @@ let%expect_test _ = (((f.ml (2 6) (10 7)) (table (syntax light) (header - ((cell ()) (cell (((f.ml (3 9) (3 10)) (word a)))) - (cell (((f.ml (3 11) (3 12)) (word b)))))) + ((cell ()) + (cell + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) + (cell + (((f.ml (3 11) (3 12)) (paragraph (((f.ml (3 11) (3 12)) (word b))))))))) (data ((row - ((cell (((f.ml (5 8) (5 9)) (word c)))) - (cell (((f.ml (5 10) (5 11)) (word d)))))) + ((cell + (((f.ml (5 8) (5 9)) (paragraph (((f.ml (5 8) (5 9)) (word c))))))) + (cell + (((f.ml (5 10) (5 11)) + (paragraph (((f.ml (5 10) (5 11)) (word d))))))))) (row - ((cell (((f.ml (6 8) (6 10)) (word cc)))) - (cell (((f.ml (6 11) (6 13)) (word dd)))))) + ((cell + (((f.ml (6 8) (6 10)) + (paragraph (((f.ml (6 8) (6 10)) (word cc))))))) + (cell + (((f.ml (6 11) (6 13)) + (paragraph (((f.ml (6 11) (6 13)) (word dd))))))))) (row - ((cell (((f.ml (7 8) (7 10)) (word -:)))) - (cell (((f.ml (7 11) (7 14)) (word :-:)))))) + ((cell + (((f.ml (7 8) (7 10)) + (paragraph (((f.ml (7 8) (7 10)) (word -:))))))) + (cell + (((f.ml (7 11) (7 14)) + (paragraph (((f.ml (7 11) (7 14)) (word :-:))))))))) (row - ((cell (((f.ml (8 8) (8 9)) (word e)))) - (cell (((f.ml (8 10) (8 11)) (word f)))))) + ((cell + (((f.ml (8 8) (8 9)) (paragraph (((f.ml (8 8) (8 9)) (word e))))))) + (cell + (((f.ml (8 10) (8 11)) + (paragraph (((f.ml (8 10) (8 11)) (word f))))))))) (row - ((cell (((f.ml (9 8) (9 9)) (word g)))) - (cell (((f.ml (9 10) (9 11)) (word h)))) (cell ()))))) + ((cell + (((f.ml (9 8) (9 9)) (paragraph (((f.ml (9 8) (9 9)) (word g))))))) + (cell + (((f.ml (9 10) (9 11)) + (paragraph (((f.ml (9 10) (9 11)) (word h))))))) + (cell ()))))) (align (left right)))))) (warnings ())) |}] @@ -483,8 +586,11 @@ let%expect_test _ = ((output (((f.ml (2 11) (5 12)) (table (syntax light) - (header ((cell ()) (cell (((f.ml (3 23) (3 24)) (word b)))))) (data ()) - (align (center center)))))) + (header + ((cell ()) + (cell + (((f.ml (3 23) (3 24)) (paragraph (((f.ml (3 23) (3 24)) (word b))))))))) + (data ()) (align (center center)))))) (warnings ( "File \"f.ml\", line 3, characters 13-20:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] @@ -504,8 +610,10 @@ let%expect_test _ = (((f.ml (2 11) (6 12)) (table (syntax light) (header - ((cell (((f.ml (4 13) (4 14)) (word a)))) - (cell (((f.ml (4 17) (4 18)) (word b)))))) + ((cell + (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word a))))))) + (cell + (((f.ml (4 17) (4 18)) (paragraph (((f.ml (4 17) (4 18)) (word b))))))))) (data ()) (align (center center)))))) (warnings ( "File \"f.ml\", line 3, characters 11-18:\ From 6237d0febb2f11811344438c078d80c20cdb183a Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Fri, 10 Feb 2023 13:20:44 +0000 Subject: [PATCH 06/19] Do not allow alignment in heavy tables --- src/syntax.ml | 74 ++++++++++++++------------------------------- test/test_tables.ml | 32 ++------------------ 2 files changed, 25 insertions(+), 81 deletions(-) diff --git a/src/syntax.ml b/src/syntax.ml index d1765fee..c29a3648 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -93,31 +93,25 @@ module Table = struct end module Heavy_syntax = struct - let create ~header ~data ~align : Ast.table = ((header, data, align), `Heavy) + let create ~header ~data : Ast.table = ((header, data, []), `Heavy) let valid_header_row row = - List.map - (function - | `Header align, x -> Some (Option.value align ~default:`Center, x) - | `Data, _ -> None) - row + List.map (function `Header, x -> Some x | `Data, _ -> None) row |> Option.join_list let from_grid grid : Ast.table = match grid with - | [] -> create ~header:[] ~data:[] ~align:[] + | [] -> create ~header:[] ~data:[] | row1 :: rows2_N -> - let header, data, align = + let header, data = (* If the first line is the header row, everything else is data. *) match valid_header_row row1 with - | Some header -> - let align, header = List.split header in - (header, rows2_N, align) + | Some header -> (header, rows2_N) (* Otherwise everything is considered data. *) - | None -> ([], grid, []) + | None -> ([], grid) in let data = List.map (List.map snd) data in - create ~header ~data ~align + create ~header ~data end end @@ -1349,14 +1343,12 @@ and heavy_table_row ~parent_markup input = let rec consume_cell_items acc = Reader.until_rbrace input acc >>> fun next_token -> match next_token.Loc.value with - | `Begin_table_header as token -> ( + | `Begin_table_header as token -> junk input; let content, _brace_location = heavy_table_header input ~parent_markup:token in - match content with - | None -> consume_cell_items ((`Header None, []) :: acc) - | Some (x, b) -> consume_cell_items ((`Header x, b) :: acc)) + consume_cell_items ((`Header, content) :: acc) | `Begin_table_data as token -> junk input; let content, token_after_list_item, _where_in_line = @@ -1378,8 +1370,7 @@ and heavy_table_row ~parent_markup input = in consume_cell_items [] -(* Consumes a table header (that might start with '{L ...}', '{C ...}' or '{R ... }', - which are represented by [`Begin_paragraph_style _] tokens). +(* Consumes a table header. This function is called immediately after '{th' ([`Begin_table_header]) is read. The only "valid" way to exit is by reading a [`Right_brace] token, @@ -1387,40 +1378,19 @@ and heavy_table_row ~parent_markup input = and heavy_table_header ~parent_markup input = let rec consume_items acc = Reader.until_rbrace input acc >>> fun next_token -> - match next_token.Loc.value with - | `Begin_paragraph_style style as token -> - junk input; - (match acc with - | Some _ -> - Parse_error.not_allowed next_token.location - ~what:(Token.describe token) - ~in_what:(Token.describe parent_markup) - |> add_warning input - | None -> ()); - let content, token_after_list_item, _where_in_line = - block_element_list In_table_header ~parent_markup input - in - (match token_after_list_item.value with - | `Right_brace -> junk input - | `End -> - Parse_error.not_allowed token_after_list_item.location - ~what:(Token.describe `End) ~in_what:(Token.describe token) - |> add_warning input); - consume_items (Some (Some style, content)) - | token -> - (match acc with - | Some _ -> - Parse_error.not_allowed next_token.location - ~what:(Token.describe token) - ~in_what:(Token.describe parent_markup) - |> add_warning input - | None -> ()); - let content, _token_after_list_item, _where_in_line = - block_element_list In_table_header ~parent_markup input - in - consume_items (Some (None, content)) + (match acc with + | _ :: _ -> + Parse_error.not_allowed next_token.location + ~what:(Token.describe next_token.value) + ~in_what:(Token.describe parent_markup) + |> add_warning input + | [] -> ()); + let content, _token_after_list_item, _where_in_line = + block_element_list In_table_header ~parent_markup input + in + consume_items content in - consume_items None + consume_items [] (* {2 Entry point} *) diff --git a/test/test_tables.ml b/test/test_tables.ml index 4e3dcc30..3d7d00ac 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -37,7 +37,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (header ((cell ()))) (data ()) (align (center)))))) + (table (syntax heavy) (header ((cell ()))) (data ()) (align ()))))) (warnings ())) |}] let multiple_headers = @@ -47,7 +47,7 @@ let%expect_test _ = ((output (((f.ml (1 0) (1 37)) (table (syntax heavy) (header ((cell ()))) - (data ((row ((cell ()))) (row ((cell ()))))) (align (center)))))) + (data ((row ((cell ()))) (row ((cell ()))))) (align ()))))) (warnings ())) |}] let complex_table = @@ -142,33 +142,7 @@ let%expect_test _ = (((f.ml (24 25) (24 26)) (paragraph (((f.ml (24 25) (24 26)) (word 3))))))))))) (align (center center center)))))))))) - (align (center center)))))) - (warnings ())) |}] - - let align = - test - {| - {table - {tr - {th {L a}} - {th {C b}} - {th {R c}} - } - } - |}; - [%expect - {| - ((output - (((f.ml (2 8) (8 9)) - (table (syntax heavy) - (header - ((cell - (((f.ml (4 19) (4 20)) (paragraph (((f.ml (4 19) (4 20)) (word a))))))) - (cell - (((f.ml (5 19) (5 20)) (paragraph (((f.ml (5 19) (5 20)) (word b))))))) - (cell - (((f.ml (6 19) (6 20)) (paragraph (((f.ml (6 19) (6 20)) (word c))))))))) - (data ()) (align (left center right)))))) + (align ()))))) (warnings ())) |}] end in () From 9c34050a1615281f22e2978417d6592673acd923 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Fri, 10 Feb 2023 13:26:31 +0000 Subject: [PATCH 07/19] Typo --- src/syntax.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/syntax.ml b/src/syntax.ml index c29a3648..941dd525 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -475,7 +475,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = (* {3 Helper types} *) (* The interpretation of tokens in the block parser depends on where on a line - each token appears. The five possible "locations" are: + each token appears. The seven possible "locations" are: - [`At_start_of_line], when only whitespace has been read on the current line. From 486fd61ff512d7fb59004fb7a2fc59095f86da5e Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Fri, 10 Feb 2023 16:08:56 +0000 Subject: [PATCH 08/19] Preserve td/th in the datatype --- src/ast.ml | 4 +- src/lexer.mll | 4 +- src/syntax.ml | 97 ++++--------- src/token.ml | 11 +- test/test.ml | 9 +- test/test_tables.ml | 346 +++++++++++++++++++++++--------------------- 6 files changed, 222 insertions(+), 249 deletions(-) diff --git a/src/ast.ml b/src/ast.ml index fb325cad..2e2fa7c4 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -30,10 +30,10 @@ type inline_element = text. Similarly the [`Link] constructor has the link itself as first parameter and the second is the replacement text. *) -type 'a cell = 'a with_location list +type 'a cell = 'a with_location list * [ `Header | `Data ] type 'a row = 'a cell list type 'a grid = 'a row list -type 'a abstract_table = 'a row * 'a grid * alignment list +type 'a abstract_table = 'a grid * alignment list type nestable_block_element = [ `Paragraph of inline_element with_location list diff --git a/src/lexer.mll b/src/lexer.mll index 576e5c61..5fe5f230 100644 --- a/src/lexer.mll +++ b/src/lexer.mll @@ -411,10 +411,10 @@ rule token input = parse { emit input `Begin_table_row } | "{th" - { emit input `Begin_table_header } + { emit input (`Begin_table_cell `Header) } | "{td" - { emit input `Begin_table_data } + { emit input (`Begin_table_cell `Data) } | '{' (['0'-'9']+ as level) ':' (([^ '}'] # space_char)* as label) { emit diff --git a/src/syntax.ml b/src/syntax.ml index 941dd525..5a7bc027 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -64,54 +64,46 @@ module Table = struct let valid_align_row lx = List.map valid_align lx |> Option.join_list - let create ~header ~data ~align : Ast.table = + let create ~grid ~align : Ast.table = let to_block x = Loc.at x.Loc.location (`Paragraph [ x ]) in - let cell_to_block = List.map to_block in + let cell_to_block (x, k) = (List.map to_block x, k) in let row_to_block = List.map cell_to_block in let grid_to_block = List.map row_to_block in - ((row_to_block header, grid_to_block data, align), `Light) + ((grid_to_block grid, align), `Light) - let from_grid (grid : _ Ast.grid) : Ast.table = + let with_kind kind : 'a with_location list list -> 'a Ast.row = + List.map (fun c -> (c, kind)) + + let from_grid grid : Ast.table = match grid with - | [] -> create ~header:[] ~data:[] ~align:[] + | [] -> create ~grid:[] ~align:[] | row1 :: rows2_N -> ( match valid_align_row row1 with (* If the first line is the align row, everything else is data. *) - | Some align -> create ~header:[] ~data:rows2_N ~align + | Some align -> + create ~grid:(List.map (with_kind `Data) rows2_N) ~align | None -> ( match rows2_N with (* Only 1 line, if this is not the align row this is data. *) - | [] -> create ~header:[] ~data:[ row1 ] ~align:[] + | [] -> create ~grid:[ with_kind `Data row1 ] ~align:[] | row2 :: rows3_N -> ( match valid_align_row row2 with (* If the second line is the align row, the first one is the header and the rest is data. *) - | Some align -> create ~header:row1 ~data:rows3_N ~align + | Some align -> + let header = with_kind `Header row1 in + let data = List.map (with_kind `Data) rows3_N in + create ~grid:(header :: data) ~align (* No align row in the first 2 lines, everything is considered data. *) - | None -> create ~header:[] ~data:grid ~align:[]))) + | None -> + create ~grid:(List.map (with_kind `Data) grid) ~align:[])) + ) end module Heavy_syntax = struct - let create ~header ~data : Ast.table = ((header, data, []), `Heavy) - - let valid_header_row row = - List.map (function `Header, x -> Some x | `Data, _ -> None) row - |> Option.join_list - - let from_grid grid : Ast.table = - match grid with - | [] -> create ~header:[] ~data:[] - | row1 :: rows2_N -> - let header, data = - (* If the first line is the header row, everything else is data. *) - match valid_header_row row1 with - | Some header -> (header, rows2_N) - (* Otherwise everything is considered data. *) - | None -> ([], grid) - in - let data = List.map (List.map snd) data in - create ~header ~data + let create ~grid : Ast.table = ((grid, []), `Heavy) + let from_grid grid : Ast.table = create ~grid end end @@ -475,7 +467,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = (* {3 Helper types} *) (* The interpretation of tokens in the block parser depends on where on a line - each token appears. The seven possible "locations" are: + each token appears. The six possible "locations" are: - [`At_start_of_line], when only whitespace has been read on the current line. @@ -485,8 +477,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = [-], has been read, and only whitespace has been read since. - [`After_explicit_list_bullet], when a valid explicit bullet, such as [{li], has been read, and only whitespace has been read since. - - [`After_table_header], when a table header opening markup ('{th') has been read. - - [`After_table_cell], when a table cell opening markup ('{td') has been read. + - [`After_table_cell], when a table cell opening markup ('{th' or '{td') has been read. - [`After_text], when any other valid non-whitespace token has already been read on the current line. @@ -510,7 +501,6 @@ type where_in_line = | `After_tag | `After_shorthand_bullet | `After_explicit_list_bullet - | `After_table_header | `After_table_cell | `After_text ] @@ -565,7 +555,6 @@ type ('block, 'stops_at_which_tokens) context = | Top_level : (Ast.block_element, stops_at_delimiters) context | In_shorthand_list : (Ast.nestable_block_element, stopped_implicitly) context | In_explicit_list : (Ast.nestable_block_element, stops_at_delimiters) context - | In_table_header : (Ast.nestable_block_element, stops_at_delimiters) context | In_table_cell : (Ast.nestable_block_element, stops_at_delimiters) context | In_tag : (Ast.nestable_block_element, Token.t) context @@ -581,7 +570,6 @@ let accepted_in_all_contexts : | Top_level -> (block :> Ast.block_element) | In_shorthand_list -> block | In_explicit_list -> block - | In_table_header -> block | In_table_cell -> block | In_tag -> block @@ -674,7 +662,6 @@ let rec block_element_list : | Top_level -> (List.rev acc, next_token, where_in_line) | In_shorthand_list -> (List.rev acc, next_token, where_in_line) | In_explicit_list -> (List.rev acc, next_token, where_in_line) - | In_table_header -> (List.rev acc, next_token, where_in_line) | In_table_cell -> (List.rev acc, next_token, where_in_line) | In_tag -> (List.rev acc, next_token, where_in_line)) (* Whitespace. This can terminate some kinds of block elements. It is also @@ -726,8 +713,7 @@ let rec block_element_list : consume_block_elements ~parsed_a_tag where_in_line acc (* Table cells ([{th ...}] and [{td ...}]) can never appear directly in block content. They can only appear inside [{tr ...}]. *) - | { value = (`Begin_table_header | `Begin_table_data) as token; location } - -> + | { value = `Begin_table_cell _ as token; location } -> let suggestion = Printf.sprintf "move %s into %s." (Token.print token) (Token.describe `Begin_table_row) @@ -777,7 +763,6 @@ let rec block_element_list : if where_in_line = `At_start_of_line then (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context - | In_table_header -> recover_when_not_at_top_level context | In_table_cell -> recover_when_not_at_top_level context | In_tag -> if where_in_line = `At_start_of_line then @@ -1028,7 +1013,6 @@ let rec block_element_list : (List.rev acc, next_token, where_in_line) else recover_when_not_at_top_level context | In_explicit_list -> recover_when_not_at_top_level context - | In_table_header -> recover_when_not_at_top_level context | In_table_cell -> recover_when_not_at_top_level context | In_tag -> recover_when_not_at_top_level context | Top_level -> @@ -1089,7 +1073,6 @@ let rec block_element_list : | Top_level -> `At_start_of_line | In_shorthand_list -> `After_shorthand_bullet | In_explicit_list -> `After_explicit_list_bullet - | In_table_header -> `After_table_header | In_table_cell -> `After_table_cell | In_tag -> `After_tag in @@ -1334,7 +1317,7 @@ and heavy_table ~parent_markup ~parent_markup_location input = (Table.Heavy_syntax.from_grid grid, brace_location) (* Consumes a sequence of table cells (starting with '{th ...}' or '{td ... }', - which are represented by [`Begin_table_header] [`Begin_table_data] tokens). + which are represented by [`Begin_table_cell] tokens). This function is called immediately after '{tr' ([`Begin_table_row]) is read. The only "valid" way to exit is by reading a [`Right_brace] token, @@ -1343,13 +1326,7 @@ and heavy_table_row ~parent_markup input = let rec consume_cell_items acc = Reader.until_rbrace input acc >>> fun next_token -> match next_token.Loc.value with - | `Begin_table_header as token -> - junk input; - let content, _brace_location = - heavy_table_header input ~parent_markup:token - in - consume_cell_items ((`Header, content) :: acc) - | `Begin_table_data as token -> + | `Begin_table_cell kind as token -> junk input; let content, token_after_list_item, _where_in_line = block_element_list In_table_cell ~parent_markup:token input @@ -1360,7 +1337,7 @@ and heavy_table_row ~parent_markup input = Parse_error.not_allowed token_after_list_item.location ~what:(Token.describe `End) ~in_what:(Token.describe token) |> add_warning input); - consume_cell_items ((`Data, content) :: acc) + consume_cell_items ((content, kind) :: acc) | token -> Parse_error.not_allowed next_token.location ~what:(Token.describe token) ~in_what:(Token.describe parent_markup) @@ -1370,28 +1347,6 @@ and heavy_table_row ~parent_markup input = in consume_cell_items [] -(* Consumes a table header. - - This function is called immediately after '{th' ([`Begin_table_header]) is - read. The only "valid" way to exit is by reading a [`Right_brace] token, - which is consumed. *) -and heavy_table_header ~parent_markup input = - let rec consume_items acc = - Reader.until_rbrace input acc >>> fun next_token -> - (match acc with - | _ :: _ -> - Parse_error.not_allowed next_token.location - ~what:(Token.describe next_token.value) - ~in_what:(Token.describe parent_markup) - |> add_warning input - | [] -> ()); - let content, _token_after_list_item, _where_in_line = - block_element_list In_table_header ~parent_markup input - in - consume_items content - in - consume_items [] - (* {2 Entry point} *) let parse warnings tokens = diff --git a/src/token.ml b/src/token.ml index 6493f79b..61a852be 100644 --- a/src/token.ml +++ b/src/token.ml @@ -72,8 +72,7 @@ type t = | (* Table markup. *) `Begin_table of [ `Light | `Heavy ] | `Begin_table_row - | `Begin_table_header - | `Begin_table_data + | `Begin_table_cell of [ `Header | `Data ] | `Minus | `Plus | `Bar @@ -97,8 +96,8 @@ let print : [< t ] -> string = function let syntax = match syntax with `Light -> "t" | `Heavy -> "table" in Printf.sprintf "'{%s'" syntax | `Begin_table_row -> "'{tr'" - | `Begin_table_header -> "'{th'" - | `Begin_table_data -> "'{td'" + | `Begin_table_cell `Header -> "'{th'" + | `Begin_table_cell `Data -> "'{td'" | `Minus -> "'-'" | `Plus -> "'+'" | `Bar -> "'|'" @@ -158,8 +157,8 @@ let describe : [< t | `Comment ] -> string = function | `Begin_table `Light -> "'{t ...}' (table)" | `Begin_table `Heavy -> "'{table ...}' (table)" | `Begin_table_row -> "'{tr ...}' (table row)" - | `Begin_table_header -> "'{th ... }' (table header cell)" - | `Begin_table_data -> "'{td ... }' (table data cell)" + | `Begin_table_cell `Header -> "'{th ... }' (table header cell)" + | `Begin_table_cell `Data -> "'{td ... }' (table data cell)" | `Minus -> "'-' (bulleted list item)" | `Plus -> "'+' (numbered list item)" | `Bar -> "'|'" diff --git a/test/test.ml b/test/test.ml index 946c6b6f..07603734 100644 --- a/test/test.ml +++ b/test/test.ml @@ -85,18 +85,17 @@ module Ast_to_sexp = struct |> fun items -> List items in List [ Atom kind; Atom weight; items ] - | `Table ((header, data, align), s) -> + | `Table ((data, align), s) -> let syntax = function `Light -> "light" | `Heavy -> "heavy" in + let kind = function `Header -> "header" | `Data -> "data" in let map name x f = List [ Atom name; List (List.map f x) ] in List [ Atom "table"; List [ Atom "syntax"; Atom (syntax s) ]; - ( map "header" header @@ fun cell -> - map "cell" cell @@ at.at (nestable_block_element at) ); ( map "data" data @@ fun row -> - map "row" row @@ fun cell -> - map "cell" cell @@ at.at (nestable_block_element at) ); + map "row" row @@ fun (cell, k) -> + map (kind k) cell @@ at.at (nestable_block_element at) ); map "align" align @@ alignment; ] diff --git a/test/test_tables.ml b/test/test_tables.ml index 3d7d00ac..24149a7b 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -8,9 +8,7 @@ let%expect_test _ = test "{table }"; [%expect {| - ((output - (((f.ml (1 0) (1 8)) - (table (syntax heavy) (header ()) (data ()) (align ()))))) + ((output (((f.ml (1 0) (1 8)) (table (syntax heavy) (data ()) (align ()))))) (warnings ())) |}] let empty_row = @@ -18,8 +16,7 @@ let%expect_test _ = [%expect {| ((output - (((f.ml (1 0) (1 14)) - (table (syntax heavy) (header ()) (data ()) (align ()))))) + (((f.ml (1 0) (1 14)) (table (syntax heavy) (data ((row ()))) (align ()))))) (warnings ()))|}] let no_header = @@ -28,7 +25,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (header ()) (data ((row ((cell ()))))) (align ()))))) + (table (syntax heavy) (data ((row ((data ()))))) (align ()))))) (warnings ())) |}] let no_data = @@ -37,7 +34,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (header ((cell ()))) (data ()) (align ()))))) + (table (syntax heavy) (data ((row ((header ()))))) (align ()))))) (warnings ())) |}] let multiple_headers = @@ -46,8 +43,9 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 37)) - (table (syntax heavy) (header ((cell ()))) - (data ((row ((cell ()))) (row ((cell ()))))) (align ()))))) + (table (syntax heavy) + (data ((row ((header ()))) (row ((header ()))) (row ((data ()))))) + (align ()))))) (warnings ())) |}] let complex_table = @@ -86,16 +84,16 @@ let%expect_test _ = ((output (((f.ml (2 8) (28 9)) (table (syntax heavy) - (header - ((cell - (((f.ml (4 16) (4 19)) - (paragraph (((f.ml (4 16) (4 19)) (word xxx))))))) - (cell - (((f.ml (5 16) (5 19)) - (paragraph (((f.ml (5 16) (5 19)) (word yyy))))))))) (data ((row - ((cell + ((header + (((f.ml (4 16) (4 19)) + (paragraph (((f.ml (4 16) (4 19)) (word xxx))))))) + (header + (((f.ml (5 16) (5 19)) + (paragraph (((f.ml (5 16) (5 19)) (word yyy))))))))) + (row + ((data (((f.ml (8 16) (8 36)) (paragraph (((f.ml (8 16) (8 20)) (word aaaa)) ((f.ml (8 20) (8 21)) space) @@ -103,12 +101,11 @@ let%expect_test _ = ((f.ml (8 25) (8 28)) (word ccc)) ((f.ml (8 28) (8 29)) space) ((f.ml (8 29) (8 36)) (italic (((f.ml (8 32) (8 35)) (word ddd)))))))))) - (cell + (data (((f.ml (11 15) (11 32)) - (table (syntax heavy) (header ()) (data ((row ((cell ()))))) - (align ()))))))) + (table (syntax heavy) (data ((row ((data ()))))) (align ()))))))) (row - ((cell + ((data (((f.ml (16 15) (18 20)) (unordered light ((((f.ml (16 17) (16 20)) @@ -117,28 +114,28 @@ let%expect_test _ = (paragraph (((f.ml (17 17) (17 20)) (word bbb)))))) (((f.ml (18 17) (18 20)) (paragraph (((f.ml (18 17) (18 20)) (word ccc))))))))))) - (cell + (data (((f.ml (21 14) (25 15)) (table (syntax light) - (header - ((cell - (((f.ml (22 17) (22 18)) - (paragraph (((f.ml (22 17) (22 18)) (word x))))))) - (cell - (((f.ml (22 21) (22 22)) - (paragraph (((f.ml (22 21) (22 22)) (word y))))))) - (cell - (((f.ml (22 25) (22 26)) - (paragraph (((f.ml (22 25) (22 26)) (word z))))))))) (data ((row - ((cell + ((header + (((f.ml (22 17) (22 18)) + (paragraph (((f.ml (22 17) (22 18)) (word x))))))) + (header + (((f.ml (22 21) (22 22)) + (paragraph (((f.ml (22 21) (22 22)) (word y))))))) + (header + (((f.ml (22 25) (22 26)) + (paragraph (((f.ml (22 25) (22 26)) (word z))))))))) + (row + ((data (((f.ml (24 17) (24 18)) (paragraph (((f.ml (24 17) (24 18)) (word 1))))))) - (cell + (data (((f.ml (24 21) (24 22)) (paragraph (((f.ml (24 21) (24 22)) (word 2))))))) - (cell + (data (((f.ml (24 25) (24 26)) (paragraph (((f.ml (24 25) (24 26)) (word 3))))))))))) (align (center center center)))))))))) @@ -153,9 +150,7 @@ let%expect_test _ = test "{t }"; [%expect {| - ((output - (((f.ml (1 0) (1 4)) - (table (syntax light) (header ()) (data ()) (align ()))))) + ((output (((f.ml (1 0) (1 4)) (table (syntax light) (data ()) (align ()))))) (warnings ())) |}] let simple = @@ -168,10 +163,10 @@ let%expect_test _ = {| ((output (((f.ml (2 8) (4 9)) - (table (syntax light) (header ()) + (table (syntax light) (data ((row - ((cell + ((data (((f.ml (3 12) (3 13)) (paragraph (((f.ml (3 12) (3 13)) (word a))))))))))) (align ()))))) @@ -189,20 +184,20 @@ let%expect_test _ = {| ((output (((f.ml (2 8) (5 9)) - (table (syntax light) (header ()) + (table (syntax light) (data ((row - ((cell + ((data (((f.ml (3 11) (3 12)) (paragraph (((f.ml (3 11) (3 12)) (word a))))))) - (cell + (data (((f.ml (3 16) (3 19)) (paragraph (((f.ml (3 16) (3 19)) (word *b*))))))))) (row - ((cell + ((data (((f.ml (4 11) (4 13)) (paragraph (((f.ml (4 11) (4 13)) (word *c))))))) - (cell + (data (((f.ml (4 15) (4 17)) (paragraph (((f.ml (4 15) (4 17)) (word d*))))))))))) (align ()))))) @@ -218,13 +213,13 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (4 7)) - (table (syntax light) (header ()) + (table (syntax light) (data ((row - ((cell + ((data (((f.ml (3 11) (3 13)) (paragraph (((f.ml (3 11) (3 13)) (word `a))))))) - (cell + (data (((f.ml (3 15) (3 16)) (paragraph (((f.ml (3 15) (3 16)) (word `))))))))))) (align ()))))) @@ -241,12 +236,12 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (5 7)) - (table (syntax light) (header ()) + (table (syntax light) (data ((row - ((cell + ((data (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word x))))))) - (cell + (data (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word y))))))))))) (align (center center)))))) @@ -263,18 +258,18 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (5 7)) - (table (syntax light) (header ()) + (table (syntax light) (data ((row - ((cell + ((data (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) - (cell + (data (((f.ml (3 13) (3 14)) (paragraph (((f.ml (3 13) (3 14)) (word y))))))))) (row - ((cell + ((data (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word x))))))) - (cell + (data (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word y))))))))))) (align ()))))) @@ -290,7 +285,7 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (4 7)) - (table (syntax light) (header ()) (data ()) (align (center center)))))) + (table (syntax light) (data ()) (align (center center)))))) (warnings ())) |}] let no_data = @@ -305,12 +300,14 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (header - ((cell - (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) - (cell - (((f.ml (3 13) (3 14)) (paragraph (((f.ml (3 13) (3 14)) (word y))))))))) - (data ()) (align (center center)))))) + (data + ((row + ((header + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) + (header + (((f.ml (3 13) (3 14)) + (paragraph (((f.ml (3 13) (3 14)) (word y))))))))))) + (align (center center)))))) (warnings ())) |}] let alignment = @@ -326,16 +323,20 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (header - ((cell - (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) - (cell - (((f.ml (3 13) (3 14)) (paragraph (((f.ml (3 13) (3 14)) (word b))))))) - (cell - (((f.ml (3 17) (3 18)) (paragraph (((f.ml (3 17) (3 18)) (word c))))))) - (cell - (((f.ml (3 21) (3 22)) (paragraph (((f.ml (3 21) (3 22)) (word d))))))))) - (data ()) (align (center left right center)))))) + (data + ((row + ((header + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) + (header + (((f.ml (3 13) (3 14)) + (paragraph (((f.ml (3 13) (3 14)) (word b))))))) + (header + (((f.ml (3 17) (3 18)) + (paragraph (((f.ml (3 17) (3 18)) (word c))))))) + (header + (((f.ml (3 21) (3 22)) + (paragraph (((f.ml (3 21) (3 22)) (word d))))))))))) + (align (center left right center)))))) (warnings ())) |}] let no_bars = @@ -352,26 +353,29 @@ let%expect_test _ = ((output (((f.ml (2 6) (6 7)) (table (syntax light) - (header - ((cell - (((f.ml (3 8) (3 9)) (paragraph (((f.ml (3 8) (3 9)) (word a))))))) - (cell - (((f.ml (3 12) (3 13)) (paragraph (((f.ml (3 12) (3 13)) (word b))))))) - (cell - (((f.ml (3 16) (3 17)) (paragraph (((f.ml (3 16) (3 17)) (word c))))))) - (cell - (((f.ml (3 20) (3 21)) (paragraph (((f.ml (3 20) (3 21)) (word d))))))))) (data ((row - ((cell + ((header + (((f.ml (3 8) (3 9)) (paragraph (((f.ml (3 8) (3 9)) (word a))))))) + (header + (((f.ml (3 12) (3 13)) + (paragraph (((f.ml (3 12) (3 13)) (word b))))))) + (header + (((f.ml (3 16) (3 17)) + (paragraph (((f.ml (3 16) (3 17)) (word c))))))) + (header + (((f.ml (3 20) (3 21)) + (paragraph (((f.ml (3 20) (3 21)) (word d))))))))) + (row + ((data (((f.ml (5 8) (5 9)) (paragraph (((f.ml (5 8) (5 9)) (word a))))))) - (cell + (data (((f.ml (5 12) (5 13)) (paragraph (((f.ml (5 12) (5 13)) (word b))))))) - (cell + (data (((f.ml (5 16) (5 17)) (paragraph (((f.ml (5 16) (5 17)) (word c))))))) - (cell + (data (((f.ml (5 20) (5 21)) (paragraph (((f.ml (5 20) (5 21)) (word d))))))))))) (align (center left right center)))))) @@ -395,26 +399,29 @@ let%expect_test _ = ((output (((f.ml (2 6) (10 7)) (table (syntax light) - (header - ((cell - (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word a))))))) - (cell - (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word b))))))) - (cell - (((f.ml (4 17) (4 18)) (paragraph (((f.ml (4 17) (4 18)) (word c))))))) - (cell - (((f.ml (4 21) (4 22)) (paragraph (((f.ml (4 21) (4 22)) (word d))))))))) (data ((row - ((cell + ((header + (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word a))))))) + (header + (((f.ml (4 13) (4 14)) + (paragraph (((f.ml (4 13) (4 14)) (word b))))))) + (header + (((f.ml (4 17) (4 18)) + (paragraph (((f.ml (4 17) (4 18)) (word c))))))) + (header + (((f.ml (4 21) (4 22)) + (paragraph (((f.ml (4 21) (4 22)) (word d))))))))) + (row + ((data (((f.ml (8 9) (8 10)) (paragraph (((f.ml (8 9) (8 10)) (word a))))))) - (cell + (data (((f.ml (8 13) (8 14)) (paragraph (((f.ml (8 13) (8 14)) (word b))))))) - (cell + (data (((f.ml (8 17) (8 18)) (paragraph (((f.ml (8 17) (8 18)) (word c))))))) - (cell + (data (((f.ml (8 21) (8 22)) (paragraph (((f.ml (8 21) (8 22)) (word d))))))))))) (align (center center center center)))))) @@ -433,32 +440,34 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (header - ((cell - (((f.ml (3 9) (3 14)) - (paragraph - (((f.ml (3 9) (3 14)) (italic (((f.ml (3 12) (3 13)) (word a)))))))) - ((f.ml (3 15) (3 28)) - (paragraph (((f.ml (3 15) (3 28)) (google.com ()))))) - ((f.ml (3 29) (3 31)) - (paragraph (((f.ml (3 29) (3 31)) (word "\\t"))))))) - (cell ()) - (cell - (((f.ml (3 36) (3 41)) - (paragraph (((f.ml (3 36) (3 41)) (math_span b))))) - ((f.ml (3 42) (3 47)) - (paragraph - (((f.ml (3 42) (3 47)) - (emphasis (((f.ml (3 45) (3 46)) (word c)))))))) - ((f.ml (3 48) (3 57)) - (paragraph (((f.ml (3 48) (3 57)) (raw_markup () " xyz "))))))) - (cell - (((f.ml (3 60) (3 65)) - (paragraph - (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d)))))))) - ((f.ml (3 66) (3 71)) - (paragraph (((f.ml (3 66) (3 71)) (code_span foo))))))))) - (data ()) (align (center center center center)))))) + (data + ((row + ((header + (((f.ml (3 9) (3 14)) + (paragraph + (((f.ml (3 9) (3 14)) + (italic (((f.ml (3 12) (3 13)) (word a)))))))) + ((f.ml (3 15) (3 28)) + (paragraph (((f.ml (3 15) (3 28)) (google.com ()))))) + ((f.ml (3 29) (3 31)) + (paragraph (((f.ml (3 29) (3 31)) (word "\\t"))))))) + (header ()) + (header + (((f.ml (3 36) (3 41)) + (paragraph (((f.ml (3 36) (3 41)) (math_span b))))) + ((f.ml (3 42) (3 47)) + (paragraph + (((f.ml (3 42) (3 47)) + (emphasis (((f.ml (3 45) (3 46)) (word c)))))))) + ((f.ml (3 48) (3 57)) + (paragraph (((f.ml (3 48) (3 57)) (raw_markup () " xyz "))))))) + (header + (((f.ml (3 60) (3 65)) + (paragraph + (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d)))))))) + ((f.ml (3 66) (3 71)) + (paragraph (((f.ml (3 66) (3 71)) (code_span foo))))))))))) + (align (center center center center)))))) (warnings ())) |}] let no_space = @@ -474,16 +483,21 @@ let%expect_test _ = ((output (((f.ml (2 7) (5 8)) (table (syntax light) - (header - ((cell - (((f.ml (3 11) (3 12)) (paragraph (((f.ml (3 11) (3 12)) (word a))))))) - (cell - (((f.ml (3 15) (3 16)) (paragraph (((f.ml (3 15) (3 16)) (word b))))))) - (cell - (((f.ml (3 18) (3 19)) (paragraph (((f.ml (3 18) (3 19)) (word c))))))) - (cell - (((f.ml (3 21) (3 22)) (paragraph (((f.ml (3 21) (3 22)) (word d))))))))) - (data ()) (align (center right left center)))))) + (data + ((row + ((header + (((f.ml (3 11) (3 12)) + (paragraph (((f.ml (3 11) (3 12)) (word a))))))) + (header + (((f.ml (3 15) (3 16)) + (paragraph (((f.ml (3 15) (3 16)) (word b))))))) + (header + (((f.ml (3 18) (3 19)) + (paragraph (((f.ml (3 18) (3 19)) (word c))))))) + (header + (((f.ml (3 21) (3 22)) + (paragraph (((f.ml (3 21) (3 22)) (word d))))))))))) + (align (center right left center)))))) (warnings ())) |}] let multiple_headers = @@ -504,46 +518,47 @@ let%expect_test _ = ((output (((f.ml (2 6) (10 7)) (table (syntax light) - (header - ((cell ()) - (cell - (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) - (cell - (((f.ml (3 11) (3 12)) (paragraph (((f.ml (3 11) (3 12)) (word b))))))))) (data ((row - ((cell + ((header ()) + (header + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) + (header + (((f.ml (3 11) (3 12)) + (paragraph (((f.ml (3 11) (3 12)) (word b))))))))) + (row + ((data (((f.ml (5 8) (5 9)) (paragraph (((f.ml (5 8) (5 9)) (word c))))))) - (cell + (data (((f.ml (5 10) (5 11)) (paragraph (((f.ml (5 10) (5 11)) (word d))))))))) (row - ((cell + ((data (((f.ml (6 8) (6 10)) (paragraph (((f.ml (6 8) (6 10)) (word cc))))))) - (cell + (data (((f.ml (6 11) (6 13)) (paragraph (((f.ml (6 11) (6 13)) (word dd))))))))) (row - ((cell + ((data (((f.ml (7 8) (7 10)) (paragraph (((f.ml (7 8) (7 10)) (word -:))))))) - (cell + (data (((f.ml (7 11) (7 14)) (paragraph (((f.ml (7 11) (7 14)) (word :-:))))))))) (row - ((cell + ((data (((f.ml (8 8) (8 9)) (paragraph (((f.ml (8 8) (8 9)) (word e))))))) - (cell + (data (((f.ml (8 10) (8 11)) (paragraph (((f.ml (8 10) (8 11)) (word f))))))))) (row - ((cell + ((data (((f.ml (9 8) (9 9)) (paragraph (((f.ml (9 8) (9 9)) (word g))))))) - (cell + (data (((f.ml (9 10) (9 11)) (paragraph (((f.ml (9 10) (9 11)) (word h))))))) - (cell ()))))) + (data ()))))) (align (left right)))))) (warnings ())) |}] @@ -560,11 +575,13 @@ let%expect_test _ = ((output (((f.ml (2 11) (5 12)) (table (syntax light) - (header - ((cell ()) - (cell - (((f.ml (3 23) (3 24)) (paragraph (((f.ml (3 23) (3 24)) (word b))))))))) - (data ()) (align (center center)))))) + (data + ((row + ((header ()) + (header + (((f.ml (3 23) (3 24)) + (paragraph (((f.ml (3 23) (3 24)) (word b))))))))))) + (align (center center)))))) (warnings ( "File \"f.ml\", line 3, characters 13-20:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] @@ -583,12 +600,15 @@ let%expect_test _ = ((output (((f.ml (2 11) (6 12)) (table (syntax light) - (header - ((cell - (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word a))))))) - (cell - (((f.ml (4 17) (4 18)) (paragraph (((f.ml (4 17) (4 18)) (word b))))))))) - (data ()) (align (center center)))))) + (data + ((row + ((header + (((f.ml (4 13) (4 14)) + (paragraph (((f.ml (4 13) (4 14)) (word a))))))) + (header + (((f.ml (4 17) (4 18)) + (paragraph (((f.ml (4 17) (4 18)) (word b))))))))))) + (align (center center)))))) (warnings ( "File \"f.ml\", line 3, characters 11-18:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] From e3738d0eba8c2dab2192170bfcdbc0c74de506cd Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Fri, 10 Feb 2023 16:14:56 +0000 Subject: [PATCH 09/19] Renaming --- src/syntax.ml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/syntax.ml b/src/syntax.ml index 5a7bc027..6e89b646 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -74,7 +74,7 @@ module Table = struct let with_kind kind : 'a with_location list list -> 'a Ast.row = List.map (fun c -> (c, kind)) - let from_grid grid : Ast.table = + let from_raw_data grid : Ast.table = match grid with | [] -> create ~grid:[] ~align:[] | row1 :: rows2_N -> ( @@ -1253,7 +1253,7 @@ and light_table ~parent_markup ~parent_markup_location input = in let rows, brace_location = consume_rows [] ~last_loc:parent_markup_location in let grid = List.rev rows in - (Table.Light_syntax.from_grid grid, brace_location) + (Table.Light_syntax.from_raw_data grid, brace_location) (* Consumes a table row that might start with [`Bar]. *) and light_table_row ~parent_markup ~last_loc input = From 36d381a002b94b6475845e7fb8cc9a558d3ed97d Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 7 Feb 2023 15:21:41 +0100 Subject: [PATCH 10/19] 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 --- src/lexer.mll | 4 +-- src/syntax.ml | 70 ++++++++++++++++++++++++++++++++------------- src/token.ml | 12 ++++---- test/test_tables.ml | 41 ++++++++++++++++++++++++++ 4 files changed, 99 insertions(+), 28 deletions(-) diff --git a/src/lexer.mll b/src/lexer.mll index 5fe5f230..9c42ed29 100644 --- a/src/lexer.mll +++ b/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 } diff --git a/src/syntax.ml b/src/syntax.ml index 6e89b646..ddf2c63d 100644 --- a/src/syntax.ml +++ b/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 -> diff --git a/src/token.ml b/src/token.ml index 61a852be..c76b3112 100644 --- a/src/token.ml +++ b/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)" diff --git a/test/test_tables.ml b/test/test_tables.ml index 24149a7b..3da8fd6b 100644 --- a/test/test_tables.ml +++ b/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 {| From bdfeef16ec6d58141a6a1bf4ebbff0a0aa44f95e Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 7 Feb 2023 17:11:03 +0100 Subject: [PATCH 11/19] Add suggestion on wrong content inside `{table }` and `{`tr }` Signed-off-by: Paul-Elliot --- src/syntax.ml | 3 +++ test/test_tables.ml | 27 +++++++++++++++++++++++++++ 2 files changed, 30 insertions(+) diff --git a/src/syntax.ml b/src/syntax.ml index ddf2c63d..61fd3256 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -1338,6 +1338,7 @@ and heavy_table ~parent_markup ~parent_markup_location input = | token -> Parse_error.not_allowed next_token.location ~what:(Token.describe token) ~in_what:(Token.describe parent_markup) + ~suggestion:"Move outside of {table ...}, or inside {tr ...}" |> add_warning input; junk input; consume_rows acc ~last_loc @@ -1371,6 +1372,8 @@ and heavy_table_row ~parent_markup input = | token -> Parse_error.not_allowed next_token.location ~what:(Token.describe token) ~in_what:(Token.describe parent_markup) + ~suggestion: + "Move outside of {table ...}, or inside {td ...} or {th ...}" |> add_warning input; junk input; consume_cell_items acc diff --git a/test/test_tables.ml b/test/test_tables.ml index 3da8fd6b..0e05ade3 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -37,6 +37,33 @@ let%expect_test _ = (table (syntax heavy) (data ((row ((header ()))))) (align ()))))) (warnings ())) |}] + let bad_data = + test "{table absurd content}"; + [%expect + {| + ((output (((f.ml (1 0) (1 22)) (table (syntax heavy) (data ()) (align ()))))) + (warnings + ( "File \"f.ml\", line 1, characters 7-13:\ + \n'absurd' is not allowed in '{table ...}' (table).\ + \nSuggestion: Move outside of {table ...}, or inside {tr ...}" + "File \"f.ml\", line 1, characters 14-21:\ + \n'content' is not allowed in '{table ...}' (table).\ + \nSuggestion: Move outside of {table ...}, or inside {tr ...}"))) |}] + + let bad_row = + test "{table {tr absurd content}}"; + [%expect + {| + ((output + (((f.ml (1 0) (1 27)) (table (syntax heavy) (data ((row ()))) (align ()))))) + (warnings + ( "File \"f.ml\", line 1, characters 11-17:\ + \n'absurd' is not allowed in '{tr ...}' (table row).\ + \nSuggestion: Move outside of {table ...}, or inside {td ...} or {th ...}" + "File \"f.ml\", line 1, characters 18-25:\ + \n'content' is not allowed in '{tr ...}' (table row).\ + \nSuggestion: Move outside of {table ...}, or inside {td ...} or {th ...}"))) |}] + let multiple_headers = test "{table {tr {th}} {tr {th}} {tr {td}}}"; [%expect From bd19b75bd402e199bd9aee1ff4d5b7923cfa18a9 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 7 Feb 2023 17:15:32 +0100 Subject: [PATCH 12/19] allow `|` char as a word outside of light table Signed-off-by: Paul-Elliot --- src/syntax.ml | 29 ++++++++++++----------------- test/test.ml | 32 +++++++++++++++++++++++++++++++- test/test_tables.ml | 3 ++- 3 files changed, 45 insertions(+), 19 deletions(-) diff --git a/src/syntax.ml b/src/syntax.ml index 61fd3256..4dadc755 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -204,6 +204,9 @@ let rec inline_element : | `Plus -> junk input; Loc.at location (`Word "+") + | `Bar -> + junk input; + Loc.at location (`Word "|") | (`Code_span _ | `Math_span _ | `Raw_markup _) as token -> junk input; Loc.at location token @@ -364,6 +367,11 @@ and delimited_inline_element_list : junk input; let element = Loc.same next_token (`Space ws) in consume_elements ~at_start_of_line:true (element :: acc) + | `Bar as token -> + let acc = + inline_element input next_token.location ~context token :: acc + in + consume_elements ~at_start_of_line:false acc | (`Minus | `Plus) as bullet -> (if at_start_of_line then let suggestion = @@ -457,8 +465,8 @@ let paragraph : input -> Ast.nestable_block_element with_location = fun acc -> let next_token = peek input in match next_token.value with - | (`Space _ | `Minus | `Plus | #token_that_always_begins_an_inline_element) - as token -> + | ( `Space _ | `Minus | `Plus | `Bar + | #token_that_always_begins_an_inline_element ) as token -> let element = inline_element input next_token.location ~context:Outside_light_table token @@ -748,19 +756,6 @@ let rec block_element_list : |> add_warning input; junk input; consume_block_elements ~parsed_a_tag where_in_line acc - (* Bars can never appear directly in block content. - They can only appear inside [{t ...}]. *) - | { value = `Bar as token; location } -> - let suggestion = - Printf.sprintf "move %s into %s." (Token.print token) - (Token.describe `Begin_table_light) - in - Parse_error.not_allowed ~what:(Token.describe token) - ~in_what:(Token.describe parent_markup) - ~suggestion location - |> add_warning input; - junk input; - consume_block_elements ~parsed_a_tag where_in_line acc (* Tags. These can appear at the top level only. Also, once one tag is seen, the only top-level elements allowed are more tags. *) | { value = `Tag tag as token; location } as next_token -> ( @@ -872,8 +867,8 @@ let rec block_element_list : let tag = Loc.at location (`Tag tag) in consume_block_elements ~parsed_a_tag:true `After_text (tag :: acc))) - | { value = #token_that_always_begins_an_inline_element; _ } as next_token - -> + | ( { value = #token_that_always_begins_an_inline_element; _ } + | { value = `Bar; _ } ) as next_token -> warn_if_after_tags next_token; warn_if_after_text next_token; diff --git a/test/test.ml b/test/test.ml index 07603734..670cf142 100644 --- a/test/test.ml +++ b/test/test.ml @@ -405,7 +405,7 @@ let%expect_test _ = () let%expect_test _ = - let module Plus_minus_words = struct + let module Plus_minus_bar_words = struct let minus_in_word = test "foo-bar"; [%expect @@ -444,6 +444,36 @@ let%expect_test _ = ((f.ml (1 4) (1 5)) (word +))))))) (warnings ())) |}] + let bar_in_word = + test "foo|bar"; + [%expect + {| + ((output + (((f.ml (1 0) (1 7)) + (paragraph + (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) (word |)) + ((f.ml (1 4) (1 7)) (word bar))))))) + (warnings ())) |}] + + let escaped_bar_in_word = + test "foo\\|bar"; + [%expect + {| + ((output + (((f.ml (1 0) (1 8)) (paragraph (((f.ml (1 0) (1 8)) (word "foo\\|bar"))))))) + (warnings ())) |}] + + let bar_as_word = + test "foo |"; + [%expect + {| + ((output + (((f.ml (1 0) (1 5)) + (paragraph + (((f.ml (1 0) (1 3)) (word foo)) ((f.ml (1 3) (1 4)) space) + ((f.ml (1 4) (1 5)) (word |))))))) + (warnings ())) |}] + let negative_number = test "-3.14 -1337"; [%expect diff --git a/test/test_tables.ml b/test/test_tables.ml index 0e05ade3..4fd99f16 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -506,7 +506,8 @@ let%expect_test _ = newlines} | {b d} [foo] | } |}; - [%expect {| + [%expect + {| ((output (((f.ml (2 6) (6 7)) (table (syntax light) From d72b51cf015077d320869c012bd7a04add2b61bc Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 8 Feb 2023 07:30:08 +0100 Subject: [PATCH 13/19] adding a test for varying number of cells Signed-off-by: Paul-Elliot --- test/test_tables.ml | 60 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/test/test_tables.ml b/test/test_tables.ml index 4fd99f16..0caf576d 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -681,5 +681,65 @@ let%expect_test _ = (warnings ( "File \"f.ml\", line 3, characters 11-18:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] + + let more_cells_later = + test + {| + {t + | x | y | + |---|---| + | x | y | z | + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (6 7)) + (table (syntax light) + (data + ((row + ((header + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) + (header + (((f.ml (3 13) (3 14)) + (paragraph (((f.ml (3 13) (3 14)) (word y))))))))) + (row + ((data + (((f.ml (5 9) (5 10)) (paragraph (((f.ml (5 9) (5 10)) (word x))))))) + (data + (((f.ml (5 13) (5 14)) + (paragraph (((f.ml (5 13) (5 14)) (word y))))))) + (data + (((f.ml (5 17) (5 18)) + (paragraph (((f.ml (5 17) (5 18)) (word z))))))))))) + (align (center center)))))) + (warnings ())) |}] + + let less_cells_later = + test + {| + {t + | x | y | + |---|---| + x + } + |}; + [%expect + {| + ((output + (((f.ml (2 6) (6 7)) + (table (syntax light) + (data + ((row + ((header + (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) + (header + (((f.ml (3 13) (3 14)) + (paragraph (((f.ml (3 13) (3 14)) (word y))))))))) + (row + ((data + (((f.ml (5 7) (5 8)) (paragraph (((f.ml (5 7) (5 8)) (word x))))))))))) + (align (center center)))))) + (warnings ())) |}] end in () From 97fd2a3f5a6898b66cf82653cb90e6b01b661982 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Tue, 14 Feb 2023 11:33:16 +0100 Subject: [PATCH 14/19] Fix new paragraph starting on `|` Signed-off-by: Paul-Elliot --- src/syntax.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/syntax.ml b/src/syntax.ml index 4dadc755..968e6dcc 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -482,7 +482,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = fun acc -> match npeek 2 input with | { value = `Single_newline ws; location } - :: { value = #token_that_always_begins_an_inline_element; _ } + :: { value = #token_that_always_begins_an_inline_element | `Bar; _ } :: _ -> junk input; let acc = Loc.at location (`Space ws) :: acc in From 361354c642b40e968a83d2b11dc4d02ee3f4ab28 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 16 Feb 2023 13:31:00 +0100 Subject: [PATCH 15/19] Fix default alignment This commit fixes several alignment issues. 1. No alignment in a cell was encoded as an alignment to `Center. "Centering" was certainly a typo, but there is also the issue that "no specified alignment" should really be different than "specified to ..." For instance (assuming `{R ...}` exists): ``` {R {t |aaa|bbb| |---|---| |xxx|yyy|}} ``` would not be right-aligned inside the table, with the previous behaviour. This commit allows for "unspecified alignment" using an option. 2. No alignment in a table was encoded as an empty list of alignment. This was wrong, since at some point we might want to raise warnings in case the number of alignment and the number of columns differ. Signed-off-by: Paul-Elliot --- src/ast.ml | 2 +- src/syntax.ml | 50 +++++++++++++++++++--------------- test/test.ml | 16 +++++++---- test/test_tables.ml | 66 ++++++++++++++++++++++++++------------------- 4 files changed, 78 insertions(+), 56 deletions(-) diff --git a/src/ast.ml b/src/ast.ml index 2e2fa7c4..065c19e9 100644 --- a/src/ast.ml +++ b/src/ast.ml @@ -33,7 +33,7 @@ type inline_element = type 'a cell = 'a with_location list * [ `Header | `Data ] type 'a row = 'a cell list type 'a grid = 'a row list -type 'a abstract_table = 'a grid * alignment list +type 'a abstract_table = 'a grid * alignment option list option type nestable_block_element = [ `Paragraph of inline_element with_location list diff --git a/src/syntax.ml b/src/syntax.ml index 968e6dcc..bbbf4ccc 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -40,29 +40,35 @@ let peek input = module Table = struct module Light_syntax = struct - let default_align = `Center - let valid_align = function | [ { Loc.value = `Word w; _ } ] -> ( match String.length w with - | 0 -> Some default_align + | 0 -> `Valid None | 1 -> ( match w with - | "-" -> Some default_align - | ":" -> Some `Center - | _ -> None) + | "-" -> `Valid None + | ":" -> `Valid (Some `Center) + | _ -> `Invalid) | len -> if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) then match (String.get w 0, String.get w (len - 1)) with - | ':', ':' -> Some `Center - | ':', '-' -> Some `Left - | '-', ':' -> Some `Right - | '-', '-' -> Some default_align - | _ -> None - else None) - | _ -> None - - let valid_align_row lx = List.map valid_align lx |> Option.join_list + | ':', ':' -> `Valid (Some `Center) + | ':', '-' -> `Valid (Some `Left) + | '-', ':' -> `Valid (Some `Right) + | '-', '-' -> `Valid None + | _ -> `Invalid + else `Invalid) + | _ -> `Invalid + + let valid_align_row lx = + let rec loop acc = function + | [] -> Some (List.rev acc) + | x :: q -> ( + match valid_align x with + | `Invalid -> None + | `Valid alignment -> loop (alignment :: acc) q) + in + loop [] lx let create ~grid ~align : Ast.table = let to_block x = Loc.at x.Loc.location (`Paragraph [ x ]) in @@ -76,33 +82,33 @@ module Table = struct let from_raw_data grid : Ast.table = match grid with - | [] -> create ~grid:[] ~align:[] + | [] -> create ~grid:[] ~align:None | row1 :: rows2_N -> ( match valid_align_row row1 with (* If the first line is the align row, everything else is data. *) - | Some align -> + | Some _ as align -> create ~grid:(List.map (with_kind `Data) rows2_N) ~align | None -> ( match rows2_N with (* Only 1 line, if this is not the align row this is data. *) - | [] -> create ~grid:[ with_kind `Data row1 ] ~align:[] + | [] -> create ~grid:[ with_kind `Data row1 ] ~align:None | row2 :: rows3_N -> ( match valid_align_row row2 with (* If the second line is the align row, the first one is the header and the rest is data. *) - | Some align -> + | Some _ as align -> let header = with_kind `Header row1 in let data = List.map (with_kind `Data) rows3_N in create ~grid:(header :: data) ~align (* No align row in the first 2 lines, everything is considered data. *) | None -> - create ~grid:(List.map (with_kind `Data) grid) ~align:[])) - ) + create ~grid:(List.map (with_kind `Data) grid) ~align:None + ))) end module Heavy_syntax = struct - let create ~grid : Ast.table = ((grid, []), `Heavy) + let create ~grid : Ast.table = ((grid, None), `Heavy) let from_grid grid : Ast.table = create ~grid end end diff --git a/test/test.ml b/test/test.ml index 670cf142..619e2658 100644 --- a/test/test.ml +++ b/test/test.ml @@ -29,10 +29,11 @@ module Ast_to_sexp = struct | `Superscript -> Atom "superscript" | `Subscript -> Atom "subscript" - let alignment : Ast.alignment -> sexp = function - | `Left -> Atom "left" - | `Center -> Atom "center" - | `Right -> Atom "right" + let alignment : Ast.alignment option -> sexp = function + | Some `Left -> Atom "left" + | Some `Center -> Atom "center" + | Some `Right -> Atom "right" + | None -> Atom "default" let reference_kind : Ast.reference_kind -> sexp = function | `Simple -> Atom "simple" @@ -89,6 +90,11 @@ module Ast_to_sexp = struct let syntax = function `Light -> "light" | `Heavy -> "heavy" in let kind = function `Header -> "header" | `Data -> "data" in let map name x f = List [ Atom name; List (List.map f x) ] in + let alignment = + match align with + | None -> List [ Atom "align"; Atom "no alignment" ] + | Some align -> map "align" align @@ alignment + in List [ Atom "table"; @@ -96,7 +102,7 @@ module Ast_to_sexp = struct ( map "data" data @@ fun row -> map "row" row @@ fun (cell, k) -> map (kind k) cell @@ at.at (nestable_block_element at) ); - map "align" align @@ alignment; + alignment; ] let tag at : Ast.tag -> sexp = function diff --git a/test/test_tables.ml b/test/test_tables.ml index 0caf576d..0edc334b 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -8,7 +8,9 @@ let%expect_test _ = test "{table }"; [%expect {| - ((output (((f.ml (1 0) (1 8)) (table (syntax heavy) (data ()) (align ()))))) + ((output + (((f.ml (1 0) (1 8)) + (table (syntax heavy) (data ()) (align "no alignment"))))) (warnings ())) |}] let empty_row = @@ -16,7 +18,8 @@ let%expect_test _ = [%expect {| ((output - (((f.ml (1 0) (1 14)) (table (syntax heavy) (data ((row ()))) (align ()))))) + (((f.ml (1 0) (1 14)) + (table (syntax heavy) (data ((row ()))) (align "no alignment"))))) (warnings ()))|}] let no_header = @@ -25,7 +28,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (data ((row ((data ()))))) (align ()))))) + (table (syntax heavy) (data ((row ((data ()))))) (align "no alignment"))))) (warnings ())) |}] let no_data = @@ -34,14 +37,17 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (data ((row ((header ()))))) (align ()))))) + (table (syntax heavy) (data ((row ((header ()))))) + (align "no alignment"))))) (warnings ())) |}] let bad_data = test "{table absurd content}"; [%expect {| - ((output (((f.ml (1 0) (1 22)) (table (syntax heavy) (data ()) (align ()))))) + ((output + (((f.ml (1 0) (1 22)) + (table (syntax heavy) (data ()) (align "no alignment"))))) (warnings ( "File \"f.ml\", line 1, characters 7-13:\ \n'absurd' is not allowed in '{table ...}' (table).\ @@ -55,7 +61,8 @@ let%expect_test _ = [%expect {| ((output - (((f.ml (1 0) (1 27)) (table (syntax heavy) (data ((row ()))) (align ()))))) + (((f.ml (1 0) (1 27)) + (table (syntax heavy) (data ((row ()))) (align "no alignment"))))) (warnings ( "File \"f.ml\", line 1, characters 11-17:\ \n'absurd' is not allowed in '{tr ...}' (table row).\ @@ -72,7 +79,7 @@ let%expect_test _ = (((f.ml (1 0) (1 37)) (table (syntax heavy) (data ((row ((header ()))) (row ((header ()))) (row ((data ()))))) - (align ()))))) + (align "no alignment"))))) (warnings ())) |}] let complex_table = @@ -130,7 +137,8 @@ let%expect_test _ = (italic (((f.ml (8 32) (8 35)) (word ddd)))))))))) (data (((f.ml (11 15) (11 32)) - (table (syntax heavy) (data ((row ((data ()))))) (align ()))))))) + (table (syntax heavy) (data ((row ((data ()))))) + (align "no alignment"))))))) (row ((data (((f.ml (16 15) (18 20)) @@ -165,8 +173,8 @@ let%expect_test _ = (data (((f.ml (24 25) (24 26)) (paragraph (((f.ml (24 25) (24 26)) (word 3))))))))))) - (align (center center center)))))))))) - (align ()))))) + (align (default default default)))))))))) + (align "no alignment"))))) (warnings ())) |}] end in () @@ -177,7 +185,9 @@ let%expect_test _ = test "{t }"; [%expect {| - ((output (((f.ml (1 0) (1 4)) (table (syntax light) (data ()) (align ()))))) + ((output + (((f.ml (1 0) (1 4)) + (table (syntax light) (data ()) (align "no alignment"))))) (warnings ())) |}] let simple = @@ -196,7 +206,7 @@ let%expect_test _ = ((data (((f.ml (3 12) (3 13)) (paragraph (((f.ml (3 12) (3 13)) (word a))))))))))) - (align ()))))) + (align "no alignment"))))) (warnings ())) |}] let stars = @@ -227,7 +237,7 @@ let%expect_test _ = (data (((f.ml (4 15) (4 17)) (paragraph (((f.ml (4 15) (4 17)) (word d*))))))))))) - (align ()))))) + (align "no alignment"))))) (warnings ())) |}] let backquotes = @@ -249,7 +259,7 @@ let%expect_test _ = (data (((f.ml (3 15) (3 16)) (paragraph (((f.ml (3 15) (3 16)) (word `))))))))))) - (align ()))))) + (align "no alignment"))))) (warnings ())) |}] let no_header = @@ -271,7 +281,7 @@ let%expect_test _ = (data (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word y))))))))))) - (align (center center)))))) + (align (default default)))))) (warnings ())) |}] let no_align = @@ -299,7 +309,7 @@ let%expect_test _ = (data (((f.ml (4 13) (4 14)) (paragraph (((f.ml (4 13) (4 14)) (word y))))))))))) - (align ()))))) + (align "no alignment"))))) (warnings ())) |}] let only_align = @@ -312,7 +322,7 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (4 7)) - (table (syntax light) (data ()) (align (center center)))))) + (table (syntax light) (data ()) (align (default default)))))) (warnings ())) |}] let no_data = @@ -334,7 +344,7 @@ let%expect_test _ = (header (((f.ml (3 13) (3 14)) (paragraph (((f.ml (3 13) (3 14)) (word y))))))))))) - (align (center center)))))) + (align (default default)))))) (warnings ())) |}] let alignment = @@ -363,7 +373,7 @@ let%expect_test _ = (header (((f.ml (3 21) (3 22)) (paragraph (((f.ml (3 21) (3 22)) (word d))))))))))) - (align (center left right center)))))) + (align (default left right center)))))) (warnings ())) |}] let no_bars = @@ -405,7 +415,7 @@ let%expect_test _ = (data (((f.ml (5 20) (5 21)) (paragraph (((f.ml (5 20) (5 21)) (word d))))))))))) - (align (center left right center)))))) + (align (default left right center)))))) (warnings ())) |}] let light_table_new_lines = @@ -451,7 +461,7 @@ let%expect_test _ = (data (((f.ml (8 21) (8 22)) (paragraph (((f.ml (8 21) (8 22)) (word d))))))))))) - (align (center center center center)))))) + (align (default default default default)))))) (warnings ())) |}] let light_table_markup = @@ -494,7 +504,7 @@ let%expect_test _ = (((f.ml (3 60) (3 65)) (bold (((f.ml (3 63) (3 64)) (word d)))))))) ((f.ml (3 66) (3 71)) (paragraph (((f.ml (3 66) (3 71)) (code_span foo))))))))))) - (align (center center center center)))))) + (align (default default default default)))))) (warnings ())) |}] let light_table_markup_with_newlines = @@ -534,7 +544,7 @@ let%expect_test _ = (((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)))))) + (align (default default)))))) (warnings ( "File \"f.ml\", line 4, character 18 to line 5, character 14:\ \nLine break is not allowed in '{t ...}' (table)."))) |}] @@ -566,7 +576,7 @@ let%expect_test _ = (header (((f.ml (3 21) (3 22)) (paragraph (((f.ml (3 21) (3 22)) (word d))))))))))) - (align (center right left center)))))) + (align (default right left center)))))) (warnings ())) |}] let multiple_headers = @@ -650,7 +660,7 @@ let%expect_test _ = (header (((f.ml (3 23) (3 24)) (paragraph (((f.ml (3 23) (3 24)) (word b))))))))))) - (align (center center)))))) + (align (default default)))))) (warnings ( "File \"f.ml\", line 3, characters 13-20:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] @@ -677,7 +687,7 @@ let%expect_test _ = (header (((f.ml (4 17) (4 18)) (paragraph (((f.ml (4 17) (4 18)) (word b))))))))))) - (align (center center)))))) + (align (default default)))))) (warnings ( "File \"f.ml\", line 3, characters 11-18:\ \n'{[...]}' (code block) is not allowed in '{t ...}' (table)."))) |}] @@ -712,7 +722,7 @@ let%expect_test _ = (data (((f.ml (5 17) (5 18)) (paragraph (((f.ml (5 17) (5 18)) (word z))))))))))) - (align (center center)))))) + (align (default default)))))) (warnings ())) |}] let less_cells_later = @@ -739,7 +749,7 @@ let%expect_test _ = (row ((data (((f.ml (5 7) (5 8)) (paragraph (((f.ml (5 7) (5 8)) (word x))))))))))) - (align (center center)))))) + (align (default default)))))) (warnings ())) |}] end in () From 1199bd4b9db8e60de59cdd16be1d08035974c505 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Mon, 20 Feb 2023 17:49:20 +0000 Subject: [PATCH 16/19] Handle '+' to separate columns in 'align' row --- src/dune | 3 ++ src/syntax.ml | 91 ++++++++++++++++++++++++++++++++++----------- test/test_tables.ml | 65 ++++++++++++++++++++++++++++++++ 3 files changed, 137 insertions(+), 22 deletions(-) diff --git a/src/dune b/src/dune index 36bd5bf2..bc32ea67 100644 --- a/src/dune +++ b/src/dune @@ -5,6 +5,9 @@ (public_name odoc-parser) (instrumentation (backend bisect_ppx)) + (inline_tests) + (preprocess + (pps ppx_expect)) (flags (:standard -w -50)) (libraries astring result camlp-streams)) diff --git a/src/syntax.ml b/src/syntax.ml index bbbf4ccc..4a85493c 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -40,33 +40,80 @@ let peek input = module Table = struct module Light_syntax = struct + let split_on_plus w = + let len = String.length w in + match w with + | "+" -> [ "" ] + | _ when len > 1 -> + let plus = function '+' -> true | _ -> false in + let w = + if plus (String.get w 0) then String.sub w 1 (len - 1) else w + in + let len = String.length w in + let w = + if plus (String.get w (len - 1)) then String.sub w 0 (len - 1) + else w + in + String.split_on_char '+' w + | _ -> [ w ] + + let%expect_test _ = + let f x = + let pp x = Printf.printf "%S " x in + List.iter pp (split_on_plus x) + in + f ""; + [%expect {| "" |}]; + f "+"; + [%expect {| "" |}]; + f "++"; + [%expect {| "" |}]; + f "+--+"; + [%expect {| "--" |}]; + f "--"; + [%expect {| "--" |}]; + f "--+--+--"; + [%expect {| "--" "--" "--" |}]; + f "+----+----+----+"; + [%expect {| "----" "----" "----" |}] + let valid_align = function - | [ { Loc.value = `Word w; _ } ] -> ( - match String.length w with - | 0 -> `Valid None - | 1 -> ( - match w with - | "-" -> `Valid None - | ":" -> `Valid (Some `Center) - | _ -> `Invalid) - | len -> - if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) then - match (String.get w 0, String.get w (len - 1)) with - | ':', ':' -> `Valid (Some `Center) - | ':', '-' -> `Valid (Some `Left) - | '-', ':' -> `Valid (Some `Right) - | '-', '-' -> `Valid None - | _ -> `Invalid - else `Invalid) - | _ -> `Invalid + | [ { Loc.value = `Word w; _ } ] -> + (* We consider [+----+----+----+] a valid row, as it is a common format. *) + let valid_word w = + match String.length w with + | 0 -> `Valid None + | 1 -> ( + match w with + | "-" -> `Valid None + | ":" -> `Valid (Some `Center) + | _ -> `Invalid) + | len -> + if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) + then + match (String.get w 0, String.get w (len - 1)) with + | ':', ':' -> `Valid (Some `Center) + | ':', '-' -> `Valid (Some `Left) + | '-', ':' -> `Valid (Some `Right) + | '-', '-' -> `Valid None + | _ -> `Invalid + else `Invalid + in + List.map valid_word (split_on_plus w) + | _ -> [ `Invalid ] let valid_align_row lx = let rec loop acc = function | [] -> Some (List.rev acc) - | x :: q -> ( - match valid_align x with - | `Invalid -> None - | `Valid alignment -> loop (alignment :: acc) q) + | x :: q -> + let all_aligns = valid_align x in + let valid_aligns = + List.filter_map + (function `Valid a -> Some a | `Invalid -> None) + all_aligns + in + if List.(length valid_aligns < length all_aligns) then None + else loop (List.rev_append valid_aligns acc) q in loop [] lx diff --git a/test/test_tables.ml b/test/test_tables.ml index 0edc334b..0f15256b 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -751,5 +751,70 @@ let%expect_test _ = (((f.ml (5 7) (5 8)) (paragraph (((f.ml (5 7) (5 8)) (word x))))))))))) (align (default default)))))) (warnings ())) |}] + + let with_pluses = + test + {| + {t + xx | yy | zz + ---------+-----------+-------------- + } + + {t + xx | yy | zz + +---------+-----------+-------------+ + } + + {t + xx | yy | zz + +---------|-----------+-------------| + } + |}; + [%expect + {| + ((output + (((f.ml (2 8) (5 9)) + (table (syntax light) + (data + ((row + ((header + (((f.ml (3 8) (3 10)) + (paragraph (((f.ml (3 8) (3 10)) (word xx))))))) + (header + (((f.ml (3 19) (3 21)) + (paragraph (((f.ml (3 19) (3 21)) (word yy))))))) + (header + (((f.ml (3 31) (3 33)) + (paragraph (((f.ml (3 31) (3 33)) (word zz))))))))))) + (align (default default default)))) + ((f.ml (7 8) (10 9)) + (table (syntax light) + (data + ((row + ((header + (((f.ml (8 9) (8 11)) + (paragraph (((f.ml (8 9) (8 11)) (word xx))))))) + (header + (((f.ml (8 20) (8 22)) + (paragraph (((f.ml (8 20) (8 22)) (word yy))))))) + (header + (((f.ml (8 32) (8 34)) + (paragraph (((f.ml (8 32) (8 34)) (word zz))))))))))) + (align (default default default)))) + ((f.ml (12 8) (15 9)) + (table (syntax light) + (data + ((row + ((header + (((f.ml (13 9) (13 11)) + (paragraph (((f.ml (13 9) (13 11)) (word xx))))))) + (header + (((f.ml (13 20) (13 22)) + (paragraph (((f.ml (13 20) (13 22)) (word yy))))))) + (header + (((f.ml (13 32) (13 34)) + (paragraph (((f.ml (13 32) (13 34)) (word zz))))))))))) + (align (default default default)))))) + (warnings ())) |}] end in () From 53d21611f6b29f7d316679a166bdd7d8e7f4a87a Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Mon, 20 Feb 2023 17:51:57 +0000 Subject: [PATCH 17/19] Renaming data->grid in tests, data is a kind of a cell --- test/test.ml | 4 +-- test/test_tables.ml | 64 ++++++++++++++++++++++----------------------- 2 files changed, 34 insertions(+), 34 deletions(-) diff --git a/test/test.ml b/test/test.ml index 619e2658..4fedc471 100644 --- a/test/test.ml +++ b/test/test.ml @@ -86,7 +86,7 @@ module Ast_to_sexp = struct |> fun items -> List items in List [ Atom kind; Atom weight; items ] - | `Table ((data, align), s) -> + | `Table ((grid, align), s) -> let syntax = function `Light -> "light" | `Heavy -> "heavy" in let kind = function `Header -> "header" | `Data -> "data" in let map name x f = List [ Atom name; List (List.map f x) ] in @@ -99,7 +99,7 @@ module Ast_to_sexp = struct [ Atom "table"; List [ Atom "syntax"; Atom (syntax s) ]; - ( map "data" data @@ fun row -> + ( map "grid" grid @@ fun row -> map "row" row @@ fun (cell, k) -> map (kind k) cell @@ at.at (nestable_block_element at) ); alignment; diff --git a/test/test_tables.ml b/test/test_tables.ml index 0f15256b..51c8a38b 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -10,7 +10,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 8)) - (table (syntax heavy) (data ()) (align "no alignment"))))) + (table (syntax heavy) (grid ()) (align "no alignment"))))) (warnings ())) |}] let empty_row = @@ -19,7 +19,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 14)) - (table (syntax heavy) (data ((row ()))) (align "no alignment"))))) + (table (syntax heavy) (grid ((row ()))) (align "no alignment"))))) (warnings ()))|}] let no_header = @@ -28,7 +28,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (data ((row ((data ()))))) (align "no alignment"))))) + (table (syntax heavy) (grid ((row ((data ()))))) (align "no alignment"))))) (warnings ())) |}] let no_data = @@ -37,7 +37,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 17)) - (table (syntax heavy) (data ((row ((header ()))))) + (table (syntax heavy) (grid ((row ((header ()))))) (align "no alignment"))))) (warnings ())) |}] @@ -47,7 +47,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 22)) - (table (syntax heavy) (data ()) (align "no alignment"))))) + (table (syntax heavy) (grid ()) (align "no alignment"))))) (warnings ( "File \"f.ml\", line 1, characters 7-13:\ \n'absurd' is not allowed in '{table ...}' (table).\ @@ -62,7 +62,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 27)) - (table (syntax heavy) (data ((row ()))) (align "no alignment"))))) + (table (syntax heavy) (grid ((row ()))) (align "no alignment"))))) (warnings ( "File \"f.ml\", line 1, characters 11-17:\ \n'absurd' is not allowed in '{tr ...}' (table row).\ @@ -78,7 +78,7 @@ let%expect_test _ = ((output (((f.ml (1 0) (1 37)) (table (syntax heavy) - (data ((row ((header ()))) (row ((header ()))) (row ((data ()))))) + (grid ((row ((header ()))) (row ((header ()))) (row ((data ()))))) (align "no alignment"))))) (warnings ())) |}] @@ -118,7 +118,7 @@ let%expect_test _ = ((output (((f.ml (2 8) (28 9)) (table (syntax heavy) - (data + (grid ((row ((header (((f.ml (4 16) (4 19)) @@ -137,7 +137,7 @@ let%expect_test _ = (italic (((f.ml (8 32) (8 35)) (word ddd)))))))))) (data (((f.ml (11 15) (11 32)) - (table (syntax heavy) (data ((row ((data ()))))) + (table (syntax heavy) (grid ((row ((data ()))))) (align "no alignment"))))))) (row ((data @@ -152,7 +152,7 @@ let%expect_test _ = (data (((f.ml (21 14) (25 15)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (22 17) (22 18)) @@ -187,7 +187,7 @@ let%expect_test _ = {| ((output (((f.ml (1 0) (1 4)) - (table (syntax light) (data ()) (align "no alignment"))))) + (table (syntax light) (grid ()) (align "no alignment"))))) (warnings ())) |}] let simple = @@ -201,7 +201,7 @@ let%expect_test _ = ((output (((f.ml (2 8) (4 9)) (table (syntax light) - (data + (grid ((row ((data (((f.ml (3 12) (3 13)) @@ -222,7 +222,7 @@ let%expect_test _ = ((output (((f.ml (2 8) (5 9)) (table (syntax light) - (data + (grid ((row ((data (((f.ml (3 11) (3 12)) @@ -251,7 +251,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (4 7)) (table (syntax light) - (data + (grid ((row ((data (((f.ml (3 11) (3 13)) @@ -274,7 +274,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (data + (grid ((row ((data (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word x))))))) @@ -296,7 +296,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (data + (grid ((row ((data (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) @@ -322,7 +322,7 @@ let%expect_test _ = {| ((output (((f.ml (2 6) (4 7)) - (table (syntax light) (data ()) (align (default default)))))) + (table (syntax light) (grid ()) (align (default default)))))) (warnings ())) |}] let no_data = @@ -337,7 +337,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) @@ -360,7 +360,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word a))))))) @@ -390,7 +390,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (6 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 8) (3 9)) (paragraph (((f.ml (3 8) (3 9)) (word a))))))) @@ -436,7 +436,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (10 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (4 9) (4 10)) (paragraph (((f.ml (4 9) (4 10)) (word a))))))) @@ -477,7 +477,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (5 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 9) (3 14)) @@ -521,7 +521,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (6 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (2 11) (2 13)) @@ -562,7 +562,7 @@ let%expect_test _ = ((output (((f.ml (2 7) (5 8)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 11) (3 12)) @@ -597,7 +597,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (10 7)) (table (syntax light) - (data + (grid ((row ((header ()) (header @@ -654,7 +654,7 @@ let%expect_test _ = ((output (((f.ml (2 11) (5 12)) (table (syntax light) - (data + (grid ((row ((header ()) (header @@ -679,7 +679,7 @@ let%expect_test _ = ((output (((f.ml (2 11) (6 12)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (4 13) (4 14)) @@ -706,7 +706,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (6 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) @@ -739,7 +739,7 @@ let%expect_test _ = ((output (((f.ml (2 6) (6 7)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 9) (3 10)) (paragraph (((f.ml (3 9) (3 10)) (word x))))))) @@ -775,7 +775,7 @@ let%expect_test _ = ((output (((f.ml (2 8) (5 9)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (3 8) (3 10)) @@ -789,7 +789,7 @@ let%expect_test _ = (align (default default default)))) ((f.ml (7 8) (10 9)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (8 9) (8 11)) @@ -803,7 +803,7 @@ let%expect_test _ = (align (default default default)))) ((f.ml (12 8) (15 9)) (table (syntax light) - (data + (grid ((row ((header (((f.ml (13 9) (13 11)) From a6f0526b8388c592117934089235c275e7684b09 Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Tue, 21 Feb 2023 09:25:50 +0000 Subject: [PATCH 18/19] Revert 1199bd4 --- src/dune | 3 -- src/syntax.ml | 91 +++++++++++---------------------------------- test/test_tables.ml | 65 -------------------------------- 3 files changed, 22 insertions(+), 137 deletions(-) diff --git a/src/dune b/src/dune index bc32ea67..36bd5bf2 100644 --- a/src/dune +++ b/src/dune @@ -5,9 +5,6 @@ (public_name odoc-parser) (instrumentation (backend bisect_ppx)) - (inline_tests) - (preprocess - (pps ppx_expect)) (flags (:standard -w -50)) (libraries astring result camlp-streams)) diff --git a/src/syntax.ml b/src/syntax.ml index 4a85493c..bbbf4ccc 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -40,80 +40,33 @@ let peek input = module Table = struct module Light_syntax = struct - let split_on_plus w = - let len = String.length w in - match w with - | "+" -> [ "" ] - | _ when len > 1 -> - let plus = function '+' -> true | _ -> false in - let w = - if plus (String.get w 0) then String.sub w 1 (len - 1) else w - in - let len = String.length w in - let w = - if plus (String.get w (len - 1)) then String.sub w 0 (len - 1) - else w - in - String.split_on_char '+' w - | _ -> [ w ] - - let%expect_test _ = - let f x = - let pp x = Printf.printf "%S " x in - List.iter pp (split_on_plus x) - in - f ""; - [%expect {| "" |}]; - f "+"; - [%expect {| "" |}]; - f "++"; - [%expect {| "" |}]; - f "+--+"; - [%expect {| "--" |}]; - f "--"; - [%expect {| "--" |}]; - f "--+--+--"; - [%expect {| "--" "--" "--" |}]; - f "+----+----+----+"; - [%expect {| "----" "----" "----" |}] - let valid_align = function - | [ { Loc.value = `Word w; _ } ] -> - (* We consider [+----+----+----+] a valid row, as it is a common format. *) - let valid_word w = - match String.length w with - | 0 -> `Valid None - | 1 -> ( - match w with - | "-" -> `Valid None - | ":" -> `Valid (Some `Center) - | _ -> `Invalid) - | len -> - if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) - then - match (String.get w 0, String.get w (len - 1)) with - | ':', ':' -> `Valid (Some `Center) - | ':', '-' -> `Valid (Some `Left) - | '-', ':' -> `Valid (Some `Right) - | '-', '-' -> `Valid None - | _ -> `Invalid - else `Invalid - in - List.map valid_word (split_on_plus w) - | _ -> [ `Invalid ] + | [ { Loc.value = `Word w; _ } ] -> ( + match String.length w with + | 0 -> `Valid None + | 1 -> ( + match w with + | "-" -> `Valid None + | ":" -> `Valid (Some `Center) + | _ -> `Invalid) + | len -> + if String.for_all (Char.equal '-') (String.sub w 1 (len - 2)) then + match (String.get w 0, String.get w (len - 1)) with + | ':', ':' -> `Valid (Some `Center) + | ':', '-' -> `Valid (Some `Left) + | '-', ':' -> `Valid (Some `Right) + | '-', '-' -> `Valid None + | _ -> `Invalid + else `Invalid) + | _ -> `Invalid let valid_align_row lx = let rec loop acc = function | [] -> Some (List.rev acc) - | x :: q -> - let all_aligns = valid_align x in - let valid_aligns = - List.filter_map - (function `Valid a -> Some a | `Invalid -> None) - all_aligns - in - if List.(length valid_aligns < length all_aligns) then None - else loop (List.rev_append valid_aligns acc) q + | x :: q -> ( + match valid_align x with + | `Invalid -> None + | `Valid alignment -> loop (alignment :: acc) q) in loop [] lx diff --git a/test/test_tables.ml b/test/test_tables.ml index 51c8a38b..f81144b6 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -751,70 +751,5 @@ let%expect_test _ = (((f.ml (5 7) (5 8)) (paragraph (((f.ml (5 7) (5 8)) (word x))))))))))) (align (default default)))))) (warnings ())) |}] - - let with_pluses = - test - {| - {t - xx | yy | zz - ---------+-----------+-------------- - } - - {t - xx | yy | zz - +---------+-----------+-------------+ - } - - {t - xx | yy | zz - +---------|-----------+-------------| - } - |}; - [%expect - {| - ((output - (((f.ml (2 8) (5 9)) - (table (syntax light) - (grid - ((row - ((header - (((f.ml (3 8) (3 10)) - (paragraph (((f.ml (3 8) (3 10)) (word xx))))))) - (header - (((f.ml (3 19) (3 21)) - (paragraph (((f.ml (3 19) (3 21)) (word yy))))))) - (header - (((f.ml (3 31) (3 33)) - (paragraph (((f.ml (3 31) (3 33)) (word zz))))))))))) - (align (default default default)))) - ((f.ml (7 8) (10 9)) - (table (syntax light) - (grid - ((row - ((header - (((f.ml (8 9) (8 11)) - (paragraph (((f.ml (8 9) (8 11)) (word xx))))))) - (header - (((f.ml (8 20) (8 22)) - (paragraph (((f.ml (8 20) (8 22)) (word yy))))))) - (header - (((f.ml (8 32) (8 34)) - (paragraph (((f.ml (8 32) (8 34)) (word zz))))))))))) - (align (default default default)))) - ((f.ml (12 8) (15 9)) - (table (syntax light) - (grid - ((row - ((header - (((f.ml (13 9) (13 11)) - (paragraph (((f.ml (13 9) (13 11)) (word xx))))))) - (header - (((f.ml (13 20) (13 22)) - (paragraph (((f.ml (13 20) (13 22)) (word yy))))))) - (header - (((f.ml (13 32) (13 34)) - (paragraph (((f.ml (13 32) (13 34)) (word zz))))))))))) - (align (default default default)))))) - (warnings ())) |}] end in () From 86583cc24db07ff269ba0c7279a3954e8d6e3770 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Wed, 22 Feb 2023 18:20:09 +0000 Subject: [PATCH 19/19] Alternate method of invalid light table syntax --- src/loc.ml | 8 ++++++ src/loc.mli | 4 +++ src/syntax.ml | 65 +++++++++++++++------------------------------ test/test_tables.ml | 2 +- 4 files changed, 34 insertions(+), 45 deletions(-) diff --git a/src/loc.ml b/src/loc.ml index e3f5a07c..0316fa27 100644 --- a/src/loc.ml +++ b/src/loc.ml @@ -22,3 +22,11 @@ let span spans = let nudge_start offset span = { span with start = { span.start with column = span.start.column + offset } } + +let spans_multiple_lines = function + | { + location = + { start = { line = start_line; _ }; end_ = { line = end_line; _ }; _ }; + _; + } -> + end_line > start_line diff --git a/src/loc.mli b/src/loc.mli index 0afe7355..135ba035 100644 --- a/src/loc.mli +++ b/src/loc.mli @@ -39,3 +39,7 @@ val map : ('a -> 'b) -> 'a with_location -> 'b with_location val same : _ with_location -> 'b -> 'b with_location (** [same x y] retuns the value y wrapped in a {!with_location} whose location is that of [x] *) + +val spans_multiple_lines : _ with_location -> bool +(** [spans_multiple_lines x] checks to see whether [x] is located + on a single line or whether it covers more than one. *) diff --git a/src/syntax.ml b/src/syntax.ml index bbbf4ccc..48be287f 100644 --- a/src/syntax.ml +++ b/src/syntax.ml @@ -162,11 +162,6 @@ 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), @@ -188,12 +183,8 @@ type inline_context = In_light_table | Outside_light_table This function consumes exactly the tokens that make up the element. *) let rec inline_element : - input -> - Loc.span -> - context:inline_context -> - _ -> - Ast.inline_element with_location = - fun input location ~context next_token -> + input -> Loc.span -> _ -> Ast.inline_element with_location = + fun input location next_token -> match next_token with | `Space _ as token -> junk input; @@ -226,8 +217,7 @@ let rec inline_element : in let content, brace_location = delimited_inline_element_list ~parent_markup - ~parent_markup_location:location ~requires_leading_whitespace ~context - input + ~parent_markup_location:location ~requires_leading_whitespace input in let location = Loc.span [ location; brace_location ] in @@ -255,7 +245,7 @@ let rec inline_element : let content, brace_location = delimited_inline_element_list ~parent_markup ~parent_markup_location:location ~requires_leading_whitespace:false - ~context input + input in let location = Loc.span [ location; brace_location ] in @@ -293,7 +283,7 @@ let rec inline_element : let content, brace_location = delimited_inline_element_list ~parent_markup ~parent_markup_location:location ~requires_leading_whitespace:false - ~context input + input in `Link (u, content) |> Loc.at (Loc.span [ location; brace_location ]) @@ -324,11 +314,9 @@ 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 - ~context input -> + fun ~parent_markup ~parent_markup_location ~requires_leading_whitespace 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. *) @@ -351,17 +339,10 @@ 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 ~context token :: acc - in + let acc = inline_element input next_token.location token :: acc in consume_elements ~at_start_of_line:false acc - | `Single_newline ws as blank -> + | `Single_newline ws -> 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 -> @@ -374,9 +355,7 @@ and delimited_inline_element_list : let element = Loc.same next_token (`Space ws) in consume_elements ~at_start_of_line:true (element :: acc) | `Bar as token -> - let acc = - inline_element input next_token.location ~context token :: acc - in + let acc = inline_element input next_token.location token :: acc in consume_elements ~at_start_of_line:false acc | (`Minus | `Plus) as bullet -> (if at_start_of_line then @@ -389,9 +368,7 @@ and delimited_inline_element_list : ~suggestion next_token.location |> add_warning input); - let acc = - inline_element input next_token.location ~context bullet :: acc - in + let acc = inline_element input next_token.location bullet :: acc in consume_elements ~at_start_of_line:false acc | other_token -> Parse_error.not_allowed @@ -473,10 +450,7 @@ let paragraph : input -> Ast.nestable_block_element with_location = match next_token.value with | ( `Space _ | `Minus | `Plus | `Bar | #token_that_always_begins_an_inline_element ) as token -> - let element = - inline_element input next_token.location ~context:Outside_light_table - token - in + let element = inline_element input next_token.location token in paragraph_line (element :: acc) | _ -> acc in @@ -1023,7 +997,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 - ~context:Outside_light_table input + input in let location = Loc.span [ location; brace_location ] in let paragraph = @@ -1063,8 +1037,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 ~context:Outside_light_table - input + ~requires_leading_whitespace:true input in if content = [] then Parse_error.should_not_be_empty ~what:(Token.describe token) @@ -1081,7 +1054,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 - ~context:Outside_light_table input + input in let location = Loc.span [ location; brace_location ] in @@ -1307,9 +1280,13 @@ 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 ~context:In_light_table token - in + let i = inline_element input next_token.location token in + if Loc.spans_multiple_lines i then + Parse_error.not_allowed + ~what:(Token.describe (`Single_newline "")) + ~in_what:(Token.describe `Begin_table_light) + i.location + |> add_warning input; consume_row acc_row (i :: acc_cell) ~new_line:false ~last_loc:next_token.location | other_token -> diff --git a/test/test_tables.ml b/test/test_tables.ml index f81144b6..2084e9b9 100644 --- a/test/test_tables.ml +++ b/test/test_tables.ml @@ -546,7 +546,7 @@ let%expect_test _ = (paragraph (((f.ml (5 32) (5 37)) (code_span foo))))))))))) (align (default default)))))) (warnings - ( "File \"f.ml\", line 4, character 18 to line 5, character 14:\ + ( "File \"f.ml\", line 4, character 11 to line 5, character 23:\ \nLine break is not allowed in '{t ...}' (table)."))) |}] let no_space =