diff --git a/scalpel.cabal b/scalpel.cabal --- a/scalpel.cabal +++ b/scalpel.cabal @@ -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 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 @@ -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 @@ -- >
-- > Bill -- > --- >
\ +-- > -- >
-- > Susan -- >
WTF!?!
diff --git a/src/Text/HTML/Scalpel/Internal/Scrape.hs b/src/Text/HTML/Scalpel/Internal/Scrape.hs --- a/src/Text/HTML/Scalpel/Internal/Scrape.hs +++ b/src/Text/HTML/Scalpel/Internal/Scrape.hs @@ -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 diff --git a/src/Text/HTML/Scalpel/Internal/Select.hs b/src/Text/HTML/Scalpel/Internal/Select.hs --- a/src/Text/HTML/Scalpel/Internal/Select.hs +++ b/src/Text/HTML/Scalpel/Internal/Select.hs @@ -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 diff --git a/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs b/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs --- a/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs +++ b/src/Text/HTML/Scalpel/Internal/Select/Combinators.hs @@ -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 diff --git a/src/Text/HTML/Scalpel/Internal/Select/Types.hs b/src/Text/HTML/Scalpel/Internal/Select/Types.hs --- a/src/Text/HTML/Scalpel/Internal/Select/Types.hs +++ b/src/Text/HTML/Scalpel/Internal/Select/Types.hs @@ -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 diff --git a/tests/TestMain.hs b/tests/TestMain.hs --- a/tests/TestMain.hs +++ b/tests/TestMain.hs @@ -104,7 +104,7 @@ ["bar"] ] -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 "foobar" (Just [True, False]) - (map (== "foo") <$> (texts $ "a")) + (map (== "foo") <$> texts "a") , scrapeTest "" (Just "foo") - (attr "key" $ "a") + (attr "key" "a") , scrapeTest "" @@ -158,16 +158,16 @@ , scrapeTest "foobar" (Just "foo") - ((text $ "a" // "b") <|> (text $ "a" // "c")) + (text ("a" // "b") <|> text ("a" // "c")) , scrapeTest "foobar" (Just "bar") - ((text $ "a" // "d") <|> (text $ "a" // "c")) + (text ("a" // "d") <|> text ("a" // "c")) - , scrapeTest "" (Just "foobar") (attr "src" $ "img") + , scrapeTest "" (Just "foobar") (attr "src" "img") - , scrapeTest "" (Just "foobar") (attr "src" $ "img") + , scrapeTest "" (Just "foobar") (attr "src" "img") ] scrapeTest :: (Eq a, Show a) => String -> Maybe a -> Scraper String a -> Test