{-# LANGUAGE OverloadedStrings #-}
-- | Utilities for rewriting URLs referenced via CSS properties.
module Data.CSS.Preprocessor.Assets(StyleAssets(..), URIRewriter(..)) where

-- TODO Unit test!
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)

-- | Extracts referenced URLs from specified properties.
data StyleAssets = StyleAssets {
    -- | The properties from which to extract URLs.
    StyleAssets -> [Text]
filterProps :: [Txt.Text],
    -- | The extracted URLs.
    StyleAssets -> [URI]
assets :: [URI]
}

instance CSS.StyleSheet StyleAssets where
    addRule :: StyleAssets -> StyleRule -> StyleAssets
addRule self :: StyleAssets
self (CSS.StyleRule _ props :: [(Text, [Token])]
props _) =
        [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 | (prop :: Text
prop, val :: [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
text <- [Token]
val,
                    Just uri :: 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]]
            )


-- | Substitutes in given URLs into a property value.
rewritePropertyVal :: [(URI, URI)] -> [CSSTok.Token] -> [CSSTok.Token] 
rewritePropertyVal :: [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal rewrites :: [(URI, URI)]
rewrites (CSSTok.Url text :: Text
text:vals :: [Token]
vals)
    | Just uri :: 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 rewrite :: 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 "") Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites [Token]
vals
    | Bool
otherwise = Text -> Token
CSSTok.Url "" Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
: [(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites [Token]
vals
rewritePropertyVal rewrites :: [(URI, URI)]
rewrites (val :: Token
val:vals :: [Token]
vals) = Token
valToken -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:[(URI, URI)] -> [Token] -> [Token]
rewritePropertyVal [(URI, URI)]
rewrites [Token]
vals
rewritePropertyVal _ [] = []

-- | Substitutes in given URLs into the inner stylesheet being parsed.
data URIRewriter s = URIRewriter [(URI, URI)] s
instance CSS.StyleSheet s => CSS.StyleSheet (URIRewriter s) where
    setPriority :: Int -> URIRewriter s -> URIRewriter s
setPriority p :: Int
p (URIRewriter r :: [(URI, URI)]
r s :: 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 r :: [(URI, URI)]
r s :: s
s) (CSS.StyleRule sel :: Selector
sel props :: [(Text, [Token])]
props psuedo :: 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) | (prop :: Text
prop, val :: [Token]
val) <- [(Text, [Token])]
props
        ] Text
psuedo
    addAtRule :: URIRewriter s -> Text -> [Token] -> (URIRewriter s, [Token])
addAtRule (URIRewriter r :: [(URI, URI)]
r s :: s
s) name :: Text
name toks :: [Token]
toks =
        let (self' :: s
self', toks' :: [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')