HandsomeSoup 0.3.2 → 0.3.3

raw patch · 11 files changed

+394/−282 lines, 11 filesdep +HandsomeSoupdep +hspecdep +network-uridep ~basedep ~networknew-component:exe:handsomesoupPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HandsomeSoup, hspec, network-uri

Dependency ranges changed: base, network

API changes (from Hackage documentation)

Files

• HandsomeSoup.cabal +54/−55
• README.markdown +6/−3
• Text/CSS/Parser.hs +0/−127
• Text/CSS/Utils.hs +0/−12
• Text/HandsomeSoup.hs +0/−85
• examples/GoogleSearch.hs +10/−0
• src/Text/CSS/Parser.hs +127/−0
• src/Text/CSS/Utils.hs +12/−0
• src/Text/HandsomeSoup.hs +90/−0
• tests/AllTests.hs +75/−0
• tests/test.html +20/−0

@@ -1,61 +1,60 @@--- HandsomeSoup.cabal auto-generated by cabal init. For additional--- options, see--- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.--- The name of the package.-Name:                HandsomeSoup---- The package version. See the Haskell package versioning policy--- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for--- standards guiding when and how versions should be incremented.-Version:             0.3.2---- A short (one-line) description of the package.-Synopsis:            Work with HTML more easily in HXT---- A longer description of the package.-Description: See examples and full readme on the Github page: https:\/\/github.com\/egonSchiele\/HandsomeSoup---- URL for the project homepage or repository.-Homepage:            https://github.com/egonSchiele/HandsomeSoup---- The license under which the package is released.-License:             BSD3---- The file containing the license text.-License-file:        LICENSE---- The package author(s).-Author:              Aditya Bhargava---- An email address to which users can send suggestions, bug reports,--- and patches.-Maintainer:          bluemangroupie@gmail.com---- A copyright notice.--- Copyright:           +Name:               HandsomeSoup+Version:            0.3.3+Synopsis:           Work with HTML more easily in HXT+Description:        See examples and full readme on the Github page: https:\/\/github.com\/egonSchiele\/HandsomeSoup+Homepage:           https://github.com/egonSchiele/HandsomeSoup+License:            BSD3+License-file:       LICENSE+Author:             Aditya Bhargava+Maintainer:         bluemangroupie@gmail.com+Category:           Text+Build-type:         Simple+Cabal-version:      >=1.8 -Category:            Text+Extra-source-files: README.markdown+                  , examples/*.hs+Data-files:         tests/test.html+library+  hs-source-dirs:     src+  Exposed-modules:    Text.HandsomeSoup+                    , Text.CSS.Parser+  Other-modules:      Text.CSS.Utils+  Build-depends:      base            >= 4.6  &&  < 5+                    , transformers+                    , HTTP+                    , parsec+                    , containers+                    , mtl+                    , MaybeT+                    , hxt+                    , network >= 2.6+                    , network-uri >= 2.6+                    , hxt-http -Build-type:          Simple+test-suite hspec+  hs-source-dirs:      tests+  main-is:             AllTests.hs+  type:                exitcode-stdio-1.0+  Other-modules:       Paths_HandsomeSoup+  Build-depends:       base                >= 4.6  &&  < 5+                     -- currently uses HSpec.Monadic submodule, removed in 1.10.0+                     , hspec               < 1.10+                     , HandsomeSoup+                     , hxt --- Extra files to be distributed with the package, such as examples or--- a README.-Extra-source-files: README.markdown+Flag buildExamples+  description:       Build examples+  default:           False --- Constraint on the version of Cabal needed to build this package.-Cabal-version:       >=1.2+executable handsomesoup+  If flag(buildExamples)+    Buildable:        True+  Else+    Buildable:        False +  hs-source-dirs:  examples+  main-is:         GoogleSearch.hs+  Build-depends:   base            >= 4.6  &&  < 5+                 , HandsomeSoup+                 , hxt -Library-  -- Modules exported by the library.-  Exposed-modules:     Text.HandsomeSoup, Text.CSS.Parser-  -  -- Packages needed in order to build this package.-  Build-depends: base < 5, transformers, HTTP, parsec, containers, mtl, MaybeT, hxt, network, hxt-http-  -  -- Modules not exported by this package.-  Other-modules: Text.CSS.Utils-  -  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.-  -- Build-tools:         -  

