scalpel 0.2.1.1 → 0.3.0

raw patch · 11 files changed

+372/−141 lines, 11 filesdep +containersdep +criteriondep +data-defaultdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: containers, criterion, data-default

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• README.md +2/−2
• benchmarks/Main.hs +41/−0
• scalpel.cabal +16/−2
• src/Text/HTML/Scalpel.hs +8/−5
• src/Text/HTML/Scalpel/Internal/Scrape.hs +23/−18
• src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs +2/−1
• src/Text/HTML/Scalpel/Internal/Scrape/URL.hs +79/−10
• src/Text/HTML/Scalpel/Internal/Select.hs +127/−31
• src/Text/HTML/Scalpel/Internal/Select/Types.hs +2/−1
• tests/TestMain.hs +61/−71

@@ -2,6 +2,17 @@  ## HEAD +## 0.3.0++- Added benchmarks and many optimizations.+- The `select` method is removed from the public API.+- Many methods now have a constraint that the string type parametrizing+  TagSoup's tag type now must be order-able.+- Added `scrapeUrlWithConfig` that will hopefully put an end to multiplying+  `scrapeUrlWith*` methods.+- The default behaviour of the `scrapeUrl*` methods is to attempt to infer the+  character encoding from the `Content-Type` header.+ ## 0.2.1.1  - Cleanup stale instance references in documentation of TagName and

