@@ 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 []
@@ 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' [] _ = []