rss-conduit 0.5.1.1 → 0.6.0.0

raw patch · 9 files changed

+230/−191 lines, 9 filesdep +microlensdep +microlens-thdep +template-haskelldep −lens-simpledep ~xml-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: microlens, microlens-th, template-haskell

Dependencies removed: lens-simple

Dependency ranges changed: xml-conduit

API changes (from Hackage documentation)

Files

• rss-conduit.cabal +7/−3
• src/Text/RSS/Conduit/Parse.hs +92/−65
• src/Text/RSS/Conduit/Render.hs +6/−5
• src/Text/RSS/Extensions/DublinCore.hs +34/−23
• src/Text/RSS/Extensions/Syndication.hs +10/−7
• src/Text/RSS/Lens.hs +10/−39
• src/Text/RSS/Lens/Rules.hs +12/−0
• src/Text/RSS1/Conduit/Parse.hs +57/−47
• test/Main.hs +2/−2

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: rss-conduit-version: 0.5.1.1+version: 0.6.0.0 build-type: Simple license: CC0-1.0 license-file: LICENSE@@ -42,6 +42,8 @@         Text.RSS.Extensions.Syndication         Text.RSS.Lens         Text.RSS.Types+    other-modules:+        Text.RSS.Lens.Rules     build-depends:         atom-conduit >=0.5,         conduit >= 1.3,@@ -49,9 +51,11 @@         containers -any,         dublincore-xml-conduit -any,         safe-exceptions -any,-        lens-simple -any,+        microlens -any,+        microlens-th -any,         safe -any,         text -any,+        template-haskell -any,         time >=1.5,         timerep >=2.0,         uri-bytestring >=0.2,@@ -73,7 +77,7 @@         data-default -any,         dublincore-xml-conduit -any,         filepath -any,-        lens-simple -any,+        microlens -any,         mono-traversable -any,         resourcet -any,         safe-exceptions -any,

