packages feed

stylist 2.4.0.2 → 2.5.0.0

raw patch · 17 files changed

+256/−441 lines, 17 filesdep +stylist-traits

Dependencies added: stylist-traits

Files

README.md view
@@ -1,7 +1,7 @@ # Haskell Stylist Generic CSS style engine for Haskell, intended to aid the development of new browser engines. -Stylish Haskell implements CSS selection and cascade (but not inheritance) independant of the CSS at-rules and properties understood by the caller. It is intended to ease the development of new browser engines, independant of their output targets.+Haskell Stylist implements CSS selection and cascade (but not inheritance) independant of the CSS at-rules and properties understood by the caller. It is intended to ease the development of new browser engines, independant of their output targets.  For more interesting projects see: https://github.io/alcinnz/browser-engine-ganarchy/
src/Data/CSS/Preprocessor/Assets.hs view
@@ -3,7 +3,7 @@ module Data.CSS.Preprocessor.Assets(StyleAssets(..), URIRewriter(..)) where  -- TODO Unit test!-import           Data.Text as Txt hiding (elem)+import           Data.Text as Txt import           Network.URI import qualified Data.CSS.Syntax.StyleSheet as CSS import qualified Data.CSS.Syntax.Tokens as CSSTok
src/Data/CSS/Preprocessor/Conditions.hs view
@@ -16,6 +16,7 @@ import Data.CSS.Syntax.Selector import Data.CSS.Syntax.Tokens(Token(..)) import Data.CSS.Style (PropertyParser(..))+import Data.CSS.Syntax.AtLayer as AtLayer  import Data.Text.Internal (Text(..)) import Data.Text (unpack)@@ -36,15 +37,22 @@     -- | Queued style rules, to be evaluated later.     rules :: [ConditionalRule p],     -- | PropertyParser to test against for `@supports` rules.-    propertyParser :: p+    propertyParser :: p,+    -- | Known-named @layers.+    layers :: AtLayer.Tree,+    -- | The current @layer, for resolving nesting+    layerNamespace :: [Text],+    -- | The integral path to the current @layer, for resolving nesting+    layerPath' :: [Int] }  -- | Constructs an empty `ConditionalStyles`. conditionalStyles :: PropertyParser p => URI -> String -> ConditionalStyles p-conditionalStyles uri mediaDocument' = ConditionalStyles uri mediaDocument' False [] temp+conditionalStyles uri mediaDocument' =+    ConditionalStyles uri mediaDocument' False [] temp AtLayer.emptyTree [] [0]  -- | Style rules that can be queued in a `ConditionalStyles`.-data ConditionalRule p = Priority Int | StyleRule' StyleRule | AtRule Text [Token] |+data ConditionalRule p = Priority [Int] | StyleRule' StyleRule | AtRule Text [Token] |     External Query.Expr URI | Internal Query.Expr (ConditionalStyles p)  addRule' :: ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p@@ -60,7 +68,7 @@ parseAtBlock self [] = (self, [])  instance PropertyParser p => StyleSheet (ConditionalStyles p) where-    setPriority x self = addRule' self $ Priority x+    setPriorities x self = addRule' self { layerPath' = x } $ Priority x     addRule self rule = addRule' self $ StyleRule' rule      addAtRule self "document" (Whitespace:toks) = addAtRule self "document" toks@@ -107,6 +115,15 @@             if evalSupports (propertyParser self) cond                 then parseAtBlock self toks' else (self, skipAtRule toks') +    addAtRule self@ConditionalStyles { layers = l, layerNamespace = ns, layerPath' = xs@(x:_) }+            "layer" toks =+        case parseAtLayer ns toks l $ \ns' path' -> setPriorities (x:path') self {+            layerNamespace = ns'+        } of+            (layers', Just self', toks') ->+                (setPriorities xs self { rules = rules self', layers = layers' }, toks')+            (layers', Nothing, toks') -> (setPriorities xs self { layers = layers' }, toks')+     addAtRule self rule tokens = let (block, rest) = scanAtRule tokens in         (addRule' self $ AtRule rule block, rest) @@ -120,11 +137,42 @@ -------- parseAtImport :: PropertyParser p => ConditionalStyles p -> Text ->         [Token] -> (ConditionalStyles p, [Token])+parseAtImport self src (Whitespace:toks) = parseAtImport self src toks+parseAtImport self src (Function "supports":toks)+    | (cond, RightParen:toks') <- break (== RightParen) toks =+        if evalSupports (propertyParser self) cond+            then parseAtImport self src toks' else (self, skipAtRule toks')+parseAtImport self@ConditionalStyles {  layerNamespace = ns } src (Function "layer":toks)+        | (layerToks, RightParen:toks') <- break (== RightParen) toks, validLayer layerToks =+            parseAtImportInLayer self src (ns ++ [name | Ident name <- layerToks]) toks'+    where+        validLayer toks' = validLayer' (Delim '.':filter (/= Whitespace) toks')+        validLayer' (Delim '.':Ident _:toks') = validLayer toks'+        validLayer' [] = True+        validLayer' _ = False+parseAtImport self@ConditionalStyles { layers = l, layerNamespace = ns } src (Ident "layer":toks) =+        parseAtImportInLayer self src (uniqueName ns l) toks parseAtImport self src toks     | (cond, Semicolon:toks') <- Query.parse Semicolon toks, Just uri <- parseURI $ unpack src =         (addRule' self $ External cond uri, toks') parseAtImport self _ toks = (self, skipAtRule toks) +parseAtImportInLayer :: PropertyParser p => ConditionalStyles p -> Text -> [Text] ->+    [Token] -> (ConditionalStyles p, [Token])+parseAtImportInLayer self@ConditionalStyles {+        layers = l, layerNamespace = ns, layerPath' = xs@(x:_)+    } src layerName toks =+        let (ret, toks') = parseAtImport self' src toks in (setPriorities xs ret, toks')+  where+    layers' = registerLayer layerName l+    self' = setPriorities (x:layerPath layerName layers') self {+        layers = layers',+        layerNamespace = ns+    }+parseAtImportInLayer self src layerName toks = parseAtImportInLayer self {+        layerPath' = [0]+    } src layerName toks -- Shouldn't happen, recover gracefully.+ -- | Returns `@import` URLs that need to be imported. extractImports :: (Text -> Query.Datum) -> (Token -> Query.Datum) -> ConditionalStyles p -> [URI] extractImports vars evalToken self =@@ -157,7 +205,7 @@ resolve v t styles self = resolve' v t (reverse $ rules self) styles resolve' :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) ->         [ConditionalRule p] -> s -> s-resolve' v t (Priority x:rules') styles = resolve' v t rules' $ setPriority x styles+resolve' v t (Priority x:rules') styles = resolve' v t rules' $ setPriorities x styles resolve' v t (StyleRule' rule:rules') styles = resolve' v t rules' $ addRule styles rule resolve' v t (AtRule name block:rules') styles = resolve' v t rules' $ fst $ addAtRule styles name block resolve' v t (Internal cond block:rules') styles | Query.eval v t cond =
src/Data/CSS/Preprocessor/PsuedoClasses.hs view
@@ -2,16 +2,18 @@ -- | Lowers psuedoclasses to rawer syntactic forms. module Data.CSS.Preprocessor.PsuedoClasses(LowerPsuedoClasses(..),     psuedoClassesFilter, htmlPsuedoFilter,-    addRewrite, addRewrite', addPsuedoEl, addNamespace, addTest, PropertyTest) where+    addRewrite, addRewrite', addTest, addContains, PropertyTest,+    addPsuedoEl, addNamespace) where  import Data.CSS.Syntax.StyleSheet import Data.CSS.Syntax.Selector import Data.CSS.Syntax.Tokens -import Data.Text as Txt hiding (elem)+import Data.Text as Txt import Data.Maybe (fromMaybe, listToMaybe) import Data.HashMap.Lazy as HM import Data.Function ((&))+import Data.List as L (intercalate)  -------- ---- core@@ -88,6 +90,16 @@     spliceArgs (tok:toks) args = tok : spliceArgs toks args     spliceArgs _ _ = [Ident "\tfail"] +addContains :: Text -> [Int] -> LowerPsuedoClasses s -> LowerPsuedoClasses s+addContains name path self =+    addRewrite' name (L.intercalate [Comma] $ buildSelector path [Colon, Ident "root"]) self+  where+    buildSelector (p:ps) prefix =+        let prefix' = prefix ++ [Delim '>', Colon, Function "nth-child", num p, RightParen]+        in prefix' : buildSelector ps prefix'+    buildSelector [] _ = []+    num x = Number (Txt.pack $ show x) $ NVInteger (toInteger x)+ addTest :: Text -> Maybe Text -> Text -> PropertyFunc -> LowerPsuedoClasses s -> LowerPsuedoClasses s addTest name ns attr test self = addTest' name (noArg [Property ns attr $ Callback test]) self     where@@ -124,4 +136,5 @@     addRewrite "readonly" "[readonly], [disabled]" &     addRewrite "read-write" ":not([readonly]):not([disabled])" &     addRewrite "required" "[required]" &-    addRewrite "scope" ":root"+    addRewrite "scope" ":root" &+    addRewrite "root" "html"
src/Data/CSS/Style.hs view
@@ -19,7 +19,9 @@ import Data.CSS.Style.Cascade (PropertyParser(..), TrivialPropertyParser, Props)  import Data.CSS.Syntax.Tokens (Token(..))-import Data.CSS.Syntax.StyleSheet (StyleSheet(..))+import Data.CSS.Syntax.StyleSheet (StyleSheet(..), skipAtRule)+import Data.CSS.Syntax.AtLayer as AtLayer+ import Data.HashMap.Strict (HashMap, lookupDefault, fromList) import Data.Text (isPrefixOf) import Data.List (elemIndex)@@ -38,24 +40,39 @@     -- | 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, incorporates Cascade Layers+    -- | Parse data for @layer, to give webdevs explicit control over the cascade.+    layers :: AtLayer.Tree,+    --- | The name of the @layer we're within.+    layerNamespace :: [Text] }  -- | Constructs an empty QueryableStyleSheet'. queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p-queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = 0}+queryableStyleSheet = QueryableStyleSheet' {+    store = new, parser = temp, layers = AtLayer.emptyTree,+    priority = [0], layerNamespace = [] }  instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where-    setPriority v self = self {priority = v}-    addRule self@(QueryableStyleSheet' store' _ priority') rule = self {+    setPriorities vs self = self { priority = vs }+    addRule self@(QueryableStyleSheet' store' _ priority' _ _) rule = self {             store = addStyleRule store' priority' $ styleRule' rule         }+    addAtRule self@QueryableStyleSheet' { layerNamespace = ns, layers = layers_, priority = v:_ }+            "layer" toks =+        case parseAtLayer ns toks layers_ $ \ns' path -> self {+            priority = v : path, layerNamespace = ns'+        } of+            (layers', Just self', toks') -> (self { store = store self', layers = layers' }, toks')+            (layers', Nothing, toks') -> (self { layers = layers' }, toks')+    addAtRule self _ toks = (self, skipAtRule toks)  --- Reexpose cascade methods -- | Looks up style rules matching the specified element, grouped by psuedoelement. queryRules :: (PropertyParser p, RuleStore s) =>     QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']-queryRules (QueryableStyleSheet' store' _ _) = Cascade.query store'+queryRules (QueryableStyleSheet' store' _ _ _ _) = Cascade.query store'  -- | Selects used property values from the given style rules, -- & populates into a new `PropertyParser` inheriting from the one given.
src/Data/CSS/Style/Cascade.hs view
@@ -8,6 +8,7 @@  import Data.CSS.Style.Common import Data.CSS.Syntax.Tokens+import Stylist (PropertyParser(..), Props)  -- TODO do performance tests to decide beside between strict/lazy, --      or is another Map implementation better?@@ -15,37 +16,12 @@ import qualified Data.HashMap.Lazy as HML import Data.Text (unpack, pack, isPrefixOf) --- | Defines how to parse CSS properties into an output "style" format.-class PropertyParser a where-    -- | Default styles.-    temp :: a-    -- | Creates a style inherited from a parent style.-    inherit :: a -> a-    inherit = id--    -- | Expand a shorthand property into longhand properties.-    shorthand :: a -> Text -> [Token] -> [(Text, [Token])]-    shorthand self key value | Just _ <- longhand self self key value = [(key, value)]-        | otherwise = []-    -- longhand parent self name value-    longhand :: a -> a -> Text -> [Token] -> Maybe a--    -- | Retrieve stored variables, optional.-    getVars :: a -> Props-    getVars _ = []-    -- | Save variable values, optional.-    setVars :: Props -> a -> a-    setVars _ = id- -- | Gather properties into a hashmap. data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token]) deriving (Show, Eq) instance PropertyParser TrivialPropertyParser where     temp = TrivialPropertyParser empty     longhand _ (TrivialPropertyParser self) key value =         Just $ TrivialPropertyParser $ insert (unpack key) value self---- | "key: value;" entries to be parsed into an output type.-type Props = [(Text, [Token])]  -------- ---- Query/Psuedo-elements
src/Data/CSS/Style/Common.hs view
@@ -11,39 +11,24 @@ import Data.CSS.Syntax.Selector import Data.CSS.Syntax.Tokens import Data.Text.Internal (Text(..))---- | An inversely-linked tree of elements, to apply CSS selectors to.-data Element = ElementNode {-    -- | The element's parent in the tree.-    parent :: Maybe Element,-    -- | The element's previous sibling in the tree.-    previous :: Maybe Element,-    -- | The element's name.-    name :: Text,-    -- | The element's namespace.-    namespace :: Text,-    -- | The element's attributes, in sorted order.-    attributes :: [Attribute]-}--- | A key-value attribute.-data Attribute = Attribute Text Text String deriving (Eq, Ord)+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
src/Data/CSS/Style/Importance.hs view
@@ -26,7 +26,7 @@     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
src/Data/CSS/Style/Selector/Interpret.hs view
@@ -7,6 +7,7 @@     ) where  import Data.CSS.Style.Common+import Stylist (compileAttrTest, matched, hasWord)  import Data.Text (unpack) import Data.List@@ -14,7 +15,7 @@ import Data.Bits (xor)  -- For pseudoclasses-import Data.CSS.Syntax.Selector (parseSelectors, PropertyFunc(..))+import Data.CSS.Syntax.Selector (parseSelectors) import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))  -- | A compiled(?) CSS selector.@@ -73,16 +74,6 @@ lowerInner (Psuedoclass _ _:_) = ([Fail], []) lowerInner [] = ([], []) -compileAttrTest :: PropertyTest -> String -> Bool-compileAttrTest Exists = matched-compileAttrTest (Equals val) = (== (unpack val))-compileAttrTest (Suffix val) = isSuffixOf $ unpack val-compileAttrTest (Prefix val) = isPrefixOf $ unpack val-compileAttrTest (Substring val) = isInfixOf $ unpack val-compileAttrTest (Include val) = hasWord $ unpack val-compileAttrTest (Dash val) = hasLang $ unpack val-compileAttrTest (Callback (PropertyFunc cb)) = cb- sortAttrs :: [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)] sortAttrs = sortBy compareAttrs where compareAttrs (x, x', _) (y, y', _) = (x, x') `compare` (y, y') @@ -106,8 +97,6 @@     | not $ test el = False     | upTest (fromJust $ traverser el) = True     | otherwise = indirect traverser upTest test $ fromJust $ traverser el-matched :: t -> Bool-matched _ = True  testAttr :: Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc testAttr expected test next attrs@(Attribute attr _ value : attrs')@@ -123,11 +112,6 @@     | (attr, ns) == (expected, expectedNS) && test value = next attrs     | otherwise = False testAttrNS _ _ _ _ [] = False--hasWord :: String -> String -> Bool-hasWord expected value = expected `elem` words value-hasLang :: [Char] -> [Char] -> Bool-hasLang expected value = expected == value || isPrefixOf (expected ++ "-") value  --- Pseudoclasses recursiveSelect :: Bool -> [SelectorFunc] -> SelectorFunc -> SelectorFunc
src/Data/CSS/Style/Selector/Specificity.hs view
@@ -40,7 +40,10 @@     new = OrderedRuleStore new 0     addStyleRule (OrderedRuleStore self count) priority rule = OrderedRuleStore (             addStyleRule self priority $ rule {-                rank = (priority, computeSpecificity (psuedoElement rule) $ selector rule, count)+                rank = (+                    priority ++ [maxBound], -- Ensure unlayered rules take precedance.+                    computeSpecificity (psuedoElement rule) $ selector rule,+                    count)             }         ) (count + 1)     lookupRules (OrderedRuleStore self _) el = sort $ lookupRules self el
src/Data/CSS/StyleTree.hs view
@@ -1,50 +1,42 @@ -- | Abstracts away tree traversals. -- Mostly used by callers including (soon) XML Conduit Stylist, -- but also used internally for generating counter text.+--+-- Backwards compatability module, this API has been moved out into "stylist-traits".+-- Though it also contains integration between the styletree & styling APIs.+{-# LANGUAGE OverloadedStrings #-} module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder',-    Path, treeMap, treeFlatten, preorder, preorder', postorder) where--data StyleTree p = StyleTree {-    style :: p,-    children :: [StyleTree p]-}--type Path = [Integer]-treeOrder :: (c -> c -> Path -> p -> (c, p')) ->-    c -> StyleTree p -> StyleTree p'-treeOrder cb ctxt tree = StyleTree-    (snd $ cb ctxt ctxt [] $ style tree)-    (snd $ treeOrder' cb ctxt ctxt [0] $ children tree)-treeOrder' :: (c -> c -> Path -> p -> (c, p')) ->-    c -> c -> Path -> [StyleTree p] -> (c, [StyleTree p'])-treeOrder' cb prevContext context (num:path) (node:nodes) = (tailContext, StyleTree node' children' : nodes')-    where-        (selfContext, node') = cb prevContext context (num:path) $ style node-        (childContext, children') = treeOrder' cb selfContext selfContext (0:num:path) $ children node-        (tailContext, nodes') = treeOrder' cb selfContext childContext (num + 1:path) nodes-treeOrder' _ _ context _ [] = (context, [])-treeOrder' _ _ _ [] _ = error "Invalid path during tree traversal!"+    Path, treeMap, treeFlatten, preorder, preorder', postorder,+    stylize, inlinePseudos) where -treeMap :: (p -> p') -> StyleTree p -> StyleTree p'-treeMap cb = treeOrder (\_ _ _ p -> ((), cb p)) ()+import Stylist.Tree -- Mainly for reexports -treeFlatten :: StyleTree p -> [p]-treeFlatten = treeFlatten' . children-treeFlatten' :: [StyleTree p] -> [p]-treeFlatten' (StyleTree p []:ps) = p : treeFlatten' ps-treeFlatten' (StyleTree _ childs:sibs) = treeFlatten' childs ++ treeFlatten' sibs-treeFlatten' [] = []+import Stylist+import Data.CSS.Style+import Data.CSS.Syntax.StyleSheet (parseProperties')+import Data.CSS.Syntax.Tokens+import Data.Text (Text, pack)+import Data.HashMap.Strict as M (toList)+import Data.Maybe (fromMaybe) -preorder :: (Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b-preorder cb self = head $ preorder' cb Nothing Nothing [self]-preorder' :: (Maybe b -> Maybe b -> a -> b) ->-        Maybe b -> Maybe b -> [StyleTree a] -> [StyleTree b]-preorder' cb parent previous (self:sibs) = let self' = cb parent previous $ style self-        in StyleTree self' (preorder' cb (Just self') Nothing $ children self) :-            preorder' cb parent (Just self') sibs-preorder' _ _ _ [] = []+stylize :: PropertyParser s => QueryableStyleSheet s -> StyleTree Element -> StyleTree [(Text, s)]+stylize = preorder . stylize'+stylize' :: PropertyParser s => QueryableStyleSheet s -> Maybe [(Text, s)] -> Maybe [(Text, s)] ->+        Element -> [(Text, s)]+stylize' stylesheet parent' _ el = ("", base) : [+        (k, cascade' v [] base) | (k, v) <- M.toList $ queryRules stylesheet el+    ] where+        base = cascade stylesheet el overrides $ fromMaybe temp $ lookup "" =<< parent'+        overrides = concat [fst $ parseProperties' $ tokenize $ pack val+            | Attribute "style" _ val <- attributes el] -postorder :: (a -> [b] -> [b]) -> StyleTree a -> [StyleTree b]-postorder cb (StyleTree self childs) =-    [StyleTree self' children' | self' <- cb self $ Prelude.map style children']-  where children' = concat $ Prelude.map (postorder cb) childs+inlinePseudos :: PropertyParser s => StyleTree [(Text, VarParser s)] -> StyleTree s+inlinePseudos (StyleTree self childs) = StyleTree {+        style = fromMaybe temp $ innerParser <$> lookup "" self,+        children = pseudo "before" ++ map inlinePseudos childs ++ pseudo "after"+    } where+        pseudo n+            | Just sty <- innerParser <$> lookup n self,+                Just style' <- longhand sty sty "::" [Ident n] = [StyleTree style' []]+            | Just sty <- innerParser <$> lookup n self = [StyleTree sty []]+            | otherwise = []
+ src/Data/CSS/Syntax/AtLayer.hs view
@@ -0,0 +1,74 @@+module Data.CSS.Syntax.AtLayer(parseAtLayer, Tree(..),+    registerLayer, layerPath, uniqueName, emptyTree) where++import Data.HashMap.Lazy as M (HashMap, (!?), insert, size, empty)+import Data.Text as T hiding (reverse, replicate, length)+import Data.CSS.Syntax.Tokens++import Stylist.Parse++parseAtLayer :: StyleSheet s => [Text] -> [Token] -> Tree ->+    ([Text] -> [Int] -> s) -> (Tree, Maybe s, [Token])+parseAtLayer namespace (Whitespace:toks) tree cb = parseAtLayer namespace toks tree cb+parseAtLayer namespace (Ident layer:toks) tree cb = inner toks [layer] tree+    where+        inner (Delim '.':Ident sublayer:toks') layers tree' =  inner toks' (sublayer:layers) tree'+        inner (Whitespace:toks') layers tree' = inner toks' layers tree'+        inner (Comma:toks') layers tree' =+            let (ret, tail') = parseLayerStmt namespace toks' $registerLayer (namespaced layers) tree'+            in (ret, Nothing, tail')+        inner (LeftCurlyBracket:toks') layers  tree' =+            let (ret, styles, tail') = parseLayerBlock (namespaced layers) toks' tree' cb+            in (ret, Just styles, tail')+        inner (Semicolon:toks') layers tree' = (registerLayer (namespaced layers) tree', Nothing, toks')+        inner [] layers tree' = (registerLayer (namespaced layers) tree', Nothing, [])+        inner toks' _ _ = (tree, Nothing, skipAtRule toks')+        namespaced layers = namespace ++ reverse layers+parseAtLayer ns (LeftCurlyBracket:toks) tree cb = +    let (ret, styles, tail') = parseLayerBlock (uniqueName ns tree) toks tree cb+    in (ret, Just styles, tail')+parseAtLayer _ toks tree _ = (tree, Nothing, skipAtRule toks)++parseLayerStmt :: [Text] -> [Token] -> Tree -> (Tree, [Token])+parseLayerStmt namespace (Whitespace:toks) tree = parseLayerStmt namespace toks tree+parseLayerStmt namespace (Ident layer:toks) tree = inner toks [layer] tree+    where+        inner (Delim '.':Ident sublayer:toks') layers tree' = inner toks' (sublayer:layers) tree'+        inner (Comma:toks') layers tree' =+            parseLayerStmt namespace toks' $ registerLayer (namespaced layers) tree'+        inner (Whitespace:toks') layers tree' = inner toks' layers tree'+        inner (Semicolon:toks') layers tree' = (registerLayer (namespaced layers) tree', toks')+        inner [] layers tree' = (registerLayer (namespaced layers) tree', [])+        inner toks' _ _ = (tree, skipAtRule toks')+        namespaced layers = namespace ++ reverse layers+parseLayerStmt _ toks tree = (tree, skipAtRule toks)++parseLayerBlock :: StyleSheet s => [Text] -> [Token] -> Tree ->+    ([Text] -> [Int] -> s) -> (Tree, s, [Token])+parseLayerBlock layers toks tree cb = (tree', parse' styles block, toks')+    where+        (block, toks') = scanBlock toks+        tree' = registerLayer layers tree+        styles = cb layers $ layerPath layers tree'++newtype Tree = Tree (HashMap Text (Int, Tree))+registerLayer :: [Text] -> Tree -> Tree+registerLayer (layer:sublayers) (Tree self)+    | Just (ix, subtree) <- self !? layer = Tree $ insert layer (ix, registerLayer sublayers subtree) self+    | otherwise = Tree $ insert layer (succ $ size self, registerLayer sublayers $ Tree M.empty) self+registerLayer [] self = self++layerPath :: [Text] -> Tree -> [Int]+layerPath (layer:sublayers) (Tree self)+    | Just (ix, subtree) <- self !? layer = ix:layerPath sublayers subtree+    | otherwise = [] -- Should have registered first...+layerPath [] _ = []++uniqueName :: [Text] -> Tree -> [Text]+uniqueName (namespace:namespaces) (Tree self) +    | Just (_, subtree) <- self !? namespace = namespace:uniqueName namespaces subtree+    | otherwise = replicate (length namespaces + 2) T.empty -- Should have registered first+uniqueName [] (Tree self) = [T.pack $ show $ size self]++emptyTree :: Tree+emptyTree = Tree M.empty
src/Data/CSS/Syntax/Selector.hs view
@@ -1,119 +1,10 @@ -- | Parses CSS selectors -- See `parseSelectors`+--+-- Backwards-compatibility module, this API has been moved out into "stylist-traits". module Data.CSS.Syntax.Selector(         Selector(..), SimpleSelector(..), PropertyTest(..), PropertyFunc(..),         parseSelectors     ) where -import Data.CSS.Syntax.Tokens-import Data.CSS.Syntax.StylishUtil--import Data.Text.Internal (Text(..))---- | A CSS "selector" indicating which elements should be effected by CSS.-data Selector = Element [SimpleSelector] -- ^ Selects a single element.-    | Child Selector [SimpleSelector] -- ^ Represents "a > b" operator.-    | Descendant Selector [SimpleSelector] -- ^ Represents "a b" operator.-    | Adjacent Selector [SimpleSelector] -- ^ Represents "a + b" operator.-    | Sibling Selector [SimpleSelector] -- ^ Represents "a ~ b" operator.-    deriving (Show, Eq)--- | An individual test comprising a CSS stylesheet.-data SimpleSelector = Tag Text -- ^ Matches a tagname, e.g. "a"-    | Namespace Text-    | Id Text -- ^ Matches the "id" attribute, e.g. "#header"-    | Class Text -- ^ Matches the "class" attribute, e.g. ".ad"-    | Property (Maybe Text) Text PropertyTest -- ^ Matches a specified property-    | Psuedoclass Text [Token] -- ^ Matches psuedoclasses provided by the caller (via a nameless property).-    deriving (Show, Eq)--- | How should a property be matched.-data PropertyTest = Exists -- ^ Matches whether an attribute actually exists, e.g. "[title]"-    | Equals Text -- ^ Matches whether the attribute is exactly equal to the value, e.g. "="-    | Suffix Text -- ^ Matches whether attribute ends with the given value, e.g. "$="-    | Prefix Text -- ^ Matches whether attribute starts with the given value, e.g. "^="-    | Substring Text -- ^ Matches whether the attribute contains the given value, e.g. "*="-    | Include Text -- ^ Is one of the whitespace-seperated values the one specified? e.g. "~="-    | Dash Text -- ^ Matches whitespace seperated values, or their "-"-seperated prefixes. e.g. "|="-    | Callback PropertyFunc -- ^ Calls the given function to test this property.-    deriving (Show, Eq)--- | Caller-specified functions to extend property selection.--- Has incorrect Show/Eq implementations so this rare exception doesn't break things.-data PropertyFunc = PropertyFunc (String -> Bool)-instance Show PropertyFunc where-    show _ = "xx"-instance Eq PropertyFunc where-    _ == _ = False---- | Parses a CSS selector.-parseSelectors :: Parser [Selector]-parseSelectors tokens = concatP (:) parseCompound parseSelectorsTail $ skipSpace tokens-parseSelectorsTail :: Parser [Selector]-parseSelectorsTail (Comma:tokens) = parseSelectors tokens-parseSelectorsTail tokens = ([], tokens)-parseCompound :: Parser Selector-parseCompound tokens = parseCombinators (Element selector) tokens'-    where (selector, tokens') = parseSelector tokens--parseSelector' :: SimpleSelector -> Parser [SimpleSelector]-parseSelector' op tokens = (op:selector, tokens')-    where (selector, tokens') = parseSelector tokens--parseSelector :: Parser [SimpleSelector]-parseSelector (Ident ns:Delim '|':tokens) = parseSelector' (Namespace ns) tokens-parseSelector (Delim '*':tokens) = parseSelector tokens-parseSelector (Ident tag:tokens) = parseSelector' (Tag tag) tokens-parseSelector (Hash _ i:tokens) = parseSelector' (Id i) tokens-parseSelector (Delim '.':Ident class_:tokens) = parseSelector' (Class class_) tokens-parseSelector (LeftSquareBracket:Ident ns:Delim '|':Ident prop:tokens) =-        concatP appendPropertySel parsePropertySel parseSelector tokens-    where appendPropertySel test selector = Property (Just ns) prop test : selector-parseSelector (LeftSquareBracket:Ident prop:tokens) =-        concatP appendPropertySel parsePropertySel parseSelector tokens-    where appendPropertySel test selector = Property Nothing prop test : selector-parseSelector (Colon:Ident p:ts) = parseSelector' (Psuedoclass p []) ts-parseSelector (Colon:Function fn:tokens) =-        concatP appendPseudo scanBlock parseSelector tokens-    where appendPseudo args selector = Psuedoclass fn args : selector-parseSelector tokens = ([], tokens)--parseCombinators' :: Selector -> Parser Selector-parseCombinators' selector tokens = parseCombinators selector' tokens'-    where (selector', tokens') = parseCombinator selector tokens-parseCombinators :: Selector -> Parser Selector-parseCombinators selector (Whitespace:tokens) = parseCombinators' selector tokens-parseCombinators selector tokens@(Delim _:_) = parseCombinators' selector tokens-parseCombinators selector tokens = (selector, tokens)--parseCombinator' :: (Selector -> [SimpleSelector] -> Selector)-                    -> Selector -> Parser Selector-parseCombinator' cb selector tokens = (cb selector selector', tokens')-    where (selector', tokens') = parseSelector $ skipSpace tokens-parseCombinator :: Selector -> [Token] -> (Selector, [Token])-parseCombinator selector (Whitespace:tokens) = parseCombinator selector tokens-parseCombinator selector (Delim '>':tokens) = parseCombinator' Child selector tokens-parseCombinator selector (Delim '~':tokens) = parseCombinator' Sibling selector tokens-parseCombinator selector (Delim '+':tokens) = parseCombinator' Adjacent selector tokens--- Take special care to avoid adding a trailing Descendant when not needed.-parseCombinator selector tokens@(LeftCurlyBracket:_) = (selector, tokens)-parseCombinator selector tokens@(RightCurlyBracket:_) = (selector, tokens)-parseCombinator selector tokens@(RightSquareBracket:_) = (selector, tokens)-parseCombinator selector tokens@(Comma:_) = (selector, tokens)--parseCombinator selector tokens@(RightParen:_) = (selector, tokens)-parseCombinator selector [] = (selector, [])--parseCombinator selector tokens = parseCombinator' Descendant selector tokens--parsePropertySel :: Parser PropertyTest-parsePropertySel (RightSquareBracket:tokens) = (Exists, tokens)-parsePropertySel (Delim '=':tokens) = parsePropertyVal (Equals) tokens-parsePropertySel (SuffixMatch:tokens) = parsePropertyVal (Suffix) tokens-parsePropertySel (PrefixMatch:tokens) = parsePropertyVal (Prefix) tokens-parsePropertySel (SubstringMatch:tokens) = parsePropertyVal (Substring) tokens-parsePropertySel (IncludeMatch:tokens) = parsePropertyVal (Include) tokens-parsePropertySel (DashMatch:tokens) = parsePropertyVal (Dash) tokens-parsePropertySel tokens = (Exists, skipBlock tokens)--parsePropertyVal :: (Text -> PropertyTest) -> Parser PropertyTest-parsePropertyVal wrapper (Ident val:RightSquareBracket:tokens) = (wrapper val, tokens)-parsePropertyVal wrapper (String val:RightSquareBracket:tokens) = (wrapper val, tokens)-parsePropertyVal _ tokens = (Exists, skipBlock tokens)+import Stylist.Parse.Selector
src/Data/CSS/Syntax/StyleSheet.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE OverloadedStrings #-} -- | Parses a CSS stylesheet -- See `StyleSheet` & `parseForURL`.+--+-- Backwards-compatability module, this API has been moved out into "stylist-traits". module Data.CSS.Syntax.StyleSheet (         parse, parse', parseForURL, TrivialStyleSheet(..),         StyleSheet(..), skipAtRule, scanAtRule, scanBlock, skipSpace,@@ -11,141 +13,4 @@         scanValue     ) where -import Data.CSS.Syntax.Tokens-import Data.CSS.Syntax.Selector-import Data.CSS.Syntax.StylishUtil--import Data.Text.Internal (Text(..))-import Data.Text (pack, unpack)-import Network.URI (parseRelativeReference, relativeTo, uriToString, URI(..))--------------- Output type class------------ | Describes how to store, and to some extent parse, CSS stylesheets.--- These methods are used to construct the results from `parse`, etc.-class StyleSheet s where-    -- | Sets the stylesheet priority (useragent vs user vs author), optional.-    setPriority :: Int -> s -> s-    setPriority _ = id-    -- | Stores a parsed selector+properties rule.-    addRule :: s -> StyleRule -> s-    -- | Stores and parses an identified at-rule.-    addAtRule :: s -> Text -> [Token] -> (s, [Token])-    addAtRule self _ tokens = (self, skipAtRule tokens)---- | Stores the parsed selector*s*+proeprties rule.-addRules :: StyleSheet ss => ss -> ([Selector], ([(Text, [Token])], Text)) -> ss-addRules self (selector:selectors, val@(props, psuedoel)) = addRules self' (selectors, val)-    where self' = addRule self $ StyleRule selector props psuedoel-addRules self ([], _) = self---- | The properties to set for elements matching the given selector.-data StyleRule = StyleRule Selector [(Text, [Token])] Text deriving (Show, Eq)---- | Gathers StyleRules into a list, mainly for testing.-data TrivialStyleSheet = TrivialStyleSheet [StyleRule] deriving (Show, Eq)-instance StyleSheet TrivialStyleSheet where-    addRule (TrivialStyleSheet self) rule = TrivialStyleSheet $ rule:self--------------- Basic parsing------------ | Parse a CSS stylesheet-parse :: StyleSheet s => s -> Text -> s-parse stylesheet source = parse' stylesheet $ tokenize source---- | Parse a CSS stylesheet, resolving all URLs to absolute form.-parseForURL :: StyleSheet s => s -> URI -> Text -> s-parseForURL stylesheet base source = parse' stylesheet $ rewriteURLs $ tokenize source-    where-        rewriteURLs (Url text:toks)-            | Just url <- parseRelativeReference $ unpack text =-                Url (pack $ uriToString id (relativeTo url base) "") : rewriteURLs toks-            | otherwise = Function "url" : RightParen : rewriteURLs toks-        rewriteURLs (tok:toks) = tok : rewriteURLs toks-        rewriteURLs [] = []---- | Parse a tokenized (via `css-syntax`) CSS stylesheet-parse' :: StyleSheet t => t -> [Token] -> t--- Things to skip.-parse' stylesheet (Whitespace:tokens) = parse' stylesheet tokens-parse' stylesheet (CDO:tokens) = parse' stylesheet tokens-parse' stylesheet (CDC:tokens) = parse' stylesheet tokens-parse' stylesheet (Comma:tokens) = parse' stylesheet tokens -- TODO issue warnings.--parse' stylesheet [] = stylesheet--parse' stylesheet (AtKeyword kind:tokens) = parse' stylesheet' tokens'-    where (stylesheet', tokens') = addAtRule stylesheet kind $ skipSpace tokens-parse' stylesheet tokens = parse' (addRules stylesheet rule) tokens'-    where (rule, tokens') = concatP (,) parseSelectors parseProperties tokens--------------- Property parsing------------ | Parse "{key: value; ...}" property values, with a psuedoelement.-parseProperties :: Parser ([(Text, [Token])], Text)-parseProperties (LeftCurlyBracket:tokens) = noPsuedoel $ parseProperties' tokens-parseProperties (Whitespace:tokens) = parseProperties tokens-parseProperties (Colon:Colon:Ident n:tokens) = ((val, n), tokens')-    where ((val, _), tokens') = parseProperties tokens--- This error recovery is a bit overly conservative, but it's simple.-parseProperties (_:tokens) = noPsuedoel ([], skipAtRule tokens)-parseProperties [] = noPsuedoel ([], [])--noPsuedoel :: (x, y) -> ((x, Text), y)-noPsuedoel (val, tokens) = ((val, ""), tokens)---- | Parse "key: value;"... property values, as per the HTML "style" property.-parseProperties' :: Parser [(Text, [Token])]-parseProperties' (Whitespace:tokens) = parseProperties' tokens-parseProperties' (Ident name:tokens)-    | Colon:tokens' <- skipSpace tokens =-        concatP appendProp scanValue parseProperties' tokens'-    where appendProp value props = (name, value):props-parseProperties' (RightCurlyBracket:tokens) = ([], tokens)-parseProperties' [] = ([], [])-parseProperties' tokens = parseProperties' (skipValue tokens)--------------- Skipping/Scanning utilities------------ | Returns tokens before & after an at-rule value, terminated after a curly-bracketed block or a semicolon.-scanAtRule :: Parser [Token]-scanAtRule (Semicolon:tokens) = ([Semicolon], tokens)-scanAtRule tokens@(LeftCurlyBracket:_) = scanInner tokens $ \rest -> ([], rest)--scanAtRule tokens@(LeftParen:_) = scanInner tokens scanValue-scanAtRule tokens@(Function _:_) = scanInner tokens scanValue-scanAtRule tokens@(LeftSquareBracket:_) = scanInner tokens scanValue--- To ensure parens are balanced, should already be handled.-scanAtRule (RightCurlyBracket:tokens) = ([], RightCurlyBracket:tokens)-scanAtRule (RightParen:tokens) = ([], RightParen:tokens)-scanAtRule (RightSquareBracket:tokens) = ([], RightSquareBracket:tokens)--scanAtRule tokens = capture scanAtRule tokens---- | Returns tokens after an at-rule, as per `scanAtRule`.-skipAtRule :: [Token] -> [Token]-skipAtRule tokens = snd $ scanAtRule tokens---- | Returns tokens before & after a semicolon.-scanValue :: Parser [Token]-scanValue (Semicolon:tokens) = ([], tokens)-scanValue (Whitespace:tokens) = scanValue tokens--scanValue tokens@(LeftCurlyBracket:_) = scanInner tokens scanValue-scanValue tokens@(LeftParen:_) = scanInner tokens scanValue-scanValue tokens@(Function _:_) = scanInner tokens scanValue-scanValue tokens@(LeftSquareBracket:_) = scanInner tokens scanValue--- To ensure parens are balanced, should already be handled.-scanValue (RightCurlyBracket:tokens) = ([], RightCurlyBracket:tokens)-scanValue (RightParen:tokens) = ([], RightParen:tokens)-scanValue (RightSquareBracket:tokens) = ([], RightSquareBracket:tokens)--scanValue tokens = capture scanValue tokens---- | Returns tokens after a semicolon.-skipValue :: [Token] -> [Token]-skipValue tokens = snd $ scanValue tokens+import Stylist.Parse
− src/Data/CSS/Syntax/StylishUtil.hs 
@@ -1,54 +0,0 @@--- | Utility parser combinators for parsing CSS stylesheets.-module Data.CSS.Syntax.StylishUtil(-        concatP, capture, skipSpace,-        scanBlock, skipBlock, scanInner,-        Parser-    ) where--import Data.CSS.Syntax.Tokens---- | A simple parser combinator type.-type Parser x = [Token] -> (x, [Token])---- | Chains two parser combinators together.-concatP :: (a -> b -> c) -> Parser a -> Parser b -> Parser c-concatP join left right tokens = (join x y, remainder)-    where-        (x, tokens') = left tokens-        (y, remainder) = right tokens'---- | "captures" the token being parsed into the returned output.-capture :: Parser [Token] -> Parser [Token]-capture cb (token:tokens) = (token:captured, tokens')-   where (captured, tokens') = cb tokens-capture _ [] = ([], [])---- | Removes preceding `Whitespace` tokens.-skipSpace :: [Token] -> [Token]-skipSpace (Whitespace:tokens) = skipSpace tokens-skipSpace tokens = tokens---- | Returns tokens until the next unbalanced closing brace.-scanBlock :: Parser [Token]--- TODO assert closing tags are correct---    But what should the error recovery be?-scanBlock (RightCurlyBracket:tokens) = ([RightCurlyBracket], tokens)-scanBlock (RightParen:tokens) = ([RightParen], tokens)-scanBlock (RightSquareBracket:tokens) = ([RightSquareBracket], tokens)--scanBlock tokens@(LeftCurlyBracket:_) = scanInner tokens scanBlock-scanBlock tokens@(LeftParen:_) = scanInner tokens scanBlock-scanBlock tokens@(Function _:_) = scanInner tokens scanBlock-scanBlock tokens@(LeftSquareBracket:_) = scanInner tokens scanBlock--scanBlock tokens = capture scanBlock tokens---- | Returns tokens after the next unbalanced closing brace.-skipBlock :: [Token] -> [Token]-skipBlock tokens = snd $ scanBlock tokens---- | Parses a block followed by the given combinator, returning the tokens the matched.-scanInner :: [Token] -> Parser [Token] -> ([Token], [Token])-scanInner (token:tokens) cb = concatP gather scanBlock cb tokens-    where gather x y = token : x ++ y-scanInner [] _ = error "Expected a token to capture."
stylist.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             2.4.0.2+version:             2.5.0.0  -- A short (one-line) description of the package. synopsis:            Apply CSS styles to a document tree.@@ -59,10 +59,10 @@                        Data.CSS.Preprocessor.Assets, Data.CSS.Preprocessor.Text, Data.CSS.Preprocessor.PsuedoClasses      -- Modules included in this library but not exported.-  other-modules:       Data.CSS.Syntax.StylishUtil,-                       Data.CSS.Style.Importance, Data.CSS.Style.Common, Data.CSS.Style.Cascade,+  other-modules:       Data.CSS.Style.Importance, Data.CSS.Style.Common, Data.CSS.Style.Cascade,                        Data.CSS.Style.Selector.Index, Data.CSS.Style.Selector.Interpret,-                           Data.CSS.Style.Selector.Specificity, Data.CSS.Style.Selector.LowerWhere+                           Data.CSS.Style.Selector.Specificity, Data.CSS.Style.Selector.LowerWhere,+                       Data.CSS.Syntax.AtLayer      -- LANGUAGE extensions used by modules in this package.   -- other-extensions:    @@ -71,7 +71,7 @@   build-depends:       base >=4.9 && <5, css-syntax >=0.1 && <0.2, text,                         unordered-containers >= 0.2 && <0.3, hashable,                         network-uri >= 2.6 && <2.7, async >= 2.1 && <2.3,-                        regex-tdfa >= 1.3+                        regex-tdfa >= 1.3, stylist-traits >= 0.1 && < 0.2      -- Directories containing source files.   hs-source-dirs:      src@@ -82,6 +82,13 @@   ghc-options: -Wall    test-suite test-stylist+  other-modules:+    Data.CSS.Preprocessor.Conditions, Data.CSS.Preprocessor.Conditions.Expr, Data.CSS.Preprocessor.Text,+    Data.CSS.Style.Cascade, Data.CSS.Style.Common, Data.CSS.Style.Importance,+    Data.CSS.Style.Selector.Index, Data.CSS.Style.Selector.Interpret,+        Data.CSS.Style.Selector.LowerWhere, Data.CSS.Style.Selector.Specificity,+    Data.CSS.StyleTree, Data.CSS.Syntax.AtLayer+   hs-source-dirs:       src test   default-language:     Haskell2010   type:     exitcode-stdio-1.0@@ -91,5 +98,4 @@                         unordered-containers >= 0.2 && <0.3, hashable,                         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-  ghc-options: -Wall+                        scientific >= 0.3 && <1.0, regex-tdfa >= 1.3, stylist-traits >= 0.1 && < 0.2
test/Test.hs view
@@ -3,6 +3,7 @@  import Test.Hspec import Data.HashMap.Strict+import qualified Data.HashMap.Lazy as L import Data.Maybe (fromJust) import Network.URI import Data.Scientific (toRealFloat)@@ -11,6 +12,8 @@ import Data.CSS.Syntax.StyleSheet (parse, StyleSheet(..), TrivialStyleSheet(..), scanAtRule, scanValue) import Data.CSS.Syntax.Selector +import Data.CSS.Syntax.AtLayer+ import Data.CSS.Style.Common import Data.CSS.Style.Selector.Index import Data.CSS.Style.Selector.Interpret@@ -98,7 +101,7 @@                 ]     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 +124,17 @@             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 +277,8 @@                 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 +289,8 @@                 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@@ -504,6 +507,18 @@              let textStyle4 = fromJust $ longhand temp textStyle1 "counter-increment" [Ident "-rhaps-ol"]             style (Txt.resolve $ StyleTree textStyle4 []) `shouldBe` TrivialPropertyParser (fromList [("content", [String "1"])])+    describe "@layer" $ do+        it "Deduplicates names" $ do+            let init = Tree L.empty+            let tree2 = registerLayer ["LeagueOfGentlemenAdventurers", "The Stranger"] init+            let tree3 = registerLayer ["JusticeUnion", "TomTomorrow"] tree2+            let tree4 = registerLayer ["HomeTeam", "DocRocket"] tree3+            let tree5 = registerLayer ["JusticeUnion", "TheOgre"] tree4++            layerPath ["JusticeUnion", "TheOgre"] tree5 `shouldBe` [2, 2]+            layerPath ["HomeTeam"] tree5 `shouldBe` [3]+            layerPath ["LeagueOfGentlemenAdventurers"] tree5 `shouldBe` [1]+            uniqueName ["HomeTeam"] tree5 `shouldBe` ["HomeTeam", "1"]  styleIndex :: StyleIndex styleIndex = new