@@ -1,6 +1,6 @@ # HandsomeSoup -Current Status: Usable. Please file bugs!+Current Status: Usable and stable. **Needs GHC 7.6**. Please file bugs!  HandsomeSoup is the library I wish I had when I started parsing HTML in Haskell. @@ -16,8 +16,11 @@  [Nokogiri](http://nokogiri.org/), the HTML parser for Ruby, has an example showing how to scrape Google search results. This is easy in HandsomeSoup: +    import Text.XML.HXT.Core+    import Text.HandsomeSoup+         main = do-        doc <- fromUrl "http://www.google.com/search?q=egon+schiele"+        let doc = fromUrl "http://www.google.com/search?q=egon+schiele"         links <- runX $ doc >>> css "h3.r a" ! "href"         mapM_ putStrLn links @@ -25,7 +28,7 @@  ### Easily parse an online page using `fromUrl` -    doc <- fromUrl "http://example.com"+    let doc = fromUrl "http://example.com"  ### Or a local page using `parseHtml` 

@@ -1,127 +0,0 @@-module Text.CSS.Parser where--import Text.Parsec-import qualified Data.Functor.Identity as I-import Data.List-import Data.Maybe-import Text.CSS.Utils--- if no tag name was given, sName will be set to '*'--- attrs are (attr name, attr value).--- if attr value is the empty string, we just check to--- make sure that the element has that attribute.------ if the attr value is prefixed with a '~', we treat--- that attribute as a list of words separated by a space--- and make sure that at least one of those words matches.--- --- if the attr value is prefixed with a `|`, the value must--- be exactly val or start with val immediately followed by a '-'.--- This is primarily intended to allow language subcode matches.--- Example: [lang|="en"] matches "en", "en-US", etc.--- From: http://www.w3.org/TR/CSS2/selector.html.-data Selector = Selector { sName :: String, sAttrs :: [(String,String)], spseudoSelectores :: [String] } | Space | ChildOf | FollowedBy deriving (Show)---- pretty printers for debugging-pp Space = "<space>"-pp ChildOf = "<child of>"-pp FollowedBy = "<followed by>"-pp (Selector name attrs pseudo) = show name ++ ":" ++ showMap attrs ++ ", " ++ show pseudo-    where showMap m = ("{" ++ (foldl (\acc (k,v) -> acc ++ (show k) ++ ":" ++ (show v) ++ ", ") "" m)) ++ "}"--{- Some lexeme parsers -}-ident :: ParsecT [Char] u I.Identity String-ident = do c1 <- optionMaybe (char '-')-           c2 <- nmstart-           cs <- many nmchar-           return $ concat [maybeToList c1, [c2], cs]--nmstart = alphaNum <|> char '_'-nmchar  = alphaNum <|> oneOf "_-"--{- TYPE SELECTORS FOLLOW -}---- | selects a tag name, like @ h1 @-typeSelector :: ParsecT [Char] u I.Identity [Char]-typeSelector = many1 (alphaNum <|> oneOf "_-")---- | universal selector, selects @ * @-universalSelector :: ParsecT [Char] u I.Identity String-universalSelector = string "*"--{- SECONDARY SELECTORS FOLLOW -}---- | selects a pseudo-element or pseudo-class, like @ :link @, @ :first-child @ etc.-pseudoSelector :: ParsecT [Char] u I.Identity [Char]-pseudoSelector = char ':' >> many1 (alphaNum <|> oneOf "-()")---- | class selector, selects @ .foo @-classSelector :: ParsecT [Char] u I.Identity ([Char], [Char])-classSelector = do-    val <- char '.' >> ident-    return ("class", '~':val)---- | id selector, selects @ #foo @-idSelector :: ParsecT [Char] u I.Identity ([Char], [Char])-idSelector = do-    val <- char '#' >> many1 nmchar-    return ("id", val)---- | selects attributes, like @ [id] @ (element must have id) or @ [id=foo] @ (element must have id foo).-attributeSelector :: ParsecT [Char] u I.Identity ([Char], [Char])-attributeSelector = do-      _contents <- between (char '[') (char ']') (many1 (alphaNum <|> oneOf "/-_|~=\"'."))-      -- remove quotes-      let contents = filter (\c -> c /= '"' && c /= '\'') _contents-      if "~=" `isInfixOf` contents -          then return $ (\(a, b) -> (a, '~':b)) $ splitOn "~=" contents-          else if "|=" `isInfixOf` contents -              then return $ (\(a, b) -> (a, '|':b)) $ splitOn "|=" contents-              else if '=' `elem` contents-                   then return $ splitOn "=" contents-                   else return (contents, "")---- | selector for everything after the type except pseudoSelectores-secondarySelector = many1 (classSelector <|> idSelector <|> attributeSelector)--{- COMBINATOR SELECTORS FOLLOW -}--space_ = do-    many1 $ string " "-    return Space--childOf = do-    spaces >> string ">" >> spaces-    return ChildOf--followedBy = do-    spaces >> string "+" >> spaces-    return FollowedBy--{- SIMPLE SELECTORS FOLLOW -}---- | selects a tagname followed by one or more secondary selectors--- example: @ a.foo @, @ *#hello @, @ h1 @ etc-simpleSelectorTag :: ParsecT [Char] u I.Identity Selector-simpleSelectorTag = do-    tagName <- typeSelector <|> universalSelector-    attrs <- secondarySelector <|> return []-    pseudo <- many1 pseudoSelector <|> return []-    return $ Selector tagName attrs pseudo---- | selects one or more secondary selectors--- and automatically prepends the universal selector to them.--- example: @ .foo @, @ #hello @ etc-simpleSelectorNoTag = do-    attrs <- secondarySelector-    pseudo <- many1 pseudoSelector <|> return []-    return $ Selector "*" attrs pseudo---- | A simple selector is either a type selector or universal selector followed immediately by zero or more attribute selectors, ID selectors, or pseudo-classes, in any order.-simpleSelector :: ParsecT [Char] u I.Identity Selector-simpleSelector = simpleSelectorTag <|> simpleSelectorNoTag <|> try childOf <|> try followedBy <|> space_---- | One or more simple selectors separated by combinators. -selector :: ParsecT [Char] u I.Identity [[Selector]]-selector = many1 simpleSelector `sepBy` (spaces >> string "," >> spaces)--css = parse selector ""

