{-# OPTIONS -fno-warn-incomplete-patterns #-}

--------------------------------------------------------------------
-- |
-- Module    : Text.Feed.Constructor
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Description: Module for an abstraction layer between different kinds of feeds.
--
--------------------------------------------------------------------
module Text.Feed.Constructor
  ( FeedKind(..)
  , newFeed -- :: FeedKind  -> Feed
  , feedFromRSS -- :: RSS       -> Feed
  , feedFromAtom -- :: Atom.Feed -> Feed
  , feedFromRDF -- :: RSS1.Feed -> Feed
  , feedFromXML -- :: Element   -> Feed
  , getFeedKind -- :: Feed      -> FeedKind
  , FeedSetter -- type _ a = a -> Feed -> Feed
  , addItem -- :: FeedSetter Item
  , withFeedTitle -- :: FeedSetter Text
  , withFeedHome -- :: FeedSetter URLString
  , withFeedHTML -- :: FeedSetter URLString
  , withFeedDescription -- :: FeedSetter Text
  , withFeedPubDate -- :: FeedSetter DateString
  , withFeedLastUpdate -- :: FeedSetter DateString
  , withFeedDate -- :: FeedSetter DateString
  , withFeedLogoLink -- :: FeedSetter URLString
  , withFeedLanguage -- :: FeedSetter Text
  , withFeedCategories -- :: FeedSetter [(Text, Maybe Text)]
  , withFeedGenerator -- :: FeedSetter Text
  , withFeedItems -- :: FeedSetter [Item]
  , newItem -- :: FeedKind   -> Item
  , getItemKind -- :: Item       -> FeedKind
  , atomEntryToItem -- :: Atom.Entry -> Item
  , rssItemToItem -- :: RSS.Item   -> Item
  , rdfItemToItem -- :: RSS1.Item  -> Item
  , ItemSetter -- type _ a = a -> Item -> Item
  , withItemTitle -- :: ItemSetter Text
  , withItemLink -- :: ItemSetter URLString
  , withItemPubDate -- :: ItemSetter DateString
  , withItemDate -- :: ItemSetter DateString
  , withItemAuthor -- :: ItemSetter Text
  , withItemCommentLink -- :: ItemSetter Text
  , withItemEnclosure -- :: Text -> Maybe Text -> ItemSetter Integer
  , withItemFeedLink -- :: Text -> ItemSetter Text
  , withItemId -- :: Bool   -> ItemSetter Text
  , withItemCategories -- :: ItemSetter [(Text, Maybe Text)]
  , withItemDescription -- :: ItemSetter Text
  , withItemRights -- :: ItemSetter Text
  ) where

import Prelude.Compat

import Text.Feed.Types as Feed.Types

import Text.Atom.Feed as Atom
import Text.DublinCore.Types
import Text.RSS.Syntax as RSS
import Text.RSS1.Syntax as RSS1

import Data.XML.Compat
import Data.XML.Types as XML

import Data.Char (toLower)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Text (Text, pack)

-- ToDo:
--
--  - complete set of constructors over feeds
--  - provide a unified treatment of date string reps.
--    (i.e., I know they differ across formats, but ignorant what
--    the constraints are at the moment.)
-- | Construct an empty feed document, intending to output it in
-- the 'fk' feed format.
newFeed :: FeedKind -> Feed.Types.Feed
newFeed :: FeedKind -> Feed
newFeed FeedKind
fk =
  case FeedKind
fk of
    FeedKind
AtomKind ->
      Feed -> Feed
AtomFeed
        (Text -> TextContent -> Text -> Feed
Atom.nullFeed
           Text
"feed-id-not-filled-in"
           (Text -> TextContent
TextString Text
"dummy-title")
           Text
"dummy-and-bogus-update-date")
    RSSKind Maybe Text
mbV ->
      let def :: RSS
def = Text -> Text -> RSS
RSS.nullRSS Text
"dummy-title" Text
"default-channel-url"
       in RSS -> Feed
RSSFeed (RSS -> Feed) -> RSS -> Feed
forall a b. (a -> b) -> a -> b
$ RSS -> (Text -> RSS) -> Maybe Text -> RSS
forall b a. b -> (a -> b) -> Maybe a -> b
maybe RSS
def (\Text
v -> RSS
def {RSS.rssVersion = v}) Maybe Text
mbV
    RDFKind Maybe Text
mbV ->
      let def :: Feed
def = Text -> Text -> Feed
RSS1.nullFeed Text
"default-channel-url" Text
"dummy-title"
       in Feed -> Feed
RSS1Feed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$ Feed -> (Text -> Feed) -> Maybe Text -> Feed
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Feed
def (\Text
v -> Feed
def {RSS1.feedVersion = v}) Maybe Text
mbV

feedFromRSS :: RSS.RSS -> Feed.Types.Feed
feedFromRSS :: RSS -> Feed
feedFromRSS = RSS -> Feed
RSSFeed

feedFromAtom :: Atom.Feed -> Feed.Types.Feed
feedFromAtom :: Feed -> Feed
feedFromAtom = Feed -> Feed
AtomFeed

feedFromRDF :: RSS1.Feed -> Feed.Types.Feed
feedFromRDF :: Feed -> Feed
feedFromRDF = Feed -> Feed
RSS1Feed

feedFromXML :: XML.Element -> Feed.Types.Feed
feedFromXML :: Element -> Feed
feedFromXML = Element -> Feed
XMLFeed

getFeedKind :: Feed.Types.Feed -> FeedKind
getFeedKind :: Feed -> FeedKind
getFeedKind Feed
f =
  case Feed
f of
    Feed.Types.AtomFeed {} -> FeedKind
AtomKind
    Feed.Types.RSSFeed RSS
r ->
      Maybe Text -> FeedKind
RSSKind
        (case RSS -> Text
RSS.rssVersion RSS
r of
           Text
"2.0" -> Maybe Text
forall a. Maybe a
Nothing
           Text
v -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)
    Feed.Types.RSS1Feed Feed
r ->
      Maybe Text -> FeedKind
RDFKind
        (case Feed -> Text
RSS1.feedVersion Feed
r of
           Text
"1.0" -> Maybe Text
forall a. Maybe a
Nothing
           Text
v -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
v)
    Feed.Types.XMLFeed {} -> Maybe Text -> FeedKind
RSSKind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"2.0") -- for now, just a hunch..

