rss-conduit 0.4.2.1 → 0.4.2.2

raw patch · 10 files changed

+212/−190 lines, 10 filesdep ~conduitPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: conduit

API changes (from Hackage documentation)

Files

• rss-conduit.cabal +2/−2
• src/Text/RSS/Conduit/Parse.hs +54/−53
• src/Text/RSS/Conduit/Render.hs +14/−14
• src/Text/RSS/Extensions.hs +10/−10
• src/Text/RSS/Extensions/Atom.hs +3/−3
• src/Text/RSS/Extensions/Content.hs +4/−4
• src/Text/RSS/Extensions/DublinCore.hs +19/−19
• src/Text/RSS/Extensions/Syndication.hs +15/−15
• src/Text/RSS1/Conduit/Parse.hs +33/−33
• test/Main.hs +58/−37

@@ -1,5 +1,5 @@ name: rss-conduit-version: 0.4.2.1+version: 0.4.2.2 cabal-version: >=1.10 build-type: Simple license: PublicDomain@@ -41,7 +41,7 @@     build-depends:         atom-conduit >=0.5,         base >=4.8 && <5,-        conduit -any,+        conduit >= 1.2.8,         conduit-combinators -any,         containers -any,         dublincore-xml-conduit -any,

@@ -40,6 +40,7 @@ import           Data.Text.Encoding import           Data.Time.Clock import           Data.Time.LocalTime+import           Data.Time.RFC3339 import           Data.Time.RFC822 import           Data.Version import           Data.XML.Types@@ -88,12 +89,12 @@ 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+  maybe (throw $ InvalidTime text) return $ parseTimeRFC822 text <|> parseTimeRFC3339 text -headRequiredC :: MonadThrow m => Text -> Consumer a m a+headRequiredC :: MonadThrow m => Text -> ConduitT a b m a headRequiredC e = maybe (throw $ MissingElement e) return =<< headC -projectC :: Monad m => Fold a a' b b' -> Conduit a m b+projectC :: Monad m => Fold a a' b b' -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -106,12 +107,12 @@ -- | Parse a @\<skipHours\>@ element. rssSkipHours :: MonadThrow m => ConduitM Event o m (Maybe (Set Hour)) rssSkipHours = tagIgnoreAttrs "skipHours" $-  fromList <$> (manyYield' (tagIgnoreAttrs "hour" $ content >>= asInt >>= asHour) =$= sinkList)+  fromList <$> (manyYield' (tagIgnoreAttrs "hour" $ content >>= asInt >>= asHour) .| sinkList)  -- | Parse a @\<skipDays\>@ element. rssSkipDays :: MonadThrow m => ConduitM Event o m (Maybe (Set Day)) rssSkipDays = tagIgnoreAttrs "skipDays" $-  fromList <$> (manyYield' (tagIgnoreAttrs "day" $ content >>= asDay) =$= sinkList)+  fromList <$> (manyYield' (tagIgnoreAttrs "day" $ content >>= asDay) .| sinkList)   data TextInputPiece = TextInputTitle Text | TextInputDescription Text@@ -121,12 +122,12 @@  -- | Parse a @\<textInput\>@ element. rssTextInput :: MonadThrow m => ConduitM Event o m (Maybe RssTextInput)-rssTextInput = tagIgnoreAttrs "textInput" $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent 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")-    <*> ZipConduit (projectC _TextInputName =$= headRequiredC "Missing <name> element")-    <*> ZipConduit (projectC _TextInputLink =$= headRequiredC "Missing <link> element")+    <$> ZipConduit (projectC _TextInputTitle .| headRequiredC "Missing <title> element")+    <*> ZipConduit (projectC _TextInputDescription .| headRequiredC "Missing <description> element")+    <*> ZipConduit (projectC _TextInputName .| headRequiredC "Missing <name> element")+    <*> ZipConduit (projectC _TextInputLink .| headRequiredC "Missing <link> element")   piece = [ fmap TextInputTitle <$> tagIgnoreAttrs "title" content           , fmap TextInputDescription <$> tagIgnoreAttrs "description" content           , fmap TextInputName <$> tagIgnoreAttrs "name" content@@ -142,14 +143,14 @@  -- | Parse an @\<image\>@ element. rssImage :: (MonadThrow m) => ConduitM Event o m (Maybe RssImage)-rssImage = tagIgnoreAttrs "image" $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent 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-    <*> ZipConduit (projectC _ImageLink =$= headDefC nullURI)  -- Lenient-    <*> ZipConduit (projectC _ImageWidth =$= headC)-    <*> ZipConduit (projectC _ImageHeight =$= headC)-    <*> ZipConduit (projectC _ImageDescription =$= headDefC "")+    <$> ZipConduit (projectC _ImageUri .| headRequiredC "Missing <url> element")+    <*> ZipConduit (projectC _ImageTitle .| headDefC "Unnamed image")  -- Lenient+    <*> ZipConduit (projectC _ImageLink .| headDefC nullURI)  -- Lenient+    <*> ZipConduit (projectC _ImageWidth .| headC)+    <*> ZipConduit (projectC _ImageHeight .| headC)+    <*> ZipConduit (projectC _ImageDescription .| headDefC "")   piece = [ fmap ImageUri <$> tagIgnoreAttrs "url" (content >>= asRssURI)           , fmap ImageTitle <$> tagIgnoreAttrs "title" content           , fmap ImageLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)@@ -205,19 +206,19 @@ -- -- RSS extensions are automatically parsed based on the inferred result type. rssItem :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (Maybe (RssItem e))-rssItem = tagIgnoreAttrs "item" $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where+rssItem = tagIgnoreAttrs "item" $ (manyYield' (choose piece) .| parser) <* many ignoreAnyTreeContent where   parser = getZipConduit $ RssItem-    <$> ZipConduit (projectC _ItemTitle =$= headDefC "")-    <*> ZipConduit (projectC _ItemLink =$= headC)-    <*> ZipConduit (projectC _ItemDescription =$= headDefC "")-    <*> ZipConduit (projectC _ItemAuthor =$= headDefC "")-    <*> ZipConduit (projectC _ItemCategory =$= sinkList)-    <*> ZipConduit (projectC _ItemComments =$= headC)-    <*> ZipConduit (projectC _ItemEnclosure =$= sinkList)-    <*> ZipConduit (projectC _ItemGuid =$= headC)-    <*> ZipConduit (projectC _ItemPubDate =$= headC)-    <*> ZipConduit (projectC _ItemSource =$= headC)-    <*> ZipConduit (projectC _ItemOther =$= concatC =$= parseRssItemExtensions)+    <$> ZipConduit (projectC _ItemTitle .| headDefC "")+    <*> ZipConduit (projectC _ItemLink .| headC)+    <*> ZipConduit (projectC _ItemDescription .| headDefC "")+    <*> ZipConduit (projectC _ItemAuthor .| headDefC "")+    <*> ZipConduit (projectC _ItemCategory .| sinkList)+    <*> ZipConduit (projectC _ItemComments .| headC)+    <*> ZipConduit (projectC _ItemEnclosure .| sinkList)+    <*> ZipConduit (projectC _ItemGuid .| headC)+    <*> ZipConduit (projectC _ItemPubDate .| headC)+    <*> ZipConduit (projectC _ItemSource .| headC)+    <*> ZipConduit (projectC _ItemOther .| concatC .| parseRssItemExtensions)   piece = [ fmap ItemTitle <$> tagIgnoreAttrs "title" content           , fmap ItemLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)           , fmap ItemDescription <$> tagIgnoreAttrs "description" content@@ -228,7 +229,7 @@           , fmap ItemGuid <$> rssGuid           , fmap ItemPubDate <$> tagDate "pubDate"           , fmap ItemSource <$> rssSource-          , fmap ItemOther . nonEmpty <$> (void takeAnyTreeContent =$= sinkList)+          , fmap ItemOther . nonEmpty <$> (void takeAnyTreeContent .| sinkList)           ]  @@ -247,29 +248,29 @@ -- -- RSS extensions are automatically parsed based on the inferred result type. rssDocument :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (Maybe (RssDocument e))-rssDocument = tagName' "rss" attributes $ \version -> force "Missing <channel>" $ tagIgnoreAttrs "channel" (manyYield' (choose piece) =$= parser version) <* many ignoreAnyTreeContent 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")-    <*> ZipConduit (projectC _ChannelDescription =$= headDefC "")  -- Lenient-    <*> ZipConduit (projectC _ChannelItem =$= sinkList)-    <*> ZipConduit (projectC _ChannelLanguage =$= headDefC "")-    <*> ZipConduit (projectC _ChannelCopyright =$= headDefC "")-    <*> ZipConduit (projectC _ChannelManagingEditor =$= headDefC "")-    <*> ZipConduit (projectC _ChannelWebmaster =$= headDefC "")-    <*> ZipConduit (projectC _ChannelPubDate =$= headC)-    <*> ZipConduit (projectC _ChannelLastBuildDate =$= headC)-    <*> ZipConduit (projectC _ChannelCategory =$= sinkList)-    <*> ZipConduit (projectC _ChannelGenerator =$= headDefC "")-    <*> ZipConduit (projectC _ChannelDocs =$= headC)-    <*> ZipConduit (projectC _ChannelCloud =$= headC)-    <*> ZipConduit (projectC _ChannelTtl =$= headC)-    <*> ZipConduit (projectC _ChannelImage =$= headC)-    <*> ZipConduit (projectC _ChannelRating =$= headDefC "")-    <*> ZipConduit (projectC _ChannelTextInput =$= headC)-    <*> ZipConduit (projectC _ChannelSkipHours =$= headDefC mempty)-    <*> ZipConduit (projectC _ChannelSkipDays =$= headDefC mempty)-    <*> ZipConduit (projectC _ChannelOther =$= concatC =$= parseRssChannelExtensions)+    <$> ZipConduit (projectC _ChannelTitle .| headRequiredC "Missing <title> element")+    <*> ZipConduit (projectC _ChannelLink .| headRequiredC "Missing <link> element")+    <*> ZipConduit (projectC _ChannelDescription .| headDefC "")  -- Lenient+    <*> ZipConduit (projectC _ChannelItem .| sinkList)+    <*> ZipConduit (projectC _ChannelLanguage .| headDefC "")+    <*> ZipConduit (projectC _ChannelCopyright .| headDefC "")+    <*> ZipConduit (projectC _ChannelManagingEditor .| headDefC "")+    <*> ZipConduit (projectC _ChannelWebmaster .| headDefC "")+    <*> ZipConduit (projectC _ChannelPubDate .| headC)+    <*> ZipConduit (projectC _ChannelLastBuildDate .| headC)+    <*> ZipConduit (projectC _ChannelCategory .| sinkList)+    <*> ZipConduit (projectC _ChannelGenerator .| headDefC "")+    <*> ZipConduit (projectC _ChannelDocs .| headC)+    <*> ZipConduit (projectC _ChannelCloud .| headC)+    <*> ZipConduit (projectC _ChannelTtl .| headC)+    <*> ZipConduit (projectC _ChannelImage .| headC)+    <*> ZipConduit (projectC _ChannelRating .| headDefC "")+    <*> ZipConduit (projectC _ChannelTextInput .| headC)+    <*> ZipConduit (projectC _ChannelSkipHours .| headDefC mempty)+    <*> ZipConduit (projectC _ChannelSkipDays .| headDefC mempty)+    <*> ZipConduit (projectC _ChannelOther .| concatC .| parseRssChannelExtensions)   piece = [ fmap ChannelTitle <$> tagIgnoreAttrs "title" content           , fmap ChannelLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)           , fmap ChannelDescription <$> tagIgnoreAttrs "description" content@@ -290,6 +291,6 @@           , fmap ChannelTextInput <$> rssTextInput           , fmap ChannelSkipHours <$> rssSkipHours           , fmap ChannelSkipDays <$> rssSkipDays-          , fmap ChannelOther . nonEmpty <$> (void takeAnyTreeContent =$= sinkList)+          , fmap ChannelOther . nonEmpty <$> (void takeAnyTreeContent .| sinkList)           ]   attributes = (requireAttr "version" >>= asVersion) <* ignoreAttrs