@@ -1,12 +0,0 @@-module Text.CSS.Utils where-import Data.List---- like break, except don't keep the element you broke on.--- and it takes a list as the thing to break on.-splitOn a xs = _splitOn a "" xs--_splitOn _ begin [] = (begin, [])-_splitOn a begin end@(x:xs)-  | a `isPrefixOf` end = (begin, drop (length a) end)-  | otherwise = _splitOn a (begin ++ [x]) xs-

@@ -1,85 +0,0 @@-module Text.HandsomeSoup (openUrl, fromUrl, parseHtml, (!), css) where--import Text.XML.HXT.Core-import Network.HTTP-import Network.URI-import Data.Tree.NTree.TypeDefs-import Control.Monad.Maybe-import Control.Monad.Trans-import Data.Maybe-import Text.Parsec-import qualified Data.Map as M-import Data.Monoid (mconcat)-import qualified Data.Functor.Identity as I-import qualified Debug.Trace as D-import Data.List-import Control.Monad-import Text.CSS.Parser hiding (css)-import Text.XML.HXT.Arrow.ReadDocument-import Text.XML.HXT.HTTP---- | Helper function for getting page content. Example:------ > contents <- runMaybeT $ openUrl "http://foo.com"-openUrl :: String -> MaybeT IO String-openUrl url = case parseURI url of-    Nothing -> fail "couldn't parse url"-    Just u  -> liftIO (getResponseBody =<< simpleHTTP (mkRequest GET u))---- | Given a url, returns a document. Example:------ > doc = fromUrl "http://foo.com"--- > doc = fromUrl "tests/test.html"-fromUrl :: String -> IOSArrow XmlTree (NTree XNode)-fromUrl url = readDocument [withValidate        no,-                            withInputEncoding   isoLatin1,-                            withParseByMimeType yes,-                            withHTTP            [],-                            withWarnings        no] url---- | Given a string, parses it and returns a document. Example:------ > doc = parseHtml "<h1>hello!</h1>"-parseHtml :: String -> IOSArrow XmlTree (NTree XNode)-parseHtml = readString [withParseHTML yes, withWarnings no]---- | Shortcut for getting attributes. Example:------ > doc >>> css "a" ! "href"-(!) :: ArrowXml cat => cat a XmlTree -> String -> cat a String-(!) a str = a >>> getAttrValue str---- | A css selector for getting elements from a document. Example:------ > doc >>> css "#menu li"-css :: ArrowXml a => [Char] -> a (NTree XNode) (NTree XNode)-css tag = case (parse selector "" tag) of-       Left err -> D.trace (show err) this-       Right x  -> fromSelectors x---- | Used internally. works on a selector (i.e a list of simple selectors)-fromSelectors sel@(s:selectors) = foldl (\acc selector -> acc <+> _fromSelectors selector) (_fromSelectors s) selectors---- | Used internally. works on simple selectors and their combinators-_fromSelectors (s:selectors) = foldl (\acc selector -> make acc selector) (make this s) selectors-  where -        make acc sel@(Selector name attrs pseudo)-          | name == "*" = acc >>> ((multi this >>> makeAttrs attrs) >>. makePseudos pseudo)-          | otherwise = acc >>> ((multi $ hasName name >>> makeAttrs attrs) >>. makePseudos pseudo)-        make acc Space = acc >>> getChildren-        make acc ChildOf = acc >>> getChildren >>> processChildren none-        makeAttrs (a:attrs) = foldl (\acc attr -> acc >>> makeAttr attr) (makeAttr a) attrs-        makeAttrs [] = this-        makeAttr (name, "") = hasAttr name-        makeAttr (name, '~':value) = hasAttrValue name (elem value . words)-        makeAttr (name, '|':value) = hasAttrValue name (headMatch value)-        makeAttr (name, value) = hasAttrValue name (==value)-        makePseudos (p:pseudos) = foldl (\acc pseudo -> acc >>> makePseudo pseudo) (makePseudo p) pseudos-        makePseudos [] = id-        makePseudo "first-child" = take 1---- | Used internally to match attribute selectors like @ [att|=val] @.--- From: http://www.w3.org/TR/CSS2/selector.html--- "Represents an element with the att attribute, its value either being exactly "val" or beginning with "val" immediately followed by '-'".-headMatch value attrValue = value == attrValue || value `isPrefixOf` attrValue-    where first = head . words $ attrValue

