module Data.CSS.Style( QueryableStyleSheet(..), QueryableStyleSheet'(..), queryableStyleSheet, queryRules, PropertyParser(..), cascade, TrivialPropertyParser(..), Element(..), Attribute(..) ) where import Data.CSS.Style.Selector.Index import Data.CSS.Style.Selector.Interpret import Data.CSS.Style.Selector.Specificity import Data.CSS.Style.Importance import Data.CSS.Style.Common import Data.CSS.Syntax.StyleSheet (StyleSheet(..)) -- TODO do performance tests to decide beside between strict/lazy, -- or is another Map implementation better? import Data.HashMap.Strict import Data.CSS.Syntax.Tokens import Data.Text (unpack) type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter ( PropertyExpander parser (OrderedRuleStore (InterpretedRuleStore StyleIndex)) )) parser data QueryableStyleSheet' store parser = QueryableStyleSheet' { store :: store, parser :: parser, priority :: Int -- author vs user agent vs user styles } queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = 0} instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where addRule self@(QueryableStyleSheet' store _ priority) rule = self { store = addStyleRule store priority $ styleRule' rule } queryRules (QueryableStyleSheet' store _ _) el = lookupRules store el -------- ---- Cascade -------- cascadeRules overrides rules = cascadeProperties overrides $ concat $ Prelude.map properties rules cascadeProperties overrides props = fromList (props ++ overrides) -------- ---- Dispatch to property definitions -------- class PropertyParser a where temp :: a shorthand :: a -> Text -> [Token] -> [(Text, [Token])] shorthand self name value | Just _ <- longhand self self name value = [(name, value)] | otherwise = [] -- longhand parent self name value longhand :: a -> a -> Text -> [Token] -> Maybe a cascade :: PropertyParser p => QueryableStyleSheet p -> Element -> [(Text, [Token])] -> p -> p cascade self el overrides parent = dispatch parent parent $ toList $ cascadeRules overrides $ queryRules self el dispatch parent child ((name, value):props) | Just child' <- longhand parent child name value = dispatch parent child' props | otherwise = dispatch parent child props dispatch _ child [] = child --- Verify syntax during parsing, so invalid properties don't interfere with cascade. data PropertyExpander parser inner = PropertyExpander parser inner instance (PropertyParser parser, RuleStore inner) => RuleStore (PropertyExpander parser inner) where new = PropertyExpander temp new addStyleRule (PropertyExpander parser inner) priority rule = PropertyExpander parser $ addStyleRule inner priority $ expandRule parser rule lookupRules (PropertyExpander _ inner) el = lookupRules inner el expandRule parser rule = rule {inner = StyleRule selector $ expandProperties parser properties} where (StyleRule selector properties) = inner rule expandProperties parser ((name, value):props) = shorthand parser name value ++ expandProperties parser props expandProperties _ [] = [] -------- ---- Testing utility -------- data TrivialPropertyParser = TrivialPropertyParser (HashMap String [Token]) instance PropertyParser TrivialPropertyParser where temp = TrivialPropertyParser empty longhand _ (TrivialPropertyParser self) key value = Just $ TrivialPropertyParser $ insert (unpack key) value self