@@ -40,7 +40,7 @@ -- }}}  -- | Render the top-level @\<rss\>@ element.-renderRssDocument :: Monad m => RenderRssExtensions e => RssDocument e -> Source m Event+renderRssDocument :: Monad m => RenderRssExtensions e => RssDocument e -> ConduitT () Event m () renderRssDocument d = tag "rss" (attr "version" . pack . showVersion $ d^.documentVersionL) $   tag "channel" mempty $ do     textTag "title" $ d^.channelTitleL@@ -66,7 +66,7 @@     renderRssChannelExtensions $ d^.channelExtensionsL  -- | Render an @\<item\>@ element.-renderRssItem :: Monad m => RenderRssExtensions e => RssItem e -> Source m Event+renderRssItem :: Monad m => RenderRssExtensions e => RssItem e -> ConduitT () Event m () renderRssItem i = tag "item" mempty $ do   optionalTextTag "title" $ i^.itemTitleL   forM_ (i^.itemLinkL) $ textTag "link" . renderRssURI@@ -81,24 +81,24 @@   renderRssItemExtensions $ i^.itemExtensionsL  -- | Render a @\<source\>@ element.-renderRssSource :: (Monad m) => RssSource -> Source m Event+renderRssSource :: (Monad m) => RssSource -> ConduitT () Event m () renderRssSource s = tag "source" (attr "url" $ renderRssURI $ s^.sourceUrlL) . content $ s^.sourceNameL  -- | Render an @\<enclosure\>@ element.-renderRssEnclosure :: (Monad m) => RssEnclosure -> Source m Event+renderRssEnclosure :: (Monad m) => RssEnclosure -> ConduitT () Event m () renderRssEnclosure e = tag "enclosure" attributes mempty where   attributes = attr "url" (renderRssURI $ e^.enclosureUrlL)     <> attr "length" (tshow $ e^.enclosureLengthL)     <> attr "type" (e^.enclosureTypeL)  -- | Render a @\<guid\>@ element.-renderRssGuid :: (Monad m) => RssGuid -> Source m Event+renderRssGuid :: (Monad m) => RssGuid -> ConduitT () Event m () renderRssGuid (GuidUri u) = tag "guid" (attr "isPermaLink" "true") $ content $ renderRssURI u renderRssGuid (GuidText t) = tag "guid" mempty $ content t   -- | Render a @\<cloud\>@ element.-renderRssCloud :: Monad m => RssCloud -> Source m Event+renderRssCloud :: Monad m => RssCloud -> ConduitT () Event m () renderRssCloud c = tag "cloud" attributes $ return () where   attributes = attr "domain" domain     <> optionalAttr "port" port@@ -124,11 +124,11 @@   describe ProtocolHttpPost = "http-post"  -- | Render a @\<category\>@ element.-renderRssCategory :: (Monad m) => RssCategory -> Source m Event+renderRssCategory :: (Monad m) => RssCategory -> ConduitT () Event m () renderRssCategory c = tag "category" (attr "domain" $ c^.categoryDomainL) . content $ c^.categoryNameL  -- | Render an @\<image\>@ element.-renderRssImage :: (Monad m) => RssImage -> Source m Event+renderRssImage :: (Monad m) => RssImage -> ConduitT () Event m () renderRssImage i = tag "image" mempty $ do   textTag "url" $ renderRssURI $ i^.imageUriL   textTag "title" $ i^.imageTitleL@@ -138,7 +138,7 @@   optionalTextTag "description" $ i^.imageDescriptionL  -- | Render a @\<textInput\>@ element.-renderRssTextInput :: (Monad m) => RssTextInput -> Source m Event+renderRssTextInput :: (Monad m) => RssTextInput -> ConduitT () Event m () renderRssTextInput t = tag "textInput" mempty $ do   textTag "title" $ t^.textInputTitleL   textTag "description" $ t^.textInputDescriptionL@@ -146,11 +146,11 @@   textTag "link" $ renderRssURI $ t^.textInputLinkL  -- | Render a @\<skipDays\>@ element.-renderRssSkipDays :: (Monad m) => Set Day -> Source m Event+renderRssSkipDays :: (Monad m) => Set Day -> ConduitT () Event m () renderRssSkipDays s = unless (Set.null s) $ tag "skipDays" mempty $ forM_ s $ textTag "day" . tshow  -- | Render a @\<skipHours\>@ element.-renderRssSkipHours :: (Monad m) => Set Hour -> Source m Event+renderRssSkipHours :: (Monad m) => Set Hour -> ConduitT () Event m () renderRssSkipHours s = unless (Set.null s) $ tag "skipHour" mempty $ forM_ s $ textTag "hour" . tshow  @@ -158,13 +158,13 @@ tshow :: Show a => a -> Text tshow = pack . show -textTag :: (Monad m) => Name -> Text -> Source m Event+textTag :: (Monad m) => Name -> Text -> ConduitT () Event m () textTag name = tag name mempty . content -optionalTextTag :: Monad m => Name -> Text -> Source m Event+optionalTextTag :: Monad m => Name -> Text -> ConduitT () Event m () optionalTextTag name value = unless (Text.null value) $ textTag name value -dateTag :: (Monad m) => Name -> UTCTime -> Source m Event+dateTag :: (Monad m) => Name -> UTCTime -> ConduitT () Event m () dateTag name = tag name mempty . content . formatTimeRFC822 . utcToZonedTime utc  renderRssURI :: RssURI -> Text