@@ -44,7 +44,8 @@ import           Data.Time.RFC822 import           Data.Version import           Data.XML.Types-import           Lens.Simple+import           Lens.Micro+import           Lens.Micro.TH import           Safe import           Text.ParserCombinators.ReadP (readP_to_S) import           Text.Read                    (readMaybe)@@ -73,7 +74,7 @@ asBool t       = throwM $ InvalidBool t  asVersion :: MonadThrow m => Text -> m Version-asVersion t = maybe (throwM $ InvalidVersion t) return . fmap fst . headMay . readP_to_S parseVersion $ unpack t+asVersion t = maybe (throwM $ InvalidVersion t) (return . fst) . headMay . readP_to_S parseVersion $ unpack t  asCloudProtocol :: MonadThrow m => Text -> m CloudProtocol asCloudProtocol "xml-rpc"   = return ProtocolXmlRpc@@ -94,7 +95,7 @@ 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' -> ConduitT a b m ()+projectC :: Monad m => Traversal' a b -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -115,19 +116,21 @@   fromList <$> (manyYield' (tagIgnoreAttrs "day" $ content >>= asDay) .| sinkList)  -data TextInputPiece = TextInputTitle Text | TextInputDescription Text-                    | TextInputName Text | TextInputLink RssURI+data TextInputPiece = TextInputTitle { __textInputTitle :: Text }+                    | TextInputDescription { __textInputDescription :: Text }+                    | TextInputName { __textInputName :: Text }+                    | TextInputLink { __textInputLink :: RssURI } -makeTraversals ''TextInputPiece+makeLenses ''TextInputPiece  -- | Parse a @\<textInput\>@ element. rssTextInput :: MonadThrow m => ConduitM Event o m (Maybe RssTextInput) 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@@ -136,21 +139,25 @@   -data ImagePiece = ImageUri RssURI | ImageTitle Text | ImageLink RssURI | ImageWidth Int-                | ImageHeight Int | ImageDescription Text+data ImagePiece = ImageUri { __imageUri :: RssURI }+                | ImageTitle { __imageTitle :: Text }+                | ImageLink { __imageLink :: RssURI }+                | ImageWidth { __imageWidth :: Int }+                | ImageHeight { __imageHeight :: Int }+                | ImageDescription { __imageDescription :: Text } -makeTraversals ''ImagePiece+makeLenses ''ImagePiece  -- | Parse an @\<image\>@ element. rssImage :: (MonadThrow m) => ConduitM Event o m (Maybe RssImage) 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)@@ -195,12 +202,19 @@   handler uri = RssSource uri <$> content  -data ItemPiece = ItemTitle Text | ItemLink RssURI | ItemDescription Text-               | ItemAuthor Text | ItemCategory RssCategory | ItemComments RssURI-               | ItemEnclosure RssEnclosure | ItemGuid RssGuid | ItemPubDate UTCTime-               | ItemSource RssSource | ItemOther (NonEmpty Event)+data ItemPiece = ItemTitle { __itemTitle :: Text }+               | ItemLink { __itemLink :: RssURI }+               | ItemDescription { __itemDescription :: Text }+               | ItemAuthor { __itemAuthor :: Text }+               | ItemCategory { __itemCategory :: RssCategory }+               | ItemComments { __itemComments :: RssURI }+               | ItemEnclosure { __itemEnclosure :: RssEnclosure }+               | ItemGuid { __itemGuid :: RssGuid }+               | ItemPubDate { __itemPubDate :: UTCTime }+               | ItemSource { __itemSource :: RssSource }+               | ItemOther { __itemOther :: NonEmpty Event } -makeTraversals ''ItemPiece+makeLenses ''ItemPiece  -- | Parse an @\<item\>@ element. --@@ -208,17 +222,17 @@ 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 "")-    <*> 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 .| parseRssItemExtension)+    <$> 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 .| parseRssItemExtension)   piece = [ fmap ItemTitle <$> tagIgnoreAttrs "title" content           , fmap ItemLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)           , fmap ItemDescription <$> tagIgnoreAttrs "description" content@@ -233,16 +247,29 @@           ]  -data ChannelPiece e = ChannelTitle Text | ChannelLink RssURI | ChannelDescription Text-                    | ChannelItem (RssItem e) | ChannelLanguage Text | ChannelCopyright Text-                    | ChannelManagingEditor Text | ChannelWebmaster Text | ChannelPubDate UTCTime-                    | ChannelLastBuildDate UTCTime | ChannelCategory RssCategory-                    | ChannelGenerator Text | ChannelDocs RssURI | ChannelCloud RssCloud-                    | ChannelTtl Int | ChannelImage RssImage | ChannelRating Text-                    | ChannelTextInput RssTextInput | ChannelSkipHours (Set Hour)-                    | ChannelSkipDays (Set Day) | ChannelOther (NonEmpty Event)+data ChannelPiece e = ChannelTitle { __channelTitle :: Text }+                    | ChannelLink { __channelLink :: RssURI }+                    | ChannelDescription { __channelDescription :: Text }+                    | ChannelItem { __channelItem :: RssItem e }+                    | ChannelLanguage { __channelLanguage :: Text }+                    | ChannelCopyright { __channelCopyright :: Text }+                    | ChannelManagingEditor { __channelManagingEditor :: Text }+                    | ChannelWebmaster { __channelWebmaster :: Text }+                    | ChannelPubDate { __channelPubDate :: UTCTime }+                    | ChannelLastBuildDate { __channelLastBuildDate :: UTCTime }+                    | ChannelCategory { __channelCategory :: RssCategory }+                    | ChannelGenerator { __channelGenerator :: Text }+                    | ChannelDocs { __channelDocs :: RssURI }+                    | ChannelCloud { __channelCloud :: RssCloud }+                    | ChannelTtl { __channelTtl :: Int }+                    | ChannelImage { __channelImage :: RssImage }+                    | ChannelRating { __channelRating :: Text }+                    | ChannelTextInput { __channelTextInput :: RssTextInput }+                    | ChannelSkipHours { __channelSkipHours :: Set Hour }+                    | ChannelSkipDays { __channelSkipDays :: Set Day }+                    | ChannelOther { __channelOther :: NonEmpty Event } -makeTraversals ''ChannelPiece+makeLenses ''ChannelPiece  -- | Parse an @\<rss\>@ element. --@@ -250,27 +277,27 @@ 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")-    <*> 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 .| parseRssChannelExtension)+    <$> 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 .| parseRssChannelExtension)   piece = [ fmap ChannelTitle <$> tagIgnoreAttrs "title" content           , fmap ChannelLink <$> tagIgnoreAttrs "link" (content >>= asRssURI)           , fmap ChannelDescription <$> tagIgnoreAttrs "description" content

@@ -33,7 +33,8 @@ import           Data.Time.RFC822 import           Data.Version import           Data.XML.Types-import           Lens.Simple+import           Lens.Micro+import           Lens.Micro.Extras import           Safe import           Text.XML.Stream.Render import           URI.ByteString@@ -52,7 +53,7 @@     optionalTextTag "webMaster" $ d^.channelWebmasterL     forM_ (d^.channelPubDateL) $ dateTag "pubDate"     forM_ (d^.channelLastBuildDateL) $ dateTag "lastBuildDate"-    forM_ (d^..channelCategoriesL) renderRssCategory+    forM_ (d^.channelCategoriesL) renderRssCategory     optionalTextTag "generator" $ d^.channelGeneratorL     forM_ (d^.channelDocsL) $ textTag "docs" . renderRssURI     forM_ (d^.channelCloudL) renderRssCloud@@ -62,7 +63,7 @@     forM_ (d^.channelTextInputL) renderRssTextInput     renderRssSkipHours $ d^.channelSkipHoursL     renderRssSkipDays $ d^.channelSkipDaysL-    forM_ (d^..channelItemsL) renderRssItem+    forM_ (d^.channelItemsL) renderRssItem     renderRssChannelExtension $ d^.channelExtensionsL  -- | Render an @\<item\>@ element.@@ -72,9 +73,9 @@   forM_ (i^.itemLinkL) $ textTag "link" . renderRssURI   optionalTextTag "description" $ i^.itemDescriptionL   optionalTextTag "author" $ i^.itemAuthorL-  forM_ (i^..itemCategoriesL) renderRssCategory+  forM_ (i^.itemCategoriesL) renderRssCategory   forM_ (i^.itemCommentsL) $ textTag "comments" . renderRssURI-  forM_ (i^..itemEnclosureL) renderRssEnclosure+  forM_ (i^.itemEnclosureL) renderRssEnclosure   forM_ (i^.itemGuidL) renderRssGuid   forM_ (i^.itemPubDateL) $ dateTag "pubDate"   forM_ (i^.itemSourceL) renderRssSource

@@ -33,7 +33,8 @@ import           Data.Time.RFC3339 import           Data.XML.Types import           GHC.Generics-import           Lens.Simple+import           Lens.Micro+import           Lens.Micro.TH import qualified Text.XML.DublinCore.Conduit.Parse  as DC import           Text.XML.DublinCore.Conduit.Render import           Text.XML.Stream.Parse@@ -41,7 +42,7 @@ -- }}}  -- {{{ Utils-projectC :: Monad m => Fold a a' b b' -> ConduitT a b m ()+projectC :: Monad m => Traversal' a b -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -73,33 +74,43 @@ mkDcMetaData = DcMetaData mempty mempty mempty Nothing mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty mempty  -data ElementPiece = ElementContributor Text | ElementCoverage Text | ElementCreator Text-                  | ElementDate UTCTime | ElementDescription Text | ElementFormat Text-                  | ElementIdentifier Text | ElementLanguage Text | ElementPublisher Text-                  | ElementRelation Text | ElementRights Text | ElementSource Text-                  | ElementSubject Text | ElementTitle Text | ElementType Text+data ElementPiece = ElementContributor { __elementContributor :: Text }+                  | ElementCoverage { __elementCoverage :: Text }+                  | ElementCreator { __elementCreator :: Text }+                  | ElementDate { __elementDate :: UTCTime }+                  | ElementDescription { __elementDescription :: Text }+                  | ElementFormat { __elementFormat :: Text }+                  | ElementIdentifier { __elementIdentifier :: Text }+                  | ElementLanguage { __elementLanguage :: Text }+                  | ElementPublisher { __elementPublisher :: Text }+                  | ElementRelation { __elementRelation :: Text }+                  | ElementRights { __elementRights :: Text }+                  | ElementSource { __elementSource :: Text }+                  | ElementSubject { __elementSubject :: Text }+                  | ElementTitle { __elementTitle :: Text }+                  | ElementType { __elementType :: Text } -makeTraversals ''ElementPiece+makeLenses ''ElementPiece  -- | Parse a set of Dublin Core metadata elements. 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

@@ -51,7 +51,8 @@ import           Data.Time.RFC822 import           Data.XML.Types import           GHC.Generics-import           Lens.Simple+import           Lens.Micro+import           Lens.Micro.TH import           Text.Read import           Text.XML.Stream.Parse import qualified Text.XML.Stream.Render as Render@@ -69,7 +70,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' -> ConduitT a b m ()+projectC :: Monad m => Traversal' a b -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -132,17 +133,19 @@ mkSyndicationInfo = SyndicationInfo mzero mzero mzero  -data ElementPiece = ElementPeriod SyndicationPeriod | ElementFrequency Int | ElementBase UTCTime+data ElementPiece = ElementPeriod { __elementPeriod :: SyndicationPeriod }+                  | ElementFrequency { __elementFrequency :: Int }+                  | ElementBase { __elementBase :: UTCTime } -makeTraversals ''ElementPiece+makeLenses ''ElementPiece  -- | Parse all __Syndication__ elements. 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

@@ -3,47 +3,18 @@ module Text.RSS.Lens (module Text.RSS.Lens) where  -- {{{ Imports+import           Text.RSS.Lens.Rules import           Text.RSS.Types -import           Lens.Simple+import           Lens.Micro.TH import           URI.ByteString -- }}} --$(makeLensesBy (\n -> Just (n ++ "L")) ''RssCategory)-$(makeLensesBy (\n -> Just (n ++ "L")) ''RssEnclosure)-$(makeLensesBy (\n -> Just (n ++ "L")) ''RssSource)--$(makeLensesBy-  (let f "itemCategories" = Nothing-       f "itemEnclosure"  = Nothing-       f n                = Just (n ++ "L")-   in f)-  ''RssItem)--itemCategoriesL :: Traversal' (RssItem e) RssCategory-itemCategoriesL inj a@RssItem { itemCategories = c } = (\x -> a { itemCategories = c }) <$> traverse inj c-{-# INLINE itemCategoriesL #-}--itemEnclosureL :: Traversal' (RssItem e) RssEnclosure-itemEnclosureL inj a@RssItem { itemEnclosure = e } = (\x -> a { itemEnclosure = e }) <$> traverse inj e-{-# INLINE itemEnclosureL #-}---$(makeLensesBy (\n -> Just (n ++ "L")) ''RssTextInput)-$(makeLensesBy (\n -> Just (n ++ "L")) ''RssCloud)-$(makeLensesBy (\n -> Just (n ++ "L")) ''RssImage)-$(makeLensesBy-  (let f "channelItems"      = Nothing-       f "channelCategories" = Nothing-       f n                   = Just (n ++ "L")-  in f)-  ''RssDocument)--channelItemsL :: Traversal' (RssDocument e) (RssItem e)-channelItemsL inj a@RssDocument { channelItems = i } = (\x -> a { channelItems = i }) <$> traverse inj i-{-# INLINE channelItemsL #-}--channelCategoriesL :: Traversal' (RssDocument e) RssCategory-channelCategoriesL inj a@RssDocument { channelCategories = c } = (\x -> a { channelCategories = c }) <$> traverse inj c-{-# INLINE channelCategoriesL #-}+makeLensesWith rules ''RssCategory+makeLensesWith rules ''RssEnclosure+makeLensesWith rules ''RssSource+makeLensesWith rules ''RssItem+makeLensesWith rules ''RssTextInput+makeLensesWith rules ''RssCloud+makeLensesWith rules ''RssImage+makeLensesWith rules ''RssDocument

@@ -0,0 +1,12 @@+{-# LANGUAGE FlexibleContexts #-}+module Text.RSS.Lens.Rules where++-- {{{ Imports+import           Language.Haskell.TH.Syntax+import           Lens.Micro+import           Lens.Micro.TH+-- }}}++rules :: LensRules+rules = set lensField f lensRules where+  f _ _ name = [TopName $ mkName (nameBase name <> "L")]

@@ -32,7 +32,8 @@ import           Data.Time.RFC3339 import           Data.Version import           Data.XML.Types-import           Lens.Simple+import           Lens.Micro+import           Lens.Micro.TH import           Text.XML.Stream.Parse import           URI.ByteString -- }}}@@ -55,7 +56,7 @@ 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' -> ConduitT a b m ()+projectC :: Monad m => Traversal' a b -> ConduitT a b m () projectC prism = fix $ \recurse -> do   item <- await   case (item, item ^? (_Just . prism)) of@@ -90,19 +91,21 @@ -- }}}  -data TextInputPiece = TextInputTitle Text | TextInputDescription Text-                    | TextInputName Text | TextInputLink RssURI+data TextInputPiece = TextInputTitle { __textInputTitle :: Text }+                    | TextInputDescription { __textInputDescription :: Text }+                    | TextInputName { __textInputName :: Text }+                    | TextInputLink { __textInputLink :: RssURI } -makeTraversals ''TextInputPiece+makeLenses ''TextInputPiece  -- | Parse a @\<textinput\>@ element. rss1TextInput :: MonadThrow m => ConduitM Event o m (Maybe RssTextInput) rss1TextInput = rss1Tag "textinput" attributes $ \uri -> (manyYield' (choose piece) .| parser uri) <* many ignoreAnyTreeContent where   parser uri = getZipConduit $ RssTextInput-    <$> ZipConduit (projectC _TextInputTitle .| headRequiredC "Missing <title> element")-    <*> ZipConduit (projectC _TextInputDescription .| headRequiredC "Missing <description> element")-    <*> ZipConduit (projectC _TextInputName .| headRequiredC "Missing <name> element")-    <*> ZipConduit (projectC _TextInputLink .| headDefC uri)  -- Lenient+    <$> 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)@@ -111,10 +114,15 @@   attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs  -data ItemPiece = ItemTitle Text | ItemLink RssURI | ItemDescription Text | ItemCreator Text-               | ItemDate UTCTime | ItemContent Text | ItemOther (NonEmpty Event)+data ItemPiece = ItemTitle { __itemTitle :: Text }+               | ItemLink { __itemLink :: RssURI }+               | ItemDescription { __itemDescription :: Text }+               | ItemCreator { __itemCreator :: Text }+               | ItemDate { __itemDate :: UTCTime }+               | ItemContent { __itemContent :: Text }+               | ItemOther { __itemOther :: NonEmpty Event } -makeTraversals ''ItemPiece+makeLenses ''ItemPiece  -- | Parse an @\<item\>@ element. --@@ -122,17 +130,17 @@ 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)-    <*> (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 .| parseRssItemExtension)+    <*> 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))@@ -143,17 +151,19 @@   attributes = (requireAttr (rdfName "about") >>= asRssURI) <* ignoreAttrs  -data ImagePiece = ImageUri RssURI | ImageTitle Text | ImageLink RssURI+data ImagePiece = ImageUri { __imageUri :: RssURI }+  | ImageTitle { __imageTitle :: Text }+  | ImageLink { __imageLink :: RssURI } -makeTraversals ''ImagePiece+makeLenses ''ImagePiece  -- | Parse an @\<image\>@ element. rss1Image :: (MonadThrow m) => ConduitM Event o m (Maybe RssImage) rss1Image = rss1Tag "image" attributes $ \uri -> (manyYield' (choose piece) .| parser uri) <* many ignoreAnyTreeContent where   parser uri = getZipConduit $ RssImage-    <$> ZipConduit (projectC _ImageUri .| headDefC uri)  -- Lenient-    <*> ZipConduit (projectC _ImageTitle .| headDefC "Unnamed image")  -- Lenient-    <*> ZipConduit (projectC _ImageLink .| headDefC nullURI)  -- Lenient+    <$> 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@@ -181,15 +191,15 @@   , channelExtensions'  :: RssChannelExtension extensions   } -data ChannelPiece = ChannelTitle Text-  | ChannelLink RssURI-  | ChannelDescription Text-  | ChannelImage RssImage-  | ChannelItems [Text]-  | ChannelTextInput RssURI-  | ChannelOther (NonEmpty Event)+data ChannelPiece = ChannelTitle { __channelTitle :: Text }+  | ChannelLink { __channelLink :: RssURI }+  | ChannelDescription { __channelDescription :: Text }+  | ChannelImage { __channelImage :: RssImage }+  | ChannelItems { __channelItems :: [Text] }+  | ChannelTextInput { __channelTextInput :: RssURI }+  | ChannelOther { __channelOther :: NonEmpty Event } -makeTraversals ''ChannelPiece+makeLenses ''ChannelPiece   -- | Parse a @\<channel\>@ element.@@ -198,13 +208,13 @@ 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")-    <*> 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 .| parseRssChannelExtension)+    <$> 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 .| parseRssChannelExtension)   piece = [ fmap ChannelTitle <$> rss1Tag "title" ignoreAttrs (const content)           , fmap ChannelLink <$> rss1Tag "link" ignoreAttrs (const $ content >>= asRssURI)           , fmap ChannelDescription <$> rss1Tag "description" ignoreAttrs (const content)@@ -243,12 +253,12 @@   mempty   (channelExtensions' channel) -data DocumentPiece e = DocumentChannel (Rss1Channel e)-  | DocumentImage RssImage-  | DocumentItem (RssItem e)-  | DocumentTextInput RssTextInput+data DocumentPiece e = DocumentChannel { __documentChannel :: Rss1Channel e }+  | DocumentImage { __documentImage :: RssImage }+  | DocumentItem { __documentItem :: RssItem e }+  | DocumentTextInput { __documentTextInput :: RssTextInput } -makeTraversals ''DocumentPiece+makeLenses ''DocumentPiece   -- | Parse an @\<RDF\>@ element.@@ -257,10 +267,10 @@ 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")-    <*> 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

@@ -32,7 +32,7 @@ import           Data.Version import           Data.Void import           Data.XML.Types-import           Lens.Simple+import           Lens.Micro import           System.FilePath import           System.IO import           System.Timeout@@ -316,7 +316,7 @@   result^?channelImageL._Just.imageTitleL @?= Just "XML.com"   result^?channelImageL._Just.imageLinkL @?= Just imageLink   result^?channelImageL._Just.imageUriL @?= Just imageUri-  length (result^..channelItemsL) @?= 2+  length (result^.channelItemsL) @?= 2   result^?channelTextInputL._Just.textInputTitleL @?= Just "Search XML.com"   result^?channelTextInputL._Just.textInputDescriptionL @?= Just "Search XML.com's XML collection"   result^?channelTextInputL._Just.textInputNameL @?= Just "s"