diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,11 @@
## 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.
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -232,6 +232,17 @@
[generalized-repetition](https://github.com/fimad/scalpel/tree/master/examples/generalized-repetition/)
in the examples directory.
+### scalpel-core
+
+The `scalpel` package relies on curl to provide networking support. For small
+projects and one off scraping tasks this is likely sufficient. However when
+using scalpel in existing projects or on platforms without curl this dependency
+can be a hindrance.
+
+For these scenarios users can instead depend on
+[scalpel-core](https://hackage.haskell.org/package/scalpel-core) which does not
+provide networking support and does not depend on curl.
+
Troubleshooting
---------------
@@ -263,3 +274,18 @@
A list of user agent strings can be found
[here](http://www.useragentstring.com/pages/useragentstring.php).
+### Building on Windows
+
+Building scalpel on Windows can be a challenge because of the dependency on
+curl. In order to successfully build scalpel you must download
+[curl](http://curl.haxx.se/download.html) and add the following to your
+stack.yaml file.
+
+```yaml
+extra-lib-dirs: ["C:/Program Files/cURL/dlls"]
+extra-include-dirs: ["C:/Program Files/cURL/dlls"]
+```
+
+If you do not require network support, you can instead depend on
+[scalpel-core](https://hackage.haskell.org/package/scalpel-core) which does not
+does not depend on curl.
diff --git a/benchmarks/Main.hs b/benchmarks/Main.hs
deleted file mode 100644
--- a/benchmarks/Main.hs
+++ /dev/null
@@ -1,57 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-import Text.HTML.Scalpel
-
-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.cabal b/scalpel.cabal
--- a/scalpel.cabal
+++ b/scalpel.cabal
@@ -1,5 +1,5 @@
name: scalpel
-version: 0.4.1
+version: 0.5.0
synopsis: A high level web scraping library for Haskell.
description:
Scalpel is a web scraping library inspired by libraries like Parsec and
@@ -24,66 +24,27 @@
source-repository this
type: git
location: https://github.com/fimad/scalpel.git
- tag: v0.4.1
+ 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.Scrape.URL
- , Text.HTML.Scalpel.Internal.Select
- , Text.HTML.Scalpel.Internal.Select.Combinators
- , Text.HTML.Scalpel.Internal.Select.Types
+ Text.HTML.Scalpel.Internal.Scrape.URL
exposed-modules:
Text.HTML.Scalpel
hs-source-dirs: src/
default-language: Haskell2010
build-depends:
base >= 4.6 && < 5
+ , scalpel-core == 0.5.0
, bytestring
- , containers
, curl >= 1.3.4
, 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
- , 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
- , tagsoup
- , text
- ghc-options: -Wall
diff --git a/src/Text/HTML/Scalpel.hs b/src/Text/HTML/Scalpel.hs
--- a/src/Text/HTML/Scalpel.hs
+++ b/src/Text/HTML/Scalpel.hs
@@ -144,8 +144,5 @@
, iso88591Decoder
) where
-import Text.HTML.Scalpel.Internal.Scrape
-import Text.HTML.Scalpel.Internal.Scrape.StringLike
+import Text.HTML.Scalpel.Core
import Text.HTML.Scalpel.Internal.Scrape.URL
-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
deleted file mode 100644
--- a/src/Text/HTML/Scalpel/Internal/Scrape.hs
+++ /dev/null
@@ -1,232 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-{-# 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/Scrape/URL.hs b/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs
--- a/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs
+++ b/src/Text/HTML/Scalpel/Internal/Scrape/URL.hs
@@ -13,7 +13,7 @@
, scrapeURLWithConfig
) where
-import Text.HTML.Scalpel.Internal.Scrape
+import Text.HTML.Scalpel.Core
import Control.Applicative ((<$>))
import Data.Char (toLower)
@@ -52,6 +52,12 @@
-- | The 'scrapeURL' function downloads the contents of the given URL and
-- executes a 'Scraper' on it.
+--
+-- 'scrapeURL' makes use of curl to make HTTP requests. The dependency on curl
+-- may be too heavyweight for some use cases. In which case users who do not
+-- require inbuilt networking support can depend on
+-- for a
+-- lightweight subset of this library that does not depend on curl.
scrapeURL :: (Ord str, TagSoup.StringLike str)
=> URL -> Scraper str a -> IO (Maybe a)
scrapeURL = scrapeURLWithOpts [Curl.CurlFollowLocation True]
diff --git a/src/Text/HTML/Scalpel/Internal/Select.hs b/src/Text/HTML/Scalpel/Internal/Select.hs
deleted file mode 100644
--- a/src/Text/HTML/Scalpel/Internal/Select.hs
+++ /dev/null
@@ -1,267 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs
+++ /dev/null
@@ -1,81 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/src/Text/HTML/Scalpel/Internal/Select/Types.hs
+++ /dev/null
@@ -1,83 +0,0 @@
-{-# 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
deleted file mode 100644
--- a/tests/TestMain.hs
+++ /dev/null
@@ -1,305 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Main (main) where
-
-import Text.HTML.Scalpel
-
-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)