From 4bdb4befad2b36c500e4f30d584b5415c00ef7c6 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 10 Aug 2022 21:51:15 +1200 Subject: [PATCH] Fix @layer to play nicely with the conditional at-rules. If you're not using that, its still integrated into core. Since the @layer rules are stripped by ConditionalStyles this shouldn't make a difference. --- src/Data/CSS/Preprocessor/Conditions.hs | 58 ++++++++++++++++++++++--- src/Data/CSS/Style.hs | 12 +++-- stylist-traits/src/Stylist.hs | 8 +++- stylist-traits/src/Stylist/Parse.hs | 6 ++- 4 files changed, 70 insertions(+), 14 deletions(-) diff --git a/src/Data/CSS/Preprocessor/Conditions.hs b/src/Data/CSS/Preprocessor/Conditions.hs index 7a3871c..a7c9576 100644 --- a/src/Data/CSS/Preprocessor/Conditions.hs +++ b/src/Data/CSS/Preprocessor/Conditions.hs @@ -16,6 +16,7 @@ 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) @@ -36,15 +37,22 @@ data ConditionalStyles p = ConditionalStyles { -- | Queued style rules, to be evaluated later. rules :: [ConditionalRule p], -- | PropertyParser to test against for `@supports` rules. - propertyParser :: p + propertyParser :: p, + -- | Known-named @layers. + layers :: AtLayer.Tree, + -- | The current @layer, for resolving nesting + layerNamespace :: [Text], + -- | The integral path to the current @layer, for resolving nesting + layerPath' :: [Int] } -- | Constructs an empty `ConditionalStyles`. conditionalStyles :: PropertyParser p => URI -> String -> ConditionalStyles p -conditionalStyles uri mediaDocument' = ConditionalStyles uri mediaDocument' False [] temp +conditionalStyles uri mediaDocument' = + ConditionalStyles uri mediaDocument' False [] temp AtLayer.emptyTree [] [0] -- | Style rules that can be queued in a `ConditionalStyles`. -data ConditionalRule p = Priority Int | StyleRule' StyleRule | AtRule Text [Token] | +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 @@ -60,7 +68,7 @@ parseAtBlock self (_:toks) = parseAtBlock self toks parseAtBlock self [] = (self, []) instance PropertyParser p => StyleSheet (ConditionalStyles p) where - setPriority x self = addRule' self $ Priority x + setPriorities x self = addRule' self { layerPath' = x } $ Priority x addRule self rule = addRule' self $ StyleRule' rule addAtRule self "document" (Whitespace:toks) = addAtRule self "document" toks @@ -107,6 +115,15 @@ instance PropertyParser p => StyleSheet (ConditionalStyles p) where if evalSupports (propertyParser self) cond then parseAtBlock self toks' else (self, skipAtRule toks') + addAtRule self@ConditionalStyles { layers = l, layerNamespace = ns, layerPath' = xs@(x:_) } + "layer" toks = + case parseAtLayer ns toks l $ \ns' path' -> setPriorities (x:path') self { + layerNamespace = ns' + } of + (layers', Just self', toks') -> + (setPriorities xs self { rules = rules self', layers = layers' }, toks') + (layers', Nothing, toks') -> (setPriorities xs self { layers = layers' }, toks') + addAtRule self rule tokens = let (block, rest) = scanAtRule tokens in (addRule' self $ AtRule rule block, rest) @@ -120,11 +137,42 @@ testIsStyled styles = styles { isUnstyled = null $ rules styles } -------- parseAtImport :: PropertyParser p => ConditionalStyles p -> Text -> [Token] -> (ConditionalStyles p, [Token]) +parseAtImport self src (Whitespace:toks) = parseAtImport self src toks +parseAtImport self src (Function "supports":toks) + | (cond, RightParen:toks') <- break (== RightParen) toks = + if evalSupports (propertyParser self) cond + then parseAtImport self src toks' else (self, skipAtRule toks') +parseAtImport self@ConditionalStyles { layerNamespace = ns } src (Function "layer":toks) + | (layerToks, RightParen:toks') <- break (== RightParen) toks, validLayer layerToks = + parseAtImportInLayer self src (ns ++ [name | Ident name <- layerToks]) toks' + where + validLayer toks' = validLayer' (Delim '.':filter (/= Whitespace) toks') + validLayer' (Delim '.':Ident _:toks') = validLayer toks' + validLayer' [] = True + validLayer' _ = False +parseAtImport self@ConditionalStyles { layers = l, layerNamespace = ns } src (Ident "layer":toks) = + parseAtImportInLayer self src (uniqueName ns l) toks parseAtImport self src toks | (cond, Semicolon:toks') <- Query.parse Semicolon toks, Just uri <- parseURI $ unpack src = (addRule' self $ External cond uri, toks') parseAtImport self _ toks = (self, skipAtRule toks) +parseAtImportInLayer :: PropertyParser p => ConditionalStyles p -> Text -> [Text] -> + [Token] -> (ConditionalStyles p, [Token]) +parseAtImportInLayer self@ConditionalStyles { + layers = l, layerNamespace = ns, layerPath' = xs@(x:_) + } src layerName toks = + let (ret, toks') = parseAtImport self' src toks in (setPriorities xs ret, toks') + where + layers' = registerLayer layerName l + self' = setPriorities (x:layerPath layerName layers') self { + layers = layers', + layerNamespace = ns + } +parseAtImportInLayer self src layerName toks = parseAtImportInLayer self { + layerPath' = [0] + } src layerName 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 vars evalToken self = @@ -157,7 +205,7 @@ resolve :: StyleSheet s => (Text -> Query.Datum) -> (Token -> Query.Datum) -> 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 (Priority x:rules') styles = resolve' v t rules' $ setPriorities 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 = diff --git a/src/Data/CSS/Style.hs b/src/Data/CSS/Style.hs index 0af565b..a19bf5d 100644 --- a/src/Data/CSS/Style.hs +++ b/src/Data/CSS/Style.hs @@ -42,8 +42,6 @@ data QueryableStyleSheet' store parser = QueryableStyleSheet' { -- | Whether author, useragent, or user styles are currently being parsed. -- The tail of this list indicates which Cascade Layer is active. priority :: [Int], -- author vs user agent vs user styles, incorporates Cascade Layers - -- | Priority without Cascade Layers - priority' :: Int, -- | Parse data for @layer, to give webdevs explicit control over the cascade. layers :: AtLayer.Tree, --- | The name of the @layer we're within. @@ -54,14 +52,14 @@ data QueryableStyleSheet' store parser = QueryableStyleSheet' { queryableStyleSheet :: PropertyParser p => QueryableStyleSheet p queryableStyleSheet = QueryableStyleSheet' { store = new, parser = temp, layers = AtLayer.emptyTree, - priority = [0], priority' = 0, layerNamespace = [] } + priority = [0], layerNamespace = [] } instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p) where - setPriority v self = self {priority = [v], priority' = v} - addRule self@(QueryableStyleSheet' store' _ priority' _ _ _) rule = self { + setPriorities vs self = self { priority = vs } + addRule self@(QueryableStyleSheet' store' _ priority' _ _) rule = self { store = addStyleRule store' priority' $ styleRule' rule } - addAtRule self@QueryableStyleSheet' { layerNamespace = ns, layers = layers_, priority' = v } + addAtRule self@QueryableStyleSheet' { layerNamespace = ns, layers = layers_, priority = v:_ } "layer" toks = case parseAtLayer ns toks layers_ $ \ns' path -> self { priority = v : path, layerNamespace = ns' @@ -74,7 +72,7 @@ instance (RuleStore s, PropertyParser p) => StyleSheet (QueryableStyleSheet' s p -- | Looks up style rules matching the specified element, grouped by psuedoelement. queryRules :: (PropertyParser p, RuleStore s) => QueryableStyleSheet' s p -> Element -> HashMap Text [StyleRule'] -queryRules (QueryableStyleSheet' store' _ _ _ _ _) = Cascade.query store' +queryRules (QueryableStyleSheet' store' _ _ _ _) = Cascade.query store' -- | Selects used property values from the given style rules, -- & populates into a new `PropertyParser` inheriting from the one given. diff --git a/stylist-traits/src/Stylist.hs b/stylist-traits/src/Stylist.hs index 2e505ee..de86b8e 100644 --- a/stylist-traits/src/Stylist.hs +++ b/stylist-traits/src/Stylist.hs @@ -1,4 +1,4 @@ -module Stylist( +module Stylist(cssPriorityAgent, cssPriorityUser, cssPriorityAuthor, PropertyParser(..), TrivialPropertyParser(..), StyleSheet(..), TrivialStyleSheet(..), Props, Element(..), Attribute(..)) where @@ -8,6 +8,12 @@ import Data.CSS.Syntax.Tokens (Token) import Stylist.Parse (StyleSheet(..), TrivialStyleSheet(..)) +-- | Set the priority for a CSS stylesheet being parsed. +cssPriorityAgent, cssPriorityUser, cssPriorityAuthor :: StyleSheet s => s -> s +cssPriorityAgent = setPriority 1 +cssPriorityUser = setPriority 2 +cssPriorityAuthor = setPriority 3 + -- | Defines how to parse CSS properties into an output "style" format. class PropertyParser a where -- | Default styles. diff --git a/stylist-traits/src/Stylist/Parse.hs b/stylist-traits/src/Stylist/Parse.hs index e94cc65..ef2ad75 100644 --- a/stylist-traits/src/Stylist/Parse.hs +++ b/stylist-traits/src/Stylist/Parse.hs @@ -26,8 +26,12 @@ import Network.URI (parseRelativeReference, relativeTo, uriToString, URI(..)) -- These methods are used to construct the results from `parse`, etc. class StyleSheet s where -- | Sets the stylesheet priority (useragent vs user vs author), optional. + -- Favor `setPriorities` for richer API. setPriority :: Int -> s -> s - setPriority _ = id + setPriority v self = setPriorities [v] self + -- | Sets the multi-layered stylesheet priority (for the sake of @layer rules), optional. + setPriorities :: [Int] -> s -> s + setPriorities _ = id -- | Stores a parsed selector+properties rule. addRule :: s -> StyleRule -> s -- | Stores and parses an identified at-rule. -- 2.30.2