Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added support for E[attr]

  • Loading branch information...
commit 2f8678b028294231d2e1dae849821c9b8928e73f 1 parent 205e703
@shangaslammi authored
Showing with 12 additions and 2 deletions.
  1. +8 −2 Text/XML/HXT/CSS/Internal/Selector.hs
  2. +4 −0 test-css.hs
View
10 Text/XML/HXT/CSS/Internal/Selector.hs
@@ -1,7 +1,7 @@
module Text.XML.HXT.CSS.Internal.Selector where
-import Control.Applicative ((<$>),(*>))
+import Control.Applicative ((<$>),(*>),(<*))
import Control.Monad
import Control.Monad.Instances
import Data.Char
@@ -21,6 +21,7 @@ data Selector
| SelectAny
| PrecededBy Selector Selector
| AdjacentTo Selector Selector
+ | AttrExists String
deriving (Eq, Show)
selectorToArrow :: (ArrowChoice a, ArrowXml a) => Selector -> a XmlTree XmlTree
@@ -29,6 +30,7 @@ selectorToArrow = step where
SelectName name -> hasName name
SelectClass cls -> hasClass cls
SelectId id -> hasId id
+ AttrExists attr -> hasAttr attr
Select many -> seqA $ map step many
DescendantOf (PrecededBy node left) parent ->
step parent >>> multi (preceding (step left) >>> step node)
@@ -50,16 +52,19 @@ parseSelector :: String -> Maybe Selector
parseSelector = either (const Nothing) (Just . adjust) . parse selector "" where
selector = do
sels <- sepBy1 (chainl1 pattern sep) (spaces >> string "," >> spaces)
+ eof
return $ case sels of
[single] -> single
many -> SelectAll many
pattern = do
- parts <- many1 $ star <|> cls <|> id' <|> name
+ parts <- many1 $ star <|> cls <|> id' <|> name <|> attr
return $ case parts of
[single] -> single
many -> Select many
+ attrFilter = AttrExists <$> ident
+
sep = spaces *> (child <|> sibling <|> adjacent <|> descendant)
descendant = return (flip DescendantOf)
child = string ">" *> spaces *> return (flip ChildOf)
@@ -70,6 +75,7 @@ parseSelector = either (const Nothing) (Just . adjust) . parse selector "" where
cls = char '.' *> (SelectClass <$> ident)
id' = char '#' *> (SelectId <$> ident)
star = char '*' *> return SelectAny
+ attr = char '[' *> (spaces *> attrFilter <* spaces) <* char ']'
ident = many1 . satisfy . anyOf $ [isAlpha, (`elem` "-_")]
View
4 test-css.hs
@@ -147,6 +147,10 @@ main = hspecX $ [describe "hxt-css-selectors" $
, it "should match descendants in sibling nodes" $ do
res <- testSel [css|p.first ~ ul li|] (getName &&& getAttrValue "class")
res @?= [("li","one"),("li","two"),("li","three")]
+
+ , it "should match elements that contain an attribute" $ do
+ res <- testSel [css|*[id]|] (getName &&& getAttrValue "id")
+ res @?= [("section","header"),("section","content"),("section","footer")]
]
, describe "processing" $
Please sign in to comment.
Something went wrong with that request. Please try again.