@@ -39,29 +39,29 @@ class ParseRssExtension a where   -- | This parser will be fed with all 'Event's within the @\<channel\>@ element.   -- Therefore, it is expected to ignore 'Event's unrelated to the RSS extension.-  parseRssChannelExtension :: MonadThrow m => ConduitM Event o m (RssChannelExtension a)+  parseRssChannelExtension :: MonadThrow m => ConduitT Event o m (RssChannelExtension a)   -- | This parser will be fed with all 'Event's within the @\<item\>@ element.   -- Therefore, it is expected to ignore 'Event's unrelated to the RSS extension.-  parseRssItemExtension :: MonadThrow m => ConduitM Event o m (RssItemExtension a)+  parseRssItemExtension :: MonadThrow m => ConduitT Event o m (RssItemExtension a)  -- | Requirement on a list of extension tags to be able to parse and combine them. type ParseRssExtensions (e :: [*]) = (AllConstrained ParseRssExtension e, SingI e)  -- | Parse a combination of RSS extensions at @\<channel\>@ level.-parseRssChannelExtensions :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (RssChannelExtensions e)+parseRssChannelExtensions :: ParseRssExtensions e => MonadThrow m => ConduitT Event o m (RssChannelExtensions e) parseRssChannelExtensions = f sing where   f :: AllConstrained ParseRssExtension e => MonadThrow m-    => Sing e -> ConduitM Event o m (RssChannelExtensions e)+    => Sing e -> ConduitT Event o m (RssChannelExtensions e)   f SNil = return $ RssChannelExtensions RNil   f (SCons _ es) = fmap RssChannelExtensions $ getZipConduit $ (:&)     <$> ZipConduit parseRssChannelExtension     <*> ZipConduit (rssChannelExtension <$> f es)  -- | Parse a combination of RSS extensions at @\<item\>@ level.-parseRssItemExtensions :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (RssItemExtensions e)+parseRssItemExtensions :: ParseRssExtensions e => MonadThrow m => ConduitT Event o m (RssItemExtensions e) parseRssItemExtensions = f sing where   f :: AllConstrained ParseRssExtension e => MonadThrow m-    => Sing e -> ConduitM Event o m (RssItemExtensions e)+    => Sing e -> ConduitT Event o m (RssItemExtensions e)   f SNil = return $ RssItemExtensions RNil   f (SCons _ es) = fmap RssItemExtensions $ getZipConduit $ (:&)     <$> ZipConduit parseRssItemExtension@@ -73,22 +73,22 @@ -- | 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+  renderRssChannelExtension :: Monad m => RssChannelExtension e -> ConduitT () Event m ()   -- | Render extension for the @\<item\>@ element.-  renderRssItemExtension :: Monad m => RssItemExtension e -> Source m Event+  renderRssItemExtension :: Monad m => RssItemExtension e -> ConduitT () Event m ()  -- | Requirement on a list of extension tags to be able to render them. type RenderRssExtensions (e :: [*]) = (AllConstrained RenderRssExtension e)  -- | Render a set of @\<channel\>@ extensions.-renderRssChannelExtensions :: Monad m => RenderRssExtensions e => RssChannelExtensions e -> Source m Event+renderRssChannelExtensions :: Monad m => RenderRssExtensions e => RssChannelExtensions e -> ConduitT () Event m () 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 :: Monad m => RenderRssExtensions e => RssItemExtensions e -> ConduitT () Event m () renderRssItemExtensions (RssItemExtensions RNil) = pure () renderRssItemExtensions (RssItemExtensions (a :& t)) = do   renderRssItemExtension a

