~alcinnz/haskell-stylist: Parse namespace selectors.

6 files changed, 48 insertions(+), 21 deletions(-)

M src/Data/CSS/Style/Common.hs
M src/Data/CSS/Style/Selector/Index.hs
M src/Data/CSS/Style/Selector/Interpret.hs
M src/Data/CSS/Style/Selector/Specificity.hs
M src/Data/CSS/Syntax/Selector.hs
M test/Test.hs

M src/Data/CSS/Style/Common.hs => src/Data/CSS/Style/Common.hs +2 -0

@@ 20,6 20,8 @@ data Element = ElementNode {
     previous :: Maybe Element,
     -- | The element's name.
     name :: Text,
+    -- | The element's namespace.
+    namespace :: Text,
     -- | The element's attributes, in sorted order.
     attributes :: [Attribute]
 }

M src/Data/CSS/Style/Selector/Index.hs => src/Data/CSS/Style/Selector/Index.hs +7 -6

@@ 58,7 58,7 @@ selectorKey :: [SimpleSelector] -> Maybe SimpleSelector
 selectorKey (tok@(Tag _) : _) = Just tok
 selectorKey (tok@(Id _) : _) = Just tok
 selectorKey (tok@(Class _) : _) = Just tok
-selectorKey (Property prop _ : _) = Just $ Property prop Exists
+selectorKey (Property _ prop _ : _) = Just $ Property Nothing prop Exists
 selectorKey (_ : tokens) = selectorKey tokens
 selectorKey [] = Nothing
 


@@ 70,12 70,12 @@ testsForElement element =
     (Tag $ name element) : (testsForAttributes $ attributes element)
 testsForAttributes (Attribute "class" value:attrs) =
     (Prelude.map (\s -> Class $ pack s) $ words value) ++
-        (Property "class" Exists : testsForAttributes attrs)
+        (Property Nothing "class" Exists : testsForAttributes attrs)
 testsForAttributes (Attribute "id" value:attrs) =
     (Prelude.map (\s -> Id $ pack s) $ words value) ++
-        (Property "id" Exists : testsForAttributes attrs)
+        (Property Nothing "id" Exists : testsForAttributes attrs)
 testsForAttributes (Attribute elName _:attrs) =
-    Property elName Exists : testsForAttributes attrs
+    Property Nothing elName Exists : testsForAttributes attrs
 testsForAttributes [] = []
 
 -- Implement hashable for SimpleSelector here because it proved challenging to automatically derive it.


@@ 83,10 83,11 @@ instance Hashable SimpleSelector where
     hashWithSalt seed (Tag tag) = seed `hashWithSalt` (0::Int) `hashWithSalt` unpack tag
     hashWithSalt seed (Id i) = seed `hashWithSalt` (1::Int) `hashWithSalt` unpack i
     hashWithSalt seed (Class class_) = seed `hashWithSalt` (2::Int) `hashWithSalt` unpack class_
-    hashWithSalt seed (Property prop test) =
-        seed `hashWithSalt` (3::Int) `hashWithSalt` unpack prop `hashWithSalt` test
+    hashWithSalt seed (Property ns prop test) =
+        seed `hashWithSalt` (3::Int) `hashWithSalt` unpack <$> ns `hashWithSalt` unpack prop `hashWithSalt` test
     hashWithSalt seed (Psuedoclass p args) =
         seed `hashWithSalt` (4::Int) `hashWithSalt` p `hashWithSalt` serialize args
+    hashWithSalt seed (Namespace ns) = seed `hashWithSalt` (5::Int) `hashWithSalt` unpack ns
 
 instance Hashable PropertyTest where
     hashWithSalt seed Exists = seed `hashWithSalt` (0::Int)

M src/Data/CSS/Style/Selector/Interpret.hs => src/Data/CSS/Style/Selector/Interpret.hs +6 -2

@@ 21,7 21,7 @@ import Data.CSS.Syntax.Tokens (Token(..), NumericValue(..))
 type SelectorFunc = Element -> Bool
 type AttrsFunc = [Attribute] -> Bool
 -- Mostly here for the sake of pseudoclasses.
