{-# LANGUAGE OverloadedStrings #-}
module Main where
import Test.Hspec
import Data.HashMap.Strict
import Data.CSS.Syntax.Tokens
import Data.CSS.Syntax.StyleSheet
import Data.CSS.Syntax.Selector
import Data.CSS.Style.Common
import Data.CSS.Style.Selector.Index
import Data.CSS.Style.Selector.Interpret
import Data.CSS.Style
main :: IO ()
main = hspec spec
spec :: Spec
spec = do
describe "Canary" $ do
it "Test framework works" $ do
True `shouldBe` True
describe "Parsing" $ do
it "Ignores @rules" $ do
parse emptyStyle "@encoding 'utf-8';" `shouldBe` emptyStyle
parse emptyStyle " @encoding 'utf-8';" `shouldBe` emptyStyle
parse emptyStyle "@encoding 'utf-8'; " `shouldBe` emptyStyle
parse emptyStyle "@media print { a:link {color: green;} }" `shouldBe` emptyStyle
parse emptyStyle " @media print { a:link {color: green;} }" `shouldBe` emptyStyle
parse emptyStyle "@media print { a:link {color: green;} } " `shouldBe` emptyStyle
parse emptyStyle "@encoding 'utf-8'; a {color:green}" `shouldBe` linkStyle
parse emptyStyle "a {color:green}@encoding 'utf-8';" `shouldBe` linkStyle
parse emptyStyle "@media print{a{color:black;}}a {color:green}" `shouldBe` linkStyle
parse emptyStyle "a {color:green} @media print {a{color:black;}}" `shouldBe` linkStyle
it "Parses style rules" $ do
-- Syntax examples from "Head First HTML & CSS with XHTML"
parse emptyStyle "bedroom { drapes: blue; carpet: wool shag; }" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "bedroom"]) [
("drapes", [Ident "blue"]),
("carpet", [Ident "wool", Ident "shag"])
] ""]
parse emptyStyle " bathroom{tile :1in white;drapes :pink}" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "bathroom"]) [
("tile", [Dimension "1" (NVInteger 1) "in", Ident "white"]),
("drapes", [Ident "pink"])
] ""]
it "Parses selectors" $ do
parse emptyStyle ".class {}" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Class "class"]) [] ""
]
parse emptyStyle "*.class {}" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Class "class"]) [] ""
]
parse emptyStyle "#id {}" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Id "id"]) [] ""
]
parse emptyStyle "[attr] {}" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Property "attr" Exists]) [] ""
]
parse emptyStyle "a , b {}" `shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "b"]) [] "",
StyleRule (Element [Tag "a"]) [] ""
]
parse emptyStyle "a b {}" `shouldBe` TrivialStyleSheet [
StyleRule (Descendant (Element [Tag "a"]) [Tag "b"]) [] ""
]
parse emptyStyle "a > b {}" `shouldBe` TrivialStyleSheet [
StyleRule (Child (Element [Tag "a"]) [Tag "b"]) [] ""
]
parse emptyStyle "a ~ b {}" `shouldBe` TrivialStyleSheet [
StyleRule (Sibling (Element [Tag "a"]) [Tag "b"]) [] ""
]
parse emptyStyle "a + b {}" `shouldBe` TrivialStyleSheet [
StyleRule (Adjacent (Element [Tag "a"]) [Tag "b"]) [] ""
]
parse emptyStyle "a::before {}"
`shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "a"]) [] "before"
]
parse emptyStyle "a:before {}"
`shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "a", Psuedoclass "before" []]) [] ""
]
describe "Style Index" $ do
it "Retrieves appropriate styles" $ do
let index = addStyleRule styleIndex 0 $ styleRule' sampleRule
let element = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [
Attribute "class" "external",
Attribute "href" "https://adrian.geek.nz/",
Attribute "id" "mysite"
]
}
let element2 = ElementNode {
name = "b",
parent = Just element,
previous = Just element, -- Invalid tree, oh well.
attributes = []
}
rulesForElement index element `shouldBe` [sampleRule]
rulesForElement index element2 `shouldBe` []
let rule1 = StyleRule (Element [Class "external"]) [("color", [Ident "green"])] ""
let index1 = addStyleRule styleIndex 0 $ styleRule' rule1
rulesForElement index1 element `shouldBe` [rule1]
rulesForElement index1 element2 `shouldBe` []
let rule2 = StyleRule (Element [Id "mysite"]) [("color", [Ident "green"])] ""
let index2 = addStyleRule styleIndex 0 $ styleRule' rule2
rulesForElement index2 element `shouldBe` [rule2]
rulesForElement index2 element2 `shouldBe` []
let rule3 = StyleRule (Element [Property "href" $ Prefix "https://"]) [("color", [Ident "green"])] ""
let index3 = addStyleRule styleIndex 0 $ styleRule' rule3
rulesForElement index3 element `shouldBe` [rule3]
rulesForElement index3 element2 `shouldBe` []
describe "Selector Compiler" $ do
it "Correctly evaluates selectors" $ do
let parentEl = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [
Attribute "class" "external secure link",
Attribute "href" "https://adrian.geek.nz/index.html",
Attribute "id" "mysite",
Attribute "lang" "en-US"
]
}
let sibling = ElementNode {
name = "img",
parent = Just parentEl,
previous = Nothing,
attributes = []
}
let child = ElementNode {
name = "b",
parent = Just parentEl,
previous = Just sibling,
attributes = []
}
let selector1 = compile (Element [Tag "a"])
selector1 parentEl `shouldBe` True
selector1 sibling `shouldBe` False
selector1 child `shouldBe` False
let selector2 = compile (Element [Class "external"])
selector2 parentEl `shouldBe` True
selector2 sibling `shouldBe` False
selector2 child `shouldBe` False
let selector3 = compile (Element [Id "mysite"])
selector3 parentEl `shouldBe` True
selector3 sibling `shouldBe` False
selector3 child `shouldBe` False
let selector4 = compile (Element [Property "lang" Exists])
selector4 parentEl `shouldBe` True
selector4 sibling `shouldBe` False
selector4 child `shouldBe` False
let selector5 = compile (Element [Property "class" $ Include "secure"])
selector5 parentEl `shouldBe` True
selector5 sibling `shouldBe` False
selector5 child `shouldBe` False
let selector6 = compile (Element [Property "href" $ Prefix "https://"])
selector6 parentEl `shouldBe` True
selector6 sibling `shouldBe` False
selector6 child `shouldBe` False
let selector7 = compile (Element [Property "href" $ Suffix ".html"])
selector7 parentEl `shouldBe` True
selector7 sibling `shouldBe` False
selector7 child `shouldBe` False
let selector8 = compile (Element [Property "href" $ Substring ".geek.nz"])
selector8 parentEl `shouldBe` True
selector8 sibling `shouldBe` False
selector8 child `shouldBe` False
let selector9 = compile (Element [Property "lang" $ Dash "en"])
selector9 parentEl `shouldBe` True
selector9 sibling `shouldBe` False
selector9 child `shouldBe` False
let selectorA = compile (Element [Property "lang" $ Dash "en-US"])
selectorA parentEl `shouldBe` True
selectorA sibling `shouldBe` False
selectorA child `shouldBe` False
let selectorB = compile (Element [Property "lang" $ Dash "en-UK"])
selectorB parentEl `shouldBe` False
selectorB sibling `shouldBe` False
selectorB child `shouldBe` False
-- TODO These could be tested better.
let selectorC = compile $ Child (Element [Tag "a"]) [Tag "b"]
selectorC parentEl `shouldBe` False
selectorC sibling `shouldBe` False
selectorC child `shouldBe` True
let selectorD = compile $ Descendant (Element [Tag "a"]) [Tag "b"]
selectorD parentEl `shouldBe` False
selectorD sibling `shouldBe` False
selectorD child `shouldBe` True
let selectorE = compile $ Sibling (Element [Tag "img"]) [Tag "b"]
selectorE parentEl `shouldBe` False
selectorE sibling `shouldBe` False
selectorE child `shouldBe` True
let selectorF = compile $ Adjacent (Element [Tag "img"]) [Tag "b"]
selectorF parentEl `shouldBe` False
selectorF sibling `shouldBe` False
selectorF child `shouldBe` True
describe "Style resolution" $ do
it "respects selector specificity" $ do
let el = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [Attribute "class" "link"]
}
let rules = parse queryable "a.link {color: green} a {color: red}"
let TrivialPropertyParser style = cascade rules el [] temp::TrivialPropertyParser
style ! "color" `shouldBe` [Ident "green"]
it "respects syntax order" $ do
let el = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [Attribute "class" "link"]
}
let rules = parse queryable "a {color: red; color: green}"
let TrivialPropertyParser style = cascade rules el [] temp::TrivialPropertyParser
style ! "color" `shouldBe` [Ident "green"]
let rules2 = parse queryable "a {color: red} a {color: green}"
let TrivialPropertyParser style2 = cascade rules2 el [] temp::TrivialPropertyParser
style2 ! "color" `shouldBe` [Ident "green"]
it "respects stylesheet precedence" $ do
let el = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [Attribute "class" "link"]
}
let rules = parse (queryable {priority = 1}) "a {color: green}"
let rules2 = parse (rules {priority = 2}) "a {color: red}" :: QueryableStyleSheet TrivialPropertyParser
let TrivialPropertyParser style = cascade rules2 el [] temp::TrivialPropertyParser
style ! "color" `shouldBe` [Ident "green"]
let el' = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [Attribute "class" "link"]
}
let rules' = parse (queryable {priority = 1}) "a {color: red}"
let rules2' = parse (rules' {priority = 2}) "a {color: green !important}" :: QueryableStyleSheet TrivialPropertyParser
let TrivialPropertyParser style' = cascade rules2' el' [] temp::TrivialPropertyParser
style' ! "color" `shouldBe` [Ident "green"]
it "respects overrides" $ do
let el = ElementNode {
name = "a",
parent = Nothing,
previous = Nothing,
attributes = [Attribute "class" "link"]
}
let rules = parse queryable "a {color: red;}"
let TrivialPropertyParser style = cascade rules el [("color", [Ident "green"])] temp::TrivialPropertyParser
style ! "color" `shouldBe` [Ident "green"]
describe "Parser freezes" $ do
it "does not regress" $ do
parse emptyStyle "output: {content: 'Output'; pitch: high}"
`shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "output"]) [] ""
] -- Turned out to just be incorrect parsing
parse emptyStyle "input, output {content: attr(value)}"
`shouldBe` TrivialStyleSheet [
StyleRule (Element [Tag "output"]) [
("content", [Function "attr", Ident "value", RightParen])
] "",
StyleRule (Element [Tag "input"]) [
("content", [Function "attr", Ident "value", RightParen])
] ""
]
it "paren balancing" $ do
scanValue [RightParen] `shouldBe` ([], [RightParen])
scanValue [LeftParen] `shouldBe` ([LeftParen], [])
scanValue [Function "fn", LeftParen] `shouldBe` ([Function "fn", LeftParen], [])
scanValue [Function "fn", Ident "arg", LeftParen] `shouldBe`
([Function "fn", Ident "arg", LeftParen], [])
styleIndex :: StyleIndex
styleIndex = new
queryable :: QueryableStyleSheet TrivialPropertyParser
queryable = queryableStyleSheet
emptyStyle :: TrivialStyleSheet
emptyStyle = TrivialStyleSheet []
linkStyle :: TrivialStyleSheet
linkStyle = TrivialStyleSheet [sampleRule]
sampleRule :: StyleRule
sampleRule = StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""