cattrap-0.1.0.0: test/Test.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Test.Hspec

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

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

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) -}

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

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