From 22babd5382c21d32e9d73984c5d5ff3d83ba715b Mon Sep 17 00:00:00 2001 From: Christian Despres <50160106+despresc@users.noreply.github.com> Date: Sat, 12 Sep 2020 11:50:36 -0400 Subject: [API change] Rename Writers.Tables and its contents (#6679) Writers.Tables is now Writers.AnnotatedTable. All of the types and functions in it have had the "Ann" removed from them. Now it is expected that the module be imported qualified. --- test/Tests/Writers/AnnotatedTable.hs | 254 +++++++++++++++++++++++++++++++++++ test/Tests/Writers/Tables.hs | 252 ---------------------------------- 2 files changed, 254 insertions(+), 252 deletions(-) create mode 100644 test/Tests/Writers/AnnotatedTable.hs delete mode 100644 test/Tests/Writers/Tables.hs (limited to 'test/Tests/Writers') diff --git a/test/Tests/Writers/AnnotatedTable.hs b/test/Tests/Writers/AnnotatedTable.hs new file mode 100644 index 000000000..7e16cf8e0 --- /dev/null +++ b/test/Tests/Writers/AnnotatedTable.hs @@ -0,0 +1,254 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{- | + Module : Tests.Writers.AnnotatedTable + Copyright : 2020 Christian Despres + License : GNU GPL, version 2 or above + + Maintainer : Christian Despres + Stability : alpha + Portability : portable + +Tests for the table helper functions. +-} +module Tests.Writers.AnnotatedTable + ( 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 qualified Text.Pandoc.Writers.AnnotatedTable + as Ann + +tests :: [TestTree] +tests = [testGroup "toTable" $ testAnnTable <> annTableProps] + +getSpec :: Ann.Cell -> [ColSpec] +getSpec (Ann.Cell colspec _ _) = F.toList colspec + +catHeaderSpec :: Ann.HeaderRow -> [ColSpec] +catHeaderSpec (Ann.HeaderRow _ _ x) = concatMap getSpec x + +catBodySpec :: Ann.BodyRow -> [ColSpec] +catBodySpec (Ann.BodyRow _ _ 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 = Ann.toTable nullAttr + emptyCaption + spec + (th initialHeads) + [initialTB1, initialTB2] + (tf initialHeads) + + acl al n a h w = + Ann.Cell (NonEmpty.fromList al) n $ Cell (a, [], []) AlignDefault h w [] + emptyAnnCell al n = acl al n "" 1 1 + ahrw = Ann.HeaderRow nullAttr + abrw = Ann.BodyRow nullAttr + ath = Ann.TableHead nullAttr + atb = Ann.TableBody nullAttr + atf = Ann.TableFoot 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 = + Ann.Table 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 Ann.toTable will normalize a table identically to +-- the table builder. This should mean that Ann.toTable 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 (Ann.toTable 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 Ann.fromTable x of + (_, _, colspec, a, b, c) -> Right (colspec, a, b, c) + +-- The property of Ann.toTable 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 + Ann.Table _ _ _ ath atbs atf = + Ann.toTable nullAttr emptyCaption cs th tbs tf + in conjoin + $ [colNumTH twidth ath] + <> (colNumTB twidth <$> atbs) + <> [colNumTF twidth atf] + where + colNumTH n (Ann.TableHead _ rs) = firstly (isHeaderValid n) rs + colNumTB n (Ann.TableBody _ _ rs ts) = + firstly (isHeaderValid n) rs && firstly (isBodyValid n) ts + colNumTF n (Ann.TableFoot _ rs) = firstly (isHeaderValid n) rs + + isHeaderValid n (Ann.HeaderRow _ _ x) = isSegmentValid n x + isBodyValid n (Ann.BodyRow _ _ _ 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 + $ \(Ann.Cell _ (Ann.ColNumber n) (Cell _ _ _ (ColSpan w) _)) -> + n + w == twidth + +-- The property of an Ann.Table from Ann.toTable 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 Ann.Table _ _ _ ath atbs atf = + Ann.toTable 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 (Ann.TableHead _ rs) = firstHeaderValid cs rs + firstRowTB cs (Ann.TableBody _ _ rs ts) = + firstHeaderValid cs rs && firstBodyValid cs ts + firstRowTF cs (Ann.TableFoot _ rs) = firstHeaderValid cs rs + +-- The property that in any row in an Ann.Table from Ann.toTable, 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 Ann.Table _ _ _ ath atbs atf = + Ann.toTable nullAttr emptyCaption cs th tbs tf + in conjoin + $ subsetTH cs ath + <> concatMap (subsetTB cs) atbs + <> subsetTF cs atf + where + subsetTH cs (Ann.TableHead _ rs) = map (subsetHeader cs) rs + subsetTB cs (Ann.TableBody _ _ rs ts) = + map (subsetHeader cs) rs <> map (subsetBody cs) ts + subsetTF cs (Ann.TableFoot _ 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 Ann.Table from Ann.toTable, 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 Ann.Table _ _ _ ath atbs atf = + Ann.toTable nullAttr emptyCaption cs th tbs tf + in conjoin $ cellColTH ath <> concatMap cellColTB atbs <> cellColTF atf + where + cellColTH (Ann.TableHead _ rs) = concatMap cellColHeader rs + cellColTB (Ann.TableBody _ _ rs ts) = + concatMap cellColHeader rs <> concatMap cellColBody ts + cellColTF (Ann.TableFoot _ rs) = concatMap cellColHeader rs + + cellColHeader (Ann.HeaderRow _ _ x) = fmap validLength x + cellColBody (Ann.BodyRow _ _ x y) = fmap validLength x <> fmap validLength y + + validLength (Ann.Cell colspec _ (Cell _ _ _ (ColSpan w) _)) = + length colspec == w diff --git a/test/Tests/Writers/Tables.hs b/test/Tests/Writers/Tables.hs deleted file mode 100644 index 6dab8f972..000000000 --- a/test/Tests/Writers/Tables.hs +++ /dev/null @@ -1,252 +0,0 @@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} -{- | - Module : Tests.Writers.Tables - Copyright : 2020 Christian Despres - License : GNU GPL, version 2 or above - - Maintainer : Christian Despres - 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 -- cgit v1.2.3