{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.Style(
QueryableStyleSheet, QueryableStyleSheet'(..), queryableStyleSheet,
queryRules,
PropertyParser(..), cascade, cascade', VarParser(..),
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.Selector.LowerWhere
import Data.CSS.Style.Importance
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.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)
type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (
PropertyExpander parser (
OrderedRuleStore (WhereLowerer (InterpretedRuleStore StyleIndex))
)
)) parser
data QueryableStyleSheet' store parser = QueryableStyleSheet' {
QueryableStyleSheet' store parser -> store
store :: store,
QueryableStyleSheet' store parser -> parser
parser :: parser,
QueryableStyleSheet' store parser -> [Int]
priorities :: [Int],
QueryableStyleSheet' store parser -> Tree
layers :: AtLayer.Tree,
QueryableStyleSheet' store parser -> [Text]
layerNamespace :: [Text]
}
queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
queryableStyleSheet :: QueryableStyleSheet p
queryableStyleSheet = QueryableStyleSheet' :: forall store parser.
store
-> parser
-> [Int]
-> Tree
-> [Text]
-> QueryableStyleSheet' store parser
QueryableStyleSheet' {
store :: ImportanceSplitter
(PropertyExpander
p
(OrderedRuleStore
(WhereLowerer (InterpretedRuleStore StyleIndex))))
store = ImportanceSplitter
(PropertyExpander
p
(OrderedRuleStore
(WhereLowerer (InterpretedRuleStore StyleIndex))))
forall a. RuleStore a => a
new, parser :: p
parser = p
forall a. PropertyParser a => a
temp, layers :: Tree
layers = Tree
AtLayer.emptyTree,
priorities :: [Int]
priorities = [0], layerNamespace :: [Text]
layerNamespace = [] }
instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where
setPriorities :: [Int] -> QueryableStyleSheet' s p -> QueryableStyleSheet' s p
setPriorities vs :: [Int]
vs self :: QueryableStyleSheet' s p
self = QueryableStyleSheet' s p
self { priorities :: [Int]
priorities = [Int]
vs }
addRule :: QueryableStyleSheet' s p -> StyleRule -> QueryableStyleSheet' s p
addRule self :: QueryableStyleSheet' s p
self@(QueryableStyleSheet' store' :: s
store' _ priority' :: [Int]
priority' _ _) rule :: StyleRule
rule = QueryableStyleSheet' s p
self {
store :: s
store = s -> [Int] -> StyleRule' -> s
forall a. RuleStore a => a -> [Int] -> StyleRule' -> a
addStyleRule s
store' [Int]
priority' (StyleRule' -> s) -> StyleRule' -> s
forall a b. (a -> b) -> a -> b
$ StyleRule -> StyleRule'
styleRule' StyleRule
rule
}
addAtRule :: QueryableStyleSheet' s p
-> Text -> [Token] -> (QueryableStyleSheet' s p, [Token])
addAtRule self :: QueryableStyleSheet' s p
self@QueryableStyleSheet' { layerNamespace :: forall store parser. QueryableStyleSheet' store parser -> [Text]
layerNamespace = [Text]
ns, layers :: forall store parser. QueryableStyleSheet' store parser -> Tree
layers = Tree
layers_, priorities :: forall store parser. QueryableStyleSheet' store parser -> [Int]
priorities = v :: Int
v:_ }
"layer" toks :: [Token]
toks =
case [Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> QueryableStyleSheet' s p)
-> (Tree, Maybe (QueryableStyleSheet' s p), [Token])
forall s.
StyleSheet s =>
[Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> s)
-> (Tree, Maybe s, [Token])
parseAtLayer [Text]
ns [Token]
toks Tree
layers_ (([Text] -> [Int] -> QueryableStyleSheet' s p)
-> (Tree, Maybe (QueryableStyleSheet' s p), [Token]))
-> ([Text] -> [Int] -> QueryableStyleSheet' s p)
-> (Tree, Maybe (QueryableStyleSheet' s p), [Token])
forall a b. (a -> b) -> a -> b
$ \ns' :: [Text]
ns' path :: [Int]
path -> QueryableStyleSheet' s p
self {
priorities :: [Int]
priorities = Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
path, layerNamespace :: [Text]
layerNamespace = [Text]
ns'
} of
(layers' :: Tree
layers', Just self' :: QueryableStyleSheet' s p
self', toks' :: [Token]
toks') -> (QueryableStyleSheet' s p
self { store :: s
store = QueryableStyleSheet' s p -> s
forall store parser. QueryableStyleSheet' store parser -> store
store QueryableStyleSheet' s p
self', layers :: Tree
layers = Tree
layers' }, [Token]
toks')
(layers' :: Tree
layers', Nothing, toks' :: [Token]
toks') -> (QueryableStyleSheet' s p
self { layers :: Tree
layers = Tree
layers' }, [Token]
toks')
addAtRule self :: QueryableStyleSheet' s p
self _ toks :: [Token]
toks = (QueryableStyleSheet' s p
self, [Token] -> [Token]
skipAtRule [Token]
toks)
queryRules :: (PropertyParser p, RuleStore s) =>
QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
queryRules :: QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
queryRules (QueryableStyleSheet' store' :: s
store' _ _ _ _) = s -> Element -> HashMap Text [StyleRule']
forall s. RuleStore s => s -> Element -> HashMap Text [StyleRule']
Cascade.query s
store'
cascade' :: PropertyParser p => [StyleRule'] -> Props -> p -> p
cascade' :: [StyleRule'] -> Props -> p -> p
cascade' = [StyleRule'] -> Props -> p -> p
forall p. PropertyParser p => [StyleRule'] -> Props -> p -> p
Cascade.cascade
cascade :: PropertyParser p => QueryableStyleSheet p -> Element -> Props -> p -> p
cascade :: QueryableStyleSheet p -> Element -> Props -> p -> p
cascade self :: QueryableStyleSheet p
self el :: Element
el props :: Props
props style :: p
style = (p -> Text -> [StyleRule'] -> p)
-> p -> HashMap Text [StyleRule'] -> p
forall a k v. (a -> k -> v -> a) -> a -> HashMap k v -> a
HM.foldlWithKey' p -> Text -> [StyleRule'] -> p
forall p. PropertyParser p => p -> Text -> [StyleRule'] -> p
applyPseudoEl ([StyleRule'] -> Props -> p -> p
forall p. PropertyParser p => [StyleRule'] -> Props -> p -> p
cascade' (
[StyleRule'] -> Text -> HashMap Text [StyleRule'] -> [StyleRule']
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
lookupDefault [] "" HashMap Text [StyleRule']
rules) Props
props p
style) HashMap Text [StyleRule']
rules
where
rules :: HashMap Text [StyleRule']
rules = QueryableStyleSheet p -> Element -> HashMap Text [StyleRule']
forall p s.
(PropertyParser p, RuleStore s) =>
QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
queryRules QueryableStyleSheet p
self Element
el
applyPseudoEl :: PropertyParser p => p -> Text -> [StyleRule'] -> p
applyPseudoEl :: p -> Text -> [StyleRule'] -> p
applyPseudoEl self' :: p
self' "" _ = p
self'
applyPseudoEl self' :: p
self' pseudo :: Text
pseudo props' :: [StyleRule']
props' = p -> Text -> (p -> Maybe p -> p) -> p
forall a. PropertyParser a => a -> Text -> (a -> Maybe a -> a) -> a
pseudoEl p
self' Text
pseudo p -> Maybe p -> p
forall a. PropertyParser a => a -> Maybe a -> a
cb
where cb :: a -> Maybe a -> a
cb parent' :: a
parent' base' :: Maybe a
base' = [StyleRule'] -> Props -> a -> a -> a
forall p. PropertyParser p => [StyleRule'] -> Props -> p -> p -> p
Cascade.cascadeWithParent [StyleRule']
props' [] a
parent' (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (a -> a
forall a. PropertyParser a => a -> a
inherit a
parent') Maybe a
base'
data PropertyExpander parser inner = PropertyExpander parser inner
instance (PropertyParser parser, RuleStore inner) => RuleStore (PropertyExpander parser inner) where
new :: PropertyExpander parser inner
new = parser -> inner -> PropertyExpander parser inner
forall parser inner.
parser -> inner -> PropertyExpander parser inner
PropertyExpander parser
forall a. PropertyParser a => a
temp inner
forall a. RuleStore a => a
new
addStyleRule :: PropertyExpander parser inner
-> [Int] -> StyleRule' -> PropertyExpander parser inner
addStyleRule (PropertyExpander parser' :: parser
parser' inner' :: inner
inner') priority' :: [Int]
priority' rule :: StyleRule'
rule =
parser -> inner -> PropertyExpander parser inner
forall parser inner.
parser -> inner -> PropertyExpander parser inner
PropertyExpander parser
parser' (inner -> PropertyExpander parser inner)
-> inner -> PropertyExpander parser inner
forall a b. (a -> b) -> a -> b
$ inner -> [Int] -> StyleRule' -> inner
forall a. RuleStore a => a -> [Int] -> StyleRule' -> a
addStyleRule inner
inner' [Int]
priority' (StyleRule' -> inner) -> StyleRule' -> inner
forall a b. (a -> b) -> a -> b
$ parser -> StyleRule' -> StyleRule'
forall t. PropertyParser t => t -> StyleRule' -> StyleRule'
expandRule parser
parser' StyleRule'
rule
lookupRules :: PropertyExpander parser inner -> Element -> [StyleRule']
lookupRules (PropertyExpander _ inner' :: inner
inner') el :: Element
el = inner -> Element -> [StyleRule']
forall a. RuleStore a => a -> Element -> [StyleRule']
lookupRules inner
inner' Element
el
expandRule :: PropertyParser t => t -> StyleRule' -> StyleRule'
expandRule :: t -> StyleRule' -> StyleRule'
expandRule parser' :: t
parser' rule :: StyleRule'
rule = StyleRule'
rule {inner :: StyleRule
inner = Selector -> Props -> Text -> StyleRule
StyleRule Selector
sel (t -> Props -> Props
forall t. PropertyParser t => t -> Props -> Props
expandProperties t
parser' Props
props) Text
psuedo}
where (StyleRule sel :: Selector
sel props :: Props
props psuedo :: Text
psuedo) = StyleRule' -> StyleRule
inner StyleRule'
rule
expandProperties :: PropertyParser t => t -> [(Text, [Token])] -> [(Text, [Token])]
expandProperties :: t -> Props -> Props
expandProperties parser' :: t
parser' ((key :: Text
key, value :: [Token]
value):props :: Props
props) =
t -> Text -> [Token] -> Props
forall a. PropertyParser a => a -> Text -> [Token] -> Props
shorthand t
parser' Text
key [Token]
value Props -> Props -> Props
forall a. [a] -> [a] -> [a]
++ t -> Props -> Props
forall t. PropertyParser t => t -> Props -> Props
expandProperties t
parser' Props
props
expandProperties _ [] = []
data VarParser a = VarParser {VarParser a -> Props
vars :: Props, VarParser a -> a
innerParser :: a}
instance PropertyParser p => PropertyParser (VarParser p) where
temp :: VarParser p
temp = Props -> p -> VarParser p
forall a. Props -> a -> VarParser a
VarParser [] p
forall a. PropertyParser a => a
temp
inherit :: VarParser p -> VarParser p
inherit (VarParser vars' :: Props
vars' self :: p
self) = Props -> p -> VarParser p
forall a. Props -> a -> VarParser a
VarParser Props
vars' (p -> VarParser p) -> p -> VarParser p
forall a b. (a -> b) -> a -> b
$ p -> p
forall a. PropertyParser a => a -> a
inherit p
self
priority :: VarParser p -> [Text]
priority (VarParser _ self :: p
self) = p -> [Text]
forall a. PropertyParser a => a -> [Text]
priority p
self
shorthand :: VarParser p -> Text -> [Token] -> Props
shorthand self :: VarParser p
self name' :: Text
name' value :: [Token]
value
| Text -> Token
Function "var" Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token]
value Bool -> Bool -> Bool
|| "--" Text -> Text -> Bool
`isPrefixOf` Text
name' = [(Text
name', [Token]
value)]
| Bool
otherwise = p -> Text -> [Token] -> Props
forall a. PropertyParser a => a -> Text -> [Token] -> Props
shorthand (VarParser p -> p
forall a. VarParser a -> a
innerParser VarParser p
self) Text
name' [Token]
value
longhand :: VarParser p
-> VarParser p -> Text -> [Token] -> Maybe (VarParser p)
longhand parent' :: VarParser p
parent' self :: VarParser p
self@(VarParser vars' :: Props
vars' inner' :: p
inner') name' :: Text
name' value :: [Token]
value
| Text -> Token
Function "var" Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token]
value = [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars [Token]
value (Props -> HashMap Text [Token]
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
fromList Props
vars') Maybe [Token]
-> ([Token] -> Maybe (VarParser p)) -> Maybe (VarParser p)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= VarParser p
-> VarParser p -> Text -> [Token] -> Maybe (VarParser p)
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand VarParser p
parent' VarParser p
self Text
name'
| Bool
otherwise = Props -> p -> VarParser p
forall a. Props -> a -> VarParser a
VarParser Props
vars' (p -> VarParser p) -> Maybe p -> Maybe (VarParser p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> p -> p -> Text -> [Token] -> Maybe p
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand (VarParser p -> p
forall a. VarParser a -> a
innerParser VarParser p
parent') p
inner' Text
name' [Token]
value
getVars :: VarParser p -> Props
getVars = VarParser p -> Props
forall a. VarParser a -> Props
vars
setVars :: Props -> VarParser p -> VarParser p
setVars v :: Props
v self :: VarParser p
self = VarParser p
self {vars :: Props
vars = Props
v}
resolveVars :: [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars :: [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars (Function "var":Ident var :: Text
var:RightParen:toks :: [Token]
toks) ctxt :: HashMap Text [Token]
ctxt = ([Token] -> Text -> HashMap Text [Token] -> [Token]
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
lookupDefault [] Text
var HashMap Text [Token]
ctxt [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++) ([Token] -> [Token]) -> Maybe [Token] -> Maybe [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars [Token]
toks HashMap Text [Token]
ctxt
resolveVars (Function "var":Ident var :: Text
var:Comma:toks :: [Token]
toks) ctxt :: HashMap Text [Token]
ctxt
| Just i :: Int
i <- Token
RightParen Token -> [Token] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Token]
toks, (fallback :: [Token]
fallback, RightParen:toks' :: [Token]
toks') <- Int
i Int -> [Token] -> ([Token], [Token])
forall a. Int -> [a] -> ([a], [a])
`splitAt` [Token]
toks =
([Token] -> Text -> HashMap Text [Token] -> [Token]
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
lookupDefault [Token]
fallback Text
var HashMap Text [Token]
ctxt [Token] -> [Token] -> [Token]
forall a. [a] -> [a] -> [a]
++) ([Token] -> [Token]) -> Maybe [Token] -> Maybe [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars [Token]
toks' HashMap Text [Token]
ctxt
resolveVars (Function "var":_) _ = Maybe [Token]
forall a. Maybe a
Nothing
resolveVars (tok :: Token
tok:toks :: [Token]
toks) ctxt :: HashMap Text [Token]
ctxt = (Token
tokToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:) ([Token] -> [Token]) -> Maybe [Token] -> Maybe [Token]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token] -> HashMap Text [Token] -> Maybe [Token]
resolveVars [Token]
toks HashMap Text [Token]
ctxt
resolveVars [] _ = [Token] -> Maybe [Token]
forall a. a -> Maybe a
Just []