addItem :: Feed.Types.Item -> Feed.Types.Feed -> Feed.Types.Feed
addItem :: Item -> Feed -> Feed
addItem Item
it Feed
f =
  case (Item
it, Feed
f) of
    (Feed.Types.AtomItem Entry
e, Feed.Types.AtomFeed Feed
fe) ->
      Feed -> Feed
Feed.Types.AtomFeed Feed
fe {Atom.feedEntries = e : Atom.feedEntries fe}
    (Feed.Types.RSSItem RSSItem
e, Feed.Types.RSSFeed RSS
r) ->
      RSS -> Feed
Feed.Types.RSSFeed
        RSS
r {RSS.rssChannel = (RSS.rssChannel r) {RSS.rssItems = e : RSS.rssItems (RSS.rssChannel r)}}
    (Feed.Types.RSS1Item Item
e, Feed.Types.RSS1Feed Feed
r)
         -- note: do not update the channel item URIs at this point;
         -- will delay doing so until serialization.
     -> Feed -> Feed
Feed.Types.RSS1Feed Feed
r {RSS1.feedItems = e : RSS1.feedItems r}
    (Item, Feed)
_ ->
      [Char] -> Feed
forall a. HasCallStack => [Char] -> a
error [Char]
"addItem: currently unable to automatically convert items from one feed type to another"

withFeedItems :: FeedSetter [Feed.Types.Item]
withFeedItems :: FeedSetter [Item]
withFeedItems [Item]
is Feed
fe =
  (Item -> Feed -> Feed) -> Feed -> [Item] -> Feed
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
    Item -> Feed -> Feed
addItem
    (case Feed
fe of
       Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {Atom.feedEntries = []}
       Feed.Types.RSSFeed RSS
f -> RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssItems = []}}
       Feed.Types.RSS1Feed Feed
f -> Feed -> Feed
Feed.Types.RSS1Feed Feed
f {feedItems = []})
    [Item]
is

newItem :: FeedKind -> Feed.Types.Item
newItem :: FeedKind -> Item
newItem FeedKind
fk =
  case FeedKind
fk of
    FeedKind
AtomKind ->
      Entry -> Item
Feed.Types.AtomItem (Entry -> Item) -> Entry -> Item
forall a b. (a -> b) -> a -> b
$
      Text -> TextContent -> Text -> Entry
Atom.nullEntry
        Text
"entry-id-not-filled-in"
        (Text -> TextContent
TextString Text
"dummy-entry-title")
        Text
"dummy-and-bogus-entry-update-date"
    RSSKind {} -> RSSItem -> Item
Feed.Types.RSSItem (RSSItem -> Item) -> RSSItem -> Item
forall a b. (a -> b) -> a -> b
$ Text -> RSSItem
RSS.nullItem Text
"dummy-rss-item-title"
    RDFKind {} ->
      Item -> Item
Feed.Types.RSS1Item (Item -> Item) -> Item -> Item
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Item
RSS1.nullItem Text
"dummy-item-uri" Text
"dummy-item-title" Text
"dummy-item-link"

getItemKind :: Feed.Types.Item -> FeedKind
getItemKind :: Item -> FeedKind
getItemKind Item
f =
  case Item
