{-# 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.
    forall p. ConditionalStyles p -> URI
hostURL :: URI,
    -- | The type of document, `@document domain(...)` rules.
    forall p. ConditionalStyles p -> String
mediaDocument :: String,
    -- | Whether the page provided any of it's own styling (valid or not)
    forall p. ConditionalStyles p -> Bool
isUnstyled :: Bool,
    -- | Queued style rules, to be evaluated later.
    forall p. ConditionalStyles p -> [ConditionalRule p]
rules :: [ConditionalRule p],
    -- | PropertyParser to test against for `@supports` rules.
    forall p. ConditionalStyles p -> p
propertyParser :: p,
    -- | Known-named @layers.
    forall p. ConditionalStyles p -> Tree
layers :: AtLayer.Tree,
    -- | The current @layer, for resolving nesting
    forall p. ConditionalStyles p -> [Text]
layerNamespace :: [Text],
    -- | The integral path to the current @layer, for resolving nesting
    forall p. ConditionalStyles p -> [Int]
layerPath' :: [Int]
}

-- | Constructs an empty `ConditionalStyles`.
conditionalStyles :: PropertyParser p => URI -> String -> ConditionalStyles p
conditionalStyles :: forall p. PropertyParser p => URI -> String -> ConditionalStyles p
conditionalStyles URI
uri 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 [] [Int
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' :: forall p.
ConditionalStyles p -> ConditionalRule p -> ConditionalStyles p
addRule' ConditionalStyles p
self 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 :: forall p. 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 :: forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock t
self (Token
LeftCurlyBracket:[Token]
toks) =
    let ([Token]
block, [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 t
self (Token
_:[Token]
toks) = t -> [Token] -> (t, [Token])
forall t. StyleSheet t => t -> [Token] -> (t, [Token])
parseAtBlock t
self [Token]
toks
parseAtBlock t
self [] = (t
self, [])

instance PropertyParser p => StyleSheet (ConditionalStyles p) where
    setPriorities :: [Int] -> ConditionalStyles p -> ConditionalStyles p
setPriorities [Int]
x 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 ConditionalStyles p
self 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 ConditionalStyles p
self Text
"document" (Token
Whitespace:[Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self Text
"document" [Token]
toks
    addAtRule ConditionalStyles p
self Text
"document" (Token
Comma:[Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self Text
"document" [Token]
toks
    addAtRule ConditionalStyles p
self Text
"document" (Url Text
match:[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 Text
"document" [Token]
toks
    addAtRule ConditionalStyles p
self Text
"document" (Function Text
"url-prefix":String Text
match:Token
RightParen:[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 Text
"document" [Token]
toks
    addAtRule ConditionalStyles p
self Text
"document" (Function Text
"domain":String Text
match:Token
RightParen:[Token]
toks)
        | Text -> String
unpack Text
match String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
domain Bool -> Bool -> Bool
|| (Char
'.'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 Text
"document" [Token]
toks
        where
            domain :: String
domain | Just 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 = String
""
    addAtRule ConditionalStyles p
self Text
"document" (Function Text
"media-document":String Text
match:Token
RightParen:[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 Text
"document" [Token]
toks
    -- Rhapsode-specific: matches if the document didn't provide any of it's own stylings.
    addAtRule ConditionalStyles p
self Text
"document" (Ident Text
"unstyled":[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 Text
"document" [Token]
toks
    -- TODO Support regexp() conditions, requires new dependency
    addAtRule ConditionalStyles p
self Text
"document" (Function Text
"regexp":String Text
pattern:Token
RightParen:[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 Text
"document" [Token]
toks
    addAtRule ConditionalStyles p
self Text
"document" [Token]
tokens = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
tokens)

    addAtRule ConditionalStyles p
self Text
"media" [Token]
toks
        | (Expr
cond, Token
LeftCurlyBracket:[Token]
block) <- Token -> [Token] -> (Expr, [Token])
Query.parse Token
LeftCurlyBracket [Token]
toks =
            let ([Token]
block', [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 ConditionalStyles p
self Text
"media" [Token]
tokens = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
tokens)

    addAtRule ConditionalStyles p
self Text
"import" (Token
Whitespace:[Token]
toks) = ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
forall s. StyleSheet s => s -> Text -> [Token] -> (s, [Token])
addAtRule ConditionalStyles p
self Text
"import" [Token]
toks
    addAtRule ConditionalStyles p
self Text
"import" (Url Text
src:[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 ConditionalStyles p
self Text
"import" (String Text
src:[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 ConditionalStyles p
self Text
"import" [Token]
tokens = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
tokens)

    addAtRule ConditionalStyles p
self Text
"supports" [Token]
toks =
            let ([Token]
cond, [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@(Int
x:[Int]
_) }
            Text
"layer" [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
$ \[Text]
ns' [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
            (Tree
layers', Just ConditionalStyles p
self', [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')
            (Tree
layers', Maybe (ConditionalStyles p)
Nothing, [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 ConditionalStyles p
self Text
rule [Token]
tokens = let ([Token]
block, [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 :: forall p. ConditionalStyles p -> ConditionalStyles p
testIsStyled 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 :: forall p.
PropertyParser p =>
ConditionalStyles p
-> Text -> [Token] -> (ConditionalStyles p, [Token])
parseAtImport ConditionalStyles p
self Text
src (Token
Whitespace:[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 ConditionalStyles p
self Text
src (Function Text
"supports":[Token]
toks)
    | ([Token]
cond, Token
RightParen:[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 } Text
src (Function Text
"layer":[Token]
toks)
        | ([Token]
layerToks, Token
RightParen:[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 Text
name <- [Token]
layerToks]) [Token]
toks'
    where
        validLayer :: [Token] -> Bool
validLayer [Token]
toks' = [Token] -> Bool
validLayer' (Char -> Token
Delim Char
'.'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 Char
'.':Ident Text
_:[Token]
toks') = [Token] -> Bool
validLayer [Token]
toks'
        validLayer' [] = Bool
True
        validLayer' [Token]
_ = 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 } Text
src (Ident Text
"layer":[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 ConditionalStyles p
self Text
src [Token]
toks
    | (Expr
cond, Token
Semicolon:[Token]
toks') <- Token -> [Token] -> (Expr, [Token])
Query.parse Token
Semicolon [Token]
toks, Just 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 ConditionalStyles p
self Text
_ [Token]
toks = (ConditionalStyles p
self, [Token] -> [Token]
skipAtRule [Token]
toks)

parseAtImportInLayer :: PropertyParser p => ConditionalStyles p -> Text -> [Text] ->
    [Token] -> (ConditionalStyles p, [Token])
parseAtImportInLayer :: forall p.
PropertyParser p =>
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@(Int
x:[Int]
_)
    } Text
src [Text]
layerName [Token]
toks =
        let (ConditionalStyles p
ret, [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 ConditionalStyles p
self Text
src [Text]
layerName [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' = [Int
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 :: forall p.
(Text -> Datum) -> (Token -> Datum) -> ConditionalStyles p -> [URI]
extractImports Text -> Datum
vars Token -> Datum
evalToken ConditionalStyles p
self =
    [URI
uri | External Expr
cond 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 :: forall p.
ConditionalStyles p
-> [(URI, ConditionalStyles p)] -> ConditionalStyles p
resolveImports ConditionalStyles p
self [(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 Expr
cond URI
uri) | (ConditionalStyles p
body:[ConditionalStyles p]
_) <- [ConditionalStyles p
body | (URI
uri', 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 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 :: 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
self [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
$ \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 :: forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> s -> ConditionalStyles p -> s
resolve Text -> Datum
v Token -> Datum
t s
styles 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' :: forall s p.
StyleSheet s =>
(Text -> Datum)
-> (Token -> Datum) -> [ConditionalRule p] -> s -> s
resolve' Text -> Datum
v Token -> Datum
t (Priority [Int]
x:[ConditionalRule p]
rules') 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' Text -> Datum
v Token -> Datum
t (StyleRule' StyleRule
rule:[ConditionalRule p]
rules') 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' Text -> Datum
v Token -> Datum
t (AtRule Text
name [Token]
block:[ConditionalRule p]
rules') 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' Text -> Datum
v Token -> Datum
t (Internal Expr
cond ConditionalStyles p
block:[ConditionalRule p]
rules') 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' Text -> Datum
v Token -> Datum
t (ConditionalRule p
_:[ConditionalRule p]
rules') 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' Text -> Datum
_ Token -> Datum
_ [] s
styles = s
styles

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

evalSupports :: PropertyParser p => p -> [Token] -> Bool
evalSupports :: forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self (Token
Whitespace:[Token]
toks) = p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks
evalSupports p
self (Ident Text
"not":[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 p
self (Token
LeftParen:[Token]
toks) = let ([Token]
block, [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 p
self (Function Text
"selector":[Token]
toks) = let ([Token]
block, [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 p
_ [Token]
_ = Bool
False

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

supportsProperty :: PropertyParser p => [Token] -> p -> Bool
supportsProperty :: forall p. PropertyParser p => [Token] -> p -> Bool
supportsProperty (Token
Whitespace:[Token]
toks) p
self = [Token] -> p -> Bool
forall p. PropertyParser p => [Token] -> p -> Bool
supportsProperty [Token]
toks p
self
supportsProperty toks :: [Token]
toks@(Ident Text
"not":[Token]
_) p
self = p -> [Token] -> Bool
forall p. PropertyParser p => p -> [Token] -> Bool
evalSupports p
self [Token]
toks -- Special case fallback
supportsProperty (Ident Text
key:[Token]
toks) p
self
    | (Token
Colon:[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 Text
"initial"] [(Text, [Token])] -> [(Text, [Token])] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
    | Bool
otherwise = Bool
False
supportsProperty [Token]
toks 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 [Token]
toks = let ([Selector]
sels, [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])