~alcinnz/haskell-stylist

d5d20109987fcd3fb7befff090b95cd1b8c2bdef — Adrian Cochrane 4 years ago feb616e
Implement var() via a PropertyParser decorator.
2 files changed, 37 insertions(+), 6 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 +33 -3
@@ 2,7 2,7 @@
module Data.CSS.Style(
        QueryableStyleSheet, QueryableStyleSheet'(..), queryableStyleSheet,
        queryRules,
        PropertyParser(..), cascade, cascade',
        PropertyParser(..), cascade, cascade', VarParser(..),
        TrivialPropertyParser(..),
        Element(..), Attribute(..)
    ) where


@@ 15,9 15,11 @@ import Data.CSS.Style.Common
import qualified Data.CSS.Style.Cascade as Cascade
import Data.CSS.Style.Cascade (PropertyParser(..), TrivialPropertyParser, Props)

import Data.CSS.Syntax.Tokens (Token)
import Data.CSS.Syntax.Tokens (Token(..))
import Data.CSS.Syntax.StyleSheet (StyleSheet(..))
import Data.HashMap.Strict (HashMap, lookupDefault)
import Data.HashMap.Strict (HashMap, lookupDefault, fromList)
import Data.Text (isPrefixOf)
import Data.List (elemIndex)

type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (
        PropertyExpander parser (OrderedRuleStore (InterpretedRuleStore StyleIndex))


@@ 65,3 67,31 @@ expandProperties :: PropertyParser t => t -> [(Text, [Token])] -> [(Text, [Token
expandProperties parser' ((key, value):props) =
        shorthand parser' key value ++ expandProperties parser' props
expandProperties _ [] = []

--------
---- var()
--------
data VarParser a = VarParser {vars :: Props, innerParser :: a}

instance PropertyParser p => PropertyParser (VarParser p) where
    temp = VarParser [] temp
    inherit (VarParser vars' self) = VarParser vars' $ inherit self

    shorthand self name' value
        | Function "var" `elem` value || "--" `isPrefixOf` name' = [(name', value)] -- Fail during inheritance...
        | otherwise = shorthand (innerParser self) name' value
    longhand parent' self@(VarParser vars' inner') name' value
        | Function "var" `elem` value = resolveVars value (fromList vars') >>= longhand parent' self name'
        | otherwise = VarParser vars' <$> longhand (innerParser parent') inner' name' value

    getVars = vars
    setVars v self = self {vars = v}

resolveVars :: [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars (Function "var":Ident var:RightParen:toks) ctxt = (lookupDefault [] var ctxt ++) <$> resolveVars toks ctxt
resolveVars (Function "var":Ident var:Comma:toks) ctxt
    | Just i <- RightParen `elemIndex` toks, (fallback, RightParen:toks') <- i `splitAt` toks =
        (lookupDefault fallback var ctxt ++) <$> resolveVars toks' ctxt
resolveVars (Function "var":_) _ = Nothing
resolveVars (tok:toks) ctxt = (tok:) <$> resolveVars toks ctxt
resolveVars [] _ = Just []

M src/Data/CSS/Style/Cascade.hs => src/Data/CSS/Style/Cascade.hs +4 -3
@@ 10,7 10,7 @@ import Data.CSS.Syntax.Tokens
-- TODO do performance tests to decide beside between strict/lazy,
--      or is another Map implementation better?
import Data.HashMap.Strict
import Data.Text (unpack, pack)
import Data.Text (unpack, pack, isPrefixOf)

class PropertyParser a where
    temp :: a


@@ 58,7 58,8 @@ cascadeProperties :: Props -> Props -> HashMap Text [Token]
cascadeProperties overrides props = fromList (props ++ overrides)

dispatch, dispatch' :: PropertyParser p => p -> p -> Props -> p
dispatch base child props = dispatch' base (setVars props child) props
dispatch base child props = dispatch' base (setVars vars child) props
    where vars = Prelude.filter (\(n, _) -> isPrefixOf "--" n) props
dispatch' base child ((key, value):props)
    | Just child' <- longhand base child key value = dispatch base child' props
    | otherwise = dispatch base child props


@@ 76,7 77,7 @@ attrs2Dict :: Element -> HashMap Text String
attrs2Dict el = fromList [(a, b) | Attribute a b <- attributes el]

resolveAttr' :: [Token] -> HashMap Text String  -> [Token]
resolveAttr' (Function "attr":Ident attr:LeftParen:toks) attrs =
resolveAttr' (Function "attr":Ident attr:RightParen:toks) attrs =
    String (pack $ lookupDefault "" attr attrs) : resolveAttr' toks attrs
resolveAttr' (tok:toks) attrs = tok : resolveAttr' toks attrs
resolveAttr' [] _ = []