{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.StyleTree(StyleTree(..), treeOrder, treeOrder',
Path, treeMap, treeFlatten, preorder, preorder', postorder,
stylize, inlinePseudos) where
import Stylist.Tree
import Stylist
import Data.CSS.Style
import Data.CSS.Syntax.StyleSheet (parseProperties')
import Data.CSS.Syntax.Tokens
import Data.Text (Text, pack)
import Data.HashMap.Strict as M (toList)
import Data.Maybe (fromMaybe)
stylize :: PropertyParser s => QueryableStyleSheet s -> StyleTree Element -> StyleTree [(Text, s)]
stylize :: forall s.
PropertyParser s =>
QueryableStyleSheet s -> StyleTree Element -> StyleTree [(Text, s)]
stylize = (Maybe [(Text, s)] -> Maybe [(Text, s)] -> Element -> [(Text, s)])
-> StyleTree Element -> StyleTree [(Text, s)]
forall b a.
(Maybe b -> Maybe b -> a -> b) -> StyleTree a -> StyleTree b
preorder ((Maybe [(Text, s)] -> Maybe [(Text, s)] -> Element -> [(Text, s)])
-> StyleTree Element -> StyleTree [(Text, s)])
-> (QueryableStyleSheet s
-> Maybe [(Text, s)]
-> Maybe [(Text, s)]
-> Element
-> [(Text, s)])
-> QueryableStyleSheet s
-> StyleTree Element
-> StyleTree [(Text, s)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryableStyleSheet s
-> Maybe [(Text, s)] -> Maybe [(Text, s)] -> Element -> [(Text, s)]
forall s.
PropertyParser s =>
QueryableStyleSheet s
-> Maybe [(Text, s)] -> Maybe [(Text, s)] -> Element -> [(Text, s)]
stylize'
stylize' :: PropertyParser s => QueryableStyleSheet s -> Maybe [(Text, s)] -> Maybe [(Text, s)] ->
Element -> [(Text, s)]
stylize' :: forall s.
PropertyParser s =>
QueryableStyleSheet s
-> Maybe [(Text, s)] -> Maybe [(Text, s)] -> Element -> [(Text, s)]
stylize' QueryableStyleSheet s
stylesheet Maybe [(Text, s)]
parent' Maybe [(Text, s)]
_ Element
el = (Text
"", s
base) (Text, s) -> [(Text, s)] -> [(Text, s)]
forall a. a -> [a] -> [a]
: [
(Text
k, [StyleRule'] -> Props -> s -> s
forall p. PropertyParser p => [StyleRule'] -> Props -> p -> p
cascade' [StyleRule']
v [] s
base) | (Text
k, [StyleRule']
v) <- HashMap Text [StyleRule'] -> [(Text, [StyleRule'])]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap Text [StyleRule'] -> [(Text, [StyleRule'])])
-> HashMap Text [StyleRule'] -> [(Text, [StyleRule'])]
forall a b. (a -> b) -> a -> b
$ QueryableStyleSheet s -> Element -> HashMap Text [StyleRule']
forall p s.
(PropertyParser p, RuleStore s) =>
QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule']
queryRules QueryableStyleSheet s
stylesheet Element
el
] where
base :: s
base = QueryableStyleSheet s -> Element -> Props -> s -> s
forall p.
PropertyParser p =>
QueryableStyleSheet p -> Element -> Props -> p -> p
cascade QueryableStyleSheet s
stylesheet Element
el Props
overrides (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe s
forall a. PropertyParser a => a
temp (Maybe s -> s) -> Maybe s -> s
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, s)] -> Maybe s
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"" ([(Text, s)] -> Maybe s) -> Maybe [(Text, s)] -> Maybe s
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe [(Text, s)]
parent'
overrides :: Props
overrides = [Props] -> Props
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [(Props, [Token]) -> Props
forall a b. (a, b) -> a
fst ((Props, [Token]) -> Props) -> (Props, [Token]) -> Props
forall a b. (a -> b) -> a -> b
$ Parser Props
parseProperties' Parser Props -> Parser Props
forall a b. (a -> b) -> a -> b
$ Text -> [Token]
tokenize (Text -> [Token]) -> Text -> [Token]
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
val
| Attribute Text
"style" Text
_ String
val <- Element -> [Attribute]
attributes Element
el]
inlinePseudos :: PropertyParser s => StyleTree [(Text, VarParser s)] -> StyleTree s
inlinePseudos :: forall s.
PropertyParser s =>
StyleTree [(Text, VarParser s)] -> StyleTree s
inlinePseudos (StyleTree [(Text, VarParser s)]
self [StyleTree [(Text, VarParser s)]]
childs) = StyleTree :: forall p. p -> [StyleTree p] -> StyleTree p
StyleTree {
style :: s
style = s -> Maybe s -> s
forall a. a -> Maybe a -> a
fromMaybe s
forall a. PropertyParser a => a
temp (Maybe s -> s) -> Maybe s -> s
forall a b. (a -> b) -> a -> b
$ VarParser s -> s
forall a. VarParser a -> a
innerParser (VarParser s -> s) -> Maybe (VarParser s) -> Maybe s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [(Text, VarParser s)] -> Maybe (VarParser s)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"" [(Text, VarParser s)]
self,
children :: [StyleTree s]
children = Text -> [StyleTree s]
pseudo Text
"before" [StyleTree s] -> [StyleTree s] -> [StyleTree s]
forall a. [a] -> [a] -> [a]
++ (StyleTree [(Text, VarParser s)] -> StyleTree s)
-> [StyleTree [(Text, VarParser s)]] -> [StyleTree s]
forall a b. (a -> b) -> [a] -> [b]
map StyleTree [(Text, VarParser s)] -> StyleTree s
forall s.
PropertyParser s =>
StyleTree [(Text, VarParser s)] -> StyleTree s
inlinePseudos [StyleTree [(Text, VarParser s)]]
childs [StyleTree s] -> [StyleTree s] -> [StyleTree s]
forall a. [a] -> [a] -> [a]
++ Text -> [StyleTree s]
pseudo Text
"after"
} where
pseudo :: Text -> [StyleTree s]
pseudo Text
n
| Just s
sty <- VarParser s -> s
forall a. VarParser a -> a
innerParser (VarParser s -> s) -> Maybe (VarParser s) -> Maybe s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [(Text, VarParser s)] -> Maybe (VarParser s)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
n [(Text, VarParser s)]
self,
Just s
style' <- s -> s -> Text -> [Token] -> Maybe s
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand s
sty s
sty Text
"::" [Text -> Token
Ident Text
n] = [s -> [StyleTree s] -> StyleTree s
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree s
style' []]
| Just s
sty <- VarParser s -> s
forall a. VarParser a -> a
innerParser (VarParser s -> s) -> Maybe (VarParser s) -> Maybe s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [(Text, VarParser s)] -> Maybe (VarParser s)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
n [(Text, VarParser s)]
self = [s -> [StyleTree s] -> StyleTree s
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree s
sty []]
| Bool
otherwise = []