4 files changed, 102 insertions(+), 17 deletions(-)

M src/Data/CSS/Preprocessor/Conditions.hs
M src/Data/CSS/Preprocessor/Conditions/Expr.hs
M stylist.cabal
M test/Test.hs

@@ 1,10 1,12 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Data.CSS.Preprocessor.Conditions(
         ConditionalStyles(..), conditionalStyles,
-        extractImports, resolveImports, resolve
+        extractImports, resolveImports, loadImports, resolve,
+        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


@@ 25,7 27,7 @@ data ConditionalStyles p = ConditionalStyles {
 }
 
 conditionalStyles :: PropertyParser p => URI -> String -> ConditionalStyles p
-conditionalStyles uri mediaDocument = ConditionalStyles uri mediaDocument [] temp
+conditionalStyles uri mediaDocument' = ConditionalStyles uri mediaDocument' [] temp
 
 data ConditionalRule p = Priority Int | StyleRule' StyleRule | AtRule Text [Token] |
     External Query.Expr URI | Internal Query.Expr (ConditionalStyles p)


@@ 106,17 108,33 @@ resolveImports self responses = self {rules = map resolveImport $ rules self}
             Internal cond body
         resolveImport x = x
 
+loadImports :: PropertyParser p => (URI -> IO Text) -> (Text -> Query.Datum) -> (Token -> Query.Datum) ->
+        ConditionalStyles p -> [URI] -> IO (ConditionalStyles p)
+loadImports loader vars evalToken self blocklist = do
+        let imports = extractImports vars evalToken self
+        imported <- loadAll [url | url <- imports, url `notElem` blocklist] Nothing
+        return $ resolveImports self imported
+    where
+        loadAll urls Nothing = loadAll urls $ Just urls
+        loadAll (url:urls) (Just blocklist') = do
+            source <- loader url
+            let parsed = parse self {rules = []} source
+            styles <- loadImports loader vars evalToken parsed (blocklist ++ blocklist')
+            rest <- loadAll urls $ Just blocklist'
+            return ((url, styles):rest)
+        loadAll [] _ = return []
+
 resolve :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) ->
         s -> ConditionalStyles p -> s
 resolve v t styles self = resolve' v t (reverse $ rules self) styles
 resolve' :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) ->
         [ConditionalRule p] -> s -> s
-resolve' v t (Priority x:rules) styles = resolve' v t rules $ setPriority x styles
-resolve' v t (StyleRule' rule:rules) styles = resolve' v t rules $ addRule styles rule
-resolve' v t (AtRule name block:rules) styles = resolve' v t rules $ fst $ addAtRule styles name block
-resolve' v t (Internal cond block:rules) styles | Query.eval v t cond =
-    resolve' v t rules $ resolve v t styles block
-resolve' v t (_:rules) styles = resolve' v t rules styles
+resolve' v t (Priority x:rules') styles = resolve' v t rules' $ setPriority x styles
+resolve' v t (StyleRule' rule:rules') styles = resolve' v t rules' $ addRule styles rule
+resolve' v t (AtRule name block:rules') styles = resolve' v t rules' $ fst $ addAtRule styles name block
+resolve' v t (Internal cond block:rules') styles | Query.eval v t cond =
+    resolve' v t rules' $ resolve v t styles block
+resolve' v t (_:rules') styles = resolve' v t rules' styles
 resolve' _ _ [] styles = styles
 
 --------

@@ 1,6 1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Data.CSS.Preprocessor.Conditions.Expr(
-        Expr, Op(..), parse, eval, Datum(..)
+        Expr, Op(..), parse, parse', eval, Datum(..)
     ) where
 
 import Data.CSS.Syntax.Tokens(Token(..))


@@ 9,7 9,7 @@ import Data.Text (stripPrefix)
 
 type Expr = [Op]
 data Op = And | Or | Not | Var Text | Tok Token | MkRatio | Func Text [Token]
