Convert light table contents to nestable block elements

Author: gpetiot

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 ]

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

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 ]