scalpel 0.4.1 → 0.5.0

raw patch · 12 files changed

+43/−1090 lines, 12 filesdep +scalpel-coredep −HUnitdep −containersdep −criteriondep ~basedep ~tagsoupPVP ok

version bump matches the API change (PVP)

Dependencies added: scalpel-core

Dependencies removed: HUnit, containers, criterion, fail, regex-base, regex-tdfa, scalpel, vector

Dependency ranges changed: base, tagsoup

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +26/−0
• benchmarks/Main.hs +0/−57
• scalpel.cabal +4/−43
• src/Text/HTML/Scalpel.hs +1/−4
• src/Text/HTML/Scalpel/Internal/Scrape.hs +0/−232
• src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs +0/−17
• src/Text/HTML/Scalpel/Internal/Scrape/URL.hs +7/−1
• src/Text/HTML/Scalpel/Internal/Select.hs +0/−267
• src/Text/HTML/Scalpel/Internal/Select/Combinators.hs +0/−81
• src/Text/HTML/Scalpel/Internal/Select/Types.hs +0/−83
• tests/TestMain.hs +0/−305

@@ -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.

@@ -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.

@@ -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 "<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")

@@ -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

@@ -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

@@ -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:------ @--- \<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

@@ -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)

@@ -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+-- <https://hackage.haskell.org/package/scalpel-core scalpel-core> 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]

@@ -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

@@ -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)

@@ -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

@@ -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-            "<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)