5 files changed, 37 insertions(+), 28 deletions(-)

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

@@ 89,7 89,7 @@ resolveAttr self el = self {
     } where StyleRule sel attrs psuedo = inner self
 
 attrs2Dict :: Element -> HashMap Text String
-attrs2Dict el = fromList [(a, b) | Attribute a b <- attributes el]
+attrs2Dict el = fromList [(a, b) | Attribute a _ b <- attributes el]
 
 resolveAttr' :: [Token] -> HashMap Text String  -> [Token]
 resolveAttr' (Function "attr":Ident attr:RightParen:toks) attrs =

@@ 26,7 26,7 @@ data Element = ElementNode {
     attributes :: [Attribute]
 }
 -- | A key-value attribute.
-data Attribute = Attribute Text String deriving (Eq, Ord)
+data Attribute = Attribute Text Text String deriving (Eq, Ord)
 
 class RuleStore a where
     new :: a

@@ 68,13 68,13 @@ testsForAttributes :: [Attribute] -> [SimpleSelector]
 testsForElement :: Element -> [SimpleSelector]
 testsForElement element =
     (Tag $ name element) : (testsForAttributes $ attributes element)
-testsForAttributes (Attribute "class" value:attrs) =
+testsForAttributes (Attribute "class" _ value:attrs) =
     (Prelude.map (\s -> Class $ pack s) $ words value) ++
         (Property Nothing "class" Exists : testsForAttributes attrs)
-testsForAttributes (Attribute "id" value:attrs) =
+testsForAttributes (Attribute "id" _ value:attrs) =
     (Prelude.map (\s -> Id $ pack s) $ words value) ++
         (Property Nothing "id" Exists : testsForAttributes attrs)
-testsForAttributes (Attribute elName _:attrs) =
+testsForAttributes (Attribute elName _ _:attrs) =
     Property Nothing elName Exists : testsForAttributes attrs
 testsForAttributes [] = []
 

@@ 33,7 33,7 @@ compile (Sibling up sel) = indirect previous (compile up) $ compileInner sel
 
 compileInner :: [SimpleSelector] -> SelectorFunc
 compileInner sel = compileInner' $ lowerInner sel
-compileInner' :: ([IL], [(Text, String -> Bool)]) -> SelectorFunc
+compileInner' :: ([IL], [(Text, Maybe 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


@@ 44,16 44,17 @@ compileInner' ((Nth ofType n 0:tests), attrs) =
 compileInner' ((Nth ofType a b:tests), attrs) =
     nthChild' ofType (fromInteger a) (fromInteger b) $ compileInner' (tests, attrs)
 compileInner' ([], attrs) = testAttrs (compileAttrs $ sortAttrs attrs) matched
-compileAttrs :: [(Text, String -> Bool)] -> AttrsFunc
-compileAttrs ((tag, test):attrs) = testAttr tag test $ compileAttrs attrs
+compileAttrs :: [(Text, Maybe Text, String -> Bool)] -> AttrsFunc
+compileAttrs ((tag, Nothing, test):attrs) = testAttr tag test $ compileAttrs attrs
+compileAttrs ((tag, Just ns, test):attrs) = testAttrNS ns tag test $ compileAttrs attrs
 compileAttrs [] = matched
 
