1 files changed, 29 insertions(+), 18 deletions(-)

M 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]" &