~alcinnz/haskell-stylist

38022972af85067203abd9b8855ad0f9e56a0399 — Adrian Cochrane 5 years ago ee89bcf
Implement dispatching parser of CSS properties.
1 files changed, 46 insertions(+), 11 deletions(-)

M src/Stylish/Style/Selector.hs
M src/Stylish/Style/Selector.hs => src/Stylish/Style/Selector.hs +46 -11
@@ 1,6 1,7 @@
module Stylish.Style.Selector(
        QueryableStyleSheet(..), queryableStyleSheet,
        queryRules
        queryRules,
        PropertyParser(..), cascade
    ) where

import Stylish.Style.Selector.Index


@@ 9,7 10,7 @@ import Stylish.Style.Selector.Specificity
import Stylish.Style.Selector.Importance
import Stylish.Style.Selector.Common

import Stylish.Parse (StyleSheet(..))
import Stylish.Parse (StyleSheet(..), StyleRule(..))

-- TODO do performance tests to decide beside between strict/lazy,
--      or is another Map implementation better?


@@ 17,24 18,25 @@ import Data.HashMap.Strict
import Data.Text.Internal (Text(..))
import Data.CSS.Syntax.Tokens

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

data QueryableStyleSheet' store = QueryableStyleSheet' {
data QueryableStyleSheet' store parser = QueryableStyleSheet' {
    store :: store,
    parser :: parser,
    priority :: Int -- author vs user agent vs user styles
}

queryableStyleSheet :: QueryableStyleSheet
queryableStyleSheet = QueryableStyleSheet' {store = new, priority = 0}
queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
queryableStyleSheet = QueryableStyleSheet' {store = new, parser = temp, priority = 0}

instance RuleStore s => StyleSheet (QueryableStyleSheet' s) where
    addRule self@(QueryableStyleSheet' store priority) rule = self {
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
queryRules (QueryableStyleSheet' store _ _) el = lookupRules store el

--------
---- Cascade


@@ 43,3 45,36 @@ queryRules (QueryableStyleSheet' store _) el = lookupRules store el
cascadeRules rules = cascadeProperties $ concat $ Prelude.map properties rules

cascadeProperties ((name, value):props) = insert name value $ cascadeProperties props

--------
---- 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 -> p -> p
cascade self el parent = dispatch parent parent $ toList $ cascadeRules $ 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

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