From 2bb6ba1d247f41ea07255b8061702afc40b9ad69 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Tue, 10 Sep 2019 12:19:00 +1200 Subject: [PATCH] Draft interpretor for @supports. --- src/Data/CSS/Preprocessor/Conditions.hs | 63 ++++++++++++++++---- src/Data/CSS/Preprocessor/Conditions/Expr.hs | 4 -- src/Data/CSS/Syntax/StyleSheet.hs | 2 +- 3 files changed, 51 insertions(+), 18 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Conditions.hs b/src/Data/CSS/Preprocessor/Conditions.hs index b323972..0205f6a 100644 --- a/src/Data/CSS/Preprocessor/Conditions.hs +++ b/src/Data/CSS/Preprocessor/Conditions.hs @@ -4,9 +4,12 @@ module Data.CSS.Preprocessor.Conditions( ) where import qualified Data.CSS.Preprocessor.Conditions.Expr as Query +import Data.CSS.Preprocessor.Conditions.Expr (Op(..)) import Data.CSS.Syntax.StyleSheet +import Data.CSS.Syntax.Selector import Data.CSS.Syntax.Tokens(Token(..)) +import Data.CSS.Style (PropertyParser(..)) import Data.Text.Internal (Text(..)) import Data.Text (unpack) @@ -14,16 +17,17 @@ import Network.URI (URI(..), URIAuth(..), parseURI) import Data.List -data ConditionalStyles s = ConditionalStyles { +data ConditionalStyles s p = ConditionalStyles { hostURL :: URI, mediaDocument :: String, inner :: s, - conditions :: [(Query.Expr, StyleRef)] + conditions :: [(Query.Expr, StyleRef)], + propertyParser :: p } data StyleRef = External URI | Internal [Token] deriving Eq -hostUrlS :: ConditionalStyles s -> String +hostUrlS :: ConditionalStyles s p -> String hostUrlS = show . hostURL parseAtBlock :: StyleSheet t => t -> [Token] -> (t, [Token]) @@ -32,7 +36,7 @@ parseAtBlock self (LeftCurlyBracket:toks) = parseAtBlock self (_:toks) = parseAtBlock self toks parseAtBlock self [] = (self, []) -instance StyleSheet s => StyleSheet (ConditionalStyles s) where +instance (StyleSheet s, PropertyParser p) => StyleSheet (ConditionalStyles s p) where setPriority x self = self {inner = setPriority x $ inner self} addRule self rule = self {inner = addRule (inner self) rule} @@ -75,19 +79,21 @@ instance StyleSheet s => StyleSheet (ConditionalStyles s) where -------- ---- @import/@media -------- -parseAtImport :: StyleSheet s => ConditionalStyles s -> Text -> [Token] -> (ConditionalStyles s, [Token]) +parseAtImport :: (StyleSheet s, PropertyParser p) => ConditionalStyles s p -> + Text -> [Token] -> (ConditionalStyles s p, [Token]) parseAtImport self src toks | (cond, Semicolon:toks') <- Query.parse Semicolon toks, Just uri <- parseURI $ unpack src = (self { conditions = (cond, External uri) : conditions self }, toks') parseAtImport self _ toks = (self, skipAtRule toks) -loadImports :: StyleSheet s => (URI -> IO Text) -> - (Text -> Query.Datum) -> (Token -> Query.Datum) -> - ConditionalStyles s -> IO s +loadImports :: (StyleSheet s, PropertyParser p) => + (URI -> IO Text) -> (Text -> Query.Datum) -> (Token -> Query.Datum) -> + ConditionalStyles s p -> IO s loadImports = loadImports' [] [] -loadImports' :: StyleSheet s => [URI] -> [(Query.Expr, StyleRef)] -> (URI -> IO Text) -> - (Text -> Query.Datum) -> (Token -> Query.Datum) -> - ConditionalStyles s -> IO s +loadImports' :: (StyleSheet s, PropertyParser p) => + [URI] -> [(Query.Expr, StyleRef)] -> + (URI -> IO Text) -> (Text -> Query.Datum) -> (Token -> Query.Datum) -> + ConditionalStyles s p -> IO s loadImports' blocklist ((cond, src):conds) loader vars evalToken self | Query.eval vars evalToken cond, Internal tokens <- src = loadImports' blocklist conds loader vars evalToken (parse' self tokens) @@ -100,11 +106,42 @@ loadImports' blocklist [] loader v t self | otherwise = loadImports' blocklist conds loader v t self {conditions = []} where conds = conditions self -expandForMedia :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) -> - ConditionalStyles s -> s +expandForMedia :: (StyleSheet s, PropertyParser p) => (Text -> Query.Datum) -> + (Token -> Query.Datum) -> ConditionalStyles s p -> s expandForMedia vars evalToken self | conds == [] = inner self | otherwise = expandForMedia vars evalToken $ foldl parse' self {conditions = []} [ src | (cond, Internal src) <- conds, Query.eval vars evalToken cond ] where conds = conditions self + +-------- +---- @supports +-------- + +evalSupports :: PropertyParser p => p -> [Token] -> Bool +evalSupports self (Ident "not":toks) = not $ evalSupports self toks +evalSupports self (LeftParen:toks) = let (block, toks') = scanBlock toks in + evalSupportsOp toks' self $ supportsProperty block self +evalSupports self (Function "selector":toks) = let (block, toks') = scanBlock toks in + evalSupportsOp toks' self $ supportsSelector block +evalSupports _ _ = False + +evalSupportsOp :: PropertyParser p => [Token] -> p -> Bool -> Bool +evalSupportsOp (Ident "and":toks) self right = right && evalSupports self toks +evalSupportsOp (Ident "or":toks) self right = right || evalSupports self toks +evalSupportsOp [RightParen] _ ret = ret -- scanBlock captures closing paren +evalSupportsOp [] _ ret = ret +evalSupportsOp _ _ _ = False + +supportsProperty :: PropertyParser p => [Token] -> p -> Bool +supportsProperty toks@(Ident "not":_) self = evalSupports self toks -- Special case fallback +supportsProperty (Ident key:toks) self + | (Colon:value) <- skipSpace toks = shorthand self key (init value) /= [] + | skipSpace toks `elem` [[RightParen], []] = shorthand self key [Ident "initial"] /= [] + | otherwise = False +supportsProperty toks self = evalSupports self toks -- Fallback to parenthesized expression. + +supportsSelector :: [Token] -> Bool +supportsSelector toks = let (sels, toks') = parseSelectors toks in + sels /= [] && (toks' == [] || toks' == [RightParen]) diff --git a/src/Data/CSS/Preprocessor/Conditions/Expr.hs b/src/Data/CSS/Preprocessor/Conditions/Expr.hs index b3e20b6..0b16301 100644 --- a/src/Data/CSS/Preprocessor/Conditions/Expr.hs +++ b/src/Data/CSS/Preprocessor/Conditions/Expr.hs @@ -38,9 +38,6 @@ parse' (RightParen:toks) ((Var ")", 0):ops) = parse' toks ops parse' (RightParen:toks) ((Not, 0):ops) = Not : parse' toks ops -- Functional not syntax parse' toks@(RightParen:_) ((op, _):ops) = op : parse' toks ops parse' (RightParen:_) [] = [] -- Invalid! -parse' (Function name:toks) ops - | (args, RightParen:toks') <- break (== RightParen) toks = Func name args : parse' toks' ops - | otherwise = [op | (op, _) <- ops] -- Invalid! parse' (Ident var:toks) ops@((peek, _):ops') -- First, fix up various range syntaxes. | peek `elem` [Less, LessEq, Greater, GreaterEq] = -- Chained conditions @@ -71,7 +68,6 @@ 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 -- 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' _ _ _ (Func _ _:_) = False -- Unsupported here, parser used elsewhere eval' (N y:N x:stack) v t (Less:ops) = eval' (B (x < y):stack) v t ops eval' (N y:N x:stack) v t (LessEq:ops) = eval' (B (x <= y):stack) v t ops eval' (y:x:stack) v t (Equal:ops) = eval' (B (x == y):stack) v t ops diff --git a/src/Data/CSS/Syntax/StyleSheet.hs b/src/Data/CSS/Syntax/StyleSheet.hs index c9caace..e737148 100644 --- a/src/Data/CSS/Syntax/StyleSheet.hs +++ b/src/Data/CSS/Syntax/StyleSheet.hs @@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Data.CSS.Syntax.StyleSheet ( parse, parse', parseForURL, TrivialStyleSheet(..), - StyleSheet(..), skipAtRule, scanBlock, + StyleSheet(..), skipAtRule, scanBlock, skipSpace, StyleRule(..), -- For parsing at-rules, HTML "style" attribute, etc. parseProperties, parseProperties', -- 2.30.2