f of
    Feed.Types.AtomItem {} -> FeedKind
AtomKind
    Feed.Types.RSSItem {} -> Maybe Text -> FeedKind
RSSKind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"2.0") -- good guess..
    Feed.Types.RSS1Item {} -> Maybe Text -> FeedKind
RDFKind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"1.0")
    Feed.Types.XMLItem {} -> Maybe Text -> FeedKind
RSSKind (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"2.0")

type FeedSetter a = a -> Feed.Types.Feed -> Feed.Types.Feed

withFeedTitle :: FeedSetter Text
withFeedTitle :: FeedSetter Text
withFeedTitle Text
tit Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedTitle = TextString tit}
    Feed.Types.RSSFeed RSS
f -> RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssTitle = tit}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed Feed
f {feedChannel = (feedChannel f) {channelTitle = tit}}
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"title"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"title" Text
tit)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f

withFeedHome :: FeedSetter URLString
withFeedHome :: FeedSetter Text
withFeedHome Text
url Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedLinks = newSelf : Atom.feedLinks f}
      -- ToDo: fix, the <link> element is for the HTML home of the channel, not the
      -- location of the feed itself. Struggling to find if there is a common way
      -- to represent this outside of RSS 2.0 standard elements..
    Feed.Types.RSSFeed RSS
f -> RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssLink = url}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed Feed
f {feedChannel = (feedChannel f) {channelURI = url}}
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"link"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"link" Text
url)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
  where
    newSelf :: Link
newSelf = (Text -> Link
nullLink Text
url) {linkRel = Just (Left "self"), linkType = Just "application/atom+xml"}

-- | 'withFeedHTML' sets the URL where an HTML version of the
-- feed is published.
withFeedHTML :: FeedSetter URLString
withFeedHTML :: FeedSetter Text
withFeedHTML Text
url Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedLinks = newAlt : Atom.feedLinks f}
    Feed.Types.RSSFeed RSS
f -> RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssLink = url}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed Feed
f {feedChannel = (feedChannel f) {channelLink = url}}
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"link"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"link" Text
url)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
  where
    newAlt :: Link
newAlt = (Text -> Link
nullLink Text
url) {linkRel = Just (Left "alternate"), linkType = Just "text/html"}

-- | 'withFeedHTML' sets the URL where an HTML version of the
-- feed is published.
withFeedDescription :: FeedSetter Text
withFeedDescription :: FeedSetter Text
withFeedDescription Text
desc Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedSubtitle = Just (TextString desc)}
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssDescription = desc}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed Feed
f {feedChannel = (feedChannel f) {channelDesc = desc}}
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"description"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"description" Text
desc)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f

withFeedPubDate :: FeedSetter Text
withFeedPubDate :: FeedSetter Text
withFeedPubDate Text
dateStr Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedUpdated = dateStr}
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssPubDate = Just dateStr}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isDate ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Channel -> [DCItem]
RSS1.channelDC (Feed -> Channel
RSS1.feedChannel Feed
f) of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = dateStr} : bs}
            }
        ([DCItem]
_, []) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f)
                  { RSS1.channelDC =
                      DCItem {dcElt = DC_Date, dcText = dateStr} :
                      RSS1.channelDC (RSS1.feedChannel f)
                  }
            }
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"pubDate"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"pubDate" Text
dateStr)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
  where
    isDate :: DCItem -> Bool
isDate DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Date

withFeedLastUpdate :: FeedSetter DateString
withFeedLastUpdate :: FeedSetter Text
withFeedLastUpdate Text
dateStr Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedUpdated = dateStr}
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssLastUpdate = Just dateStr}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isDate ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Channel -> [DCItem]
RSS1.channelDC (Feed -> Channel
RSS1.feedChannel Feed
f) of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = dateStr} : bs}
            }
        ([DCItem]
_, []) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f)
                  { RSS1.channelDC =
                      DCItem {dcElt = DC_Date, dcText = dateStr} :
                      RSS1.channelDC (RSS1.feedChannel f)
                  }
            }
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"lastUpdate"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"lastUpdate" Text
dateStr)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
  where
    isDate :: DCItem -> Bool
isDate DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Date

-- | 'withFeedDate dt' is the composition of 'withFeedPubDate'
-- and 'withFeedLastUpdate', setting both publication date and
-- last update date to 'dt'. Notice that RSS2.0 is the only format
-- supporting both pub and last-update.
withFeedDate :: FeedSetter DateString
withFeedDate :: FeedSetter Text
withFeedDate Text
dt Feed
f = FeedSetter Text
withFeedPubDate Text
dt (FeedSetter Text
withFeedLastUpdate Text
dt Feed
f)

