{-# LANGUAGE OverloadedStrings #-}
module Data.CSS.Preprocessor.Conditions(
ConditionalStyles(..)
) where
import Data.CSS.Syntax.StyleSheet
import Data.CSS.Syntax.Tokens(Token(..))
import Data.Text (unpack)
import Network.URI (URI(..), URIAuth(..))
data ConditionalStyles s = ConditionalStyles {
hostURL :: URI,
mediaDocument :: String,
inner :: s
}
hostUrlS = show . hostURL
parseAtBlock self (LeftCurlyBracket:toks) =
let (block, toks') = scanBlock toks in (parse' self block, toks')
parseAtBlock self (_:toks) = parseAtBlock self toks
parseAtBlock self [] = (self, [])
instance StyleSheet ConditionalStyles where
setPriority x self = self {inner = setPriority x $ inner self}
addRule self rule = self {inner = addRule (inner self) rule}
addAtRule self "document" (Comma:toks) = addAtRule self "document" toks
addAtRule self "document" (Url match:toks) | unpack match == hostUrlS self =
parseAtBlock self toks
addAtRule self "document" (Function "url-prefix":String match:RightParen:toks) =
| unpack match `isPrefixOf` hostUrlS self = parseAtBlock self toks
addAtRule self "document" (Function "domain":String match:RightParen:toks)
| unpack match == domain || ('.':unpack match) `isSuffixOf` domain =
parseAtBlock self toks
where
domain | Just auth <- uriAuthority $ hostURL self = uriRegName auth
| otherwise = ""
addAtRule self "document" (Function "media-document":String match:RightParen:toks) =
| unpack match == mediaDocument self = parseAtBlock self toks
-- TODO Support regexp() conditions, requires new dependency
addAtRule self "document" tokens = (self, skipAtRule tokens)
addAtRule self rule tokens =
let (self', tokens') = addAtRule (inner self) rule tokens in (self {inner = self'}, tokens')