rss-conduit 0.4.1.0 → 0.4.2.0

raw patch · 10 files changed

+259/−66 lines, 10 filesdep +blaze-builderdep ~atom-conduitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: blaze-builder

Dependency ranges changed: atom-conduit

API changes (from Hackage documentation)

Files

• Text/RSS/Conduit/Render.hs +6/−7
• Text/RSS/Extensions.hs +24/−0
• Text/RSS/Extensions/Atom.hs +6/−1
• Text/RSS/Extensions/Content.hs +14/−2
• Text/RSS/Extensions/DublinCore.hs +31/−4
• Text/RSS/Extensions/Syndication.hs +54/−8
• Text/RSS/Types.hs +4/−1
• rss-conduit.cabal +4/−3
• test/Arbitrary.hs +58/−10
• test/Main.hs +58/−30

@@ -17,6 +17,7 @@   ) where  -- {{{ Imports+import           Text.RSS.Extensions import           Text.RSS.Lens import           Text.RSS.Types @@ -39,9 +40,7 @@ -- }}}  -- | Render the top-level @\<rss\>@ element.------ __Note__: RSS extensions are NOT rendered.-renderRssDocument :: Monad m => RssDocument a -> Source m Event+renderRssDocument :: Monad m => RenderRssExtensions e => RssDocument e -> Source m Event renderRssDocument d = tag "rss" (attr "version" . pack . showVersion $ d^.documentVersionL) $   tag "channel" mempty $ do     textTag "title" $ d^.channelTitleL@@ -64,11 +63,10 @@     renderRssSkipHours $ d^.channelSkipHoursL     renderRssSkipDays $ d^.channelSkipDaysL     forM_ (d^..channelItemsL) renderRssItem+    renderRssChannelExtensions $ d^.channelExtensionsL  -- | Render an @\<item\>@ element.------ __Note__: RSS extensions are NOT rendered.-renderRssItem :: Monad m => RssItem e -> Source m Event+renderRssItem :: Monad m => RenderRssExtensions e => RssItem e -> Source m Event renderRssItem i = tag "item" mempty $ do   optionalTextTag "title" $ i^.itemTitleL   forM_ (i^.itemLinkL) $ textTag "link" . renderRssURI@@ -80,6 +78,7 @@   forM_ (i^.itemGuidL) renderRssGuid   forM_ (i^.itemPubDateL) $ dateTag "pubDate"   forM_ (i^.itemSourceL) renderRssSource+  renderRssItemExtensions $ i^.itemExtensionsL  -- | Render a @\<source\>@ element. renderRssSource :: (Monad m) => RssSource -> Source m Event@@ -156,7 +155,7 @@   -- {{{ Utils-tshow :: (Show a) => a -> Text+tshow :: Show a => a -> Text tshow = pack . show  textTag :: (Monad m) => Name -> Text -> Source m Event

@@ -47,6 +47,16 @@ -- | Requirement on a list of extension tags to be able to parse and combine them. type ParseRssExtensions (e :: [*]) = (AllConstrained ParseRssExtension e, SingI e) +-- | Class of RSS extensions that can be rendered.+class RenderRssExtension e where+  -- | Render extension for the @\<channel\>@ element.+  renderRssChannelExtension :: Monad m => RssChannelExtension e -> Source m Event+  -- | Render extension for the @\<item\>@ element.+  renderRssItemExtension :: Monad m => RssItemExtension e -> Source m Event++-- | Requirement on a list of extension tags to be able to render them.+type RenderRssExtensions (e :: [*]) = (AllConstrained RenderRssExtension e)+ -- | Parse a combination of RSS extensions at @\<channel\>@ level. parseRssChannelExtensions :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (RssChannelExtensions e) parseRssChannelExtensions = f sing where@@ -66,3 +76,17 @@   f (SCons _ es) = fmap RssItemExtensions $ getZipConduit $ (:&)     <$> ZipConduit parseRssItemExtension     <*> ZipConduit (rssItemExtension <$> f es)++-- | Render a set of @\<channel\>@ extensions.+renderRssChannelExtensions :: Monad m => RenderRssExtensions e => RssChannelExtensions e -> Source m Event+renderRssChannelExtensions (RssChannelExtensions RNil) = pure ()+renderRssChannelExtensions (RssChannelExtensions (a :& t)) = do+  renderRssChannelExtension a+  renderRssChannelExtensions (RssChannelExtensions t)++-- | Render a set of @\<item\>@ extensions.+renderRssItemExtensions :: Monad m => RenderRssExtensions e => RssItemExtensions e -> Source m Event+renderRssItemExtensions (RssItemExtensions RNil) = pure ()+renderRssItemExtensions (RssItemExtensions (a :& t)) = do+  renderRssItemExtension a+  renderRssItemExtensions (RssItemExtensions t)

@@ -11,10 +11,11 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                 hiding (throwM)+import           Conduit                  hiding (throwM) import           Data.Singletons import           GHC.Generics import           Text.Atom.Conduit.Parse+import           Text.Atom.Conduit.Render import           Text.Atom.Types import           Text.XML.Stream.Parse -- }}}@@ -29,6 +30,10 @@ instance ParseRssExtension AtomModule where   parseRssChannelExtension = AtomChannel <$> (manyYield' atomLink =$= headC)   parseRssItemExtension    = AtomItem <$> (manyYield' atomLink =$= headC)++instance RenderRssExtension AtomModule where+  renderRssChannelExtension = mapM_ renderAtomLink . channelAtomLink+  renderRssItemExtension    = mapM_ renderAtomLink . itemAtomLink  data instance RssChannelExtension AtomModule = AtomChannel { channelAtomLink :: Maybe AtomLink }   deriving(Eq, Generic, Show)