withFeedLogoLink :: URLString -> FeedSetter URLString
withFeedLogoLink :: Text -> FeedSetter Text
withFeedLogoLink Text
imgURL Text
lnk Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f ->
      Feed -> Feed
Feed.Types.AtomFeed Feed
f {feedLogo = Just imgURL, feedLinks = newSelf : Atom.feedLinks f}
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed
        RSS
f
          { rssChannel =
              (rssChannel f) {rssImage = Just $ RSS.nullImage imgURL (rssTitle (rssChannel f)) lnk}
          }
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$
      Feed
f
        { feedImage = Just $ RSS1.nullImage imgURL (RSS1.channelTitle (RSS1.feedChannel f)) lnk
        , feedChannel = (feedChannel f) {channelImageURI = Just imgURL}
        }
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"image"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just
                                   (Name -> [Element] -> Element
forall t. ToNode t => Name -> t -> Element
unode
                                      Name
"image"
                                      [Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"url" Text
imgURL, Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"title" Text
title, Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"link" Text
lnk])
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
      where title :: Text
title =
              case (Element -> Maybe Element)
-> Maybe Element -> Maybe (Maybe Element)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Name -> Element -> Maybe Element
findChild Name
"title") (Name -> Element -> Maybe Element
findChild Name
"channel" Element
f) of
                Just (Just Element
e1) -> Element -> Text
strContent Element
e1
                Maybe (Maybe Element)
_ -> Text
"feed_title" -- shouldn't happen..
  where
    newSelf :: Link
newSelf = (Text -> Link
nullLink Text
lnk) {linkRel = Just (Left "self"), linkType = Just "application/atom+xml"}

withFeedLanguage :: FeedSetter Text
withFeedLanguage :: FeedSetter Text
withFeedLanguage Text
lang Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f -> Feed -> Feed
Feed.Types.AtomFeed Feed
f {Atom.feedAttrs = langAttr : Atom.feedAttrs f}
      where langAttr :: Attr
langAttr = (Name
name, [Text -> Content
ContentText Text
lang])
            name :: Name
name = Name {nameLocalName :: Text
nameLocalName = Text
"lang", nameNamespace :: Maybe Text
nameNamespace = Maybe Text
forall a. Maybe a
Nothing, namePrefix :: Maybe Text
namePrefix = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"xml"}
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssLanguage = Just lang}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isLang ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Channel -> [DCItem]
RSS1.channelDC (Feed -> Channel
RSS1.feedChannel Feed
f) of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = lang} : bs}
            }
        ([DCItem]
_, []) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f)
                  { RSS1.channelDC =
                      DCItem {dcElt = DC_Language, dcText = lang} :
                      RSS1.channelDC (RSS1.feedChannel f)
                  }
            }
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"language"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"language" Text
lang)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
  where
    isLang :: DCItem -> Bool
isLang DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Language

withFeedCategories :: FeedSetter [(Text, Maybe Text)]
withFeedCategories :: FeedSetter [(Text, Maybe Text)]
withFeedCategories [(Text, Maybe Text)]
cats Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f ->
      Feed -> Feed
Feed.Types.AtomFeed
        Feed
f
          { Atom.feedCategories =
              map (\(Text
t, Maybe Text
mb) -> (Text -> Category
Atom.newCategory Text
t) {Atom.catScheme = mb}) cats ++ feedCategories f
          }
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed
        RSS
f
          { rssChannel =
              (rssChannel f)
                { RSS.rssCategories =
                    map (\(Text
t, Maybe Text
mb) -> (Text -> RSSCategory
RSS.newCategory Text
t) {RSS.rssCategoryDomain = mb}) cats ++
                    RSS.rssCategories (rssChannel f)
                }
          }
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed
        Feed
f
          { feedChannel =
              (feedChannel f)
                { RSS1.channelDC =
                    map (\(Text
t, Maybe Text
_) -> DCItem {dcElt :: DCInfo
dcElt = DCInfo
DC_Subject, dcText :: Text
dcText = Text
t}) cats ++
                    RSS1.channelDC (feedChannel f)
                }
          }
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    (((Text, Maybe Text) -> Element -> Element)
-> Element -> [(Text, Maybe Text)] -> Element
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                       (\(Text
t, Maybe Text
mb) Element
acc ->
                          Element -> Element -> Element
addChild
                            (Name -> [Attr] -> Element
forall t. ToNode t => Name -> t -> Element
unode
                               Name
"category"
                               ((Attr -> [Attr])
-> (Text -> Attr -> [Attr]) -> Maybe Text -> Attr -> [Attr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: []) (\Text
v Attr
x -> [Text -> Text -> Attr
mkAttr Text
"domain" Text
v, Attr
x]) Maybe Text
mb (Text -> Text -> Attr
mkAttr Text
"term" Text
t)))
                            Element
acc)
                       Element
e
                       [(Text, Maybe Text)]
cats)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f

