{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeFamilies      #-}
-- | Streaming parsers for the RSS 1.0 standard.
module Text.RSS1.Conduit.Parse
  ( -- * Top-level
    rss1Document
    -- * Elements
  , rss1ChannelItems
  , rss1Image
  , rss1Item
  , rss1TextInput
  ) where

-- {{{ Imports
import           Text.RSS.Extensions
import           Text.RSS.Types

import           Conduit                hiding (throwM)
import           Control.Exception.Safe as Exception
import           Control.Monad
import           Control.Monad.Fix
import           Data.Conduit
import           Data.List.NonEmpty
import           Data.Text              as Text
import           Data.Text.Encoding
import           Data.Time.Clock
import           Data.Time.LocalTime
import           Data.Time.RFC3339
import           Data.Version
import           Data.XML.Types
import           Lens.Micro
import           Lens.Micro.TH
import           Text.XML.Stream.Parse
import           URI.ByteString
-- }}}

-- {{{ Util
asDate :: (MonadThrow m) => Text -> m UTCTime
asDate :: Text -> m UTCTime
asDate Text
text = m UTCTime
-> (ZonedTime -> m UTCTime) -> Maybe ZonedTime -> m UTCTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RssException -> m UTCTime
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (RssException -> m UTCTime) -> RssException -> m UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> RssException
InvalidTime Text
text) (UTCTime -> m UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> m UTCTime)
-> (ZonedTime -> UTCTime) -> ZonedTime -> m UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> UTCTime
zonedTimeToUTC) (Maybe ZonedTime -> m UTCTime) -> Maybe ZonedTime -> m UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> Maybe ZonedTime
forall t. TextualMonoid t => t -> Maybe ZonedTime
parseTimeRFC3339 Text
text

asRssURI :: (MonadThrow m) => Text -> m RssURI
asRssURI :: Text -> m RssURI
asRssURI Text
t = case (Text -> Either URIParseError (URIRef Absolute)
parseURI' Text
t, Text -> Either URIParseError (URIRef Relative)
parseRelativeRef' Text
t) of
  (Right URIRef Absolute
u, Either URIParseError (URIRef Relative)
_) -> RssURI -> m RssURI
forall (m :: * -> *) a. Monad m => a -> m a
return (RssURI -> m RssURI) -> RssURI -> m RssURI
forall a b. (a -> b) -> a -> b
$ URIRef Absolute -> RssURI
forall a. URIRef a -> RssURI
RssURI URIRef Absolute
u
  (Either URIParseError (URIRef Absolute)
_, Right URIRef Relative
u) -> RssURI -> m RssURI
forall (m :: * -> *) a. Monad m => a -> m a
return (RssURI -> m RssURI) -> RssURI -> m RssURI
forall a b. (a -> b) -> a -> b
$ URIRef Relative -> RssURI
forall a. URIRef a -> RssURI
RssURI URIRef Relative
u
  (Either URIParseError (URIRef Absolute)
_, Left URIParseError
e)  -> RssException -> m RssURI
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (RssException -> m RssURI) -> RssException -> m RssURI
forall a b. (a -> b) -> a -> b
$ URIParseError -> RssException
InvalidURI URIParseError
e
  where parseURI' :: Text -> Either URIParseError (URIRef Absolute)
parseURI' = URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions (ByteString -> Either URIParseError (URIRef Absolute))
-> (Text -> ByteString)
-> Text
-> Either URIParseError (URIRef Absolute)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
        parseRelativeRef' :: Text -> Either URIParseError (URIRef Relative)
parseRelativeRef' = URIParserOptions
-> ByteString -> Either URIParseError (URIRef Relative)
parseRelativeRef URIParserOptions
laxURIParserOptions (ByteString -> Either URIParseError (URIRef Relative))
-> (Text -> ByteString)
-> Text
-> Either URIParseError (URIRef Relative)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

nullURI :: RssURI
nullURI :: RssURI
nullURI = URIRef Relative -> RssURI
forall a. URIRef a -> RssURI
RssURI (URIRef Relative -> RssURI) -> URIRef Relative -> RssURI
forall a b. (a -> b) -> a -> b
$ Maybe Authority
-> ByteString -> Query -> Maybe ByteString -> URIRef Relative
RelativeRef Maybe Authority
forall a. Maybe a
Nothing ByteString
"" ([(ByteString, ByteString)] -> Query
Query []) Maybe ByteString
forall a. Maybe a
Nothing

headRequiredC :: MonadThrow m => Text -> ConduitT a b m a
headRequiredC :: Text -> ConduitT a b m a
headRequiredC Text
e = ConduitT a b m a
-> (a -> ConduitT a b m a) -> Maybe a -> ConduitT a b m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (RssException -> ConduitT a b m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (RssException -> ConduitT a b m a)
-> RssException -> ConduitT a b m a
forall a b. (a -> b) -> a -> b
$ Text -> RssException
MissingElement Text
e) a -> ConduitT a b m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> ConduitT a b m a)
-> ConduitT a b m (Maybe a) -> ConduitT a b m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ConduitT a b m (Maybe a)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC

projectC :: Monad m => Traversal' a b -> ConduitT a b m ()
projectC :: Traversal' a b -> ConduitT a b m ()
projectC Traversal' a b
prism = (ConduitT a b m () -> ConduitT a b m ()) -> ConduitT a b m ()
forall a. (a -> a) -> a
fix ((ConduitT a b m () -> ConduitT a b m ()) -> ConduitT a b m ())
-> (ConduitT a b m () -> ConduitT a b m ()) -> ConduitT a b m ()
forall a b. (a -> b) -> a -> b
$ \ConduitT a b m ()
recurse -> do
  Maybe a
item <- ConduitT a b m (Maybe a)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
  case (Maybe a
item, Maybe a
item Maybe a -> Getting (First b) (Maybe a) b -> Maybe b
forall s a. s -> Getting (First a) s a -> Maybe a
^? ((a -> Const (First b) a) -> Maybe a -> Const (First b) (Maybe a)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just ((a -> Const (First b) a) -> Maybe a -> Const (First b) (Maybe a))
-> ((b -> Const (First b) b) -> a -> Const (First b) a)
-> Getting (First b) (Maybe a) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Const (First b) b) -> a -> Const (First b) a
Traversal' a b
prism)) of
    (Maybe a
_, Just b
a) -> b -> ConduitT a b m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield b
a ConduitT a b m () -> ConduitT a b m () -> ConduitT a b m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConduitT a b m ()
recurse
    (Just a
_, Maybe b
_) -> ConduitT a b m ()
recurse
    (Maybe a, Maybe b)
_           -> () -> ConduitT a b m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


contentTag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b)
contentTag :: Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
contentTag Text
string = NameMatcher Name
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' ((Name -> Bool) -> NameMatcher Name
matching (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
contentName Text
string))

dcTag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b)
dcTag :: Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
dcTag Text
string = NameMatcher Name
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' ((Name -> Bool) -> NameMatcher Name
matching (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
dcName Text
string))

rdfTag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b)
rdfTag :: Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rdfTag Text
string = NameMatcher Name
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' ((Name -> Bool) -> NameMatcher Name
matching (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
rdfName Text
string))

rss1Tag :: MonadThrow m => Text -> AttrParser a -> (a -> ConduitM Event o m b) -> ConduitM Event o m (Maybe b)
rss1Tag :: Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
string = NameMatcher Name
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
forall (m :: * -> *) a b o c.
MonadThrow m =>
NameMatcher a
-> AttrParser b
-> (b -> ConduitT Event o m c)
-> ConduitT Event o m (Maybe c)
tag' ((Name -> Bool) -> NameMatcher Name
matching (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
rss1Name Text
string))

contentName :: Text -> Name
contentName :: Text -> Name
contentName Text
string = Text -> Maybe Text -> Maybe Text -> Name
Name Text
string (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://purl.org/rss/1.0/modules/content/") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"content")

dcName :: Text -> Name
dcName :: Text -> Name
dcName Text
string = Text -> Maybe Text -> Maybe Text -> Name
Name Text
string (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://purl.org/dc/elements/1.1/") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"dc")

rdfName :: Text -> Name
rdfName :: Text -> Name
rdfName Text
string = Text -> Maybe Text -> Maybe Text -> Name
Name Text
string (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://www.w3.org/1999/02/22-rdf-syntax-ns#") (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"rdf")

rss1Name :: Text -> Name
rss1Name :: Text -> Name
rss1Name Text
string = Text -> Maybe Text -> Maybe Text -> Name
Name Text
string (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"http://purl.org/rss/1.0/") Maybe Text
forall a. Maybe a
Nothing
-- }}}