@@ -13,8 +13,10 @@     ContentModule(..)   , RssChannelExtension(ContentChannel)   , RssItemExtension(ContentItem)-    -- * Parsers+    -- * Parser   , contentEncoded+    -- * Renderer+  , renderContentEncoded     -- * Misc   , namespacePrefix   , namespaceURI@@ -26,12 +28,15 @@  import           Conduit                hiding (throwM) import           Control.Exception.Safe as Exception+import           Control.Monad import           Data.Maybe import           Data.Singletons-import           Data.Text+import           Data.Text              (Text)+import qualified Data.Text              as Text import           Data.XML.Types import           GHC.Generics import           Text.XML.Stream.Parse+import qualified Text.XML.Stream.Render as Render import           URI.ByteString -- }}} @@ -46,6 +51,9 @@   parseRssChannelExtension = pure ContentChannel   parseRssItemExtension    = ContentItem <$> (manyYield' contentEncoded =$= headDefC mempty) +instance RenderRssExtension ContentModule where+  renderRssChannelExtension = const $ pure ()+  renderRssItemExtension (ContentItem e) = unless (Text.null e) $ renderContentEncoded e  data instance RssChannelExtension ContentModule = ContentChannel deriving(Eq, Generic, Ord, Show) data instance RssItemExtension ContentModule = ContentItem { itemContent :: Text }@@ -66,3 +74,7 @@ -- | Parse a @\<content:encoded\>@ element. contentEncoded :: MonadThrow m => ConduitM Event o m (Maybe Text) contentEncoded = tagIgnoreAttrs (matching (== contentName "encoded")) content++-- | Render a @\<content:encoded\>@ element.+renderContentEncoded :: Monad m => Text -> Source m Event+renderContentEncoded = Render.tag (contentName "encoded") mempty . Render.content

@@ -3,6 +3,7 @@ {-# LANGUAGE KindSignatures    #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TemplateHaskell   #-} {-# LANGUAGE TypeFamilies      #-} -- | __Dublin Core__ extension for RSS.@@ -21,19 +22,22 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                           hiding (throwM)-import           Control.Exception.Safe            as Exception+import           Conduit                            hiding (throwM)+import           Control.Exception.Safe             as Exception+import           Control.Monad import           Control.Monad.Fix import           Data.Maybe import           Data.Singletons-import           Data.Text+import           Data.Text                          (Text)+import qualified Data.Text                          as Text import           Data.Time.Clock import           Data.Time.LocalTime import           Data.Time.RFC3339 import           Data.XML.Types import           GHC.Generics import           Lens.Simple-import qualified Text.XML.DublinCore.Conduit.Parse as DC+import qualified Text.XML.DublinCore.Conduit.Parse  as DC+import           Text.XML.DublinCore.Conduit.Render import           Text.XML.Stream.Parse import           URI.ByteString -- }}}@@ -115,7 +119,26 @@           , fmap ElementType <$> DC.elementType           ] +-- | Render a set of Dublin Core metadata elements.+renderDcMetadata :: Monad m => DcMetaData -> Source m Event+renderDcMetadata DcMetaData{..} = do+  unless (Text.null elementContributor) $ renderElementContributor elementContributor+  unless (Text.null elementCoverage) $ renderElementCoverage elementCoverage+  unless (Text.null elementCreator) $ renderElementCreator elementCreator+  forM_ elementDate renderElementDate+  unless (Text.null elementDescription) $ renderElementDescription elementDescription+  unless (Text.null elementFormat) $ renderElementFormat elementFormat+  unless (Text.null elementIdentifier) $ renderElementIdentifier elementIdentifier+  unless (Text.null elementLanguage) $ renderElementLanguage elementLanguage+  unless (Text.null elementPublisher) $ renderElementPublisher elementPublisher+  unless (Text.null elementRelation) $ renderElementRelation elementRelation+  unless (Text.null elementRights) $ renderElementRights elementRights+  unless (Text.null elementSource) $ renderElementSource elementSource+  unless (Text.null elementSubject) $ renderElementSubject elementSubject+  unless (Text.null elementTitle) $ renderElementTitle elementTitle+  unless (Text.null elementType) $ renderElementType elementType + -- | __Dublin Core__ tag type. data DublinCoreModule :: * @@ -126,6 +149,10 @@ instance ParseRssExtension DublinCoreModule where   parseRssChannelExtension = DublinCoreChannel <$> dcMetadata   parseRssItemExtension    = DublinCoreItem <$> dcMetadata++instance RenderRssExtension DublinCoreModule where+  renderRssChannelExtension = renderDcMetadata . channelDcMetaData+  renderRssItemExtension    = renderDcMetadata . itemDcMetaData   data instance RssChannelExtension DublinCoreModule = DublinCoreChannel { channelDcMetaData :: DcMetaData }

@@ -3,6 +3,7 @@ {-# LANGUAGE KindSignatures    #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes        #-}+{-# LANGUAGE RecordWildCards   #-} {-# LANGUAGE TemplateHaskell   #-} {-# LANGUAGE TypeFamilies      #-} -- | __Syndication__ module for RSS.@@ -17,9 +18,15 @@   , SyndicationPeriod(..)   , asSyndicationPeriod     -- * Parsers+  , syndicationInfo   , syndicationPeriod   , syndicationFrequency   , syndicationBase+    -- * Renderers+  , renderSyndicationInfo+  , renderSyndicationPeriod+  , renderSyndicationFrequency+  , renderSyndicationBase     -- * Misc   , namespacePrefix   , namespaceURI@@ -29,9 +36,9 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                           hiding (throwM)+import           Conduit                hiding (throwM) import           Control.Applicative-import           Control.Exception.Safe            as Exception+import           Control.Exception.Safe as Exception import           Control.Monad import           Control.Monad.Fix import           Data.Maybe@@ -46,12 +53,15 @@ import           GHC.Generics import           Lens.Simple import           Text.Read-import qualified Text.XML.DublinCore.Conduit.Parse as DC import           Text.XML.Stream.Parse+import qualified Text.XML.Stream.Render as Render import           URI.ByteString -- }}}  -- {{{ Utils+tshow :: Show a => a -> Text+tshow = pack . show+ asDate :: MonadThrow m => Text -> m UTCTime asDate text = maybe (throw $ InvalidTime text) (return . zonedTimeToUTC) $   parseTimeRFC3339 text <|> parseTimeRFC2822 text <|> parseTimeRFC822 text@@ -87,9 +97,13 @@ syndicationTag :: MonadThrow m => Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a) syndicationTag name = tagIgnoreAttrs (matching (== syndicationName name)) +renderSyndicationTag :: Monad m => Text -> Text -> Source m Event+renderSyndicationTag name = Render.tag (syndicationName name) mempty . Render.content -data SyndicationPeriod = Hourly | Daily | Weekly | Monthly | Yearly deriving(Eq, Generic, Ord, Show) +data SyndicationPeriod = Hourly | Daily | Weekly | Monthly | Yearly+  deriving (Bounded, Enum, Eq, Generic, Ord, Read, Show)+ asSyndicationPeriod :: MonadThrow m => Text -> m SyndicationPeriod asSyndicationPeriod "hourly"  = pure Hourly asSyndicationPeriod "daily"   = pure Daily@@ -98,12 +112,20 @@ asSyndicationPeriod "yearly"  = pure Yearly asSyndicationPeriod t         = throw $ InvalidSyndicationPeriod t +fromSyndicationPeriod :: SyndicationPeriod -> Text+fromSyndicationPeriod Hourly  = "hourly"+fromSyndicationPeriod Daily   = "daily"+fromSyndicationPeriod Weekly  = "weekly"+fromSyndicationPeriod Monthly = "monthly"+fromSyndicationPeriod Yearly  = "yearly"++ -- | __Syndication__ extension model. data SyndicationInfo = SyndicationInfo   { updatePeriod    :: Maybe SyndicationPeriod   , updateFrequency :: Maybe Int   , updateBase      :: Maybe UTCTime-  } deriving(Eq, Generic, Ord, Show)+  } deriving (Eq, Generic, Ord, Read, Show)  -- | Construct an empty 'SyndicationInfo'. mkSyndicationInfo :: SyndicationInfo@@ -114,7 +136,7 @@  makeTraversals ''ElementPiece --- | Parse __Syndication__ elements.+-- | Parse all __Syndication__ elements. syndicationInfo :: MonadThrow m => ConduitM Event o m SyndicationInfo syndicationInfo = manyYield' (choose piece) =$= parser where   parser = getZipConduit $ SyndicationInfo@@ -138,6 +160,26 @@ syndicationBase :: MonadThrow m => ConduitM Event o m (Maybe UTCTime) syndicationBase = syndicationTag "updateBase" (content >>= asDate) +-- | Render all __Syndication__ elements.+renderSyndicationInfo :: Monad m => SyndicationInfo -> Source m Event+renderSyndicationInfo SyndicationInfo{..} = do+  forM_ updatePeriod renderSyndicationPeriod+  forM_ updateFrequency renderSyndicationFrequency+  forM_ updateBase renderSyndicationBase++-- | Render a @\<sy:updatePeriod\>@ element.+renderSyndicationPeriod :: Monad m => SyndicationPeriod -> Source m Event+renderSyndicationPeriod = renderSyndicationTag "updatePeriod" . fromSyndicationPeriod++-- | Render a @\<sy:updateFrequency\>@ element.+renderSyndicationFrequency :: Monad m => Int -> Source m Event+renderSyndicationFrequency = renderSyndicationTag "updateFrequency" . tshow++-- | Render a @\<sy:updateBase\>@ element.+renderSyndicationBase :: Monad m => UTCTime -> Source m Event+renderSyndicationBase = renderSyndicationTag "updateBase" . formatTimeRFC822 . utcToZonedTime utc++ -- | __Syndication__ tag type. data SyndicationModule :: * @@ -149,7 +191,11 @@   parseRssChannelExtension = SyndicationChannel <$> syndicationInfo   parseRssItemExtension    = pure SyndicationItem +instance RenderRssExtension SyndicationModule where+  renderRssChannelExtension = renderSyndicationInfo . channelSyndicationInfo+  renderRssItemExtension    = const $ pure () + data instance RssChannelExtension SyndicationModule = SyndicationChannel { channelSyndicationInfo :: SyndicationInfo}-  deriving(Eq, Generic, Ord, Show)-data instance RssItemExtension SyndicationModule = SyndicationItem deriving(Eq, Generic, Ord, Show)+  deriving (Eq, Generic, Ord, Read, Show)+data instance RssItemExtension SyndicationModule = SyndicationItem deriving (Eq, Generic, Ord, Read, Show)

@@ -67,6 +67,7 @@  deriving instance Eq RssException deriving instance Generic RssException+deriving instance Read RssException deriving instance Show RssException  instance Exception RssException where@@ -183,7 +184,7 @@ deriving instance Show RssTextInput  data CloudProtocol = ProtocolXmlRpc | ProtocolSoap | ProtocolHttpPost-  deriving(Eq, Generic, Ord, Show)+  deriving(Eq, Generic, Ord, Read, Show)  -- | The @\<cloud\>@ element. data RssCloud = RssCloud@@ -303,6 +304,7 @@ deriving instance (Eq (Rec RssChannelExtension a)) => Eq (RssChannelExtensions a) deriving instance (Generic (Rec RssChannelExtension a)) => Generic (RssChannelExtensions a) deriving instance (Ord (Rec RssChannelExtension a)) => Ord (RssChannelExtensions a)+deriving instance (Read (Rec RssChannelExtension a)) => Read (RssChannelExtensions a) deriving instance (Show (Rec RssChannelExtension a)) => Show (RssChannelExtensions a)  -- | Combination of multiple @\<item\>@ extensions.@@ -312,4 +314,5 @@ deriving instance (Eq (Rec RssItemExtension a)) => Eq (RssItemExtensions a) deriving instance (Generic (Rec RssItemExtension a)) => Generic (RssItemExtensions a) deriving instance (Ord (Rec RssItemExtension a)) => Ord (RssItemExtensions a)+deriving instance (Read (Rec RssItemExtension a)) => Read (RssItemExtensions a) deriving instance (Show (Rec RssItemExtension a)) => Show (RssItemExtensions a)

@@ -1,5 +1,5 @@ name: rss-conduit-version: 0.4.1.0+version: 0.4.2.0 cabal-version: >=1.10 build-type: Simple license: PublicDomain@@ -35,7 +35,7 @@         Text.RSS.Lens         Text.RSS.Types     build-depends:-        atom-conduit -any,+        atom-conduit >=0.5,         base >=4.8 && <5,         conduit -any,         conduit-combinators -any,@@ -59,8 +59,9 @@     main-is: Main.hs     build-depends:         rss-conduit -any,-        atom-conduit -any,+        atom-conduit >=0.5,         base >=4.8 && <5,+        blaze-builder -any,         bytestring -any,         conduit -any,         conduit-combinators -any,

@@ -5,25 +5,27 @@ module Arbitrary (module Arbitrary) where  -- {{{ Imports-import           Data.ByteString           (ByteString)+import           Text.RSS.Extensions.Atom+import           Text.RSS.Extensions.Content+import           Text.RSS.Extensions.DublinCore+import           Text.RSS.Extensions.Syndication+import           Text.RSS.Types++import           Data.ByteString                 (ByteString) import           Data.Char import           Data.Maybe-import           Data.MonoTraversable      (Element)+import           Data.MonoTraversable            (Element) import           Data.NonNull-import           Data.Sequences            (SemiSequence)-import           Data.Text                 (Text, find, pack)+import           Data.Sequences                  (SemiSequence)+import           Data.Text                       (Text, find, pack) import           Data.Text.Encoding import           Data.Time.Clock import           Data.Version import           Data.Vinyl.Core- import           GHC.Generics- import           Test.QuickCheck-import           Test.QuickCheck.Instances ()--import           Text.RSS.Types-+import           Test.QuickCheck.Instances       ()+import           Text.Atom.Types import           URI.ByteString -- }}} @@ -163,3 +165,49 @@   arbitrary = oneof [RssURI <$> (arbitrary :: Gen (URIRef Absolute)), RssURI <$> (arbitrary :: Gen (URIRef Relative))]   shrink (RssURI a@URI{})         = RssURI <$> shrink a   shrink (RssURI a@RelativeRef{}) = RssURI <$> shrink a++instance Arbitrary DcMetaData where+  arbitrary = DcMetaData+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> oneof [Just <$> genTime, pure Nothing]+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++instance Arbitrary (RssChannelExtension DublinCoreModule) where+  arbitrary = DublinCoreChannel <$> arbitrary++instance Arbitrary SyndicationPeriod where+  arbitrary = arbitraryBoundedEnum+  shrink = genericShrink++instance Arbitrary SyndicationInfo where+  arbitrary = SyndicationInfo+    <$> arbitrary+    <*> arbitrary+    <*> oneof [Just <$> genTime, pure Nothing]++instance Arbitrary (RssChannelExtension SyndicationModule) where+  arbitrary = SyndicationChannel <$> arbitrary++instance Arbitrary AtomURI where+  arbitrary = oneof [AtomURI <$> (arbitrary :: Gen (URIRef Absolute)), AtomURI <$> (arbitrary :: Gen (URIRef Relative))]++instance Arbitrary AtomLink where+  arbitrary = AtomLink <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary (RssChannelExtension AtomModule) where+  arbitrary = AtomChannel <$> arbitrary++instance Arbitrary (RssItemExtension ContentModule) where+  arbitrary = ContentItem <$> arbitrary

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE OverloadedLists     #-} {-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE QuasiQuotes         #-} {-# LANGUAGE ScopedTypeVariables #-} -- {{{ Imports import           Text.RSS.Conduit.Parse          as Parser@@ -16,6 +17,7 @@ import           Text.RSS1.Conduit.Parse         as Parser  import           Arbitrary+import           Blaze.ByteString.Builder        (toByteString) import           Conduit import           Control.Exception.Safe          as Exception import           Control.Monad@@ -26,10 +28,12 @@ import           Data.Default import           Data.Singletons.Prelude.List import           Data.Text                       (Text)+import           Data.Text.Encoding import           Data.Time.Calendar import           Data.Time.LocalTime import           Data.Version import           Data.Vinyl.Core+import           Data.Void import           Data.XML.Types import qualified Language.Haskell.HLint          as HLint (hlint) import           Lens.Simple@@ -43,6 +47,7 @@ import           Text.XML.Stream.Parse           as XML hiding (choose) import           Text.XML.Stream.Render import           URI.ByteString+import           URI.ByteString.QQ -- }}}  main :: IO ()@@ -80,16 +85,39 @@  properties :: TestTree properties = testGroup "Properties"-  [ roundtripTextInputProperty-  , roundtripImageProperty-  , roundtripCategoryProperty-  , roundtripEnclosureProperty-  , roundtripSourceProperty-  , roundtripGuidProperty-  , roundtripItemProperty+  [ roundtripProperty "RssTextInput" renderRssTextInput rssTextInput+  , roundtripProperty "RssImage" renderRssImage rssImage+  , roundtripProperty "RssCategory" renderRssCategory rssCategory+  , roundtripProperty "RssEnclosure" renderRssEnclosure rssEnclosure+  , roundtripProperty "RssSource" renderRssSource rssSource+  , roundtripProperty "RssGuid" renderRssGuid rssGuid+  , roundtripProperty "RssItem"+      (renderRssItem :: RssItem '[] -> Source Maybe Event)+      rssItem+  , roundtripProperty "DublinCore"+      (renderRssChannelExtension :: RssChannelExtension DublinCoreModule -> Source Maybe Event)+      (Just <$> parseRssChannelExtension)+  , roundtripProperty "Syndication"+      (renderRssChannelExtension :: RssChannelExtension SyndicationModule -> Source Maybe Event)+      (Just <$> parseRssChannelExtension)+  , roundtripProperty "Atom"+      (renderRssChannelExtension :: RssChannelExtension AtomModule -> Source Maybe Event)+      (Just <$> parseRssChannelExtension)+  , roundtripProperty "Content"+      (renderRssItemExtension :: RssItemExtension ContentModule -> Source Maybe Event)+      (Just <$> parseRssItemExtension)   ]  +roundtripProperty :: Eq a => Arbitrary a => Show a+                  => TestName -> (a -> Source Maybe Event) -> ConduitM Event Void Maybe (Maybe a) -> TestTree+roundtripProperty name render parse = testProperty ("parse . render = id (" <> name <> ")") $ do+  input <- arbitrary+  let intermediate = fmap (decodeUtf8 . toByteString) $ runConduit $ render input =$= renderBuilder def =$= foldC+      output = join $ runConduit $ render input =$= parse+  return $ counterexample (show input <> " | " <> show intermediate <> " | " <> show output) $ Just input == output++ skipHoursCase :: TestTree skipHoursCase = testCase "<skipHours> element" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssSkipHours@@ -121,7 +149,7 @@   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)+  result^.textInputLinkL @=? RssURI [uri|http://search.xml.com|]   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>"@@ -136,7 +164,7 @@   result^.textInputTitleL @?= "Title"   result^.textInputDescriptionL @?= "Description"   result^.textInputNameL @?= "Name"-  result^.textInputLinkL @=? RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "link.ext") Nothing)) "" (Query []) Nothing)+  result^.textInputLinkL @=? RssURI [uri|http://link.ext|]   where input = [ "<textInput>"                 , "<title>Title</title>"                 , "<description>Description</description>"@@ -148,9 +176,9 @@ 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^.imageUriL @?= RssURI [uri|http://xml.com/universal/images/xml_tiny.gif|]   result^.imageTitleL @?= "XML.com"-  result^.imageLinkL @?= RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.xml.com") Nothing)) "" (Query []) Nothing)+  result^.imageLinkL @?= RssURI [uri|http://www.xml.com|]   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>"@@ -163,9 +191,9 @@ 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^.imageUriL @?= RssURI [uri|http://image.ext|]   result^.imageTitleL @?= "Title"-  result^.imageLinkL @?= RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "link.ext") Nothing)) "" (Query []) Nothing)+  result^.imageLinkL @?= RssURI [uri|http://link.ext|]   result^.imageWidthL @?= Just 100   result^.imageHeightL @?= Just 200   result^.imageDescriptionL @?= "Description"@@ -198,7 +226,7 @@   where input = [ "<cloud domain=\"rpc.sys.com\" port=\"80\" path=\"/RPC2\" registerProcedure=\"pingMe\" protocol=\"soap\"/>"                 , "<cloud domain=\"rpc.sys.com\" port=\"80\" path=\"/RPC2\" registerProcedure=\"myCloud.rssPleaseNotify\" protocol=\"xml-rpc\" />"                 ]-        uri = RssURI (RelativeRef (Just (Authority Nothing (Host "rpc.sys.com") (Just $ Port 80))) "/RPC2" (Query []) Nothing)+        uri = RssURI [relativeRef|//rpc.sys.com:80/RPC2|]  guidCase :: TestTree guidCase = testCase "<guid> element" $ do@@ -208,23 +236,23 @@                 , "<guid isPermaLink=\"false\">1</guid>"                 , "<guid>2</guid>"                 ]-        uri = RssURI (RelativeRef (Just (Authority Nothing (Host "guid.ext") Nothing)) "" (Query []) Nothing)+        uri = RssURI [relativeRef|//guid.ext|]  enclosureCase :: TestTree enclosureCase = testCase "<enclosure> element" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssEnclosure-  result @?= RssEnclosure uri 12216320 "audio/mpeg"+  result @?= RssEnclosure url 12216320 "audio/mpeg"   where input = [ "<enclosure url=\"http://www.scripting.com/mp3s/weatherReportSuite.mp3\" length=\"12216320\" type=\"audio/mpeg\" />"                 ]-        uri = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.scripting.com") Nothing)) "/mp3s/weatherReportSuite.mp3" (Query []) Nothing)+        url = RssURI [uri|http://www.scripting.com/mp3s/weatherReportSuite.mp3|]  sourceCase :: TestTree sourceCase = testCase "<source> element" $ do   result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssSource-  result @?= RssSource uri "Tomalak's Realm"+  result @?= RssSource url "Tomalak's Realm"   where input = [ "<source url=\"http://www.tomalak.org/links2.xml\">Tomalak's Realm</source>"                 ]-        uri = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.tomalak.org") Nothing)) "/links2.xml" (Query []) Nothing)+        url = RssURI [uri|http://www.tomalak.org/links2.xml|]  rss1ItemCase :: TestTree rss1ItemCase = testCase "RSS1 <item> element" $ do@@ -246,7 +274,7 @@                 , "<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)+        link = RssURI [uri|http://xml.com/pub/2000/08/09/xslt/xslt.html|]  rss2ItemCase :: TestTree rss2ItemCase = testCase "RSS2 <item> element" $ do@@ -266,7 +294,7 @@                 , "<sometag>Some content in unknown tag, should be ignored.</sometag>"                 , "</item>"                 ]-        link = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.example.com") Nothing)) "/blog/post/1" (Query []) Nothing)+        link = RssURI [uri|http://www.example.com/blog/post/1|]   rss1ChannelItemsCase :: TestTree@@ -336,10 +364,10 @@                 , "</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)+        link = RssURI [uri|http://xml.com/pub|]+        imageLink = RssURI [uri|http://www.xml.com|]+        imageUri = RssURI [uri|http://xml.com/universal/images/xml_tiny.gif|]+        textInputLink = RssURI [uri|http://search.xml.com|]   rss2DocumentCase :: TestTree@@ -371,7 +399,7 @@                 , "</channel>"                 , "</rss>"                 ]-        link = RssURI (URI (Scheme "http") (Just (Authority Nothing (Host "www.example.com") Nothing)) "/main.html" (Query []) Nothing)+        link = RssURI [uri|http://www.example.com/main.html|]   dublinCoreChannelCase :: TestTree@@ -474,8 +502,8 @@                 , "</channel>"                 , "</rss>"                 ]-        uri = AtomURI (URI (Scheme "http") (Just (Authority Nothing (Host "dallas.example.com") Nothing)) "/rss.xml" (Query []) Nothing)-        link = AtomLink uri "self" "application/rss+xml" mempty mempty mempty+        url = AtomURI [uri|http://dallas.example.com/rss.xml|]+        link = AtomLink url "self" "application/rss+xml" mempty mempty mempty  multipleExtensionsCase :: TestTree multipleExtensionsCase = testCase "Multiple extensions" $ do@@ -488,8 +516,8 @@                 , "<content:encoded><![CDATA[<p>What a <em>beautiful</em> day!</p>]]></content:encoded>"                 , "</item>"                 ]-        uri = AtomURI (URI (Scheme "http") (Just (Authority Nothing (Host "dallas.example.com") Nothing)) "/rss.xml" (Query []) Nothing)-        link = AtomLink uri "self" "application/rss+xml" mempty mempty mempty+        url = AtomURI [uri|http://dallas.example.com/rss.xml|]+        link = AtomLink url "self" "application/rss+xml" mempty mempty mempty   hlint :: TestTree