-data IL = Tagname Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer
+data IL = Tagname Text | NS Text | Fail | Recursive Bool [Selector] | Nth Bool Integer Integer
 
 -- | Converts a parsed CSS selector into a callable function.
 compile :: Selector -> SelectorFunc


@@ 35,6 35,7 @@ compileInner :: [SimpleSelector] -> SelectorFunc
 compileInner sel = compileInner' $ lowerInner sel
 compileInner' :: ([IL], [(Text, String -> Bool)]) -> SelectorFunc
 compileInner' ((Tagname tag:tests), attrs) = testTag tag $ compileInner' (tests, attrs)
+compileInner' ((NS ns:tests), attrs) = testNS ns $ compileInner' (tests, attrs)
 compileInner' ((Fail:_), _) = \_ -> False
 compileInner' ((Recursive negate' sels:tests), attrs) =
     recursiveSelect negate' (map compile sels) $ compileInner' (tests, attrs)


@@ 48,10 49,11 @@ compileAttrs ((tag, test):attrs) = testAttr tag test $ compileAttrs attrs
 compileAttrs [] = matched
 
 lowerInner :: [SimpleSelector] -> ([IL], [(Text, String -> Bool)])
+lowerInner (Namespace ns:sel) = (NS ns:tests, attrs) where (tests, attrs) = lowerInner sel
 lowerInner (Tag tag:sel) = (Tagname tag:tests, attrs) where (tests, attrs) = lowerInner sel
 lowerInner (Id i:s) = (tests, ("id", hasWord $ unpack i):attrs) where (tests, attrs) = lowerInner s
 lowerInner (Class c:s) = (tests, ("class", hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
-lowerInner (Property prop test:s) = (tests, (prop, compileAttrTest test):attrs)
+lowerInner (Property _ prop test:s) = (tests, (prop, compileAttrTest test):attrs)
     where (tests, attrs) = lowerInner s
 -- psuedos, TODO handle argumented psuedoclasses.
 lowerInner (Psuedoclass c args:s)


@@ 86,6 88,8 @@ sortAttrs = sortBy compareAttrs where compareAttrs x y = fst x `compare` fst y
 testTag :: Text -> SelectorFunc -> SelectorFunc
 testTag tag success el | name el == tag = success el
     | otherwise = False
+testNS ns success el | namespace el == ns = success el
+    | otherwise = False
 testAttrs :: AttrsFunc -> SelectorFunc -> SelectorFunc
 testAttrs attrsTest success el | attrsTest $ attributes el = success el
     | otherwise = False

M src/Data/CSS/Style/Selector/Specificity.hs => src/Data/CSS/Style/Selector/Specificity.hs +2 -1

@@ 19,13 19,14 @@ computeSpecificity "" (Sibling upSel sel) = computeSpecificity "" upSel `add` co
 computeSpecificity _ sel = computeSpecificity "" sel `add` (0, 0, 1)
 
 computeSpecificity' :: [SimpleSelector] -> Vec
+computeSpecificity' (Namespace _:sel) = computeSpecificity' sel
 computeSpecificity' (Tag _:sel) = computeSpecificity' sel `add` (0, 0, 1)
 computeSpecificity' (Class _:sel) = computeSpecificity' sel `add` (0, 1, 0)
 computeSpecificity' (Psuedoclass c args:sel)
     | c `elem` ["not", "is"], (sels, []) <- parseSelectors args =
         computeSpecificity' sel `add` maximum (map (computeSpecificity "") sels)
 computeSpecificity' (Psuedoclass _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
-computeSpecificity' (Property _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
+computeSpecificity' (Property _ _ _:sel) = computeSpecificity' sel `add` (0, 1, 0)
 computeSpecificity' (Id _:sel) = computeSpecificity' sel `add` (1, 0, 0)
 computeSpecificity' [] = (0, 0, 0)

M src/Data/CSS/Syntax/Selector.hs => src/Data/CSS/Syntax/Selector.hs +7 -2

@@ 19,9 19,10 @@ data Selector = Element [SimpleSelector] -- ^ Selects a single element.
     deriving (Show, Eq)
 -- | An individual test comprising a CSS stylesheet.
 data SimpleSelector = Tag Text -- ^ Matches a tagname, e.g. "a"
+    | Namespace Text
     | Id Text -- ^ Matches the "id" attribute, e.g. "#header"
     | Class Text -- ^ Matches the "class" attribute, e.g. ".ad"
-    | Property Text PropertyTest -- ^ Matches a specified property
+    | Property (Maybe Text) Text PropertyTest -- ^ Matches a specified property
     | Psuedoclass Text [Token] -- ^ Matches psuedoclasses provided by the caller (via a nameless property).
     deriving (Show, Eq)
 -- | How should a property be matched.


@@ 49,13 50,17 @@ parseSelector' op tokens = (op:selector, tokens')
     where (selector, tokens') = parseSelector tokens
 
 parseSelector :: Parser [SimpleSelector]
+parseSelector (Ident ns:Delim '|':tokens) = parseSelector' (Namespace ns) tokens
 parseSelector (Delim '*':tokens) = parseSelector tokens
 parseSelector (Ident tag:tokens) = parseSelector' (Tag tag) tokens
 parseSelector (Hash _ i:tokens) = parseSelector' (Id i) tokens
 parseSelector (Delim '.':Ident class_:tokens) = parseSelector' (Class class_) tokens
+parseSelector (LeftSquareBracket:Ident ns:Delim '|':Ident prop:tokens) =
+        concatP appendPropertySel parsePropertySel parseSelector tokens
+    where appendPropertySel test selector = Property (Just ns) prop test : selector
 parseSelector (LeftSquareBracket:Ident prop:tokens) =
         concatP appendPropertySel parsePropertySel parseSelector tokens
-    where appendPropertySel test selector = Property prop test : selector
+    where appendPropertySel test selector = Property Nothing prop test : selector
 parseSelector (Colon:Ident p:ts) = parseSelector' (Psuedoclass p []) ts
 parseSelector (Colon:Function fn:tokens) =
         concatP appendPseudo scanBlock parseSelector tokens

M test/Test.hs => test/Test.hs +24 -10

@@ 68,7 68,7 @@ spec = do
                     StyleRule (Element [Id "id"]) [] ""
                 ]
             parse emptyStyle "[attr] {}" `shouldBe` TrivialStyleSheet [
-                    StyleRule (Element [Property "attr" Exists]) [] ""
+                    StyleRule (Element [Property Nothing "attr" Exists]) [] ""
                 ]
             parse emptyStyle "a , b {}" `shouldBe` TrivialStyleSheet [
                     StyleRule (Element [Tag "b"]) [] "",


@@ 99,6 99,7 @@ spec = do
             let index = addStyleRule styleIndex 0 $ styleRule' sampleRule
             let element = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [


@@ 109,6 110,7 @@ spec = do
             }
             let element2 = ElementNode {
                 name = "b",
+                namespace = "",
                 parent = Just element,
                 previous = Just element, -- Invalid tree, oh well.
                 attributes = []


@@ 126,7 128,7 @@ spec = do
             rulesForElement index2 element `shouldBe` [rule2]
             rulesForElement index2 element2 `shouldBe` []
 
-            let rule3 = StyleRule (Element [Property "href" $ Prefix "https://"]) [("color", [Ident "green"])] ""
+            let rule3 = StyleRule (Element [Property Nothing "href" $ Prefix "https://"]) [("color", [Ident "green"])] ""
             let index3 = addStyleRule styleIndex 0 $ styleRule' rule3
             rulesForElement index3 element `shouldBe` [rule3]
             rulesForElement index3 element2 `shouldBe` []


@@ 134,6 136,7 @@ spec = do
         it "Correctly evaluates selectors" $ do
             let parentEl = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [


@@ 145,12 148,14 @@ spec = do
             }
             let sibling = ElementNode {
                 name = "img",
+                namespace = "",
                 parent = Just parentEl,
                 previous = Nothing,
                 attributes = []
             }
             let child = ElementNode {
                 name = "b",
+                namespace = "",
                 parent = Just parentEl,
                 previous = Just sibling,
                 attributes = []


@@ 171,42 176,42 @@ spec = do
             selector3 sibling `shouldBe` False
             selector3 child `shouldBe` False
 
-            let selector4 = compile (Element [Property "lang" Exists])
+            let selector4 = compile (Element [Property Nothing "lang" Exists])
             selector4 parentEl `shouldBe` True
             selector4 sibling `shouldBe` False
             selector4 child `shouldBe` False
 
-            let selector5 = compile (Element [Property "class" $ Include "secure"])
+            let selector5 = compile (Element [Property Nothing "class" $ Include "secure"])
             selector5 parentEl `shouldBe` True
             selector5 sibling `shouldBe` False
             selector5 child `shouldBe` False
 
-            let selector6 = compile (Element [Property "href" $ Prefix "https://"])
+            let selector6 = compile (Element [Property Nothing "href" $ Prefix "https://"])
             selector6 parentEl `shouldBe` True
             selector6 sibling `shouldBe` False
             selector6 child `shouldBe` False
 
-            let selector7 = compile (Element [Property "href" $ Suffix ".html"])
+            let selector7 = compile (Element [Property Nothing "href" $ Suffix ".html"])
             selector7 parentEl `shouldBe` True
             selector7 sibling `shouldBe` False
             selector7 child `shouldBe` False
 
-            let selector8 = compile (Element [Property "href" $ Substring ".geek.nz"])
+            let selector8 = compile (Element [Property Nothing "href" $ Substring ".geek.nz"])
             selector8 parentEl `shouldBe` True
             selector8 sibling `shouldBe` False
             selector8 child `shouldBe` False
 
-            let selector9 = compile (Element [Property "lang" $ Dash "en"])
+            let selector9 = compile (Element [Property Nothing "lang" $ Dash "en"])
             selector9 parentEl `shouldBe` True
             selector9 sibling `shouldBe` False
             selector9 child `shouldBe` False
 
-            let selectorA = compile (Element [Property "lang" $ Dash "en-US"])
+            let selectorA = compile (Element [Property Nothing "lang" $ Dash "en-US"])
             selectorA parentEl `shouldBe` True
             selectorA sibling `shouldBe` False
             selectorA child `shouldBe` False
 
-            let selectorB = compile (Element [Property "lang" $ Dash "en-UK"])
+            let selectorB = compile (Element [Property Nothing "lang" $ Dash "en-UK"])
             selectorB parentEl `shouldBe` False
             selectorB sibling `shouldBe` False
             selectorB child `shouldBe` False


@@ 236,6 241,7 @@ spec = do
         it "respects selector specificity" $ do
             let el = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [Attribute "class" "link"]


@@ 246,6 252,7 @@ spec = do
         it "respects syntax order" $ do
             let el = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [Attribute "class" "link"]


@@ 260,6 267,7 @@ spec = do
         it "respects stylesheet precedence" $ do
             let el = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [Attribute "class" "link"]


@@ 271,6 279,7 @@ spec = do
 
             let el' = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [Attribute "class" "link"]


@@ 282,6 291,7 @@ spec = do
         it "respects overrides" $ do
             let el = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [Attribute "class" "link"]


@@ 324,6 334,7 @@ spec = do
 
             let el = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = []


@@ 334,6 345,7 @@ spec = do
         it "applies within element" $ do
             let el = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = []


@@ 346,12 358,14 @@ spec = do
         it "inherits" $ do
             let parent = ElementNode {
                 name = "a",
+                namespace = "",
                 parent = Nothing,
                 previous = Nothing,
                 attributes = []
             }
             let el = ElementNode {
                 name = "b",
+                namespace = "",
                 parent = Just parent,
                 previous = Nothing,
                 attributes = []