withFeedGenerator :: FeedSetter (Text, Maybe URLString)
withFeedGenerator :: FeedSetter (Text, Maybe Text)
withFeedGenerator (Text
gen, Maybe Text
mbURI) Feed
fe =
  case Feed
fe of
    Feed.Types.AtomFeed Feed
f ->
      Feed -> Feed
Feed.Types.AtomFeed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$
      Feed
f {Atom.feedGenerator = Just ((Atom.nullGenerator gen) {Atom.genURI = mbURI})}
    Feed.Types.RSSFeed RSS
f ->
      RSS -> Feed
Feed.Types.RSSFeed RSS
f {rssChannel = (rssChannel f) {rssGenerator = Just gen}}
    Feed.Types.RSS1Feed Feed
f ->
      Feed -> Feed
Feed.Types.RSS1Feed (Feed -> Feed) -> Feed -> Feed
forall a b. (a -> b) -> a -> b
$
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isSource ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Channel -> [DCItem]
RSS1.channelDC (Feed -> Channel
RSS1.feedChannel Feed
f) of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f) {RSS1.channelDC = as ++ dci {dcText = gen} : bs}
            }
        ([DCItem]
_, []) ->
          Feed
f
            { RSS1.feedChannel =
                (RSS1.feedChannel f)
                  { RSS1.channelDC =
                      DCItem {dcElt = DC_Source, dcText = gen} : RSS1.channelDC (RSS1.feedChannel f)
                  }
            }
    Feed.Types.XMLFeed Element
f ->
      Element -> Feed
Feed.Types.XMLFeed (Element -> Feed) -> Element -> Feed
forall a b. (a -> b) -> a -> b
$
      (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
        (\Element
e ->
           if Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"channel"
             then Element -> Maybe Element
forall a. a -> Maybe a
Just
                    ((Element -> Maybe Element) -> Element -> Element
mapMaybeChildren
                       (\Element
e2 ->
                          if Element -> Name
elementName Element
e2 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
"generator"
                            then Element -> Maybe Element
forall a. a -> Maybe a
Just (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"generator" Text
gen)
                            else Maybe Element
forall a. Maybe a
Nothing)
                       Element
e)
             else Maybe Element
forall a. Maybe a
Nothing)
        Element
f
  where
    isSource :: DCItem -> Bool
isSource DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Source

-- Item constructors (all the way to the end):
atomEntryToItem :: Atom.Entry -> Feed.Types.Item
atomEntryToItem :: Entry -> Item
atomEntryToItem = Entry -> Item
Feed.Types.AtomItem

rssItemToItem :: RSS.RSSItem -> Feed.Types.Item
rssItemToItem :: RSSItem -> Item
rssItemToItem = RSSItem -> Item
Feed.Types.RSSItem

rdfItemToItem :: RSS1.Item -> Feed.Types.Item
rdfItemToItem :: Item -> Item
rdfItemToItem = Item -> Item
Feed.Types.RSS1Item

type ItemSetter a = a -> Feed.Types.Item -> Feed.Types.Item

-- | 'withItemPubDate dt' associates the creation\/ publication date 'dt'
-- with a feed item.
withItemPubDate :: ItemSetter DateString
withItemPubDate :: ItemSetter Text
withItemPubDate Text
dt Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e -> Entry -> Item
Feed.Types.AtomItem Entry
e {Atom.entryUpdated = dt}
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemPubDate = Just dt}
    Feed.Types.RSS1Item Item
i ->
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isDate ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Item -> [DCItem]
RSS1.itemDC Item
i of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemDC = as ++ dci {dcText = dt} : bs}
        ([DCItem]
_, []) ->
          Item -> Item
Feed.Types.RSS1Item
            Item
i {RSS1.itemDC = DCItem {dcElt = DC_Date, dcText = dt} : RSS1.itemDC i}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"pubDate" Text
dt) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"pubDate") Element
i
  where
    isDate :: DCItem -> Bool
isDate DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Date

-- | 'withItemDate' is a synonym for 'withItemPubDate'.
withItemDate :: ItemSetter DateString
withItemDate :: ItemSetter Text
withItemDate = ItemSetter Text
withItemPubDate

-- | 'withItemTitle myTitle' associates a new title, 'myTitle',
-- with a feed item.
withItemTitle :: ItemSetter Text
withItemTitle :: ItemSetter Text
withItemTitle Text
tit Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e -> Entry -> Item
Feed.Types.AtomItem Entry
e {Atom.entryTitle = TextString tit}
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemTitle = Just tit}
    Feed.Types.RSS1Item Item
i -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemTitle = tit}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"title" Text
tit) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"title") Element
i

