{-# 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 Data.Text (isPrefixOf)
import Data.List (elemIndex)
type QueryableStyleSheet parser = QueryableStyleSheet' (ImportanceSplitter (
PropertyExpander parser (
OrderedRuleStore (WhereLowerer (InterpretedRuleStore StyleIndex))
)
)) parser
data QueryableStyleSheet' store parser = QueryableStyleSheet' {
forall store parser. QueryableStyleSheet' store parser -> store
store :: store,
forall store parser. QueryableStyleSheet' store parser -> parser
parser :: parser,
forall store parser. QueryableStyleSheet' store parser -> [Int]
priority :: [Int],
forall store parser. QueryableStyleSheet' store parser -> Tree
layers :: AtLayer.Tree,
forall store parser. QueryableStyleSheet' store parser -> [Text]
layerNamespace :: [Text]
}
queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p
queryableStyleSheet :: forall p. PropertyParser p => 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,
priority :: [Int]
priority = [Int
0], layerNamespace :: [Text]
layerNamespace = [] }
instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where
setPriorities :: [Int] -> QueryableStyleSheet' s p -> QueryableStyleSheet' s p
setPriorities [Int]
vs QueryableStyleSheet' s p
self = QueryableStyleSheet' s p
self { priority :: [Int]
priority = [Int]
vs }
addRule :: QueryableStyleSheet' s p -> StyleRule -> QueryableStyleSheet' s p
addRule self :: QueryableStyleSheet' s p
self@(QueryableStyleSheet' s
store' p
_ [Int]
priority' Tree
_ [Text]
_) 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_, priority :: forall store parser. QueryableStyleSheet' store parser -> [Int]
priority = Int
v:[Int]
_ }
Text
"layer" [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
$ \[Text]
ns' [Int]
path -> QueryableStyleSheet' s p
self {
priority :: [Int]
priority = Int
v Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int]
path, layerNamespace :: [Text]
layerNamespace = [Text]
ns'
} of
(Tree
layers', Just QueryableStyleSheet' s p
self', [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')
(Tree
layers', Maybe (QueryableStyleSheet' s p)
Nothing, [Token]
toks') -> (QueryableStyleSheet' s p
self { layers :: Tree
layers = Tree
layers' }, [Token]
toks')
addAtRule QueryableStyleSheet' s p
self Text
_ [Token]
toks = (QueryableStyleSheet' s p
self, [Token] -> [Token]
skipAtRule [Token]
toks)
queryRules :: (PropertyParser p, RuleStore s) =>
QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
queryRules :: forall p s.
(PropertyParser p, RuleStore s) =>
QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
queryRules (QueryableStyleSheet' s
store' p
_ [Int]
_ Tree
_ [Text]
_) = 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' :: forall p. PropertyParser p => [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 :: forall p.
PropertyParser p =>
QueryableStyleSheet p -> Element -> Props -> p -> p
cascade QueryableStyleSheet p
self Element
el = [StyleRule'] -> Props -> p -> p
forall p. PropertyParser p => [StyleRule'] -> Props -> p -> p
cascade' ([StyleRule'] -> Props -> p -> p)
-> [StyleRule'] -> Props -> p -> p
forall a b. (a -> b) -> a -> b
$ [StyleRule'] -> Text -> HashMap Text [StyleRule'] -> [StyleRule']
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
lookupDefault [] Text
"" (HashMap Text [StyleRule'] -> [StyleRule'])
-> HashMap Text [StyleRule'] -> [StyleRule']
forall a b. (a -> b) -> a -> b
$ 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
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' inner
inner') [Int]
priority' 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 parser
_ inner
inner') Element
el = inner -> Element -> [StyleRule']
forall a. RuleStore a => a -> Element -> [StyleRule']
lookupRules inner
inner' Element
el
expandRule :: PropertyParser t => t -> StyleRule' -> StyleRule'
expandRule :: forall t. PropertyParser t => t -> StyleRule' -> StyleRule'
expandRule t
parser' 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 Selector
sel Props
props Text
psuedo) = StyleRule' -> StyleRule
inner StyleRule'
rule
expandProperties :: PropertyParser t => t -> [(Text, [Token])] -> [(Text, [Token])]
expandProperties :: forall t. PropertyParser t => t -> Props -> Props
expandProperties t
parser' ((Text
key, [Token]
value):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 t
_ [] = []
data VarParser a = VarParser {forall a. VarParser a -> Props
vars :: Props, forall a. 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 Props
vars' 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
shorthand :: VarParser p -> Text -> [Token] -> Props
shorthand VarParser p
self Text
name' [Token]
value
| Text -> Token
Function Text
"var" Token -> [Token] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Token]
value Bool -> Bool -> Bool
|| Text
"--" 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 VarParser p
parent' self :: VarParser p
self@(VarParser Props
vars' p
inner') Text
name' [Token]
value
| Text -> Token
Function Text
"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 Props
v 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 Text
"var":Ident Text
var:Token
RightParen:[Token]
toks) 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 Text
"var":Ident Text
var:Token
Comma:[Token]
toks) HashMap Text [Token]
ctxt
| Just Int
i <- Token
RightParen Token -> [Token] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
`elemIndex` [Token]
toks, ([Token]
fallback, Token
RightParen:[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 Text
"var":[Token]
_) HashMap Text [Token]
_ = Maybe [Token]
forall a. Maybe a
Nothing
resolveVars (Token
tok:[Token]
toks) 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 [] HashMap Text [Token]
_ = [Token] -> Maybe [Token]
forall a. a -> Maybe a
Just []