@@ -11,7 +11,7 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                  (headC, (=$=))+import           Conduit                  (headC, (.|)) import           Data.Singletons import           GHC.Generics import           Text.Atom.Conduit.Parse@@ -28,8 +28,8 @@ instance SingI AtomModule where sing = SAtomModule  instance ParseRssExtension AtomModule where-  parseRssChannelExtension = AtomChannel <$> (manyYield' atomLink =$= headC)-  parseRssItemExtension    = AtomItem <$> (manyYield' atomLink =$= headC)+  parseRssChannelExtension = AtomChannel <$> (manyYield' atomLink .| headC)+  parseRssItemExtension    = AtomItem <$> (manyYield' atomLink .| headC)  instance RenderRssExtension AtomModule where   renderRssChannelExtension = mapM_ renderAtomLink . channelAtomLink

@@ -26,7 +26,7 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                (ConduitM, Source, headDefC, (=$=))+import           Conduit                (ConduitT, Source, headDefC, (.|)) import           Control.Exception.Safe as Exception import           Control.Monad import           Data.Maybe@@ -49,7 +49,7 @@  instance ParseRssExtension ContentModule where   parseRssChannelExtension = pure ContentChannel-  parseRssItemExtension    = ContentItem <$> (manyYield' contentEncoded =$= headDefC mempty)+  parseRssItemExtension    = ContentItem <$> (manyYield' contentEncoded .| headDefC mempty)  instance RenderRssExtension ContentModule where   renderRssChannelExtension = const $ pure ()@@ -72,9 +72,9 @@ contentName string = Name string (Just "http://purl.org/rss/1.0/modules/content/") (Just namespacePrefix)  -- | Parse a @\<content:encoded\>@ element.-contentEncoded :: MonadThrow m => ConduitM Event o m (Maybe Text)+contentEncoded :: MonadThrow m => ConduitT Event o m (Maybe Text) contentEncoded = tagIgnoreAttrs (matching (== contentName "encoded")) content  -- | Render a @\<content:encoded\>@ element.-renderContentEncoded :: Monad m => Text -> Source m Event+renderContentEncoded :: Monad m => Text -> ConduitT () Event m () renderContentEncoded = Render.tag (contentName "encoded") mempty . Render.content

