2 files changed, 23 insertions(+), 5 deletions(-)

M src/Data/CSS/Style.hs
M src/Data/CSS/Style/Cascade.hs

@@ 23,8 23,10 @@ import Data.CSS.Syntax.StyleSheet (StyleSheet(..), skipAtRule)
 import Data.CSS.Syntax.AtLayer as AtLayer
 
 import Data.HashMap.Strict (HashMap, lookupDefault, fromList)
+import qualified Data.HashMap.Strict as HM
 import Data.Text (isPrefixOf)
 import Data.List (elemIndex)
+import Data.Maybe (fromMaybe)
 
 -- | A parsed CSS stylesheet from which you can query styles to match an element.
 type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (


@@ 79,9 81,19 @@ queryRules (QueryableStyleSheet' store' _ _ _ _) = Cascade.query store'
 cascade' :: PropertyParser p => [StyleRule'] -> Props -> p -> p
 cascade' = Cascade.cascade
 
--- | Facade over `queryRules` & `cascade'` for simple cases you don't care about psuedoelements.
+-- | Facade over `queryRules` & `cascade'`.
+-- Instead of exposing pseudoelements to callers it exposes pseudoelements to
+-- the `PropertyParser` implementation.
 cascade :: PropertyParser p => QueryableStyleSheet p -> Element -> Props -> p -> p
-cascade self el = cascade' $ lookupDefault [] "" $ queryRules self el
+cascade self el props style = HM.foldlWithKey' applyPseudoEl (cascade' (
+        lookupDefault [] "" rules) props style) rules
+  where
+    rules = queryRules self el
+    applyPseudoEl :: PropertyParser p => p -> Text -> [StyleRule'] -> p
+    applyPseudoEl self' "" _ = self'
+    applyPseudoEl self' pseudo props' = pseudoEl self' pseudo cb
+        where cb parent' base' = Cascade.cascadeWithParent props' [] parent' $
+                                    fromMaybe (inherit parent') base'
 
 --- Verify syntax during parsing, so invalid properties don't interfere with cascade.
 data PropertyExpander parser inner = PropertyExpander parser inner

@@ 2,7 2,7 @@
 -- | Applies CSS selection, cascade, & inheritance.
 -- INTERNAL MODULE.
 module Data.CSS.Style.Cascade(
-        query, cascade,
+        query, cascade, cascadeWithParent,
         TrivialPropertyParser(..), PropertyParser(..), Props
     ) where
 


@@ 41,15 41,21 @@ query self el = Prelude.foldr yield empty $ lookupRules self el
 cascade :: PropertyParser p => [StyleRule'] -> Props -> p -> p
 cascade styles overrides base =
     construct base $ HML.toList $ cascadeRules (getVars base ++ overrides) styles
+-- | Variant of `cascade` which allows configuring base styles seperate from parent.
+cascadeWithParent :: PropertyParser p => [StyleRule'] -> Props -> p -> p -> p
+cascadeWithParent styles overrides parent' base = constructWithParent parent' base $
+    HML.toList $ cascadeRules (getVars base ++ overrides) styles
 
 cascadeRules :: Props -> [StyleRule'] -> HashMap Text [Token]
 cascadeRules overrides rules = cascadeProperties overrides $ concat $ Prelude.map properties rules
 cascadeProperties :: Props -> Props -> HashMap Text [Token]
 cascadeProperties overrides props = HML.fromList (props ++ overrides)
 
+constructWithParent :: PropertyParser p => p -> p -> Props -> p
+constructWithParent parent' base props = dispatch parent' child props
+    where child = setVars [item | item@(n, _) <- props, isPrefixOf "--" n] base
 construct :: PropertyParser p => p -> Props -> p
-construct base props = dispatch base child props
-    where child = setVars [item | item@(n, _) <- props, isPrefixOf "--" n] $ inherit base
+construct base props = constructWithParent base (inherit base) props
 dispatch :: PropertyParser p => p -> p -> Props -> p
 dispatch base child ((key, value):props)
     | Just child' <- longhand base child key value = dispatch base child' props