rss-conduit 0.4.3.1 → 0.5.0.0

raw patch · 15 files changed

+541/−351 lines, 15 filesdep +base-compat-batteriesdep −semigroupsdep −singletonsdep −vinyldep ~basedep ~conduitdep ~xml-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: base-compat-batteries

Dependencies removed: semigroups, singletons, vinyl

Dependency ranges changed: base, conduit, xml-conduit

API changes (from Hackage documentation)

Files

• LICENSE +117/−9
• rss-conduit.cabal +41/−26
• src/Text/RSS/Conduit/Parse.hs +4/−4
• src/Text/RSS/Conduit/Render.hs +4/−4
• src/Text/RSS/Extensions.hs +42/−48
• src/Text/RSS/Extensions/Atom.hs +44/−20
• src/Text/RSS/Extensions/Content.hs +36/−20
• src/Text/RSS/Extensions/DublinCore.hs +44/−23
• src/Text/RSS/Extensions/Syndication.hs +36/−21
• src/Text/RSS/Lens.hs +0/−11
• src/Text/RSS/Types.hs +24/−51
• src/Text/RSS1/Conduit/Parse.hs +12/−14
• test/Arbitrary.hs +19/−16
• test/Main.hs +14/−84
• test/QuickCheck.hs +104/−0

@@ -1,13 +1,121 @@-DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE-Version 2, December 2004+Creative Commons Legal Code -Copyright (C) 2015 koral <koral at mailoo dot org>+CC0 1.0 Universal -Everyone is permitted to copy and distribute verbatim or modified-copies of this license document, and changing it is allowed as long-as the name is changed.+    CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE+    LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN+    ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS+    INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES+    REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS+    PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM+    THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED+    HEREUNDER. -DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE-TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION+Statement of Purpose -0. You just DO WHAT THE FUCK YOU WANT TO.+The laws of most jurisdictions throughout the world automatically confer+exclusive Copyright and Related Rights (defined below) upon the creator+and subsequent owner(s) (each and all, an "owner") of an original work of+authorship and/or a database (each, a "Work").++Certain owners wish to permanently relinquish those rights to a Work for+the purpose of contributing to a commons of creative, cultural and+scientific works ("Commons") that the public can reliably and without fear+of later claims of infringement build upon, modify, incorporate in other+works, reuse and redistribute as freely as possible in any form whatsoever+and for any purposes, including without limitation commercial purposes.+These owners may contribute to the Commons to promote the ideal of a free+culture and the further production of creative, cultural and scientific+works, or to gain reputation or greater distribution for their Work in+part through the use and efforts of others.++For these and/or other purposes and motivations, and without any+expectation of additional consideration or compensation, the person+associating CC0 with a Work (the "Affirmer"), to the extent that he or she+is an owner of Copyright and Related Rights in the Work, voluntarily+elects to apply CC0 to the Work and publicly distribute the Work under its+terms, with knowledge of his or her Copyright and Related Rights in the+Work and the meaning and intended legal effect of CC0 on those rights.++1. Copyright and Related Rights. A Work made available under CC0 may be+protected by copyright and related or neighboring rights ("Copyright and+Related Rights"). Copyright and Related Rights include, but are not+limited to, the following:++  i. the right to reproduce, adapt, distribute, perform, display,+     communicate, and translate a Work;+ ii. moral rights retained by the original author(s) and/or performer(s);+iii. publicity and privacy rights pertaining to a person's image or+     likeness depicted in a Work;+ iv. rights protecting against unfair competition in regards to a Work,+     subject to the limitations in paragraph 4(a), below;+  v. rights protecting the extraction, dissemination, use and reuse of data+     in a Work;+ vi. database rights (such as those arising under Directive 96/9/EC of the+     European Parliament and of the Council of 11 March 1996 on the legal+     protection of databases, and under any national implementation+     thereof, including any amended or successor version of such+     directive); and+vii. other similar, equivalent or corresponding rights throughout the+     world based on applicable law or treaty, and any national+     implementations thereof.++2. Waiver. To the greatest extent permitted by, but not in contravention+of, applicable law, Affirmer hereby overtly, fully, permanently,+irrevocably and unconditionally waives, abandons, and surrenders all of+Affirmer's Copyright and Related Rights and associated claims and causes+of action, whether now known or unknown (including existing as well as+future claims and causes of action), in the Work (i) in all territories+worldwide, (ii) for the maximum duration provided by applicable law or+treaty (including future time extensions), (iii) in any current or future+medium and for any number of copies, and (iv) for any purpose whatsoever,+including without limitation commercial, advertising or promotional+purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each+member of the public at large and to the detriment of Affirmer's heirs and+successors, fully intending that such Waiver shall not be subject to+revocation, rescission, cancellation, termination, or any other legal or+equitable action to disrupt the quiet enjoyment of the Work by the public+as contemplated by Affirmer's express Statement of Purpose.++3. Public License Fallback. Should any part of the Waiver for any reason+be judged legally invalid or ineffective under applicable law, then the+Waiver shall be preserved to the maximum extent permitted taking into+account Affirmer's express Statement of Purpose. In addition, to the+extent the Waiver is so judged Affirmer hereby grants to each affected+person a royalty-free, non transferable, non sublicensable, non exclusive,+irrevocable and unconditional license to exercise Affirmer's Copyright and+Related Rights in the Work (i) in all territories worldwide, (ii) for the+maximum duration provided by applicable law or treaty (including future+time extensions), (iii) in any current or future medium and for any number+of copies, and (iv) for any purpose whatsoever, including without+limitation commercial, advertising or promotional purposes (the+"License"). The License shall be deemed effective as of the date CC0 was+applied by Affirmer to the Work. Should any part of the License for any+reason be judged legally invalid or ineffective under applicable law, such+partial invalidity or ineffectiveness shall not invalidate the remainder+of the License, and in such case Affirmer hereby affirms that he or she+will not (i) exercise any of his or her remaining Copyright and Related+Rights in the Work or (ii) assert any associated claims and causes of+action with respect to the Work, in either case contrary to Affirmer's+express Statement of Purpose.++4. Limitations and Disclaimers.++ a. No trademark or patent rights held by Affirmer are waived, abandoned,+    surrendered, licensed or otherwise affected by this document.+ b. Affirmer offers the Work as-is and makes no representations or+    warranties of any kind concerning the Work, express, implied,+    statutory or otherwise, including without limitation warranties of+    title, merchantability, fitness for a particular purpose, non+    infringement, or the absence of latent or other defects, accuracy, or+    the present or absence of errors, whether or not discoverable, all to+    the greatest extent permissible under applicable law.+ c. Affirmer disclaims responsibility for clearing rights of other persons+    that may apply to the Work or any use thereof, including without+    limitation any person's Copyright and Related Rights in the Work.+    Further, Affirmer disclaims responsibility for obtaining any necessary+    consents, permissions or other rights required for any use of the+    Work.+ d. Affirmer understands and acknowledges that Creative Commons is not a+    party to this document and has no duty or obligation with respect to+    this CC0 or use of the Work.

