Change the table builder to permit looser intermediate table heads (#77)

The table builder (and the normalizeTableBody function) now permit
cells in the intermediate head of a TableBody to extend past the
RowHeadColumns. This allows for intermediate tables to have
subheadings that extend across the entire table.

Formerly the table builder would treat the intermediate head like the
intermediate body, and clip or drop cells that extended past the row
head.

Author: despresc

src/Text/Pandoc/Builder.hs

@@ -579,13 +579,16 @@ normalizeTableHead twidth (TableHead attr rows)
 
 -- | Normalize the intermediate head and body section of a
 -- 'TableBody', as in 'normalizeTableHead', but additionally ensure
--- that row head cells do not go beyond the row head.
+-- that row head cells do not go beyond the row head inside the
+-- intermediate body.
 normalizeTableBody :: Int -> TableBody -> TableBody
 normalizeTableBody twidth (TableBody attr rhc th tb)
-  = TableBody attr rhc' (normBody th) (normBody tb)
+  = TableBody attr
+              rhc'
+              (normalizeHeaderSection twidth th)
+              (normalizeBodySection twidth rhc' tb)
   where
     rhc' = max 0 $ min (RowHeadColumns twidth) rhc
-    normBody = normalizeBodySection twidth rhc'
 
 -- | Normalize the 'TableFoot', as in 'normalizeTableHead'.
 normalizeTableFoot :: Int -> TableFoot -> TableFoot

src/Text/Pandoc/Definition.hs

@@ -238,8 +238,9 @@ data Row = Row Attr [Cell]
 data TableHead = TableHead Attr [Row]
   deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
 
--- | A body of a table, with an intermediate head and the specified
--- number of row header columns.
+-- | A body of a table, with an intermediate head, intermediate body,
+-- and the specified number of row header columns in the intermediate
+-- body.
 data TableBody = TableBody Attr RowHeadColumns [Row] [Row]
   deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
 

test/test-pandoc-types.hs

@@ -468,16 +468,18 @@ cellsSubsetPad xs _ = all isPadCell xs
 rowSubset :: Row -> Row -> Bool
 rowSubset (Row a1 x1) (Row a2 x2) = a1 == a2 && cellsSubsetPad x1 x2
 
+-- The remarks in rowSubset apply.
+rowsSubset :: [Row] -> [Row] -> Bool
+rowsSubset (x:xs) (y:ys) = rowSubset x y && rowsSubset xs ys
+rowsSubset []     _      = True
+rowsSubset (_:_)  []     = False
+
 normIsSubset :: (Arbitrary a, Show a, Eq a)
              => (Int -> a -> a)
              -> (a -> [Row])
              -> Property
 normIsSubset f proj = withWidth $
   \n a -> let a' = f n a in proj a' `rowsSubset` proj a
-  where
-    rowsSubset (x:xs) (y:ys) = rowSubset x y && rowsSubset xs ys
-    rowsSubset []     _      = True
-    rowsSubset (_:_)  []     = False
 
 p_tableNormHeadIsSubset :: Property
 p_tableNormHeadIsSubset = normIsSubset normalizeTableHead thproj
@@ -486,7 +488,9 @@ p_tableNormHeadIsSubset = normIsSubset normalizeTableHead thproj
 
 -- Checking that each row is a subset of its unnormalized version is a
 -- little onerous in the TableBody (because of the row head/row body
--- distinction), so we settle for testing it only for the first row.
+-- distinction), so we settle for testing it only for the first row of
+-- the intermediate body. The intermediate head is still checked
+-- fully.
 p_tableNormBodyIsSubset :: Property
 p_tableNormBodyIsSubset = withWidth $
   \n tb -> checkBody n (normalizeTableBody n tb) tb
@@ -512,7 +516,7 @@ p_tableNormBodyIsSubset = withWidth $
     checkRows _ _   []     []    = True
     checkRows _ _   _      _     = False
     checkBody n (TableBody _ (RowHeadColumns rhc) th' tb') (TableBody _ _ th tb)
-      = checkRows n rhc th' th && checkRows n rhc tb' tb
+      = rowsSubset th' th && checkRows n rhc tb' tb
 
 p_tableNormFootIsSubset :: Property
 p_tableNormFootIsSubset = normIsSubset normalizeTableFoot tfproj
@@ -570,20 +574,18 @@ t_tableNormExample = testCase "table normalization example" assertion
       ,[cl "c" 1 1]
       ]
     initialTB = tb 1
-      [[cl "e" 4 3,cl "f" 4 3]
+      [[]
+      ,[cl "g" (-7) 0,cl "h" 4 1]]
+      [[cl "e" 4 3   ,cl "f" 4 3]
       ,[]
       ,[emptyCell]
       ]
-      [[]
-      ,[cl "g" (-7) 0]]
     finalTB = tb 1
+      [[emptyCell,emptyCell,emptyCell]
+      ,[cl "g" 1 1,cl "h" 1 1,emptyCell]]
       [[cl "e" 3 1,cl "f" 3 2]
       ,[]
-      ,[]
-      ]
-      [[emptyCell,emptyCell,emptyCell]
-      ,[cl "g" 1 1,emptyCell,emptyCell]
-      ]
+      ,[]]
     spec = replicate 3 (AlignDefault, ColWidthDefault)
     expected = singleton $ Table nullAttr
                                  emptyCaption