{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RankNTypes         #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies       #-}
-- | __Content__ extension for RSS.
-- Cf specification at <http://web.resource.org/rss/1.0/modules/content/>.
--
-- This implementation corresponds to the /updated syntax/ from the specification.
module Text.RSS.Extensions.Content
  ( -- * Types
    ContentModule(..)
  , RssChannelExtension(..)
  , RssItemExtension(..)
    -- * Parser
  , contentEncoded
    -- * Renderer
  , renderContentEncoded
    -- * Misc
  , namespacePrefix
  , namespaceURI
  ) where

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

import           Conduit                (ConduitT, Source, ZipConduit (..), headDefC, (.|))
import           Control.Exception.Safe as Exception
import           Control.Monad
import           Data.Maybe
import           Data.Text              (Text)
import qualified Data.Text              as Text
import           Data.XML.Types
import           GHC.Generics
import           Text.XML.Stream.Parse
import qualified Text.XML.Stream.Render as Render
import           URI.ByteString
-- }}}

-- | __Content__ tag type.
newtype ContentModule a = ContentModule a

instance ParseRssExtension a => ParseRssExtension (ContentModule a) where
  parseRssChannelExtension :: ConduitT Event o m (RssChannelExtension (ContentModule a))
parseRssChannelExtension = RssChannelExtension a -> RssChannelExtension (ContentModule a)
forall a.
RssChannelExtension a -> RssChannelExtension (ContentModule a)
ContentChannel (RssChannelExtension a -> RssChannelExtension (ContentModule a))
-> ConduitT Event o m (RssChannelExtension a)
-> ConduitT Event o m (RssChannelExtension (ContentModule a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m (RssChannelExtension a)
forall a (m :: * -> *) o.
(ParseRssExtension a, MonadThrow m) =>
ConduitT Event o m (RssChannelExtension a)
parseRssChannelExtension
  parseRssItemExtension :: ConduitT Event o m (RssItemExtension (ContentModule a))
parseRssItemExtension    = ZipConduit Event o m (RssItemExtension (ContentModule a))
-> ConduitT Event o m (RssItemExtension (ContentModule a))
forall i o (m :: * -> *) r. ZipConduit i o m r -> ConduitT i o m r
getZipConduit (ZipConduit Event o m (RssItemExtension (ContentModule a))
 -> ConduitT Event o m (RssItemExtension (ContentModule a)))
-> ZipConduit Event o m (RssItemExtension (ContentModule a))
-> ConduitT Event o m (RssItemExtension (ContentModule a))
forall a b. (a -> b) -> a -> b
$ Text -> RssItemExtension a -> RssItemExtension (ContentModule a)
forall a.
Text -> RssItemExtension a -> RssItemExtension (ContentModule a)
ContentItem
    (Text -> RssItemExtension a -> RssItemExtension (ContentModule a))
-> ZipConduit Event o m Text
-> ZipConduit
     Event
     o
     m
     (RssItemExtension a -> RssItemExtension (ContentModule a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ConduitT Event o m Text -> ZipConduit Event o m Text
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit (ConduitT Event Text m (Maybe Text) -> ConduitT Event Text m ()
forall (m :: * -> *) b.
MonadThrow m =>
ConduitT Event b m (Maybe b) -> ConduitT Event b m ()
manyYield' ConduitT Event Text m (Maybe Text)
forall (m :: * -> *) o.
MonadThrow m =>
ConduitT Event o m (Maybe Text)
contentEncoded ConduitT Event Text m ()
-> ConduitM Text o m Text -> ConduitT Event 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
  Event
  o
  m
  (RssItemExtension a -> RssItemExtension (ContentModule a))
-> ZipConduit Event o m (RssItemExtension a)
-> ZipConduit Event o m (RssItemExtension (ContentModule a))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ConduitT Event o m (RssItemExtension a)
-> ZipConduit Event o m (RssItemExtension a)
forall i o (m :: * -> *) r. ConduitT i o m r -> ZipConduit i o m r
ZipConduit ConduitT Event o m (RssItemExtension a)
forall a (m :: * -> *) o.
(ParseRssExtension a, MonadThrow m) =>
ConduitT Event o m (RssItemExtension a)
parseRssItemExtension

instance RenderRssExtension a => RenderRssExtension (ContentModule a) where
  renderRssChannelExtension :: RssChannelExtension (ContentModule a) -> ConduitT () Event m ()
renderRssChannelExtension (ContentChannel a) = RssChannelExtension a -> ConduitT () Event m ()
forall e (m :: * -> *).
(RenderRssExtension e, Monad m) =>
RssChannelExtension e -> ConduitT () Event m ()
renderRssChannelExtension RssChannelExtension a
a
  renderRssItemExtension :: RssItemExtension (ContentModule a) -> ConduitT () Event m ()
renderRssItemExtension (ContentItem e a) = do
    Bool -> ConduitT () Event m () -> ConduitT () Event m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text -> Bool
Text.null Text
e) (ConduitT () Event m () -> ConduitT () Event m ())
-> ConduitT () Event m () -> ConduitT () Event m ()
forall a b. (a -> b) -> a -> b
$ Text -> ConduitT () Event m ()
forall (m :: * -> *). Monad m => Text -> ConduitT () Event m ()
renderContentEncoded Text
e
    RssItemExtension a -> ConduitT () Event m ()
forall e (m :: * -> *).
(RenderRssExtension e, Monad m) =>
RssItemExtension e -> ConduitT () Event m ()
renderRssItemExtension RssItemExtension a
a

data instance RssChannelExtension (ContentModule a) = ContentChannel { RssChannelExtension (ContentModule a) -> RssChannelExtension a
channelContentOther :: RssChannelExtension a }

deriving instance Eq (RssChannelExtension a) => Eq (RssChannelExtension (ContentModule a))
deriving instance Ord (RssChannelExtension a) => Ord (RssChannelExtension (ContentModule a))
deriving instance Read (RssChannelExtension a) => Read (RssChannelExtension (ContentModule a))
deriving instance Show (RssChannelExtension a) => Show (RssChannelExtension (ContentModule a))
deriving instance Generic (RssChannelExtension a) => Generic (RssChannelExtension (ContentModule a))

data instance RssItemExtension (ContentModule a) = ContentItem
  { RssItemExtension (ContentModule a) -> Text
itemContent :: Text
  , RssItemExtension (ContentModule a) -> RssItemExtension a
itemContentOther   :: RssItemExtension a
  }

deriving instance Eq (RssItemExtension a) => Eq (RssItemExtension (ContentModule a))
deriving instance Ord (RssItemExtension a) => Ord (RssItemExtension (ContentModule a))
deriving instance Read (RssItemExtension a) => Read (RssItemExtension (ContentModule a))
deriving instance Show (RssItemExtension a) => Show (RssItemExtension (ContentModule a))
deriving instance Generic (RssItemExtension a) => Generic (RssItemExtension (ContentModule a))



-- | XML prefix is @content@.
namespacePrefix :: Text
namespacePrefix :: Text
namespacePrefix = Text
"content"

-- | XML namespace is @http://purl.org/rss/1.0/modules/content/@
namespaceURI :: URIRef Absolute
namespaceURI :: URIRef Absolute
namespaceURI = URIRef Absolute
uri where Right URIRef Absolute
uri = URIParserOptions
-> ByteString -> Either URIParseError (URIRef Absolute)
parseURI URIParserOptions
laxURIParserOptions ByteString
"http://purl.org/rss/1.0/modules/content/"

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
namespacePrefix)

-- | Parse a @\<content:encoded\>@ element.
contentEncoded :: MonadThrow m => ConduitT Event o m (Maybe Text)
contentEncoded :: ConduitT Event o m (Maybe Text)
contentEncoded = NameMatcher Name
-> ConduitT Event o m Text -> ConduitT Event o m (Maybe Text)
forall (m :: * -> *) a o b.
MonadThrow m =>
NameMatcher a
-> ConduitT Event o m b -> ConduitT Event o m (Maybe b)
tagIgnoreAttrs ((Name -> Bool) -> NameMatcher Name
matching (Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Name
contentName Text
"encoded")) ConduitT Event o m Text
forall (m :: * -> *) o. MonadThrow m => ConduitT Event o m Text
content

-- | Render a @\<content:encoded\>@ element.
renderContentEncoded :: Monad m => Text -> ConduitT () Event m ()
renderContentEncoded :: Text -> ConduitT () Event m ()
renderContentEncoded = Name
-> Attributes -> ConduitT () Event m () -> ConduitT () Event m ()
forall (m :: * -> *) i.
Monad m =>
Name
-> Attributes -> ConduitT i Event m () -> ConduitT i Event m ()
Render.tag (Text -> Name
contentName Text
"encoded") Attributes
forall a. Monoid a => a
mempty (ConduitT () Event m () -> ConduitT () Event m ())
-> (Text -> ConduitT () Event m ())
-> Text
-> ConduitT () Event m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ConduitT () Event m ()
forall (m :: * -> *) i. Monad m => Text -> ConduitT i Event m ()
Render.content