Use the new builders, modify readers to preserve empty headers

The Builder.simpleTable now only adds a row to the TableHead when the
given header row is not null. This uncovered an inconsistency in the
readers: some would unconditionally emit a header filled with empty
cells, even if the header was not present. Now every reader has the
conditional behaviour. Only the XWiki writer depended on the header
row being always present; it now pads its head as necessary.

6 files changed, 141 insertions, 135 deletions

diff --git a/test/Tests/Readers/DokuWiki.hs b/test/Tests/Readers/DokuWiki.hs
index d812c215f..15a6a6982 100644
--- a/test/Tests/Readers/DokuWiki.hs
+++ b/test/Tests/Readers/DokuWiki.hs
@@ -296,31 +296,22 @@ tests = [ testGroup "inlines"
           T.unlines [ "| foo | bar |"
                     , "| bat | baz |"
                     ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       []
-                       [[plain "foo", plain "bar"]
-                       ,[plain "bat", plain "baz"]]
+          simpleTable [] [[plain "foo", plain "bar"]
+                         ,[plain "bat", plain "baz"]]
         , "Table with header" =:
           T.unlines [ "^ foo ^ bar ^"
                     , "| bat | baz |"
                     ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       [plain "foo", plain "bar"]
-                       [[plain "bat", plain "baz"]]
+          simpleTable [plain "foo", plain "bar"] [[plain "bat", plain "baz"]]
         , "Table with colspan" =:
           T.unlines [ "^ 0,0 ^ 0,1 ^ 0,2 ^"
                     , "| 1,0 | 1,1 ||"
                     , "| 2,0 | 2,1 | 2,2 |"
                     ] =?>
-          table
-            mempty
-            [(AlignDefault, ColWidthDefault)
-            ,(AlignDefault, ColWidthDefault)
-            ,(AlignDefault, ColWidthDefault)]
-            [plain "0,0", plain "0,1", plain "0,2"]
-            [[plain "1,0", plain "1,1", mempty]
-            ,[plain "2,0", plain "2,1", plain "2,2"]
-            ]
+          simpleTable [plain "0,0", plain "0,1", plain "0,2"]
+                      [[plain "1,0", plain "1,1", mempty]
+                      ,[plain "2,0", plain "2,1", plain "2,2"]
+                      ]
         , "Indented code block" =:
           T.unlines [ "foo"
                     , "  bar"
diff --git a/test/Tests/Readers/LaTeX.hs b/test/Tests/Readers/LaTeX.hs
index 5cddab871..821747f26 100644
--- a/test/Tests/Readers/LaTeX.hs
+++ b/test/Tests/Readers/LaTeX.hs
@@ -36,8 +36,14 @@ infix 4 =:
 (=:) = test latex
 
 simpleTable' :: [Alignment] -> [[Blocks]] -> Blocks
-simpleTable' aligns = table "" (zip aligns (repeat ColWidthDefault))
-                      (map (const mempty) aligns)
+simpleTable' aligns rows
+  = table emptyCaption
+          (zip aligns (repeat ColWidthDefault))
+          (TableHead nullAttr [])
+          [TableBody nullAttr 0 [] $ map toRow rows]
+          (TableFoot nullAttr [])
+  where
+    toRow = Row nullAttr . map simpleCell
 
 tokUntokRt :: String -> Bool
 tokUntokRt s = untokenize (tokenize "random" t) == t
diff --git a/test/Tests/Readers/Man.hs b/test/Tests/Readers/Man.hs
index 7623dcb71..7280f15f2 100644
--- a/test/Tests/Readers/Man.hs
+++ b/test/Tests/Readers/Man.hs
@@ -30,6 +30,9 @@ infix 4 =:
      => String -> (Text, c) -> TestTree
 (=:) = test man
 
+toRow :: [Blocks] -> Row
+toRow = Row nullAttr . map simpleCell
+
 tests :: [TestTree]
 tests = [
   -- .SH "HEllo bbb" "aaa"" as"
@@ -122,16 +125,21 @@ tests = [
   testGroup "Tables" [
       "t1" =:
       ".TS\nallbox;\nl l l.\na\tb\tc\nd\te\tf\n.TE"
-      =?> table mempty (replicate 3 (AlignLeft, ColWidthDefault)) [] [
-        map (plain . str ) ["a", "b", "c"],
-        map (plain . str ) ["d", "e", "f"]
-      ],
+      =?> table
+            emptyCaption
+            (replicate 3 (AlignLeft, ColWidthDefault))
+            (TableHead nullAttr [])
+            [TableBody nullAttr 0 [] $ map toRow
+              [map (plain . str ) ["a", "b", "c"],
+               map (plain . str ) ["d", "e", "f"]]]
+            (TableFoot nullAttr []),
       "longcell" =:
       ".TS\n;\nr.\nT{\na\nb\nc d\nT}\nf\n.TE"
       =?> table
-            mempty
+            emptyCaption
             [(AlignRight, ColWidthDefault)]
-            []
-            [[plain $ text "a b c d"], [plain $ str "f"]]
+            (TableHead nullAttr [])
+            [TableBody nullAttr 0 [] $ map toRow [[plain $ text "a b c d"], [plain $ str "f"]]]
+            (TableFoot nullAttr [])
     ]
   ]
diff --git a/test/Tests/Readers/Muse.hs b/test/Tests/Readers/Muse.hs
index 074b2dc27..77108eb83 100644
--- a/test/Tests/Readers/Muse.hs
+++ b/test/Tests/Readers/Muse.hs
@@ -43,6 +43,17 @@ infix 4 =:
 spcSep :: [Inlines] -> Inlines
 spcSep = mconcat . intersperse space
 
+simpleTable' :: Int -> Caption -> [Blocks] -> [[Blocks]] -> Blocks
+simpleTable' n capt headers rows
+  = table capt
+          (replicate n (AlignDefault, ColWidthDefault))
+          (TableHead nullAttr $ toHeaderRow headers)
+          [TableBody nullAttr 0 [] $ map toRow rows]
+          (TableFoot nullAttr [])
+  where
+    toRow = Row nullAttr . map simpleCell
+    toHeaderRow l = if null l then [] else [toRow l]
+
 -- Tables don't round-trip yet
 --
 makeRoundTrip :: Block -> Block
@@ -982,14 +993,10 @@ tests =
     , testGroup "Tables"
         [ "Two cell table" =:
           "One | Two" =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       []
-                       [[plain "One", plain "Two"]]
+          simpleTable [] [[plain "One", plain "Two"]]
         , "Table with multiple words" =:
           "One two | three four" =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       []
-                       [[plain "One two", plain "three four"]]
+          simpleTable [] [[plain "One two", plain "three four"]]
         , "Not a table" =:
           "One| Two" =?>
           para (text "One| Two")
@@ -1001,38 +1008,30 @@ tests =
             [ "One |  Two"
             , "Three  | Four"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       []
-                       [[plain "One", plain "Two"],
-                       [plain "Three", plain "Four"]]
+          simpleTable [] [[plain "One", plain "Two"],
+                          [plain "Three", plain "Four"]]
         , "Table with one header" =:
           T.unlines
             [ "First || Second"
             , "Third | Fourth"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            [plain "First", plain "Second"]
-            [[plain "Third", plain "Fourth"]]
+          simpleTable [plain "First", plain "Second"] [[plain "Third", plain "Fourth"]]
         , "Table with two headers" =:
           T.unlines
             [ "First || header"
             , "Second || header"
             , "Foo | bar"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            [plain "First", plain "header"]
-            [[plain "Second", plain "header"],
-             [plain "Foo", plain "bar"]]
+          simpleTable [plain "First", plain "header"] [[plain "Second", plain "header"],
+                                                       [plain "Foo", plain "bar"]]
         , "Header and footer reordering" =:
           T.unlines
             [ "Foo ||| bar"
             , "Baz || foo"
             , "Bar | baz"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            [plain "Baz", plain "foo"]
-            [[plain "Bar", plain "baz"],
-             [plain "Foo", plain "bar"]]
+          simpleTable [plain "Baz", plain "foo"] [[plain "Bar", plain "baz"],
+                                                  [plain "Foo", plain "bar"]]
         , "Table with caption" =:
           T.unlines
             [ "Foo || bar || baz"
@@ -1040,32 +1039,30 @@ tests =
             , "Second | row | there"
             , "|+ Table caption +|"
             ] =?>
-          table (text "Table caption") (replicate 3 (AlignDefault, ColWidthDefault))
-            [plain "Foo", plain "bar", plain "baz"]
-            [[plain "First", plain "row", plain "here"],
-             [plain "Second", plain "row", plain "there"]]
+          simpleTable' 3 (simpleCaption $ plain $ text "Table caption")
+                       [plain "Foo", plain "bar", plain "baz"]
+                       [[plain "First", plain "row", plain "here"],
+                        [plain "Second", plain "row", plain "there"]]
         , "Table caption with +" =:
           T.unlines
             [ "Foo | bar"
             , "|+ Table + caption +|"
             ] =?>
-          table (text "Table + caption") (replicate 2 (AlignDefault, ColWidthDefault))
-            []
-            [[plain "Foo", plain "bar"]]
+          simpleTable' 2 (simpleCaption $ plain $ text "Table + caption")
+                       []
+                       [[plain "Foo", plain "bar"]]
         , "Caption without table" =:
           "|+ Foo bar baz +|" =?>
-          table (text "Foo bar baz") [] [] []
+          simpleTable' 0 (simpleCaption $ plain $ text "Foo bar baz") [] []
         , "Table indented with space" =:
           T.unlines
             [ " Foo | bar"
             , " Baz | foo"
             , " Bar | baz"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            []
-            [[plain "Foo", plain "bar"],
-             [plain "Baz", plain "foo"],
-             [plain "Bar", plain "baz"]]
+          simpleTable [] [[plain "Foo", plain "bar"],
+                          [plain "Baz", plain "foo"],
+                          [plain "Bar", plain "baz"]]
         , "Empty cells" =:
           T.unlines
             [ " | Foo"
@@ -1073,42 +1070,33 @@ tests =
             , " bar |"
             , " || baz"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            [plain "", plain "baz"]
-            [[plain "", plain "Foo"],
-             [plain "", plain ""],
-             [plain "bar", plain ""]]
+          simpleTable [plain "", plain "baz"] [[plain "", plain "Foo"],
+                                               [plain "", plain ""],
+                                               [plain "bar", plain ""]]
         , "Empty cell in the middle" =:
           T.unlines
             [ " 1 | 2 | 3"
             , " 4 |   | 6"
             , " 7 | 8 | 9"
             ] =?>
-          table mempty [ (AlignDefault, ColWidthDefault)
-                       , (AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            []
-            [[plain "1", plain "2", plain "3"],
-             [plain "4", mempty,    plain "6"],
-             [plain "7", plain "8", plain "9"]]
+          simpleTable []
+                      [[plain "1", plain "2", plain "3"],
+                       [plain "4", mempty,    plain "6"],
+                       [plain "7", plain "8", plain "9"]]
         , "Grid table" =:
           T.unlines
             [ "+-----+-----+"
             , "| foo | bar |"
             , "+-----+-----+"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       []
-                       [[para "foo", para "bar"]]
+          simpleTable [] [[para "foo", para "bar"]]
         , "Grid table inside list" =:
           T.unlines
             [ " - +-----+-----+"
             , "   | foo | bar |"
             , "   +-----+-----+"
             ] =?>
-          bulletList [table mempty [ (AlignDefault, ColWidthDefault)
-                                   , (AlignDefault, ColWidthDefault)]
-                                   []
-                                   [[para "foo", para "bar"]]]
+          bulletList [simpleTable [] [[para "foo", para "bar"]]]
         , "Grid table with two rows" =:
           T.unlines
             [ "+-----+-----+"
@@ -1117,10 +1105,8 @@ tests =
             , "| bat | baz |"
             , "+-----+-----+"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-                       []
-                       [[para "foo", para "bar"]
-                       ,[para "bat", para "baz"]]
+          simpleTable [] [[para "foo", para "bar"]
+                         ,[para "bat", para "baz"]]
         , "Grid table inside grid table" =:
           T.unlines
             [ "+-----+"
@@ -1129,11 +1115,7 @@ tests =
             , "|+---+|"
             , "+-----+"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault)]
-                       []
-                       [[table mempty [(AlignDefault, ColWidthDefault)]
-                                      []
-                                      [[para "foo"]]]]
+          simpleTable [] [[simpleTable [] [[para "foo"]]]]
         , "Grid table with example" =:
           T.unlines
             [ "+------------+"
@@ -1142,9 +1124,7 @@ tests =
             , "| </example> |"
             , "+------------+"
             ] =?>
-          table mempty [(AlignDefault, ColWidthDefault)]
-                       []
-                       [[codeBlock "foo"]]
+          simpleTable [] [[codeBlock "foo"]]
         ]
     , testGroup "Lists"
       [ "Bullet list" =:
@@ -1513,19 +1493,11 @@ tests =
                        ]
       , "Definition list with table" =:
         " foo :: bar | baz" =?>
-        definitionList [ ("foo", [ table mempty [ (AlignDefault, ColWidthDefault)
-                                                , (AlignDefault, ColWidthDefault)]
-                                                []
-                                                [[plain "bar", plain "baz"]]
+        definitionList [ ("foo", [ simpleTable [] [[plain "bar", plain "baz"]]
                                  ])]
       , "Definition list with table inside bullet list" =:
         " - foo :: bar | baz" =?>
-        bulletList [definitionList [ ("foo", [ table
-                                                mempty
-                                                [ (AlignDefault, ColWidthDefault)
-                                                , (AlignDefault, ColWidthDefault) ]
-                                                []
-                                                [[plain "bar", plain "baz"]]
+        bulletList [definitionList [ ("foo", [ simpleTable [] [[plain "bar", plain "baz"]]
                                              ])]]
       , test emacsMuse "Multi-line definition lists from Emacs Muse manual"
         (T.unlines
diff --git a/test/Tests/Readers/Org/Block/Table.hs b/test/Tests/Readers/Org/Block/Table.hs
index 4b76f4a58..d35d17979 100644
--- a/test/Tests/Readers/Org/Block/Table.hs
+++ b/test/Tests/Readers/Org/Block/Table.hs
@@ -24,7 +24,18 @@ simpleTable' :: Int
              -> [Blocks]
              -> [[Blocks]]
              -> Blocks
-simpleTable' n = table "" (replicate n (AlignDefault, ColWidthDefault))
+simpleTable' n = simpleTable'' emptyCaption $ replicate n (AlignDefault, ColWidthDefault)
+
+simpleTable'' :: Caption -> [ColSpec] -> [Blocks] -> [[Blocks]] -> Blocks
+simpleTable'' capt spec headers rows
+  = table capt
+          spec
+          (TableHead nullAttr $ toHeaderRow headers)
+          [TableBody nullAttr 0 [] $ map toRow rows]
+          (TableFoot nullAttr [])
+  where
+    toRow = Row nullAttr . map simpleCell
+    toHeaderRow l = if null l then [] else [toRow l]
 
 tests :: [TestTree]
 tests =
@@ -121,14 +132,16 @@ tests =
                 , "| 1       | One  | foo  |"
                 , "| 2       | Two  | bar  |"
                 ] =?>
-      table "" (zip
-                 [AlignCenter, AlignRight, AlignDefault]
-                 [ColWidthDefault, ColWidthDefault, ColWidthDefault])
-            []
-            [ [ plain "Numbers", plain "Text", plain "More" ]
-            , [ plain "1"      , plain "One" , plain "foo"  ]
-            , [ plain "2"      , plain "Two" , plain "bar"  ]
-            ]
+      simpleTable''
+        emptyCaption
+        (zip
+          [AlignCenter, AlignRight, AlignDefault]
+          [ColWidthDefault, ColWidthDefault, ColWidthDefault])
+        []
+        [ [ plain "Numbers", plain "Text", plain "More" ]
+        , [ plain "1"      , plain "One" , plain "foo"  ]
+        , [ plain "2"      , plain "Two" , plain "bar"  ]
+        ]
 
   , "Pipe within text doesn't start a table" =:
       "Ceci n'est pas une | pipe " =?>
@@ -145,23 +158,26 @@ tests =
                 , "| 1       | One  | foo  |"
                 , "| 2"
                 ] =?>
-      table "" (zip [AlignCenter, AlignRight] [ColWidthDefault, ColWidthDefault])
-            [ plain "Numbers", plain "Text" ]
-            [ [ plain "1" , plain "One" , plain "foo" ]
-            , [ plain "2" ]
-            ]
+      simpleTable''
+        emptyCaption
+        (zip [AlignCenter, AlignRight] [ColWidthDefault, ColWidthDefault])
+        [ plain "Numbers", plain "Text" ]
+        [ [ plain "1" , plain "One" , plain "foo" ]
+        , [ plain "2" ]
+        ]
 
   , "Table with caption" =:
       T.unlines [ "#+CAPTION: Hitchhiker's Multiplication Table"
                 , "| x |  6 |"
                 , "| 9 | 42 |"
                 ] =?>
-      table "Hitchhiker's Multiplication Table"
-            [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
-            []
-            [ [ plain "x", plain "6" ]
-            , [ plain "9", plain "42" ]
-            ]
+      simpleTable''
+        (simpleCaption $ plain "Hitchhiker's Multiplication Table")
+        [(AlignDefault, ColWidthDefault), (AlignDefault, ColWidthDefault)]
+        []
+        [ [ plain "x", plain "6" ]
+        , [ plain "9", plain "42" ]
+        ]
 
   , "named table" =:
       T.unlines [ "#+NAME: x-marks-the-spot"
diff --git a/test/Tests/Readers/Txt2Tags.hs b/test/Tests/Readers/Txt2Tags.hs
index be6747bfe..a56f814ae 100644
--- a/test/Tests/Readers/Txt2Tags.hs
+++ b/test/Tests/Readers/Txt2Tags.hs
@@ -44,7 +44,18 @@ simpleTable' :: Int
              -> [Blocks]
              -> [[Blocks]]
              -> Blocks
-simpleTable' n = table "" (replicate n (AlignCenter, ColWidthDefault))
+simpleTable' n = simpleTable'' $ replicate n (AlignCenter, ColWidthDefault)
+
+simpleTable'' :: [ColSpec] -> [Blocks] -> [[Blocks]] -> Blocks
+simpleTable'' spec headers rows
+  = table emptyCaption
+          spec
+          (TableHead nullAttr $ toHeaderRow headers)
+          [TableBody nullAttr 0 [] $ map toRow rows]
+          (TableFoot nullAttr [])
+  where
+    toRow = Row nullAttr . map simpleCell
+    toHeaderRow l = if null l then [] else [toRow l]
 
 tests :: [TestTree]
 tests =
@@ -398,14 +409,15 @@ tests =
                   , "| 1 |    One  |    foo  |"
                   , "| 2 |    Two  | bar  |"
                   ] =?>
-          table "" (zip
-                     [AlignCenter, AlignRight, AlignDefault]
-                     [ColWidthDefault, ColWidthDefault, ColWidthDefault])
-                []
-                [ [ plain "Numbers", plain "Text", plain "More" ]
-                , [ plain "1"      , plain "One" , plain "foo"  ]
-                , [ plain "2"      , plain "Two" , plain "bar"  ]
-                ]
+          simpleTable''
+            (zip
+              [AlignCenter, AlignRight, AlignDefault]
+              [ColWidthDefault, ColWidthDefault, ColWidthDefault])
+            []
+            [ [ plain "Numbers", plain "Text", plain "More" ]
+            , [ plain "1"      , plain "One" , plain "foo"  ]
+            , [ plain "2"      , plain "Two" , plain "bar"  ]
+            ]
 
       , "Pipe within text doesn't start a table" =:
           "Ceci n'est pas une | pipe " =?>
@@ -417,13 +429,14 @@ tests =
                   , "| 1 | One  | foo  |"
                   , "| 2 "
                   ] =?>
-          table "" (zip
-                     [AlignCenter, AlignLeft, AlignLeft]
-                     [ColWidthDefault, ColWidthDefault, ColWidthDefault])
-                [ plain "Numbers", plain "Text" , plain mempty ]
-                [ [ plain "1"      , plain "One"  , plain "foo"  ]
-                , [ plain "2"      , plain mempty , plain mempty  ]
-                ]
+          simpleTable''
+            (zip
+              [AlignCenter, AlignLeft, AlignLeft]
+              [ColWidthDefault, ColWidthDefault, ColWidthDefault])
+            [ plain "Numbers", plain "Text" , plain mempty ]
+            [ [ plain "1"      , plain "One"  , plain "foo"  ]
+            , [ plain "2"      , plain mempty , plain mempty  ]
+            ]
 
       ]