aboutsummaryrefslogtreecommitdiff
path: root/test/Tests/Writers/AnnotatedTable.hs
blob: 53cca80a697619c5af9c5f09233e385dd1791870 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Tests.Writers.AnnotatedTable
   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.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