{-# 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