{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.Preprocessor.Assets(StyleAssets(..), URIRewriter(..)) where
import Data.Text as Txt hiding (elem)
import Network.URI
import qualified Data.CSS.Syntax.StyleSheet as CSS
import qualified Data.CSS.Syntax.Tokens as CSSTok
import Data.List (nub, elem)
data StyleAssets = StyleAssets {
StyleAssets -> [Text]
filterProps :: [Txt.Text],
StyleAssets -> [URI]
assets :: [URI]
}
instance CSS.StyleSheet StyleAssets where
addRule :: StyleAssets -> StyleRule -> StyleAssets
addRule StyleAssets
self (CSS.StyleRule Selector
_ [(Text, [Token])]
props Text
_) =
[Text] -> [URI] -> StyleAssets
StyleAssets (StyleAssets -> [Text]
filterProps StyleAssets
self) ([URI] -> StyleAssets) -> [URI] -> StyleAssets
forall a b. (a -> b) -> a -> b
$ [URI] -> [URI]
forall a. Eq a => [a] -> [a]
nub (
StyleAssets -> [URI]
assets StyleAssets
self [URI] -> [URI] -> [URI]
forall a. [a] -> [a] -> [a]
++ [URI
uri | (Text
prop, [Token]
val) <- [(Text, [Token])]
props,
Text
prop Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` StyleAssets -> [Text]
filterProps StyleAssets
self,
CSSTok.Url Text
text <- [Token]
val,
Just URI
uri <- [String -> Maybe URI
parseAbsoluteURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
text]]
)
rewritePropertyVal :: [(URI, URI)] -> [CSSTok.Token] -> [CSSTok.Token]
rewritePropertyVal :: [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites (CSSTok.Url Text
text:[Token]
vals)
| Just URI
uri <- String -> Maybe URI
parseURIReference (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
Txt.unpack Text
text, Just URI
rewrite <- URI
uri URI -> [(URI, URI)] -> Maybe URI
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(URI, URI)]
rewrites =
Text -> Token
CSSTok.Url (String -> Text
Txt.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ (String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
rewrite String
"") Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites [Token]
vals
| Bool
otherwise = Text -> Token
CSSTok.Url Text
"" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites [Token]
vals
rewritePropertyVal [(URI, URI)]
rewrites (Token
val:[Token]
vals) = Token
valToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites [Token]
vals
rewritePropertyVal [(URI, URI)]
_ [] = []
data URIRewriter s = URIRewriter [(URI, URI)] s
instance CSS.StyleSheet s => CSS.StyleSheet (URIRewriter s) where
setPriority :: Int -> URIRewriter s -> URIRewriter s
setPriority Int
p (URIRewriter [(URI, URI)]
r s
s) = [(URI, URI)] -> s -> URIRewriter s
forall s. [(URI, URI)] -> s -> URIRewriter s
URIRewriter [(URI, URI)]
r (s -> URIRewriter s) -> s -> URIRewriter s
forall a b. (a -> b) -> a -> b
$ Int -> s -> s
forall s. StyleSheet s => Int -> s -> s
CSS.setPriority Int
p s
s
addRule :: URIRewriter s -> StyleRule -> URIRewriter s
addRule (URIRewriter [(URI, URI)]
r s
s) (CSS.StyleRule Selector
sel [(Text, [Token])]
props Text
psuedo) =
[(URI, URI)] -> s -> URIRewriter s
forall s. [(URI, URI)] -> s -> URIRewriter s
URIRewriter [(URI, URI)]
r (s -> URIRewriter s) -> s -> URIRewriter s
forall a b. (a -> b) -> a -> b
$ s -> StyleRule -> s
forall s. StyleSheet s => s -> StyleRule -> s
CSS.addRule s
s (StyleRule -> s) -> StyleRule -> s
forall a b. (a -> b) -> a -> b
$ Selector -> [(Text, [Token])] -> Text -> StyleRule
CSS.StyleRule Selector
sel [
(Text
prop, [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
r [Token]
val) | (Text
prop, [Token]
val) <- [(Text, [Token])]
props
] Text
psuedo
addAtRule :: URIRewriter s -> Text -> [Token] -> (URIRewriter s, [Token])
addAtRule (URIRewriter [(URI, URI)]
r s
s) Text
name [Token]
toks =
let (s
self', [Token]
toks') = s -> Text -> [Token] -> (s, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
CSS.addAtRule s
s Text
name [Token]
toks in ([(URI, URI)] -> s -> URIRewriter s
forall s. [(URI, URI)] -> s -> URIRewriter s
URIRewriter [(URI, URI)]
r s
self', [Token]
toks')