@@ -1,15 +1,16 @@+cabal-version: 2.2 name: rss-conduit-version: 0.4.3.1-cabal-version: >=1.10+version: 0.5.0.0 build-type: Simple-license: PublicDomain+license: CC0-1.0 license-file: LICENSE-maintainer: chahine.moreau@gmail.com+author: koral+maintainer: mail@cmoreau.info+bug-reports: https://github.com/k0ral/rss-conduit/issues synopsis: Streaming parser/renderer for the RSS standard.-description:-    Cf README file.+description: Cf README file. category: XML, Conduit-author: chahine.moreau@gmail.com+tested-with: GHC <8.9 && >=8.4.2 extra-source-files:     README.md @@ -22,10 +23,13 @@   manual: True   default: False +common common+    build-depends: base >=4.7 && <5, base-compat-batteries+    default-language: Haskell2010++ library-    if impl(ghc <8)-        build-depends:-            semigroups -any+    import: common     exposed-modules:         Text.RSS1.Conduit.Parse         Text.RSS.Conduit.Parse@@ -40,7 +44,6 @@         Text.RSS.Types     build-depends:         atom-conduit >=0.5,-        base >=4.8 && <5,         conduit >= 1.3,         conduit-combinators -any,         containers -any,@@ -48,24 +51,21 @@         safe-exceptions -any,         lens-simple -any,         safe -any,-        singletons -any,         text -any,         time >=1.5,         timerep >=2.0,         uri-bytestring >=0.2,-        vinyl >= 0.9,         xml-conduit >=1.5,         xml-types -any-    default-language: Haskell2010     hs-source-dirs: src -test-suite  Tests+test-suite tests+    import: common     type: exitcode-stdio-1.0     main-is: Main.hs     build-depends:-        rss-conduit -any,+        rss-conduit,         atom-conduit >=0.5,-        base >=4.8 && <5,         blaze-builder -any,         bytestring -any,         conduit -any,@@ -75,35 +75,50 @@         filepath -any,         lens-simple -any,         mono-traversable -any,-        QuickCheck -any,-        quickcheck-instances -any,         resourcet -any,         safe-exceptions -any,-        singletons -any,         tasty -any,         tasty-golden -any,         tasty-hunit -any,+        time >=1.5,+        text -any,+        uri-bytestring >=0.2,+        xml-conduit >=1.3,+        xml-types -any+    hs-source-dirs: test++test-suite quickcheck-tests+    import: common+    type: exitcode-stdio-1.0+    main-is: QuickCheck.hs+    build-depends:+        rss-conduit,+        atom-conduit >=0.5,+        blaze-builder -any,+        bytestring -any,+        conduit -any,+        dublincore-xml-conduit -any,+        filepath -any,+        QuickCheck -any,+        quickcheck-instances -any,+        tasty -any,         tasty-quickcheck -any,         time >=1.5,         text -any,         uri-bytestring >=0.2,-        vinyl -any,         xml-conduit >=1.3,         xml-types -any-    default-language: Haskell2010     hs-source-dirs: test     other-modules:         Arbitrary  test-suite hlint+    import: common     if flag(enable-hlint-test)       buildable: True     else       buildable: False     type: exitcode-stdio-1.0     main-is: HLint.hs-    build-depends:-        base >=4.8,-        hlint -any-    default-language: Haskell2010+    build-depends: hlint -any     hs-source-dirs: test

@@ -205,7 +205,7 @@ -- | Parse an @\<item\>@ element. -- -- RSS extensions are automatically parsed based on the inferred result type.-rssItem :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (Maybe (RssItem e))+rssItem :: ParseRssExtension e => MonadThrow m => ConduitM Event o m (Maybe (RssItem e)) rssItem = tagIgnoreAttrs "item" $ (manyYield' (choose piece) .| parser) <* many ignoreAnyTreeContent where   parser = getZipConduit $ RssItem     <$> ZipConduit (projectC _ItemTitle .| headDefC "")@@ -218,7 +218,7 @@     <*> ZipConduit (projectC _ItemGuid .| headC)     <*> ZipConduit (projectC _ItemPubDate .| headC)     <*> ZipConduit (projectC _ItemSource .| headC)-    <*> ZipConduit (projectC _ItemOther .| concatC .| parseRssItemExtensions)+    <*> ZipConduit (projectC _ItemOther .| concatC .| parseRssItemExtension)   piece = [ fmap ItemTitle <$> tagIgnoreAttrs "title" content           , fmap ItemLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)           , fmap ItemDescription <$> tagIgnoreAttrs "description" content@@ -247,7 +247,7 @@ -- | Parse an @\<rss\>@ element. -- -- RSS extensions are automatically parsed based on the inferred result type.-rssDocument :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (Maybe (RssDocument e))+rssDocument :: ParseRssExtension 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   parser version = getZipConduit $ RssDocument version     <$> ZipConduit (projectC _ChannelTitle .| headRequiredC "Missing <title> element")@@ -270,7 +270,7 @@     <*> ZipConduit (projectC _ChannelTextInput .| headC)     <*> ZipConduit (projectC _ChannelSkipHours .| headDefC mempty)     <*> ZipConduit (projectC _ChannelSkipDays .| headDefC mempty)-    <*> ZipConduit (projectC _ChannelOther .| concatC .| parseRssChannelExtensions)+    <*> ZipConduit (projectC _ChannelOther .| concatC .| parseRssChannelExtension)   piece = [ fmap ChannelTitle <$> tagIgnoreAttrs "title" content           , fmap ChannelLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)           , fmap ChannelDescription <$> tagIgnoreAttrs "description" content

@@ -40,7 +40,7 @@ -- }}}  -- | Render the top-level @\<rss\>@ element.-renderRssDocument :: Monad m => RenderRssExtensions e => RssDocument e -> ConduitT () Event m ()+renderRssDocument :: Monad m => RenderRssExtension e => RssDocument e -> ConduitT () Event m () renderRssDocument d = tag "rss" (attr "version" . pack . showVersion $ d^.documentVersionL) $   tag "channel" mempty $ do     textTag "title" $ d^.channelTitleL@@ -63,10 +63,10 @@     renderRssSkipHours $ d^.channelSkipHoursL     renderRssSkipDays $ d^.channelSkipDaysL     forM_ (d^..channelItemsL) renderRssItem-    renderRssChannelExtensions $ d^.channelExtensionsL+    renderRssChannelExtension $ d^.channelExtensionsL  -- | Render an @\<item\>@ element.-renderRssItem :: Monad m => RenderRssExtensions e => RssItem e -> ConduitT () Event m ()+renderRssItem :: Monad m => RenderRssExtension e => RssItem e -> ConduitT () Event m () renderRssItem i = tag "item" mempty $ do   optionalTextTag "title" $ i^.itemTitleL   forM_ (i^.itemLinkL) $ textTag "link" . renderRssURI@@ -78,7 +78,7 @@   forM_ (i^.itemGuidL) renderRssGuid   forM_ (i^.itemPubDateL) $ dateTag "pubDate"   forM_ (i^.itemSourceL) renderRssSource-  renderRssItemExtensions $ i^.itemExtensionsL+  renderRssItemExtension $ i^.itemExtensionsL  -- | Render a @\<source\>@ element. renderRssSource :: (Monad m) => RssSource -> ConduitT () Event m ()

