diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs new file mode 100644 --- /dev/null +++ b/benchmarks/Main.hs @@ -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 "" + close = T.pack "" + 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" diff --git a/scalpel.cabal b/scalpel.cabal --- a/scalpel.cabal +++ b/scalpel.cabal @@ -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 diff --git a/src/Text/HTML/Scalpel.hs b/src/Text/HTML/Scalpel.hs --- a/src/Text/HTML/Scalpel.hs +++ b/src/Text/HTML/Scalpel.hs @@ -95,8 +95,8 @@ -- > return $ ImageComment author imageURL -- -- Complete examples can be found in the --- folder in the scalpel --- git repository. +-- 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 diff --git a/src/Text/HTML/Scalpel/Internal/Scrape.hs b/src/Text/HTML/Scalpel/Internal/Scrape.hs --- a/src/Text/HTML/Scalpel/Internal/Scrape.hs +++ b/src/Text/HTML/Scalpel/Internal/Scrape.hs @@ -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 diff --git a/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs b/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs --- a/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs +++ b/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs @@ -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) diff --git a/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs b/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs --- a/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs +++ b/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs @@ -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 diff --git a/src/Text/HTML/Scalpel/Internal/Select.hs b/src/Text/HTML/Scalpel/Internal/Select.hs --- a/src/Text/HTML/Scalpel/Internal/Select.hs +++ b/src/Text/HTML/Scalpel/Internal/Select.hs @@ -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 ``. +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 diff --git a/src/Text/HTML/Scalpel/Internal/Select/Types.hs b/src/Text/HTML/Scalpel/Internal/Select/Types.hs --- a/src/Text/HTML/Scalpel/Internal/Select/Types.hs +++ b/src/Text/HTML/Scalpel/Internal/Select/Types.hs @@ -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 diff --git a/tests/TestMain.hs b/tests/TestMain.hs --- a/tests/TestMain.hs +++ b/tests/TestMain.hs @@ -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 "foo" - ["foo"] + (Just ["foo"]) + (htmls ("a" @: [])) - , selectTest - ("a" @: []) + , scrapeTest "foobar" - ["foo", "bar"] + (Just ["foo", "bar"]) + (htmls ("a" @: [])) - , selectTest - ("a" @: []) + , scrapeTest "foo" - ["foo"] + (Just ["foo"]) + (htmls ("a" @: [])) - , selectTest - ("a" @: []) + , scrapeTest "foo" - ["foo", "foo"] + (Just ["foo", "foo"]) + (htmls ("a" @: [])) - , selectTest - ("b" @: []) + , scrapeTest "foo" - [] + Nothing + (htmls ("b" @: [])) - , selectTest - ("a" @: []) + , scrapeTest "foo" - [""] + (Just [""]) + (htmls ("a" @: [])) - , selectTest - ("a" @: ["key" @= "value"]) - "foobar" - ["bar"] + , scrapeTest + "foobar" + (Just ["bar"]) + (htmls ("a" @: ["key" @= "value"])) - , selectTest - ("a" // "b" @: [] // "c") + , scrapeTest "foo" - ["foo"] + (Just ["foo"]) + (htmls ("a" // "b" @: [] // "c")) - , selectTest - ("a" // "b") + , scrapeTest "foobarbaz" - ["foo", "bar"] - - , selectTest - ("a" @: [hasClass "a"]) - "foo" - ["foo"] - - , selectTest - ("a" @: [hasClass "c"]) - "foo" - [] + (Just ["foo", "bar"]) + (htmls ("a" // "b")) - , selectTest - ("a" @: ["key" @=~ re "va(foo|bar|lu)e"]) - "foo" - ["foo"] + , scrapeTest + "foo" + (Just ["foo"]) + (htmls ("a" @: [hasClass "a"])) - , selectTest - ("a" @: [Any @= "value"]) - "foobar" - ["foo", "bar"] + , scrapeTest + "foo" + Nothing + (htmls ("a" @: [hasClass "c"])) - , selectTest - ("a" @: [Any @= "value"]) - "foobar" - ["bar"] + , scrapeTest + "foo" + (Just ["foo"]) + (htmls ("a" @: ["key" @=~ re "va(foo|bar|lu)e"])) - , selectTest - (Any @: [Any @= "value"]) - "foobar" - ["foo", "bar"] + , scrapeTest + "foobar" + (Just ["foo", "bar"]) + (htmls ("a" @: [Any @= "value"])) - , selectTest - (Any @: [Any @= "value"]) - "foobar" - ["bar"] - ] + , scrapeTest + "foobar" + (Just ["bar"]) + (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 + "foobar" + (Just ["foo", "bar"]) + (htmls (Any @: [Any @= "value"])) -re :: String -> Text.Regex.TDFA.Regex -re = Text.Regex.TDFA.makeRegex + , scrapeTest + "foobar" + (Just ["bar"]) + (htmls (Any @: [Any @= "value"])) -scrapeTests = "scrapeTests" ~: TestList [ - scrapeTest + , scrapeTest "foo" (Just "foo") (text "a")