data TextInputPiece = TextInputTitle { TextInputPiece -> Text
__textInputTitle :: Text }
                    | TextInputDescription { TextInputPiece -> Text
__textInputDescription :: Text }
                    | TextInputName { TextInputPiece -> Text
__textInputName :: Text }
                    | TextInputLink { TextInputPiece -> RssURI
__textInputLink :: RssURI }

makeLenses ''TextInputPiece

-- | Parse a @\<textinput\>@ element.
rss1TextInput :: MonadThrow m => ConduitM Event o m (Maybe RssTextInput)
rss1TextInput :: ConduitM Event o m (Maybe RssTextInput)
rss1TextInput = Text
-> AttrParser RssURI
-> (RssURI -> ConduitM Event o m RssTextInput)
-> ConduitM Event o m (Maybe RssTextInput)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"textinput" AttrParser RssURI
attributes ((RssURI -> ConduitM Event o m RssTextInput)
 -> ConduitM Event o m (Maybe RssTextInput))
-> (RssURI -> ConduitM Event o m RssTextInput)
-> ConduitM Event o m (Maybe RssTextInput)
forall a b. (a -> b) -> a -> b
$ \RssURI
uri -> (ConduitT Event TextInputPiece m (Maybe TextInputPiece)
-> ConduitT Event TextInputPiece m ()
forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ([ConduitT Event TextInputPiece m (Maybe TextInputPiece)]
-> ConduitT Event TextInputPiece m (Maybe TextInputPiece)
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event TextInputPiece m (Maybe TextInputPiece)]
forall o. [ConduitT Event o m (Maybe TextInputPiece)]
piece) ConduitT Event TextInputPiece m ()
-> ConduitM TextInputPiece o m RssTextInput
-> ConduitM Event o m RssTextInput
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM TextInputPiece o m RssTextInput
forall (m :: * -> *) o.
MonadThrow m =>
RssURI -> ConduitT TextInputPiece o m RssTextInput
parser RssURI
uri) ConduitM Event o m RssTextInput
-> ConduitT Event o m [()] -> ConduitM Event o m RssTextInput
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitT Event o m (Maybe ()) -> ConduitT Event o m [()]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe ())
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent where
  parser :: RssURI -> ConduitT TextInputPiece o m RssTextInput
parser RssURI
uri = ZipConduit TextInputPiece o m RssTextInput
-> ConduitT TextInputPiece o m RssTextInput
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit (ZipConduit TextInputPiece o m RssTextInput
 -> ConduitT TextInputPiece o m RssTextInput)
-> ZipConduit TextInputPiece o m RssTextInput
-> ConduitT TextInputPiece o m RssTextInput
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> RssURI -> RssTextInput
RssTextInput
    (Text -> Text -> Text -> RssURI -> RssTextInput)
-> ZipConduit TextInputPiece o m Text
-> ZipConduit
     TextInputPiece o m (Text -> Text -> RssURI -> RssTextInput)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT TextInputPiece o m Text
-> ZipConduit TextInputPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' TextInputPiece Text -> ConduitT TextInputPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' TextInputPiece Text
_textInputTitle ConduitT TextInputPiece Text m ()
-> ConduitM Text o m Text -> ConduitT TextInputPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a b. MonadThrow m => Text -> ConduitT a b m a
headRequiredC Text
"Missing <title> element")
    ZipConduit
  TextInputPiece o m (Text -> Text -> RssURI -> RssTextInput)
-> ZipConduit TextInputPiece o m Text
-> ZipConduit TextInputPiece o m (Text -> RssURI -> RssTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT TextInputPiece o m Text
-> ZipConduit TextInputPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' TextInputPiece Text -> ConduitT TextInputPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' TextInputPiece Text
_textInputDescription ConduitT TextInputPiece Text m ()
-> ConduitM Text o m Text -> ConduitT TextInputPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a b. MonadThrow m => Text -> ConduitT a b m a
headRequiredC Text
"Missing <description> element")
    ZipConduit TextInputPiece o m (Text -> RssURI -> RssTextInput)
-> ZipConduit TextInputPiece o m Text
-> ZipConduit TextInputPiece o m (RssURI -> RssTextInput)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT TextInputPiece o m Text
-> ZipConduit TextInputPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' TextInputPiece Text -> ConduitT TextInputPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' TextInputPiece Text
_textInputName ConduitT TextInputPiece Text m ()
-> ConduitM Text o m Text -> ConduitT TextInputPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a b. MonadThrow m => Text -> ConduitT a b m a
headRequiredC Text
"Missing <name> element")
    ZipConduit TextInputPiece o m (RssURI -> RssTextInput)
-> ZipConduit TextInputPiece o m RssURI
-> ZipConduit TextInputPiece o m RssTextInput
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT TextInputPiece o m RssURI
-> ZipConduit TextInputPiece o m RssURI
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' TextInputPiece RssURI
-> ConduitT TextInputPiece RssURI m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' TextInputPiece RssURI
_textInputLink ConduitT TextInputPiece RssURI m ()
-> ConduitM RssURI o m RssURI -> ConduitT TextInputPiece o m RssURI
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM RssURI o m RssURI
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC RssURI
uri)  -- Lenient
  piece :: [ConduitT Event o m (Maybe TextInputPiece)]