@@ -43,7 +43,7 @@ -- }}}  -- {{{ Utils-projectC :: Monad m => Fold a a' b b' -> Conduit a m b+projectC :: Monad m => Fold a a' b b' -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -84,24 +84,24 @@ makeTraversals ''ElementPiece  -- | Parse a set of Dublin Core metadata elements.-dcMetadata :: MonadThrow m => ConduitM Event o m DcMetaData-dcMetadata = manyYield' (choose piece) =$= parser where+dcMetadata :: MonadThrow m => ConduitT Event o m DcMetaData+dcMetadata = manyYield' (choose piece) .| parser where   parser = getZipConduit $ DcMetaData-    <$> ZipConduit (projectC _ElementContributor =$= headDefC "")-    <*> ZipConduit (projectC _ElementCoverage =$= headDefC "")-    <*> ZipConduit (projectC _ElementCreator =$= headDefC "")-    <*> ZipConduit (projectC _ElementDate =$= headC)-    <*> ZipConduit (projectC _ElementDescription =$= headDefC "")-    <*> ZipConduit (projectC _ElementFormat =$= headDefC "")-    <*> ZipConduit (projectC _ElementIdentifier =$= headDefC "")-    <*> ZipConduit (projectC _ElementLanguage =$= headDefC "")-    <*> ZipConduit (projectC _ElementPublisher =$= headDefC "")-    <*> ZipConduit (projectC _ElementRelation =$= headDefC "")-    <*> ZipConduit (projectC _ElementRights =$= headDefC "")-    <*> ZipConduit (projectC _ElementSource =$= headDefC "")-    <*> ZipConduit (projectC _ElementSubject =$= headDefC "")-    <*> ZipConduit (projectC _ElementTitle =$= headDefC "")-    <*> ZipConduit (projectC _ElementType =$= headDefC "")+    <$> ZipConduit (projectC _ElementContributor .| headDefC "")+    <*> ZipConduit (projectC _ElementCoverage .| headDefC "")+    <*> ZipConduit (projectC _ElementCreator .| headDefC "")+    <*> ZipConduit (projectC _ElementDate .| headC)+    <*> ZipConduit (projectC _ElementDescription .| headDefC "")+    <*> ZipConduit (projectC _ElementFormat .| headDefC "")+    <*> ZipConduit (projectC _ElementIdentifier .| headDefC "")+    <*> ZipConduit (projectC _ElementLanguage .| headDefC "")+    <*> ZipConduit (projectC _ElementPublisher .| headDefC "")+    <*> ZipConduit (projectC _ElementRelation .| headDefC "")+    <*> ZipConduit (projectC _ElementRights .| headDefC "")+    <*> ZipConduit (projectC _ElementSource .| headDefC "")+    <*> ZipConduit (projectC _ElementSubject .| headDefC "")+    <*> ZipConduit (projectC _ElementTitle .| headDefC "")+    <*> ZipConduit (projectC _ElementType .| headDefC "")   piece = [ fmap ElementContributor <$> DC.elementContributor           , fmap ElementCoverage <$> DC.elementCoverage           , fmap ElementCreator <$> DC.elementCreator@@ -120,7 +120,7 @@           ]  -- | Render a set of Dublin Core metadata elements.-renderDcMetadata :: Monad m => DcMetaData -> Source m Event+renderDcMetadata :: Monad m => DcMetaData -> ConduitT () Event m () renderDcMetadata DcMetaData{..} = do   unless (Text.null elementContributor) $ renderElementContributor elementContributor   unless (Text.null elementCoverage) $ renderElementCoverage elementCoverage

@@ -69,7 +69,7 @@ asInt :: MonadThrow m => Text -> m Int asInt t = maybe (throwM $ InvalidInt t) return . readMaybe $ unpack t -projectC :: Monad m => Fold a a' b b' -> Conduit a m b+projectC :: Monad m => Fold a a' b b' -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -94,10 +94,10 @@ syndicationName :: Text -> Name syndicationName string = Name string (Just "http://purl.org/rss/1.0/modules/syndication/") (Just namespacePrefix) -syndicationTag :: MonadThrow m => Text -> ConduitM Event o m a -> ConduitM Event o m (Maybe a)+syndicationTag :: MonadThrow m => Text -> ConduitT Event o m a -> ConduitT Event o m (Maybe a) syndicationTag name = tagIgnoreAttrs (matching (== syndicationName name)) -renderSyndicationTag :: Monad m => Text -> Text -> Source m Event+renderSyndicationTag :: Monad m => Text -> Text -> ConduitT () Event m () renderSyndicationTag name = Render.tag (syndicationName name) mempty . Render.content  @@ -137,46 +137,46 @@ makeTraversals ''ElementPiece  -- | Parse all __Syndication__ elements.-syndicationInfo :: MonadThrow m => ConduitM Event o m SyndicationInfo-syndicationInfo = manyYield' (choose piece) =$= parser where+syndicationInfo :: MonadThrow m => ConduitT Event o m SyndicationInfo+syndicationInfo = manyYield' (choose piece) .| parser where   parser = getZipConduit $ SyndicationInfo-    <$> ZipConduit (projectC _ElementPeriod =$= headC)-    <*> ZipConduit (projectC _ElementFrequency =$= headC)-    <*> ZipConduit (projectC _ElementBase =$= headC)+    <$> ZipConduit (projectC _ElementPeriod .| headC)+    <*> ZipConduit (projectC _ElementFrequency .| headC)+    <*> ZipConduit (projectC _ElementBase .| headC)   piece = [ fmap ElementPeriod <$> syndicationPeriod           , fmap ElementFrequency <$> syndicationFrequency           , fmap ElementBase <$> syndicationBase           ]  -- | Parse a @\<sy:updatePeriod\>@ element.-syndicationPeriod :: MonadThrow m => ConduitM Event o m (Maybe SyndicationPeriod)+syndicationPeriod :: MonadThrow m => ConduitT Event o m (Maybe SyndicationPeriod) syndicationPeriod = syndicationTag "updatePeriod" (content >>= asSyndicationPeriod)  -- | Parse a @\<sy:updateFrequency\>@ element.-syndicationFrequency :: MonadThrow m => ConduitM Event o m (Maybe Int)+syndicationFrequency :: MonadThrow m => ConduitT Event o m (Maybe Int) syndicationFrequency = syndicationTag "updateFrequency" (content >>= asInt)  -- | Parse a @\<sy:updateBase\>@ element.-syndicationBase :: MonadThrow m => ConduitM Event o m (Maybe UTCTime)+syndicationBase :: MonadThrow m => ConduitT Event o m (Maybe UTCTime) syndicationBase = syndicationTag "updateBase" (content >>= asDate)  -- | Render all __Syndication__ elements.-renderSyndicationInfo :: Monad m => SyndicationInfo -> Source m Event+renderSyndicationInfo :: Monad m => SyndicationInfo -> ConduitT () Event m () 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 :: Monad m => SyndicationPeriod -> ConduitT () Event m () renderSyndicationPeriod = renderSyndicationTag "updatePeriod" . fromSyndicationPeriod  -- | Render a @\<sy:updateFrequency\>@ element.-renderSyndicationFrequency :: Monad m => Int -> Source m Event+renderSyndicationFrequency :: Monad m => Int -> ConduitT () Event m () renderSyndicationFrequency = renderSyndicationTag "updateFrequency" . tshow  -- | Render a @\<sy:updateBase\>@ element.-renderSyndicationBase :: Monad m => UTCTime -> Source m Event+renderSyndicationBase :: Monad m => UTCTime -> ConduitT () Event m () renderSyndicationBase = renderSyndicationTag "updateBase" . formatTimeRFC822 . utcToZonedTime utc  

@@ -54,10 +54,10 @@ nullURI :: RssURI nullURI = RssURI $ RelativeRef Nothing "" (Query []) Nothing -headRequiredC :: MonadThrow m => Text -> Consumer a m a+headRequiredC :: MonadThrow m => Text -> ConduitT a b m a headRequiredC e = maybe (throw $ MissingElement e) return =<< headC -projectC :: Monad m => Fold a a' b b' -> Conduit a m b+projectC :: Monad m => Fold a a' b b' -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -99,12 +99,12 @@  -- | 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+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+    <$> 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)@@ -122,25 +122,25 @@ -- -- RSS extensions are automatically parsed based on the inferred result type. rss1Item :: ParseRssExtensions e => MonadCatch m => ConduitM Event o m (Maybe (RssItem e))-rss1Item = rss1Tag "item" attributes $ \uri -> (manyYield' (choose piece) =$= parser uri) <* many ignoreAnyTreeContent where+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)+    <$> 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)+    <*> ZipConduit (projectC _ItemDate .| headC)     <*> pure mzero-    <*> ZipConduit (projectC _ItemOther =$= concatC =$= parseRssItemExtensions)+    <*> ZipConduit (projectC _ItemOther .| concatC .| parseRssItemExtensions)   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)-          , fmap ItemOther . nonEmpty <$> (void takeAnyTreeContent =$= sinkList)+          , fmap ItemOther . nonEmpty <$> (void takeAnyTreeContent .| sinkList)           ]   attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs @@ -151,11 +151,11 @@  -- | 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+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+    <$> 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@@ -198,22 +198,22 @@ -- -- RSS extensions are automatically parsed based on the inferred result type. rss1Channel :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (Maybe (Rss1Channel e))-rss1Channel = rss1Tag "channel" attributes $ \channelId -> (manyYield' (choose piece) =$= parser channelId) <* many ignoreAnyTreeContent where+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)-    <*> ZipConduit (projectC _ChannelOther =$= concatC =$= parseRssChannelExtensions)+    <$> 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)+    <*> ZipConduit (projectC _ChannelOther .| concatC .| parseRssChannelExtensions)   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-          , fmap ChannelOther . nonEmpty <$> (void takeAnyTreeContent =$= sinkList)+          , fmap ChannelOther . nonEmpty <$> (void takeAnyTreeContent .| sinkList)           ]   attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs @@ -257,12 +257,12 @@ -- -- RSS extensions are automatically parsed based on the inferred result type. rss1Document :: ParseRssExtensions e => MonadCatch m => ConduitM Event o m (Maybe (RssDocument e))-rss1Document = fmap (fmap rss1ToRss2) $ rdfTag "RDF" ignoreAttrs $ const $ (manyYield' (choose piece) =$= parser) <* many ignoreAnyTreeContent where+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)+    <$> 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

@@ -27,6 +27,7 @@ import           Data.Conduit import           Data.Conduit.List import           Data.Default+import           Data.Maybe import           Data.Singletons.Prelude.List import           Data.Text                       (Text) import           Data.Text.Encoding@@ -70,7 +71,8 @@   , enclosureCase   , sourceCase   , rss1ItemCase-  , rss2ItemCase+  , rss2ItemCase1+  , rss2ItemCase2   , rss1ChannelItemsCase   , rss1DocumentCase   , rss2DocumentCase@@ -91,7 +93,7 @@   , roundtripProperty "RssSource" renderRssSource rssSource   , roundtripProperty "RssGuid" renderRssGuid rssGuid   , roundtripProperty "RssItem"-      (renderRssItem :: RssItem '[] -> Source Maybe Event)+      (renderRssItem :: RssItem '[] -> ConduitT () Event Maybe ())       rssItem   , roundtripProperty "DublinCore"       (renderRssChannelExtension @DublinCoreModule)@@ -109,17 +111,17 @@   roundtripProperty :: Eq a => Arbitrary a => Show a-                  => TestName -> (a -> Source Maybe Event) -> ConduitM Event Void Maybe (Maybe a) -> TestTree+                  => TestName -> (a -> ConduitT () Event Maybe ()) -> ConduitT 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+  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+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssSkipHours   result @?= [Hour 0, Hour 9, Hour 18, Hour 21]   where input = [ "<skipHours>"                 , "<hour>21</hour>"@@ -132,7 +134,7 @@  skipDaysCase :: TestTree skipDaysCase = testCase "<skipDays> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssSkipDays+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssSkipDays   result @?= [Monday, Saturday, Friday]   where input = [ "<skipDays>"                 , "<day>Monday</day>"@@ -144,7 +146,7 @@  rss1TextInputCase :: TestTree rss1TextInputCase = testCase "RSS1 <textinput> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1TextInput+  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"@@ -159,7 +161,7 @@  rss2TextInputCase :: TestTree rss2TextInputCase = testCase "RSS2 <textInput> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssTextInput+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssTextInput   result^.textInputTitleL @?= "Title"   result^.textInputDescriptionL @?= "Description"   result^.textInputNameL @?= "Name"@@ -174,7 +176,7 @@  rss1ImageCase :: TestTree rss1ImageCase = testCase "RSS1 <image> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1Image+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rss1Image   result^.imageUriL @?= RssURI [uri|http://xml.com/universal/images/xml_tiny.gif|]   result^.imageTitleL @?= "XML.com"   result^.imageLinkL @?= RssURI [uri|http://www.xml.com|]@@ -189,7 +191,7 @@  rss2ImageCase :: TestTree rss2ImageCase = testCase "RSS2 <image> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssImage+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssImage   result^.imageUriL @?= RssURI [uri|http://image.ext|]   result^.imageTitleL @?= "Title"   result^.imageLinkL @?= RssURI [uri|http://link.ext|]@@ -210,7 +212,7 @@  categoryCase :: TestTree categoryCase = testCase "<category> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssCategory+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssCategory   result @?= RssCategory "Domain" "Name"   where input = [ "<category domain=\"Domain\">"                 , "Name"@@ -219,7 +221,7 @@  cloudCase :: TestTree cloudCase = testCase "<cloud> element" $ do-  result1:result2:_ <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.many rssCloud+  result1:result2:_ <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| XML.many rssCloud   result1 @?= RssCloud uri "pingMe" ProtocolSoap   result2 @?= RssCloud uri "myCloud.rssPleaseNotify" ProtocolXmlRpc   where input = [ "<cloud domain=\"rpc.sys.com\" port=\"80\" path=\"/RPC2\" registerProcedure=\"pingMe\" protocol=\"soap\"/>"@@ -229,7 +231,7 @@  guidCase :: TestTree guidCase = testCase "<guid> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= XML.many rssGuid+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| XML.many rssGuid   result @?= [GuidUri uri, GuidText "1", GuidText "2"]   where input = [ "<guid isPermaLink=\"true\">//guid.ext</guid>"                 , "<guid isPermaLink=\"false\">1</guid>"@@ -239,7 +241,7 @@  enclosureCase :: TestTree enclosureCase = testCase "<enclosure> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssEnclosure+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssEnclosure   result @?= RssEnclosure url 12216320 "audio/mpeg"   where input = [ "<enclosure url=\"http://www.scripting.com/mp3s/weatherReportSuite.mp3\" length=\"12216320\" type=\"audio/mpeg\" />"                 ]@@ -247,7 +249,7 @@  sourceCase :: TestTree sourceCase = testCase "<source> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssSource+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssSource   result @?= RssSource url "Tomalak's Realm"   where input = [ "<source url=\"http://www.tomalak.org/links2.xml\">Tomalak's Realm</source>"                 ]@@ -255,7 +257,7 @@  rss1ItemCase :: TestTree rss1ItemCase = testCase "RSS1 <item> element" $ do-  Just result <- runResourceT $ runConduit $ sourceList input =$= XML.parseText' def =$= rss1Item+  Just result <- runResourceT $ runConduit $ sourceList input .| XML.parseText' def .| 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."@@ -275,15 +277,15 @@                 ]         link = RssURI [uri|http://xml.com/pub/2000/08/09/xslt/xslt.html|] -rss2ItemCase :: TestTree-rss2ItemCase = testCase "RSS2 <item> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rssItem+rss2ItemCase1 :: TestTree+rss2ItemCase1 = testCase "RSS2 <item> element 1" $ do+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssItem   result^.itemTitleL @?= "Example entry"   result^.itemLinkL @?= Just link   result^.itemDescriptionL @?= "Here is some text containing an interesting description."   result^.itemGuidL @?= Just (GuidText "7bd204c6-1655-4c27-aeee-53f933c5395f")   result^.itemExtensionsL @?= RssItemExtensions RNil-  -- isJust (result^.itemPubDate_) @?= True+  isJust (result^.itemPubDateL) @?= True   where input = [ "<item>"                 , "<title>Example entry</title>"                 , "<description>Here is some text containing an interesting description.</description>"@@ -296,9 +298,28 @@         link = RssURI [uri|http://www.example.com/blog/post/1|]  +rss2ItemCase2 :: TestTree+rss2ItemCase2 = testCase "RSS2 <item> element 2" $ do+  result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| force "ERROR" rssItem+  result^.itemTitleL @?= "Plop"+  result^.itemLinkL @?= Nothing+  result^.itemDescriptionL @?= ""+  result^.itemAuthorL @?= "author@w3schools.com"+  result^.itemGuidL @?= Nothing+  result^.itemExtensionsL @?= RssItemExtensions RNil+  isJust (result^.itemPubDateL) @?= True+  where input = [ "<item>"+                , "<title>Plop</title>"+                , "<author>author@w3schools.com</author>"+                , "<pubDate>2018-07-13T00:00:00-04:00</pubDate>"+                , "</item>"+                ]+        link = RssURI [uri|http://www.example.com/blog/post/1|]++ rss1ChannelItemsCase :: TestTree rss1ChannelItemsCase = testCase "RSS1 <items> element" $ do-  result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= force "ERROR" rss1ChannelItems+  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>"@@ -312,7 +333,7 @@  rss1DocumentCase :: TestTree rss1DocumentCase = testCase "<rdf> element" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rss1Document+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| 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."@@ -371,7 +392,7 @@  rss2DocumentCase :: TestTree rss2DocumentCase = testCase "<rss> element" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssDocument+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument   result^.documentVersionL @?= Version [2] []   result^.channelTitleL @?= "RSS Title"   result^.channelDescriptionL @?= "This is an example of an RSS feed"@@ -403,7 +424,7 @@  dublinCoreChannelCase :: TestTree dublinCoreChannelCase = testCase "Dublin Core <channel> extension" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssDocument+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument   result^.channelExtensionsL @?= RssChannelExtensions (DublinCoreChannel dublinCoreElement :& RNil)   where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"                 , "<rss xmlns:dc=\"http://purl.org/dc/elements/1.1/\" version=\"2.0\">"@@ -431,7 +452,7 @@  dublinCoreItemCase :: TestTree dublinCoreItemCase = testCase "Dublin Core <item> extension" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssItem+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem   result^.itemExtensionsL @?= RssItemExtensions (DublinCoreItem dublinCoreElement :& RNil)   where input = [ "<item xmlns:dc=\"http://purl.org/dc/elements/1.1/\">"                 , "<title>Example entry</title>"@@ -458,7 +479,7 @@  contentItemCase :: TestTree contentItemCase = testCase "Content <item> extension" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssItem+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem   result^.itemExtensionsL @?= RssItemExtensions (ContentItem "<p>What a <em>beautiful</em> day!</p>" :& RNil)   where input = [ "<item xmlns:content=\"http://purl.org/rss/1.0/modules/content/\">"                 , "<title>Example entry</title>"@@ -468,7 +489,7 @@  syndicationChannelCase :: TestTree syndicationChannelCase = testCase "Syndication <channel> extension" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssDocument+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument   result^.channelExtensionsL @?= RssChannelExtensions (SyndicationChannel syndicationInfo :& RNil)   where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"                 , "<rss xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\" version=\"2.0\">"@@ -490,7 +511,7 @@  atomChannelCase :: TestTree atomChannelCase = testCase "Atom <channel> extension" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssDocument+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument   result^.channelExtensionsL @?= RssChannelExtensions (AtomChannel (Just link) :& RNil)   where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"                 , "<rss xmlns:atom=\"http://www.w3.org/2005/Atom\" version=\"2.0\">"@@ -506,7 +527,7 @@  multipleExtensionsCase :: TestTree multipleExtensionsCase = testCase "Multiple extensions" $ do-  Just result <- runResourceT . runConduit $ sourceList input =$= XML.parseText' def =$= rssItem+  Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem   result^.itemExtensionsL @?= RssItemExtensions (ContentItem "<p>What a <em>beautiful</em> day!</p>" :& AtomItem (Just link) :& RNil)   where input = [ "<item xmlns:content=\"http://purl.org/rss/1.0/modules/content/\""                 , " xmlns:atom=\"http://www.w3.org/2005/Atom\">"@@ -520,25 +541,25 @@   roundtripTextInputProperty :: TestTree-roundtripTextInputProperty = testProperty "parse . render = id (RssTextInput)" $ \t -> either (const False) (t ==) (runConduit $ renderRssTextInput t =$= force "ERROR" rssTextInput)+roundtripTextInputProperty = testProperty "parse . render = id (RssTextInput)" $ \t -> either (const False) (t ==) (runConduit $ renderRssTextInput t .| force "ERROR" rssTextInput)  roundtripImageProperty :: TestTree-roundtripImageProperty = testProperty "parse . render = id (RssImage)" $ \t -> either (const False) (t ==) (runConduit $ renderRssImage t =$= force "ERROR" rssImage)+roundtripImageProperty = testProperty "parse . render = id (RssImage)" $ \t -> either (const False) (t ==) (runConduit $ renderRssImage t .| force "ERROR" rssImage)  roundtripCategoryProperty :: TestTree-roundtripCategoryProperty = testProperty "parse . render = id (RssCategory)" $ \t -> either (const False) (t ==) (runConduit $ renderRssCategory t =$= force "ERROR" rssCategory)+roundtripCategoryProperty = testProperty "parse . render = id (RssCategory)" $ \t -> either (const False) (t ==) (runConduit $ renderRssCategory t .| force "ERROR" rssCategory)  roundtripEnclosureProperty :: TestTree-roundtripEnclosureProperty = testProperty "parse . render = id (RssEnclosure)" $ \t -> either (const False) (t ==) (runConduit $ renderRssEnclosure t =$= force "ERROR" rssEnclosure)+roundtripEnclosureProperty = testProperty "parse . render = id (RssEnclosure)" $ \t -> either (const False) (t ==) (runConduit $ renderRssEnclosure t .| force "ERROR" rssEnclosure)  roundtripSourceProperty :: TestTree-roundtripSourceProperty = testProperty "parse . render = id (RssSource)" $ \t -> either (const False) (t ==) (runConduit $ renderRssSource t =$= force "ERROR" rssSource)+roundtripSourceProperty = testProperty "parse . render = id (RssSource)" $ \t -> either (const False) (t ==) (runConduit $ renderRssSource t .| force "ERROR" rssSource)  roundtripGuidProperty :: TestTree-roundtripGuidProperty = testProperty "parse . render = id (RssGuid)" $ \t -> either (const False) (t ==) (runConduit $ renderRssGuid t =$= force "ERROR" rssGuid)+roundtripGuidProperty = testProperty "parse . render = id (RssGuid)" $ \t -> either (const False) (t ==) (runConduit $ renderRssGuid t .| force "ERROR" rssGuid)  roundtripItemProperty :: TestTree-roundtripItemProperty = testProperty "parse . render = id (RssItem)" $ \(t :: RssItem '[]) -> either (const False) (t ==) (runConduit $ renderRssItem t =$= force "ERROR" rssItem)+roundtripItemProperty = testProperty "parse . render = id (RssItem)" $ \(t :: RssItem '[]) -> either (const False) (t ==) (runConduit $ renderRssItem t .| force "ERROR" rssItem)   letter = choose ('a', 'z')