build tables with consistent lengths, see jgm/pandoc#4059

jgm · Jan 15, 2018 · ed19be7 · ed19be7
1 parent 0bd6a45
commit ed19be7
Show file tree

Hide file tree

Showing 2 changed files with 27 additions and 9 deletions.
diff --git a/Text/Pandoc/Builder.hs b/Text/Pandoc/Builder.hs
@@ -471,21 +471,19 @@ headerWith attr level = singleton . Header level attr . toList
 horizontalRule :: Blocks
 horizontalRule = singleton HorizontalRule
 
+-- | Table builder. Rows and headers will be padded or truncated to the size of
+-- @cellspecs@
 table :: Inlines               -- ^ Caption
       -> [(Alignment, Double)] -- ^ Column alignments and fractional widths
       -> [Blocks]              -- ^ Headers
       -> [[Blocks]]            -- ^ Rows
       -> Blocks
 table caption cellspecs headers rows = singleton $
-  Table (toList caption) aligns widths
-      (map toList headers') (map (map toList) rows)
+  Table (toList caption) aligns widths (sanitise headers) (map sanitise rows)
    where (aligns, widths) = unzip cellspecs
-         numcols  = case (headers:rows) of
-                         [] -> 0
-                         xs -> maximum (map length xs)
-         headers' = if null headers
-                       then replicate numcols mempty
-                       else headers
+         sanitise = map toList . pad mempty numcols
+         numcols = length cellspecs
+         pad element upTo list = take upTo (list ++ repeat element)
 
 -- | A simple table without a caption.
 simpleTable :: [Blocks]   -- ^ Headers

diff --git a/test/test-pandoc-types.hs b/test/test-pandoc-types.hs
@@ -3,6 +3,7 @@
 import Text.Pandoc.Arbitrary ()
 import Text.Pandoc.Definition
 import Text.Pandoc.Walk
+import Text.Pandoc.Builder (simpleTable, singleton)
 import Data.Generics
 import Data.List (tails)
 import Test.HUnit (Assertion, assertEqual, assertFailure)
@@ -362,6 +363,24 @@ t_div = ( Div ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Para [Str "Hello"]]
 t_null :: (Block, ByteString)
 t_null = (Null, [s|{"t":"Null"}|])
 
+-- headers and rows are truncated or padded to a consistent number of
+-- cells in order to avoid syntax errors after conversion, see
+-- jgm/pandoc#4059. this test uses `simpleTable` therefore it cannot
+-- test truncation
+t_tableSan :: Test
+t_tableSan = testCase "table sanitisation" $ assertion
+             where assertion = assertEqual err expected generated
+                   err = "sanitisation error"
+                   headers = [singleton Null, singleton Null]
+                   r1 = [mempty]
+                   r2 = []
+                   generated = simpleTable headers [r1, r2]
+                   expected = singleton (Table
+                                         []
+                                         [AlignDefault, AlignDefault]
+                                         [0.0, 0.0]
+                                         [[Null], [Null]] [[[], []], [[], []]])
+
 
 tests :: [Test]
 tests =
@@ -438,7 +457,8 @@ tests =
         , testEncodeDecode "Null" t_null
         ]
       ]
-    ]
+    ],
+    t_tableSan
   ]