Add syntax for tables

Author: gpetiot

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,13 +47,18 @@ 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\]].
     This corresponds to the syntactic constructor used (see the
     {{: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

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

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

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)) }