{-# LANGUAGE OverloadedStrings #-}
-- | Evaluates conditional CSS @rules.
-- Parse a CSS stylesheet to `ConditionalStyles` to evaluate @document & @supports rules.
-- Call `loadImports` to resolve any @import rules to @media rules.
-- And call `resolve` to convert into another `StyleSheet` instance whilst resolving @media rules.
module Data.CSS.Preprocessor.Conditions(
        ConditionalStyles(..), conditionalStyles, ConditionalRule(..),
        extractImports, resolveImports, loadImports, resolve, testIsStyled,
        Datum(..)
    ) where

import qualified Data.CSS.Preprocessor.Conditions.Expr as Query
import Data.CSS.Preprocessor.Conditions.Expr (Datum(..))

import Data.CSS.Syntax.StyleSheet
import Data.CSS.Syntax.Selector
import Data.CSS.Syntax.Tokens(Token(..))
import Data.CSS.Style (PropertyParser(..))
import Data.CSS.Syntax.AtLayer as AtLayer

import Data.Text.Internal (Text(..))
import Data.Text (unpack)
import Network.URI (URI(..), URIAuth(..), parseURI)
import Control.Concurrent.Async (forConcurrently)
import Text.Regex.TDFA ((=~))

import Data.List

-- | Collects and evaluates conditional at-rules.
data ConditionalStyles p = ConditionalStyles {
    -- | The URL to the webpage being styled, for `@document` rules.
    ConditionalStyles p -> URI
hostURL :: URI,
    -- | The type of document, `@document domain(...)` rules.
    ConditionalStyles p -> String
mediaDocument :: String,
    -- | Whether the page provided any of it's own styling (valid or not)
    ConditionalStyles p -> Bool
isUnstyled :: Bool,
    -- | Queued style rules, to be evaluated later.
    ConditionalStyles p -> [ConditionalRule p]
rules :: [ConditionalRule p],
    -- | PropertyParser to test against for `@supports` rules.
    ConditionalStyles p -> p
propertyParser :: p,
    -- | Known-named @layers.
    ConditionalStyles p -> Tree
layers :: AtLayer.Tree,
    -- | The current @layer, for resolving nesting
    ConditionalStyles p -> [Text]
layerNamespace :: [Text],
    -- | The integral path to the current @layer, for resolving nesting
    ConditionalStyles p -> [Int]
layerPath' :: [Int]
}

-- | Constructs an empty `ConditionalStyles`.
conditionalStyles :: PropertyParser p => URI -> String -> ConditionalStyles p
conditionalStyles :: URI -> String -> ConditionalStyles p
conditionalStyles uri :: URI
uri mediaDocument' :: String
mediaDocument' =
    URI
-> String
-> Bool
-> [ConditionalRule p]
-> p
-> Tree
-> [Text]
-> [Int]
-> ConditionalStyles p
forall p.
URI
-> String
-> Bool
-> [ConditionalRule p]
-> p
-> Tree
-> [Text]
-> [Int]
-> ConditionalStyles p
ConditionalStyles URI
uri String
mediaDocument' Bool
False [] p
forall a. PropertyParser a => a
temp Tree
AtLayer.emptyTree [] [0]

-- | Style rules that can be queued in a `ConditionalStyles`.
data ConditionalRule p = Priority [Int] | StyleRule' StyleRule | AtRule Text [Token] |
    External Query.Expr URI | Internal Query.Expr (ConditionalStyles p)

addRule' :: ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' :: ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' self :: ConditionalStyles p
self rule :: ConditionalRule p
rule = ConditionalStyles p
self {rules :: [ConditionalRule p]
rules = ConditionalRule p
rule ConditionalRule p -> [ConditionalRule p] -> [ConditionalRule p]
forall a. a -> [a] -> [a]
: ConditionalStyles p -> [ConditionalRule p]
forall p. ConditionalStyles p -> [ConditionalRule p]
rules ConditionalStyles p
self}

hostUrlS :: ConditionalStyles p -> String
hostUrlS :: ConditionalStyles p -> String
hostUrlS = URI -> String
forall a. Show a => a -> String
show (URI -> String)
-> (ConditionalStyles p -> URI) -> ConditionalStyles p -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConditionalStyles p -> URI
forall p. ConditionalStyles p -> URI
hostURL

parseAtBlock :: StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock :: t -> [Token] -> (t, [Token])
parseAtBlock self :: t
self (LeftCurlyBracket:toks :: [Token]
toks) =
    let (block :: [Token]
block, toks' :: [Token]
toks') = Parser [Token]
scanBlock [Token]
toks in (t -> [Token] -> t
forall t. StyleSheet t => t -> [Token] -> t
parse' t
self [Token]
block, [Token]
toks')
parseAtBlock self :: t
self (_:toks :: [Token]
toks) = t -> [Token] -> (t, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock t
self [Token]
toks
parseAtBlock self :: t
self [] = (t
self, [])

instance PropertyParser p => StyleSheet (ConditionalStyles p) where
    setPriorities :: [Int] -> ConditionalStyles p -> ConditionalStyles p
setPriorities x :: [Int]
x self :: ConditionalStyles p
self = ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
forall p.
ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' ConditionalStyles p
self { layerPath' :: [Int]
layerPath' = [Int]
x } (ConditionalRule p -> ConditionalStyles p)
-> ConditionalRule p -> ConditionalStyles p
forall a b. (a -> b) -> a -> b
$ [Int] -> ConditionalRule p
forall p. [Int] -> ConditionalRule p
Priority [Int]
x
    addRule :: ConditionalStyles p -> StyleRule -> ConditionalStyles p
addRule self :: ConditionalStyles p
self rule :: StyleRule
rule = ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
forall p.
ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' ConditionalStyles p
self (ConditionalRule p -> ConditionalStyles p)
-> ConditionalRule p -> ConditionalStyles p
forall a b. (a -> b) -> a -> b
$ StyleRule -> ConditionalRule p
forall p. StyleRule -> ConditionalRule p
StyleRule' StyleRule
rule

    addAtRule :: ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
addAtRule self :: ConditionalStyles p
self "document" (Whitespace:toks :: [Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    addAtRule self :: ConditionalStyles p
self "document" (Comma:toks :: [Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    addAtRule self :: ConditionalStyles p
self "document" (Url match :: Text
match:toks :: [Token]
toks)
        | Text -> String
unpack Text
match String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ConditionalStyles p -> String
forall p. ConditionalStyles p -> String
hostUrlS ConditionalStyles p
self = ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks
        | Bool
otherwise = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    addAtRule self :: ConditionalStyles p
self "document" (Function "url-prefix":String match :: Text
match:RightParen:toks :: [Token]
toks)
        | Text -> String
unpack Text
match String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ConditionalStyles p -> String
forall p. ConditionalStyles p -> String
hostUrlS ConditionalStyles p
self = ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks
        | Bool
otherwise = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    addAtRule self :: ConditionalStyles p
self "document" (Function "domain":String match :: Text
match:RightParen:toks :: [Token]
toks)
        | Text -> String
unpack Text
match String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
domain Bool -> Bool -> Bool
|| ('.'Char -> String -> String
forall a. a -> [a] -> [a]
:Text -> String
unpack Text
match) String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
domain =
            ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks
        | Bool
otherwise = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
        where
            domain :: String
domain | Just auth :: URIAuth
auth <- URI -> Maybe URIAuth
uriAuthority (URI -> Maybe URIAuth) -> URI -> Maybe URIAuth
forall a b. (a -> b) -> a -> b
$ ConditionalStyles p -> URI
forall p. ConditionalStyles p -> URI
hostURL ConditionalStyles p
self = URIAuth -> String
uriRegName URIAuth
auth
                | Bool
otherwise = ""
    addAtRule self :: ConditionalStyles p
self "document" (Function "media-document":String match :: Text
match:RightParen:toks :: [Token]
toks)
        | Text -> String
unpack Text
match String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== ConditionalStyles p -> String
forall p. ConditionalStyles p -> String
mediaDocument ConditionalStyles p
self = ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks
        | Bool
otherwise = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    -- Rhapsode-specific: matches if the document didn't provide any of it's own stylings.
    addAtRule self :: ConditionalStyles p
self "document" (Ident "unstyled":toks :: [Token]
toks)
        | ConditionalStyles p -> Bool
forall p. ConditionalStyles p -> Bool
isUnstyled ConditionalStyles p
self = ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks
        | Bool
otherwise = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    -- TODO Support regexp() conditions, requires new dependency
    addAtRule self :: ConditionalStyles p
self "document" (Function "regexp":String pattern :: Text
pattern:RightParen:toks :: [Token]
toks)
        | ConditionalStyles p -> String
forall p. ConditionalStyles p -> String
hostUrlS ConditionalStyles p
self String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text -> String
unpack Text
pattern = ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks
        | Bool
otherwise = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "document" [Token]
toks
    addAtRule self :: ConditionalStyles p
self "document" tokens :: [Token]
tokens = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
tokens)

    addAtRule self :: ConditionalStyles p
self "media" toks :: [Token]
toks
        | (cond :: Expr
cond, LeftCurlyBracket:block :: [Token]
block) <- Token -> [Token] -> (Expr, [Token])
Query.parse Token
LeftCurlyBracket [Token]
toks =
            let (block' :: [Token]
block', toks' :: [Token]
toks') = Parser [Token]
scanBlock [Token]
block in
                (ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
forall p.
ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' ConditionalStyles p
self (ConditionalRule p -> ConditionalStyles p)
-> ConditionalRule p -> ConditionalStyles p
forall a b. (a -> b) -> a -> b
$ Expr -> ConditionalStyles p -> ConditionalRule p
forall p. Expr -> ConditionalStyles p -> ConditionalRule p
Internal Expr
cond (ConditionalStyles p -> ConditionalRule p)
-> ConditionalStyles p -> ConditionalRule p
forall a b. (a -> b) -> a -> b
$ ConditionalStyles p -> [Token] -> ConditionalStyles p
forall t. StyleSheet t => t -> [Token] -> t
parse' ConditionalStyles p
self {rules :: [ConditionalRule p]
rules = []} [Token]
block', [Token]
toks')
    addAtRule self :: ConditionalStyles p
self "media" tokens :: [Token]
tokens = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
tokens)

    addAtRule self :: ConditionalStyles p
self "import" (Whitespace:toks :: [Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self "import" [Token]
toks
    addAtRule self :: ConditionalStyles p
self "import" (Url src :: Text
src:toks :: [Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport ConditionalStyles p
self Text
src [Token]
toks
    addAtRule self :: ConditionalStyles p
self "import" (String src :: Text
src:toks :: [Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport ConditionalStyles p
self Text
src [Token]
toks
    addAtRule self :: ConditionalStyles p
self "import" tokens :: [Token]
tokens = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
tokens)

    addAtRule self :: ConditionalStyles p
self "supports" toks :: [Token]
toks =
            let (cond :: [Token]
cond, toks' :: [Token]
toks') = (Token -> Bool) -> Parser [Token]
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
LeftCurlyBracket) [Token]
toks in
            if p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports (ConditionalStyles p -> p
forall p. ConditionalStyles p -> p
propertyParser ConditionalStyles p
self) [Token]
cond
                then ConditionalStyles p -> [Token] -> (ConditionalStyles p, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock ConditionalStyles p
self [Token]
toks' else (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
toks')

    addAtRule self :: ConditionalStyles p
self@ConditionalStyles { layers :: forall p. ConditionalStyles p -> Tree
layers = Tree
l, layerNamespace :: forall p. ConditionalStyles p -> [Text]
layerNamespace = [Text]
ns, layerPath' :: forall p. ConditionalStyles p -> [Int]
layerPath' = xs :: [Int]
xs@(x :: Int
x:_) }
            "layer" toks :: [Token]
toks =
        case [Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> ConditionalStyles p)
-> (Tree, Maybe (ConditionalStyles p), [Token])
forall s.
StyleSheet s =>
[Text]
-> [Token]
-> Tree
-> ([Text] -> [Int] -> s)
-> (Tree, Maybe s, [Token])
parseAtLayer [Text]
ns [Token]
toks Tree
l (([Text] -> [Int] -> ConditionalStyles p)
 -> (Tree, Maybe (ConditionalStyles p), [Token]))
-> ([Text] -> [Int] -> ConditionalStyles p)
-> (Tree, Maybe (ConditionalStyles p), [Token])
forall a b. (a -> b) -> a -> b
$ \ns' :: [Text]
ns' path' :: [Int]
path' -> [Int] -> ConditionalStyles p -> ConditionalStyles p
forall s. StyleSheet s => [Int] -> s -> s
setPriorities (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
path') ConditionalStyles p
self {
            layerNamespace :: [Text]
layerNamespace = [Text]
ns'
        } of
            (layers' :: Tree
layers', Just self' :: ConditionalStyles p
self', toks' :: [Token]
toks') ->
                ([Int] -> ConditionalStyles p -> ConditionalStyles p
forall s. StyleSheet s => [Int] -> s -> s
setPriorities [Int]
xs ConditionalStyles p
self { rules :: [ConditionalRule p]
rules = ConditionalStyles p -> [ConditionalRule p]
forall p. ConditionalStyles p -> [ConditionalRule p]
rules ConditionalStyles p
self', layers :: Tree
layers = Tree
layers' }, [Token]
toks')
            (layers' :: Tree
layers', Nothing, toks' :: [Token]
toks') -> ([Int] -> ConditionalStyles p -> ConditionalStyles p
forall s. StyleSheet s => [Int] -> s -> s
setPriorities [Int]
xs ConditionalStyles p
self { layers :: Tree
layers = Tree
layers' }, [Token]
toks')

    addAtRule self :: ConditionalStyles p
self rule :: Text
rule tokens :: [Token]
tokens = let (block :: [Token]
block, rest :: [Token]
rest) = Parser [Token]
scanAtRule [Token]
tokens in
        (ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
forall p.
ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' ConditionalStyles p
self (ConditionalRule p -> ConditionalStyles p)
-> ConditionalRule p -> ConditionalStyles p
forall a b. (a -> b) -> a -> b
$ Text -> [Token] -> ConditionalRule p
forall p. Text -> [Token] -> ConditionalRule p
AtRule Text
rule [Token]
block, [Token]
rest)

-- | Flags whether any style rules have been applied yet,
-- for the sake of evaluating "@document unstyled {...}".
testIsStyled :: ConditionalStyles p -> ConditionalStyles p
testIsStyled :: ConditionalStyles p -> ConditionalStyles p
testIsStyled styles :: ConditionalStyles p
styles = ConditionalStyles p
styles { isUnstyled :: Bool
isUnstyled = [ConditionalRule p] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ConditionalRule p] -> Bool) -> [ConditionalRule p] -> Bool
forall a b. (a -> b) -> a -> b
$ ConditionalStyles p -> [ConditionalRule p]
forall p. ConditionalStyles p -> [ConditionalRule p]
rules ConditionalStyles p
styles }

--------
---- @import/@media
--------
parseAtImport :: PropertyParser p => ConditionalStyles p -> Text ->
        [Token] -> (ConditionalStyles p, [Token])
parseAtImport :: ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport self :: ConditionalStyles p
self src :: Text
src (Whitespace:toks :: [Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport ConditionalStyles p
self Text
src [Token]
toks
parseAtImport self :: ConditionalStyles p
self src :: Text
src (Function "supports":toks :: [Token]
toks)
    | (cond :: [Token]
cond, RightParen:toks' :: [Token]
toks') <- (Token -> Bool) -> Parser [Token]
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
RightParen) [Token]
toks =
        if p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports (ConditionalStyles p -> p
forall p. ConditionalStyles p -> p
propertyParser ConditionalStyles p
self) [Token]
cond
            then ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport ConditionalStyles p
self Text
src [Token]
toks' else (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
toks')
parseAtImport self :: ConditionalStyles p
self@ConditionalStyles {  layerNamespace :: forall p. ConditionalStyles p -> [Text]
layerNamespace = [Text]
ns } src :: Text
src (Function "layer":toks :: [Token]
toks)
        | (layerToks :: [Token]
layerToks, RightParen:toks' :: [Token]
toks') <- (Token -> Bool) -> Parser [Token]
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
== Token
RightParen) [Token]
toks, [Token] -> Bool
validLayer [Token]
layerToks =
            ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
parseAtImportInLayer ConditionalStyles p
self Text
src ([Text]
ns [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
name | Ident name :: Text
name <- [Token]
layerToks]) [Token]
toks'
    where
        validLayer :: [Token] -> Bool
validLayer toks' :: [Token]
toks' = [Token] -> Bool
validLayer' (Char -> Token
Delim '.'Token -> [Token] -> [Token]
forall a. a -> [a] -> [a]
:(Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= Token
Whitespace) [Token]
toks')
        validLayer' :: [Token] -> Bool
validLayer' (Delim '.':Ident _:toks' :: [Token]
toks') = [Token] -> Bool
validLayer [Token]
toks'
        validLayer' [] = Bool
True
        validLayer' _ = Bool
False
parseAtImport self :: ConditionalStyles p
self@ConditionalStyles { layers :: forall p. ConditionalStyles p -> Tree
layers = Tree
l, layerNamespace :: forall p. ConditionalStyles p -> [Text]
layerNamespace = [Text]
ns } src :: Text
src (Ident "layer":toks :: [Token]
toks) =
        ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
parseAtImportInLayer ConditionalStyles p
self Text
src ([Text] -> Tree -> [Text]
uniqueName [Text]
ns Tree
l) [Token]
toks
parseAtImport self :: ConditionalStyles p
self src :: Text
src toks :: [Token]
toks
    | (cond :: Expr
cond, Semicolon:toks' :: [Token]
toks') <- Token -> [Token] -> (Expr, [Token])
Query.parse Token
Semicolon [Token]
toks, Just uri :: URI
uri <- String -> Maybe URI
parseURI (String -> Maybe URI) -> String -> Maybe URI
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack Text
src =
        (ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
forall p.
ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' ConditionalStyles p
self (ConditionalRule p -> ConditionalStyles p)
-> ConditionalRule p -> ConditionalStyles p
forall a b. (a -> b) -> a -> b
$ Expr -> URI -> ConditionalRule p
forall p. Expr -> URI -> ConditionalRule p
External Expr
cond URI
uri, [Token]
toks')
parseAtImport self :: ConditionalStyles p
self _ toks :: [Token]
toks = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
toks)

parseAtImportInLayer :: PropertyParser p => ConditionalStyles p -> Text -> [Text] ->
    [Token] -> (ConditionalStyles p, [Token])
parseAtImportInLayer :: ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
parseAtImportInLayer self :: ConditionalStyles p
self@ConditionalStyles {
        layers :: forall p. ConditionalStyles p -> Tree
layers = Tree
l, layerNamespace :: forall p. ConditionalStyles p -> [Text]
layerNamespace = [Text]
ns, layerPath' :: forall p. ConditionalStyles p -> [Int]
layerPath' = xs :: [Int]
xs@(x :: Int
x:_)
    } src :: Text
src layerName :: [Text]
layerName toks :: [Token]
toks =
        let (ret :: ConditionalStyles p
ret, toks' :: [Token]
toks') = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport ConditionalStyles p
self' Text
src [Token]
toks in ([Int] -> ConditionalStyles p -> ConditionalStyles p
forall s. StyleSheet s => [Int] -> s -> s
setPriorities [Int]
xs ConditionalStyles p
ret, [Token]
toks')
  where
    layers' :: Tree
layers' = [Text] -> Tree -> Tree
registerLayer [Text]
layerName Tree
l
    self' :: ConditionalStyles p
self' = [Int] -> ConditionalStyles p -> ConditionalStyles p
forall s. StyleSheet s => [Int] -> s -> s
setPriorities (Int
xInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Text] -> Tree -> [Int]
layerPath [Text]
layerName Tree
layers') ConditionalStyles p
self {
        layers :: Tree
layers = Tree
layers',
        layerNamespace :: [Text]
layerNamespace = [Text]
ns
    }
parseAtImportInLayer self :: ConditionalStyles p
self src :: Text
src layerName :: [Text]
layerName toks :: [Token]
toks = ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Text] -> [Token] -> (ConditionalStyles p, [Token])
parseAtImportInLayer ConditionalStyles p
self {
        layerPath' :: [Int]
layerPath' = [0]
    } Text
src [Text]
layerName [Token]
toks -- Shouldn't happen, recover gracefully.

-- | Returns `@import` URLs that need to be imported.
extractImports :: (Text -> Query.Datum) -> (Token -> Query.Datum) -> ConditionalStyles p -> [URI]
extractImports :: (Text -> Datum) -> (Token -> Datum) -> ConditionalStyles p -> [URI]
extractImports vars :: Text -> Datum
vars evalToken :: Token -> Datum
evalToken self :: ConditionalStyles p
self =
    [URI
uri | External cond :: Expr
cond uri :: URI
uri <- ConditionalStyles p -> [ConditionalRule p]
forall p. ConditionalStyles p -> [ConditionalRule p]
rules ConditionalStyles p
self, (Text -> Datum) -> (Token -> Datum) -> Expr -> Bool
Query.eval Text -> Datum
vars Token -> Datum
evalToken Expr
cond]

-- | Substitutes external values in for `@import` rules.
resolveImports :: ConditionalStyles p -> [(URI, ConditionalStyles p)] -> ConditionalStyles p
resolveImports :: ConditionalStyles p
-> [(URI, ConditionalStyles p)] -> ConditionalStyles p
resolveImports self :: ConditionalStyles p
self responses :: [(URI, ConditionalStyles p)]
responses = ConditionalStyles p
self {rules :: [ConditionalRule p]
rules = (ConditionalRule p -> ConditionalRule p)
-> [ConditionalRule p] -> [ConditionalRule p]
forall a b. (a -> b) -> [a] -> [b]
map ConditionalRule p -> ConditionalRule p
resolveImport ([ConditionalRule p] -> [ConditionalRule p])
-> [ConditionalRule p] -> [ConditionalRule p]
forall a b. (a -> b) -> a -> b
$ ConditionalStyles p -> [ConditionalRule p]
forall p. ConditionalStyles p -> [ConditionalRule p]
rules ConditionalStyles p
self}
    where
        resolveImport :: ConditionalRule p -> ConditionalRule p
resolveImport (External cond :: Expr
cond uri :: URI
uri) | (body :: ConditionalStyles p
body:_) <- [ConditionalStyles p
body | (uri' :: URI
uri', body :: ConditionalStyles p
body) <- [(URI, ConditionalStyles p)]
responses, URI
uri' URI -> URI -> Bool
forall a. Eq a => a -> a -> Bool
== URI
uri] =
            Expr -> ConditionalStyles p -> ConditionalRule p
forall p. Expr -> ConditionalStyles p -> ConditionalRule p
Internal Expr
cond ConditionalStyles p
body
        resolveImport x :: ConditionalRule p
x = ConditionalRule p
x

-- | Evaluates a given "loader" to resolve any `@import` rules.
loadImports :: PropertyParser p => (URI -> IO Text) -> (Text -> Query.Datum) -> (Token -> Query.Datum) ->
        ConditionalStyles p -> [URI] -> IO (ConditionalStyles p)
loadImports :: (URI -> IO Text)
-> (Text -> Datum)
-> (Token -> Datum)
-> ConditionalStyles p
-> [URI]
-> IO (ConditionalStyles p)
loadImports loader :: URI -> IO Text
loader vars :: Text -> Datum
vars evalToken :: Token -> Datum
evalToken self :: ConditionalStyles p
self blocklist :: [URI]
blocklist = do
        let imports :: [URI]
imports = (Text -> Datum) -> (Token -> Datum) -> ConditionalStyles p -> [URI]
forall p.
(Text -> Datum) -> (Token -> Datum) -> ConditionalStyles p -> [URI]
extractImports Text -> Datum
vars Token -> Datum
evalToken ConditionalStyles p
self
        let urls :: [URI]
urls = [URI
url | URI
url <- [URI]
imports, URI
url URI -> [URI] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [URI]
blocklist]
        [(URI, ConditionalStyles p)]
imported <- [URI]
-> (URI -> IO (URI, ConditionalStyles p))
-> IO [(URI, ConditionalStyles p)]
forall (t :: * -> *) a b.
Traversable t =>
t a -> (a -> IO b) -> IO (t b)
forConcurrently [URI]
urls ((URI -> IO (URI, ConditionalStyles p))
 -> IO [(URI, ConditionalStyles p)])
-> (URI -> IO (URI, ConditionalStyles p))
-> IO [(URI, ConditionalStyles p)]
forall a b. (a -> b) -> a -> b
$ \url :: URI
url -> do
            Text
source <- URI -> IO Text
loader URI
url
            let parsed :: ConditionalStyles p
parsed = ConditionalStyles p -> Text -> ConditionalStyles p
forall s. StyleSheet s => s -> Text -> s
parse ConditionalStyles p
self {rules :: [ConditionalRule p]
rules = []} Text
source
            ConditionalStyles p
styles <- (URI -> IO Text)
-> (Text -> Datum)
-> (Token -> Datum)
-> ConditionalStyles p
-> [URI]
-> IO (ConditionalStyles p)
forall p.
PropertyParser p =>
(URI -> IO Text)
-> (Text -> Datum)
-> (Token -> Datum)
-> ConditionalStyles p
-> [URI]
-> IO (ConditionalStyles p)
loadImports URI -> IO Text
loader Text -> Datum
vars Token -> Datum
evalToken ConditionalStyles p
parsed ([URI]
blocklist [URI] -> [URI] -> [URI]
forall a. [a] -> [a] -> [a]
++ [URI]
urls)
            (URI, ConditionalStyles p) -> IO (URI, ConditionalStyles p)
forall (m :: * -> *) a. Monad m => a -> m a
return (URI
url, ConditionalStyles p
styles)
        ConditionalStyles p -> IO (ConditionalStyles p)
forall (m :: * -> *) a. Monad m => a -> m a
return (ConditionalStyles p -> IO (ConditionalStyles p))
-> ConditionalStyles p -> IO (ConditionalStyles p)
forall a b. (a -> b) -> a -> b
$ ConditionalStyles p
-> [(URI, ConditionalStyles p)] -> ConditionalStyles p
forall p.
ConditionalStyles p
-> [(URI, ConditionalStyles p)] -> ConditionalStyles p
resolveImports ConditionalStyles p
self [(URI, ConditionalStyles p)]
imported

-- | Evaluates any media queries, returning a new StyleSheet with the queued operations.
resolve :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) ->
        s -> ConditionalStyles p -> s
resolve :: (Text -> Datum)
-> (Token -> Datum) -> s -> ConditionalStyles p -> s
resolve v :: Text -> Datum
v t :: Token -> Datum
t styles :: s
styles self :: ConditionalStyles p
self = (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t ([ConditionalRule p] -> [ConditionalRule p]
forall a. [a] -> [a]
reverse ([ConditionalRule p] -> [ConditionalRule p])
-> [ConditionalRule p] -> [ConditionalRule p]
forall a b. (a -> b) -> a -> b
$ ConditionalStyles p -> [ConditionalRule p]
forall p. ConditionalStyles p -> [ConditionalRule p]
rules ConditionalStyles p
self) s
styles
resolve' :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) ->
        [ConditionalRule p] -> s -> s
resolve' :: (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' v :: Text -> Datum
v t :: Token -> Datum
t (Priority x :: [Int]
x:rules' :: [ConditionalRule p]
rules') styles :: s
styles = (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t [ConditionalRule p]
rules' (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ [Int] -> s -> s
forall s. StyleSheet s => [Int] -> s -> s
setPriorities [Int]
x s
styles
resolve' v :: Text -> Datum
v t :: Token -> Datum
t (StyleRule' rule :: StyleRule
rule:rules' :: [ConditionalRule p]
rules') styles :: s
styles = (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t [ConditionalRule p]
rules' (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ s -> StyleRule -> s
forall s. StyleSheet s => s -> StyleRule -> s
addRule s
styles StyleRule
rule
resolve' v :: Text -> Datum
v t :: Token -> Datum
t (AtRule name :: Text
name block :: [Token]
block:rules' :: [ConditionalRule p]
rules') styles :: s
styles = (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t [ConditionalRule p]
rules' (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ (s, [Token]) -> s
forall a b. (a, b) -> a
fst ((s, [Token]) -> s) -> (s, [Token]) -> s
forall a b. (a -> b) -> a -> b
$ s -> Text -> [Token] -> (s, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule s
styles Text
name [Token]
block
resolve' v :: Text -> Datum
v t :: Token -> Datum
t (Internal cond :: Expr
cond block :: ConditionalStyles p
block:rules' :: [ConditionalRule p]
rules') styles :: s
styles | (Text -> Datum) -> (Token -> Datum) -> Expr -> Bool
Query.eval Text -> Datum
v Token -> Datum
t Expr
cond =
    (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t [ConditionalRule p]
rules' (s -> s) -> s -> s
forall a b. (a -> b) -> a -> b
$ (Text -> Datum)
-> (Token -> Datum) -> s -> ConditionalStyles p -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> s -> ConditionalStyles p -> s
resolve Text -> Datum
v Token -> Datum
t s
styles ConditionalStyles p
block
resolve' v :: Text -> Datum
v t :: Token -> Datum
t (_:rules' :: [ConditionalRule p]
rules') styles :: s
styles = (Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t [ConditionalRule p]
rules' s
styles
resolve' _ _ [] styles :: s
styles = s
styles

--------
---- @supports
--------

evalSupports :: PropertyParser p => p -> [Token] -> Bool
evalSupports :: p -> [Token] -> Bool
evalSupports self :: p
self (Whitespace:toks :: [Token]
toks) = p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks
evalSupports self :: p
self (Ident "not":toks :: [Token]
toks) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks
evalSupports self :: p
self (LeftParen:toks :: [Token]
toks) = let (block :: [Token]
block, toks' :: [Token]
toks') = Parser [Token]
scanBlock [Token]
toks in
    [Token] -> p -> Bool -> Bool
forall p. PropertyParser p => [Token] -> p -> Bool -> Bool
evalSupportsOp [Token]
toks' p
self (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Token] -> p -> Bool
forall p. PropertyParser p => [Token] -> p -> Bool
supportsProperty [Token]
block p
self
evalSupports self :: p
self (Function "selector":toks :: [Token]
toks) = let (block :: [Token]
block, toks' :: [Token]
toks') = Parser [Token]
scanBlock [Token]
toks in
    [Token] -> p -> Bool -> Bool
forall p. PropertyParser p => [Token] -> p -> Bool -> Bool
evalSupportsOp [Token]
toks' p
self (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Token] -> Bool
supportsSelector [Token]
block
evalSupports _ _ = Bool
False

evalSupportsOp :: PropertyParser p => [Token] -> p -> Bool -> Bool
evalSupportsOp :: [Token] -> p -> Bool -> Bool
evalSupportsOp (Whitespace:toks :: [Token]
toks) self :: p
self right :: Bool
right = [Token] -> p -> Bool -> Bool
forall p. PropertyParser p => [Token] -> p -> Bool -> Bool
evalSupportsOp [Token]
toks p
self Bool
right
evalSupportsOp (Ident "and":toks :: [Token]
toks) self :: p
self right :: Bool
right = Bool
right Bool -> Bool -> Bool
&& p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks
evalSupportsOp (Ident "or":toks :: [Token]
toks) self :: p
self right :: Bool
right = Bool
right Bool -> Bool -> Bool
|| p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks
evalSupportsOp [RightParen] _ ret :: Bool
ret = Bool
ret -- scanBlock captures closing paren
evalSupportsOp [] _ ret :: Bool
ret = Bool
ret
evalSupportsOp _ _ _ = Bool
False

supportsProperty :: PropertyParser p => [Token] -> p -> Bool
supportsProperty :: [Token] -> p -> Bool
supportsProperty (Whitespace:toks :: [Token]
toks) self :: p
self = [Token] -> p -> Bool
forall p. PropertyParser p => [Token] -> p -> Bool
supportsProperty [Token]
toks p
self
supportsProperty toks :: [Token]
toks@(Ident "not":_) self :: p
self = p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks -- Special case fallback
supportsProperty (Ident key :: Text
key:toks :: [Token]
toks) self :: p
self
    | (Colon:value :: [Token]
value) <- [Token] -> [Token]
skipSpace [Token]
toks = -- "init"'s used to strip trailing RightParen
        p -> Text -> [Token] -> [(Text, [Token])]
forall a.
PropertyParser a =>
a -> Text -> [Token] -> [(Text, [Token])]
shorthand p
self Text
key ((Token -> Bool) -> [Token] -> [Token]
forall a. (a -> Bool) -> [a] -> [a]
filter (Token -> Token -> Bool
forall a. Eq a => a -> a -> Bool
/= Token
Whitespace) ([Token] -> [Token]) -> [Token] -> [Token]
forall a b. (a -> b) -> a -> b
$ [Token] -> [Token]
forall a. [a] -> [a]
init [Token]
value) [(Text, [Token])] -> [(Text, [Token])] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
    | [Token] -> [Token]
skipSpace [Token]
toks [Token] -> [[Token]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [[Token
RightParen], []] = p -> Text -> [Token] -> [(Text, [Token])]
forall a.
PropertyParser a =>
a -> Text -> [Token] -> [(Text, [Token])]
shorthand p
self Text
key [Text -> Token
Ident "initial"] [(Text, [Token])] -> [(Text, [Token])] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
    | Bool
otherwise = Bool
False
supportsProperty toks :: [Token]
toks self :: p
self = p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks -- Fallback to parenthesized expression.

supportsSelector :: [Token] -> Bool
supportsSelector :: [Token] -> Bool
supportsSelector toks :: [Token]
toks = let (sels :: [Selector]
sels, toks' :: [Token]
toks') = Parser [Selector]
parseSelectors [Token]
toks in
    [Selector]
sels [Selector] -> [Selector] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& ([Token]
toks' [Token] -> [Token] -> Bool
forall a. Eq a => a -> a -> Bool
== [] Bool -> Bool -> Bool
|| [Token]
toks' [Token] -> [Token] -> Bool
forall a. Eq a => a -> a -> Bool
== [Token
RightParen])