aboutsummaryrefslogtreecommitdiff
path: root/test
diff options
context:
space:
mode:
authorChristian Despres <50160106+despresc@users.noreply.github.com>2020-09-05 17:36:51 -0400
committerGitHub <noreply@github.com>2020-09-05 14:36:51 -0700
commit10c6c411f9bd582ce9bafe159728f322a54395cd (patch)
tree710e87c33e06824eeb171a5ddc5c9eb174c9f43e /test
parent3935c9c5c4b070d43b2d7d946fd28dfdaf87e080 (diff)
downloadpandoc-10c6c411f9bd582ce9bafe159728f322a54395cd.tar.gz
Add Writers.Tables helper functions and types, add tests for those (#6655)
Add Writers.Tables helper functions and types, add tests for those The Writers.Tables module contains an AnnTable type that is a pandoc Table with added inferred information that should be enough for writers (in particular the HTML writer) to operate on without having to lay out the table themselves. The toAnnTable and fromAnnTable functions in that module convert between AnnTable and Table. In addition to producing an AnnTable with coherent and well-formed annotations, the toAnnTable function also normalizes its input Table like the table builder does. Various tests ensure that toAnnTable normalizes tables exactly like the table builder, and that its annotations are coherent.
Diffstat (limited to 'test')
-rw-r--r--test/Tests/Writers/Tables.hs252
-rw-r--r--test/test-pandoc.hs2
2 files changed, 254 insertions, 0 deletions
diff --git a/test/Tests/Writers/Tables.hs b/test/Tests/Writers/Tables.hs
new file mode 100644
index 000000000..6dab8f972
--- /dev/null
+++ b/test/Tests/Writers/Tables.hs
@@ -0,0 +1,252 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+ Module : Tests.Writers.Tables
+ Copyright : 2020 Christian Despres
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Christian Despres <christian.j.j.despres@gmail.com>
+ Stability : alpha
+ Portability : portable
+
+Tests for the table helper functions.
+-}
+module Tests.Writers.Tables
+ ( tests
+ )
+where
+
+import Prelude
+import qualified Data.Foldable as F
+import qualified Data.List.NonEmpty as NonEmpty
+import Test.Tasty
+import Test.Tasty.HUnit ( testCase
+ , (@?=)
+ )
+import Test.Tasty.QuickCheck ( QuickCheckTests(..)
+ , Property
+ , Testable
+ , conjoin
+ , forAll
+ , testProperty
+ , (===)
+ , vectorOf
+ , choose
+ , arbitrary
+ , elements
+ )
+import Text.Pandoc.Arbitrary ( )
+import Text.Pandoc.Builder
+import Text.Pandoc.Writers.Tables
+
+tests :: [TestTree]
+tests = [testGroup "toAnnTable" $ testAnnTable <> annTableProps]
+
+getSpec :: AnnCell -> [ColSpec]
+getSpec (AnnCell colspec _ _) = F.toList colspec
+
+catHeaderSpec :: AnnHeaderRow -> [ColSpec]
+catHeaderSpec (AnnHeaderRow _ _ x) = concatMap getSpec x
+
+catBodySpec :: AnnBodyRow -> [ColSpec]
+catBodySpec (AnnBodyRow _ _ x y) = concatMap getSpec x <> concatMap getSpec y
+
+-- Test if the first list can be obtained from the second by deleting
+-- elements from it.
+isSubsetOf :: Eq a => [a] -> [a] -> Bool
+isSubsetOf (x : xs) (y : ys) | x == y = isSubsetOf xs ys
+ | otherwise = isSubsetOf (x : xs) ys
+isSubsetOf [] _ = True
+isSubsetOf _ [] = False
+
+testAnnTable :: [TestTree]
+testAnnTable =
+ [testCase "annotates a sample table properly" $ generated @?= expected]
+ where
+ spec1 = (AlignRight, ColWidthDefault)
+ spec2 = (AlignLeft, ColWidthDefault)
+ spec3 = (AlignCenter, ColWidthDefault)
+ spec = [spec1, spec2, spec3]
+
+ cl a h w = Cell (a, [], []) AlignDefault h w []
+ rws = map $ Row nullAttr
+ th = TableHead nullAttr . rws
+ tb n x y = TableBody nullAttr n (rws x) (rws y)
+ tf = TableFoot nullAttr . rws
+ initialHeads = [[cl "a" 1 1, cl "b" 3 2], [cl "c" 2 2, cl "d" 1 1]]
+ initialTB1 = tb 1
+ [[], [cl "e" 5 1, cl "f" (-7) 0]]
+ [[cl "g" 4 3, cl "h" 4 3], [], [emptyCell]]
+ initialTB2 = tb 2 [] [[cl "i" 4 3, cl "j" 4 3]]
+ generated = toAnnTable nullAttr
+ emptyCaption
+ spec
+ (th initialHeads)
+ [initialTB1, initialTB2]
+ (tf initialHeads)
+
+ acl al n a h w =
+ AnnCell (NonEmpty.fromList al) n $ Cell (a, [], []) AlignDefault h w []
+ emptyAnnCell al n = acl al n "" 1 1
+ ahrw = AnnHeaderRow nullAttr
+ abrw = AnnBodyRow nullAttr
+ ath = AnnTableHead nullAttr
+ atb = AnnTableBody nullAttr
+ atf = AnnTableFoot nullAttr
+
+ finalTH = ath
+ [ ahrw 0 [acl [spec1] 0 "a" 1 1, acl [spec2, spec3] 1 "b" 2 2]
+ , ahrw 1 [acl [spec1] 0 "c" 1 1]
+ ]
+ finalTB1 = atb
+ 1
+ [ ahrw
+ 2
+ [emptyAnnCell [spec1] 0, emptyAnnCell [spec2] 1, emptyAnnCell [spec3] 2]
+ , ahrw
+ 3
+ [acl [spec1] 0 "e" 1 1, acl [spec2] 1 "f" 1 1, emptyAnnCell [spec3] 2]
+ ]
+ [ abrw 4 [acl [spec1] 0 "g" 3 1] [acl [spec2, spec3] 1 "h" 3 2]
+ , abrw 5 [] []
+ , abrw 6 [] []
+ ]
+ finalTB2 =
+ atb 2 [] [abrw 7 [acl [spec1, spec2] 0 "i" 1 2] [acl [spec3] 2 "j" 1 1]]
+ finalTF = atf
+ [ ahrw 8 [acl [spec1] 0 "a" 1 1, acl [spec2, spec3] 1 "b" 2 2]
+ , ahrw 9 [acl [spec1] 0 "c" 1 1]
+ ]
+ expected =
+ AnnTable nullAttr emptyCaption spec finalTH [finalTB1, finalTB2] finalTF
+
+withColSpec :: Testable prop => ([ColSpec] -> prop) -> Property
+withColSpec = forAll arbColSpec
+ where
+ arbColSpec = do
+ cs <- choose (1 :: Int, 6)
+ vectorOf
+ cs
+ ((,) <$> arbitrary <*> elements
+ [ColWidthDefault, ColWidth (1 / 3), ColWidth 0.25]
+ )
+
+annTableProps :: [TestTree]
+annTableProps =
+ localOption (QuickCheckTests 50)
+ <$> [ testProperty "normalizes like the table builder" propBuilderAnnTable
+ , testProperty "has valid final cell columns" propColNumber
+ , testProperty "has valid first row column data" propFirstRowCols
+ , testProperty "has valid all row column data" propColSubsets
+ , testProperty "has valid cell column data lengths"
+ propCellColLengths
+ ]
+
+-- The property that toAnnTable will normalize a table identically to
+-- the table builder. This should mean that toAnnTable is at least as
+-- rigorous as Builder.table in that respect without repeating those
+-- tests here (see the pandoc-types Table tests for examples).
+propBuilderAnnTable :: TableHead -> [TableBody] -> TableFoot -> Property
+propBuilderAnnTable th tbs tf = withColSpec $ \cs ->
+ convertTable (table emptyCaption cs th tbs tf)
+ === convertAnnTable (toAnnTable nullAttr emptyCaption cs th tbs tf)
+ where
+ convertTable blks = case toList blks of
+ [Table _ _ colspec a b c] -> Right (colspec, a, b, c)
+ x -> Left x
+ convertAnnTable x = case fromAnnTable x of
+ (_, _, colspec, a, b, c) -> Right (colspec, a, b, c)
+
+-- The property of toAnnTable that if the last cell in the first row
+-- of a table section has ColSpan w and ColNumber n, then w + n is the
+-- width of the table.
+propColNumber :: TableHead -> [TableBody] -> TableFoot -> Property
+propColNumber th tbs tf = withColSpec $ \cs ->
+ let twidth = length cs
+ AnnTable _ _ _ ath atbs atf =
+ toAnnTable nullAttr emptyCaption cs th tbs tf
+ in conjoin
+ $ [colNumTH twidth ath]
+ <> (colNumTB twidth <$> atbs)
+ <> [colNumTF twidth atf]
+ where
+ colNumTH n (AnnTableHead _ rs) = firstly (isHeaderValid n) rs
+ colNumTB n (AnnTableBody _ _ rs ts) =
+ firstly (isHeaderValid n) rs && firstly (isBodyValid n) ts
+ colNumTF n (AnnTableFoot _ rs) = firstly (isHeaderValid n) rs
+
+ isHeaderValid n (AnnHeaderRow _ _ x) = isSegmentValid n x
+ isBodyValid n (AnnBodyRow _ _ _ x) = isSegmentValid n x
+
+ firstly f (x : _) = f x
+ firstly _ [] = True
+ lastly f [x ] = f x
+ lastly f (_ : xs) = lastly f xs
+ lastly _ [] = True
+
+ isSegmentValid twidth cs = flip lastly cs
+ $ \(AnnCell _ (ColNumber n) (Cell _ _ _ (ColSpan w) _)) -> n + w == twidth
+
+-- The property of an AnnTable from toAnnTable that if the NonEmpty
+-- ColSpec data of the cells in the first row of a table section are
+-- concatenated, the result should equal the [ColSpec] of the entire
+-- table.
+propFirstRowCols :: TableHead -> [TableBody] -> TableFoot -> Property
+propFirstRowCols th tbs tf = withColSpec $ \cs ->
+ let AnnTable _ _ _ ath atbs atf =
+ toAnnTable nullAttr emptyCaption cs th tbs tf
+ in conjoin
+ $ [firstRowTH cs ath]
+ <> (firstRowTB cs <$> atbs)
+ <> [firstRowTF cs atf]
+ where
+ firstly f (x : _) = f x
+ firstly _ [] = True
+
+ firstHeaderValid cs = firstly $ \r -> cs == catHeaderSpec r
+ firstBodyValid cs = firstly $ \r -> cs == catBodySpec r
+
+ firstRowTH cs (AnnTableHead _ rs) = firstHeaderValid cs rs
+ firstRowTB cs (AnnTableBody _ _ rs ts) =
+ firstHeaderValid cs rs && firstBodyValid cs ts
+ firstRowTF cs (AnnTableFoot _ rs) = firstHeaderValid cs rs
+
+-- The property that in any row in an AnnTable from toAnnTable, the
+-- NonEmpty ColSpec annotations on cells, when concatenated, form a
+-- subset (really sublist) of the [ColSpec] of the entire table.
+propColSubsets :: TableHead -> [TableBody] -> TableFoot -> Property
+propColSubsets th tbs tf = withColSpec $ \cs ->
+ let AnnTable _ _ _ ath atbs atf =
+ toAnnTable nullAttr emptyCaption cs th tbs tf
+ in conjoin
+ $ subsetTH cs ath
+ <> concatMap (subsetTB cs) atbs
+ <> subsetTF cs atf
+ where
+ subsetTH cs (AnnTableHead _ rs) = map (subsetHeader cs) rs
+ subsetTB cs (AnnTableBody _ _ rs ts) =
+ map (subsetHeader cs) rs <> map (subsetBody cs) ts
+ subsetTF cs (AnnTableFoot _ rs) = map (subsetHeader cs) rs
+
+ subsetHeader cs r = catHeaderSpec r `isSubsetOf` cs
+ subsetBody cs r = catBodySpec r `isSubsetOf` cs
+
+-- The property that in any cell in an AnnTable from toAnnTable, the
+-- NonEmpty ColSpec annotation on a cell is equal in length to its
+-- ColSpan.
+propCellColLengths :: TableHead -> [TableBody] -> TableFoot -> Property
+propCellColLengths th tbs tf = withColSpec $ \cs ->
+ let AnnTable _ _ _ ath atbs atf =
+ toAnnTable nullAttr emptyCaption cs th tbs tf
+ in conjoin $ cellColTH ath <> concatMap cellColTB atbs <> cellColTF atf
+ where
+ cellColTH (AnnTableHead _ rs) = concatMap cellColHeader rs
+ cellColTB (AnnTableBody _ _ rs ts) =
+ concatMap cellColHeader rs <> concatMap cellColBody ts
+ cellColTF (AnnTableFoot _ rs) = concatMap cellColHeader rs
+
+ cellColHeader (AnnHeaderRow _ _ x) = fmap validLength x
+ cellColBody (AnnBodyRow _ _ x y) = fmap validLength x <> fmap validLength y
+
+ validLength (AnnCell colspec _ (Cell _ _ _ (ColSpan w) _)) =
+ length colspec == w
diff --git a/test/test-pandoc.hs b/test/test-pandoc.hs
index d0a1a6f18..50c7d5b09 100644
--- a/test/test-pandoc.hs
+++ b/test/test-pandoc.hs
@@ -44,6 +44,7 @@ import qualified Tests.Writers.Org
import qualified Tests.Writers.Plain
import qualified Tests.Writers.Powerpoint
import qualified Tests.Writers.RST
+import qualified Tests.Writers.Tables
import qualified Tests.Writers.TEI
import Tests.Helpers (findPandoc)
import Text.Pandoc.Shared (inDirectory)
@@ -72,6 +73,7 @@ tests pandocPath = testGroup "pandoc tests"
, testGroup "FB2" Tests.Writers.FB2.tests
, testGroup "PowerPoint" Tests.Writers.Powerpoint.tests
, testGroup "Ms" Tests.Writers.Ms.tests
+ , testGroup "Tables" Tests.Writers.Tables.tests
]
, testGroup "Readers"
[ testGroup "LaTeX" Tests.Readers.LaTeX.tests