--------------------------------------------------------------------
-- |
-- Module    : Text.Feed.Translate
-- Copyright : (c) Galois, Inc. 2008,
--             (c) Sigbjorn Finne 2009-
-- License   : BSD3
--
-- Maintainer: Sigbjorn Finne <sof@forkIO.com>
-- Stability : provisional
-- Portability: portable
--
-- Translating between RSS formats; work in progress.
--
module Text.Feed.Translate
  ( translateItemTo -- :: FeedKind -> Item -> Item
  , withAtomEntry -- :: (Atom.Entry -> Atom.Entry) -> Item -> Item
  , withRSSItem -- :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item
  , withRSS1Item -- :: (RSS1.Item -> RSS1.Item) -> Item -> Item
  ) where

import Prelude.Compat

import Control.Arrow ((&&&))
import Text.Atom.Feed as Atom
import Text.Feed.Constructor
import Text.Feed.Types as Feed
import Text.RSS.Syntax as RSS
import qualified Text.RSS1.Syntax as RSS1

import Data.Maybe (fromMaybe)
import Data.Text (Text)

-- functions for performing format-specific transformations.
-- If the item isn't in the of-interest format, no transformation
-- is performed (i.e., no on-the-fly translation into the requested
-- format is performed; the caller is responsible
--
withAtomEntry :: (Atom.Entry -> Atom.Entry) -> Item -> Item
withAtomEntry :: (Entry -> Entry) -> Item -> Item
withAtomEntry Entry -> Entry
f Item
it =
  case Item
it of
    Feed.AtomItem Entry
e -> Entry -> Item
Feed.AtomItem (Entry -> Entry
f Entry
e)
    Item
_ -> Item
it

withRSSItem :: (RSS.RSSItem -> RSS.RSSItem) -> Item -> Item
withRSSItem :: (RSSItem -> RSSItem) -> Item -> Item
withRSSItem RSSItem -> RSSItem
f Item
it =
  case Item
it of
    Feed.RSSItem RSSItem
e -> RSSItem -> Item
Feed.RSSItem (RSSItem -> RSSItem
f RSSItem
e)
    Item
_ -> Item
it

withRSS1Item :: (RSS1.Item -> RSS1.Item) -> Item -> Item
withRSS1Item :: (Item -> Item) -> Item -> Item
withRSS1Item Item -> Item
f Item
it =
  case Item
it of
    Feed.RSS1Item Item
e -> Item -> Item
Feed.RSS1Item (Item -> Item
f Item
e)
    Item
_ -> Item
it

translateItemTo :: FeedKind -> Item -> Item
translateItemTo :: FeedKind -> Item -> Item
translateItemTo FeedKind
fk Item
it =
  case FeedKind
fk of
    FeedKind
AtomKind -> Item -> Item
toAtomItem Item
it
    RSSKind Maybe Text
v -> Maybe Text -> Item -> Item
toRSSItem Maybe Text
v Item
it
    RDFKind Maybe Text
v -> Maybe Text -> Item -> Item
toRDFItem Maybe Text
v Item
it

toRSSItem :: Maybe Text -> Item -> Item
toRSSItem :: Maybe Text -> Item -> Item
toRSSItem = [Char] -> Maybe Text -> Item -> Item
forall a. HasCallStack => [Char] -> a
error [Char]
"toRSSItem: unimplemented"

toRDFItem :: Maybe Text -> Item -> Item
toRDFItem :: Maybe Text -> Item -> Item
toRDFItem = [Char] -> Maybe Text -> Item -> Item
forall a. HasCallStack => [Char] -> a
error [Char]
"toRDFItem: unimplemented"

toAtomItem :: Item -> Item
toAtomItem :: Item -> Item
toAtomItem Item
it =
  case Item
it of
    AtomItem {} -> Item
it
    RSS1Item {} -> [Char] -> Item
forall a. HasCallStack => [Char] -> a
error [Char]
"toAtomItem: unimplemented (from RSS1 item rep.)"
    XMLItem {} -> [Char] -> Item
forall a. HasCallStack => [Char] -> a
error [Char]
"toAtomItem: unimplemented (from shallow XML rep.)"
    Feed.RSSItem RSSItem
ri -> (Item -> (Item -> Item) -> Item) -> Item -> [Item -> Item] -> Item
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Item
oi Item -> Item
f -> Item -> Item
f Item
oi) Item
outIt [Item -> Item]
pipeline_rss_atom
      where outIt :: Item
outIt =
              (Entry -> Entry) -> Item -> Item
withAtomEntry
                (\Entry
e ->
                   Entry
e {entryOther :: [Element]
Atom.entryOther = RSSItem -> [Element]
RSS.rssItemOther RSSItem
ri, entryAttrs :: [Attr]
Atom.entryAttrs = RSSItem -> [Attr]
RSS.rssItemAttrs RSSItem
ri})
                (FeedKind -> Item
newItem FeedKind
AtomKind)
            pipeline_rss_atom :: [Item -> Item]
