scalpel 0.1.3.1 → 0.2.0

raw patch · 7 files changed

+89/−113 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• scalpel.cabal +3/−4
• src/Text/HTML/Scalpel.hs +2/−2
• src/Text/HTML/Scalpel/Internal/Scrape.hs +15/−12
• src/Text/HTML/Scalpel/Internal/Select.hs +8/−7
• src/Text/HTML/Scalpel/Internal/Select/Combinators.hs +23/−19
• src/Text/HTML/Scalpel/Internal/Select/Types.hs +31/−62
• tests/TestMain.hs +7/−7

@@ -1,5 +1,5 @@ name:                scalpel-version:             0.1.3.1+version:             0.2.0 synopsis:            A high level web scraping library for Haskell. description:     Scalpel is a web scraping library inspired by libraries like Parsec and@@ -21,7 +21,7 @@ source-repository this   type:     git   location: https://github.com/fimad/scalpel.git-  tag:      v0.1.3.1+  tag:      v0.2.0  library   other-extensions:@@ -47,8 +47,7 @@       ,   tagsoup       >= 0.12.2       ,   text   default-extensions:-          OverloadedStrings-      ,   ParallelListComp+          ParallelListComp       ,   PatternGuards   ghc-options: -W 

@@ -40,7 +40,7 @@ -- -- -- The following is an example that demonstrates most of the features provided--- by this library. Supposed you have the following hypothetical HTML located at+-- by this library. Suppose you have the following hypothetical HTML located at -- @\"http://example.com/article.html\"@ and you would like to extract a list of -- all of the comments. --@@ -54,7 +54,7 @@ -- >       <div class='comment container'> -- >         <span class='comment author'>Bill</span> -- >         <img class='comment image' src='http://example.com/cat.gif' />--- >       </div>\+-- >       </div> -- >       <div class='comment container'> -- >         <span class='comment author'>Susan</span> -- >         <div class='comment text'>WTF!?!</div>

@@ -58,7 +58,7 @@ -- -- 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, Selectable str s)+chroot :: (TagSoup.StringLike str, Selectable s)        => s -> Scraper str a -> Scraper str a chroot selector (MkScraper inner) = MkScraper                                   $ join . (inner <$>)@@ -68,7 +68,7 @@ -- 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 :: (TagSoup.StringLike str, Selectable str s)+chroots :: (TagSoup.StringLike str, Selectable s)         => s -> Scraper str a -> Scraper str [a] chroots selector (MkScraper inner) = MkScraper                                    $ return . mapMaybe inner . select selector@@ -78,12 +78,12 @@ -- -- 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, Selectable str s) => s -> Scraper str str+text :: (TagSoup.StringLike str, Selectable s) => s -> 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 :: (TagSoup.StringLike str, Selectable str s) => s -> Scraper str [str]+texts :: (TagSoup.StringLike str, Selectable s) => s -> Scraper str [str] texts s = MkScraper $ withAll tagsToText . select s  -- | The 'html' function takes a selector and returns the html string from the@@ -91,12 +91,12 @@ -- -- 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, Selectable str s) => s -> Scraper str str+html :: (TagSoup.StringLike str, Selectable s) => s -> 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 :: (TagSoup.StringLike str, Selectable str s) => s -> Scraper str [str]+htmls :: (TagSoup.StringLike str, Selectable s) => s -> Scraper str [str] htmls s = MkScraper $ withAll tagsToHTML . select s  -- | The 'attr' function takes an attribute name and a selector and returns the@@ -105,16 +105,19 @@ -- -- This function will match only the opening tag matching the selector, to match -- every tag, use 'attrs'.-attr :: (Show str, TagSoup.StringLike str, Selectable str s)-     => str -> s -> Scraper str str-attr name s = MkScraper $ join . withHead (tagsToAttr name) . select s+attr :: (Show str, TagSoup.StringLike str, Selectable s)+     => String -> s -> 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 :: (Show str, TagSoup.StringLike str, Selectable str s)-     => str -> s -> Scraper str [str]-attrs name s = MkScraper $ fmap catMaybes . withAll (tagsToAttr name) . select s+attrs :: (Show str, TagSoup.StringLike str, Selectable s)+     => String -> s -> Scraper str [str]+attrs name s = MkScraper+             $ fmap catMaybes . withAll (tagsToAttr nameStr) . select s+    where nameStr = TagSoup.castString name  withHead :: (a -> b) -> [a] -> Maybe b withHead _ []    = Nothing

