diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -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!
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
+
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/Main.hs
@@ -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 ""
+ close = T.pack ""
+ 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")
diff --git a/scalpel-core.cabal b/scalpel-core.cabal
new file mode 100644
--- /dev/null
+++ b/scalpel-core.cabal
@@ -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
diff --git a/src/Text/HTML/Scalpel/Core.hs b/src/Text/HTML/Scalpel/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Scalpel/Core.hs
@@ -0,0 +1,55 @@
+-- |
+-- Scalpel core provides a subset of the
+-- 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
+-- 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
diff --git a/src/Text/HTML/Scalpel/Internal/Scrape.hs b/src/Text/HTML/Scalpel/Internal/Scrape.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Scalpel/Internal/Scrape.hs
@@ -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:
+--
+-- @
+-- \
+-- \ First paragraph. \
+-- \ Second paragraph. \
+-- \ Third paragraph. \
+-- \
+-- @
+--
+-- The `position` function can be used to determine the index of each @\@ 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
diff --git a/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs b/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs
@@ -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)
diff --git a/src/Text/HTML/Scalpel/Internal/Select.hs b/src/Text/HTML/Scalpel/Internal/Select.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Scalpel/Internal/Select.hs
@@ -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
diff --git a/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs b/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs
@@ -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)
diff --git a/src/Text/HTML/Scalpel/Internal/Select/Types.hs b/src/Text/HTML/Scalpel/Internal/Select/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/HTML/Scalpel/Internal/Select/Types.hs
@@ -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
diff --git a/tests/TestMain.hs b/tests/TestMain.hs
new file mode 100644
--- /dev/null
+++ b/tests/TestMain.hs
@@ -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
+ "foo"
+ (Just ["foo"])
+ (htmls ("a" @: []))
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (htmls ("a" @: []))
+
+ , scrapeTest
+ "foo"
+ (Just ["foo"])
+ (htmls ("a" @: []))
+
+ , scrapeTest
+ "foo"
+ (Just ["foo", "foo"])
+ (htmls ("a" @: []))
+
+ , scrapeTest
+ "foo"
+ (Just [])
+ (htmls ("b" @: []))
+
+ , scrapeTest
+ "foo"
+ (Just [""])
+ (htmls ("a" @: []))
+
+ , scrapeTest
+ "foobar"
+ (Just ["bar"])
+ (htmls ("a" @: ["key" @= "value"]))
+
+ , scrapeTest
+ "foo"
+ (Just ["foo"])
+ (htmls ("a" // "b" @: [] // "c"))
+
+ , scrapeTest
+ "foobarbaz"
+ (Just ["foo", "bar"])
+ (htmls ("a" // "b"))
+
+ , scrapeTest
+ "foo"
+ (Just ["foo"])
+ (htmls ("a" @: [hasClass "a"]))
+
+ , scrapeTest
+ "foo"
+ (Just [])
+ (htmls ("a" @: [hasClass "c"]))
+
+ , scrapeTest
+ "foobarbaz"
+ (Just ["foo", "baz"])
+ (texts ("a" @: [notP $ hasClass "a"]))
+
+ , scrapeTest
+ "foo"
+ (Just ["foo"])
+ (htmls ("a" @: ["key" @=~ re "va(foo|bar|lu)e"]))
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (htmls ("a" @: [AnyAttribute @= "value"]))
+
+ , scrapeTest
+ "foobar"
+ (Just ["bar"])
+ (htmls ("a" @: [AnyAttribute @= "value"]))
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (htmls (AnyTag @: [AnyAttribute @= "value"]))
+
+ , scrapeTest
+ "foobar"
+ (Just ["bar"])
+ (htmls (AnyTag @: [AnyAttribute @= "value"]))
+
+ , scrapeTest
+ "123"
+ (Just ["2", "3"])
+ (htmls (AnyTag @: [match (==)]))
+
+ , scrapeTest
+ "foo"
+ (Just "foo")
+ (text "a")
+
+ , scrapeTest
+ "foobar"
+ (Just "foo")
+ (text "a")
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (texts "a")
+
+ , scrapeTest
+ "foobar"
+ (Just [True, False])
+ (map (== "foo") <$> texts "a")
+
+ , scrapeTest
+ ""
+ (Just "foo")
+ (attr "key" "a")
+
+ , scrapeTest
+ ""
+ (Just "baz")
+ (attr "key2" $ "a" @: ["key1" @= "bar"])
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo"])
+ (chroot "a" $ texts "b")
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (chroots "a" $ text "b")
+
+ , scrapeTest
+ "foobar"
+ (Just "foo")
+ (text ("a" // "b") <|> text ("a" // "c"))
+
+ , scrapeTest
+ "foobar"
+ (Just "bar")
+ (text ("a" // "d") <|> text ("a" // "c"))
+
+ , scrapeTest
+ "
"
+ (Just "foobar")
+ (attr "src" "img")
+
+ , scrapeTest
+ ""
+ (Just "foobar")
+ (attr "src" "img")
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (texts "a")
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo", "bar"])
+ (texts "A")
+
+ , scrapeTest
+ "foo"
+ (Just ["foo"])
+ (texts $ "A" @: ["b" @= "C"])
+
+ , scrapeTest
+ "foo"
+ (Just [])
+ (texts $ "A" @: ["b" @= "c"])
+
+ , scrapeTest
+ "foobarbaz"
+ (Just ["foo", "baz"])
+ (texts ("a" @: [notP $ "b" @= "C"]))
+
+ , scrapeTest
+ "foo"
+ (Just "foo")
+ (html "a")
+
+ , scrapeTest
+ ""
+ (Just "1")
+ (html "li")
+
+ , scrapeTest
+ ""
+ (Just "")
+ (html "div")
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo","bar"])
+ (htmls "a")
+
+ , scrapeTest
+ ""
+ (Just ["1", "2"])
+ (htmls "li")
+
+ , scrapeTest
+ ""
+ (Just [""])
+ (htmls "div")
+
+ , scrapeTest
+ "123"
+ (Just "123")
+ (innerHTML anySelector)
+
+ , scrapeTest
+ ""
+ (Just "")
+ (innerHTML anySelector)
+
+ , scrapeTest
+ "foobar"
+ (Just ["foo","bar"])
+ (innerHTMLs "a")
+
+ , scrapeTest
+ "foobarbaz"
+ (Just "bar")
+ (chroot "a" $ do
+ t <- text anySelector
+ guard ("b" `isInfixOf` t)
+ html anySelector)
+
+ , scrapeTest
+ ""
+ (Just ["inner"])
+ (attrs "id" ("div" // "div"))
+
+ , scrapeTest
+ ""
+ (Just ["b", "c"])
+ (attrs "id" ("div" // "div"))
+
+ , scrapeTest
+ "12345"
+ (Just "12345")
+ (text anySelector)
+
+ , scrapeTest
+ "1"
+ Nothing
+ $ do
+ "Bad pattern" <- text "a"
+ return "OK"
+
+ , scrapeTest
+ "1"
+ (Just "OK")
+ $ do
+ "1" <- text "a"
+ return "OK"
+ , scrapeTest
+ "A
B
C
"
+ (Just [(0, "A"), (1, "B"), (2, "C")])
+ (chroots ("article" // "p") $ do
+ index <- position
+ content <- text anySelector
+ return (index, content))
+
+ , scrapeTest
+ "A
B
C
"
+ (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)