@@ -1,5 +1,3 @@-{-# LANGUAGE ConstraintKinds     #-}-{-# LANGUAGE DataKinds           #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE RankNTypes          #-}@@ -8,25 +6,53 @@ {-# LANGUAGE TypeOperators       #-} -- | Support for RSS extensions. -- Cf specification at <http://web.resource.org/rss/1.0/modules/>.+--+-- To implement an RSS extension:+--+-- - Create a data-type, that will be used as a tag to identify the extension.+--   To allow stacking multiple extensions, your data-type should have kind * -> *+--+--   > data MyExtension otherExtensions = MyExtension otherExtensions+--+-- - Implement extension types for @\<channel\>@ and @\<item\>@ elements:+--+--   > data instance RssChannelExtension (MyExtension e) = MyExtensionChannel+--   >   { -- ... add your fields ...+--   >   , otherChannelExtensions :: RssChannelExtension e+--   >   }+--   >+--   > data instance RssItemExtension (MyExtension e) = MyExtensionItem+--   >   { -- ... add your fields ...+--   >   , otherItemExtensions :: RssItemExtension e+--   >   }+--+-- - Implement 'ParseRssExtension' and 'RenderRssExtension' type classes:+--+--   > -- Parser should rely on ZipConduit to be order-insensitive+--   > instance ParseRssExtension e => ParseRssExtension (MyExtension e) where+--   >   parseRssChannelExtension = getZipConduit $ MyExtensionChannel+--   >     <$> ZipConduit -- ... parse fields+--   >     <*> ZipConduit parseRssChannelExtension+--   >   parseRssItemExtension = -- ... similarly+--   >+--   > instance RenderRssExtension e => RenderRssExtension (MyExtension e) where+--   >   renderRssChannelExtension (MyExtensionChannel {- fields -} otherChannelExtensions) = do+--   >     -- ... render fields+--   >     renderRssChannelExtension otherChannelExtensions+--   >   renderRssItemExtension (MyExtensionItem {- fields -} otherItemExtensions) = -- ... similarly module Text.RSS.Extensions where  -- {{{ Imports-import           Control.Exception.Safe       as Exception+import           Control.Exception.Safe  as Exception import           Data.Conduit import           Data.Maybe import           Data.Proxy-import           Data.Singletons-import           Data.Singletons.Prelude.Bool-import           Data.Singletons.Prelude.Eq-import           Data.Singletons.Prelude.List import           Data.Text-import           Data.Vinyl.Core-import           Data.Vinyl.TypeLevel import           Data.XML.Types import           GHC.Generics import           Text.Atom.Conduit.Parse import           Text.Atom.Types-import           Text.Read                    (readMaybe)+import           Text.Read               (readMaybe) import           Text.RSS.Types import           Text.XML.Stream.Parse import           URI.ByteString@@ -43,28 +69,9 @@   -- Therefore, it is expected to ignore 'Event's unrelated to the RSS extension.   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 => ConduitT Event o m (RssChannelExtensions e)-parseRssChannelExtensions = f sing where-  f :: AllConstrained ParseRssExtension e => MonadThrow m-    => 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 => ConduitT Event o m (RssItemExtensions e)-parseRssItemExtensions = f sing where-  f :: AllConstrained ParseRssExtension e => MonadThrow m-    => Sing e -> ConduitT Event o m (RssItemExtensions e)-  f SNil = return $ RssItemExtensions RNil-  f (SCons _ es) = fmap RssItemExtensions $ getZipConduit $ (:&)-    <$> ZipConduit parseRssItemExtension-    <*> ZipConduit (rssItemExtension <$> f es)+instance ParseRssExtension NoExtensions where+  parseRssChannelExtension = pure NoChannelExtensions+  parseRssItemExtension = pure NoItemExtensions   -- * Rendering@@ -76,19 +83,6 @@   -- | Render extension for the @\<item\>@ element.   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 -> 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 -> ConduitT () Event m ()-renderRssItemExtensions (RssItemExtensions RNil) = pure ()-renderRssItemExtensions (RssItemExtensions (a :& t)) = do-  renderRssItemExtension a-  renderRssItemExtensions (RssItemExtensions t)+instance RenderRssExtension NoExtensions where+  renderRssChannelExtension = const $ pure ()+  renderRssItemExtension = const $ pure ()

@@ -1,8 +1,10 @@-{-# LANGUAGE DataKinds      #-}-{-# LANGUAGE DeriveGeneric  #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE RankNTypes     #-}-{-# LANGUAGE TypeFamilies   #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies       #-} -- | __Atom__ extension for RSS. -- Cf specification at <http://www.rssboard.org/rss-profile#namespace-elements-atom>. module Text.RSS.Extensions.Atom where@@ -11,8 +13,7 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                  (headC, (.|))-import           Data.Singletons+import           Conduit                  (ZipConduit (..), headC, (.|)) import           GHC.Generics import           Text.Atom.Conduit.Parse import           Text.Atom.Conduit.Render@@ -21,21 +22,44 @@ -- }}}  -- | __Atom__ tag type.-data AtomModule :: *+newtype AtomModule a = AtomModule a -data instance Sing AtomModule = SAtomModule+instance ParseRssExtension a => ParseRssExtension (AtomModule a) where+  parseRssChannelExtension = getZipConduit $ AtomChannel+    <$> ZipConduit (manyYield' atomLink .| headC)+    <*> ZipConduit parseRssChannelExtension+  parseRssItemExtension    = getZipConduit $ AtomItem+    <$> ZipConduit (manyYield' atomLink .| headC)+    <*> ZipConduit parseRssItemExtension -instance SingI AtomModule where sing = SAtomModule+instance RenderRssExtension a => RenderRssExtension (AtomModule a) where+  renderRssChannelExtension AtomChannel{..} = do+    mapM_ renderAtomLink channelAtomLink+    renderRssChannelExtension channelAtomOther+  renderRssItemExtension AtomItem{..}   = do+    mapM_ renderAtomLink itemAtomLink+    renderRssItemExtension itemAtomOther -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 a) = AtomChannel+  { channelAtomLink :: Maybe AtomLink+  , channelAtomOther :: RssChannelExtension a+  } -data instance RssChannelExtension AtomModule = AtomChannel { channelAtomLink :: Maybe AtomLink }-  deriving(Eq, Generic, Show)-data instance RssItemExtension AtomModule = AtomItem { itemAtomLink :: Maybe AtomLink }-  deriving(Eq, Generic, Show)+deriving instance Eq (RssChannelExtension a) => Eq (RssChannelExtension (AtomModule a))+deriving instance Ord (RssChannelExtension a) => Ord (RssChannelExtension (AtomModule a))+--deriving instance Read (RssChannelExtension a) => Read (RssChannelExtension (AtomModule a))+deriving instance Show (RssChannelExtension a) => Show (RssChannelExtension (AtomModule a))+deriving instance Generic (RssChannelExtension a) => Generic (RssChannelExtension (AtomModule a))+++data instance RssItemExtension (AtomModule a) = AtomItem+  { itemAtomLink :: Maybe AtomLink+  , itemAtomOther :: RssItemExtension a+  }++deriving instance Eq (RssItemExtension a) => Eq (RssItemExtension (AtomModule a))+deriving instance Ord (RssItemExtension a) => Ord (RssItemExtension (AtomModule a))+--deriving instance Read (RssItemExtension a) => Read (RssItemExtension (AtomModule a))+deriving instance Show (RssItemExtension a) => Show (RssItemExtension (AtomModule a))+deriving instance Generic (RssItemExtension a) => Generic (RssItemExtension (AtomModule a))

@@ -1,9 +1,10 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE KindSignatures    #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}-{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies       #-} -- | __Content__ extension for RSS. -- Cf specification at <http://web.resource.org/rss/1.0/modules/content/>. --@@ -26,11 +27,10 @@ import           Text.RSS.Extensions import           Text.RSS.Types -import           Conduit                (ConduitT, Source, headDefC, (.|))+import           Conduit                (ConduitT, Source, ZipConduit (..), headDefC, (.|)) import           Control.Exception.Safe as Exception import           Control.Monad import           Data.Maybe-import           Data.Singletons import           Data.Text              (Text) import qualified Data.Text              as Text import           Data.XML.Types@@ -41,23 +41,39 @@ -- }}}  -- | __Content__ tag type.-data ContentModule :: *+newtype ContentModule a = ContentModule a -data instance Sing ContentModule = SContentModule+instance ParseRssExtension a => ParseRssExtension (ContentModule a) where+  parseRssChannelExtension = parseRssChannelExtension+  parseRssItemExtension    = getZipConduit $ ContentItem+    <$> ZipConduit (manyYield' contentEncoded .| headDefC mempty)+    <*> ZipConduit parseRssItemExtension -instance SingI ContentModule where sing = SContentModule+instance RenderRssExtension a => RenderRssExtension (ContentModule a) where+  renderRssChannelExtension = renderRssChannelExtension+  renderRssItemExtension (ContentItem e a) = do+    unless (Text.null e) $ renderContentEncoded e+    renderRssItemExtension a -instance ParseRssExtension ContentModule where-  parseRssChannelExtension = pure ContentChannel-  parseRssItemExtension    = ContentItem <$> (manyYield' contentEncoded .| headDefC mempty)+data instance RssChannelExtension (ContentModule a) = ContentChannel (RssChannelExtension a) -instance RenderRssExtension ContentModule where-  renderRssChannelExtension = const $ pure ()-  renderRssItemExtension (ContentItem e) = unless (Text.null e) $ renderContentEncoded e+deriving instance Eq (RssChannelExtension a) => Eq (RssChannelExtension (ContentModule a))+deriving instance Ord (RssChannelExtension a) => Ord (RssChannelExtension (ContentModule a))+deriving instance Read (RssChannelExtension a) => Read (RssChannelExtension (ContentModule a))+deriving instance Show (RssChannelExtension a) => Show (RssChannelExtension (ContentModule a))+deriving instance Generic (RssChannelExtension a) => Generic (RssChannelExtension (ContentModule a)) -data instance RssChannelExtension ContentModule = ContentChannel deriving(Eq, Generic, Ord, Show)-data instance RssItemExtension ContentModule = ContentItem { itemContent :: Text }-  deriving(Eq, Generic, Ord, Show)+data instance RssItemExtension (ContentModule a) = ContentItem+  { itemContent :: Text+  , itemOther   :: RssItemExtension a+  }++deriving instance Eq (RssItemExtension a) => Eq (RssItemExtension (ContentModule a))+deriving instance Ord (RssItemExtension a) => Ord (RssItemExtension (ContentModule a))+deriving instance Read (RssItemExtension a) => Read (RssItemExtension (ContentModule a))+deriving instance Show (RssItemExtension a) => Show (RssItemExtension (ContentModule a))+deriving instance Generic (RssItemExtension a) => Generic (RssItemExtension (ContentModule a))+   -- | XML prefix is @content@.

@@ -1,11 +1,12 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE KindSignatures    #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}-{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-} -- | __Dublin Core__ extension for RSS. --  Cf specification at <http://web.resource.org/rss/1.0/modules/dc/>. module Text.RSS.Extensions.DublinCore@@ -27,7 +28,6 @@ import           Control.Monad import           Control.Monad.Fix import           Data.Maybe-import           Data.Singletons import           Data.Text                          (Text) import qualified Data.Text                          as Text import           Data.Time.Clock@@ -69,7 +69,7 @@   , elementSubject     :: Text   , elementTitle       :: Text   , elementType        :: Text-  } deriving(Eq, Generic, Ord, Show)+  } deriving(Eq, Generic, Ord, Read, Show)  -- | Construct an empty 'DcMetaData'. mkDcMetaData = DcMetaData mempty mempty mempty Nothing mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty@@ -140,22 +140,43 @@   -- | __Dublin Core__ tag type.-data DublinCoreModule :: *+newtype DublinCoreModule a = DublinCoreModule a -data instance Sing DublinCoreModule = SDublinCoreModule+instance ParseRssExtension a => ParseRssExtension (DublinCoreModule a) where+  parseRssChannelExtension = getZipConduit $ DublinCoreChannel+    <$> ZipConduit dcMetadata+    <*> ZipConduit parseRssChannelExtension+  parseRssItemExtension    = getZipConduit $ DublinCoreItem+    <$> ZipConduit dcMetadata+    <*> ZipConduit parseRssItemExtension -instance SingI DublinCoreModule where sing = SDublinCoreModule+instance RenderRssExtension a => RenderRssExtension (DublinCoreModule a) where+  renderRssChannelExtension DublinCoreChannel{..} = do+    renderDcMetadata channelDcMetaData+    renderRssChannelExtension channelDcOther+  renderRssItemExtension DublinCoreItem{..}   = do+    renderDcMetadata itemDcMetaData+    renderRssItemExtension itemDcOther -instance ParseRssExtension DublinCoreModule where-  parseRssChannelExtension = DublinCoreChannel <$> dcMetadata-  parseRssItemExtension    = DublinCoreItem <$> dcMetadata -instance RenderRssExtension DublinCoreModule where-  renderRssChannelExtension = renderDcMetadata . channelDcMetaData-  renderRssItemExtension    = renderDcMetadata . itemDcMetaData+data instance RssChannelExtension (DublinCoreModule a) = DublinCoreChannel+  { channelDcMetaData :: DcMetaData+  , channelDcOther    :: RssChannelExtension a+  } +deriving instance Eq (RssChannelExtension a) => Eq (RssChannelExtension (DublinCoreModule a))+deriving instance Ord (RssChannelExtension a) => Ord (RssChannelExtension (DublinCoreModule a))+deriving instance Read (RssChannelExtension a) => Read (RssChannelExtension (DublinCoreModule a))+deriving instance Show (RssChannelExtension a) => Show (RssChannelExtension (DublinCoreModule a))+deriving instance Generic (RssChannelExtension a) => Generic (RssChannelExtension (DublinCoreModule a)) -data instance RssChannelExtension DublinCoreModule = DublinCoreChannel { channelDcMetaData :: DcMetaData }-  deriving(Eq, Generic, Ord, Show)-data instance RssItemExtension DublinCoreModule = DublinCoreItem { itemDcMetaData :: DcMetaData }-  deriving(Eq, Generic, Ord, Show)+data instance RssItemExtension (DublinCoreModule a) = DublinCoreItem+  { itemDcMetaData :: DcMetaData+  , itemDcOther    :: RssItemExtension a+  }++deriving instance Eq (RssItemExtension a) => Eq (RssItemExtension (DublinCoreModule a))+deriving instance Ord (RssItemExtension a) => Ord (RssItemExtension (DublinCoreModule a))+deriving instance Read (RssItemExtension a) => Read (RssItemExtension (DublinCoreModule a))+deriving instance Show (RssItemExtension a) => Show (RssItemExtension (DublinCoreModule a))+deriving instance Generic (RssItemExtension a) => Generic (RssItemExtension (DublinCoreModule a))

@@ -1,11 +1,12 @@-{-# LANGUAGE DataKinds         #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE KindSignatures    #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes        #-}-{-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE TemplateHaskell   #-}-{-# LANGUAGE TypeFamilies      #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE FlexibleContexts   #-}+{-# LANGUAGE FlexibleInstances  #-}+{-# LANGUAGE OverloadedStrings  #-}+{-# LANGUAGE RankNTypes         #-}+{-# LANGUAGE RecordWildCards    #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell    #-}+{-# LANGUAGE TypeFamilies       #-} -- | __Syndication__ module for RSS. -- Cf specification at <http://web.resource.org/rss/1.0/modules/syndication/>. module Text.RSS.Extensions.Syndication@@ -42,7 +43,6 @@ import           Control.Monad import           Control.Monad.Fix import           Data.Maybe-import           Data.Singletons import           Data.Text import           Data.Time.Clock import           Data.Time.LocalTime@@ -181,21 +181,36 @@   -- | __Syndication__ tag type.-data SyndicationModule :: *+newtype SyndicationModule a = SyndicationModule a -data instance Sing SyndicationModule = SSyndicationModule+instance ParseRssExtension a => ParseRssExtension (SyndicationModule a) where+  parseRssChannelExtension = getZipConduit $ SyndicationChannel+    <$> ZipConduit syndicationInfo+    <*> ZipConduit parseRssChannelExtension+  parseRssItemExtension    = SyndicationItem <$> parseRssItemExtension -instance SingI SyndicationModule where sing = SSyndicationModule+instance RenderRssExtension a => RenderRssExtension (SyndicationModule a) where+  renderRssChannelExtension SyndicationChannel{..} = do+    renderSyndicationInfo channelSyndicationInfo+    renderRssChannelExtension channelSyndicationOther+  renderRssItemExtension (SyndicationItem a) = renderRssItemExtension a -instance ParseRssExtension SyndicationModule where-  parseRssChannelExtension = SyndicationChannel <$> syndicationInfo-  parseRssItemExtension    = pure SyndicationItem -instance RenderRssExtension SyndicationModule where-  renderRssChannelExtension = renderSyndicationInfo . channelSyndicationInfo-  renderRssItemExtension    = const $ pure ()+data instance RssChannelExtension (SyndicationModule a) = SyndicationChannel+  { channelSyndicationInfo  :: SyndicationInfo+  , channelSyndicationOther :: RssChannelExtension a+  } +deriving instance Eq (RssChannelExtension a) => Eq (RssChannelExtension (SyndicationModule a))+deriving instance Ord (RssChannelExtension a) => Ord (RssChannelExtension (SyndicationModule a))+deriving instance Read (RssChannelExtension a) => Read (RssChannelExtension (SyndicationModule a))+deriving instance Show (RssChannelExtension a) => Show (RssChannelExtension (SyndicationModule a))+deriving instance Generic (RssChannelExtension a) => Generic (RssChannelExtension (SyndicationModule a)) -data instance RssChannelExtension SyndicationModule = SyndicationChannel { channelSyndicationInfo :: SyndicationInfo}-  deriving (Eq, Generic, Ord, Read, Show)-data instance RssItemExtension SyndicationModule = SyndicationItem deriving (Eq, Generic, Ord, Read, Show)+data instance RssItemExtension (SyndicationModule a) = SyndicationItem (RssItemExtension a)++deriving instance Eq (RssItemExtension a) => Eq (RssItemExtension (SyndicationModule a))+deriving instance Ord (RssItemExtension a) => Ord (RssItemExtension (SyndicationModule a))+deriving instance Read (RssItemExtension a) => Read (RssItemExtension (SyndicationModule a))+deriving instance Show (RssItemExtension a) => Show (RssItemExtension (SyndicationModule a))+deriving instance Generic (RssItemExtension a) => Generic (RssItemExtension (SyndicationModule a))

@@ -5,8 +5,6 @@ -- {{{ Imports import           Text.RSS.Types -import           Data.Vinyl.Lens-import           Data.Vinyl.TypeLevel import           Lens.Simple import           URI.ByteString -- }}}@@ -31,10 +29,6 @@ itemEnclosureL inj a@RssItem { itemEnclosure = e } = (\x -> a { itemEnclosure = e }) <$> traverse inj e {-# INLINE itemEnclosureL #-} -itemExtensionL :: RElem a e (RIndex a e) => Lens' (RssItem e) (RssItemExtension a)-itemExtensionL = itemExtensionsL . f . rlens where-  f inj (RssItemExtensions a) = RssItemExtensions <$> inj a-{-# INLINE itemExtensionL #-}  $(makeLensesBy (\n -> Just (n ++ "L")) ''RssTextInput) $(makeLensesBy (\n -> Just (n ++ "L")) ''RssCloud)@@ -53,8 +47,3 @@ channelCategoriesL :: Traversal' (RssDocument e) RssCategory channelCategoriesL inj a@RssDocument { channelCategories = c } = (\x -> a { channelCategories = c }) <$> traverse inj c {-# INLINE channelCategoriesL #-}--channelExtensionL :: RElem a e (RIndex a e) => Lens' (RssDocument e) (RssChannelExtension a)-channelExtensionL = channelExtensionsL . f . rlens where-  f inj (RssChannelExtensions a) = RssChannelExtensions <$> inj a-{-# INLINE channelExtensionL #-}

@@ -42,13 +42,11 @@ import           Control.Exception.Safe import           Data.Semigroup import           Data.Set-import           Data.Singletons.Prelude.List-import           Data.Text                    (Text, unpack)+import           Data.Text              (Text, unpack) import           Data.Time.Clock-import           Data.Time.LocalTime          ()+import           Data.Time.LocalTime    () import           Data.Version-import           Data.Vinyl.Core-import           GHC.Generics                 hiding ((:+:))+import           GHC.Generics           hiding ((:+:)) import           Text.Read import           URI.ByteString -- }}}@@ -148,7 +146,7 @@ -- | The @\<item\>@ element. -- -- This type is open to extensions.-data RssItem (extensions :: [*]) = RssItem+data RssItem extensions = RssItem   { itemTitle       :: Text   , itemLink        :: Maybe RssURI   , itemDescription :: Text@@ -159,16 +157,16 @@   , itemGuid        :: Maybe RssGuid   , itemPubDate     :: Maybe UTCTime   , itemSource      :: Maybe RssSource-  , itemExtensions  :: RssItemExtensions extensions+  , itemExtensions  :: RssItemExtension extensions   } -deriving instance (Eq (RssItemExtensions e)) => Eq (RssItem e)-deriving instance (Generic (RssItemExtensions e)) => Generic (RssItem e)-deriving instance (Ord (RssItemExtensions e)) => Ord (RssItem e)-deriving instance (Show (RssItemExtensions e)) => Show (RssItem e)+deriving instance (Eq (RssItemExtension e)) => Eq (RssItem e)+deriving instance (Generic (RssItemExtension e)) => Generic (RssItem e)+deriving instance (Ord (RssItemExtension e)) => Ord (RssItem e)+deriving instance (Show (RssItemExtension e)) => Show (RssItem e)  -- | Alias for 'RssItem' with no RSS extensions.-type RssItem' = RssItem '[]+type RssItem' = RssItem NoExtensions  -- | The @\<textInput\>@ element. data RssTextInput = RssTextInput@@ -242,7 +240,7 @@ -- | The @\<rss\>@ element. -- -- This type is open to extensions.-data RssDocument (extensions :: [*]) = RssDocument+data RssDocument extensions = RssDocument   { documentVersion       :: Version   , channelTitle          :: Text   , channelLink           :: RssURI@@ -264,32 +262,18 @@   , channelTextInput      :: Maybe RssTextInput   , channelSkipHours      :: Set Hour   , channelSkipDays       :: Set Day-  , channelExtensions     :: RssChannelExtensions extensions+  , channelExtensions     :: RssChannelExtension extensions   } -deriving instance (Eq (RssChannelExtensions e), Eq (RssItemExtensions e)) => Eq (RssDocument e)-deriving instance (Generic (RssChannelExtensions e), Generic (RssItemExtensions e)) => Generic (RssDocument e)-deriving instance (Ord (RssChannelExtensions e), Ord (RssItemExtensions e)) => Ord (RssDocument e)-deriving instance (Show (RssChannelExtensions e), Show (RssItemExtensions e)) => Show (RssDocument e)+deriving instance (Eq (RssChannelExtension e), Eq (RssItemExtension e)) => Eq (RssDocument e)+deriving instance (Generic (RssChannelExtension e), Generic (RssItemExtension e)) => Generic (RssDocument e)+deriving instance (Ord (RssChannelExtension e), Ord (RssItemExtension e)) => Ord (RssDocument e)+deriving instance (Show (RssChannelExtension e), Show (RssItemExtension e)) => Show (RssDocument e)  -- | Alias for 'RssDocument' with no RSS extensions.-type RssDocument' = RssDocument '[]+type RssDocument' = RssDocument NoExtensions  -- * RSS extensions------ $doc--- To implement an RSS extension:------ - Create a void data-type, that will be used as a tag to identify the extension:------   > data MyExtension :: *------ - Implement extension types for @\<channel\>@ and @\<item\>@ elements:------   > data instance RssChannelExtension MyExtension = MyExtensionChannel { {- ... fields -} }---   > data instance RssItemExtension MyExtension = MyExtensionItem { {- ... fields -} }------ - Implement corresponding parsers (cf "Text.RSS.Extensions").  -- | @\<channel\>@ extension type. data family RssChannelExtension extensionTag :: *@@ -297,22 +281,11 @@ -- | @\<item\>@ extension type. data family RssItemExtension extensionTag :: * --- | Combination of multiple @\<channel\>@ extensions.-data family RssChannelExtensions (extensionTags :: [*]) :: *-data instance RssChannelExtensions a = RssChannelExtensions { rssChannelExtension :: Rec RssChannelExtension a }--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.-data family RssItemExtensions (extensionTags :: [*]) :: *-data instance RssItemExtensions (a :: [*]) = RssItemExtensions { rssItemExtension :: Rec RssItemExtension a }+-- | Trivial extension type that parses/renders nothing.+data NoExtensions = NoExtensions+  deriving(Eq, Generic, Ord, Read, Show) -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)+data instance RssChannelExtension NoExtensions = NoChannelExtensions+  deriving(Eq, Generic, Ord, Read, Show)+data instance RssItemExtension NoExtensions = NoItemExtensions+  deriving(Eq, Generic, Ord, Read, Show)