piece = [ (Text -> TextInputPiece) -> Maybe Text -> Maybe TextInputPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextInputPiece
TextInputTitle (Maybe Text -> Maybe TextInputPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe TextInputPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"title" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (Text -> TextInputPiece) -> Maybe Text -> Maybe TextInputPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextInputPiece
TextInputDescription (Maybe Text -> Maybe TextInputPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe TextInputPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"description" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (Text -> TextInputPiece) -> Maybe Text -> Maybe TextInputPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TextInputPiece
TextInputName (Maybe Text -> Maybe TextInputPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe TextInputPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"name" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (RssURI -> TextInputPiece) -> Maybe RssURI -> Maybe TextInputPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssURI -> TextInputPiece
TextInputLink (Maybe RssURI -> Maybe TextInputPiece)
-> ConduitT Event o m (Maybe RssURI)
-> ConduitT Event o m (Maybe TextInputPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m RssURI)
-> ConduitT Event o m (Maybe RssURI)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"link" AttrParser ()
ignoreAttrs (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. a -> b -> a
const (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI)
-> ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitM Event o m Text
-> (Text -> ConduitM Event o m RssURI) -> ConduitM Event o m RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitM Event o m RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI)
          ]
  attributes :: AttrParser RssURI
attributes = (Name -> AttrParser Text
requireAttr (Text -> Name
rdfName Text
"about") AttrParser Text -> (Text -> AttrParser RssURI) -> AttrParser RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> AttrParser RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI) AttrParser RssURI -> AttrParser () -> AttrParser RssURI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* AttrParser ()
ignoreAttrs


data ItemPiece = ItemTitle { ItemPiece -> Text
__itemTitle :: Text }
               | ItemLink { ItemPiece -> RssURI
__itemLink :: RssURI }
               | ItemDescription { ItemPiece -> Text
__itemDescription :: Text }
               | ItemCreator { ItemPiece -> Text
__itemCreator :: Text }
               | ItemDate { ItemPiece -> UTCTime
__itemDate :: UTCTime }
               | ItemContent { ItemPiece -> Text
__itemContent :: Text }
               | ItemOther { ItemPiece -> NonEmpty Event
__itemOther :: NonEmpty Event }

makeLenses ''ItemPiece

-- | Parse an @\<item\>@ element.
--
-- RSS extensions are automatically parsed based on the inferred result type.
rss1Item :: ParseRssExtension e => MonadCatch m => ConduitM Event o m (Maybe (RssItem e))
rss1Item :: ConduitM Event o m (Maybe (RssItem e))
rss1Item = Text
-> AttrParser RssURI
-> (RssURI -> ConduitM Event o m (RssItem e))
-> ConduitM Event o m (Maybe (RssItem e))
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"item" AttrParser RssURI
attributes ((RssURI -> ConduitM Event o m (RssItem e))
 -> ConduitM Event o m (Maybe (RssItem e)))
-> (RssURI -> ConduitM Event o m (RssItem e))
-> ConduitM Event o m (Maybe (RssItem e))
forall a b. (a -> b) -> a -> b
$ \RssURI
uri -> (ConduitT Event ItemPiece m (Maybe ItemPiece)
-> ConduitT Event ItemPiece m ()
forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ([ConduitT Event ItemPiece m (Maybe ItemPiece)]
-> ConduitT Event ItemPiece m (Maybe ItemPiece)
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event ItemPiece m (Maybe ItemPiece)]
forall o. [ConduitT Event o m (Maybe ItemPiece)]
piece) ConduitT Event ItemPiece m ()
-> ConduitM ItemPiece o m (RssItem e)
-> ConduitM Event o m (RssItem e)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM ItemPiece o m (RssItem e)
forall (m :: * -> *) extensions o.
(ParseRssExtension extensions, MonadThrow m) =>
RssURI -> ConduitT ItemPiece o m (RssItem extensions)
parser RssURI
uri) ConduitM Event o m (RssItem e)
-> ConduitT Event o m [()] -> ConduitM Event o m (RssItem e)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitT Event o m (Maybe ()) -> ConduitT Event o m [()]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe ())
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent where
  parser :: RssURI -> ConduitT ItemPiece o m (RssItem extensions)
parser RssURI
uri = ZipConduit ItemPiece o m (RssItem extensions)
-> ConduitT ItemPiece o m (RssItem extensions)
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit (ZipConduit ItemPiece o m (RssItem extensions)
 -> ConduitT ItemPiece o m (RssItem extensions))
-> ZipConduit ItemPiece o m (RssItem extensions)
-> ConduitT ItemPiece o m (RssItem extensions)
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe RssURI
-> Text
-> Text
-> [RssCategory]
-> Maybe RssURI
-> [RssEnclosure]
-> Maybe RssGuid
-> Maybe UTCTime
-> Maybe RssSource
-> RssItemExtension extensions
-> RssItem extensions
forall extensions.
Text
-> Maybe RssURI
-> Text
-> Text
-> [RssCategory]
-> Maybe RssURI
-> [RssEnclosure]
-> Maybe RssGuid
-> Maybe UTCTime
-> Maybe RssSource
-> RssItemExtension extensions
-> RssItem extensions
RssItem
    (Text
 -> Maybe RssURI
 -> Text
 -> Text
 -> [RssCategory]
 -> Maybe RssURI
 -> [RssEnclosure]
 -> Maybe RssGuid
 -> Maybe UTCTime
 -> Maybe RssSource
 -> RssItemExtension extensions
 -> RssItem extensions)
-> ZipConduit ItemPiece o m Text
-> ZipConduit
     ItemPiece
     o
     m
     (Maybe RssURI
      -> Text
      -> Text
      -> [RssCategory]
      -> Maybe RssURI
      -> [RssEnclosure]
      -> Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ItemPiece o m Text -> ZipConduit ItemPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ItemPiece Text -> ConduitT ItemPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ItemPiece Text
_itemTitle ConduitT ItemPiece Text m ()
-> ConduitM Text o m Text -> ConduitT ItemPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC Text
forall a. Monoid a => a
mempty)
    ZipConduit
  ItemPiece
  o
  m
  (Maybe RssURI
   -> Text
   -> Text
   -> [RssCategory]
   -> Maybe RssURI
   -> [RssEnclosure]
   -> Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m (Maybe RssURI)
-> ZipConduit
     ItemPiece
     o
     m
     (Text
      -> Text
      -> [RssCategory]
      -> Maybe RssURI
      -> [RssEnclosure]
      -> Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (RssURI -> Maybe RssURI
forall a. a -> Maybe a
Just (RssURI -> Maybe RssURI)
-> ZipConduit ItemPiece o m RssURI
-> ZipConduit ItemPiece o m (Maybe RssURI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ItemPiece o m RssURI -> ZipConduit ItemPiece o m RssURI
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ItemPiece RssURI -> ConduitT ItemPiece RssURI m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ItemPiece RssURI
_itemLink ConduitT ItemPiece RssURI m ()
-> ConduitM RssURI o m RssURI -> ConduitT ItemPiece o m RssURI
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM RssURI o m RssURI
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC RssURI
uri))
    ZipConduit
  ItemPiece
  o
  m
  (Text
   -> Text
   -> [RssCategory]
   -> Maybe RssURI
   -> [RssEnclosure]
   -> Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m Text
-> ZipConduit
     ItemPiece
     o
     m
     (Text
      -> [RssCategory]
      -> Maybe RssURI
      -> [RssEnclosure]
      -> Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ItemPiece o m Text -> ZipConduit ItemPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ItemPiece Text -> ConduitT ItemPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ItemPiece Text
_itemDescription ConduitT ItemPiece Text m ()
-> ConduitM Text o m Text -> ConduitT ItemPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC Text
forall a. Monoid a => a
mempty)
    ZipConduit
  ItemPiece
  o
  m
  (Text
   -> [RssCategory]
   -> Maybe RssURI
   -> [RssEnclosure]
   -> Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m Text
-> ZipConduit
     ItemPiece
     o
     m
     ([RssCategory]
      -> Maybe RssURI
      -> [RssEnclosure]
      -> Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ItemPiece o m Text -> ZipConduit ItemPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ItemPiece Text -> ConduitT ItemPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ItemPiece Text
_itemCreator ConduitT ItemPiece Text m ()
-> ConduitM Text o m Text -> ConduitT ItemPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC Text
forall a. Monoid a => a
mempty)
    ZipConduit
  ItemPiece
  o
  m
  ([RssCategory]
   -> Maybe RssURI
   -> [RssEnclosure]
   -> Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m [RssCategory]
-> ZipConduit
     ItemPiece
     o
     m
     (Maybe RssURI
      -> [RssEnclosure]
      -> Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [RssCategory] -> ZipConduit ItemPiece o m [RssCategory]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RssCategory]
forall a. Monoid a => a
mempty
    ZipConduit
  ItemPiece
  o
  m
  (Maybe RssURI
   -> [RssEnclosure]
   -> Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m (Maybe RssURI)
-> ZipConduit
     ItemPiece
     o
     m
     ([RssEnclosure]
      -> Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe RssURI -> ZipConduit ItemPiece o m (Maybe RssURI)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RssURI
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ZipConduit
  ItemPiece
  o
  m
  ([RssEnclosure]
   -> Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m [RssEnclosure]
-> ZipConduit
     ItemPiece
     o
     m
     (Maybe RssGuid
      -> Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [RssEnclosure] -> ZipConduit ItemPiece o m [RssEnclosure]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [RssEnclosure]
forall a. Monoid a => a
mempty
    ZipConduit
  ItemPiece
  o
  m
  (Maybe RssGuid
   -> Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m (Maybe RssGuid)
-> ZipConduit
     ItemPiece
     o
     m
     (Maybe UTCTime
      -> Maybe RssSource
      -> RssItemExtension extensions
      -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe RssGuid -> ZipConduit ItemPiece o m (Maybe RssGuid)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RssGuid
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ZipConduit
  ItemPiece
  o
  m
  (Maybe UTCTime
   -> Maybe RssSource
   -> RssItemExtension extensions
   -> RssItem extensions)
-> ZipConduit ItemPiece o m (Maybe UTCTime)
-> ZipConduit
     ItemPiece
     o
     m
     (Maybe RssSource
      -> RssItemExtension extensions -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ItemPiece o m (Maybe UTCTime)
-> ZipConduit ItemPiece o m (Maybe UTCTime)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ItemPiece UTCTime -> ConduitT ItemPiece UTCTime m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ItemPiece UTCTime
_itemDate ConduitT ItemPiece UTCTime m ()
-> ConduitM UTCTime o m (Maybe UTCTime)
-> ConduitT ItemPiece o m (Maybe UTCTime)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM UTCTime o m (Maybe UTCTime)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC)
    ZipConduit
  ItemPiece
  o
  m
  (Maybe RssSource
   -> RssItemExtension extensions -> RssItem extensions)
-> ZipConduit ItemPiece o m (Maybe RssSource)
-> ZipConduit
     ItemPiece o m (RssItemExtension extensions -> RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe RssSource -> ZipConduit ItemPiece o m (Maybe RssSource)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RssSource
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ZipConduit
  ItemPiece o m (RssItemExtension extensions -> RssItem extensions)
-> ZipConduit ItemPiece o m (RssItemExtension extensions)
-> ZipConduit ItemPiece o m (RssItem extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ItemPiece o m (RssItemExtension extensions)
-> ZipConduit ItemPiece o m (RssItemExtension extensions)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ItemPiece (NonEmpty Event)
-> ConduitT ItemPiece (NonEmpty Event) m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ItemPiece (NonEmpty Event)
_itemOther ConduitT ItemPiece (NonEmpty Event) m ()
-> ConduitM (NonEmpty Event) o m (RssItemExtension extensions)
-> ConduitT ItemPiece o m (RssItemExtension extensions)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT (NonEmpty Event) Event m ()
forall (m :: * -> *) mono.
(Monad m, MonoFoldable mono) =>
ConduitT mono (Element mono) m ()
concatC ConduitT (NonEmpty Event) Event m ()
-> ConduitM Event o m (RssItemExtension extensions)
-> ConduitM (NonEmpty Event) o m (RssItemExtension extensions)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Event o m (RssItemExtension extensions)
forall a (m :: * -> *) o.
(ParseRssExtension a, MonadThrow m) =>
ConduitT Event o m (RssItemExtension a)
parseRssItemExtension)
  piece :: [ConduitT Event o m (Maybe ItemPiece)]
piece = [ (Text -> ItemPiece) -> Maybe Text -> Maybe ItemPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ItemPiece
ItemTitle (Maybe Text -> Maybe ItemPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe ItemPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"title" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (RssURI -> ItemPiece) -> Maybe RssURI -> Maybe ItemPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssURI -> ItemPiece
ItemLink (Maybe RssURI -> Maybe ItemPiece)
-> ConduitT Event o m (Maybe RssURI)
-> ConduitT Event o m (Maybe ItemPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m RssURI)
-> ConduitT Event o m (Maybe RssURI)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"link" AttrParser ()
ignoreAttrs (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. a -> b -> a
const (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI)
-> ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitM Event o m Text
-> (Text -> ConduitM Event o m RssURI) -> ConduitM Event o m RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitM Event o m RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI)
          , (Text -> ItemPiece) -> Maybe Text -> Maybe ItemPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ItemPiece
ItemDescription (Maybe Text -> Maybe ItemPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe ItemPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"description" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content) ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a)
-> ConduitT Event o m (Maybe a) -> ConduitT Event o m (Maybe a)
`orE` Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
contentTag Text
"encoded" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content))
          , (Text -> ItemPiece) -> Maybe Text -> Maybe ItemPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ItemPiece
ItemCreator (Maybe Text -> Maybe ItemPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe ItemPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
dcTag Text
"creator" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (UTCTime -> ItemPiece) -> Maybe UTCTime -> Maybe ItemPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UTCTime -> ItemPiece
ItemDate (Maybe UTCTime -> Maybe ItemPiece)
-> ConduitT Event o m (Maybe UTCTime)
-> ConduitT Event o m (Maybe ItemPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m UTCTime)
-> ConduitT Event o m (Maybe UTCTime)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
dcTag Text
"date" AttrParser ()
ignoreAttrs (ConduitM Event o m UTCTime -> () -> ConduitM Event o m UTCTime
forall a b. a -> b -> a
const (ConduitM Event o m UTCTime -> () -> ConduitM Event o m UTCTime)
-> ConduitM Event o m UTCTime -> () -> ConduitM Event o m UTCTime
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitM Event o m Text
-> (Text -> ConduitM Event o m UTCTime)
-> ConduitM Event o m UTCTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitM Event o m UTCTime
forall (m :: * -> *). MonadThrow m => Text -> m UTCTime
asDate)
          , (NonEmpty Event -> ItemPiece)
-> Maybe (NonEmpty Event) -> Maybe ItemPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Event -> ItemPiece
ItemOther (Maybe (NonEmpty Event) -> Maybe ItemPiece)
-> ([Event] -> Maybe (NonEmpty Event))
-> [Event]
-> Maybe ItemPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Maybe (NonEmpty Event)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Event] -> Maybe ItemPiece)
-> ConduitT Event o m [Event]
-> ConduitT Event o m (Maybe ItemPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConduitT Event Event m (Maybe ()) -> ConduitT Event Event m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ConduitT Event Event m (Maybe ())
forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeAnyTreeContent ConduitT Event Event m ()
-> ConduitT Event o m [Event] -> ConduitT Event o m [Event]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Event o m [Event]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
          ]
  attributes :: AttrParser RssURI
attributes = (Name -> AttrParser Text
requireAttr (Text -> Name
rdfName Text
"about") AttrParser Text -> (Text -> AttrParser RssURI) -> AttrParser RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> AttrParser RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI) AttrParser RssURI -> AttrParser () -> AttrParser RssURI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* AttrParser ()
ignoreAttrs


data ImagePiece = ImageUri { ImagePiece -> RssURI
__imageUri :: RssURI }
  | ImageTitle { ImagePiece -> Text
__imageTitle :: Text }
  | ImageLink { ImagePiece -> RssURI
__imageLink :: RssURI }

makeLenses ''ImagePiece

-- | Parse an @\<image\>@ element.
rss1Image :: (MonadThrow m) => ConduitM Event o m (Maybe RssImage)
rss1Image :: ConduitM Event o m (Maybe RssImage)
rss1Image = Text
-> AttrParser RssURI
-> (RssURI -> ConduitM Event o m RssImage)
-> ConduitM Event o m (Maybe RssImage)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"image" AttrParser RssURI
attributes ((RssURI -> ConduitM Event o m RssImage)
 -> ConduitM Event o m (Maybe RssImage))
-> (RssURI -> ConduitM Event o m RssImage)
-> ConduitM Event o m (Maybe RssImage)
forall a b. (a -> b) -> a -> b
$ \RssURI
uri -> (ConduitT Event ImagePiece m (Maybe ImagePiece)
-> ConduitT Event ImagePiece m ()
forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ([ConduitT Event ImagePiece m (Maybe ImagePiece)]
-> ConduitT Event ImagePiece m (Maybe ImagePiece)
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event ImagePiece m (Maybe ImagePiece)]
forall o. [ConduitT Event o m (Maybe ImagePiece)]
piece) ConduitT Event ImagePiece m ()
-> ConduitM ImagePiece o m RssImage -> ConduitM Event o m RssImage
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM ImagePiece o m RssImage
forall (m :: * -> *) o.
Monad m =>
RssURI -> ConduitT ImagePiece o m RssImage
parser RssURI
uri) ConduitM Event o m RssImage
-> ConduitT Event o m [()] -> ConduitM Event o m RssImage
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitT Event o m (Maybe ()) -> ConduitT Event o m [()]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe ())
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent where
  parser :: RssURI -> ConduitT ImagePiece o m RssImage
parser RssURI
uri = ZipConduit ImagePiece o m RssImage
-> ConduitT ImagePiece o m RssImage
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit (ZipConduit ImagePiece o m RssImage
 -> ConduitT ImagePiece o m RssImage)
-> ZipConduit ImagePiece o m RssImage
-> ConduitT ImagePiece o m RssImage
forall a b. (a -> b) -> a -> b
$ RssURI
-> Text -> RssURI -> Maybe Int -> Maybe Int -> Text -> RssImage
RssImage
    (RssURI
 -> Text -> RssURI -> Maybe Int -> Maybe Int -> Text -> RssImage)
-> ZipConduit ImagePiece o m RssURI
-> ZipConduit
     ImagePiece
     o
     m
     (Text -> RssURI -> Maybe Int -> Maybe Int -> Text -> RssImage)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ImagePiece o m RssURI -> ZipConduit ImagePiece o m RssURI
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ImagePiece RssURI -> ConduitT ImagePiece RssURI m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ImagePiece RssURI
_imageUri ConduitT ImagePiece RssURI m ()
-> ConduitM RssURI o m RssURI -> ConduitT ImagePiece o m RssURI
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM RssURI o m RssURI
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC RssURI
uri)  -- Lenient
    ZipConduit
  ImagePiece
  o
  m
  (Text -> RssURI -> Maybe Int -> Maybe Int -> Text -> RssImage)
-> ZipConduit ImagePiece o m Text
-> ZipConduit
     ImagePiece
     o
     m
     (RssURI -> Maybe Int -> Maybe Int -> Text -> RssImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ImagePiece o m Text -> ZipConduit ImagePiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ImagePiece Text -> ConduitT ImagePiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ImagePiece Text
_imageTitle ConduitT ImagePiece Text m ()
-> ConduitM Text o m Text -> ConduitT ImagePiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC Text
"Unnamed image")  -- Lenient
    ZipConduit
  ImagePiece
  o
  m
  (RssURI -> Maybe Int -> Maybe Int -> Text -> RssImage)
-> ZipConduit ImagePiece o m RssURI
-> ZipConduit
     ImagePiece o m (Maybe Int -> Maybe Int -> Text -> RssImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ImagePiece o m RssURI -> ZipConduit ImagePiece o m RssURI
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ImagePiece RssURI -> ConduitT ImagePiece RssURI m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ImagePiece RssURI
_imageLink ConduitT ImagePiece RssURI m ()
-> ConduitM RssURI o m RssURI -> ConduitT ImagePiece o m RssURI
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM RssURI o m RssURI
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC RssURI
nullURI)  -- Lenient
    ZipConduit
  ImagePiece o m (Maybe Int -> Maybe Int -> Text -> RssImage)
-> ZipConduit ImagePiece o m (Maybe Int)
-> ZipConduit ImagePiece o m (Maybe Int -> Text -> RssImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> ZipConduit ImagePiece o m (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ZipConduit ImagePiece o m (Maybe Int -> Text -> RssImage)
-> ZipConduit ImagePiece o m (Maybe Int)
-> ZipConduit ImagePiece o m (Text -> RssImage)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe Int -> ZipConduit ImagePiece o m (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a
mzero
    ZipConduit ImagePiece o m (Text -> RssImage)
-> ZipConduit ImagePiece o m Text
-> ZipConduit ImagePiece o m RssImage
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ZipConduit ImagePiece o m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
forall a. Monoid a => a
mempty
  piece :: [ConduitT Event o m (Maybe ImagePiece)]
piece = [ (RssURI -> ImagePiece) -> Maybe RssURI -> Maybe ImagePiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssURI -> ImagePiece
ImageUri (Maybe RssURI -> Maybe ImagePiece)
-> ConduitT Event o m (Maybe RssURI)
-> ConduitT Event o m (Maybe ImagePiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m RssURI)
-> ConduitT Event o m (Maybe RssURI)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"url" AttrParser ()
ignoreAttrs (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. a -> b -> a
const (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI)
-> ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. (a -> b) -> a -> b
$ ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitT Event o m Text
-> (Text -> ConduitM Event o m RssURI) -> ConduitM Event o m RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitM Event o m RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI)
          , (Text -> ImagePiece) -> Maybe Text -> Maybe ImagePiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ImagePiece
ImageTitle (Maybe Text -> Maybe ImagePiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe ImagePiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitT Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"title" AttrParser ()
ignoreAttrs (ConduitT Event o m Text -> () -> ConduitT Event o m Text
forall a b. a -> b -> a
const ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (RssURI -> ImagePiece) -> Maybe RssURI -> Maybe ImagePiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssURI -> ImagePiece
ImageLink (Maybe RssURI -> Maybe ImagePiece)
-> ConduitT Event o m (Maybe RssURI)
-> ConduitT Event o m (Maybe ImagePiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m RssURI)
-> ConduitT Event o m (Maybe RssURI)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"link" AttrParser ()
ignoreAttrs (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. a -> b -> a
const (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI)
-> ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. (a -> b) -> a -> b
$ ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitT Event o m Text
-> (Text -> ConduitM Event o m RssURI) -> ConduitM Event o m RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitM Event o m RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI)
          ]
  attributes :: AttrParser RssURI
attributes = (Name -> AttrParser Text
requireAttr (Text -> Name
rdfName Text
"about") AttrParser Text -> (Text -> AttrParser RssURI) -> AttrParser RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> AttrParser RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI) AttrParser RssURI -> AttrParser () -> AttrParser RssURI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* AttrParser ()
ignoreAttrs


-- | Parse an @\<items\>@ element.
rss1ChannelItems :: MonadThrow m => ConduitM Event o m (Maybe [Text])
rss1ChannelItems :: ConduitM Event o m (Maybe [Text])
rss1ChannelItems = (Maybe (Maybe [Text]) -> Maybe [Text])
-> ConduitT Event o m (Maybe (Maybe [Text]))
-> ConduitM Event o m (Maybe [Text])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe [Text]) -> Maybe [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ConduitT Event o m (Maybe (Maybe [Text]))
 -> ConduitM Event o m (Maybe [Text]))
-> ConduitT Event o m (Maybe (Maybe [Text]))
-> ConduitM Event o m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ Text
-> AttrParser ()
-> (() -> ConduitM Event o m (Maybe [Text]))
-> ConduitT Event o m (Maybe (Maybe [Text]))
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"items" AttrParser ()
ignoreAttrs ((() -> ConduitM Event o m (Maybe [Text]))
 -> ConduitT Event o m (Maybe (Maybe [Text])))
-> (() -> ConduitM Event o m (Maybe [Text]))
-> ConduitT Event o m (Maybe (Maybe [Text]))
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m (Maybe [Text])
-> () -> ConduitM Event o m (Maybe [Text])
forall a b. a -> b -> a
const (ConduitM Event o m (Maybe [Text])
 -> () -> ConduitM Event o m (Maybe [Text]))
-> ConduitM Event o m (Maybe [Text])
-> ()
-> ConduitM Event o m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ Text
-> AttrParser ()
-> (() -> ConduitM Event o m [Text])
-> ConduitM Event o m (Maybe [Text])
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rdfTag Text
"Seq" AttrParser ()
ignoreAttrs ((() -> ConduitM Event o m [Text])
 -> ConduitM Event o m (Maybe [Text]))
-> (() -> ConduitM Event o m [Text])
-> ConduitM Event o m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m [Text] -> () -> ConduitM Event o m [Text]
forall a b. a -> b -> a
const (ConduitM Event o m [Text] -> () -> ConduitM Event o m [Text])
-> ConduitM Event o m [Text] -> () -> ConduitM Event o m [Text]
forall a b. (a -> b) -> a -> b
$ ConduitT Event o m (Maybe Text) -> ConduitM Event o m [Text]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many (ConduitT Event o m (Maybe Text) -> ConduitM Event o m [Text])
-> ConduitT Event o m (Maybe Text) -> ConduitM Event o m [Text]
forall a b. (a -> b) -> a -> b
$ Text
-> AttrParser Text
-> (Text -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rdfTag Text
"li" AttrParser Text
attributes Text -> ConduitM Event o m Text
forall (m :: * -> *) a. Monad m => a -> m a
return where
  attributes :: AttrParser Text
attributes = Name -> AttrParser Text
requireAttr (Text -> Name
rdfName Text
"resource") AttrParser Text -> AttrParser () -> AttrParser Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* AttrParser ()
ignoreAttrs


data Rss1Channel extensions = Rss1Channel
  { Rss1Channel extensions -> RssURI
channelId'          :: RssURI
  , Rss1Channel extensions -> Text
channelTitle'       :: Text
  , Rss1Channel extensions -> RssURI
channelLink'        :: RssURI
  , Rss1Channel extensions -> Text
channelDescription' :: Text
  , Rss1Channel extensions -> [Text]
channelItems'       :: [Text]
  , Rss1Channel extensions -> Maybe RssImage
channelImage'       :: Maybe RssImage
  , Rss1Channel extensions -> Maybe RssURI
channelTextInput'   :: Maybe RssURI
  , Rss1Channel extensions -> RssChannelExtension extensions
channelExtensions'  :: RssChannelExtension extensions
  }

data ChannelPiece = ChannelTitle { ChannelPiece -> Text
__channelTitle :: Text }
  | ChannelLink { ChannelPiece -> RssURI
__channelLink :: RssURI }
  | ChannelDescription { ChannelPiece -> Text
__channelDescription :: Text }
  | ChannelImage { ChannelPiece -> RssImage
__channelImage :: RssImage }
  | ChannelItems { ChannelPiece -> [Text]
__channelItems :: [Text] }
  | ChannelTextInput { ChannelPiece -> RssURI
__channelTextInput :: RssURI }
  | ChannelOther { ChannelPiece -> NonEmpty Event
__channelOther :: NonEmpty Event }

makeLenses ''ChannelPiece


-- | Parse a @\<channel\>@ element.
--
-- RSS extensions are automatically parsed based on the inferred result type.
rss1Channel :: ParseRssExtension e => MonadThrow m => ConduitM Event o m (Maybe (Rss1Channel e))
rss1Channel :: ConduitM Event o m (Maybe (Rss1Channel e))
rss1Channel = Text
-> AttrParser RssURI
-> (RssURI -> ConduitM Event o m (Rss1Channel e))
-> ConduitM Event o m (Maybe (Rss1Channel e))
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"channel" AttrParser RssURI
attributes ((RssURI -> ConduitM Event o m (Rss1Channel e))
 -> ConduitM Event o m (Maybe (Rss1Channel e)))
-> (RssURI -> ConduitM Event o m (Rss1Channel e))
-> ConduitM Event o m (Maybe (Rss1Channel e))
forall a b. (a -> b) -> a -> b
$ \RssURI
channelId -> (ConduitT Event ChannelPiece m (Maybe ChannelPiece)
-> ConduitT Event ChannelPiece m ()
forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ([ConduitT Event ChannelPiece m (Maybe ChannelPiece)]
-> ConduitT Event ChannelPiece m (Maybe ChannelPiece)
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event ChannelPiece m (Maybe ChannelPiece)]
forall o. [ConduitT Event o m (Maybe ChannelPiece)]
piece) ConduitT Event ChannelPiece m ()
-> ConduitM ChannelPiece o m (Rss1Channel e)
-> ConduitM Event o m (Rss1Channel e)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| RssURI -> ConduitM ChannelPiece o m (Rss1Channel e)
forall (m :: * -> *) extensions o.
(MonadThrow m, ParseRssExtension extensions) =>
RssURI -> ConduitT ChannelPiece o m (Rss1Channel extensions)
parser RssURI
channelId) ConduitM Event o m (Rss1Channel e)
-> ConduitT Event o m [()] -> ConduitM Event o m (Rss1Channel e)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitT Event o m (Maybe ()) -> ConduitT Event o m [()]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe ())
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent where
  parser :: RssURI -> ConduitT ChannelPiece o m (Rss1Channel extensions)
parser RssURI
channelId = ZipConduit ChannelPiece o m (Rss1Channel extensions)
-> ConduitT ChannelPiece o m (Rss1Channel extensions)
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit (ZipConduit ChannelPiece o m (Rss1Channel extensions)
 -> ConduitT ChannelPiece o m (Rss1Channel extensions))
-> ZipConduit ChannelPiece o m (Rss1Channel extensions)
-> ConduitT ChannelPiece o m (Rss1Channel extensions)
forall a b. (a -> b) -> a -> b
$ RssURI
-> Text
-> RssURI
-> Text
-> [Text]
-> Maybe RssImage
-> Maybe RssURI
-> RssChannelExtension extensions
-> Rss1Channel extensions
forall extensions.
RssURI
-> Text
-> RssURI
-> Text
-> [Text]
-> Maybe RssImage
-> Maybe RssURI
-> RssChannelExtension extensions
-> Rss1Channel extensions
Rss1Channel RssURI
channelId
    (Text
 -> RssURI
 -> Text
 -> [Text]
 -> Maybe RssImage
 -> Maybe RssURI
 -> RssChannelExtension extensions
 -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m Text
-> ZipConduit
     ChannelPiece
     o
     m
     (RssURI
      -> Text
      -> [Text]
      -> Maybe RssImage
      -> Maybe RssURI
      -> RssChannelExtension extensions
      -> Rss1Channel extensions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT ChannelPiece o m Text -> ZipConduit ChannelPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece Text -> ConduitT ChannelPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece Text
_channelTitle ConduitT ChannelPiece Text m ()
-> ConduitM Text o m Text -> ConduitT ChannelPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a b. MonadThrow m => Text -> ConduitT a b m a
headRequiredC Text
"Missing <title> element")
    ZipConduit
  ChannelPiece
  o
  m
  (RssURI
   -> Text
   -> [Text]
   -> Maybe RssImage
   -> Maybe RssURI
   -> RssChannelExtension extensions
   -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m RssURI
-> ZipConduit
     ChannelPiece
     o
     m
     (Text
      -> [Text]
      -> Maybe RssImage
      -> Maybe RssURI
      -> RssChannelExtension extensions
      -> Rss1Channel extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ChannelPiece o m RssURI
-> ZipConduit ChannelPiece o m RssURI
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece RssURI -> ConduitT ChannelPiece RssURI m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece RssURI
_channelLink ConduitT ChannelPiece RssURI m ()
-> ConduitM RssURI o m RssURI -> ConduitT ChannelPiece o m RssURI
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM RssURI o m RssURI
forall (m :: * -> *) a b. MonadThrow m => Text -> ConduitT a b m a
headRequiredC Text
"Missing <link> element")
    ZipConduit
  ChannelPiece
  o
  m
  (Text
   -> [Text]
   -> Maybe RssImage
   -> Maybe RssURI
   -> RssChannelExtension extensions
   -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m Text
-> ZipConduit
     ChannelPiece
     o
     m
     ([Text]
      -> Maybe RssImage
      -> Maybe RssURI
      -> RssChannelExtension extensions
      -> Rss1Channel extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ChannelPiece o m Text -> ZipConduit ChannelPiece o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece Text -> ConduitT ChannelPiece Text m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece Text
_channelDescription ConduitT ChannelPiece Text m ()
-> ConduitM Text o m Text -> ConduitT ChannelPiece o m Text
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM Text o m Text
forall (m :: * -> *) a o. Monad m => a -> ConduitT a o m a
headDefC Text
"")  -- Lenient
    ZipConduit
  ChannelPiece
  o
  m
  ([Text]
   -> Maybe RssImage
   -> Maybe RssURI
   -> RssChannelExtension extensions
   -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m [Text]
-> ZipConduit
     ChannelPiece
     o
     m
     (Maybe RssImage
      -> Maybe RssURI
      -> RssChannelExtension extensions
      -> Rss1Channel extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ChannelPiece o m [Text]
-> ZipConduit ChannelPiece o m [Text]
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece [Text] -> ConduitT ChannelPiece [Text] m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece [Text]
_channelItems ConduitT ChannelPiece [Text] m ()
-> ConduitM [Text] o m [Text] -> ConduitT ChannelPiece o m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT [Text] Text m ()
forall (m :: * -> *) mono.
(Monad m, MonoFoldable mono) =>
ConduitT mono (Element mono) m ()
concatC ConduitT [Text] Text m ()
-> ConduitM Text o m [Text] -> ConduitM [Text] o m [Text]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Text o m [Text]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
    ZipConduit
  ChannelPiece
  o
  m
  (Maybe RssImage
   -> Maybe RssURI
   -> RssChannelExtension extensions
   -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m (Maybe RssImage)
-> ZipConduit
     ChannelPiece
     o
     m
     (Maybe RssURI
      -> RssChannelExtension extensions -> Rss1Channel extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ChannelPiece o m (Maybe RssImage)
-> ZipConduit ChannelPiece o m (Maybe RssImage)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece RssImage
-> ConduitT ChannelPiece RssImage m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece RssImage
_channelImage ConduitT ChannelPiece RssImage m ()
-> ConduitM RssImage o m (Maybe RssImage)
-> ConduitT ChannelPiece o m (Maybe RssImage)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM RssImage o m (Maybe RssImage)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC)
    ZipConduit
  ChannelPiece
  o
  m
  (Maybe RssURI
   -> RssChannelExtension extensions -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m (Maybe RssURI)
-> ZipConduit
     ChannelPiece
     o
     m
     (RssChannelExtension extensions -> Rss1Channel extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ChannelPiece o m (Maybe RssURI)
-> ZipConduit ChannelPiece o m (Maybe RssURI)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece RssURI -> ConduitT ChannelPiece RssURI m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece RssURI
_channelTextInput ConduitT ChannelPiece RssURI m ()
-> ConduitM RssURI o m (Maybe RssURI)
-> ConduitT ChannelPiece o m (Maybe RssURI)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM RssURI o m (Maybe RssURI)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC)
    ZipConduit
  ChannelPiece
  o
  m
  (RssChannelExtension extensions -> Rss1Channel extensions)
-> ZipConduit ChannelPiece o m (RssChannelExtension extensions)
-> ZipConduit ChannelPiece o m (Rss1Channel extensions)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT ChannelPiece o m (RssChannelExtension extensions)
-> ZipConduit ChannelPiece o m (RssChannelExtension extensions)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' ChannelPiece (NonEmpty Event)
-> ConduitT ChannelPiece (NonEmpty Event) m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC Traversal' ChannelPiece (NonEmpty Event)
_channelOther ConduitT ChannelPiece (NonEmpty Event) m ()
-> ConduitM (NonEmpty Event) o m (RssChannelExtension extensions)
-> ConduitT ChannelPiece o m (RssChannelExtension extensions)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT (NonEmpty Event) Event m ()
forall (m :: * -> *) mono.
(Monad m, MonoFoldable mono) =>
ConduitT mono (Element mono) m ()
concatC ConduitT (NonEmpty Event) Event m ()
-> ConduitM Event o m (RssChannelExtension extensions)
-> ConduitM (NonEmpty Event) o m (RssChannelExtension extensions)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Event o m (RssChannelExtension extensions)
forall a (m :: * -> *) o.
(ParseRssExtension a, MonadThrow m) =>
ConduitT Event o m (RssChannelExtension a)
parseRssChannelExtension)
  piece :: [ConduitT Event o m (Maybe ChannelPiece)]
piece = [ (Text -> ChannelPiece) -> Maybe Text -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ChannelPiece
ChannelTitle (Maybe Text -> Maybe ChannelPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"title" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , (RssURI -> ChannelPiece) -> Maybe RssURI -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssURI -> ChannelPiece
ChannelLink (Maybe RssURI -> Maybe ChannelPiece)
-> ConduitT Event o m (Maybe RssURI)
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m RssURI)
-> ConduitT Event o m (Maybe RssURI)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"link" AttrParser ()
ignoreAttrs (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. a -> b -> a
const (ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI)
-> ConduitM Event o m RssURI -> () -> ConduitM Event o m RssURI
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content ConduitM Event o m Text
-> (Text -> ConduitM Event o m RssURI) -> ConduitM Event o m RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> ConduitM Event o m RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI)
          , (Text -> ChannelPiece) -> Maybe Text -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ChannelPiece
ChannelDescription (Maybe Text -> Maybe ChannelPiece)
-> ConduitT Event o m (Maybe Text)
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser ()
-> (() -> ConduitM Event o m Text)
-> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"description" AttrParser ()
ignoreAttrs (ConduitM Event o m Text -> () -> ConduitM Event o m Text
forall a b. a -> b -> a
const ConduitM Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content)
          , ([Text] -> ChannelPiece) -> Maybe [Text] -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Text] -> ChannelPiece
ChannelItems (Maybe [Text] -> Maybe ChannelPiece)
-> ConduitT Event o m (Maybe [Text])
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe [Text])
forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe [Text])
rss1ChannelItems
          , (RssImage -> ChannelPiece) -> Maybe RssImage -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssImage -> ChannelPiece
ChannelImage (Maybe RssImage -> Maybe ChannelPiece)
-> ConduitT Event o m (Maybe RssImage)
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe RssImage)
forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe RssImage)
rss1Image
          , (RssURI -> ChannelPiece) -> Maybe RssURI -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssURI -> ChannelPiece
ChannelTextInput (Maybe RssURI -> Maybe ChannelPiece)
-> ConduitT Event o m (Maybe RssURI)
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> AttrParser RssURI
-> (RssURI -> ConduitM Event o m RssURI)
-> ConduitT Event o m (Maybe RssURI)
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rss1Tag Text
"textinput" (Name -> AttrParser Text
requireAttr (Text -> Name
rdfName Text
"resource") AttrParser Text -> (Text -> AttrParser RssURI) -> AttrParser RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> AttrParser RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI) RssURI -> ConduitM Event o m RssURI
forall (m :: * -> *) a. Monad m => a -> m a
return
          , (NonEmpty Event -> ChannelPiece)
-> Maybe (NonEmpty Event) -> Maybe ChannelPiece
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NonEmpty Event -> ChannelPiece
ChannelOther (Maybe (NonEmpty Event) -> Maybe ChannelPiece)
-> ([Event] -> Maybe (NonEmpty Event))
-> [Event]
-> Maybe ChannelPiece
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event] -> Maybe (NonEmpty Event)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty ([Event] -> Maybe ChannelPiece)
-> ConduitT Event o m [Event]
-> ConduitT Event o m (Maybe ChannelPiece)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ConduitT Event Event m (Maybe ()) -> ConduitT Event Event m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ConduitT Event Event m (Maybe ())
forall (m :: * -> *).
MonadThrow m =>
ConduitT Event Event m (Maybe ())
takeAnyTreeContent ConduitT Event Event m ()
-> ConduitT Event o m [Event] -> ConduitT Event o m [Event]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitT Event o m [Event]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
          ]
  attributes :: AttrParser RssURI
attributes = (Name -> AttrParser Text
requireAttr (Text -> Name
rdfName Text
"about") AttrParser Text -> (Text -> AttrParser RssURI) -> AttrParser RssURI
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> AttrParser RssURI
forall (m :: * -> *). MonadThrow m => Text -> m RssURI
asRssURI) AttrParser RssURI -> AttrParser () -> AttrParser RssURI
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* AttrParser ()
ignoreAttrs


data Rss1Document e = Rss1Document (Rss1Channel e) (Maybe RssImage) [RssItem e] (Maybe RssTextInput)

rss1ToRss2 :: Rss1Document e -> RssDocument e
rss1ToRss2 :: Rss1Document e -> RssDocument e
rss1ToRss2 (Rss1Document Rss1Channel e
channel Maybe RssImage
image [RssItem e]
items Maybe RssTextInput
textInput) = Version
-> Text
-> RssURI
-> Text
-> [RssItem e]
-> Text
-> Text
-> Text
-> Text
-> Maybe UTCTime
-> Maybe UTCTime
-> [RssCategory]
-> Text
-> Maybe RssURI
-> Maybe RssCloud
-> Maybe Int
-> Maybe RssImage
-> Text
-> Maybe RssTextInput
-> Set Hour
-> Set Day
-> RssChannelExtension e
-> RssDocument e
forall extensions.
Version
-> Text
-> RssURI
-> Text
-> [RssItem extensions]
-> Text
-> Text
-> Text
-> Text
-> Maybe UTCTime
-> Maybe UTCTime
-> [RssCategory]
-> Text
-> Maybe RssURI
-> Maybe RssCloud
-> Maybe Int
-> Maybe RssImage
-> Text
-> Maybe RssTextInput
-> Set Hour
-> Set Day
-> RssChannelExtension extensions
-> RssDocument extensions
RssDocument
  ([Int] -> [String] -> Version
Version [Int
1] [])
  (Rss1Channel e -> Text
forall extensions. Rss1Channel extensions -> Text
channelTitle' Rss1Channel e
channel)
  (Rss1Channel e -> RssURI
forall extensions. Rss1Channel extensions -> RssURI
channelLink' Rss1Channel e
channel)
  (Rss1Channel e -> Text
forall extensions. Rss1Channel extensions -> Text
channelDescription' Rss1Channel e
channel)
  [RssItem e]
items
  Text
forall a. Monoid a => a
mempty
  Text
forall a. Monoid a => a
mempty
  Text
forall a. Monoid a => a
mempty
  Text
forall a. Monoid a => a
mempty
  Maybe UTCTime
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Maybe UTCTime
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  [RssCategory]
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Text
forall a. Monoid a => a
mempty
  Maybe RssURI
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Maybe RssCloud
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Maybe Int
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  Maybe RssImage
image
  Text
forall a. Monoid a => a
mempty
  Maybe RssTextInput
textInput
  Set Hour
forall a. Monoid a => a
mempty
  Set Day
forall a. Monoid a => a
mempty
  (Rss1Channel e -> RssChannelExtension e
forall extensions.
Rss1Channel extensions -> RssChannelExtension extensions
channelExtensions' Rss1Channel e
channel)

data DocumentPiece e = DocumentChannel { DocumentPiece e -> Rss1Channel e
__documentChannel :: Rss1Channel e }
  | DocumentImage { DocumentPiece e -> RssImage
__documentImage :: RssImage }
  | DocumentItem { DocumentPiece e -> RssItem e
__documentItem :: RssItem e }
  | DocumentTextInput { DocumentPiece e -> RssTextInput
__documentTextInput :: RssTextInput }

makeLenses ''DocumentPiece


-- | Parse an @\<RDF\>@ element.
--
-- RSS extensions are automatically parsed based on the inferred result type.
rss1Document :: ParseRssExtension e => MonadCatch m => ConduitM Event o m (Maybe (RssDocument e))
rss1Document :: ConduitM Event o m (Maybe (RssDocument e))
rss1Document = (Maybe (Rss1Document e) -> Maybe (RssDocument e))
-> ConduitT Event o m (Maybe (Rss1Document e))
-> ConduitM Event o m (Maybe (RssDocument e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Rss1Document e -> RssDocument e)
-> Maybe (Rss1Document e) -> Maybe (RssDocument e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rss1Document e -> RssDocument e
forall e. Rss1Document e -> RssDocument e
rss1ToRss2) (ConduitT Event o m (Maybe (Rss1Document e))
 -> ConduitM Event o m (Maybe (RssDocument e)))
-> ConduitT Event o m (Maybe (Rss1Document e))
-> ConduitM Event o m (Maybe (RssDocument e))
forall a b. (a -> b) -> a -> b
$ Text
-> AttrParser ()
-> (() -> ConduitM Event o m (Rss1Document e))
-> ConduitT Event o m (Maybe (Rss1Document e))
forall (m :: * -> *) a o b.
MonadThrow m =>
Text
-> AttrParser a
-> (a -> ConduitM Event o m b)
-> ConduitM Event o m (Maybe b)
rdfTag Text
"RDF" AttrParser ()
ignoreAttrs ((() -> ConduitM Event o m (Rss1Document e))
 -> ConduitT Event o m (Maybe (Rss1Document e)))
-> (() -> ConduitM Event o m (Rss1Document e))
-> ConduitT Event o m (Maybe (Rss1Document e))
forall a b. (a -> b) -> a -> b
$ ConduitM Event o m (Rss1Document e)
-> () -> ConduitM Event o m (Rss1Document e)
forall a b. a -> b -> a
const (ConduitM Event o m (Rss1Document e)
 -> () -> ConduitM Event o m (Rss1Document e))
-> ConduitM Event o m (Rss1Document e)
-> ()
-> ConduitM Event o m (Rss1Document e)
forall a b. (a -> b) -> a -> b
$ (ConduitT Event (DocumentPiece e) m (Maybe (DocumentPiece e))
-> ConduitT Event (DocumentPiece e) m ()
forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ([ConduitT Event (DocumentPiece e) m (Maybe (DocumentPiece e))]
-> ConduitT Event (DocumentPiece e) m (Maybe (DocumentPiece e))
forall (m :: * -> *) o a.
Monad m =>
[ConduitT Event o m (Maybe a)] -> ConduitT Event o m (Maybe a)
choose [ConduitT Event (DocumentPiece e) m (Maybe (DocumentPiece e))]
forall o. [ConduitT Event o m (Maybe (DocumentPiece e))]
piece) ConduitT Event (DocumentPiece e) m ()
-> ConduitM (DocumentPiece e) o m (Rss1Document e)
-> ConduitM Event o m (Rss1Document e)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (DocumentPiece e) o m (Rss1Document e)
forall e o. ConduitT (DocumentPiece e) o m (Rss1Document e)
parser) ConduitM Event o m (Rss1Document e)
-> ConduitT Event o m [()] -> ConduitM Event o m (Rss1Document e)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ConduitT Event o m (Maybe ()) -> ConduitT Event o m [()]
forall (m :: * -> *) o a.
Monad m =>
ConduitT Event o m (Maybe a) -> ConduitT Event o m [a]
many ConduitT Event o m (Maybe ())
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe ())
ignoreAnyTreeContent where
  parser :: ConduitT (DocumentPiece e) o m (Rss1Document e)
parser = ZipConduit (DocumentPiece e) o m (Rss1Document e)
-> ConduitT (DocumentPiece e) o m (Rss1Document e)
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit (ZipConduit (DocumentPiece e) o m (Rss1Document e)
 -> ConduitT (DocumentPiece e) o m (Rss1Document e))
-> ZipConduit (DocumentPiece e) o m (Rss1Document e)
-> ConduitT (DocumentPiece e) o m (Rss1Document e)
forall a b. (a -> b) -> a -> b
$ Rss1Channel e
-> Maybe RssImage
-> [RssItem e]
-> Maybe RssTextInput
-> Rss1Document e
forall e.
Rss1Channel e
-> Maybe RssImage
-> [RssItem e]
-> Maybe RssTextInput
-> Rss1Document e
Rss1Document
    (Rss1Channel e
 -> Maybe RssImage
 -> [RssItem e]
 -> Maybe RssTextInput
 -> Rss1Document e)
-> ZipConduit (DocumentPiece e) o m (Rss1Channel e)
-> ZipConduit
     (DocumentPiece e)
     o
     m
     (Maybe RssImage
      -> [RssItem e] -> Maybe RssTextInput -> Rss1Document e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT (DocumentPiece e) o m (Rss1Channel e)
-> ZipConduit (DocumentPiece e) o m (Rss1Channel e)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' (DocumentPiece e) (Rss1Channel e)
-> ConduitT (DocumentPiece e) (Rss1Channel e) m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC forall e. Traversal' (DocumentPiece e) (Rss1Channel e)
Traversal' (DocumentPiece e) (Rss1Channel e)
_documentChannel ConduitT (DocumentPiece e) (Rss1Channel e) m ()
-> ConduitM (Rss1Channel e) o m (Rss1Channel e)
-> ConduitT (DocumentPiece e) o m (Rss1Channel e)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Text -> ConduitM (Rss1Channel e) o m (Rss1Channel e)
forall (m :: * -> *) a b. MonadThrow m => Text -> ConduitT a b m a
headRequiredC Text
"Missing <channel> element")
    ZipConduit
  (DocumentPiece e)
  o
  m
  (Maybe RssImage
   -> [RssItem e] -> Maybe RssTextInput -> Rss1Document e)
-> ZipConduit (DocumentPiece e) o m (Maybe RssImage)
-> ZipConduit
     (DocumentPiece e)
     o
     m
     ([RssItem e] -> Maybe RssTextInput -> Rss1Document e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT (DocumentPiece e) o m (Maybe RssImage)
-> ZipConduit (DocumentPiece e) o m (Maybe RssImage)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' (DocumentPiece e) RssImage
-> ConduitT (DocumentPiece e) RssImage m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC forall e. Traversal' (DocumentPiece e) RssImage
Traversal' (DocumentPiece e) RssImage
_documentImage ConduitT (DocumentPiece e) RssImage m ()
-> ConduitM RssImage o m (Maybe RssImage)
-> ConduitT (DocumentPiece e) o m (Maybe RssImage)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM RssImage o m (Maybe RssImage)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC)
    ZipConduit
  (DocumentPiece e)
  o
  m
  ([RssItem e] -> Maybe RssTextInput -> Rss1Document e)
-> ZipConduit (DocumentPiece e) o m [RssItem e]
-> ZipConduit
     (DocumentPiece e) o m (Maybe RssTextInput -> Rss1Document e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT (DocumentPiece e) o m [RssItem e]
-> ZipConduit (DocumentPiece e) o m [RssItem e]
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' (DocumentPiece e) (RssItem e)
-> ConduitT (DocumentPiece e) (RssItem e) m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC forall e. Traversal' (DocumentPiece e) (RssItem e)
Traversal' (DocumentPiece e) (RssItem e)
_documentItem ConduitT (DocumentPiece e) (RssItem e) m ()
-> ConduitM (RssItem e) o m [RssItem e]
-> ConduitT (DocumentPiece e) o m [RssItem e]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (RssItem e) o m [RssItem e]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList)
    ZipConduit
  (DocumentPiece e) o m (Maybe RssTextInput -> Rss1Document e)
-> ZipConduit (DocumentPiece e) o m (Maybe RssTextInput)
-> ZipConduit (DocumentPiece e) o m (Rss1Document e)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT (DocumentPiece e) o m (Maybe RssTextInput)
-> ZipConduit (DocumentPiece e) o m (Maybe RssTextInput)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (Traversal' (DocumentPiece e) RssTextInput
-> ConduitT (DocumentPiece e) RssTextInput m ()
forall (m :: * -> *) a b.
Monad m =>
Traversal' a b -> ConduitT a b m ()
projectC forall e. Traversal' (DocumentPiece e) RssTextInput
Traversal' (DocumentPiece e) RssTextInput
_documentTextInput ConduitT (DocumentPiece e) RssTextInput m ()
-> ConduitM RssTextInput o m (Maybe RssTextInput)
-> ConduitT (DocumentPiece e) o m (Maybe RssTextInput)
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM RssTextInput o m (Maybe RssTextInput)
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC)
  piece :: [ConduitT Event o m (Maybe (DocumentPiece e))]
piece = [ (Rss1Channel e -> DocumentPiece e)
-> Maybe (Rss1Channel e) -> Maybe (DocumentPiece e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rss1Channel e -> DocumentPiece e
forall e. Rss1Channel e -> DocumentPiece e
DocumentChannel (Maybe (Rss1Channel e) -> Maybe (DocumentPiece e))
-> ConduitT Event o m (Maybe (Rss1Channel e))
-> ConduitT Event o m (Maybe (DocumentPiece e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe (Rss1Channel e))
forall e (m :: * -> *) o.
(ParseRssExtension e, MonadThrow m) =>
ConduitM Event o m (Maybe (Rss1Channel e))
rss1Channel
          , (RssImage -> DocumentPiece e)
-> Maybe RssImage -> Maybe (DocumentPiece e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssImage -> DocumentPiece e
forall e. RssImage -> DocumentPiece e
DocumentImage (Maybe RssImage -> Maybe (DocumentPiece e))
-> ConduitT Event o m (Maybe RssImage)
-> ConduitT Event o m (Maybe (DocumentPiece e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe RssImage)
forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe RssImage)
rss1Image
          , (RssItem e -> DocumentPiece e)
-> Maybe (RssItem e) -> Maybe (DocumentPiece e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssItem e -> DocumentPiece e
forall e. RssItem e -> DocumentPiece e
DocumentItem (Maybe (RssItem e) -> Maybe (DocumentPiece e))
-> ConduitT Event o m (Maybe (RssItem e))
-> ConduitT Event o m (Maybe (DocumentPiece e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe (RssItem e))
forall e (m :: * -> *) o.
(ParseRssExtension e, MonadCatch m) =>
ConduitM Event o m (Maybe (RssItem e))
rss1Item
          , (RssTextInput -> DocumentPiece e)
-> Maybe RssTextInput -> Maybe (DocumentPiece e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RssTextInput -> DocumentPiece e
forall e. RssTextInput -> DocumentPiece e
DocumentTextInput (Maybe RssTextInput -> Maybe (DocumentPiece e))
-> ConduitT Event o m (Maybe RssTextInput)
-> ConduitT Event o m (Maybe (DocumentPiece e))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (Maybe RssTextInput)
forall (m :: * -> *) o.
MonadThrow m =>
ConduitM Event o m (Maybe RssTextInput)
rss1TextInput
          ]