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
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
module HTMLRenderTests where
import Control.Monad ( unless )
import qualified Data.List as L
import Data.Text ( Text )
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import Lens.Micro ( (^.), (.~), (%~), (&) )
import Test.Tasty
import Test.Tasty.HUnit
import Text.HTML.Parser ( parseTokens, renderToken
, canonicalizeTokens
, Token( TagOpen, TagSelfClose ) )
import SampleTables
import TestQQDefs
import qualified Data.KVITable as KVI
import qualified Data.KVITable.Render as KTR
import qualified Data.KVITable.Render.HTML as KTRH
cmpTables :: Text -> Text -> Text -> IO ()
cmpTables nm actual expected = do
let expH = normalize $ parseTokens $ T.concat $ fmap T.strip $ T.lines expected
actH = normalize $ parseTokens actual
normalize = fmap sortAttrs . canonicalizeTokens
sortAttrs (TagOpen n a) = TagOpen n $ L.sort a
sortAttrs (TagSelfClose n a) = TagSelfClose n $ L.sort a
sortAttrs t = t
unless (expH == actH) $ do
let dl (e,a) = if e == a then db e else de " ↱" e <> "\n " <> da " ↳" a
db b = "| > " <> b
de m e = "|" <> m <> "expect> " <> e
da m a = "|" <> m <> "actual> " <> a
el = fmap (TL.toStrict . renderToken) expH
al = fmap (TL.toStrict . renderToken) actH
addnum n l = let nt = T.pack (show n)
nl = T.length nt
in T.take (4 - nl) " " <> nt <> l
let details = ("MISMATCH between " <>
T.pack (show $ length el) <> " expected and " <>
T.pack (show $ length al) <> " actual for " <> nm) :
(fmap (uncurry addnum) $
zip [1..] $ concat $
-- Highly simplistic "diff" output assumes
-- correlated lines: added or removed lines just
-- cause everything to shown as different from that
-- point forward.
[ fmap dl $ zip el al
, fmap (de "∌ ") $ drop (length al) el
, fmap (da "∹ ") $ drop (length el) al
])
assertFailure $ T.unpack $ T.unlines details
testHTMLRendering =
testGroup "HTML rendering" $
let kvi0 = mempty :: KVI.KVITable Text
cfg0 = KTR.defaultRenderConfig
cfgWBlankRows = cfg0 { KTR.hideBlankRows = False }
in
[
testCase "empty table, hide blank" $
cmpTables "empty table, hide blank"
(KTRH.render cfg0 kvi0) [sq|
****
<table class="kvitable">
<thead class="kvitable_head">
<tr class="kvitable_tr"><th class="kvitable_th">Value</th></tr>
</thead>
<tbody class="kvitable_body">
</tbody>
</table>
****
|]
, testCase "empty table, show blank" $
cmpTables "empty table, show blank"
(KTRH.render cfgWBlankRows kvi0) [sq|
****
<table class="kvitable">
<thead class="kvitable_head">
<tr class="kvitable_tr"><th class="kvitable_th">Value</th></tr>
</thead>
<tbody class="kvitable_body">
<tr class="kvitable_tr">
<td class="kvitable_td"></td>
</tr>
</tbody>
</table>
****
|]
, testCase "empty table with labels" $
let kvi = mempty & KVI.keyVals @Float .~ [ ("foo", []), ("dog", []) ]
in cmpTables "empty table with labels" (KTRH.render cfg0 kvi) [sq|
****
<table class="kvitable">
<thead class="kvitable_head">
<tr class="kvitable_tr">
<th class="kvitable_th">foo</th>
<th class="kvitable_th">dog</th>
<th class="kvitable_th">Value</th>
</tr>
</thead>
<tbody class="kvitable_body">
</tbody>
</table>
****
|]
, testCase "nested table hideBlank=rows,cols, fitted, colstack=hundreds" $
cmpTables "nested table hideBlank=rows,cols, fitted, colstack=hundreds"
(KTRH.render (cfg0 { KTR.sortKeyVals = True
, KTR.rowRepeat = False
, KTR.hideBlankCols = True
, KTR.hideBlankRows = True
, KTR.equisizedCols = False
, KTR.colStackAt = Just "hundreds"
}) nestedTable)
[sq_f|README.md|]
, testCase "nested table hide=none, fitted, colstack=hundreds" $
cmpTables "nested table hide=none, fitted, colstack=hundreds"
(KTRH.render (cfg0 { KTR.sortKeyVals = True
, KTR.rowRepeat = False
, KTR.hideBlankCols = False
, KTR.hideBlankRows = False
, KTR.equisizedCols = False
, KTR.colStackAt = Just "hundreds"
}) nestedTable)
[sq_f|examples/hundreds_all.md|]
, testCase "nested table hideBlank=rol,col colstack=thousands" $
cmpTables "nested table hideBlank=row,col colstack=thousands"
(KTRH.render (cfg0 { KTR.sortKeyVals = True
, KTR.rowRepeat = False
, KTR.hideBlankCols = True
, KTR.hideBlankRows = True
, KTR.equisizedCols = False
, KTR.colStackAt = Just "thousands"
}) nestedTable)
[sq2_f|README.md|]
, testCase "nested table hideBlank=rol,col" $
cmpTables "nested table hideBlank=row,col"
(KTRH.render (cfg0 { KTR.sortKeyVals = True
, KTR.rowRepeat = False
, KTR.hideBlankCols = True
, KTR.hideBlankRows = True
, KTR.equisizedCols = False
}) nestedTable)
[sq3_f|README.md|]
, testCase "big table grouped sorted" $
cmpTables "big table grouped sorted"
(KTRH.render (cfg0 { KTR.sortKeyVals = True
, KTR.rowRepeat = False
, KTR.rowGroup = [ "Location", "Biome", "Category" ]
}) zooTable2)
[sq_f|examples/zoo.md|]
, testCase "big table grouped sorted no-subtype colstack" $
let zt = KVI.fromList $
foldl rmvSubtype [] $
KVI.toList zooTable2
rmvSubtype newl (keyspec, v) =
let ks = filter (("Subtype" /=) . fst) keyspec
in case lookup ks newl of
Nothing -> (ks,v) : newl
Just v' -> (ks, v' + v) : filter ((ks /=) . fst) newl
in cmpTables "big table grouped sorted no-subtype colstack"
(KTRH.render (cfg0 { KTR.sortKeyVals = True
, KTR.rowRepeat = False
, KTR.rowGroup = [ "Location", "Biome", "Category" ]
, KTR.colStackAt = Just "Name"
, KTR.equisizedCols = False
}) zt)
[sq2_f|examples/zoo.md|]
]
|