@@ -0,0 +1,10 @@+module Main where++import Text.HandsomeSoup+import Text.XML.HXT.Core++main :: IO ()+main = do+    let doc = fromUrl "http://www.google.com/search?q=egon+schiele"+    links <- runX $ doc >>> css "h3.r a" ! "href"+    mapM_ putStrLn links

@@ -0,0 +1,127 @@+module Text.CSS.Parser where++import Text.Parsec+import qualified Data.Functor.Identity as I+import Data.List+import Data.Maybe+import Text.CSS.Utils+-- if no tag name was given, sName will be set to '*'+-- attrs are (attr name, attr value).+-- if attr value is the empty string, we just check to+-- make sure that the element has that attribute.+--+-- if the attr value is prefixed with a '~', we treat+-- that attribute as a list of words separated by a space+-- and make sure that at least one of those words matches.+-- +-- if the attr value is prefixed with a `|`, the value must+-- be exactly val or start with val immediately followed by a '-'.+-- This is primarily intended to allow language subcode matches.+-- Example: [lang|="en"] matches "en", "en-US", etc.+-- From: http://www.w3.org/TR/CSS2/selector.html.+data Selector = Selector { sName :: String, sAttrs :: [(String,String)], spseudoSelectores :: [String] } | Space | ChildOf | FollowedBy deriving (Show)++-- pretty printers for debugging+pp Space = "<space>"+pp ChildOf = "<child of>"+pp FollowedBy = "<followed by>"+pp (Selector name attrs pseudo) = show name ++ ":" ++ showMap attrs ++ ", " ++ show pseudo+    where showMap m = ("{" ++ (foldl (\acc (k,v) -> acc ++ (show k) ++ ":" ++ (show v) ++ ", ") "" m)) ++ "}"++{- Some lexeme parsers -}+ident :: ParsecT [Char] u I.Identity String+ident = do c1 <- optionMaybe (char '-')+           c2 <- nmstart+           cs <- many nmchar+           return $ concat [maybeToList c1, [c2], cs]++nmstart = alphaNum <|> char '_'+nmchar  = alphaNum <|> oneOf "_-"++{- TYPE SELECTORS FOLLOW -}++-- | selects a tag name, like @ h1 @+typeSelector :: ParsecT [Char] u I.Identity [Char]+typeSelector = many1 (alphaNum <|> oneOf "_-")++-- | universal selector, selects @ * @+universalSelector :: ParsecT [Char] u I.Identity String+universalSelector = string "*"++{- SECONDARY SELECTORS FOLLOW -}++-- | selects a pseudo-element or pseudo-class, like @ :link @, @ :first-child @ etc.+pseudoSelector :: ParsecT [Char] u I.Identity [Char]+pseudoSelector = char ':' >> many1 (alphaNum <|> oneOf "-()")++-- | class selector, selects @ .foo @+classSelector :: ParsecT [Char] u I.Identity ([Char], [Char])+classSelector = do+    val <- char '.' >> ident+    return ("class", '~':val)++-- | id selector, selects @ #foo @+idSelector :: ParsecT [Char] u I.Identity ([Char], [Char])+idSelector = do+    val <- char '#' >> many1 nmchar+    return ("id", val)++-- | selects attributes, like @ [id] @ (element must have id) or @ [id=foo] @ (element must have id foo).+attributeSelector :: ParsecT [Char] u I.Identity ([Char], [Char])+attributeSelector = do+      _contents <- between (char '[') (char ']') (many1 (alphaNum <|> oneOf "/-_|~=\"'."))+      -- remove quotes+      let contents = filter (\c -> c /= '"' && c /= '\'') _contents+      if "~=" `isInfixOf` contents +          then return $ (\(a, b) -> (a, '~':b)) $ splitOn "~=" contents+          else if "|=" `isInfixOf` contents +              then return $ (\(a, b) -> (a, '|':b)) $ splitOn "|=" contents+              else if '=' `elem` contents+                   then return $ splitOn "=" contents+                   else return (contents, "")++-- | selector for everything after the type except pseudoSelectores+secondarySelector = many1 (classSelector <|> idSelector <|> attributeSelector)++{- COMBINATOR SELECTORS FOLLOW -}++space_ = do+    many1 $ string " "+    return Space++childOf = do+    spaces >> string ">" >> spaces+    return ChildOf++followedBy = do+    spaces >> string "+" >> spaces+    return FollowedBy++{- SIMPLE SELECTORS FOLLOW -}++-- | selects a tagname followed by one or more secondary selectors+-- example: @ a.foo @, @ *#hello @, @ h1 @ etc+simpleSelectorTag :: ParsecT [Char] u I.Identity Selector+simpleSelectorTag = do+    tagName <- typeSelector <|> universalSelector+    attrs <- secondarySelector <|> return []+    pseudo <- many1 pseudoSelector <|> return []+    return $ Selector tagName attrs pseudo++-- | selects one or more secondary selectors+-- and automatically prepends the universal selector to them.+-- example: @ .foo @, @ #hello @ etc+simpleSelectorNoTag = do+    attrs <- secondarySelector+    pseudo <- many1 pseudoSelector <|> return []+    return $ Selector "*" attrs pseudo++-- | A simple selector is either a type selector or universal selector followed immediately by zero or more attribute selectors, ID selectors, or pseudo-classes, in any order.+simpleSelector :: ParsecT [Char] u I.Identity Selector+simpleSelector = simpleSelectorTag <|> simpleSelectorNoTag <|> try childOf <|> try followedBy <|> space_++-- | One or more simple selectors separated by combinators. +selector :: ParsecT [Char] u I.Identity [[Selector]]+selector = many1 simpleSelector `sepBy` (spaces >> string "," >> spaces)++css = parse selector ""