@@ -19,20 +19,18 @@ 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.Conduit import           Data.List.NonEmpty-import           Data.Singletons.Prelude-import           Data.Text               as Text+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.Vinyl.Core import           Data.XML.Types import           Lens.Simple import           Text.XML.Stream.Parse@@ -121,7 +119,7 @@ -- | Parse an @\<item\>@ element. -- -- RSS extensions are automatically parsed based on the inferred result type.-rss1Item :: ParseRssExtensions e => MonadCatch m => ConduitM Event o m (Maybe (RssItem e))+rss1Item :: ParseRssExtension e => MonadCatch m => ConduitM Event o m (Maybe (RssItem e)) rss1Item = rss1Tag "item" attributes $ \uri -> (manyYield' (choose piece) .| parser uri) <* many ignoreAnyTreeContent where   parser uri = getZipConduit $ RssItem     <$> ZipConduit (projectC _ItemTitle .| headDefC mempty)@@ -134,7 +132,7 @@     <*> pure mzero     <*> ZipConduit (projectC _ItemDate .| headC)     <*> pure mzero-    <*> ZipConduit (projectC _ItemOther .| concatC .| parseRssItemExtensions)+    <*> ZipConduit (projectC _ItemOther .| concatC .| parseRssItemExtension)   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))@@ -172,7 +170,7 @@   attributes = requireAttr (rdfName "resource") <* ignoreAttrs  -data Rss1Channel (extensions :: [*]) = Rss1Channel+data Rss1Channel extensions = Rss1Channel   { channelId'          :: RssURI   , channelTitle'       :: Text   , channelLink'        :: RssURI@@ -180,7 +178,7 @@   , channelItems'       :: [Text]   , channelImage'       :: Maybe RssImage   , channelTextInput'   :: Maybe RssURI-  , channelExtensions'  :: RssChannelExtensions extensions+  , channelExtensions'  :: RssChannelExtension extensions   }  data ChannelPiece = ChannelTitle Text@@ -197,7 +195,7 @@ -- | Parse a @\<channel\>@ element. -- -- RSS extensions are automatically parsed based on the inferred result type.-rss1Channel :: ParseRssExtensions e => MonadThrow m => ConduitM Event o m (Maybe (Rss1Channel e))+rss1Channel :: ParseRssExtension e => MonadThrow m => ConduitM Event o m (Maybe (Rss1Channel e)) 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")@@ -206,7 +204,7 @@     <*> ZipConduit (projectC _ChannelItems .| concatC .| sinkList)     <*> ZipConduit (projectC _ChannelImage .| headC)     <*> ZipConduit (projectC _ChannelTextInput .| headC)-    <*> ZipConduit (projectC _ChannelOther .| concatC .| parseRssChannelExtensions)+    <*> ZipConduit (projectC _ChannelOther .| concatC .| parseRssChannelExtension)   piece = [ fmap ChannelTitle <$> rss1Tag "title" ignoreAttrs (const content)           , fmap ChannelLink <$> rss1Tag "link" ignoreAttrs (const $ content >>= asRssURI)           , fmap ChannelDescription <$> rss1Tag "description" ignoreAttrs (const content)@@ -218,7 +216,7 @@   attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs  -data Rss1Document (e :: [*]) = Rss1Document (Rss1Channel e) (Maybe RssImage) [RssItem e] (Maybe RssTextInput)+data Rss1Document e = Rss1Document (Rss1Channel e) (Maybe RssImage) [RssItem e] (Maybe RssTextInput)  rss1ToRss2 :: Rss1Document e -> RssDocument e rss1ToRss2 (Rss1Document channel image items textInput) = RssDocument@@ -245,7 +243,7 @@   mempty   (channelExtensions' channel) -data DocumentPiece (e :: [*]) = DocumentChannel (Rss1Channel e)+data DocumentPiece e = DocumentChannel (Rss1Channel e)   | DocumentImage RssImage   | DocumentItem (RssItem e)   | DocumentTextInput RssTextInput@@ -256,7 +254,7 @@ -- | Parse an @\<RDF\>@ element. -- -- RSS extensions are automatically parsed based on the inferred result type.-rss1Document :: ParseRssExtensions e => MonadCatch m => ConduitM Event o m (Maybe (RssDocument e))+rss1Document :: ParseRssExtension 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   parser = getZipConduit $ Rss1Document     <$> ZipConduit (projectC _DocumentChannel .| headRequiredC "Missing <channel> element")