-    | Less | LessEq | Equal | Greater | GreaterEq deriving Eq
+    | Less | LessEq | Equal | Greater | GreaterEq deriving (Show, Eq)
 
 parse :: Token -> [Token] -> (Expr, [Token])
 parse end toks = let (toks', rest) = break (== end) toks in (parse' toks' [], rest)


@@ 27,7 27,7 @@ parse' (Ident "only":toks) ops = parse' toks ops
 parse' (Ident "and":toks) ops = pushOp toks And 30 ops
 parse' (Ident "or":toks) ops = pushOp toks Or 30 ops
 parse' (Delim '<':Delim '=':toks) ops = pushOp toks LessEq 40 ops
-parse' (Delim '<':toks) ops = pushOp toks LessEq 40 ops
+parse' (Delim '<':toks) ops = pushOp toks Less 40 ops
 parse' (Delim '>':Delim '=':toks) ops = pushOp toks GreaterEq 40 ops
 parse' (Delim '>':toks) ops = pushOp toks Greater 40 ops
 parse' (Colon:tok:toks) ops = Tok tok : pushOp toks Equal 40 ops


@@ 65,7 65,9 @@ eval' (B y:B x:stack) v t (And:ops) = eval' (B (x && y):stack) v t ops
 eval' (B y:B x:stack) v t (Or:ops) = eval' (B (x || y):stack) v t ops
 eval' (B x:stack) v t (Not:ops) = eval' (B (not x):stack) v t ops
 eval' stack v t (Var name:ops) = eval' (v name:stack) v t ops
-eval' stack v t (Tok tok:ops) = eval' (t tok:stack) v t ops
+-- Have tokens lower to variables, to make things easier for the callee.
+eval' stack v t (Tok tok:ops) | t tok /= B False = eval' (t tok:stack) v t ops
+eval' stack v t (Tok (Ident name):ops) = eval' (v name:stack) v t ops
 -- TODO: How should I handle ratios?
 eval' (N y:N x:stack) v t (MkRatio:ops) = eval' (Ratio x y:stack) v t ops
 eval' (N y:N x:stack) v t (Less:ops) = eval' (B (x < y):stack) v t ops

@@ 85,5 85,6 @@ test-suite test-stylist
   other-modules:        Data.CSS.Syntax.StyleSheet, Data.CSS.Syntax.Selector, Data.CSS.Style
   build-depends:       base >=4.9 && <4.10, css-syntax >=0.1 && <0.2, text,
                         unordered-containers >= 0.2 && <0.3, hashable,
-                        network-uri >= 2.6 && <2.7, hspec, QuickCheck
+                        network-uri >= 2.6 && <2.7, hspec, QuickCheck,
+                        scientific >= 0.3 && <1.0
   ghc-options: -Wall

@@ 5,9 5,10 @@ import Test.Hspec
 import Data.HashMap.Strict
 import Data.Maybe (fromJust)
 import Network.URI
+import Data.Scientific (toRealFloat)
 
 import Data.CSS.Syntax.Tokens
-import Data.CSS.Syntax.StyleSheet
+import Data.CSS.Syntax.StyleSheet (parse, StyleSheet(..), TrivialStyleSheet(..), scanAtRule, scanValue)
 import Data.CSS.Syntax.Selector
 
 import Data.CSS.Style.Common


@@ 16,7 17,7 @@ import Data.CSS.Style.Selector.Interpret
 import Data.CSS.Style
 
 import Data.CSS.Preprocessor.Conditions
-import Data.CSS.Preprocessor.Conditions.Expr (Datum(..))
+import Data.CSS.Preprocessor.Conditions.Expr (Datum(..), Op(..), parse', eval)
 
 main :: IO ()
 main = hspec spec


@@ 360,7 361,7 @@ spec = do
             vars `shouldBe` [("--link", [Hash HId "f00"])]
             style ! "color" `shouldBe` [Hash HId "f00"]
     describe "Conditional @rules" $ do
-        it "can handle normal rules" $ do
+        it "handles normal rules" $ do
             let TrivialStyleSheet styles = resolve' $ parse conditional "a {color: green}"
             styles `shouldBe` [StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
 


@@ 375,6 376,60 @@ spec = do
 
             let TrivialStyleSheet styles = resolve' $ parse conditional "@font {} a {color: green}"
             styles `shouldBe` [StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+        it "handles @document" $ do
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@document url(about:blank) { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@document url(about:credits) { a {color: red} }"
+            styles `shouldBe` []
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@document url-prefix('about:') { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@document url-prefix('https:') { a {color: red} }"
+            styles `shouldBe` []
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@document media-document('test') { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@document media-document('other') { a {color: red} }"
+            styles `shouldBe` []
+        it "handles @media" $ do
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media test { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media screen { a {color: red} }"
+            styles `shouldBe` []
+
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media test or screen { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media test or test {a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media screen or screen {a {color: red} }"
+            styles `shouldBe` []
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media screen or test {a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media test and screen { a {color: red} }"
+            styles `shouldBe` []
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media test and test { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media screen and screen { a {color: red} }"
+            styles `shouldBe` []
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media screen and test {a {color: red} }"
+            styles `shouldBe` []
+
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media 2 < 3 { a {color: green} }"
+            styles `shouldBe` [StyleRule (Element []) [] "", StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""]
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media 2 < 2 { a {color: red} }"
+            styles `shouldBe` []
+            let TrivialStyleSheet styles = resolve' $ parse conditional "@media 2 < 1 { a {color: red} }"
+            styles `shouldBe` []
+        it "handles @import" $ do
+            let styles = parse conditional "@import url(about:style.css);"
+            extractImports' styles `shouldBe` [URI "about:" Nothing "style.css" "" ""]
+            let styles = parse conditional "@import 'about:style.css';"
+            extractImports' styles `shouldBe` [URI "about:" Nothing "style.css" "" ""]
+
+            let styles = parse conditional "@import url(about:style.css) test;"
+            extractImports' styles `shouldBe` [URI "about:" Nothing "style.css" "" ""]
+            let styles = parse conditional "@import url(about:style.css) screen;"
+            extractImports' styles `shouldBe` []
+        -- TODO @supports is harder to test
 
 styleIndex :: StyleIndex
 styleIndex = new


@@ 388,4 443,13 @@ linkStyle :: TrivialStyleSheet
 linkStyle = TrivialStyleSheet [sampleRule]
 sampleRule :: StyleRule
 sampleRule = StyleRule (Element [Tag "a"]) [("color", [Ident "green"])] ""
-resolve' = resolve (\_ -> B False) (\_ -> B False) emptyStyle
+resolve' = resolve (\var -> B (var == "test")) evalToken emptyStyle
+    where
+        evalToken (Number _ (NVInteger x)) = N $ fromInteger x
+        evalToken (Number _ (NVNumber x)) = N $ toRealFloat x
+        evalToken _ = B False
+extractImports' = extractImports (\var -> B (var == "test")) evalToken
+    where
+        evalToken (Number _ (NVInteger x)) = N $ fromInteger x
+        evalToken (Number _ (NVNumber x)) = N $ toRealFloat x
+        evalToken _ = B False