-- | 'withItemAuthor auStr' associates new author info
-- with a feed item.
withItemAuthor :: ItemSetter Text
withItemAuthor :: ItemSetter Text
withItemAuthor Text
au Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e ->
      Entry -> Item
Feed.Types.AtomItem
        Entry
e {Atom.entryAuthors = [nullPerson {personName = au, personURI = Just au}]}
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemAuthor = Just au}
    Feed.Types.RSS1Item Item
i ->
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isAuthor ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Item -> [DCItem]
RSS1.itemDC Item
i of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemDC = as ++ dci {dcText = au} : bs}
        ([DCItem]
_, []) ->
          Item -> Item
Feed.Types.RSS1Item
            Item
i {RSS1.itemDC = DCItem {dcElt = DC_Creator, dcText = au} : RSS1.itemDC i}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"author" Text
au) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"author") Element
i
  where
    isAuthor :: DCItem -> Bool
isAuthor DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Creator

-- | 'withItemFeedLink name myFeed' associates the parent feed URL 'myFeed'
-- with a feed item. It is labelled as 'name'.
withItemFeedLink :: Text -> ItemSetter Text
withItemFeedLink :: Text -> ItemSetter Text
withItemFeedLink Text
tit Text
url Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e ->
      Entry -> Item
Feed.Types.AtomItem
        Entry
e
          { Atom.entrySource =
              Just Atom.nullSource {sourceId = Just url, sourceTitle = Just (TextString tit)}
          }
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemSource = Just (RSS.nullSource url tit)}
    Feed.Types.RSS1Item Item
i -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemTitle = tit}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> ([Attr], Text) -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"source" ([Text -> Text -> Attr
mkAttr Text
"url" Text
url], Text
tit)) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
      (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"source") Element
i

-- | 'withItemCommentLink url' sets the URL reference to the comment page to 'url'.
withItemCommentLink :: ItemSetter Text
withItemCommentLink :: ItemSetter Text
withItemCommentLink Text
url Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e ->
      Entry -> Item
Feed.Types.AtomItem
        Entry
e {Atom.entryLinks = ((nullLink url) {linkRel = Just (Left "replies")}) : Atom.entryLinks e}
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemComments = Just url}
    Feed.Types.RSS1Item Item
i ->
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isRel ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Item -> [DCItem]
RSS1.itemDC Item
i of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemDC = as ++ dci {dcText = url} : bs}
        ([DCItem]
_, []) ->
          Item -> Item
Feed.Types.RSS1Item
            Item
i {RSS1.itemDC = DCItem {dcElt = DC_Relation, dcText = url} : RSS1.itemDC i}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"comments" Text
url) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"comments") Element
i
  where
    isRel :: DCItem -> Bool
isRel DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Relation

-- | 'withItemEnclosure url mbTy len' sets the URL reference to the comment page to 'url'.
withItemEnclosure :: Text -> Maybe Text -> ItemSetter (Maybe Integer)
withItemEnclosure :: Text -> Maybe Text -> ItemSetter (Maybe Integer)
withItemEnclosure Text
url Maybe Text
ty Maybe Integer
mb_len Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e ->
      Entry -> Item
Feed.Types.AtomItem
        Entry
e
          { Atom.entryLinks =
              ((nullLink url)
                 { linkRel = Just (Left "enclosure")
                 , linkType = ty
                 , linkLength = fmap (pack . show) mb_len
                 }) :
              Atom.entryLinks e
          }
    Feed.Types.RSSItem RSSItem
i ->
      RSSItem -> Item
Feed.Types.RSSItem
        RSSItem
i {RSS.rssItemEnclosure = Just (nullEnclosure url mb_len (fromMaybe "text/html" ty))}
    Feed.Types.RSS1Item Item
i ->
      Item -> Item
Feed.Types.RSS1Item
        Item
i
          { RSS1.itemContent =
              nullContentInfo {contentURI = Just url, contentFormat = ty} : RSS1.itemContent i
          }
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild
        ((Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"enclosure" Text
url)
           {elementAttributes = [mkAttr "length" "0", mkAttr "type" (fromMaybe "text/html" ty)]}) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
      (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"enclosure") Element
i

-- | 'withItemId isURL id' associates new unique identifier with a feed item.
-- If 'isURL' is 'True', then the id is assumed to point to a valid web resource.
withItemId :: Bool -> ItemSetter Text
withItemId :: Bool -> ItemSetter Text
withItemId Bool
isURL Text
idS Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e -> Entry -> Item
Feed.Types.AtomItem Entry
e {Atom.entryId = idS}
    Feed.Types.RSSItem RSSItem
i ->
      RSSItem -> Item
Feed.Types.RSSItem
        RSSItem
i {RSS.rssItemGuid = Just (nullGuid idS) {rssGuidPermanentURL = Just isURL}}
    Feed.Types.RSS1Item Item