@@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds         #-}+{-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs             #-} -- | 'Arbitrary' instances used by RSS types.@@ -14,14 +15,10 @@ import           Data.ByteString                 (ByteString) import           Data.Char import           Data.Maybe-import           Data.MonoTraversable            (Element)-import           Data.NonNull-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       ()@@ -99,7 +96,7 @@ instance Arbitrary RssImage where   arbitrary = RssImage <$> arbitrary <*> (pack <$> listOf genAlphaNum) <*> arbitrary <*> fmap (fmap abs) arbitrary <*> fmap (fmap abs) arbitrary <*> (pack <$> listOf genAlphaNum) -instance Arbitrary (RssItem '[]) where+instance Arbitrary (RssItem NoExtensions) where   arbitrary = RssItem     <$> (pack <$> listOf genAlphaNum)     <*> arbitrary@@ -111,7 +108,7 @@     <*> arbitrary     <*> oneof [Just <$> genTime, pure Nothing]     <*> arbitrary-    <*> pure (RssItemExtensions RNil)+    <*> pure NoItemExtensions  instance Arbitrary RssSource where   arbitrary = RssSource <$> arbitrary <*> (pack <$> listOf genAlphaNum)@@ -119,7 +116,7 @@ instance Arbitrary RssTextInput where   arbitrary = RssTextInput <$> (pack <$> listOf genAlphaNum) <*> (pack <$> listOf genAlphaNum) <*> (pack <$> listOf genAlphaNum) <*> arbitrary -instance Arbitrary (RssDocument '[]) where+instance Arbitrary (RssDocument NoExtensions) where   arbitrary = RssDocument     <$> arbitrary     <*> arbitrary@@ -142,7 +139,7 @@     <*> arbitrary     <*> arbitrary     <*> arbitrary-    <*> pure (RssChannelExtensions RNil)+    <*> pure NoChannelExtensions  instance Arbitrary Day where   arbitrary = arbitraryBoundedEnum@@ -166,6 +163,12 @@   shrink (RssURI a@URI{})         = RssURI <$> shrink a   shrink (RssURI a@RelativeRef{}) = RssURI <$> shrink a +instance Arbitrary (RssChannelExtension NoExtensions) where+  arbitrary = pure NoChannelExtensions++instance Arbitrary (RssItemExtension NoExtensions) where+  arbitrary = pure NoItemExtensions+ instance Arbitrary DcMetaData where   arbitrary = DcMetaData     <$> arbitrary@@ -184,8 +187,8 @@     <*> arbitrary     <*> arbitrary -instance Arbitrary (RssChannelExtension DublinCoreModule) where-  arbitrary = DublinCoreChannel <$> arbitrary+instance Arbitrary (RssChannelExtension a) => Arbitrary (RssChannelExtension (DublinCoreModule a)) where+  arbitrary = DublinCoreChannel <$> arbitrary <*> arbitrary  instance Arbitrary SyndicationPeriod where   arbitrary = arbitraryBoundedEnum@@ -197,8 +200,8 @@     <*> arbitrary     <*> oneof [Just <$> genTime, pure Nothing] -instance Arbitrary (RssChannelExtension SyndicationModule) where-  arbitrary = SyndicationChannel <$> arbitrary+instance Arbitrary (RssChannelExtension a) => Arbitrary (RssChannelExtension (SyndicationModule a)) where+  arbitrary = SyndicationChannel <$> arbitrary <*> arbitrary  instance Arbitrary AtomURI where   arbitrary = oneof [AtomURI <$> (arbitrary :: Gen (URIRef Absolute)), AtomURI <$> (arbitrary :: Gen (URIRef Relative))]@@ -206,8 +209,8 @@ instance Arbitrary AtomLink where   arbitrary = AtomLink <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary -instance Arbitrary (RssChannelExtension AtomModule) where-  arbitrary = AtomChannel <$> arbitrary+instance Arbitrary (RssChannelExtension a) => Arbitrary (RssChannelExtension (AtomModule a)) where+  arbitrary = AtomChannel <$> arbitrary <*> arbitrary -instance Arbitrary (RssItemExtension ContentModule) where-  arbitrary = ContentItem <$> arbitrary+instance Arbitrary (RssItemExtension a) => Arbitrary (RssItemExtension (ContentModule a)) where+  arbitrary = ContentItem <$> arbitrary <*> arbitrary