@@ -1,3 +1,4 @@+{-# LANGUAGE ImpredicativeTypes #-} {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Select (     select@@ -14,13 +15,13 @@ -- | 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 :: (TagSoup.StringLike str, Selectable str s)+select :: (TagSoup.StringLike str, Selectable s)        => s -> [TagSoup.Tag str] -> [[TagSoup.Tag str]] select s = selectNodes nodes     where (MkSelector nodes) = toSelector s  selectNodes :: TagSoup.StringLike str-            => [SelectNode str] -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]+            => [SelectNode] -> [TagSoup.Tag str] -> [[TagSoup.Tag str]] selectNodes nodes tags = head' $ reverse results     where results = [concatMap (selectNode s) ts | s  <- nodes                                                  | ts <- [tags] : results]@@ -28,7 +29,7 @@           head' (x:_) = x  selectNode :: TagSoup.StringLike str-           => SelectNode str -> [TagSoup.Tag str] -> [[TagSoup.Tag str]]+           => SelectNode -> [TagSoup.Tag str] -> [[TagSoup.Tag str]] selectNode (SelectNode node attributes) tags = concatMap extractTagBlock nodes     where nodes = filter (checkTag node attributes) $ tails tags selectNode (SelectAny attributes) tags = concatMap extractTagBlock nodes@@ -37,15 +38,15 @@ -- 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-          => str -> [AttributePredicate str] -> [TagSoup.Tag str] -> Bool+          => String -> [AttributePredicate] -> [TagSoup.Tag str] -> Bool checkTag name preds tags@(TagSoup.TagOpen str _:_)-    = name == str && checkPreds preds tags+    = TagSoup.fromString name == str && checkPreds preds tags checkTag _ _ _ = False  checkPreds :: TagSoup.StringLike str-            => [AttributePredicate str] -> [TagSoup.Tag str] -> Bool+            => [AttributePredicate] -> [TagSoup.Tag str] -> Bool checkPreds preds (TagSoup.TagOpen _ attrs:_)-    = and [or [p attr | attr <- attrs] | p <- preds]+    = and [or [checkPred p attr | attr <- attrs] | p <- preds] checkPreds _ _ = False  -- Given a list of tags, return the prefix of the tags up to the closing tag

@@ -1,3 +1,6 @@+{-# LANGUAGE ImpredicativeTypes #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiWayIf #-} {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Select.Combinators (     (//)@@ -16,8 +19,7 @@  -- | The '@:' operator creates a 'Selector' by combining a 'TagName' with a list -- of 'AttributePredicate's.-(@:) :: (TagSoup.StringLike str, TagName str tag)-     => tag -> [AttributePredicate str] -> Selector str+(@:) :: TagName tag => tag -> [AttributePredicate] -> Selector (@:) tag attrs = MkSelector [toSelectNode tag attrs] infixl 9 @: @@ -26,26 +28,26 @@ -- -- If you are attempting to match a specific class of a tag with potentially -- multiple classes, you should use the 'hasClass' utility function.-(@=) :: (TagSoup.StringLike str, AttributeName str key)-     => key -> str -> AttributePredicate str-(@=) key value (attrKey, attrValue) =  matchKey key attrKey-                                    && value == attrValue+(@=) :: AttributeName key => key -> String -> AttributePredicate+(@=) key value = MkAttributePredicate $ \(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.-(@=~) :: (TagSoup.StringLike str, AttributeName str key, RE.RegexLike re str)-      => key -> re -> AttributePredicate str-(@=~) key re (attrKey, attrValue) =  matchKey key attrKey-                                  && RE.matchTest re attrValue+(@=~) :: (AttributeName key, RE.RegexLike re String)+      => key -> re -> AttributePredicate+(@=~) key re = MkAttributePredicate $ \(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.-(//) :: (TagSoup.StringLike str, Selectable str a, Selectable str b)-    => a -> b -> Selector str+(//) :: (Selectable a, Selectable b) => a -> b -> Selector (//) a b = MkSelector (as ++ bs)     where (MkSelector as) = toSelector a           (MkSelector bs) = toSelector b@@ -54,10 +56,12 @@ -- | 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 :: TagSoup.StringLike str => str -> AttributePredicate str-hasClass clazz (attrName, classes)-    | "class" == TagSoup.toString attrName = textClass `elem` classList-    | otherwise                            = False-    where textClass   = TagSoup.castString clazz-          textClasses = TagSoup.castString classes-          classList   = T.split (== ' ') textClasses+hasClass :: String -> AttributePredicate+hasClass clazz = MkAttributePredicate 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

@@ -1,10 +1,12 @@ {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ImpredicativeTypes #-} {-# OPTIONS_HADDOCK hide #-} module Text.HTML.Scalpel.Internal.Select.Types (     Selector (..) ,   Selectable (..)-,   AttributePredicate+,   AttributePredicate (..)+,   checkPred ,   Any (..) ,   AttributeName (..) ,   TagName (..)@@ -12,18 +14,15 @@ ,   SelectNode (..) ) where -import qualified Data.ByteString as BS-import qualified Data.ByteString.Lazy as LBS-import qualified Data.Text as T-import qualified Data.Text.Lazy as LT import qualified Text.HTML.TagSoup as TagSoup+import qualified Text.StringLike as TagSoup   -- | The 'Selectable' class defines a class of types that are capable of being -- cast into a 'Selector' which in turns describes a section of an HTML DOM -- tree.-class Selectable str s | s -> str where-    toSelector :: s -> Selector str+class Selectable s where+    toSelector :: s -> Selector  -- | The 'AttributeName' class defines a class of types that can be used when -- creating 'Selector's to specify the name of an attribute of a tag.@@ -33,8 +32,8 @@ -- names of that value. -- -- In addition there is also the 'Any' type which will match any attribute name.-class AttributeName str k | k -> str where-    matchKey :: k -> str -> Bool+class AttributeName k where+    matchKey :: TagSoup.StringLike str => k -> str -> Bool  -- | The 'TagName' class defines a class of types that can be used when creating -- 'Selector's to specify the name of a tag.@@ -43,81 +42,51 @@ -- 'T.Text', etc). Values of these types refer to tags of the given value. -- -- In addition there is also the 'Any' type which will match any tag.-class TagName str t | t -> str where-    toSelectNode :: t -> [AttributePredicate str] -> SelectNode str+class TagName t where+    toSelectNode :: t -> [AttributePredicate] -> SelectNode  -- | An 'AttributePredicate' is a method that takes a 'TagSoup.Attribute' and -- returns a 'Bool' indicating if the given attribute matches a predicate.-type AttributePredicate str = TagSoup.Attribute str -> Bool+data AttributePredicate+        = MkAttributePredicate+                (TagSoup.StringLike str => TagSoup.Attribute str -> Bool) +checkPred :: TagSoup.StringLike str+          => AttributePredicate -> TagSoup.Attribute str -> Bool+checkPred (MkAttributePredicate p) = p+ -- | 'Any' can be used as a wildcard when constructing selectors to match tags -- and attributes with any name. -- -- For example, the selector @Any \@: [Any \@= \"foo\"]@ matches all tags that -- have any attribute where the value is @\"foo\"@.-data Any str = Any+data Any = Any  -- | '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 str = MkSelector [SelectNode str]+newtype Selector = MkSelector [SelectNode] -data SelectNode str = SelectNode str [AttributePredicate str]-                    | SelectAny [AttributePredicate str]+data SelectNode = SelectNode String [AttributePredicate]+                | SelectAny [AttributePredicate] -instance Selectable str (Selector str) where+instance Selectable Selector where     toSelector = id -instance Selectable String String where-    toSelector node = MkSelector [SelectNode node []]--instance Selectable BS.ByteString BS.ByteString where-    toSelector node = MkSelector [SelectNode node []]--instance Selectable LBS.ByteString LBS.ByteString where-    toSelector node = MkSelector [SelectNode node []]--instance Selectable T.Text T.Text where-    toSelector node = MkSelector [SelectNode node []]--instance Selectable LT.Text LT.Text where+instance Selectable String where     toSelector node = MkSelector [SelectNode node []] -instance Selectable str (Any str) where+instance Selectable Any where     toSelector = const (MkSelector [SelectAny []]) -instance AttributeName str (Any str) where+instance AttributeName Any where     matchKey = const . const True -instance AttributeName String String where-    matchKey = (==)--instance AttributeName BS.ByteString BS.ByteString where-    matchKey = (==)--instance AttributeName LBS.ByteString LBS.ByteString where-    matchKey = (==)--instance AttributeName T.Text T.Text where-    matchKey = (==)--instance AttributeName LT.Text LT.Text where-    matchKey = (==)+instance AttributeName String where+    matchKey = (==) . TagSoup.fromString -instance TagName str (Any str) where+instance TagName Any where     toSelectNode = const SelectAny -instance TagName String String where-    toSelectNode = SelectNode--instance TagName BS.ByteString BS.ByteString where-    toSelectNode = SelectNode--instance TagName LBS.ByteString LBS.ByteString where-    toSelectNode = SelectNode--instance TagName T.Text T.Text where-    toSelectNode = SelectNode--instance TagName LT.Text LT.Text where-    toSelectNode = SelectNode+instance TagName String where+    toSelectNode = SelectNode . TagSoup.fromString

@@ -104,7 +104,7 @@             ["<b bar=value>bar</b>"]     ] -selectTest :: Selectable String s => s -> String -> [String] -> Test+selectTest :: Selectable s => s -> String -> [String] -> Test selectTest selector tags expectedText = label ~: expected @=? actual     where         label  = "select (" ++ show tags ++ ")"@@ -133,12 +133,12 @@     ,   scrapeTest             "<a>foo</a><a>bar</a>"             (Just [True, False])-            (map (== "foo") <$> (texts $ "a"))+            (map (== "foo") <$> texts "a")      ,   scrapeTest             "<a key=foo />"             (Just "foo")-            (attr "key" $ "a")+            (attr "key" "a")      ,   scrapeTest             "<a key1=foo/><b key1=bar key2=foo /><a key1=bar key2=baz />"@@ -158,16 +158,16 @@     ,   scrapeTest             "<a><b>foo</b></a><a><c>bar</c></a>"             (Just "foo")-            ((text $ "a" // "b") <|> (text $ "a" // "c"))+            (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"))+            (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 "<img src='foobar' />" (Just "foobar") (attr "src" $ "img")+    ,   scrapeTest "<img src='foobar' />" (Just "foobar") (attr "src" "img")     ]  scrapeTest :: (Eq a, Show a) => String -> Maybe a -> Scraper String a -> Test