@@ -0,0 +1,12 @@+module Text.CSS.Utils where+import Data.List++-- like break, except don't keep the element you broke on.+-- and it takes a list as the thing to break on.+splitOn a xs = _splitOn a "" xs++_splitOn _ begin [] = (begin, [])+_splitOn a begin end@(x:xs)+  | a `isPrefixOf` end = (begin, drop (length a) end)+  | otherwise = _splitOn a (begin ++ [x]) xs+

@@ -0,0 +1,90 @@+module Text.HandsomeSoup (openUrl, fromUrl, parseHtml, (!), css) where++import Text.XML.HXT.Core+import Network.HTTP+import Network.URI+import Data.Tree.NTree.TypeDefs+import Control.Monad.Maybe+import Control.Monad.Trans+import Data.Maybe+import Text.Parsec+import qualified Data.Map as M+import Data.Monoid (mconcat)+import qualified Data.Functor.Identity as I+import qualified Debug.Trace as D+import Data.List+import Control.Monad+import Text.CSS.Parser hiding (css)+import Text.XML.HXT.Arrow.ReadDocument+import Text.XML.HXT.HTTP++-- | Helper function for getting page content. Example:+--+-- > contents <- runMaybeT $ openUrl "http://foo.com"+openUrl :: String -> MaybeT IO String+openUrl url = case parseURI url of+    Nothing -> fail "couldn't parse url"+    Just u  -> liftIO (getResponseBody =<< simpleHTTP (mkRequest GET u))++-- | Given a url, returns a document. Example:+--+-- > doc = fromUrl "http://foo.com"+-- > doc = fromUrl "tests/test.html"+fromUrl :: String -> IOSArrow b (NTree XNode)+fromUrl url = readDocument [withValidate        no,+                            withInputEncoding   isoLatin1,+                            withParseByMimeType yes,+                            withHTTP            [],+                            withWarnings        no] url++-- | Given a string, parses it and returns a document. Example:+--+-- > doc = parseHtml "<h1>hello!</h1>"+parseHtml :: String -> IOSArrow b (NTree XNode)+parseHtml = readString [withParseHTML yes, withWarnings no]++-- | Shortcut for getting attributes. Example:+--+-- > doc >>> css "a" ! "href"+(!) :: ArrowXml cat => cat a XmlTree -> String -> cat a String+(!) a str = a >>> getAttrValue str++-- | A css selector for getting elements from a document. Example:+--+-- > doc >>> css "#menu li"+css :: ArrowXml a => [Char] -> a (NTree XNode) (NTree XNode)+css tag = case (parse selector "" tag) of+       Left err -> D.trace (show err) this+       Right x  -> fromSelectors x++-- | Used internally. works on a selector (i.e a list of simple selectors)+fromSelectors sel@(s:selectors) = foldl (\acc selector -> acc <+> _fromSelectors selector) (_fromSelectors s) selectors++-- | Used internally. works on simple selectors and their combinators+_fromSelectors (s:selectors) = foldl (\acc selector -> make acc selector) (make this s) selectors+  where +        make acc sel@(Selector name attrs pseudo)+          | name == "*" = acc >>> ((multi this >>> makeAttrs attrs) >>. makePseudos pseudo)+          | otherwise = acc >>> ((multi $ hasName name >>> makeAttrs attrs) >>. makePseudos pseudo)+        make acc Space = acc >>> getChildren+        make acc ChildOf = acc >>> getChildren >>> processChildren none+        makeAttrs (a:attrs) = foldl (\acc attr -> acc >>> makeAttr attr) (makeAttr a) attrs+        makeAttrs [] = this+        makeAttr (name, "") = hasAttr name+        makeAttr (name, '~':value) = hasAttrValue name (elem value . words)+        makeAttr (name, '|':value) = hasAttrValue name (headMatch value)+        makeAttr (name, value) = hasAttrValue name (==value)+        makePseudos (p:pseudos) = foldl (\acc pseudo -> acc >>> makePseudo pseudo) (makePseudo p) pseudos+        makePseudos [] = id+        makePseudo selector+            | selector == "first-child" = take 1+            | nthSelector selector = take 1 . drop (n - 1)+            where nthSelector selector = take 10 selector == "nth-child("+                  getN selector = read $ (takeWhile (/= ')') . drop 10) selector :: Int+                  n = getN selector++-- | Used internally to match attribute selectors like @ [att|=val] @.+-- From: http://www.w3.org/TR/CSS2/selector.html+-- "Represents an element with the att attribute, its value either being exactly "val" or beginning with "val" immediately followed by '-'".+headMatch value attrValue = value == attrValue || value `isPrefixOf` attrValue+    where first = head . words $ attrValue

