    --------------------------------------------------------------------
    -- |
    -- 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 f :: Entry -> Entry
    f it :: Item
    it =
      case Item
    it of
        Feed.AtomItem e :: Entry
    e -> Entry -> Item
    Feed.AtomItem (Entry -> Entry
    f Entry
    e)
        _ -> Item
    it

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

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

    translateItemTo :: FeedKind -> Item -> Item
    translateItemTo :: FeedKind -> Item -> Item
    translateItemTo fk :: FeedKind
    fk it :: Item
    it =
      case FeedKind
    fk of
        AtomKind -> Item -> Item
    toAtomItem Item
    it
        RSSKind v :: Maybe Text
    v -> Maybe Text -> Item -> Item
    toRSSItem Maybe Text
    v Item
    it
        RDFKind v :: 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 "toRSSItem: unimplemented"

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

    toAtomItem :: Item -> Item
    toAtomItem :: Item -> Item
    toAtomItem it :: Item
    it =
      case Item
    it of
        AtomItem {} -> Item
    it
        RSS1Item {} -> [Char] -> Item
    forall a. HasCallStack => [Char] -> a
    error "toAtomItem: unimplemented (from RSS1 item rep.)"
        XMLItem {} -> [Char] -> Item
    forall a. HasCallStack => [Char] -> a
    error "toAtomItem: unimplemented (from shallow XML rep.)"
        Feed.RSSItem ri :: RSSItem
    ri -> (Item -> (Item -> Item) -> Item) -> Item -> [Item -> Item] -> Item
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl (\oi :: Item
    oi f :: Item -> Item
    f -> Item -> Item
    f Item
    oi) Item
    outIt [Item -> Item]
    pipeline_rss_atom
          where outIt :: Item
    outIt =
                  (Entry -> Entry) -> Item -> Item
    withAtomEntry
                    (\e :: 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' e :: 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' g :: 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 _ Nothing = a -> a
    forall a. a -> a
    id
                mb f :: t -> a -> a
    f (Just v :: t
    v) = t -> a -> a
    f t
    v
                ls :: ([(Text, Maybe Text)] -> a -> a) -> [RSSCategory] -> a -> a
    ls _ [] = a -> a
    forall a. a -> a
    id
            -- hack, only used for cats, so specialize:
                ls f :: [(Text, Maybe Text)] -> a -> a
    f xs :: [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
    -}