Skip to content

Commit

Permalink
Merge pull request ocaml-doc#3 from panglesd/tables
Browse files Browse the repository at this point in the history 
Fix default alignment
  • Loading branch information
Guillaume Petiot authored Feb 20, 2023
2 parents d20885a + 361354c commit 497fe75
Show file tree
Hide file tree
Showing 4 changed files with 78 additions and 56 deletions.
2 changes: 1 addition & 1 deletion src/ast.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
50 changes: 28 additions & 22 deletions src/syntax.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
16 changes: 11 additions & 5 deletions test/test.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -89,14 +90,19 @@ 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";
List [ Atom "syntax"; Atom (syntax s) ];
( 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
Expand Down
66 changes: 38 additions & 28 deletions test/test_tables.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,15 +8,18 @@ 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 =
test "{table {tr } }";
[%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 =
Expand All @@ -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 =
Expand All @@ -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).\
Expand All @@ -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).\
Expand All @@ -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 =
Expand Down Expand Up @@ -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))
Expand Down Expand Up @@ -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
()
Expand All @@ -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 =
Expand All @@ -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 =
Expand Down Expand Up @@ -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 =
Expand All @@ -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 =
Expand All @@ -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 =
Expand Down Expand Up @@ -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 =
Expand All @@ -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 =
Expand All @@ -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 =
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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)."))) |}]
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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)."))) |}]
Expand All @@ -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)."))) |}]
Expand Down Expand Up @@ -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 =
Expand All @@ -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
()

0 comments on commit 497fe75

Please sign in to comment.