~alcinnz/CatTrap

ref: b07f5dcbcf23cb75b2db2022f807d3847505a0bf CatTrap/test/Test.hs -rw-r--r-- 14.7 KiB
b07f5dcb — Adrian Cochrane Refactor to use newer Balkón APIs. 1 year, 5 months ago
                                                                                
3dce4d79 Adrian Cochrane
d5266882 Adrian Cochrane
52bc8445 Adrian Cochrane
b47a0b46 Adrian Cochrane
c06fd552 Adrian Cochrane
eae2c200 Adrian Cochrane
c06fd552 Adrian Cochrane
b47a0b46 Adrian Cochrane
3dce4d79 Adrian Cochrane
52bc8445 Adrian Cochrane
3dce4d79 Adrian Cochrane
c06fd552 Adrian Cochrane
b47a0b46 Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
62b95550 Adrian Cochrane
c06fd552 Adrian Cochrane
62b95550 Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
c06fd552 Adrian Cochrane
a5de823b Adrian Cochrane
d5266882 Adrian Cochrane
eae2c200 Adrian Cochrane
d5266882 Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
62b95550 Adrian Cochrane
b47a0b46 Adrian Cochrane
62b95550 Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
a5de823b Adrian Cochrane
b47a0b46 Adrian Cochrane
d5266882 Adrian Cochrane
b47a0b46 Adrian Cochrane
d5266882 Adrian Cochrane
52bc8445 Adrian Cochrane
3dce4d79 Adrian Cochrane
d5266882 Adrian Cochrane
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
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
{-# LANGUAGE OverloadedStrings #-}
module Main where

import Test.Hspec

import Graphics.Layout.Arithmetic
import Data.CSS.Syntax.Tokens (tokenize, Token(..))
import Stylist (PropertyParser(..))
import Data.Maybe (fromJust)

import Graphics.Layout.Box as B
import Graphics.Layout.Grid
import Graphics.Layout.Flow
import Graphics.Layout

import Graphics.Layout.Grid.CSS (parseASCIIGrid)
import qualified Data.HashMap.Lazy as HM

main :: IO ()
main = hspec spec

spec :: Spec
spec = do
    describe "canary" $ do
        it "test framework works" $ do
            True `shouldBe` True
    describe "calc()" $ do
        it "Can perform basic arithmatic" $ do
            runMath "42" `shouldBe` 42
            runMath "6 * 9" `shouldBe` 54
            runMath "6 * 9 - 42" `shouldBe` 12
            runMath "6 * (9 - 42)" `shouldBe` -198
            runMath "6 * calc(9 - 42)" `shouldBe` -198
            runMath "6 * abs(9 - 42)" `shouldBe` 198
    describe "Flow sizing" $ do
        -- Based on http://hixie.ch/tests/adhoc/css/box/block/
        it "Can overflow parent" $ do
            width (fst $ layoutFlow zeroBox {
                    size = Size 3 1
                } lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) `shouldBe` 4
            width (fst $ layoutFlow zeroBox {
                    size = Size 3 1
                } lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) `shouldBe` 4
            width (fst $ layoutFlow zeroBox {
                    size = Size 3 1
                } lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) `shouldBe` 4
        it "Fits to parent" $ do
            width (fst $ layoutFlow zeroBox {
                    size = Size 5 1
                } lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) `shouldBe` 5
            width (fst $ layoutFlow zeroBox {
                    size = Size 5 1
                } lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) `shouldBe` 5
            width (fst $ layoutFlow zeroBox {
                    size = Size 5 1
                } lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) `shouldBe` 5
        it "Fits children" $ do
            let child = mapX' (lowerLength 100) $ lengthBox {
                size = Size (Pixels 10) (Pixels 10)
              }
            height (fst $ layoutFlow zeroBox {
                size = Size 100 100
              } lengthBox [child, child]) `shouldBe` 20
        it "Collapses margins" $ do
            let a :: PaddedBox Length Double
                a = PaddedBox {
                    B.min = Size 0 Auto,
                    size = Size 0 Auto,
                    B.nat = Size 0 0,
                    B.max = Size 0 Auto,
                    padding = Border (Pixels 0) (Pixels 0) 0 0,
                    border = Border (Pixels 0) (Pixels 0) 0 0,
                    margin = Border (Pixels 5) (Pixels 10) 0 0
                  }
                b :: PaddedBox Length Double
                b = PaddedBox {
                    B.min = Size 0 Auto,
                    size = Size 0 Auto,
                    B.nat = Size 0 0,
                    B.max = Size 0 Auto,
                    padding = Border (Pixels 0) (Pixels 0) 0 0,
                    border = Border (Pixels 0) (Pixels 0) 0 0,
                    margin = Border (Pixels 10) (Pixels 5) 0 0
                  }
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [a, a]) `shouldBe` 25
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [b, b]) `shouldBe` 25
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [a, b]) `shouldBe` 20
            height (fst $ layoutFlow zeroBox {
                    size = Size 100 100
                } lengthBox [b, a]) `shouldBe` 25
    {-describe "Grid" $ do
        it "computes single-columns widths/heights" $ do
            let (pxGrid, pxCells) = gridLayout zeroBox {
                    size = Size 100 100
                  } (buildGrid [Left $ Pixels 10] [Left $ Pixels 10])
                    [GridItem 0 1 0 1 (Size Start Start) zeroBox] True
            containerSize pxGrid `shouldBe` Size 10 10
            fst (head pxCells) `shouldBe` Size 0 0
            let (pcGrid, pcCells) = gridLayout zeroBox {
                    size = Size 100 100
                  } (buildGrid [Left $ Percent 0.5] [Left $ Percent 0.5])
                    [GridItem 0 1 0 1 (Size Start Start) zeroBox] True
            containerSize pcGrid `shouldBe` Size 50 50
            fst (head pcCells) `shouldBe` Size 0 0
            let (autoGrid, autoCells) = gridLayout zeroBox {
                    size = Size 100 100
                  } (buildGrid [Left Auto] [Left Auto])
                    [GridItem 0 1 0 1 (Size Start Start) zeroBox {
                        B.min = Size 10 10,
                        size = Size 20 20
                    }] True
            containerSize autoGrid `shouldBe` Size 20 20
            fst (head autoCells) `shouldBe` Size 0 0
            let (prefGrid, prefCells) = gridLayout zeroBox {
                    size = Size 100 100
                  } (buildGrid [Left Preferred] [Left Preferred])
                    [GridItem 0 1 0 1 (Size Start Start) zeroBox {
                        B.min = Size 10 10,
                        size = Size 15 15
                    }] True
            containerSize prefGrid `shouldBe` Size 15 15
            fst (head prefCells) `shouldBe` Size 0 0
            let (minGrid, minCells) = gridLayout zeroBox {
                    size = Size 100 100
                  } (buildGrid [Left Min] [Left Min])
                    [GridItem 0 1 0 1 (Size Start Start) zeroBox {
                        B.min = Size 10 10,
                        size = Size 15 15
                    }] True
            containerSize minGrid `shouldBe` Size 10 10
            fst (head minCells) `shouldBe` Size 0 0-}
    describe "Abstract layout" $ do
        it "Can overflow parent" $ do
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    border = Border (Pixels 2) (Pixels 2) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    padding = Border (Pixels 2) (Pixels 2) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 3 1
                } (LayoutFlow () lengthBox {
                    margin = Border (Pixels 2) (Pixels 2) (Pixels 2) (Pixels 2)
                } []) False) `shouldBe` 4
        it "Fits to parent" $ do
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 5 1
                } (LayoutFlow () lengthBox {
                    border = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) False) `shouldBe` 5
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 5 1
                } (LayoutFlow () lengthBox {
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) False) `shouldBe` 5
            width (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 5 1
                } (LayoutFlow () lengthBox {
                    margin = Border (Pixels 0) (Pixels 0) (Pixels 2) (Pixels 2),
                    size = Size Auto $ Pixels 1
                } []) False) `shouldBe` 5
        it "Fits children" $ do
            let child = LayoutFlow () lengthBox {
                size = Size (Pixels 10) (Pixels 10),
                B.max = Size (Pixels 10) (Pixels 10)
              } []
            height (layoutGetBox $ head $ boxLayout zeroBox {
                size = Size 100 100
              } child False) `shouldBe` 10
            height (layoutGetBox $ head $ boxLayout zeroBox {
                size = Size 100 100
              } (LayoutFlow () lengthBox [child, child]) False) `shouldBe` 20
        it "Collapses margins" $ do
            let a :: LayoutItem Length Length ()
                a = LayoutFlow () PaddedBox {
                    B.min = Size Auto Auto,
                    size = Size Auto Auto,
                    B.nat = Size 0 0,
                    B.max = Size Auto Auto,
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 0) (Pixels 0),
                    border = Border (Pixels 0) (Pixels 0) (Pixels 0) (Pixels 0),
                    margin = Border (Pixels 5) (Pixels 10) (Pixels 0) (Pixels 0)
                  } []
                b :: LayoutItem Length Length ()
                b = LayoutFlow () PaddedBox {
                    B.min = Size Auto Auto,
                    size = Size Auto Auto,
                    B.nat = Size 0 0,
                    B.max = Size Auto Auto,
                    padding = Border (Pixels 0) (Pixels 0) (Pixels 0) (Pixels 0),
                    border = Border (Pixels 0) (Pixels 0) (Pixels 0) (Pixels 0),
                    margin = Border (Pixels 10) (Pixels 5) (Pixels 0) (Pixels 0)
                  } []
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [a, a]) False) `shouldBe` 25
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [b, b]) False) `shouldBe` 25
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [a, b]) False) `shouldBe` 20
            height (layoutGetBox $ head $ boxLayout zeroBox {
                    size = Size 100 100
                } (LayoutFlow () lengthBox [b, a]) False) `shouldBe` 25

        {-it "computes single-columns widths/heights" $ do
            let zeroCell = LayoutFlow () lengthBox []
            let nonzeroCell = LayoutFlow () lengthBox {
                B.min = Size (Pixels 10) (Pixels 10),
                size = Size (Pixels 20) (Pixels 20)
              } []

            let LayoutGrid (_, _) pxGrid pxCells = boxLayout zeroBox {
                    size = Size 100 100
                  } (LayoutGrid () (buildGrid [Left $ Pixels 10] [Left $ Pixels 10])
                    [(GridItem 0 1 0 1 (Size Start Start) lengthBox, zeroCell)]) True
            let LayoutFlow (pos, _) _ _ = snd $ head pxCells
            containerSize pxGrid `shouldBe` Size 10 10
            pos `shouldBe` (0, 0)
            let LayoutGrid (_, _) pxGrid pxCells = boxLayout zeroBox {
                    size = Size 100 100
                  } (LayoutGrid () (buildGrid [Left $ Percent 0.5] [Left $ Percent 0.5])
                    [(GridItem 0 1 0 1 (Size Start Start) lengthBox, zeroCell)]) True
            let LayoutFlow (pos, _) _ _ = snd $ head pxCells
            containerSize pxGrid `shouldBe` Size 50 50
            pos `shouldBe` (0, 0)
            let LayoutGrid (_, _) pxGrid pxCells = boxLayout zeroBox {
                    size = Size 100 100
                  } (LayoutGrid () (buildGrid [Left Auto] [Left Auto])
                    [(GridItem 0 1 0 1 (Size Start Start) lengthBox, nonzeroCell)]) True
            let LayoutFlow (pos, _) _ _ = snd $ head pxCells
            containerSize pxGrid `shouldBe` Size 20 10 -- FIXME Is the 10 correct?
            pos `shouldBe` (0, 0)
            let LayoutGrid (_, _) pxGrid pxCells = boxLayout zeroBox {
                    size = Size 100 100
                  } (LayoutGrid () (buildGrid [Left Preferred] [Left Preferred])
                    [(GridItem 0 1 0 1 (Size Start Start) lengthBox, nonzeroCell)]) True
            let LayoutFlow (pos, _) _ _ = snd $ head pxCells
            containerSize pxGrid `shouldBe` Size 20 0 -- FIXME Is the 0 correct?
            pos `shouldBe` (0, 0)
            let LayoutGrid (_, _) pxGrid pxCells = boxLayout zeroBox {
                    size = Size 100 100
                  } (LayoutGrid () (buildGrid [Left Min] [Left Min])
                    [(GridItem 0 1 0 1 (Size Start Start) lengthBox, nonzeroCell)]) True
            let LayoutFlow (pos, _) _ _ = snd $ head pxCells
            containerSize pxGrid `shouldBe` Size 10 10
            pos `shouldBe` (0, 0) -}
    describe "Grid templates" $ do
        it "parses successfully" $ do
            let grid = fromJust $ parseASCIIGrid [["head", "head"],
                                                  ["nav", "main"],
                                                  ["foot", "."]] 0 HM.empty
            HM.lookup "head" grid `shouldBe` Just ((0,2), (0, Just 1))
            HM.lookup "nav" grid `shouldBe` Just ((0,1), (1, Just 2))
            HM.lookup "main" grid `shouldBe` Just ((1,2), (1, Just 2))
            HM.lookup "foot" grid `shouldBe` Just ((0,1), (2, Nothing))
            HM.lookup "aside" grid `shouldBe` Nothing
        it "discards invalid non-squares" $ do
            let test grid = parseASCIIGrid grid 0 HM.empty `shouldBe` Nothing
            test [["head", "nav", "head"]]
            test [["head"], ["nav"], ["head"]]
            test [["head", "head"], ["head", "nav"]]

runMath = flip evalCalc [] . mapCalc fst . flip parseCalc [] . filter (/= Whitespace) . tokenize

instance PropertyParser () where
    temp = ()
    inherit _ = ()
    longhand _ _ _ _ = Nothing