@@ -0,0 +1,75 @@+module Main where++import Text.HandsomeSoup+import Text.XML.HXT.Core+import System.IO.Unsafe+import Paths_HandsomeSoup++import Test.Hspec.Monadic++-- mk :: (Show a, Eq a, ArrowXml b) => String -> b (T.NTree XNode) (T.NTree XNode) -> a -> Test+run action = unsafePerformIO $ do+      testFile <- getDataFileName "tests/test.html"+      {- runX $ (fromUrl "tests/test.html") >>> action -}+      runX $ (fromUrl testFile) >>> action++main :: IO ()+main = hspec $ do+  describe "tests" $ do+    it "should get all links" $+      run (css "a" >>> getName) == ["a", "a", "a"]++    it "should get every element" $+      run (css "*" >>> getName) == ["/","html","head","title","body","h1","b","p","strong","a","strong","a","a","p","div","p"]++    it "should get descendents" $+      run (css "p strong" >>> getName) == ["strong", "strong"]++    it "should get children (negative test)" $+      run (css "p > strong" >>> getName) == ["strong"]++    it "should get children" $+      run (css "a > strong" >>> getName) == ["strong"]++    it ":first-child pseudo-element" $+      run (css "a:first-child" >>> getName) == ["a"]++    describe "attribute selector" $ do+      it "no value" $+        run (css "p[class]" >>> getName) == ["p"]++      it "exact value" $+        run (css "a[class=sister]" >>> getName) == ["a", "a"]++      it "inexact value" $+        run (css "a[class~=sister]" >>> getName) == ["a", "a", "a"]++      it "using |" $+        run (css "[lang|='en']" >>> getName) == ["html"]++      it "underscore in attribute selector should work" $+        run (css "div[class=curr_lang]" >>> getName) == ["div"]++      it "dash in attribute selector should work" $+        run (css "p[data-original=test]" >>> getName) == ["p"]++    it "class selector" $+      run (css "a.sister" >>> getName) == ["a", "a", "a"]++    it "class selector #2" $+      run (css ".sister" >>> getName) == ["a", "a", "a"]++    it "id selector" $+      run (css "a#link1" >>> getName) == ["a"]++    it "both class and id selectors" $+      run (css "a.sister#link1" >>> getName) == ["a"]++    it "should ignore extra spaces" $+      run (css "html  body" >>> getName) == ["body"]++    it "should handle multiple elements" $+      run (css "a, p" >>> getName) == ["a","a","a","p","p","p"]++    it "should get grandchildren only" $+      run (css "p * strong" >>> getName) == ["strong"]

@@ -0,0 +1,20 @@+<html lang="en-US"><head><title>The Dormouse's story</title></head>+  <body>+    <h1 class="title"><b>The Dormouse's story</b></h1>++    <p class="story">Once upon a time there were three little sisters; and their names were+      <strong>test</strong>+  <a href="http://example.com/elsie" class="sister wut" id="link1"><strong>Elsie</strong></a>,+<a href="http://example.com/lacie" class="sister" id="link2">Lacie</a> and+<a href="http://example.com/tillie" class="sister" id="link3">Tillie</a>;+and they lived at the bottom of a well.</p>++<p data-original="test">foo</p>++<div class="curr_lang">+<p>+Inside a div.+</p>+</div>+</body>+</html>