pipeline_rss_atom =
              [ (Text -> Item -> Item) -> Maybe Text -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb Text -> Item -> Item
withItemTitle (RSSItem -> Maybe Text
rssItemTitle RSSItem
ri)
              , (Text -> Item -> Item) -> Maybe Text -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb Text -> Item -> Item
withItemLink (RSSItem -> Maybe Text
rssItemLink RSSItem
ri)
              , (Text -> Item -> Item) -> Maybe Text -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb Text -> Item -> Item
withItemDescription (RSSItem -> Maybe Text
rssItemDescription RSSItem
ri)
              , (Text -> Item -> Item) -> Maybe Text -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb Text -> Item -> Item
withItemAuthor (RSSItem -> Maybe Text
rssItemAuthor RSSItem
ri)
              , ([(Text, Maybe Text)] -> Item -> Item)
-> [RSSCategory] -> Item -> Item
forall a.
([(Text, Maybe Text)] -> a -> a) -> [RSSCategory] -> a -> a
ls [(Text, Maybe Text)] -> Item -> Item
withItemCategories (RSSItem -> [RSSCategory]
rssItemCategories RSSItem
ri)
              , (RSSGuid -> Item -> Item) -> Maybe RSSGuid -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb RSSGuid -> Item -> Item
withItemId' (RSSItem -> Maybe RSSGuid
rssItemGuid RSSItem
ri)
              , (Text -> Item -> Item) -> Maybe Text -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb Text -> Item -> Item
withItemCommentLink (RSSItem -> Maybe Text
rssItemComments RSSItem
ri)
              , (RSSEnclosure -> Item -> Item)
-> Maybe RSSEnclosure -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb RSSEnclosure -> Item -> Item
withItemEnclosure' (RSSItem -> Maybe RSSEnclosure
rssItemEnclosure RSSItem
ri)
              , (Text -> Item -> Item) -> Maybe Text -> Item -> Item
forall t a. (t -> a -> a) -> Maybe t -> a -> a
mb Text -> Item -> Item
withItemPubDate (RSSItem -> Maybe Text
rssItemPubDate RSSItem
ri)
              ]
            withItemEnclosure' :: RSSEnclosure -> Item -> Item
withItemEnclosure' RSSEnclosure
e =
              Text -> Maybe Text -> ItemSetter (Maybe Integer)
withItemEnclosure
                (RSSEnclosure -> Text
rssEnclosureURL RSSEnclosure
e)
                (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ RSSEnclosure -> Text
rssEnclosureType RSSEnclosure
e)
                (RSSEnclosure -> Maybe Integer
rssEnclosureLength RSSEnclosure
e)
            withItemId' :: RSSGuid -> Item -> Item
withItemId' RSSGuid
g = Bool -> Text -> Item -> Item
withItemId (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (RSSGuid -> Maybe Bool
rssGuidPermanentURL RSSGuid
g)) (RSSGuid -> Text
rssGuidValue RSSGuid
g)
            mb :: (t -> a -> a) -> Maybe t -> a -> a
mb t -> a -> a
_ Maybe t
Nothing = a -> a
forall a. a -> a
id
            mb t -> a -> a
f (Just t
v) = t -> a -> a
f t
v
            ls :: ([(Text, Maybe Text)] -> a -> a) -> [RSSCategory] -> a -> a
ls [(Text, Maybe Text)] -> a -> a
_ [] = a -> a
forall a. a -> a
id
        -- hack, only used for cats, so specialize:
            ls [(Text, Maybe Text)] -> a -> a
f [RSSCategory]
xs = [(Text, Maybe Text)] -> a -> a
f ((RSSCategory -> (Text, Maybe Text))
-> [RSSCategory] -> [(Text, Maybe Text)]
forall a b. (a -> b) -> [a] -> [b]
map (RSSCategory -> Text
rssCategoryValue (RSSCategory -> Text)
-> (RSSCategory -> Maybe Text) -> RSSCategory -> (Text, Maybe Text)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& RSSCategory -> Maybe Text
rssCategoryDomain) [RSSCategory]
xs)
{-
       pipeline_rss_atom =
        [ withItemTitle    (rssItemTitle ri)
        , withItemLink     (rssLink ri)
        , withDescription  (rssDescription ri)
        , \ inp -> mb (\ la -> inp{feedLanguage=...}) (rssLanguage ri)
        , \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})
                      (rssEditor ri)
        , \ inp -> mb (\ ed -> inp{feedAuthors=[nullPerson{personName=ed}]})
                      (rssWebMaster ri)
        , \ inp -> mb (\ pu -> withPubDate)
                      (rssPubDate ri)
        , \ inp -> mb withLastUpdate
                      (rssLastUpdate ri)
        , \ inp -> withCategories (map (\c -> (RSS.rssCategoryValue c, RSS.rssCategoryDomain c))
                                       (rssCategories ri)) inp
        , \ inp -> mb withGenerator
                      (rssGenerator ri)
        , rssDocs
        , rssCloud
        , rssTTL
        , rssImage
        , rssRating
        , rssTextInput
        , rssSkipHours
        , rssSkipDays
        }
      in
-}