scalpel-core 0.6.1 → 0.6.2
raw patch · 6 files changed
+198/−166 lines, 6 filesdep +mtldep +transformers
Dependencies added: mtl, transformers
Files
- CHANGELOG.md +2/−0
- scalpel-core.cabal +4/−2
- src/Text/HTML/Scalpel/Core.hs +4/−0
- src/Text/HTML/Scalpel/Internal/Scrape.hs +90/−76
- src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs +11/−3
- src/Text/HTML/Scalpel/Internal/Serial.hs +87/−85
CHANGELOG.md view
@@ -2,6 +2,8 @@ ## HEAD +## 0.6.2+ ## 0.6.1 - Support GHC 8.8.
scalpel-core.cabal view
@@ -1,5 +1,5 @@ name: scalpel-core-version: 0.6.1+version: 0.6.2 synopsis: A high level web scraping library for Haskell. description: Scalpel core provides a subset of the scalpel web scraping library that is@@ -24,7 +24,7 @@ source-repository this type: git location: https://github.com/fimad/scalpel.git- tag: v0.6.1+ tag: v0.6.2 library other-extensions:@@ -53,6 +53,8 @@ , tagsoup >= 0.12.2 , text , vector+ , transformers+ , mtl default-extensions: ParallelListComp , PatternGuards
src/Text/HTML/Scalpel/Core.hs view
@@ -34,6 +34,7 @@ -- * Scrapers , Scraper+, ScraperT -- ** Primitives , attr , attrs@@ -49,10 +50,13 @@ , matches -- ** Executing scrapers , scrape+, scrapeT , scrapeStringLike+, scrapeStringLikeT -- * Serial Scraping , SerialScraper+, SerialScraperT , inSerial -- ** Primitives , stepNext
src/Text/HTML/Scalpel/Internal/Scrape.hs view
@@ -1,8 +1,16 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Scrape (- Scraper (..)+ Scraper+, ScraperT (..) , scrape+, scrapeT , attr , attrs , html@@ -22,6 +30,13 @@ import Control.Applicative import Control.Monad+import Control.Monad.Except (MonadError)+import Control.Monad.Cont (MonadCont)+import Control.Monad.Reader+import Control.Monad.State (MonadState)+import Control.Monad.Trans.Maybe+import Control.Monad.Writer (MonadWriter)+import Data.Functor.Identity import Data.Maybe import qualified Control.Monad.Fail as Fail@@ -30,49 +45,44 @@ 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- }+-- | A 'ScraperT' operates like 'Scraper' but also acts as a monad transformer.+newtype ScraperT str m a = MkScraper (ReaderT (TagSpec str) (MaybeT m) a)+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix,+ MonadIO, MonadCont, MonadError e, MonadState s, MonadWriter w) -instance Functor (Scraper str) where- fmap f (MkScraper a) = MkScraper $ fmap (fmap f) a+#if MIN_VERSION_base(4,9,0)+deriving instance Monad m => Fail.MonadFail (ScraperT str m)+#else+instance Fail.MonadFail m => Fail.MonadFail (ScraperT str m) where+ fail = lift . Fail.fail+#endif -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 MonadTrans (ScraperT str) where+ lift op = MkScraper . lift . lift $ op -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 MonadReader s m => MonadReader s (ScraperT str m) where+ ask = MkScraper (lift . lift $ ask)+ local f (MkScraper op) = (fmap MkScraper . mapReaderT . local) f op -instance Monad (Scraper str) where-#if __GLASGOW_HASKELL__ < 808- fail = Fail.fail-#endif- return = pure- (MkScraper a) >>= f = MkScraper combined- where combined tags | (Just aVal) <- a tags = let (MkScraper b) = f aVal- in b tags- | otherwise = Nothing+-- | 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@.+type Scraper str = ScraperT str Identity -instance MonadPlus (Scraper str) where- mzero = empty- mplus = (<|>)+scrapeTagSpec :: ScraperT str m a -> TagSpec str -> m (Maybe a)+scrapeTagSpec (MkScraper r) = runMaybeT . runReaderT r -instance Fail.MonadFail (Scraper str) where- fail _ = mzero+-- | The 'scrapeT' function executes a 'ScraperT' on a list of 'TagSoup.Tag's+-- and produces an optional value. Since 'ScraperT' is a monad transformer, the+-- result is monadic.+scrapeT :: (TagSoup.StringLike str)+ => ScraperT str m a -> [TagSoup.Tag str] -> m (Maybe a)+scrapeT s = scrapeTagSpec s . tagsToSpec . TagSoup.canonicalizeTags --- | The 'scrape' function executes a 'Scraper' on a list of--- 'TagSoup.Tag's and produces an optional value.+-- | The 'scrape' function executes a 'Scraper' on a list of 'TagSoup.Tag's and+-- produces an optional value. scrape :: (TagSoup.StringLike str) => Scraper str a -> [TagSoup.Tag str] -> Maybe a-scrape s = scrapeTagSpec s . tagsToSpec . TagSoup.canonicalizeTags+scrape = fmap runIdentity . scrapeT -- | 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@@ -80,8 +90,8 @@ -- -- This function will match only the first set of tags matching the selector, to -- match every set of tags, use 'chroots'.-chroot :: (TagSoup.StringLike str)- => Selector -> Scraper str a -> Scraper str a+chroot :: (TagSoup.StringLike str, Monad m)+ => Selector -> ScraperT str m a -> ScraperT str m a chroot selector inner = do maybeResult <- listToMaybe <$> chroots selector inner guard (isJust maybeResult)@@ -94,49 +104,51 @@ -- -- > s = "<div><div>A</div></div>" -- > scrapeStringLike s (chroots "div" (pure 0)) == Just [0, 0]-chroots :: (TagSoup.StringLike str)- => Selector -> Scraper str a -> Scraper str [a]-chroots selector (MkScraper inner) = MkScraper- $ return . mapMaybe inner . select selector+chroots :: (TagSoup.StringLike str, Monad m)+ => Selector -> ScraperT str m a -> ScraperT str m [a]+chroots selector (MkScraper (ReaderT inner)) =+ MkScraper $ ReaderT $ \tags -> MaybeT $ do+ mvalues <- forM (select selector tags) (runMaybeT . inner)+ return $ Just $ catMaybes mvalues -- | The 'matches' function takes a selector and returns `()` if the selector -- matches any node in the DOM.-matches :: (TagSoup.StringLike str) => Selector -> Scraper str ()-matches s = MkScraper $ withHead (pure ()) . select s+matches :: (TagSoup.StringLike str, Monad m) => Selector -> ScraperT str m ()+matches s = MkScraper $ (guard . not . null) =<< reader (select s) -- | 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 :: (TagSoup.StringLike str) => Selector -> Scraper str str-text s = MkScraper $ withHead tagsToText . select s+text :: (TagSoup.StringLike str, Monad m) => Selector -> ScraperT str m str+text s = MkScraper $ withHead tagsToText =<< reader (select s) -- | The 'texts' function takes a selector and returns the inner text from every -- set of tags (possibly nested) matching the given selector. -- -- > s = "<div>Hello <div>World</div></div>" -- > scrapeStringLike s (texts "div") == Just ["Hello World", "World"]-texts :: (TagSoup.StringLike str)- => Selector -> Scraper str [str]-texts s = MkScraper $ withAll tagsToText . select s+texts :: (TagSoup.StringLike str, Monad m)+ => Selector -> ScraperT str m [str]+texts s = MkScraper $ withAll tagsToText =<< reader (select s) -- | The 'html' function takes a selector and returns the html string from the -- set of tags described by the given selector. -- -- This function will match only the first set of tags matching the selector, to -- match every set of tags, use 'htmls'.-html :: (TagSoup.StringLike str) => Selector -> Scraper str str-html s = MkScraper $ withHead tagsToHTML . select s+html :: (TagSoup.StringLike str, Monad m) => Selector -> ScraperT str m str+html s = MkScraper $ withHead tagsToHTML =<< reader (select s) -- | The 'htmls' function takes a selector and returns the html string from -- every set of tags (possibly nested) matching the given selector. -- -- > s = "<div><div>A</div></div>" -- > scrapeStringLike s (htmls "div") == Just ["<div><div>A</div></div>", "<div>A</div>"]-htmls :: (TagSoup.StringLike str)- => Selector -> Scraper str [str]-htmls s = MkScraper $ withAll tagsToHTML . select s+htmls :: (TagSoup.StringLike str, Monad m)+ => Selector -> ScraperT str m [str]+htmls s = MkScraper $ withAll tagsToHTML =<< reader (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@@ -144,18 +156,18 @@ -- -- This function will match only the first set of tags matching the selector, to -- match every set of tags, use 'innerHTMLs'.-innerHTML :: (TagSoup.StringLike str)- => Selector -> Scraper str str-innerHTML s = MkScraper $ withHead tagsToInnerHTML . select s+innerHTML :: (TagSoup.StringLike str, Monad m)+ => Selector -> ScraperT str m str+innerHTML s = MkScraper $ withHead tagsToInnerHTML =<< reader (select s) -- | The 'innerHTMLs' function takes a selector and returns the inner html -- string from every set of tags (possibly nested) matching the given selector. -- -- > s = "<div><div>A</div></div>" -- > scrapeStringLike s (innerHTMLs "div") == Just ["<div>A</div>", "A"]-innerHTMLs :: (TagSoup.StringLike str)- => Selector -> Scraper str [str]-innerHTMLs s = MkScraper $ withAll tagsToInnerHTML . select s+innerHTMLs :: (TagSoup.StringLike str, Monad m)+ => Selector -> ScraperT str m [str]+innerHTMLs s = MkScraper $ withAll tagsToInnerHTML =<< reader (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@@ -163,10 +175,11 @@ -- -- This function will match only the opening tag matching the selector, to match -- every tag, use 'attrs'.-attr :: (Show str, TagSoup.StringLike str)- => String -> Selector -> Scraper str str-attr name s = MkScraper- $ join . withHead (tagsToAttr $ TagSoup.castString name) . select s+attr :: (Show str, TagSoup.StringLike str, Monad m)+ => String -> Selector -> ScraperT str m str+attr name s = MkScraper $ ReaderT $ MaybeT+ . return . listToMaybe . catMaybes+ . fmap (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@@ -174,10 +187,11 @@ -- -- > s = "<div id=\"out\"><div id=\"in\"></div></div>" -- > scrapeStringLike s (attrs "id" "div") == Just ["out", "in"]-attrs :: (Show str, TagSoup.StringLike str)- => String -> Selector -> Scraper str [str]-attrs name s = MkScraper- $ fmap catMaybes . withAll (tagsToAttr nameStr) . select s+attrs :: (Show str, TagSoup.StringLike str, Monad m)+ => String -> Selector -> ScraperT str m [str]+attrs name s = MkScraper $ ReaderT $ MaybeT+ . return . Just . catMaybes+ . fmap (tagsToAttr nameStr) . select s where nameStr = TagSoup.castString name -- | The 'position' function is intended to be used within the do-block of a@@ -214,15 +228,15 @@ -- , (2, "Third paragraph.") -- ] -- @-position :: (TagSoup.StringLike str) => Scraper str Int-position = MkScraper $ Just . tagsToPosition+position :: (TagSoup.StringLike str, Monad m) => ScraperT str m Int+position = MkScraper $ reader tagsToPosition -withHead :: (a -> b) -> [a] -> Maybe b-withHead _ [] = Nothing-withHead f (x:_) = Just $ f x+withHead :: Monad m => (a -> b) -> [a] -> ReaderT (TagSpec str) (MaybeT m) b+withHead _ [] = empty+withHead f (x:_) = return $ f x -withAll :: (a -> b) -> [a] -> Maybe [b]-withAll f xs = Just $ map f xs+withAll :: Monad m => (a -> b) -> [a] -> ReaderT (TagSpec str) (MaybeT m) [b]+withAll f xs = return $ map f xs foldSpec :: TagSoup.StringLike str => (TagSoup.Tag str -> str -> str) -> TagSpec str -> str@@ -246,11 +260,11 @@ tagsToAttr :: (Show str, TagSoup.StringLike str) => str -> TagSpec str -> Maybe str-tagsToAttr attr (tags, _, _) = do+tagsToAttr tagName (tags, _, _) = do guard $ 0 < Vector.length tags let tag = infoTag $ tags Vector.! 0 guard $ TagSoup.isTagOpen tag- return $ TagSoup.fromAttrib attr tag+ return $ TagSoup.fromAttrib tagName tag tagsToPosition :: TagSpec str -> Int tagsToPosition (_, _, ctx) = ctxPosition ctx
src/Text/HTML/Scalpel/Internal/Scrape/StringLike.hs view
@@ -1,17 +1,25 @@ {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Scrape.StringLike ( scrapeStringLike+, scrapeStringLikeT ) where +import Data.Functor.Identity 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 :: (TagSoup.StringLike str) => str -> Scraper str a -> Maybe a-scrapeStringLike html scraper- = scrape scraper (TagSoup.parseTagsOptions TagSoup.parseOptionsFast html)+scrapeStringLike = fmap runIdentity . scrapeStringLikeT++-- | The 'scrapeStringLikeT' function parses a 'StringLike' value into a list of+-- tags and executes a 'ScraperT' on it. Since 'ScraperT' is a monad+-- transformer, the result is monadic.+scrapeStringLikeT :: (TagSoup.StringLike str, Monad m)+ => str -> ScraperT str m a -> m (Maybe a)+scrapeStringLikeT tags scraper = scrapeT scraper+ (TagSoup.parseTagsOptions TagSoup.parseOptionsFast tags)
src/Text/HTML/Scalpel/Internal/Serial.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Serial ( SerialScraper+, SerialScraperT , inSerial , stepBack , stepNext@@ -17,7 +24,18 @@ import Control.Applicative import Control.Monad+import Control.Monad.Trans+import Control.Monad.Except (MonadError)+import Control.Monad.Cont (MonadCont)+import Control.Monad.Reader+import Control.Monad.State+import Control.Monad.Trans.Maybe+import Control.Monad.Writer (MonadWriter)+import Data.Bifunctor+import Data.Functor.Identity import Data.List.PointedList (PointedList)+import Data.Maybe+import Prelude hiding (until) import qualified Control.Monad.Fail as Fail import qualified Data.List.PointedList as PointedList@@ -92,59 +110,39 @@ -- ("Section 2", ["Paragraph 2.1", "Paragraph 2.2"]), -- ]) -- @-newtype SerialScraper str a =- MkSerialScraper (SpecZipper str -> Maybe (a, SpecZipper str))--instance Functor (SerialScraper str) where- fmap f (MkSerialScraper a) = MkSerialScraper applied- where applied zipper- | Just (aVal, zipper') <- a zipper = Just (f aVal, zipper')- | otherwise = Nothing--instance Applicative (SerialScraper str) where- pure a = MkSerialScraper $ \zipper -> Just (a, zipper)- (MkSerialScraper f) <*> (MkSerialScraper a) = MkSerialScraper applied- where- applied zipper = do- (f', zipper') <- f zipper- (a', zipper'') <- a zipper'- return (f' a', zipper'')+type SerialScraper str a = SerialScraperT str Identity a -instance Alternative (SerialScraper str) where- empty = MkSerialScraper $ const Nothing- (MkSerialScraper a) <|> (MkSerialScraper b) = MkSerialScraper choice- where choice zipper | (Just aVal) <- a zipper = Just aVal- | otherwise = b zipper+-- | Run a serial scraper transforming over a monad 'm'.+newtype SerialScraperT str m a =+ MkSerialScraper (StateT (SpecZipper str) (MaybeT m) a)+ deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadFix,+ MonadIO, MonadCont, MonadError e, MonadReader r, MonadWriter w) -instance Monad (SerialScraper str) where-#if __GLASGOW_HASKELL__ < 808- fail = Fail.fail+#if MIN_VERSION_base(4,9,0)+deriving instance Monad m => Fail.MonadFail (SerialScraperT str m)+#else+instance Fail.MonadFail m => Fail.MonadFail (SerialScraperT str m) where+ fail = lift . Fail.fail #endif- return = pure- (MkSerialScraper a) >>= f = MkSerialScraper combined- where- combined zipper = do- (aVal, zipper') <- a zipper- let (MkSerialScraper b) = f aVal- b zipper' -instance MonadPlus (SerialScraper str) where- mzero = empty- mplus = (<|>)+instance MonadTrans (SerialScraperT str) where+ lift op = MkSerialScraper . lift . lift $ op -instance Fail.MonadFail (SerialScraper str) where- fail _ = mzero+instance MonadState s m => MonadState s (SerialScraperT str m) where+ get = MkSerialScraper (lift . lift $ get)+ put = MkSerialScraper . lift . lift . put -- | Executes a 'SerialScraper' in the context of a 'Scraper'. The immediate -- children of the currently focused node are visited serially.-inSerial :: TagSoup.StringLike str => SerialScraper str a -> Scraper str a-inSerial (MkSerialScraper serialScraper) = MkScraper scraper+inSerial :: (TagSoup.StringLike str, Monad m)+ => SerialScraperT str m a -> ScraperT str m a+inSerial (MkSerialScraper serialScraper) = MkScraper $ ReaderT $ scraper where scraper spec@(vec, root : _, ctx)- | ctxInChroot ctx = fst <$> serialScraper+ | ctxInChroot ctx = evalStateT serialScraper (toZipper (vec, Tree.subForest root, ctx))- | otherwise = fst <$> serialScraper (toZipper spec)- scraper _ = Nothing+ | otherwise = evalStateT serialScraper (toZipper spec)+ scraper _ = empty -- Create a zipper from the current tag spec by generating a new tag spec -- that just contains each root node in the forest.@@ -159,78 +157,79 @@ . foldr (PointedList.insertLeft . Just) (PointedList.singleton Nothing) -stepWith :: TagSoup.StringLike str+stepWith :: (TagSoup.StringLike str, Monad m) => (SpecZipper str -> Maybe (SpecZipper str))- -> Scraper str b- -> SerialScraper str b-stepWith moveList (MkScraper scraper) = MkSerialScraper $ \zipper -> do- zipper' <- moveList zipper- focus <- PointedList._focus zipper'- value <- scraper focus- return (value, zipper')+ -> ScraperT str m b+ -> SerialScraperT str m b+stepWith moveList (MkScraper (ReaderT scraper)) = MkSerialScraper . StateT $+ \zipper -> do+ zipper' <- maybeT $ moveList zipper+ focus <- maybeT $ PointedList._focus zipper'+ value <- scraper focus+ return (value, zipper') -- | Move the cursor back one node and execute the given scraper on the new -- focused node.-stepBack :: TagSoup.StringLike str => Scraper str a -> SerialScraper str a+stepBack :: (TagSoup.StringLike str, Monad m) => ScraperT str m a -> SerialScraperT str m a stepBack = stepWith PointedList.previous -- | Move the cursor forward one node and execute the given scraper on the new -- focused node.-stepNext :: TagSoup.StringLike str => Scraper str a -> SerialScraper str a+stepNext :: (TagSoup.StringLike str, Monad m)+ => ScraperT str m a -> SerialScraperT str m a stepNext = stepWith PointedList.next -seekWith :: TagSoup.StringLike str+seekWith :: (TagSoup.StringLike str, Monad m) => (SpecZipper str -> Maybe (SpecZipper str))- -> Scraper str b- -> SerialScraper str b-seekWith moveList (MkScraper scraper) = MkSerialScraper go+ -> ScraperT str m b+ -> SerialScraperT str m b+seekWith moveList (MkScraper (ReaderT scraper)) = MkSerialScraper (StateT go) where- go zipper = do- zipper' <- moveList zipper- runScraper zipper' <|> go zipper'+ go zipper = do zipper' <- maybeT $ moveList zipper+ runScraper zipper' <|> go zipper' runScraper zipper = do- focus <- PointedList._focus zipper+ focus <- maybeT $ PointedList._focus zipper value <- scraper focus return (value, zipper) -- | Move the cursor backward until the given scraper is successfully able to -- execute on the focused node. If the scraper is never successful then the -- serial scraper will fail.-seekBack :: TagSoup.StringLike str => Scraper str a -> SerialScraper str a+seekBack :: (TagSoup.StringLike str, Monad m)+ => ScraperT str m a -> SerialScraperT str m a seekBack = seekWith PointedList.previous -- | Move the cursor forward until the given scraper is successfully able to -- execute on the focused node. If the scraper is never successful then the -- serial scraper will fail.-seekNext :: TagSoup.StringLike str => Scraper str a -> SerialScraper str a+seekNext :: (TagSoup.StringLike str, Monad m)+ => ScraperT str m a -> SerialScraperT str m a seekNext = seekWith PointedList.next -untilWith :: TagSoup.StringLike str+untilWith :: (TagSoup.StringLike str, Monad m) => (SpecZipper str -> Maybe (SpecZipper str)) -> (Maybe (TagSpec str) -> SpecZipper str -> SpecZipper str)- -> Scraper str a- -> SerialScraper str b- -> SerialScraper str b-untilWith moveList appendNode- (MkScraper untilScraper) (MkSerialScraper scraper) =- MkSerialScraper $ \zipper -> do- let (innerZipper, zipper') = split zipper- (value, _) <- scraper $ appendNode Nothing innerZipper- return (value, zipper')- where- split zipper- | Just zipper' <- moveList zipper- , Just spec <- PointedList._focus zipper'- , Nothing <- untilScraper spec =- let (specs, zipper'') = split zipper'- in (appendNode (Just spec) specs, zipper'')- | otherwise = (PointedList.singleton Nothing, zipper)+ -> ScraperT str m a+ -> SerialScraperT str m b+ -> SerialScraperT str m b+untilWith moveList appendNode (MkScraper (ReaderT until)) (MkSerialScraper scraper) =+ MkSerialScraper $ do+ inner <- StateT split+ lift (evalStateT scraper (appendNode Nothing inner))+ where+ split zipper =+ do zipper' <- maybeT $ moveList zipper+ spec <- maybeT $ PointedList._focus zipper'+ do until spec+ return (PointedList.singleton Nothing, zipper)+ <|> (first (appendNode (Just spec)) `liftM` split zipper')+ <|> return (PointedList.singleton Nothing, zipper) -- | Create a new serial context by moving the focus backward and collecting -- nodes until the scraper matches the focused node. The serial scraper is then -- executed on the collected nodes.-untilBack :: TagSoup.StringLike str- => Scraper str a -> SerialScraper str b -> SerialScraper str b+untilBack :: (TagSoup.StringLike str, Monad m)+ => ScraperT str m a -> SerialScraperT str m b -> SerialScraperT str m b untilBack = untilWith PointedList.previous PointedList.insertRight -- | Create a new serial context by moving the focus forward and collecting@@ -239,6 +238,9 @@ -- -- The provided serial scraper is unable to see nodes outside the new restricted -- context.-untilNext :: TagSoup.StringLike str- => Scraper str a -> SerialScraper str b -> SerialScraper str b+untilNext :: (TagSoup.StringLike str, Monad m)+ => ScraperT str m a -> SerialScraperT str m b -> SerialScraperT str m b untilNext = untilWith PointedList.next PointedList.insertLeft++maybeT :: Monad m => Maybe a -> MaybeT m a+maybeT = MaybeT . return