-lowerInner :: [SimpleSelector] -> ([IL], [(Text, String -> Bool)])
+lowerInner :: [SimpleSelector] -> ([IL], [(Text, Maybe 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 (Id i:s) = (tests, ("id", Nothing, hasWord $ unpack i):attrs) where (tests, attrs) = lowerInner s
+lowerInner (Class c:s) = (tests, ("class", Nothing, hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
+lowerInner (Property ns prop test:s) = (tests, (prop, ns, compileAttrTest test):attrs)
     where (tests, attrs) = lowerInner s
 -- psuedos, TODO handle argumented psuedoclasses.
 lowerInner (Psuedoclass c args:s)


@@ 66,7 67,7 @@ lowerInner (Psuedoclass "nth-child" args:s) =
 lowerInner (Psuedoclass "nth-of-type" args:s) =
     (parseNth True (filter (== Whitespace) args):tests, attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass c []:s) =
-    (tests, ("", hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
+    (tests, ("", Nothing, hasWord $ unpack c):attrs) where (tests, attrs) = lowerInner s
 lowerInner (Psuedoclass _ _:_) = ([Fail], [])
 lowerInner [] = ([], [])
 


@@ 79,8 80,8 @@ compileAttrTest (Substring val) = isInfixOf $ unpack val
 compileAttrTest (Include val) = hasWord $ unpack val
 compileAttrTest (Dash val) = hasLang $ unpack val
 
-sortAttrs :: [(Text, b)] -> [(Text, b)]
-sortAttrs = sortBy compareAttrs where compareAttrs x y = fst x `compare` fst y
+sortAttrs :: [(Text, Maybe Text, b)] -> [(Text, Maybe Text, b)]
+sortAttrs = sortBy compareAttrs where compareAttrs (x, x', _) (y, y', _) = (x, x') `compare` (y, y')
 
 --------
 ---- Runtime


@@ 88,6 89,7 @@ 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 :: Text -> SelectorFunc -> SelectorFunc
 testNS ns success el | namespace el == ns = success el
     | otherwise = False
 testAttrs :: AttrsFunc -> SelectorFunc -> SelectorFunc


@@ 105,12 107,19 @@ matched :: t -> Bool
 matched _ = True
 
 testAttr :: Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
-testAttr expected test next attrs@(Attribute attr value : attrs')
+testAttr expected test next attrs@(Attribute attr _ value : attrs')
     | attr < expected = testAttr expected test next attrs'
     | attr > expected = False
     | attr == expected && test value = next attrs
     | otherwise = False
 testAttr _ _ _ [] = False
+testAttrNS :: Text -> Text -> (String -> Bool) -> AttrsFunc -> AttrsFunc
+testAttrNS expectedNS expected test next attrs@(Attribute attr ns value : attrs')
+    | (attr, ns) < (expected, expectedNS) = testAttrNS expectedNS expected test next attrs'
+    | (attr, ns) > (expected, expectedNS) = False
+    | (attr, ns) == (expected, expectedNS) && test value = next attrs
+    | otherwise = False
+testAttrNS _ _ _ _ [] = False
 
 hasWord :: String -> String -> Bool
 hasWord expected value = expected `elem` words value

@@ 103,9 103,9 @@ spec = do
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [
-                    Attribute "class" "external",
-                    Attribute "href" "https://adrian.geek.nz/",
-                    Attribute "id" "mysite"
+                    Attribute "class" "" "external",
+                    Attribute "href" "" "https://adrian.geek.nz/",
+                    Attribute "id" "" "mysite"
                 ]
             }
             let element2 = ElementNode {


@@ 140,10 140,10 @@ spec = do
                 parent = Nothing,
                 previous = Nothing,
                 attributes = [
-                    Attribute "class" "external secure link",
-                    Attribute "href" "https://adrian.geek.nz/index.html",
-                    Attribute "id" "mysite",
-                    Attribute "lang" "en-US"
+                    Attribute "class" "" "external secure link",
+                    Attribute "href" "" "https://adrian.geek.nz/index.html",
+                    Attribute "id" "" "mysite",
+                    Attribute "lang" "" "en-US"
                 ]
             }
             let sibling = ElementNode {


@@ 244,7 244,7 @@ spec = do
                 namespace = "",
                 parent = Nothing,
                 previous = Nothing,
-                attributes = [Attribute "class" "link"]
+                attributes = [Attribute "class" "" "link"]
             }
             let rules = parse queryable "a.link {color: green} a {color: red}"
             let VarParser _ (TrivialPropertyParser style) = cascade rules el [] temp::(VarParser TrivialPropertyParser)


@@ 255,7 255,7 @@ spec = do
                 namespace = "",
                 parent = Nothing,
                 previous = Nothing,
-                attributes = [Attribute "class" "link"]
+                attributes = [Attribute "class" "" "link"]
             }
             let rules = parse queryable "a {color: red; color: green}"
             let VarParser _ (TrivialPropertyParser style) = cascade rules el [] temp::(VarParser TrivialPropertyParser)


@@ 270,7 270,7 @@ spec = do
                 namespace = "",
                 parent = Nothing,
                 previous = Nothing,
-                attributes = [Attribute "class" "link"]
+                attributes = [Attribute "class" "" "link"]
             }
             let rules = parse (queryable {priority = 1}) "a {color: green}"
             let rules2 = parse (rules {priority = 2}) "a {color: red}" :: QueryableStyleSheet (VarParser TrivialPropertyParser)


@@ 282,7 282,7 @@ spec = do
                 namespace = "",
                 parent = Nothing,
                 previous = Nothing,
-                attributes = [Attribute "class" "link"]
+                attributes = [Attribute "class" "" "link"]
             }
             let rules' = parse (queryable {priority = 1}) "a {color: red}"
             let rules2' = parse (rules' {priority = 2}) "a {color: green !important}" :: QueryableStyleSheet (VarParser TrivialPropertyParser)


@@ 294,7 294,7 @@ spec = do
                 namespace = "",
                 parent = Nothing,
                 previous = Nothing,
-                attributes = [Attribute "class" "link"]
+                attributes = [Attribute "class" "" "link"]
             }
             let rules = parse queryable "a {color: red;}"
             let VarParser _ (TrivialPropertyParser style) = cascade rules el [("color", [Ident "green"])] temp::(VarParser TrivialPropertyParser)