i ->
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break DCItem -> Bool
isId ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Item -> [DCItem]
RSS1.itemDC Item
i of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemDC = as ++ dci {dcText = idS} : bs}
        ([DCItem]
_, []) ->
          Item -> Item
Feed.Types.RSS1Item
            Item
i {RSS1.itemDC = DCItem {dcElt = DC_Identifier, dcText = idS} : RSS1.itemDC i}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> ([Attr], Text) -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"guid" ([Text -> Text -> Attr
mkAttr Text
"isPermaLink" (Bool -> Text
forall {a}. Show a => a -> Text
showBool Bool
isURL)], Text
idS)) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$
      (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"guid") Element
i
  where
    showBool :: a -> Text
showBool a
x = [Char] -> Text
pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (a -> [Char]
forall a. Show a => a -> [Char]
show a
x)
    isId :: DCItem -> Bool
isId DCItem
dc = DCItem -> DCInfo
dcElt DCItem
dc DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Identifier

-- | 'withItemDescription desc' associates a new descriptive string (aka summary)
-- with a feed item.
withItemDescription :: ItemSetter Text
withItemDescription :: ItemSetter Text
withItemDescription Text
desc Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e -> Entry -> Item
Feed.Types.AtomItem Entry
e {Atom.entrySummary = Just (TextString desc)}
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemDescription = Just desc}
    Feed.Types.RSS1Item Item
i -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemDesc = Just desc}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"description" Text
desc) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"description") Element
i

-- | 'withItemRights rightStr' associates the rights information 'rightStr'
-- with a feed item.
withItemRights :: ItemSetter Text
withItemRights :: ItemSetter Text
withItemRights Text
desc Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e -> Entry -> Item
Feed.Types.AtomItem Entry
e {Atom.entryRights = Just (TextString desc)}
     -- Note: per-item copyright information isn't supported by RSS2.0 (and earlier editions),
     -- you can only attach this at the feed/channel level. So, there's not much we can do
     -- except dropping the information on the floor here. (Rolling our own attribute or
     -- extension element is an option, but would prefer if someone else had started that
     -- effort already.
    Feed.Types.RSSItem {} -> Item
fi
    Feed.Types.RSS1Item Item
i ->
      case (DCItem -> Bool) -> [DCItem] -> ([DCItem], [DCItem])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break ((DCInfo -> DCInfo -> Bool
forall a. Eq a => a -> a -> Bool
== DCInfo
DC_Rights) (DCInfo -> Bool) -> (DCItem -> DCInfo) -> DCItem -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DCItem -> DCInfo
dcElt) ([DCItem] -> ([DCItem], [DCItem]))
-> [DCItem] -> ([DCItem], [DCItem])
forall a b. (a -> b) -> a -> b
$ Item -> [DCItem]
RSS1.itemDC Item
i of
        ([DCItem]
as, DCItem
dci:[DCItem]
bs) -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemDC = as ++ dci {dcText = desc} : bs}
        ([DCItem]
_, []) ->
          Item -> Item
Feed.Types.RSS1Item
            Item
i {RSS1.itemDC = DCItem {dcElt = DC_Rights, dcText = desc} : RSS1.itemDC i}
     -- Since we're so far assuming that a shallow XML rep. of an item
     -- is of RSS2.0 ilk, pinning on the rights info is hard (see above.)
    Feed.Types.XMLItem {} -> Item
fi

-- | 'withItemTitle myLink' associates a new URL, 'myLink',
-- with a feed item.
withItemLink :: ItemSetter URLString
withItemLink :: ItemSetter Text
withItemLink Text
url Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e ->
      Entry -> Item
Feed.Types.AtomItem Entry
e {Atom.entryLinks = replaceAlternate url (Atom.entryLinks e)}
    Feed.Types.RSSItem RSSItem
i -> RSSItem -> Item
Feed.Types.RSSItem RSSItem
i {RSS.rssItemLink = Just url}
    Feed.Types.RSS1Item Item
i -> Item -> Item
Feed.Types.RSS1Item Item
i {RSS1.itemLink = url}
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      Element -> Element -> Element
addChild (Name -> Text -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"link" Text
url) (Element -> Element) -> Element -> Element
forall a b. (a -> b) -> a -> b
$ (Element -> Bool) -> Element -> Element
filterChildren (\Element
e -> Element -> Name
elementName Element
e Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
"link") Element
i
  where
    replaceAlternate :: Text -> [Link] -> [Link]
replaceAlternate Text
_ [] = []
    replaceAlternate Text
x (Link
lr:[Link]
xs)
      | Maybe (Either Text Text) -> Text
