Hello community, here is the log from the commit of package ghc-rss-conduit for openSUSE:Factory checked in at 2017-08-31 20:58:58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-rss-conduit (Old) and /work/SRC/openSUSE:Factory/.ghc-rss-conduit.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-rss-conduit" Thu Aug 31 20:58:58 2017 rev:2 rq:513479 version:0.3.1.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-rss-conduit/ghc-rss-conduit.changes 2017-05-17 10:51:08.309969812 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-rss-conduit.new/ghc-rss-conduit.changes 2017-08-31 20:58:59.818058901 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:07 UTC 2017 - [email protected] + +- Update to version 0.3.1.1. + +------------------------------------------------------------------- Old: ---- rss-conduit-0.3.0.0.tar.gz rss-conduit.cabal New: ---- rss-conduit-0.3.1.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-rss-conduit.spec ++++++ --- /var/tmp/diff_new_pack.VhGBgd/_old 2017-08-31 20:59:00.789922351 +0200 +++ /var/tmp/diff_new_pack.VhGBgd/_new 2017-08-31 20:59:00.813918979 +0200 @@ -19,14 +19,13 @@ %global pkg_name rss-conduit %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.3.0.0 +Version: 0.3.1.1 Release: 0 -Summary: Streaming parser/renderer for the RSS 2.0 standard +Summary: Streaming parser/renderer for the RSS standard License: WTFPL Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-conduit-combinators-devel BuildRequires: ghc-conduit-devel @@ -46,7 +45,6 @@ %if %{with tests} BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-bytestring-devel -BuildRequires: ghc-conduit-extra-devel BuildRequires: ghc-data-default-devel BuildRequires: ghc-hlint-devel BuildRequires: ghc-quickcheck-instances-devel @@ -57,7 +55,7 @@ %endif %description -Streaming parser/renderer for the RSS 2.0 standard. +Streaming parser/renderer for the RSS standard. %package devel Summary: Haskell %{pkg_name} library development files @@ -72,7 +70,6 @@ %prep %setup -q -n %{pkg_name}-%{version} -cp -p %{SOURCE1} %{pkg_name}.cabal %build %ghc_lib_build ++++++ rss-conduit-0.3.0.0.tar.gz -> rss-conduit-0.3.1.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/README.md new/rss-conduit-0.3.1.1/README.md --- old/rss-conduit-0.3.0.0/README.md 2016-08-19 08:24:17.000000000 +0200 +++ new/rss-conduit-0.3.1.1/README.md 2017-06-15 08:32:11.000000000 +0200 @@ -1,10 +1,11 @@ # rss-conduit -This [Haskell][hsk] library implements a streaming parser/renderer for the [RSS 2.0 syndication format][rss], based on [conduit][cdt]s. +This [Haskell][hsk] library implements a streaming parser/renderer for the [RSS 2.0 syndication format][rss], and a streaming parser for the [RSS 1.0 syndication format][rss1], based on [conduit][cdt]s. Parsers are lenient as much as possible. E.g. unexpected tags are simply ignored. [rss]: http://cyber.law.harvard.edu/rss/rss.html +[rss1]: http://web.resource.org/rss/1.0/spec [cdt]: https://hackage.haskell.org/package/conduit [hsk]: https://haskell.org diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/Text/RSS/Conduit/Parse.hs new/rss-conduit-0.3.1.1/Text/RSS/Conduit/Parse.hs --- old/rss-conduit-0.3.0.0/Text/RSS/Conduit/Parse.hs 2016-09-25 18:34:04.000000000 +0200 +++ new/rss-conduit-0.3.1.1/Text/RSS/Conduit/Parse.hs 2017-06-15 08:32:11.000000000 +0200 @@ -84,10 +84,10 @@ -- | Like 'tagName' but ignores the namespace. tagName' :: (MonadThrow m) => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b) -tagName' t = tagPredicate (\n -> nameLocalName n == t) +tagName' t = tag' (matching $ \n -> nameLocalName n == t) -- | Tag which content is a date-time that follows RFC 3339 format. -tagDate :: (MonadThrow m) => Name -> ConduitM Event o m (Maybe UTCTime) +tagDate :: (MonadThrow m) => NameMatcher a -> ConduitM Event o m (Maybe UTCTime) tagDate name = tagIgnoreAttrs name $ fmap zonedTimeToUTC $ do text <- content maybe (throw $ InvalidTime text) return $ parseTimeRFC822 text @@ -123,7 +123,7 @@ -- | Parse a @\<textInput\>@ element. rssTextInput :: (MonadThrow m) => ConduitM Event o m (Maybe RssTextInput) -rssTextInput = tagIgnoreAttrs "textInput" $ (manyYield' (choose piece) =$= parser) <* many ignoreAllTreesContent where +rssTextInput = tagIgnoreAttrs "textInput" $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where parser = getZipConduit $ RssTextInput <$> ZipConduit (projectC _TextInputTitle =$= headRequiredC "Missing <title> element") <*> ZipConduit (projectC _TextInputDescription =$= headRequiredC "Missing <description> element") @@ -144,7 +144,7 @@ -- | Parse an @\<image\>@ element. rssImage :: (MonadThrow m) => ConduitM Event o m (Maybe RssImage) -rssImage = tagIgnoreAttrs "image" $ (manyYield' (choose piece) =$= parser) <* many ignoreAllTreesContent where +rssImage = tagIgnoreAttrs "image" $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where parser = getZipConduit $ RssImage <$> ZipConduit (projectC _ImageUri =$= headRequiredC "Missing <url> element") <*> ZipConduit (projectC _ImageTitle =$= headDefC "Unnamed image") -- Lenient @@ -205,7 +205,7 @@ -- | Parse an @\<item\>@ element. rssItem :: MonadThrow m => ConduitM Event o m (Maybe RssItem) -rssItem = tagIgnoreAttrs "item" $ (manyYield' (choose piece) =$= parser) <* many ignoreAllTreesContent where +rssItem = tagIgnoreAttrs "item" $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where parser = getZipConduit $ RssItem <$> ZipConduit (projectC _ItemTitle =$= headDefC "") <*> ZipConduit (projectC _ItemLink =$= headC) @@ -243,7 +243,7 @@ -- | Parse an @\<rss\>@ element. rssDocument :: MonadThrow m => ConduitM Event o m (Maybe RssDocument) -rssDocument = tagName' "rss" attributes $ \version -> force "Missing <channel>" $ tagIgnoreAttrs "channel" (manyYield' (choose piece) =$= parser version) <* many ignoreAllTreesContent where +rssDocument = tagName' "rss" attributes $ \version -> force "Missing <channel>" $ tagIgnoreAttrs "channel" (manyYield' (choose piece) =$= parser version) <* many ignoreAnyTreeContent where parser version = getZipConduit $ RssDocument version <$> ZipConduit (projectC _ChannelTitle =$= headRequiredC "Missing <title> element") <*> ZipConduit (projectC _ChannelLink =$= headRequiredC "Missing <link> element") diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/Text/RSS/Lens.hs new/rss-conduit-0.3.1.1/Text/RSS/Lens.hs --- old/rss-conduit-0.3.0.0/Text/RSS/Lens.hs 2016-08-19 08:24:17.000000000 +0200 +++ new/rss-conduit-0.3.1.1/Text/RSS/Lens.hs 2017-06-15 08:32:11.000000000 +0200 @@ -1,5 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} -module Text.RSS.Lens where +module Text.RSS.Lens (module Text.RSS.Lens) where -- {{{ Imports import Lens.Simple @@ -16,33 +16,33 @@ $(makeLensesBy (let f "itemCategories" = Nothing - f "itemEnclosure" = Nothing - f n = Just (n ++ "L") + f "itemEnclosure" = Nothing + f n = Just (n ++ "L") in f) ''RssItem) itemCategoriesL :: Traversal' RssItem RssCategory -itemCategoriesL inj a@RssItem { itemCategories = c } = (\x -> a { itemCategories = c }) <$> sequenceA (map inj c) +itemCategoriesL inj a@RssItem { itemCategories = c } = (\x -> a { itemCategories = c }) <$> traverse inj c {-# INLINE itemCategoriesL #-} itemEnclosureL :: Traversal' RssItem RssEnclosure -itemEnclosureL inj a@RssItem { itemEnclosure = e } = (\x -> a { itemEnclosure = e }) <$> sequenceA (map inj e) +itemEnclosureL inj a@RssItem { itemEnclosure = e } = (\x -> a { itemEnclosure = e }) <$> traverse inj e {-# INLINE itemEnclosureL #-} $(makeLensesBy (\n -> Just (n ++ "L")) ''RssTextInput) $(makeLensesBy (\n -> Just (n ++ "L")) ''RssCloud) $(makeLensesBy (\n -> Just (n ++ "L")) ''RssImage) $(makeLensesBy - (let f "channelItems" = Nothing + (let f "channelItems" = Nothing f "channelCategories" = Nothing - f n = Just (n ++ "L") + f n = Just (n ++ "L") in f) ''RssDocument) channelItemsL :: Traversal' RssDocument RssItem -channelItemsL inj a@RssDocument { channelItems = i } = (\x -> a { channelItems = i }) <$> sequenceA (map inj i) +channelItemsL inj a@RssDocument { channelItems = i } = (\x -> a { channelItems = i }) <$> traverse inj i {-# INLINE channelItemsL #-} channelCategoriesL :: Traversal' RssDocument RssCategory -channelCategoriesL inj a@RssDocument { channelCategories = c } = (\x -> a { channelCategories = c }) <$> sequenceA (map inj c) +channelCategoriesL inj a@RssDocument { channelCategories = c } = (\x -> a { channelCategories = c }) <$> traverse inj c {-# INLINE channelCategoriesL #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/Text/RSS1/Conduit/Parse.hs new/rss-conduit-0.3.1.1/Text/RSS1/Conduit/Parse.hs --- old/rss-conduit-0.3.0.0/Text/RSS1/Conduit/Parse.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/rss-conduit-0.3.1.1/Text/RSS1/Conduit/Parse.hs 2017-06-15 08:32:11.000000000 +0200 @@ -0,0 +1,254 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +-- | Streaming parsers for the RSS 1.0 standard. +module Text.RSS1.Conduit.Parse + ( -- * Top-level + rss1Document + -- * Elements + , rss1ChannelItems + , rss1Image + , rss1Item + , rss1TextInput + ) where + +-- {{{ Imports +import Text.RSS.Types + +import Conduit hiding (throwM) + +import Control.Exception.Safe as Exception +import Control.Monad +import Control.Monad.Fix + +import Data.Conduit +import Data.Text as Text +import Data.Text.Encoding +import Data.Time.Clock +import Data.Time.LocalTime +import Data.Time.RFC3339 +import Data.Version +import Data.XML.Types + +import Lens.Simple + +import Text.XML.Stream.Parse + +import URI.ByteString +-- }}} + +-- {{{ Util +asDate :: (MonadThrow m) => Text -> m UTCTime +asDate text = maybe (throw $ InvalidTime text) (return . zonedTimeToUTC) $ parseTimeRFC3339 text + +asRssURI :: (MonadThrow m) => Text -> m RssURI +asRssURI t = case (parseURI' t, parseRelativeRef' t) of + (Right u, _) -> return $ RssURI u + (_, Right u) -> return $ RssURI u + (_, Left e) -> throwM $ InvalidURI e + where parseURI' = parseURI laxURIParserOptions . encodeUtf8 + parseRelativeRef' = parseRelativeRef laxURIParserOptions . encodeUtf8 + +nullURI :: RssURI +nullURI = RssURI $ RelativeRef Nothing "" (Query []) Nothing + +headRequiredC :: MonadThrow m => Text -> Consumer a m a +headRequiredC e = maybe (throw $ MissingElement e) return =<< headC + +projectC :: Monad m => Fold a a' b b' -> Conduit a m b +projectC prism = fix $ \recurse -> do + item <- await + case (item, item ^? (_Just . prism)) of + (_, Just a) -> yield a >> recurse + (Just _, _) -> recurse + _ -> return () + + +contentTag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b) +contentTag string = tag' (matching (== contentName string)) + +dcTag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b) +dcTag string = tag' (matching (== dcName string)) + +rdfTag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b) +rdfTag string = tag' (matching (== rdfName string)) + +rss1Tag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b) +rss1Tag string = tag' (matching (== rss1Name string)) + +contentName :: Text -> Name +contentName string = Name string (Just "http://purl.org/rss/1.0/modules/content/";) (Just "content") + +dcName :: Text -> Name +dcName string = Name string (Just "http://purl.org/dc/elements/1.1/";) (Just "dc") + +rdfName :: Text -> Name +rdfName string = Name string (Just "http://www.w3.org/1999/02/22-rdf-syntax-ns#";) (Just "rdf") + +rss1Name :: Text -> Name +rss1Name string = Name string (Just "http://purl.org/rss/1.0/";) Nothing +-- }}} + + +data TextInputPiece = TextInputTitle Text | TextInputDescription Text + | TextInputName Text | TextInputLink RssURI + +makeTraversals ''TextInputPiece + +-- | Parse a @\<textinput\>@ element. +rss1TextInput :: (MonadThrow m) => ConduitM Event o m (Maybe RssTextInput) +rss1TextInput = rss1Tag "textinput" attributes $ \uri -> (manyYield' (choose piece) =$= parser uri) <* many ignoreAnyTreeContent where + parser uri = getZipConduit $ RssTextInput + <$> ZipConduit (projectC _TextInputTitle =$= headRequiredC "Missing <title> element") + <*> ZipConduit (projectC _TextInputDescription =$= headRequiredC "Missing <description> element") + <*> ZipConduit (projectC _TextInputName =$= headRequiredC "Missing <name> element") + <*> ZipConduit (projectC _TextInputLink =$= headDefC uri) -- Lenient + piece = [ fmap TextInputTitle <$> rss1Tag "title" ignoreAttrs (const content) + , fmap TextInputDescription <$> rss1Tag "description" ignoreAttrs (const content) + , fmap TextInputName <$> rss1Tag "name" ignoreAttrs (const content) + , fmap TextInputLink <$> rss1Tag "link" ignoreAttrs (const $ content >>= asRssURI) + ] + attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs + + +data ItemPiece = ItemTitle Text | ItemLink RssURI | ItemDescription Text | ItemCreator Text | ItemDate UTCTime | ItemContent Text + +makeTraversals ''ItemPiece + +-- | Parse an @\<item\>@ element. +rss1Item :: MonadThrow m => ConduitM Event o m (Maybe RssItem) +rss1Item = rss1Tag "item" attributes $ \uri -> (manyYield' (choose piece) =$= parser uri) <* many ignoreAnyTreeContent where + parser uri = getZipConduit $ RssItem + <$> ZipConduit (projectC _ItemTitle =$= headDefC mempty) + <*> (Just <$> ZipConduit (projectC _ItemLink =$= headDefC uri)) + <*> ZipConduit (projectC _ItemDescription =$= headDefC mempty) + <*> ZipConduit (projectC _ItemCreator =$= headDefC mempty) + <*> pure mempty + <*> pure mzero + <*> pure mempty + <*> pure mzero + <*> ZipConduit (projectC _ItemDate =$= headC) + <*> pure mzero + piece = [ fmap ItemTitle <$> rss1Tag "title" ignoreAttrs (const content) + , fmap ItemLink <$> rss1Tag "link" ignoreAttrs (const $ content >>= asRssURI) + , fmap ItemDescription <$> (rss1Tag "description" ignoreAttrs (const content) `orE` contentTag "encoded" ignoreAttrs (const content)) + , fmap ItemCreator <$> dcTag "creator" ignoreAttrs (const content) + , fmap ItemDate <$> dcTag "date" ignoreAttrs (const $ content >>= asDate) + ] + attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs + + +data ImagePiece = ImageUri RssURI | ImageTitle Text | ImageLink RssURI + +makeTraversals ''ImagePiece + +-- | Parse an @\<image\>@ element. +rss1Image :: (MonadThrow m) => ConduitM Event o m (Maybe RssImage) +rss1Image = rss1Tag "image" attributes $ \uri -> (manyYield' (choose piece) =$= parser uri) <* many ignoreAnyTreeContent where + parser uri = getZipConduit $ RssImage + <$> ZipConduit (projectC _ImageUri =$= headDefC uri) -- Lenient + <*> ZipConduit (projectC _ImageTitle =$= headDefC "Unnamed image") -- Lenient + <*> ZipConduit (projectC _ImageLink =$= headDefC nullURI) -- Lenient + <*> pure mzero + <*> pure mzero + <*> pure mempty + piece = [ fmap ImageUri <$> rss1Tag "url" ignoreAttrs (const $ content >>= asRssURI) + , fmap ImageTitle <$> rss1Tag "title" ignoreAttrs (const content) + , fmap ImageLink <$> rss1Tag "link" ignoreAttrs (const $ content >>= asRssURI) + ] + attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs + + +-- | Parse an @\<items\>@ element. +rss1ChannelItems :: MonadThrow m => ConduitM Event o m (Maybe [Text]) +rss1ChannelItems = fmap join $ rss1Tag "items" ignoreAttrs $ const $ rdfTag "Seq" ignoreAttrs $ const $ many $ rdfTag "li" attributes return where + attributes = requireAttr (rdfName "resource") <* ignoreAttrs + + +data Rss1Channel = Rss1Channel + { channelId' :: RssURI + , channelTitle' :: Text + , channelLink' :: RssURI + , channelDescription' :: Text + , channelItems' :: [Text] + , channelImage' :: Maybe RssImage + , channelTextInput' :: Maybe RssURI + } + +data ChannelPiece = ChannelTitle Text + | ChannelLink RssURI + | ChannelDescription Text + | ChannelImage RssImage + | ChannelItems [Text] + | ChannelTextInput RssURI + +makeTraversals ''ChannelPiece + + +-- | Parse a @\<channel\>@ element. +rss1Channel :: MonadThrow m => ConduitM Event o m (Maybe Rss1Channel) +rss1Channel = rss1Tag "channel" attributes $ \channelId -> (manyYield' (choose piece) =$= parser channelId) <* many ignoreAnyTreeContent where + parser channelId = getZipConduit $ Rss1Channel channelId + <$> ZipConduit (projectC _ChannelTitle =$= headRequiredC "Missing <title> element") + <*> ZipConduit (projectC _ChannelLink =$= headRequiredC "Missing <link> element") + <*> ZipConduit (projectC _ChannelDescription =$= headDefC "") -- Lenient + <*> ZipConduit (projectC _ChannelItems =$= concatC =$= sinkList) + <*> ZipConduit (projectC _ChannelImage =$= headC) + <*> ZipConduit (projectC _ChannelTextInput =$= headC) + piece = [ fmap ChannelTitle <$> rss1Tag "title" ignoreAttrs (const content) + , fmap ChannelLink <$> rss1Tag "link" ignoreAttrs (const $ content >>= asRssURI) + , fmap ChannelDescription <$> rss1Tag "description" ignoreAttrs (const content) + , fmap ChannelItems <$> rss1ChannelItems + , fmap ChannelImage <$> rss1Image + , fmap ChannelTextInput <$> rss1Tag "textinput" (requireAttr (rdfName "resource") >>= asRssURI) return + ] + attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs + + +data Rss1Document = Rss1Document Rss1Channel (Maybe RssImage) [RssItem] (Maybe RssTextInput) + +rss1ToRss2 :: Rss1Document -> RssDocument +rss1ToRss2 (Rss1Document channel image items textInput) = RssDocument + (Version [1] []) + (channelTitle' channel) + (channelLink' channel) + (channelDescription' channel) + items + mempty + mempty + mempty + mempty + mzero + mzero + mzero + mempty + mzero + mzero + mzero + image + mempty + textInput + mempty + mempty + +data DocumentPiece = DocumentChannel Rss1Channel + | DocumentImage RssImage + | DocumentItem RssItem + | DocumentTextInput RssTextInput + +makeTraversals ''DocumentPiece + + +-- | Parse an @\<RDF\>@ element. +rss1Document :: MonadThrow m => ConduitM Event o m (Maybe RssDocument) +rss1Document = fmap (fmap rss1ToRss2) $ rdfTag "RDF" ignoreAttrs $ const $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where + parser = getZipConduit $ Rss1Document + <$> ZipConduit (projectC _DocumentChannel =$= headRequiredC "Missing <channel> element") + <*> ZipConduit (projectC _DocumentImage =$= headC) + <*> ZipConduit (projectC _DocumentItem =$= sinkList) + <*> ZipConduit (projectC _DocumentTextInput =$= headC) + piece = [ fmap DocumentChannel <$> rss1Channel + , fmap DocumentImage <$> rss1Image + , fmap DocumentItem <$> rss1Item + , fmap DocumentTextInput <$> rss1TextInput + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/rss-conduit.cabal new/rss-conduit-0.3.1.1/rss-conduit.cabal --- old/rss-conduit-0.3.0.0/rss-conduit.cabal 2016-09-25 18:34:04.000000000 +0200 +++ new/rss-conduit-0.3.1.1/rss-conduit.cabal 2017-06-15 08:32:11.000000000 +0200 @@ -1,6 +1,6 @@ name: rss-conduit -version: 0.3.0.0 -synopsis: Streaming parser/renderer for the RSS 2.0 standard. +version: 0.3.1.1 +synopsis: Streaming parser/renderer for the RSS standard. description: Cf README file. license: PublicDomain license-file: LICENSE @@ -17,6 +17,7 @@ library exposed-modules: + Text.RSS1.Conduit.Parse Text.RSS.Conduit.Parse Text.RSS.Conduit.Render Text.RSS.Lens @@ -35,7 +36,7 @@ , time >= 1.5 , timerep >= 2.0 , uri-bytestring >= 0.2 - , xml-conduit >= 1.3 + , xml-conduit >= 1.5 , xml-types default-language: Haskell2010 @@ -49,7 +50,7 @@ , base >= 4.8 && < 5 , bytestring , conduit - , conduit-extra + , conduit-combinators , data-default , safe-exceptions , hlint diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/test/Arbitrary.hs new/rss-conduit-0.3.1.1/test/Arbitrary.hs --- old/rss-conduit-0.3.0.0/test/Arbitrary.hs 2016-08-19 08:24:17.000000000 +0200 +++ new/rss-conduit-0.3.1.1/test/Arbitrary.hs 2017-06-15 08:32:11.000000000 +0200 @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -- | 'Arbitrary' instances used by RSS types. -module Arbitrary where +module Arbitrary (module Arbitrary) where -- {{{ Imports import Data.ByteString (ByteString) @@ -127,5 +127,5 @@ instance Arbitrary RssURI where arbitrary = oneof [RssURI <$> (arbitrary :: Gen (URIRef Absolute)), RssURI <$> (arbitrary :: Gen (URIRef Relative))] - shrink (RssURI a@URI{}) = RssURI <$> shrink a + shrink (RssURI a@URI{}) = RssURI <$> shrink a shrink (RssURI a@RelativeRef{}) = RssURI <$> shrink a diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/rss-conduit-0.3.0.0/test/Main.hs new/rss-conduit-0.3.1.1/test/Main.hs --- old/rss-conduit-0.3.0.0/test/Main.hs 2016-09-25 18:33:52.000000000 +0200 +++ new/rss-conduit-0.3.1.1/test/Main.hs 2017-06-15 08:32:11.000000000 +0200 @@ -4,12 +4,13 @@ -- {{{ Imports import Arbitrary +import Conduit + import Control.Exception.Safe as Exception import Control.Monad.Trans.Resource import Data.Char import Data.Conduit -import Data.Conduit.Binary import Data.Conduit.List import Data.Default import Data.Version @@ -26,6 +27,7 @@ import Text.RSS.Conduit.Render as Renderer import Text.RSS.Lens import Text.RSS.Types +import Text.RSS1.Conduit.Parse as Parser import Text.XML.Stream.Parse as XML hiding (choose) import Text.XML.Stream.Render @@ -45,15 +47,20 @@ unitTests = testGroup "Unit tests" [ skipHoursCase , skipDaysCase - , textInputCase - , imageCase + , rss1TextInputCase + , rss2TextInputCase + , rss1ImageCase + , rss2ImageCase , categoryCase , cloudCase , guidCase , enclosureCase , sourceCase - , itemCase - , documentCase + , rss1ItemCase + , rss2ItemCase + , rss1ChannelItemsCase + , rss1DocumentCase + , rss2DocumentCase ] properties :: TestTree @@ -93,8 +100,23 @@ , "</skipDays>" ] -textInputCase :: TestTree -textInputCase = testCase "<textInput> element" $ do +rss1TextInputCase :: TestTree +rss1TextInputCase = testCase "RSS1 <textinput> element" $ do + result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1TextInput + result^.textInputTitleL @?= "Search XML.com" + result^.textInputDescriptionL @?= "Search XML.com's XML collection" + result^.textInputNameL @?= "s" + result^.textInputLinkL @=? RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "search.xml.com") Nothing)) "" (Query []) Nothing) + where input = [ "<textinput xmlns=\"http://purl.org/rss/1.0/\"; xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"; rdf:about=\"http://search.xml.com\";>" + , "<title>Search XML.com</title>" + , "<description>Search XML.com's XML collection</description>" + , "<name>s</name>" + , "<link>http://search.xml.com</link>" + , "</textinput>" + ] + +rss2TextInputCase :: TestTree +rss2TextInputCase = testCase "RSS2 <textInput> element" $ do result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssTextInput result^.textInputTitleL @?= "Title" result^.textInputDescriptionL @?= "Description" @@ -108,8 +130,23 @@ , "</textInput>" ] -imageCase :: TestTree -imageCase = testCase "<image> element" $ do +rss1ImageCase :: TestTree +rss1ImageCase = testCase "RSS1 <image> element" $ do + result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1Image + result^.imageUriL @?= RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "xml.com") Nothing)) "/universal/images/xml_tiny.gif" (Query []) Nothing) + result^.imageTitleL @?= "XML.com" + result^.imageLinkL @?= RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.xml.com") Nothing)) "" (Query []) Nothing) + where input = [ "<image xmlns=\"http://purl.org/rss/1.0/\"; xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"; rdf:about=\"http://xml.com/universal/images/xml_tiny.gif\";>" + , "<url>http://xml.com/universal/images/xml_tiny.gif</url>" + , "<title>XML.com</title>" + , "<ignored>Ignored</ignored>" + , "<link>http://www.xml.com</link>" + , "<ignored>Ignored</ignored>" + , "</image>" + ] + +rss2ImageCase :: TestTree +rss2ImageCase = testCase "RSS2 <image> element" $ do result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssImage result^.imageUriL @?= RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "image.ext") Nothing)) "" (Query []) Nothing) result^.imageTitleL @?= "Title" @@ -174,8 +211,26 @@ ] uri = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.tomalak.org") Nothing)) "/links2.xml" (Query []) Nothing) -itemCase :: TestTree -itemCase = testCase "<item> element" $ do +rss1ItemCase :: TestTree +rss1ItemCase = testCase "RSS1 <item> element" $ do + result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1Item + result^.itemTitleL @?= "Processing Inclusions with XSLT" + result^.itemLinkL @?= Just link + result^.itemDescriptionL @?= "Processing document inclusions with general XML tools can be problematic. This article proposes a way of preserving inclusion information through SAX-based processing." + where input = [ "<item xmlns=\"http://purl.org/rss/1.0/\"; xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"; rdf:about=\"http://xml.com/pub/2000/08/09/xslt/xslt.html\";>" + , "<title>Processing Inclusions with XSLT</title>" + , "<description>Processing document inclusions with general XML tools can be" + , " problematic. This article proposes a way of preserving inclusion" + , " information through SAX-based processing." + , "</description>" + , "<link>http://xml.com/pub/2000/08/09/xslt/xslt.html</link>" + , "<sometag>Some content in unknown tag, should be ignored.</sometag>" + , "</item>" + ] + link = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "xml.com") Nothing)) "/pub/2000/08/09/xslt/xslt.html" (Query []) Nothing) + +rss2ItemCase :: TestTree +rss2ItemCase = testCase "RSS2 <item> element" $ do result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssItem result^.itemTitleL @?= "Example entry" result^.itemLinkL @?= Just link @@ -193,8 +248,81 @@ ] link = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.example.com") Nothing)) "/blog/post/1" (Query []) Nothing) -documentCase :: TestTree -documentCase = testCase "<rss> element" $ do + +rss1ChannelItemsCase :: TestTree +rss1ChannelItemsCase = testCase "RSS1 <items> element" $ do + result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1ChannelItems + result @?= [resource1, resource2] + where input = [ "<items xmlns=\"http://purl.org/rss/1.0/\"; xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\";>" + , "<rdf:Seq>" + , "<rdf:li rdf:resource=\"http://xml.com/pub/2000/08/09/xslt/xslt.html\"; />" + , "<rdf:li rdf:resource=\"http://xml.com/pub/2000/08/09/rdfdb/index.html\"; />" + , "</rdf:Seq>" + , "</items>" + ] + resource1 = "http://xml.com/pub/2000/08/09/xslt/xslt.html"; + resource2 = "http://xml.com/pub/2000/08/09/rdfdb/index.html"; + +rss1DocumentCase :: TestTree +rss1DocumentCase = testCase "<rdf> element" $ do + result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1Document + result^.documentVersionL @?= Version [1] [] + result^.channelTitleL @?= "XML.com" + result^.channelDescriptionL @?= "XML.com features a rich mix of information and services for the XML community." + result^.channelLinkL @?= link + result^?channelImageL._Just.imageTitleL @?= Just "XML.com" + result^?channelImageL._Just.imageLinkL @?= Just imageLink + result^?channelImageL._Just.imageUriL @?= Just imageUri + length (result^..channelItemsL) @?= 2 + result^?channelTextInputL._Just.textInputTitleL @?= Just "Search XML.com" + result^?channelTextInputL._Just.textInputDescriptionL @?= Just "Search XML.com's XML collection" + result^?channelTextInputL._Just.textInputNameL @?= Just "s" + result^?channelTextInputL._Just.textInputLinkL @?= Just textInputLink + where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>" + , "<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"; xmlns=\"http://purl.org/rss/1.0/\";>" + , "<channel rdf:about=\"http://www.xml.com/xml/news.rss\";>" + , "<title>XML.com</title>" + , "<link>http://xml.com/pub</link>" + , "<description>XML.com features a rich mix of information and services for the XML community.</description>" + , "<image rdf:resource=\"http://xml.com/universal/images/xml_tiny.gif\"; />" + , "<items>" + , "<rdf:Seq>" + , "<rdf:li rdf:resource=\"http://xml.com/pub/2000/08/09/xslt/xslt.html\"; />" + , "<rdf:li rdf:resource=\"http://xml.com/pub/2000/08/09/rdfdb/index.html\"; />" + , "</rdf:Seq>" + , "</items>" + , "</channel>" + , "<image rdf:about=\"http://xml.com/universal/images/xml_tiny.gif\";>" + , "<title>XML.com</title>" + , "<link>http://www.xml.com</link>" + , "<url>http://xml.com/universal/images/xml_tiny.gif</url>" + , "</image>" + , "<item rdf:about=\"http://xml.com/pub/2000/08/09/xslt/xslt.html\";>" + , "<title>Processing Inclusions with XSLT</title>" + , "<link>http://xml.com/pub/2000/08/09/xslt/xslt.html</link>" + , "<description>Processing document inclusions with general XML tools can be problematic. This article proposes a way of preserving inclusion information through SAX-based processing.</description>" + , "</item>" + , "<item rdf:about=\"http://xml.com/pub/2000/08/09/xslt/xslt.html\";>" + , "<title>Putting RDF to Work</title>" + , "<link>http://xml.com/pub/2000/08/09/rdfdb/index.html</link>" + , "<description>Tool and API support for the Resource Description Framework is slowly coming of age. Edd Dumbill takes a look at RDFDB, one of the most exciting new RDF toolkits.</description>" + , "</item>" + , "<textinput rdf:about=\"http://search.xml.com\";>" + , "<title>Search XML.com</title>" + , "<description>Search XML.com's XML collection</description>" + , "<name>s</name>" + , "<link>http://search.xml.com</link>" + , "</textinput>" + , "</rdf:RDF>" + ] + link = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "xml.com") Nothing)) "/pub" (Query []) Nothing) + imageLink = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.xml.com") Nothing)) "" (Query []) Nothing) + imageUri = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "xml.com") Nothing)) "/universal/images/xml_tiny.gif" (Query []) Nothing) + textInputLink = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "search.xml.com") Nothing)) "" (Query []) Nothing) + + +rss2DocumentCase :: TestTree +rss2DocumentCase = testCase "<rss> element" $ do result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssDocument result^.documentVersionL @?= Version [2] [] result^.channelTitleL @?= "RSS Title"
![http://xml.com/universal/images/xml_tiny.gif\"](http://xml.com/universal/images/xml_tiny.gif\"){kind=link}
