scalpel-core (empty) → 0.5.0
raw patch · 13 files changed
+1496/−0 lines, 13 filesdep +HUnitdep +basedep +bytestringsetup-changed
Dependencies added: HUnit, base, bytestring, containers, criterion, data-default, fail, regex-base, regex-tdfa, scalpel-core, tagsoup, text, vector
Files
- CHANGELOG.md +93/−0
- LICENSE +202/−0
- README.md +15/−0
- Setup.hs +2/−0
- benchmarks/Main.hs +57/−0
- scalpel-core.cabal +87/−0
- src/Text/HTML/Scalpel/Core.hs +55/−0
- src/Text/HTML/Scalpel/Internal/Scrape.hs +232/−0
- src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs +17/−0
- src/Text/HTML/Scalpel/Internal/Select.hs +267/−0
- src/Text/HTML/Scalpel/Internal/Select/Combinators.hs +81/−0
- src/Text/HTML/Scalpel/Internal/Select/Types.hs +83/−0
- tests/TestMain.hs +305/−0
+ CHANGELOG.md view
@@ -0,0 +1,93 @@+# Change Log++## HEAD++## 0.5.0++- Split `scalpel` into two packages: `scalpel` and `scalpel-core`. The latter+ does not provide networking support and does not depend on curl.++## 0.4.1++- Added `notP` attribute predicate.++## 0.4.0++- Add the `chroot` tricks (#23 and #25) to README.md and added examples.+- Fix backtracking that occurs when using `guard` and `chroot`.+- Fix bug where the same tag may appear in the result set multiple times.+- Performance optimizations when using the (//) operator.+- Make Scraper an instance of MonadFail. Practically this means that failed+ pattern matches in `<-` expressions within a do block will evaluate to mzero+ instead of throwing an error and bringing down the entire script.+- Pluralized scrapers will now return the empty list instead mzero when there+ are no matches.+- Add the `position` scraper which provides the index of the current sub-tree+ within the context of a `chroots`'s do-block.++## 0.3.1++- Added the `innerHTML` and `innerHTMLs` scraper.+- Added the `match` function which allows for the creation of arbitrary+ attribute predicates.+- Fixed build breakage with GHC 8.0.1.++## 0.3.0.1++- Make tag and attribute matching case-insensitive.++## 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+ AttributeName.++## 0.2.1++- Made Scraper an instance of MonadPlus.++## 0.2.0.1++- Fixed examples in documentation and added an examples folder for ready to+ compile examples. Added travis tests to ensures that examples remain+ compilable.++## 0.2.0++- Removed the StringLike parameter from the Selector, Selectable,+ AttributePredicate, AttributeName, and TagName types. Instead they are now+ agnostic to the underlying string type, and are only constructable with+ Strings and the Any type.++## 0.1.3.1++- Tighten dependencies and drop download-curl all together.++## 0.1.3++- Add the html and html scraper primitives for extracting raw HTML.++## 0.1.2++- Make scrapeURL follow redirects by default.+- Expose a new function scrapeURLWithOpts that takes a list of curl options.+- Fix bug (#2) where image tags that do not have a trailing "/" are not+ selectable.++## 0.1.1++- Tighten dependencies on download-curl.++## 0.1.0++- First version!
+ LICENSE view
@@ -0,0 +1,202 @@+Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "{}"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright {yyyy} {name of copyright owner}++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.+
+ README.md view
@@ -0,0 +1,15 @@+Scalpel Core+============++Scalpel core provides a subset of the+[scalpel](https://hackage.haskell.org/package/scalpel) web scraping library that+is intended to have lightweight dependencies and to be free of all non-Haskell+dependencies.++Notably this package does not contain any networking support. Users who desire a+batteries include solution should depend on `scalpel` which does include+networking support instead of `scalpel-core`.++More thorough documentation including example code can be found in the+documentation of the [scalpel](https://hackage.haskell.org/package/scalpel)+package.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/Main.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE OverloadedStrings #-}++import Text.HTML.Scalpel.Core++import Control.Applicative ((<$>))+import Control.Monad (replicateM_)+import Criterion.Main (bgroup, bench, defaultMain, nf)+import Data.Foldable (foldr')+import qualified Data.Text as T+import qualified Text.HTML.TagSoup as TagSoup+++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+ ]+ , bgroup "many-//" [+ bench "10" $ nf (manySelectNodes 10) nested1000+ , bench "100" $ nf (manySelectNodes 100) nested1000+ , bench "1000" $ nf (manySelectNodes 1000) nested1000+ ]+ ]++makeNested :: Int -> [TagSoup.Tag T.Text]+makeNested i = TagSoup.parseTags+ $ 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 :: [TagSoup.Tag T.Text] -> Maybe Integer+sumListTags testData = flip scrape testData+ $ sum <$> chroots "tag" (return 1)++manySelects :: Int -> [TagSoup.Tag T.Text] -> Maybe ()+manySelects i testData = flip scrape testData+ $ replicateM_ i+ $ sum <$> chroots "tag" (return 1)++manySelectNodes :: Int -> [TagSoup.Tag T.Text] -> Maybe T.Text+manySelectNodes i testData = flip scrape testData+ $ text+ $ foldr' (//) (tagSelector "tag")+ $ replicate (i - 1) (tagSelector "tag")
+ scalpel-core.cabal view
@@ -0,0 +1,87 @@+name: scalpel-core+version: 0.5.0+synopsis: A high level web scraping library for Haskell.+description:+ Scalpel core provides a subset of the scalpel web scraping library that is+ intended to have lightweight dependencies and to be free of all non-Haskell+ dependencies.+homepage: https://github.com/fimad/scalpel+license: Apache-2.0+license-file: LICENSE+author: Will Coster+maintainer: willcoster@gmail.com+category: Web+build-type: Simple+cabal-version: >=1.10++extra-source-files:+ README.md CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/fimad/scalpel.git++source-repository this+ type: git+ location: https://github.com/fimad/scalpel.git+ tag: v0.5.0++library+ other-extensions:+ FlexibleInstances+ , FunctionalDependencies+ other-modules:+ Text.HTML.Scalpel.Internal.Scrape+ , Text.HTML.Scalpel.Internal.Scrape.StringLike+ , Text.HTML.Scalpel.Internal.Select+ , Text.HTML.Scalpel.Internal.Select.Combinators+ , Text.HTML.Scalpel.Internal.Select.Types+ exposed-modules:+ Text.HTML.Scalpel.Core+ hs-source-dirs: src/+ default-language: Haskell2010+ build-depends:+ base >= 4.6 && < 5+ , bytestring+ , containers+ , data-default+ , fail+ , regex-base+ , regex-tdfa+ , tagsoup >= 0.12.2+ , text+ , vector+ default-extensions:+ ParallelListComp+ , PatternGuards+ ghc-options: -W++test-suite lib-tests+ type: exitcode-stdio-1.0+ main-is: TestMain.hs+ hs-source-dirs: tests/+ default-language: Haskell2010+ build-depends:+ HUnit+ , base >= 4.6 && < 5+ , regex-base+ , regex-tdfa+ , scalpel-core+ , tagsoup+ default-extensions:+ 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-core+ , tagsoup+ , text+ ghc-options: -Wall
+ src/Text/HTML/Scalpel/Core.hs view
@@ -0,0 +1,55 @@+-- |+-- Scalpel core provides a subset of the+-- <https://hackage.haskell.org/package/scalpel scalpel> web scraping library+-- that is intended to have lightweight dependencies and to be free of all+-- non-Haskell dependencies.+--+-- Notably this package does not contain any networking support. Users who+-- desire a batteries include solution should depend on @scalpel@ which does+-- include networking support instead of @scalpel-core@.+--+-- More thorough documentation including example code can be found in the+-- documentation of the <https://hackage.haskell.org/package/scalpel scalpel>+-- package.+module Text.HTML.Scalpel.Core (+-- * Selectors+ Selector+, AttributePredicate+, AttributeName (..)+, TagName (..)+, tagSelector+-- ** Wildcards+, anySelector+-- ** Tag combinators+, (//)+-- ** Attribute predicates+, (@:)+, (@=)+, (@=~)+, hasClass+, notP+, match++-- * Scrapers+, Scraper+-- ** Primitives+, attr+, attrs+, html+, htmls+, innerHTML+, innerHTMLs+, text+, texts+, chroot+, chroots+, position+-- ** Executing scrapers+, scrape+, scrapeStringLike+) where++import Text.HTML.Scalpel.Internal.Scrape+import Text.HTML.Scalpel.Internal.Scrape.StringLike+import Text.HTML.Scalpel.Internal.Select.Combinators+import Text.HTML.Scalpel.Internal.Select.Types
+ src/Text/HTML/Scalpel/Internal/Scrape.hs view
@@ -0,0 +1,232 @@+{-# OPTIONS_HADDOCK hide #-}+module Text.HTML.Scalpel.Internal.Scrape (+ Scraper+, scrape+, attr+, attrs+, html+, htmls+, innerHTML+, innerHTMLs+, text+, texts+, chroot+, chroots+, position+) where++import Text.HTML.Scalpel.Internal.Select+import Text.HTML.Scalpel.Internal.Select.Types++import Control.Applicative+import Control.Monad+import Data.Maybe++import qualified Control.Monad.Fail as Fail+import qualified Data.Vector as Vector+import qualified Text.HTML.TagSoup as TagSoup+import qualified Text.StringLike as TagSoup+++-- | 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 {+ scrapeTagSpec :: TagSpec str -> Maybe a+ }++instance Functor (Scraper str) where+ fmap f (MkScraper a) = MkScraper $ fmap (fmap f) a++instance Applicative (Scraper str) where+ pure = MkScraper . const . Just+ (MkScraper f) <*> (MkScraper a) = MkScraper applied+ where applied tags | (Just aVal) <- a tags = ($ aVal) <$> f tags+ | otherwise = Nothing++instance Alternative (Scraper str) where+ empty = MkScraper $ const Nothing+ (MkScraper a) <|> (MkScraper b) = MkScraper choice+ where choice tags | (Just aVal) <- a tags = Just aVal+ | otherwise = b tags++instance Monad (Scraper str) where+ fail = Fail.fail+ return = pure+ (MkScraper a) >>= f = MkScraper combined+ where combined tags | (Just aVal) <- a tags = let (MkScraper b) = f aVal+ in b tags+ | otherwise = Nothing++instance MonadPlus (Scraper str) where+ mzero = empty+ mplus = (<|>)++instance Fail.MonadFail (Scraper str) where+ fail _ = mzero++-- | 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 = scrapeTagSpec s . tagsToSpec . TagSoup.canonicalizeTags++-- | 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 :: (Ord str, TagSoup.StringLike str)+ => Selector -> Scraper str a -> Scraper str a+chroot selector inner = do+ maybeResult <- listToMaybe <$> chroots selector inner+ guard (isJust maybeResult)+ return $ fromJust maybeResult++-- | The 'chroots' 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. The inner scraper is executed for+-- each set of tags matching the given selector.+chroots :: (Ord str, TagSoup.StringLike str)+ => Selector -> Scraper str a -> Scraper str [a]+chroots selector (MkScraper inner) = MkScraper+ $ return . mapMaybe inner . select selector++-- | The 'text' function takes a selector and returns the inner text 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 'texts'.+text :: (Ord str, TagSoup.StringLike str) => Selector -> 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 :: (Ord str, TagSoup.StringLike str)+ => Selector -> 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 :: (Ord str, TagSoup.StringLike str) => Selector -> 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 :: (Ord str, TagSoup.StringLike str)+ => Selector -> Scraper str [str]+htmls s = MkScraper $ withAll tagsToHTML . select s++-- | The 'innerHTML' function takes a selector and returns the inner html string+-- from the set of tags described by the given selector. Inner html here meaning+-- the html within but not including the selected tags.+--+-- This function will match only the first set of tags matching the selector, to+-- match every set of tags, use 'innerHTMLs'.+innerHTML :: (Ord str, TagSoup.StringLike str)+ => Selector -> Scraper str str+innerHTML s = MkScraper $ withHead tagsToInnerHTML . select s++-- | The 'innerHTMLs' function takes a selector and returns the inner html+-- string from every set of tags matching the given selector.+innerHTMLs :: (Ord str, TagSoup.StringLike str)+ => Selector -> Scraper str [str]+innerHTMLs s = MkScraper $ withAll tagsToInnerHTML . 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+-- matches the given selector.+--+-- This function will match only the opening tag matching the selector, to match+-- every tag, use 'attrs'.+attr :: (Ord str, Show str, TagSoup.StringLike str)+ => String -> Selector -> Scraper str str+attr name s = MkScraper+ $ 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 :: (Ord str, Show str, TagSoup.StringLike str)+ => String -> Selector -> Scraper str [str]+attrs name s = MkScraper+ $ fmap catMaybes . withAll (tagsToAttr nameStr) . select s+ where nameStr = TagSoup.castString name++-- | The 'position' function is intended to be used within the do-block of a+-- `chroots` call. Within the do-block position will return the index of the+-- current sub-tree within the list of all sub-trees matched by the selector+-- passed to `chroots`.+--+-- For example, consider the following HTML:+--+-- @+-- \<article\>+-- \<p\> First paragraph. \</p\>+-- \<p\> Second paragraph. \</p\>+-- \<p\> Third paragraph. \</p\>+-- \</article\>+-- @+--+-- The `position` function can be used to determine the index of each @\<p\>@ tag+-- within the @article@ tag by doing the following.+--+-- @+-- chroots "article" // "p" $ do+-- index <- position+-- content <- text "p"+-- return (index, content)+-- @+--+-- Which will evaluate to the list:+--+-- @+-- [+-- (0, "First paragraph.")+-- , (1, "Second paragraph.")+-- , (2, "Third paragraph.")+-- ]+-- @+position :: (Ord str, TagSoup.StringLike str) => Scraper str Int+position = MkScraper $ Just . tagsToPosition++withHead :: (a -> b) -> [a] -> Maybe b+withHead _ [] = Nothing+withHead f (x:_) = Just $ f x++withAll :: (a -> b) -> [a] -> Maybe [b]+withAll f xs = Just $ map f xs++foldSpec :: TagSoup.StringLike str+ => (TagSoup.Tag str -> str -> str) -> TagSpec str -> str+foldSpec f = Vector.foldr' (f . infoTag) TagSoup.empty . (\(a, _, _) -> a)+++tagsToText :: TagSoup.StringLike str => TagSpec str -> str+tagsToText = foldSpec f+ where+ f (TagSoup.TagText str) s = str `TagSoup.append` s+ f _ s = s++tagsToHTML :: TagSoup.StringLike str => TagSpec str -> str+tagsToHTML = foldSpec (\tag s -> TagSoup.renderTags [tag] `TagSoup.append` s)++tagsToInnerHTML :: TagSoup.StringLike str => TagSpec str -> str+tagsToInnerHTML (tags, tree, ctx)+ | len < 2 = TagSoup.empty+ | otherwise = tagsToHTML (Vector.slice 1 (len - 2) tags, tree, ctx)+ where len = Vector.length tags++tagsToAttr :: (Show str, TagSoup.StringLike str)+ => str -> TagSpec str -> Maybe str+tagsToAttr attr (tags, _, _) = do+ guard $ 0 < Vector.length tags+ let tag = infoTag $ tags Vector.! 0+ guard $ TagSoup.isTagOpen tag+ return $ TagSoup.fromAttrib attr tag++tagsToPosition :: TagSpec str -> Int+tagsToPosition (_, _, ctx) = ctxPosition ctx
+ src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs view
@@ -0,0 +1,17 @@+{-# OPTIONS_HADDOCK hide #-}+module Text.HTML.Scalpel.Internal.Scrape.StringLike (+ scrapeStringLike+) where++import Text.HTML.Scalpel.Internal.Scrape++import qualified Text.HTML.TagSoup as TagSoup+import qualified Text.StringLike as TagSoup+++-- | The 'scrapeStringLike' function parses a 'StringLike' value into a list of+-- tags and executes a 'Scraper' on it.+scrapeStringLike :: (Ord str, TagSoup.StringLike str)+ => str -> Scraper str a -> Maybe a+scrapeStringLike html scraper+ = scrape scraper (TagSoup.parseTagsOptions TagSoup.parseOptionsFast html)
+ src/Text/HTML/Scalpel/Internal/Select.hs view
@@ -0,0 +1,267 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE BangPatterns #-}+{-# OPTIONS_HADDOCK hide #-}+module Text.HTML.Scalpel.Internal.Select (+ SelectContext (..)+, TagSpec+, TagInfo (..)++, select+, tagsToSpec+) where++import Text.HTML.Scalpel.Internal.Select.Types++import Control.Applicative ((<$>), (<|>))+import Data.Maybe (catMaybes, isJust, fromJust, fromMaybe)++import qualified Data.Map.Strict as Map+import qualified Data.Text as T+import qualified Data.Tree as Tree+import qualified Data.Vector as Vector+import qualified Text.HTML.TagSoup as TagSoup+import qualified Text.StringLike as TagSoup+++type Index = Int+type Name = Maybe T.Text+type CloseOffset = Maybe Index++-- | The span of a tag in terms of the index of the opening tag and the index of+-- the closing tag. If there is no closing tag the closing tag is equal to the+-- opening tag.+data Span = Span !Int !Int++-- | A representation of the hierarchal structure of a document. Nodes of the+-- tree are spans which mark the start and end of a tag. The tree is organized+-- such that tags that appear earlier in the parsed string appear earlier in the+-- list of nodes, and that a given node is completely within the span of its+-- parent.+type TagForest = Tree.Forest Span++-- | A tag and associated precomputed meta data that is accessed in tight inner+-- loops during scraping.+data TagInfo str = TagInfo {+ infoTag :: !(TagSoup.Tag str)+ , infoName :: !Name+ , infoIndex :: !Index+ , infoOffset :: !CloseOffset+ }++-- | A vector of tags and precomputed meta data. A vector is used because it+-- allows for constant time slicing and sharing memory between the slices.+type TagVector str = Vector.Vector (TagInfo str)++-- | Ephemeral meta-data that each TagSpec is tagged with. This type contains+-- information that is not intrinsic in the sub-tree that corresponds to a given+-- TagSpec.+data SelectContext = SelectContext {+ -- | `select` generates a list of `TagSpec`s that match a+ -- selector. This indicates the index in the result list+ -- that this TagSpec corresponds to.+ ctxPosition :: !Index+ }++-- | A structured representation of the parsed tags that provides fast element+-- look up via a vector of tags, and fast traversal via a rose tree of tags.+type TagSpec str = (TagVector str, TagForest, SelectContext)++-- | 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 :: (Ord str, TagSoup.StringLike str)+ => Selector -> TagSpec str -> [TagSpec str]+select s tagSpec = newSpecs+ where+ (MkSelector nodes) = s+ newSpecs = zipWith applyPosition [0..] (selectNodes nodes tagSpec [])+ applyPosition p (tags, f, ctx) = (tags, f, SelectContext p)++-- | Creates a TagSpec from a list of tags parsed by TagSoup.+tagsToSpec :: forall str. (Ord str, TagSoup.StringLike str)+ => [TagSoup.Tag str] -> TagSpec str+tagsToSpec tags = (vector, tree, ctx)+ where+ vector = tagsToVector tags+ tree = vectorToTree vector+ ctx = SelectContext 0++-- | 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 by their indices.+tagsToVector :: forall str. (Ord str, TagSoup.StringLike str)+ => [TagSoup.Tag str] -> TagVector str+tagsToVector tags = let indexed = zip tags [0..]+ total = length indexed+ unsorted = go indexed Map.empty+ emptyVec = Vector.replicate total undefined+ in emptyVec Vector.// unsorted+ where+ go :: [(TagSoup.Tag str, Index)]+ -> Map.Map T.Text [(TagSoup.Tag str, Index)]+ -> [(Index, TagInfo str)]+ go [] state = map (\(t, i) -> (i, TagInfo t (maybeName t) i Nothing))+ $ concat+ $ Map.elems state+ where+ maybeName t | TagSoup.isTagOpen t = Just $ getTagName t+ | TagSoup.isTagClose t = Just $ getTagName t+ | otherwise = Nothing+ go (x@(tag, index) : xs) state+ | TagSoup.isTagClose tag =+ let maybeOpen = head <$> Map.lookup tagName state+ state' = Map.alter popTag tagName state+ info = TagInfo tag (Just tagName) index Nothing+ res = catMaybes [+ Just (index, info)+ , calcOffset <$> maybeOpen+ ]+ in res ++ go xs state'+ | TagSoup.isTagOpen tag = go xs (Map.alter appendTag tagName state)+ | otherwise =+ let info = TagInfo tag Nothing index Nothing+ in (index, info) : go xs state+ where+ tagName = getTagName tag++ appendTag :: Maybe [(TagSoup.Tag str, Index)]+ -> Maybe [(TagSoup.Tag str, Index)]+ appendTag m = (x :) <$> (m <|> Just [])++ calcOffset :: (TagSoup.Tag str, Int) -> (Index, TagInfo str)+ calcOffset (t, i) =+ let offset = index - i+ info = TagInfo t (Just tagName) i (Just offset)+ in offset `seq` (i, info)++ popTag :: Maybe [a] -> Maybe [a]+ popTag (Just (_ : y : xs)) = let s = y : xs in s `seq` Just s+ popTag _ = Nothing++getTagName :: TagSoup.StringLike str => TagSoup.Tag str -> T.Text+getTagName (TagSoup.TagOpen name _) = TagSoup.castString name+getTagName (TagSoup.TagClose name) = TagSoup.castString name+getTagName _ = undefined++-- | Builds a forest describing the structure of the tags within a given vector.+-- The nodes of the forest are tag spans which mark the indices within the+-- vector of an open and close pair. The tree is organized such for any node n+-- the parent of node n is the smallest span that completely encapsulates the+-- span of node n.+vectorToTree :: TagSoup.StringLike str => TagVector str -> TagForest+vectorToTree tags = fixup $ forestWithin 0 (Vector.length tags)+ where+ forestWithin :: Int -> Int -> TagForest+ forestWithin !lo !hi+ | hi <= lo = []+ | not isOpen = forestWithin (lo + 1) hi+ | otherwise = Tree.Node (Span lo closeIndex) subForest+ : forestWithin (closeIndex + 1) hi+ where+ info = tags Vector.! lo+ isOpen = TagSoup.isTagOpen $ infoTag info+ closeIndex = lo + fromMaybe 0 (infoOffset info)+ subForest = forestWithin (lo + 1) closeIndex++ -- Lifts nodes whose closing tags lay outside their parent tags up to+ -- within a parent node that encompasses the node's entire span.+ fixup :: TagForest -> TagForest+ fixup [] = []+ fixup (Tree.Node (Span lo hi) subForest : siblings)+ = Tree.Node (Span lo hi) ok : bad+ where+ (ok, bad) = malformed (fixup siblings) $ fixup subForest++ malformed :: TagForest -- Forest to prepend bad trees on.+ -> TagForest -- Remaining trees to examine.+ -> (TagForest, TagForest)+ malformed preBad [] = ([], preBad)+ malformed preBad (n@(Tree.Node (Span _ nHi) _) : ns)+ | hi < nHi = (ok, n : bad)+ | otherwise = (n : ok, bad)+ where (ok, bad) = malformed preBad ns++-- | Generates a list of 'TagSpec's that match the given list of 'SelectNode's.+-- This is is done in linear time with respect to the number of tags.+--+-- The algorithm is a simple DFS traversal of the tag forest. While traversing+-- the forest if the current SelectNode is satisfied by the current node in the+-- tree the SelectNode is popped and the current node's sub-forest is traversed+-- with the remaining SelectNodes. If there is only a single SelectNode then any+-- node encountered that satisfies the SelectNode is returned as an answer.+selectNodes :: TagSoup.StringLike str+ => [SelectNode] -> TagSpec str -> [TagSpec str] -> [TagSpec str]+selectNodes [] _ acc = acc+selectNodes [_] (_, [], _) acc = acc+-- Now that there is only a single SelectNode to satisfy, search the remaining+-- forests and generates a TagSpec for each node that satisfies the condition.+selectNodes [n] (tags, f : fs, ctx) acc+ | nodeMatches n info = (shrunkSpec :)+ $ selectNodes [n] (tags, fs, ctx)+ $ selectNodes [n] (tags, Tree.subForest f, ctx) acc+ | otherwise = selectNodes [n] (tags, fs, ctx)+ $ selectNodes [n] (tags, Tree.subForest f, ctx) acc+ where+ Span lo hi = Tree.rootLabel f+ shrunkSpec = (+ Vector.slice lo (hi - lo + 1) tags+ , [fmap recenter f]+ , ctx+ )+ recenter (Span nLo nHi) = Span (nLo - lo) (nHi - lo)+ info = tags Vector.! lo+-- There are multiple SelectNodes that need to be satisfied. If the current node+-- satisfies the condition, then the current nodes sub-forest is searched for+-- matches of the remaining SelectNodes.+selectNodes (_ : _) (_, [], _) acc = acc+selectNodes (n : ns) (tags, f : fs, ctx) acc+ | nodeMatches n info = selectNodes ns (tags, Tree.subForest f, ctx)+ $ selectNodes (n : ns) (tags, fs, ctx) acc+ | otherwise = selectNodes (n : ns) (tags, Tree.subForest f, ctx)+ $ selectNodes (n : ns) (tags, fs, ctx) acc+ where+ Span lo _ = Tree.rootLabel f+ info = tags Vector.! lo++-- | Returns True if a tag satisfies a given SelectNode's condition.+nodeMatches :: TagSoup.StringLike str => SelectNode -> TagInfo str -> Bool+nodeMatches (SelectNode node preds) info = checkTag node preds info+nodeMatches (SelectAny preds) info = checkPreds preds (infoTag info)++-- | 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+ => T.Text -> [AttributePredicate] -> TagInfo str -> Bool+checkTag name preds (TagInfo tag tagName _ _)+ = TagSoup.isTagOpen tag+ && isJust tagName+ && name == fromJust tagName+ && checkPreds preds tag++-- | Returns True if a tag satisfies a list of attribute predicates.+checkPreds :: TagSoup.StringLike str+ => [AttributePredicate] -> TagSoup.Tag str -> Bool+checkPreds preds tag+ = TagSoup.isTagOpen tag+ && all (flip checkPred attrs) preds+ where (TagSoup.TagOpen _ attrs) = tag
+ src/Text/HTML/Scalpel/Internal/Select/Combinators.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiWayIf #-}+{-# OPTIONS_HADDOCK hide #-}+module Text.HTML.Scalpel.Internal.Select.Combinators (+ (//)+, (@:)+, (@=)+, (@=~)+, hasClass+, notP+, match+) where++import Text.HTML.Scalpel.Internal.Select.Types++import qualified Data.Text as T+import qualified Text.Regex.Base.RegexLike as RE+import qualified Text.StringLike as TagSoup+++-- | The '@:' operator creates a 'Selector' by combining a 'TagName' with a list+-- of 'AttributePredicate's.+(@:) :: TagName -> [AttributePredicate] -> Selector+(@:) tag attrs = MkSelector [toSelectNode tag attrs]+infixl 9 @:++-- | The '@=' operator creates an 'AttributePredicate' that will match+-- attributes with the given name and value.+--+-- If you are attempting to match a specific class of a tag with potentially+-- multiple classes, you should use the 'hasClass' utility function.+(@=) :: AttributeName -> String -> AttributePredicate+(@=) key value = anyAttrPredicate $ \(attrKey, attrValue) ->+ matchKey key attrKey+ && TagSoup.fromString value == attrValue+infixl 6 @=++-- | The '@=~' operator creates an 'AttributePredicate' that will match+-- attributes with the given name and whose value matches the given regular+-- expression.+(@=~) :: RE.RegexLike re String+ => AttributeName -> re -> AttributePredicate+(@=~) key re = anyAttrPredicate $ \(attrKey, attrValue) ->+ matchKey key attrKey+ && RE.matchTest re (TagSoup.toString attrValue)+infixl 6 @=~++-- | The '//' operator creates an 'Selector' by nesting one 'Selector' in+-- another. For example, @"div" // "a"@ will create a 'Selector' that matches+-- anchor tags that are nested arbitrarily deep within a div tag.+(//) :: Selector -> Selector -> Selector+(//) a b = MkSelector (as ++ bs)+ where (MkSelector as) = a+ (MkSelector bs) = b+infixl 5 //++-- | The classes of a tag are defined in HTML as a space separated list given by+-- the @class@ attribute. The 'hasClass' function will match a @class@ attribute+-- if the given class appears anywhere in the space separated list of classes.+hasClass :: String -> AttributePredicate+hasClass clazz = anyAttrPredicate hasClass'+ where+ hasClass' (attrName, classes)+ | "class" == TagSoup.toString attrName = textClass `elem` classList+ | otherwise = False+ where textClass = TagSoup.castString clazz+ textClasses = TagSoup.castString classes+ classList = T.split (== ' ') textClasses++-- | Negates an 'AttributePredicate'. +notP :: AttributePredicate -> AttributePredicate+notP (MkAttributePredicate p) = MkAttributePredicate $ not . p++-- | The 'match' function allows for the creation of arbitrary+-- 'AttributePredicate's. The argument is a function that takes the attribute+-- key followed by the attribute value and returns a boolean indicating if the+-- attribute satisfies the predicate.+match :: (String -> String -> Bool) -> AttributePredicate+match f = anyAttrPredicate $ \(attrKey, attrValue) ->+ f (TagSoup.toString attrKey) (TagSoup.toString attrValue)
+ src/Text/HTML/Scalpel/Internal/Select/Types.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# OPTIONS_HADDOCK hide #-}++module Text.HTML.Scalpel.Internal.Select.Types (+ Selector (..)+, AttributePredicate (..)+, checkPred+, AttributeName (..)+, matchKey+, anyAttrPredicate+, TagName (..)+, SelectNode (..)+, tagSelector+, anySelector+, toSelectNode+) where++import Data.Char (toLower)+import Data.String (IsString, fromString)++import qualified Text.HTML.TagSoup as TagSoup+import qualified Text.StringLike as TagSoup+import qualified Data.Text as T+++-- | The 'AttributeName' type can be used when creating 'Selector's to specify+-- the name of an attribute of a tag.+data AttributeName = AnyAttribute | AttributeString String++matchKey :: TagSoup.StringLike str => AttributeName -> str -> Bool+matchKey (AttributeString s) = ((TagSoup.fromString $ map toLower s) ==)+matchKey AnyAttribute = const True++instance IsString AttributeName where+ fromString = AttributeString++-- | An 'AttributePredicate' is a method that takes a 'TagSoup.Attribute' and+-- returns a 'Bool' indicating if the given attribute matches a predicate.+data AttributePredicate+ = MkAttributePredicate+ (forall str. TagSoup.StringLike str => [TagSoup.Attribute str]+ -> Bool)++checkPred :: TagSoup.StringLike str+ => AttributePredicate -> [TagSoup.Attribute str] -> Bool+checkPred (MkAttributePredicate p) = p++-- | Creates an 'AttributePredicate' from a predicate function of a single+-- attribute that matches if any one of the attributes matches the predicate.+anyAttrPredicate :: (forall str. TagSoup.StringLike str => (str, str) -> Bool)+ -> AttributePredicate+anyAttrPredicate p = MkAttributePredicate $ any p++-- | 'Selector' defines a selection of an HTML DOM tree to be operated on by+-- a web scraper. The selection includes the opening tag that matches the+-- selection, all of the inner tags, and the corresponding closing tag.+newtype Selector = MkSelector [SelectNode]++tagSelector :: String -> Selector+tagSelector tag = MkSelector [toSelectNode (TagString tag) []]++-- | A selector which will match all tags+anySelector :: Selector+anySelector = MkSelector [SelectAny []]++instance IsString Selector where+ fromString = tagSelector++data SelectNode = SelectNode !T.Text [AttributePredicate]+ | SelectAny [AttributePredicate]++-- | The 'TagName' type is used when creating a 'Selector' to specify the name+-- of a tag.+data TagName = AnyTag | TagString String++instance IsString TagName where+ fromString = TagString++toSelectNode :: TagName -> [AttributePredicate] -> SelectNode+toSelectNode AnyTag = SelectAny+toSelectNode (TagString str) = SelectNode . TagSoup.fromString $ map toLower str
+ tests/TestMain.hs view
@@ -0,0 +1,305 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Text.HTML.Scalpel.Core++import Control.Applicative+import Control.Monad (guard)+import Data.List (isInfixOf)+import System.Exit+import Test.HUnit++import qualified Text.HTML.TagSoup as TagSoup+import qualified Text.Regex.TDFA+++main = exit . failures =<< runTestTT (TestList [scrapeTests])++exit :: Int -> IO ()+exit 0 = exitSuccess+exit n = exitWith $ ExitFailure n++re :: String -> Text.Regex.TDFA.Regex+re = Text.Regex.TDFA.makeRegex++scrapeTests = "scrapeTests" ~: TestList [+ scrapeTest+ "<a>foo</a>"+ (Just ["<a>foo</a>"])+ (htmls ("a" @: []))++ , scrapeTest+ "<a>foo</a><a>bar</a>"+ (Just ["<a>foo</a>", "<a>bar</a>"])+ (htmls ("a" @: []))++ , scrapeTest+ "<b><a>foo</a></b>"+ (Just ["<a>foo</a>"])+ (htmls ("a" @: []))++ , scrapeTest+ "<a><a>foo</a></a>"+ (Just ["<a><a>foo</a></a>", "<a>foo</a>"])+ (htmls ("a" @: []))++ , scrapeTest+ "<a>foo</a>"+ (Just [])+ (htmls ("b" @: []))++ , scrapeTest+ "<a>foo"+ (Just ["<a>"])+ (htmls ("a" @: []))++ , scrapeTest+ "<a>foo</a><a key=\"value\">bar</a>"+ (Just ["<a key=\"value\">bar</a>"])+ (htmls ("a" @: ["key" @= "value"]))++ , scrapeTest+ "<a><b><c>foo</c></b></a>"+ (Just ["<c>foo</c>"])+ (htmls ("a" // "b" @: [] // "c"))++ , scrapeTest+ "<c><a><b>foo</b></a></c><c><a><d><b>bar</b></d></a></c><b>baz</b>"+ (Just ["<b>foo</b>", "<b>bar</b>"])+ (htmls ("a" // "b"))++ , scrapeTest+ "<a class=\"a b\">foo</a>"+ (Just ["<a class=\"a b\">foo</a>"])+ (htmls ("a" @: [hasClass "a"]))++ , scrapeTest+ "<a class=\"a b\">foo</a>"+ (Just [])+ (htmls ("a" @: [hasClass "c"]))++ , scrapeTest+ "<a>foo</a><a class=\"a b\">bar</a><a class=\"b\">baz</a>"+ (Just ["foo", "baz"])+ (texts ("a" @: [notP $ hasClass "a"]))++ , scrapeTest+ "<a key=\"value\">foo</a>"+ (Just ["<a key=\"value\">foo</a>"])+ (htmls ("a" @: ["key" @=~ re "va(foo|bar|lu)e"]))++ , scrapeTest+ "<a foo=\"value\">foo</a><a bar=\"value\">bar</a>"+ (Just ["<a foo=\"value\">foo</a>", "<a bar=\"value\">bar</a>"])+ (htmls ("a" @: [AnyAttribute @= "value"]))++ , scrapeTest+ "<a foo=\"other\">foo</a><a bar=\"value\">bar</a>"+ (Just ["<a bar=\"value\">bar</a>"])+ (htmls ("a" @: [AnyAttribute @= "value"]))++ , scrapeTest+ "<a foo=\"value\">foo</a><b bar=\"value\">bar</b>"+ (Just ["<a foo=\"value\">foo</a>", "<b bar=\"value\">bar</b>"])+ (htmls (AnyTag @: [AnyAttribute @= "value"]))++ , scrapeTest+ "<a foo=\"other\">foo</a><b bar=\"value\">bar</b>"+ (Just ["<b bar=\"value\">bar</b>"])+ (htmls (AnyTag @: [AnyAttribute @= "value"]))++ , scrapeTest+ "<a foo=\"bar\">1</a><a foo=\"foo\">2</a><a bar=\"bar\">3</a>"+ (Just ["<a foo=\"foo\">2</a>", "<a bar=\"bar\">3</a>"])+ (htmls (AnyTag @: [match (==)]))++ , scrapeTest+ "<a>foo</a>"+ (Just "foo")+ (text "a")++ , scrapeTest+ "<a>foo</a><a>bar</a>"+ (Just "foo")+ (text "a")++ , scrapeTest+ "<a>foo</a><a>bar</a>"+ (Just ["foo", "bar"])+ (texts "a")++ , scrapeTest+ "<a>foo</a><a>bar</a>"+ (Just [True, False])+ (map (== "foo") <$> texts "a")++ , scrapeTest+ "<a key=foo />"+ (Just "foo")+ (attr "key" "a")++ , scrapeTest+ "<a key1=foo/><b key1=bar key2=foo /><a key1=bar key2=baz />"+ (Just "baz")+ (attr "key2" $ "a" @: ["key1" @= "bar"])++ , scrapeTest+ "<a><b>foo</b></a><b>bar</b>"+ (Just ["foo"])+ (chroot "a" $ texts "b")++ , scrapeTest+ "<a><b>foo</b></a><a><b>bar</b></a>"+ (Just ["foo", "bar"])+ (chroots "a" $ text "b")++ , scrapeTest+ "<a><b>foo</b></a><a><c>bar</c></a>"+ (Just "foo")+ (text ("a" // "b") <|> text ("a" // "c"))++ , scrapeTest+ "<a><b>foo</b></a><a><c>bar</c></a>"+ (Just "bar")+ (text ("a" // "d") <|> text ("a" // "c"))++ , scrapeTest+ "<img src='foobar'>"+ (Just "foobar")+ (attr "src" "img")++ , scrapeTest+ "<img src='foobar' />"+ (Just "foobar")+ (attr "src" "img")++ , scrapeTest+ "<a>foo</a><A>bar</A>"+ (Just ["foo", "bar"])+ (texts "a")++ , scrapeTest+ "<a>foo</a><A>bar</A>"+ (Just ["foo", "bar"])+ (texts "A")++ , scrapeTest+ "<a B=C>foo</a>"+ (Just ["foo"])+ (texts $ "A" @: ["b" @= "C"])++ , scrapeTest+ "<a B=C>foo</a>"+ (Just [])+ (texts $ "A" @: ["b" @= "c"])++ , scrapeTest+ "<a>foo</a><a B=C>bar</a><a B=D>baz</a>"+ (Just ["foo", "baz"])+ (texts ("a" @: [notP $ "b" @= "C"]))++ , scrapeTest+ "<a>foo</a>"+ (Just "<a>foo</a>")+ (html "a")++ , scrapeTest+ "<body><div><ul><li>1</li><li>2</li></ul></div></body>"+ (Just "<li>1</li>")+ (html "li")++ , scrapeTest+ "<body><div></div></body>"+ (Just "<div></div>")+ (html "div")++ , scrapeTest+ "<a>foo</a><a>bar</a>"+ (Just ["<a>foo</a>","<a>bar</a>"])+ (htmls "a")++ , scrapeTest+ "<body><div><ul><li>1</li><li>2</li></ul></div></body>"+ (Just ["<li>1</li>", "<li>2</li>"])+ (htmls "li")++ , scrapeTest+ "<body><div></div></body>"+ (Just ["<div></div>"])+ (htmls "div")++ , scrapeTest+ "<a>1<b>2</b>3</a>"+ (Just "1<b>2</b>3")+ (innerHTML anySelector)++ , scrapeTest+ "<a>"+ (Just "")+ (innerHTML anySelector)++ , scrapeTest+ "<a>foo</a><a>bar</a>"+ (Just ["foo","bar"])+ (innerHTMLs "a")++ , scrapeTest+ "<a>foo</a><a>bar</a><a>baz</a>"+ (Just "<a>bar</a>")+ (chroot "a" $ do+ t <- text anySelector+ guard ("b" `isInfixOf` t)+ html anySelector)++ , scrapeTest+ "<div id=\"outer\"><div id=\"inner\">inner text</div></div>"+ (Just ["inner"])+ (attrs "id" ("div" // "div"))++ , scrapeTest+ "<div id=\"a\"><div id=\"b\"><div id=\"c\"></div></div></div>"+ (Just ["b", "c"])+ (attrs "id" ("div" // "div"))++ , scrapeTest+ "<a>1<b>2<c>3</c>4</b>5</a>"+ (Just "12345")+ (text anySelector)++ , scrapeTest+ "<a>1</a>"+ Nothing+ $ do+ "Bad pattern" <- text "a"+ return "OK"++ , scrapeTest+ "<a>1</a>"+ (Just "OK")+ $ do+ "1" <- text "a"+ return "OK"+ , scrapeTest+ "<article><p>A</p><p>B</p><p>C</p></article>"+ (Just [(0, "A"), (1, "B"), (2, "C")])+ (chroots ("article" // "p") $ do+ index <- position+ content <- text anySelector+ return (index, content))++ , scrapeTest+ "<article><p>A</p></article><article><p>B</p><p>C</p></article>"+ (Just [[(0, "A")], [(0, "B"), (1, "C")]])+ (chroots "article" $ chroots "p" $ do+ index <- position+ content <- text anySelector+ return (index, content))+ ]++scrapeTest :: (Eq a, Show a) => String -> Maybe a -> Scraper String a -> Test+scrapeTest html expected scraper = label ~: expected @=? actual+ where+ label = "scrape (" ++ show html ++ ")"+ actual = scrape scraper (TagSoup.parseTags html)