forall {a}. IsString a => Maybe (Either a a) -> a
toStr (Link -> Maybe (Either Text Text)
Atom.linkRel Link
lr) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"alternate" = Link
lr {Atom.linkHref = x} Link -> [Link] -> [Link]
forall a. a -> [a] -> [a]
: [Link]
xs
      | Bool
otherwise = Link
lr Link -> [Link] -> [Link]
forall a. a -> [a] -> [a]
: Text -> [Link] -> [Link]
replaceAlternate Text
x [Link]
xs
    toStr :: Maybe (Either a a) -> a
toStr Maybe (Either a a)
Nothing = a
""
    toStr (Just (Left a
x)) = a
x
    toStr (Just (Right a
x)) = a
x

withItemCategories :: ItemSetter [(Text, Maybe Text)]
withItemCategories :: ItemSetter [(Text, Maybe Text)]
withItemCategories [(Text, Maybe Text)]
cats Item
fi =
  case Item
fi of
    Feed.Types.AtomItem Entry
e ->
      Entry -> Item
Feed.Types.AtomItem
        Entry
e
          { Atom.entryCategories =
              map (\(Text
t, Maybe Text
mb) -> (Text -> Category
Atom.newCategory Text
t) {Atom.catScheme = mb}) cats ++ entryCategories e
          }
    Feed.Types.RSSItem RSSItem
i ->
      RSSItem -> Item
Feed.Types.RSSItem
        RSSItem
i
          { RSS.rssItemCategories =
              map (\(Text
t, Maybe Text
mb) -> (Text -> RSSCategory
RSS.newCategory Text
t) {RSS.rssCategoryDomain = mb}) cats ++
              rssItemCategories i
          }
    Feed.Types.RSS1Item Item
i ->
      Item -> Item
Feed.Types.RSS1Item
        Item
i
          { RSS1.itemDC =
              map (\(Text
t, Maybe Text
_) -> DCItem {dcElt :: DCInfo
dcElt = DCInfo
DC_Subject, dcText :: Text
dcText = Text
t}) cats ++ RSS1.itemDC i
          }
    Feed.Types.XMLItem Element
i ->
      Element -> Item
Feed.Types.XMLItem (Element -> Item) -> Element -> Item
forall a b. (a -> b) -> a -> b
$
      ((Text, Maybe Text) -> Element -> Element)
-> Element -> [(Text, Maybe Text)] -> Element
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        (\(Text
t, Maybe Text
mb) Element
acc ->
           Element -> Element -> Element
addChild
             (Name -> [Attr] -> Element
forall t. ToNode t => Name -> t -> Element
unode Name
"category" ((Attr -> [Attr])
-> (Text -> Attr -> [Attr]) -> Maybe Text -> Attr -> [Attr]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Attr -> [Attr] -> [Attr]
forall a. a -> [a] -> [a]
: []) (\Text
v Attr
x -> [Text -> Text -> Attr
mkAttr Text
"domain" Text
v, Attr
x]) Maybe Text
mb (Text -> Text -> Attr
mkAttr Text
"term" Text
t)))
             Element
acc)
        Element
i
        [(Text, Maybe Text)]
cats

-- helpers..
filterChildren :: (XML.Element -> Bool) -> XML.Element -> XML.Element
filterChildren :: (Element -> Bool) -> Element -> Element
filterChildren Element -> Bool
pre Element
e =
  case Element -> [Node]
elementNodes Element
e of
    [] -> Element
e
    [Node]
cs -> Element
e {elementNodes = mapMaybe filterElt cs}
  where
    filterElt :: Node -> Maybe Node
filterElt xe :: Node
xe@(XML.NodeElement Element
el)
      | Element -> Bool
pre Element
el = Node -> Maybe Node
forall a. a -> Maybe a
Just Node
xe
      | Bool
otherwise = Maybe Node
forall a. Maybe a
Nothing
    filterElt Node
xe = Node -> Maybe Node
forall a. a -> Maybe a
Just Node
xe

addChild :: XML.Element -> XML.Element -> XML.Element
addChild :: Element -> Element -> Element
addChild Element
a Element
b = Element
b {elementNodes = XML.NodeElement a : elementNodes b}

mapMaybeChildren :: (XML.Element -> Maybe XML.Element) -> XML.Element -> XML.Element
mapMaybeChildren :: (Element -> Maybe Element) -> Element -> Element
mapMaybeChildren Element -> Maybe Element
f Element
e =
  case Element -> [Node]
elementNodes Element
e of
    [] -> Element
e
    [Node]
cs -> Element
e {elementNodes = map procElt cs}
  where
    procElt :: Node -> Node
procElt xe :: Node
xe@(XML.NodeElement Element
el) =
      case Element -> Maybe Element
f Element
el of
        Maybe Element
Nothing -> Node
xe
        Just Element
el1 -> Element -> Node
XML.NodeElement Element
el1
    procElt Node
xe = Node
xe