@@ -4,7 +4,6 @@ {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE QuasiQuotes         #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications    #-} -- {{{ Imports import           Text.RSS.Conduit.Parse          as Parser import           Text.RSS.Conduit.Render         as Renderer@@ -17,8 +16,6 @@ import           Text.RSS.Types 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@@ -28,15 +25,11 @@ import           Data.Conduit.List import           Data.Default import           Data.Maybe-import           Data.Singletons.Prelude.List import           Data.String-import           Data.Text                       (Text)-import           Data.Text.Encoding-import qualified Data.Text.Lazy.Encoding      as Lazy-import           Data.Time.Calendar+import qualified Data.Text.Lazy.Encoding         as Lazy+import           Data.Time.Calendar              hiding (DayOfWeek (..)) import           Data.Time.LocalTime import           Data.Version-import           Data.Vinyl.Core import           Data.Void import           Data.XML.Types import           Lens.Simple@@ -44,9 +37,8 @@ import           System.IO import           System.Timeout import           Test.Tasty-import           Test.Tasty.Golden            (findByExtension, goldenVsString)+import           Test.Tasty.Golden               (findByExtension, goldenVsString) import           Test.Tasty.HUnit-import           Test.Tasty.QuickCheck import           Text.Atom.Conduit.Parse import           Text.Atom.Types import           Text.XML.Stream.Parse           as XML hiding (choose)@@ -61,7 +53,6 @@   defaultMain $ testGroup "Tests"     [ unitTests     , goldenTests-    , properties     ]  unitTests :: TestTree@@ -98,45 +89,11 @@     xmlFile <- xmlFiles     let goldenFile = addExtension xmlFile ".golden"         f file = fmap (Lazy.encodeUtf8 . fromString . show) $ runResourceT $ runConduit $ sourceFile file .| Conduit.decodeUtf8C .| XML.parseText' def .| parser-        parser = rssDocument :: MonadThrow m => ConduitM Event o m (Maybe (RssDocument '[]))+        parser = rssDocument :: MonadThrow m => ConduitM Event o m (Maybe (RssDocument NoExtensions))      return $ goldenVsString xmlFile goldenFile $ f xmlFile -properties :: TestTree-properties = testGroup "Properties"-  [ 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 '[] -> ConduitT () Event Maybe ())-      rssItem-  , roundtripProperty "DublinCore"-      (renderRssChannelExtension @DublinCoreModule)-      (Just <$> parseRssChannelExtension)-  , roundtripProperty "Syndication"-      (renderRssChannelExtension @SyndicationModule)-      (Just <$> parseRssChannelExtension)-  , roundtripProperty "Atom"-      (renderRssChannelExtension @AtomModule)-      (Just <$> parseRssChannelExtension)-  , roundtripProperty "Content"-      (renderRssItemExtension @ContentModule)-      (Just <$> parseRssItemExtension)-  ] --roundtripProperty :: Eq a => Arbitrary a => Show a-                  => 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-  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@@ -279,7 +236,7 @@   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."-  result^.itemExtensionsL @?= RssItemExtensions RNil+  result^.itemExtensionsL @?= NoItemExtensions   where input = [ "<item xmlns=\"http://purl.org/rss/1.0/\""                 , "xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\""                 , "xmlns:dc=\"http://purl.org/dc/elements/1.1/\""@@ -302,7 +259,7 @@   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+  result^.itemExtensionsL @?= NoItemExtensions   isJust (result^.itemPubDateL) @?= True   where input = [ "<item>"                 , "<title>Example entry</title>"@@ -324,7 +281,7 @@   result^.itemDescriptionL @?= ""   result^.itemAuthorL @?= "author@w3schools.com"   result^.itemGuidL @?= Nothing-  result^.itemExtensionsL @?= RssItemExtensions RNil+  result^.itemExtensionsL @?= NoItemExtensions   isJust (result^.itemPubDateL) @?= True   where input = [ "<item>"                 , "<title>Plop</title>"@@ -364,7 +321,7 @@   result^?channelTextInputL._Just.textInputDescriptionL @?= Just "Search XML.com's XML collection"   result^?channelTextInputL._Just.textInputNameL @?= Just "s"   result^?channelTextInputL._Just.textInputLinkL @?= Just textInputLink-  result^.channelExtensionsL @?= RssChannelExtensions RNil+  result^.channelExtensionsL @?= NoChannelExtensions   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\">"@@ -411,7 +368,7 @@ dublinCoreChannelCase :: TestTree dublinCoreChannelCase = testCase "Dublin Core <channel> extension" $ do   Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument-  result^.channelExtensionsL @?= RssChannelExtensions (DublinCoreChannel dublinCoreElement :& RNil)+  result^.channelExtensionsL @?= DublinCoreChannel dublinCoreElement NoChannelExtensions   where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"                 , "<rss xmlns:dc=\"http://purl.org/dc/elements/1.1/\" version=\"2.0\">"                 , "<channel>"@@ -439,7 +396,7 @@ dublinCoreItemCase :: TestTree dublinCoreItemCase = testCase "Dublin Core <item> extension" $ do   Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem-  result^.itemExtensionsL @?= RssItemExtensions (DublinCoreItem dublinCoreElement :& RNil)+  result^.itemExtensionsL @?= DublinCoreItem dublinCoreElement NoItemExtensions   where input = [ "<item xmlns:dc=\"http://purl.org/dc/elements/1.1/\">"                 , "<title>Example entry</title>"                 , "<dc:description>XML is placing increasingly heavy loads on the existing technical "@@ -466,7 +423,7 @@ contentItemCase :: TestTree contentItemCase = testCase "Content <item> extension" $ do   Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssItem-  result^.itemExtensionsL @?= RssItemExtensions (ContentItem "<p>What a <em>beautiful</em> day!</p>" :& RNil)+  result^.itemExtensionsL @?= ContentItem "<p>What a <em>beautiful</em> day!</p>" NoItemExtensions   where input = [ "<item xmlns:content=\"http://purl.org/rss/1.0/modules/content/\">"                 , "<title>Example entry</title>"                 , "<content:encoded><![CDATA[<p>What a <em>beautiful</em> day!</p>]]></content:encoded>"@@ -476,7 +433,7 @@ syndicationChannelCase :: TestTree syndicationChannelCase = testCase "Syndication <channel> extension" $ do   Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument-  result^.channelExtensionsL @?= RssChannelExtensions (SyndicationChannel syndicationInfo :& RNil)+  result^.channelExtensionsL @?= SyndicationChannel syndicationInfo NoChannelExtensions   where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"                 , "<rss xmlns:sy=\"http://purl.org/rss/1.0/modules/syndication/\" version=\"2.0\">"                 , "<channel>"@@ -498,7 +455,7 @@ atomChannelCase :: TestTree atomChannelCase = testCase "Atom <channel> extension" $ do   Just result <- runResourceT . runConduit $ sourceList input .| XML.parseText' def .| rssDocument-  result^.channelExtensionsL @?= RssChannelExtensions (AtomChannel (Just link) :& RNil)+  result^.channelExtensionsL @?= AtomChannel (Just link) NoChannelExtensions   where input = [ "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>"                 , "<rss xmlns:atom=\"http://www.w3.org/2005/Atom\" version=\"2.0\">"                 , "<channel>"@@ -514,7 +471,7 @@ multipleExtensionsCase :: TestTree multipleExtensionsCase = testCase "Multiple extensions" $ do   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)+  result^.itemExtensionsL @?= ContentItem "<p>What a <em>beautiful</em> day!</p>" (AtomItem (Just link) NoItemExtensions)   where input = [ "<item xmlns:content=\"http://purl.org/rss/1.0/modules/content/\""                 , " xmlns:atom=\"http://www.w3.org/2005/Atom\">"                 , "<title>Example entry</title>"@@ -524,30 +481,3 @@                 ]         url = AtomURI [uri|http://dallas.example.com/rss.xml|]         link = AtomLink url "self" "application/rss+xml" mempty mempty mempty---roundtripTextInputProperty :: TestTree-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)--roundtripCategoryProperty :: TestTree-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)--roundtripSourceProperty :: TestTree-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)--roundtripItemProperty :: TestTree-roundtripItemProperty = testProperty "parse . render = id (RssItem)" $ \(t :: RssItem '[]) -> either (const False) (t ==) (runConduit $ renderRssItem t .| force "ERROR" rssItem)---letter = choose ('a', 'z')-digit = arbitrary `suchThat` isDigit-alphaNum = oneof [letter, digit]

@@ -0,0 +1,104 @@+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE OverloadedLists     #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications    #-}+-- {{{ Imports+import           Text.RSS.Conduit.Parse          as Parser+import           Text.RSS.Conduit.Render         as Renderer+import           Text.RSS.Extensions+import           Text.RSS.Extensions.Atom+import           Text.RSS.Extensions.Content+import           Text.RSS.Extensions.DublinCore+import           Text.RSS.Extensions.Syndication+import           Text.RSS.Lens+import           Text.RSS.Types+import           Text.RSS1.Conduit.Parse         as Parser++import           Arbitrary+import           Blaze.ByteString.Builder        (toByteString)+import           Conduit+import           Control.Monad+import           Data.Char+import           Data.Conduit+import           Data.Conduit.List+import           Data.Maybe+import           Data.String+import           Data.Text                       (Text)+import           Data.Text.Encoding+import qualified Data.Text.Lazy.Encoding         as Lazy+import           Data.Time.Calendar+import           Data.Time.LocalTime+import           Data.Version+import           Data.Void+import           Data.XML.Types+import           Prelude                         ()+import           Prelude.Compat+import           System.FilePath+import           System.IO+import           System.Timeout+import           Test.Tasty+import           Test.Tasty.QuickCheck+import           Text.Atom.Conduit.Parse+import           Text.Atom.Types+import           Text.XML.Stream.Parse           as XML hiding (choose)+import           Text.XML.Stream.Render+import           URI.ByteString+import           URI.ByteString.QQ+-- }}}++main :: IO ()+main = defaultMain $ testGroup "Property tests"+  [ 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 '[] -> ConduitT () Event Maybe ())+--       rssItem+  , roundtripProperty "DublinCore"+      (renderRssChannelExtension @(DublinCoreModule NoExtensions))+      (Just <$> parseRssChannelExtension)+  , roundtripProperty "Syndication"+      (renderRssChannelExtension @(SyndicationModule NoExtensions))+      (Just <$> parseRssChannelExtension)+  , roundtripProperty "Atom"+      (renderRssChannelExtension @(AtomModule NoExtensions))+      (Just <$> parseRssChannelExtension)+  , roundtripProperty "Content"+      (renderRssItemExtension @(ContentModule NoExtensions))+      (Just <$> parseRssItemExtension)+  ]+++roundtripProperty :: Eq a => Arbitrary a => Show a+                  => 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+  return $ counterexample (show input <> " | " <> show intermediate <> " | " <> show output) $ Just input == output++roundtripTextInputProperty :: TestTree+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)++roundtripCategoryProperty :: TestTree+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)++roundtripSourceProperty :: TestTree+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)++roundtripItemProperty :: TestTree+roundtripItemProperty = testProperty "parse . render = id (RssItem)" $ \(t :: RssItem NoExtensions) -> either (const False) (t ==) (runConduit $ renderRssItem t .| force "ERROR" rssItem)