~alcinnz/haskell-stylist

0b37dedff7149662870aba77fb424bf16aa1602d — Adrian Cochrane 1 year, 7 months ago a73ae44
Tweak priority to be a list for the sake of cascadeLayers.
M src/Data/CSS/Style.hs => src/Data/CSS/Style.hs +4 -3
@@ 38,15 38,16 @@ data QueryableStyleSheet' store parser = QueryableStyleSheet' {
    -- | The "PropertyParser" to use for property syntax validation.
    parser :: parser,
    -- | Whether author, useragent, or user styles are currently being parsed.
    priority :: Int -- author vs user agent vs user styles
    -- The tail of this list indicates which Cascade layer is active.
    priority :: [Int] -- author vs user agent vs user styles
}

-- | Constructs an empty QueryableStyleSheet'.
queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = 0}
queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = [0]}

instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where
    setPriority v self = self {priority = v}
    setPriority v self = self {priority = [v]}
    addRule self@(QueryableStyleSheet' store' _ priority') rule = self {
            store = addStyleRule store' priority' $ styleRule' rule
        }

M src/Data/CSS/Style/Common.hs => src/Data/CSS/Style/Common.hs +3 -3
@@ 15,20 15,20 @@ import Stylist (Element(..), Attribute(..))

class RuleStore a where
    new :: a
    addStyleRule :: a -> Int -> StyleRule' -> a
    addStyleRule :: a -> [Int] -> StyleRule' -> a
    lookupRules :: a -> Element -> [StyleRule']

type SelectorFunc = Element -> Bool
data StyleRule' = StyleRule' {
    inner :: StyleRule,
    compiledSelector :: SelectorFunc,
    rank :: (Int, (Int, Int, Int), Int) -- This reads ugly, but oh well.
    rank :: ([Int], (Int, Int, Int), Int) -- This reads ugly, but oh well.
}
styleRule' :: StyleRule -> StyleRule'
styleRule' rule = StyleRule' {
    inner = rule,
    compiledSelector = \_ -> True,
    rank = (0, (0, 0, 0), 0)
    rank = ([0], (0, 0, 0), 0)
}

instance Eq StyleRule' where

M src/Data/CSS/Style/Importance.hs => src/Data/CSS/Style/Importance.hs +1 -1
@@ 26,7 26,7 @@ instance RuleStore inner => RuleStore (ImportanceSplitter inner) where
    new = ImportanceSplitter new
    addStyleRule (ImportanceSplitter self) priority rule =
            ImportanceSplitter $ addStyleRule (
                addStyleRule self (negate priority) $ buildRule unimportant
                addStyleRule self (map negate priority) $ buildRule unimportant
            ) priority $ buildRule important
        where
            (unimportant, important) = splitProperties props

M stylist.cabal => stylist.cabal +0 -1
@@ 91,4 91,3 @@ test-suite test-stylist
                        network-uri >= 2.6 && <2.7, async >= 2.1 && <2.3,
                        regex-tdfa >= 1.3, hspec, QuickCheck,
                        scientific >= 0.3 && <1.0, regex-tdfa >= 1.3, stylist-traits >= 0.1 && < 0.2
  ghc-options: -Wall

M test/Test.hs => test/Test.hs +8 -8
@@ 98,7 98,7 @@ spec = do
                ]
    describe "Style Index" $ do
        it "Retrieves appropriate styles" $ do
            let index = addStyleRule styleIndex 0 $ styleRule' sampleRule
            let index = addStyleRule styleIndex [0] $ styleRule' sampleRule
            let element = ElementNode {
                name = "a",
                namespace = "",


@@ 121,17 121,17 @@ spec = do
            rulesForElement index element2 `shouldBe` []

            let rule1 = StyleRule (Element [Class "external"]) [("color", [Ident "green"])] ""
            let index1 = addStyleRule styleIndex 0 $ styleRule' rule1
            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
            let index2 = addStyleRule styleIndex [0] $ styleRule' rule2
            rulesForElement index2 element `shouldBe` [rule2]
            rulesForElement index2 element2 `shouldBe` []

            let rule3 = StyleRule (Element [Property Nothing "href" $ Prefix "https://"]) [("color", [Ident "green"])] ""
            let index3 = addStyleRule styleIndex 0 $ styleRule' rule3
            let index3 = addStyleRule styleIndex [0] $ styleRule' rule3
            rulesForElement index3 element `shouldBe` [rule3]
            rulesForElement index3 element2 `shouldBe` []
    describe "Selector Compiler" $ do


@@ 274,8 274,8 @@ spec = do
                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 (VarParser TrivialPropertyParser)
            let rules = parse (queryable {priority = [1]}) "a {color: green}"
            let rules2 = parse (rules {priority = [2]}) "a {color: red}" :: QueryableStyleSheet (VarParser TrivialPropertyParser)
            let VarParser _ (TrivialPropertyParser style) = cascade rules2 el [] temp::(VarParser TrivialPropertyParser)
            style ! "color" `shouldBe` [Ident "green"]



@@ 286,8 286,8 @@ spec = do
                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 (VarParser TrivialPropertyParser)
            let rules' = parse (queryable {priority = [1]}) "a {color: red}"
            let rules2' = parse (rules' {priority = [2]}) "a {color: green !important}" :: QueryableStyleSheet (VarParser TrivialPropertyParser)
            let VarParser _ (TrivialPropertyParser style') = cascade rules2' el' [] temp::(VarParser TrivialPropertyParser)
            style' ! "color" `shouldBe` [Ident "green"]
        it "respects overrides" $ do