@@ -48,8 +48,8 @@ -------  Complete examples can be found in the-[examples](https://github.com/fimad/scalpel/examples) folder in the scalpel git-repository.+[examples](https://github.com/fimad/scalpel/tree/master/examples) folder in the+scalpel git repository.  The following is an example that demonstrates most of the features provided by this library. Supposed you have the following hypothetical HTML located at

@@ -0,0 +1,41 @@+import Text.HTML.Scalpel++import Control.Applicative ((<$>))+import Control.Monad (replicateM_)+import Criterion.Main (bgroup, bench, defaultMain, nf)+import qualified Data.Text as T+++main :: IO ()+main = do+    let nested100  = makeNested 100+    let nested1000 = makeNested 1000+    let nested10000 = makeNested 10000+    defaultMain [+            bgroup "nested" [+                bench "100" $ nf sumListTags nested100+            ,   bench "1000" $ nf sumListTags nested1000+            ,   bench "10000" $ nf sumListTags nested10000+            ]+        ,   bgroup "many-selects" [+                bench "10"  $ nf (manySelects 10) nested1000+            ,   bench "100" $ nf (manySelects 100) nested1000+            ,   bench "1000" $ nf (manySelects 1000) nested1000+            ]+        ]++makeNested :: Int -> T.Text+makeNested i = T.concat [T.replicate i open, one, T.replicate i close]+    where+        open  = T.pack "<tag>"+        close = T.pack "</tag>"+        one   = T.pack "1"++sumListTags :: T.Text -> Maybe Integer+sumListTags testData = scrapeStringLike testData+                     $ (sum . map (const 1)) <$> texts "tag"++manySelects :: Int -> T.Text -> Maybe ()+manySelects i testData = scrapeStringLike testData+                       $ replicateM_ i+                       $ texts "tag"

@@ -1,5 +1,5 @@ name:                scalpel-version:             0.2.1.1+version:             0.3.0 synopsis:            A high level web scraping library for Haskell. description:     Scalpel is a web scraping library inspired by libraries like Parsec and@@ -24,7 +24,7 @@ source-repository this   type:     git   location: https://github.com/fimad/scalpel.git-  tag:      v0.2.1.1+  tag:      v0.3.0  library   other-extensions:@@ -44,7 +44,9 @@   build-depends:           base          >= 4.6 && < 5       ,   bytestring+      ,   containers       ,   curl          >= 1.3.4+      ,   data-default       ,   regex-base       ,   regex-tdfa       ,   tagsoup       >= 0.12.2@@ -69,3 +71,15 @@           ParallelListComp       ,   PatternGuards   ghc-options: -W++benchmark bench+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  hs-source-dirs:   benchmarks+  main-is:          Main.hs+  build-depends:+      base               >=4.7 && <5+    , criterion          >=1.1+    , scalpel+    , text+  ghc-options: -Wall

@@ -95,8 +95,8 @@ -- >            return $ ImageComment author imageURL -- -- Complete examples can be found in the--- <https://github.com/fimad/scalpel/examples examples> folder in the scalpel--- git repository.+-- <https://github.com/fimad/scalpel/tree/master/examples examples> folder in+-- the scalpel git repository. module Text.HTML.Scalpel ( -- * Selectors     Selector@@ -113,8 +113,6 @@ ,   (@=) ,   (@=~) ,   hasClass--- ** Executing selectors-,   select  -- * Scrapers ,   Scraper@@ -133,11 +131,16 @@ ,   URL ,   scrapeURL ,   scrapeURLWithOpts+,   scrapeURLWithConfig+,   Config (..)+,   Decoder+,   defaultDecoder+,   utf8Decoder+,   iso88591Decoder ) where  import Text.HTML.Scalpel.Internal.Scrape import Text.HTML.Scalpel.Internal.Scrape.StringLike import Text.HTML.Scalpel.Internal.Scrape.URL-import Text.HTML.Scalpel.Internal.Select import Text.HTML.Scalpel.Internal.Select.Combinators import Text.HTML.Scalpel.Internal.Select.Types

@@ -1,6 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Scrape (-    Scraper (..)+    Scraper+,   scrape ,   attr ,   attrs ,   html@@ -25,9 +26,7 @@ -- | A value of 'Scraper' @a@ defines a web scraper that is capable of consuming -- a list of 'TagSoup.Tag's and optionally producing a value of type @a@. newtype Scraper str a = MkScraper {-        -- | The 'scrape' function executes a 'Scraper' on a list of-        -- 'TagSoup.Tag's and produces an optional value.-        scrape :: [TagSoup.Tag str] -> Maybe a+        scrapeOffsets :: [(TagSoup.Tag str, CloseOffset)] -> Maybe a     }  instance Functor (Scraper str) where@@ -56,13 +55,19 @@     mzero = empty     mplus = (<|>) +-- | The 'scrape' function executes a 'Scraper' on a list of+-- 'TagSoup.Tag's and produces an optional value.+scrape :: (Ord str, TagSoup.StringLike str)+       => Scraper str a -> [TagSoup.Tag str] -> Maybe a+scrape s = scrapeOffsets s . tagWithOffset+ -- | The 'chroot' function takes a selector and an inner scraper and executes -- the inner scraper as if it were scraping a document that consists solely of -- the tags corresponding to the selector. -- -- This function will match only the first set of tags matching the selector, to -- match every set of tags, use 'chroots'.-chroot :: (TagSoup.StringLike str, Selectable s)+chroot :: (Ord str, TagSoup.StringLike str, Selectable s)        => s -> Scraper str a -> Scraper str a chroot selector (MkScraper inner) = MkScraper                                   $ join . (inner <$>)@@ -72,7 +77,7 @@ -- the inner scraper as if it were scraping a document that consists solely of -- the tags corresponding to the selector. The inner scraper is executed for -- each set of tags matching the given selector.-chroots :: (TagSoup.StringLike str, Selectable s)+chroots :: (Ord str, TagSoup.StringLike str, Selectable s)         => s -> Scraper str a -> Scraper str [a] chroots selector (MkScraper inner) = MkScraper                                    $ return . mapMaybe inner . select selector@@ -82,26 +87,26 @@ -- -- This function will match only the first set of tags matching the selector, to -- match every set of tags, use 'texts'.-text :: (TagSoup.StringLike str, Selectable s) => s -> Scraper str str-text s = MkScraper $ withHead tagsToText . select s+text :: (Ord str, TagSoup.StringLike str, Selectable s) => s -> Scraper str str+text s = MkScraper $ withHead tagsToText . select_ s  -- | The 'texts' function takes a selector and returns the inner text from every -- set of tags matching the given selector.-texts :: (TagSoup.StringLike str, Selectable s) => s -> Scraper str [str]-texts s = MkScraper $ withAll tagsToText . select s+texts :: (Ord str, TagSoup.StringLike str, Selectable s) => s -> Scraper str [str]+texts s = MkScraper $ withAll tagsToText . select_ s  -- | The 'html' function takes a selector and returns the html string from the -- set of tags described by the given selector. -- -- This function will match only the first set of tags matching the selector, to -- match every set of tags, use 'htmls'.-html :: (TagSoup.StringLike str, Selectable s) => s -> Scraper str str-html s = MkScraper $ withHead tagsToHTML . select s+html :: (Ord str, TagSoup.StringLike str, Selectable s) => s -> Scraper str str+html s = MkScraper $ withHead tagsToHTML . select_ s  -- | The 'htmls' function takes a selector and returns the html string from every -- set of tags matching the given selector.-htmls :: (TagSoup.StringLike str, Selectable s) => s -> Scraper str [str]-htmls s = MkScraper $ withAll tagsToHTML . select s+htmls :: (Ord str, TagSoup.StringLike str, Selectable s) => s -> Scraper str [str]+htmls s = MkScraper $ withAll tagsToHTML . select_ s  -- | The 'attr' function takes an attribute name and a selector and returns the -- value of the attribute of the given name for the first opening tag that@@ -109,18 +114,18 @@ -- -- This function will match only the opening tag matching the selector, to match -- every tag, use 'attrs'.-attr :: (Show str, TagSoup.StringLike str, Selectable s)+attr :: (Ord str, Show str, TagSoup.StringLike str, Selectable s)      => String -> s -> Scraper str str attr name s = MkScraper-            $ join . withHead (tagsToAttr $ TagSoup.castString name) . select s+            $ join . withHead (tagsToAttr $ TagSoup.castString name) . select_ s  -- | The 'attrs' function takes an attribute name and a selector and returns the -- value of the attribute of the given name for every opening tag that matches -- the given selector.-attrs :: (Show str, TagSoup.StringLike str, Selectable s)+attrs :: (Ord str, Show str, TagSoup.StringLike str, Selectable s)      => String -> s -> Scraper str [str] attrs name s = MkScraper-             $ fmap catMaybes . withAll (tagsToAttr nameStr) . select s+             $ fmap catMaybes . withAll (tagsToAttr nameStr) . select_ s     where nameStr = TagSoup.castString name  withHead :: (a -> b) -> [a] -> Maybe b

@@ -11,5 +11,6 @@  -- | The 'scrapeStringLike' function parses a 'StringLike' value into a list of -- tags and executes a 'Scraper' on it.-scrapeStringLike :: TagSoup.StringLike str => str -> Scraper str a -> Maybe a+scrapeStringLike :: (Ord str, TagSoup.StringLike str)+                 => str -> Scraper str a -> Maybe a scrapeStringLike html scraper = scrape scraper (TagSoup.parseTags html)

@@ -1,15 +1,29 @@ {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Scrape.URL (     URL+,   Config (..)+,   Decoder++,   defaultDecoder+,   utf8Decoder+,   iso88591Decoder+ ,   scrapeURL ,   scrapeURLWithOpts+,   scrapeURLWithConfig ) where  import Text.HTML.Scalpel.Internal.Scrape -import Control.Applicative+import Control.Applicative ((<$>))+import Data.Char (toLower)+import Data.Default (def)+import Data.List (isInfixOf)+import Data.Maybe (listToMaybe)  import qualified Data.ByteString as BS+import qualified Data.Default as Default+import qualified Data.Text.Encoding as Text import qualified Network.Curl as Curl import qualified Text.HTML.TagSoup as TagSoup import qualified Text.StringLike as TagSoup@@ -17,31 +31,86 @@  type URL = String +type CurlResponse = Curl.CurlResponse_ [(String, String)] BS.ByteString++-- | A method that takes a HTTP response as raw bytes and returns the body as a+-- string type.+type Decoder str = Curl.CurlResponse_ [(String, String)] BS.ByteString -> str++-- | A record type that determines how 'scrapeUrlWithConfig' interacts with the+-- HTTP server and interprets the results.+data Config str = Config {+    curlOpts :: [Curl.CurlOption]+,   decoder  :: Decoder str+}++instance TagSoup.StringLike str => Default.Default (Config str) where+    def = Config {+            curlOpts = [Curl.CurlFollowLocation True]+        ,   decoder  = defaultDecoder+        }+ -- | The 'scrapeURL' function downloads the contents of the given URL and -- executes a 'Scraper' on it.-scrapeURL :: TagSoup.StringLike str => URL -> Scraper str a -> IO (Maybe a)+scrapeURL :: (Ord str, TagSoup.StringLike str)+          => URL -> Scraper str a -> IO (Maybe a) scrapeURL = scrapeURLWithOpts [Curl.CurlFollowLocation True]  -- | The 'scrapeURLWithOpts' function take a list of curl options and downloads -- the contents of the given URL and executes a 'Scraper' on it.-scrapeURLWithOpts :: TagSoup.StringLike str+scrapeURLWithOpts :: (Ord str, TagSoup.StringLike str)                   => [Curl.CurlOption] -> URL -> Scraper str a -> IO (Maybe a)-scrapeURLWithOpts options url scraper = do-    maybeTags <- downloadAsTags url+scrapeURLWithOpts options = scrapeURLWithConfig (def {curlOpts = options})++-- | The 'scrapeURLWithConfig' function takes a 'Config' record type and+-- downloads the contents of the given URL and executes a 'Scraper' on it.+scrapeURLWithConfig :: (Ord str, TagSoup.StringLike str)+                  => Config str -> URL -> Scraper str a -> IO (Maybe a)+scrapeURLWithConfig config url scraper = do+    maybeTags <- downloadAsTags (decoder config) url     return (maybeTags >>= scrape scraper)     where-        downloadAsTags url = do-            maybeBytes <- openURIWithOpts url options-            return $ (TagSoup.parseTags . TagSoup.castString) <$> maybeBytes+        downloadAsTags decoder url = do+            maybeBytes <- openURIWithOpts url (curlOpts config)+            return $ TagSoup.parseTags . decoder <$> maybeBytes -openURIWithOpts :: URL -> [Curl.CurlOption] -> IO (Maybe BS.ByteString)+openURIWithOpts :: URL -> [Curl.CurlOption] -> IO (Maybe CurlResponse) openURIWithOpts url opts = do     resp <- curlGetResponse_ url opts     return $ if Curl.respCurlCode resp /= Curl.CurlOK         then Nothing-        else Just $ Curl.respBody resp+        else Just resp  curlGetResponse_ :: URL                  -> [Curl.CurlOption]                  -> IO (Curl.CurlResponse_ [(String, String)] BS.ByteString) curlGetResponse_ = Curl.curlGetResponse_++-- | The default response decoder. This decoder attempts to infer the character+-- set of the HTTP response body from the `Content-Type` header. If this header+-- is not present, then the character set is assumed to be `ISO-8859-1`.+defaultDecoder :: TagSoup.StringLike str => Decoder str+defaultDecoder response = TagSoup.castString+                        $ choosenDecoder body+    where+        body        = Curl.respBody response+        headers     = Curl.respHeaders response+        contentType = listToMaybe+                    $ map (map toLower . snd)+                    $ take 1+                    $ dropWhile ((/= "content-type") . map toLower . fst)+                                headers++        isType t | Just ct <- contentType = ("charset=" ++ t) `isInfixOf` ct+                 | otherwise              = False++        choosenDecoder | isType "utf-8" = Text.decodeUtf8+                       | otherwise      = Text.decodeLatin1++-- | A decoder that will always decode using `UTF-8`.+utf8Decoder ::  TagSoup.StringLike str => Decoder str+utf8Decoder = TagSoup.castString . Text.decodeUtf8 . Curl.respBody++-- | A decoder that will always decode using `ISO-8859-1`.+iso88591Decoder ::  TagSoup.StringLike str => Decoder str+iso88591Decoder = TagSoup.castString . Text.decodeLatin1 . Curl.respBody

@@ -1,27 +1,112 @@ {-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-} {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Select (-    select+    CloseOffset++,   select+,   select_+,   tagWithOffset ) where  import Text.HTML.Scalpel.Internal.Select.Types -import Data.List+import Control.Applicative ((<$>), (<|>))+import Control.Arrow (first)+import Data.List (tails)+import Data.Maybe (catMaybes)+import GHC.Exts (sortWith) +import qualified Data.Map.Strict as Map import qualified Text.HTML.TagSoup as TagSoup import qualified Text.StringLike as TagSoup  +type CloseOffset = Maybe Int+ -- | The 'select' function takes a 'Selectable' value and a list of -- 'TagSoup.Tag's and returns a list of every subsequence of the given list of -- Tags that matches the given selector.-select :: (TagSoup.StringLike str, Selectable s)-       => s -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]+select :: (Ord str, TagSoup.StringLike str, Selectable s)+       => s+       -> [(TagSoup.Tag str, CloseOffset)]+       -> [[(TagSoup.Tag str, CloseOffset)]] select s = selectNodes nodes     where (MkSelector nodes) = toSelector s +-- | Like 'select' but strips the 'CloseOffset' from the result.+select_ :: (Ord str, TagSoup.StringLike str, Selectable s)+       => s+       -> [(TagSoup.Tag str, CloseOffset)]+       -> [[TagSoup.Tag str]]+select_ s = map (map fst) . select s++-- | Annotate each tag with the offset to the corresponding closing tag. This+-- annotating is done in O(n * log(n)).+--+-- The algorithm works on a list of tags annotated with their index. It+-- maintains a map of unclosed open tags keyed by tag name.+--+--      (1) When an open tag is encountered it is pushed onto the list keyed by+--          its name.+--+--      (2) When a closing tag is encountered the corresponding opening tag is+--          popped, the offset between the two are computed, the opening tag is+--          annotated with the offset between the two, and both are added to the+--          result set.+--+--      (3) When any other tag is encountered it is added to the result set+--          immediately.+--+--      (4) After all tags are either in the result set or the state, all+--          unclosed tags from the state are added to the result set without a+--          closing offset.+--+--      (5) The result set is then sorted and the indices are stripped from the+--          tags.+tagWithOffset :: forall str. (Ord str, TagSoup.StringLike str)+              => [TagSoup.Tag str] -> [(TagSoup.Tag str, CloseOffset)]+tagWithOffset tags = let indexed  = zip tags [0..]+                         unsorted = go indexed Map.empty+                         sorted   = sortWith snd unsorted+                      in map fst sorted+    where+        go :: [(TagSoup.Tag str, Int)]+           -> Map.Map str [(TagSoup.Tag str, Int)]+           -> [((TagSoup.Tag str, CloseOffset), Int)]+        go [] state = map (first (, Nothing)) $ concat $ Map.elems state+        go (x@(tag, index) : xs) state+            | TagSoup.isTagClose tag =+                let maybeOpen = head <$> Map.lookup tagName state+                    state'    = Map.alter popTag tagName state+                    res       = catMaybes [+                                        Just ((tag, Nothing), index)+                                    ,   calcOffset <$> maybeOpen+                                    ]+                 in res ++ go xs state'+            | TagSoup.isTagOpen tag  = go xs (Map.alter appendTag tagName state)+            | otherwise              = ((tag, Nothing), index) : go xs state+            where+                tagName = getTagName tag++                appendTag :: Maybe [(TagSoup.Tag str, Int)]+                          -> Maybe [(TagSoup.Tag str, Int)]+                appendTag m = (x :) <$> (m <|> Just [])++                calcOffset :: (t, Int) -> ((t, Maybe Int), Int)+                calcOffset (t, i) =+                    let offset = index - i+                     in offset `seq` ((t, Just offset), i)++                popTag :: Maybe [a] -> Maybe [a]+                popTag (Just (_ : y : xs)) = let s = y : xs in s `seq` Just s+                popTag _                   = Nothing+ selectNodes :: TagSoup.StringLike str-            => [SelectNode] -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]+            => [SelectNode]+            -> [(TagSoup.Tag str, CloseOffset)]+            -> [[(TagSoup.Tag str, CloseOffset)]] selectNodes nodes tags = head' $ reverse results     where results = [concatMap (selectNode s) ts | s  <- nodes                                                  | ts <- [tags] : results]@@ -29,50 +114,61 @@           head' (x:_) = x  selectNode :: TagSoup.StringLike str-           => SelectNode -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]+           => SelectNode+           -> [(TagSoup.Tag str, CloseOffset)]+           -> [[(TagSoup.Tag str, CloseOffset)]] selectNode (SelectNode node attributes) tags = concatMap extractTagBlock nodes     where nodes = filter (checkTag node attributes) $ tails tags selectNode (SelectAny attributes) tags = concatMap extractTagBlock nodes     where nodes = filter (checkPreds attributes) $ tails tags --- Given a tag name and a list of attribute predicates return a function that+-- | Given a tag name and a list of attribute predicates return a function that -- returns true if a given tag matches the supplied name and predicates. checkTag :: TagSoup.StringLike str-          => String -> [AttributePredicate] -> [TagSoup.Tag str] -> Bool-checkTag name preds tags@(TagSoup.TagOpen str _:_)+          => String+          -> [AttributePredicate]+          -> [(TagSoup.Tag str, CloseOffset)]+          -> Bool+checkTag name preds tags@((TagSoup.TagOpen str _, _) : _)     = TagSoup.fromString name == str && checkPreds preds tags checkTag _ _ _ = False  checkPreds :: TagSoup.StringLike str-            => [AttributePredicate] -> [TagSoup.Tag str] -> Bool-checkPreds preds (TagSoup.TagOpen _ attrs:_)+            => [AttributePredicate] -> [(TagSoup.Tag str, CloseOffset)] -> Bool+checkPreds preds ((TagSoup.TagOpen _ attrs, _) : _)     = and [or [checkPred p attr | attr <- attrs] | p <- preds] checkPreds _ _ = False --- Given a list of tags, return the prefix of the tags up to the closing tag+-- | Given a list of tags, return the prefix of the tags up to the closing tag -- that corresponds to the initial tag. extractTagBlock :: TagSoup.StringLike str-                => [TagSoup.Tag str] -> [[TagSoup.Tag str]]-extractTagBlock [] = []-extractTagBlock (openTag : tags)-    | not $ TagSoup.isTagOpen openTag = []-    | otherwise                       = fakeClosingTag openTag-                                      $ map (openTag :)-                                      $ splitBlock (getTagName openTag) 0 tags+                => [(TagSoup.Tag str, CloseOffset)]+                -> [[(TagSoup.Tag str, CloseOffset)]]+extractTagBlock (ctag@(tag, maybeOffset) : tags)+    | not $ TagSoup.isTagOpen tag = []+    | Just offset <- maybeOffset  = [takeOrClose ctag offset tags]+    -- To handle tags that do not have a closing tag, fake an empty block by+    -- adding a closing tag. This function assumes that the tag is an open+    -- tag.+    | otherwise                   = [[ctag, (closeForOpen tag, Nothing)]]+extractTagBlock _                 = []++-- | Take offset number of elements from tags if available. If there are not+-- that many available, then fake a closing tag for the open tag. This happens+-- with malformed HTML that looks like `<a><b></a></b>`.+takeOrClose :: TagSoup.StringLike str+            => (TagSoup.Tag str, CloseOffset)+            -> Int+            -> [(TagSoup.Tag str, CloseOffset)]+            -> [(TagSoup.Tag str, CloseOffset)]+takeOrClose open@(tag, _) offset tags = go offset tags (open :)     where-        -- To handle tags that do not have a closing tag, fake an empty block by-        -- adding a closing tag.-        fakeClosingTag openTag@(TagSoup.TagOpen name _) []-            = [[openTag, TagSoup.TagClose name]]-        fakeClosingTag _ blocks = blocks+        go 0 _        f = f []+        go _ []       _ = [open, (closeForOpen tag, Nothing)]+        go i (x : xs) f = go (i - 1) xs (f . (x :)) -splitBlock _    _       []                          = []-splitBlock name depth  (tag : tags)-    | depth == 0 && TagSoup.isTagCloseName name tag = [[tag]]-    | TagSoup.isTagCloseName name tag = tag_ $ splitBlock name (depth - 1) tags-    | TagSoup.isTagOpenName name tag  = tag_ $ splitBlock name (depth + 1) tags-    | otherwise                       = tag_ $ splitBlock name depth tags-    where tag_ = map (tag :)+closeForOpen :: TagSoup.StringLike str => TagSoup.Tag str -> TagSoup.Tag str+closeForOpen = TagSoup.TagClose . getTagName  getTagName :: TagSoup.StringLike str => TagSoup.Tag str -> str getTagName (TagSoup.TagOpen name _) = name

@@ -42,7 +42,8 @@ -- returns a 'Bool' indicating if the given attribute matches a predicate. data AttributePredicate         = MkAttributePredicate-                (TagSoup.StringLike str => TagSoup.Attribute str -> Bool)+                (forall str. TagSoup.StringLike str => TagSoup.Attribute str+                                                    -> Bool)  checkPred :: TagSoup.StringLike str           => AttributePredicate -> TagSoup.Attribute str -> Bool

@@ -13,7 +13,6 @@  main = exit . failures =<< runTestTT (TestList [         scrapeTests-    ,   selectTests     ,   scrapeHtmlsTests     ,   scrapeHtmlTests     ])@@ -22,100 +21,91 @@ exit 0 = exitSuccess exit n = exitWith $ ExitFailure n -selectTests = "selectTests" ~: TestList [-        selectTest-            ("a" @: [])+re :: String -> Text.Regex.TDFA.Regex+re = Text.Regex.TDFA.makeRegex++scrapeTests = "scrapeTests" ~: TestList [+        scrapeTest             "<a>foo</a>"-            ["<a>foo</a>"]+            (Just ["<a>foo</a>"])+            (htmls ("a" @: [])) -    ,   selectTest-            ("a" @: [])+    ,   scrapeTest             "<a>foo</a><a>bar</a>"-            ["<a>foo</a>", "<a>bar</a>"]+            (Just ["<a>foo</a>", "<a>bar</a>"])+            (htmls ("a" @: [])) -    ,   selectTest-            ("a" @: [])+    ,   scrapeTest             "<b><a>foo</a></b>"-            ["<a>foo</a>"]+            (Just ["<a>foo</a>"])+            (htmls ("a" @: [])) -    ,   selectTest-            ("a" @: [])+    ,   scrapeTest             "<a><a>foo</a></a>"-            ["<a><a>foo</a></a>", "<a>foo</a>"]+            (Just ["<a><a>foo</a></a>", "<a>foo</a>"])+            (htmls ("a" @: [])) -    ,   selectTest-            ("b" @: [])+    ,   scrapeTest             "<a>foo</a>"-            []+            Nothing+            (htmls ("b" @: [])) -    ,   selectTest-            ("a" @: [])+    ,   scrapeTest             "<a>foo"-            ["<a></a>"]+            (Just ["<a></a>"])+            (htmls ("a" @: [])) -    ,   selectTest-            ("a" @: ["key" @= "value"])-            "<a>foo</a><a key=value>bar</a>"-            ["<a key=value>bar</a>"]+    ,   scrapeTest+            "<a>foo</a><a key=\"value\">bar</a>"+            (Just ["<a key=\"value\">bar</a>"])+            (htmls ("a" @: ["key" @= "value"])) -    ,   selectTest-            ("a" // "b" @: [] // "c")+    ,   scrapeTest             "<a><b><c>foo</c></b></a>"-            ["<c>foo</c>"]+            (Just ["<c>foo</c>"])+            (htmls ("a" // "b" @: [] // "c")) -    ,   selectTest-            ("a" // "b")+    ,   scrapeTest             "<c><a><b>foo</b></a></c><c><a><d><b>bar</b></d></a></c><b>baz</b>"-            ["<b>foo</b>", "<b>bar</b>"]--    ,   selectTest-            ("a" @: [hasClass "a"])-            "<a class='a b'>foo</a>"-            ["<a class='a b'>foo</a>"]--    ,   selectTest-            ("a" @: [hasClass "c"])-            "<a class='a b'>foo</a>"-            []+            (Just ["<b>foo</b>", "<b>bar</b>"])+            (htmls ("a" // "b")) -    ,   selectTest-            ("a" @: ["key" @=~ re "va(foo|bar|lu)e"])-            "<a key=value>foo</a>"-            ["<a key=value>foo</a>"]+    ,   scrapeTest+            "<a class=\"a b\">foo</a>"+            (Just ["<a class=\"a b\">foo</a>"])+            (htmls ("a" @: [hasClass "a"])) -    ,   selectTest-            ("a" @: [Any @= "value"])-            "<a foo=value>foo</a><a bar=value>bar</a>"-            ["<a foo=value>foo</a>", "<a bar=value>bar</a>"]+    ,   scrapeTest+            "<a class=\"a b\">foo</a>"+            Nothing+            (htmls ("a" @: [hasClass "c"])) -    ,   selectTest-            ("a" @: [Any @= "value"])-            "<a foo=other>foo</a><a bar=value>bar</a>"-            ["<a bar=value>bar</a>"]+    ,   scrapeTest+            "<a key=\"value\">foo</a>"+            (Just ["<a key=\"value\">foo</a>"])+            (htmls ("a" @: ["key" @=~ re "va(foo|bar|lu)e"])) -    ,   selectTest-            (Any @: [Any @= "value"])-            "<a foo=value>foo</a><b bar=value>bar</b>"-            ["<a foo=value>foo</a>", "<b bar=value>bar</b>"]+    ,   scrapeTest+            "<a foo=\"value\">foo</a><a bar=\"value\">bar</a>"+            (Just ["<a foo=\"value\">foo</a>", "<a bar=\"value\">bar</a>"])+            (htmls ("a" @: [Any @= "value"])) -    ,   selectTest-            (Any @: [Any @= "value"])-            "<a foo=other>foo</a><b bar=value>bar</b>"-            ["<b bar=value>bar</b>"]-    ]+    ,   scrapeTest+            "<a foo=\"other\">foo</a><a bar=\"value\">bar</a>"+            (Just ["<a bar=\"value\">bar</a>"])+            (htmls ("a" @: [Any @= "value"])) -selectTest :: Selectable s => s -> String -> [String] -> Test-selectTest selector tags expectedText = label ~: expected @=? actual-    where-        label  = "select (" ++ show tags ++ ")"-        expected = map TagSoup.parseTags expectedText-        actual = select selector (TagSoup.parseTags tags)+    ,   scrapeTest+            "<a foo=\"value\">foo</a><b bar=\"value\">bar</b>"+            (Just ["<a foo=\"value\">foo</a>", "<b bar=\"value\">bar</b>"])+            (htmls (Any @: [Any @= "value"])) -re :: String -> Text.Regex.TDFA.Regex-re = Text.Regex.TDFA.makeRegex+    ,   scrapeTest+            "<a foo=\"other\">foo</a><b bar=\"value\">bar</b>"+            (Just ["<b bar=\"value\">bar</b>"])+            (htmls (Any @: [Any @= "value"])) -scrapeTests = "scrapeTests" ~: TestList [-        scrapeTest+    ,   scrapeTest             "<a>foo</a>"             (Just "foo")             (text "a")