{-# 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 :: 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' :: QueryableStyleSheet s
-> Maybe [(Text, s)] -> Maybe [(Text, s)] -> Element -> [(Text, s)]
stylize' stylesheet :: QueryableStyleSheet s
stylesheet parent' :: Maybe [(Text, s)]
parent' _ el :: Element
el = ("", 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) | (k :: Text
k, v :: [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, 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 "style" _ val :: String
val <- Element -> [Attribute]
attributes Element
el]
inlinePseudos :: PropertyParser s => StyleTree [(Text, VarParser s)] -> StyleTree s
inlinePseudos :: StyleTree [(Text, VarParser s)] -> StyleTree s
inlinePseudos (StyleTree self :: [(Text, VarParser s)]
self childs :: [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, VarParser s)]
self,
children :: [StyleTree s]
children = Text -> [StyleTree s]
pseudo "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 "after"
} where
pseudo :: Text -> [StyleTree s]
pseudo n :: Text
n
| Just sty :: 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 style' :: s
style' <- s -> s -> Text -> [Token] -> Maybe s
forall a. PropertyParser a => a -> a -> Text -> [Token] -> Maybe a
longhand s
sty s
sty "::" [Text -> Token
Ident Text
n] = [s -> [StyleTree s] -> StyleTree s
forall p. p -> [StyleTree p] -> StyleTree p
StyleTree s
style' []]
| Just sty :: 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 = []