git.iko.soy/typeable/pandoc
on master help sign in
Modify toLegacyTable to cut up cells, add tests

Now a cell with dimension (h, w) will be cut up into h*w cells of dimension (1,1), all in the same grid position, with the upper-left holding the original cell contents and the rest being empty.

commit2fc11f3b1efdd61cddf834878b845a5ec7b93923 authordespresc <christian.j.j.despres@gmail.com> dateFri 10 Apr 2020, 10:04 (7 years ago) parentc7814f3
2 files changed+104−8
compare with master
unifiedsplit
src/Text/Pandoc/Writers/Shared.hs+43−8 test/Tests/Shared.hs+61
src/Text/Pandoc/Writers/Shared.hs+43−8
@@ -431,14 +431,16 @@ endsWithPlain xs =
431431-- | Convert the relevant components of a new-style table (with block
432432-- caption, row headers, row and column spans, and so on) to those of
433433-- an old-style table (inline caption, table head with one row, no
434−-- foot, and so on).
434+-- foot, and so on). Cells with a 'RowSpan' and 'ColSpan' of @(h, w)@
435+-- will be cut up into @h * w@ cells of dimension @(1, 1)@, with the
436+-- content placed in the upper-left corner.
435437toLegacyTable :: Caption
436438 -> [ColSpec]
437439 -> TableHead
438440 -> [TableBody]
439441 -> TableFoot
440442 -> ([Inline], [Alignment], [Double], [[Block]], [[[Block]]])
441−toLegacyTable (Caption _ cbody) specs (TableHead _ th) tb (TableFoot _ tf)
443+toLegacyTable (Caption _ cbody) specs thead tbodies tfoot
442444 = (cbody', aligns, widths, th', tb')
443445 where
444446 numcols = length specs
@@ -446,13 +448,46 @@ toLegacyTable (Caption _ cbody) specs (TableHead _ th) tb (TableFoot _ tf)
446448 fromWidth (ColWidth w) | w > 0 = w
447449 fromWidth _ = 0
448450 widths = map fromWidth mwidths
449− unRow (Row _ x) = map unCell x
450− unCell (Cell _ _ _ _ x) = x
451+ unRow (Row _ x) = x
451452 unBody (TableBody _ _ hd bd) = hd <> bd
452453 unBodies = concatMap unBody
454+
455+ TableHead _ th = Builder.normalizeTableHead numcols thead
456+ tb = map (Builder.normalizeTableBody numcols) tbodies
457+ TableFoot _ tf = Builder.normalizeTableFoot numcols tfoot
458+
453459 cbody' = blocksToInlines cbody
454− sanitise = pad mempty numcols . unRow
455− pad element upTo list = take upTo (list ++ repeat element)
460+
456461 (th', tb') = case th of
457− (r:rs) -> (sanitise r, map sanitise $ rs <> unBodies tb <> tf)
458− [] -> ([], map sanitise $ unBodies tb <> tf)
462+ r:rs -> let (pendingPieces, r') = placeCutCells [] $ unRow r
463+ rs' = cutRows pendingPieces $ rs <> unBodies tb <> tf
464+ in (r', rs')
465+ [] -> ([], cutRows [] $ unBodies tb <> tf)
466+
467+ -- Adapted from placeRowSection in Builders. There is probably a
468+ -- more abstract foldRowSection that unifies them both.
469+ placeCutCells pendingPieces cells
470+ -- If there are any pending pieces for a column, add
471+ -- them. Pending pieces have preference over cells due to grid
472+ -- layout rules.
473+ | (p:ps):pendingPieces' <- pendingPieces
474+ = let (pendingPieces'', rowPieces) = placeCutCells pendingPieces' cells
475+ in (ps : pendingPieces'', p : rowPieces)
476+ -- Otherwise cut up a cell on the row and deal with its pieces.
477+ | c:cells' <- cells
478+ = let (h, w, cBody) = getComponents c
479+ cRowPieces = cBody : replicate (w - 1) mempty
480+ cPendingPieces = replicate w $ replicate (h - 1) mempty
481+ pendingPieces' = dropWhile null pendingPieces
482+ (pendingPieces'', rowPieces) = placeCutCells pendingPieces' cells'
483+ in (cPendingPieces <> pendingPieces'', cRowPieces <> rowPieces)
484+ | otherwise = ([], [])
485+
486+ cutRows pendingPieces (r:rs)
487+ = let (pendingPieces', r') = placeCutCells pendingPieces $ unRow r
488+ rs' = cutRows pendingPieces' rs
489+ in r' : rs'
490+ cutRows _ [] = []
491+
492+ getComponents (Cell _ _ (RowSpan h) (ColSpan w) body)
493+ = (h, w, body)
test/Tests/Shared.hs+61
@@ -20,6 +20,7 @@ import Test.Tasty.HUnit (assertBool, testCase, (@?=))
2020import Text.Pandoc.Arbitrary ()
2121import Text.Pandoc.Builder
2222import Text.Pandoc.Shared
23+import Text.Pandoc.Writers.Shared (toLegacyTable)
2324
2425tests :: [TestTree]
2526tests = [ testGroup "compactifyDL"
@@ -29,6 +30,7 @@ tests = [ testGroup "compactifyDL"
2930 in compactifyDL x == x)
3031 ]
3132 , testGroup "collapseFilePath" testCollapse
33+ , testGroup "toLegacyTable" testLegacyTable
3234 ]
3335
3436testCollapse :: [TestTree]
@@ -51,3 +53,62 @@ testCollapse = map (testCase "collapse")
5153 , collapseFilePath (joinPath [ "parent","foo",".."]) @?= (joinPath [ "parent"])
5254 , collapseFilePath (joinPath [ "","parent","foo","..","..","bar"]) @?= (joinPath [ "","bar"])
5355 , collapseFilePath (joinPath [ "",".","parent","foo"]) @?= (joinPath [ "","parent","foo"])]
56+
57+testLegacyTable :: [TestTree]
58+testLegacyTable =
59+ [ testCase "decomposes a table with head" $ gen1 @?= expect1
60+ , testCase "decomposes a table without head" $ gen2 @?= expect2
61+ ]
62+ where
63+ pln = toList . plain . str
64+ cl a h w = Cell ("", [], []) AlignDefault h w $ pln a
65+ rws = map $ Row nullAttr
66+ th = TableHead nullAttr . rws
67+ tb n x y = TableBody nullAttr n (rws x) (rws y)
68+ tf = TableFoot nullAttr . rws
69+
70+ headRows1 =
71+ [[cl "a" 1 1, cl "b" 2 2]
72+ ,[cl "c" 1 1]
73+ ]
74+ body1 = tb 1
75+ [[cl "e" 3 1,cl "f" 3 2]
76+ ,[]
77+ ,[]
78+ ]
79+ [[emptyCell,emptyCell,emptyCell]
80+ ,[cl "g" 1 1,emptyCell,emptyCell]
81+ ]
82+ footRows1 =
83+ [[cl "h" 1 2,cl "i" 2 1]
84+ ,[cl "j" 1 2]]
85+ caption1 = simpleCaption $ plain "caption"
86+ spec1 = replicate 2 (AlignDefault, ColWidth 0.5) ++ [(AlignRight, ColWidthDefault)]
87+ expect1 = ( [Str "caption"]
88+ , replicate 2 AlignDefault ++ [AlignRight]
89+ , replicate 2 0.5 ++ [0]
90+ , [pln "a", pln "b", mempty]
91+ , [[pln "c", mempty, mempty]
92+ ,[pln "e", pln "f", mempty]
93+ ,[mempty, mempty, mempty]
94+ ,[mempty, mempty, mempty]
95+ ,[mempty, mempty, mempty]
96+ ,[pln "g", mempty, mempty]
97+ ,[pln "h", mempty, pln "i"]
98+ ,[pln "j", mempty, mempty]]
99+ )
100+ gen1 = toLegacyTable caption1 spec1 (th headRows1) [body1] (tf footRows1)
101+
102+ expect2 = ( []
103+ , replicate 2 AlignDefault ++ [AlignRight]
104+ , replicate 2 0.5 ++ [0]
105+ , []
106+ , [[pln "e", pln "f", mempty]
107+ ,[mempty, mempty, mempty]
108+ ,[mempty, mempty, mempty]
109+ ,[mempty, mempty, mempty]
110+ ,[pln "g", mempty, mempty]
111+ ,[pln "h", mempty, pln "i"]
112+ ,[pln "j", mempty, mempty]]
113+ )
114+ gen2 = toLegacyTable emptyCaption spec1 (th []) [body1] (tf footRows1)