From cae4f2e082c6ddd4a51250bb99099df2955c3a8b Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Wed, 22 Apr 2020 21:19:06 +1200 Subject: [PATCH] Rewrite parsed namespaces according to @namespace rules. --- src/Data/CSS/Preprocessor/PsuedoClasses.hs | 47 +++++++++++++--------- 1 file changed, 29 insertions(+), 18 deletions(-) diff --git a/src/Data/CSS/Preprocessor/PsuedoClasses.hs b/src/Data/CSS/Preprocessor/PsuedoClasses.hs index 416d1cc..37074ee 100644 --- a/src/Data/CSS/Preprocessor/PsuedoClasses.hs +++ b/src/Data/CSS/Preprocessor/PsuedoClasses.hs @@ -1,13 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} -- | Lowers psuedoclasses to rawer syntactic forms. module Data.CSS.Preprocessor.PsuedoClasses(LowerPsuedoClasses(..), - psuedoClassesFilter, addRewrite, addRewrite', addPsuedoEl, htmlPsuedoFilter) where + psuedoClassesFilter, htmlPsuedoFilter, + addRewrite, addRewrite', addPsuedoEl, addNamespace) where import Data.CSS.Syntax.StyleSheet import Data.CSS.Syntax.Selector import Data.CSS.Syntax.Tokens import Data.Text as Txt +import Data.Maybe (fromMaybe) import Data.HashMap.Lazy as HM import Data.Function ((&)) @@ -17,12 +19,16 @@ import Data.Function ((&)) data LowerPsuedoClasses s = LowerPsuedoClasses { inner :: s, rewriteRules :: HashMap Text [Token], - psuedoEls :: [Text] + psuedoEls :: [Text], + namespaces :: HashMap Text Text } instance StyleSheet s => StyleSheet (LowerPsuedoClasses s) where setPriority p self = self { inner = setPriority p $ inner self } addRule self rule = self { inner = addRule (inner self) $ lowerRule self rule } + + addAtRule self "namespace" (Ident ns:toks) | (Url url:toks') <- skipSpace toks = + (addNamespace ns url self, toks') addAtRule self name toks = let (inner', toks') = addAtRule (inner self) name toks in (self { inner = inner' }, toks') @@ -30,8 +36,8 @@ lowerRule :: LowerPsuedoClasses t -> StyleRule -> StyleRule lowerRule self@(LowerPsuedoClasses { psuedoEls = psuedos }) (StyleRule sel props "") | Just pseudo <- extractPseudoEl psuedos sel = lowerRule (addRewrite' pseudo [] self) $ StyleRule sel props pseudo -lowerRule LowerPsuedoClasses { rewriteRules = rewrites } (StyleRule sel props pseudoel) = - StyleRule (lowerSelector rewrites sel) props pseudoel +lowerRule LowerPsuedoClasses { namespaces = ns, rewriteRules = rewrites } (StyleRule sel props pseudoel) = + StyleRule (lowerSelector ns rewrites sel) props pseudoel extractPseudoEl :: [Text] -> Selector -> Maybe Text extractPseudoEl ps (Element sel) @@ -42,27 +48,29 @@ extractPseudoEl ps (Descendant sel _) = extractPseudoEl ps sel extractPseudoEl ps (Adjacent sel _) = extractPseudoEl ps sel extractPseudoEl ps (Sibling sel _) = extractPseudoEl ps sel -lowerSelector :: HashMap Text [Token] -> Selector -> Selector -lowerSelector rewrites (Element sel') = Element $ lowerSelector' rewrites sel' -lowerSelector rewrites (Child p sel') = Child p $ lowerSelector' rewrites sel' -lowerSelector rewrites (Descendant p sel') = Descendant p $ lowerSelector' rewrites sel' -lowerSelector rewrites (Adjacent sib sel') = Adjacent sib $ lowerSelector' rewrites sel' -lowerSelector rewrites (Sibling sib sel') = Sibling sib $ lowerSelector' rewrites sel' +lowerSelector :: HashMap Text Text -> HashMap Text [Token] -> Selector -> Selector +lowerSelector ns rewrites (Element sel') = Element $ lowerSelector' ns rewrites sel' +lowerSelector ns rewrites (Child p sel') = Child p $ lowerSelector' ns rewrites sel' +lowerSelector ns rewrites (Descendant p sel') = Descendant p $ lowerSelector' ns rewrites sel' +lowerSelector ns rewrites (Adjacent sib sel') = Adjacent sib $ lowerSelector' ns rewrites sel' +lowerSelector ns rewrites (Sibling sib sel') = Sibling sib $ lowerSelector' ns rewrites sel' -lowerSelector' :: HashMap Text [Token] -> [SimpleSelector] -> [SimpleSelector] -lowerSelector' rewrites (Psuedoclass name []:sels) - | Just value <- name `HM.lookup` rewrites = Psuedoclass "where" value : lowerSelector' rewrites sels -lowerSelector' rewrites (Psuedoclass name [arg]:sels) +lowerSelector' :: HashMap Text Text -> HashMap Text [Token] -> [SimpleSelector] -> [SimpleSelector] +lowerSelector' namespaces' rewrites (Namespace ns:sels) = + Namespace (fromMaybe "about:invalid" $ HM.lookup ns namespaces') : lowerSelector' namespaces' rewrites sels +lowerSelector' ns rewrites (Psuedoclass name []:sels) + | Just value <- name `HM.lookup` rewrites = Psuedoclass "where" value : lowerSelector' ns rewrites sels +lowerSelector' ns rewrites (Psuedoclass name [arg]:sels) | Just value <- name `HM.lookup` rewrites = - Psuedoclass "where" [if a == Ident "_" then arg else a | a <- value] : lowerSelector' rewrites sels -lowerSelector' rewrites (sel:sels) = sel : lowerSelector' rewrites sels -lowerSelector' _ [] = [] + Psuedoclass "where" [if a == Ident "_" then arg else a | a <- value] : lowerSelector' ns rewrites sels +lowerSelector' ns rewrites (sel:sels) = sel : lowerSelector' ns rewrites sels +lowerSelector' _ _ [] = [] -------- ---- constructors -------- psuedoClassesFilter :: StyleSheet s => s -> LowerPsuedoClasses s -psuedoClassesFilter s = LowerPsuedoClasses s HM.empty ["before", "after"] +psuedoClassesFilter s = LowerPsuedoClasses s HM.empty ["before", "after"] HM.empty addPsuedoEl :: Text -> LowerPsuedoClasses s -> LowerPsuedoClasses s addPsuedoEl ps self = self { psuedoEls = psuedoEls self ++ Txt.words ps } @@ -72,6 +80,9 @@ addRewrite name sel self = addRewrite' name (tokenize sel) self addRewrite' :: Text -> [Token] -> LowerPsuedoClasses s -> LowerPsuedoClasses s addRewrite' name sel self = self { rewriteRules = insert name sel $ rewriteRules self } +addNamespace :: Text -> Text -> LowerPsuedoClasses s -> LowerPsuedoClasses s +addNamespace ns uri self = self { namespaces = insert ns uri $ namespaces self } + htmlPsuedoFilter :: StyleSheet s => s -> LowerPsuedoClasses s htmlPsuedoFilter s = psuedoClassesFilter s & addRewrite "link" "[href]" & -- 2.30.2