~alcinnz/haskell-stylist

e65bf5632729f04b25cf9c304f3434b9052c2358 — Adrian Cochrane 10 months ago 30021fd
Adjust cascade shorthand to feed pseudoelements to the property parsers,
now that Stylist Traits provides the APIs for it.
2 files changed, 23 insertions(+), 5 deletions(-)

M src/Data/CSS/Style.hs
M src/Data/CSS/Style/Cascade.hs
M src/Data/CSS/Style.hs => src/Data/CSS/Style.hs +14 -2
@@ 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

M src/Data/CSS/Style/Cascade.hs => src/Data/CSS/Style/Cascade.hs +9 -3
@@ 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