    --------------------------------------------------------------------
    -- |
    -- Module    : Text.RSS.Export
    -- Copyright : (c) Galois, Inc. 2008,
    --             (c) Sigbjorn Finne 2009-
    -- License   : BSD3
    --
    -- Maintainer: Sigbjorn Finne <sof@forkIO.com>
    -- Stability : provisional
    -- Description: Convert from RSS to XML
    --
    --------------------------------------------------------------------
    module Text.RSS.Export
      ( qualNode
      , qualName
      , xmlRSS
      , textRSS
      , xmlChannel
      , xmlItem
      , xmlSource
      , xmlEnclosure
      , xmlCategory
      , xmlGuid
      , xmlImage
      , xmlCloud
      , xmlTextInput
      , xmlSkipHours
      , xmlSkipDays
      , xmlAttr
      , xmlLeaf
      , mb
      ) where

    import Prelude.Compat

    import Data.XML.Compat
    import Data.XML.Types as XML
    import Text.RSS.Syntax
    import qualified Data.Text.Util as U

    import Data.Text (Text, pack)
    import qualified Data.Text.Lazy as TL

    qualName :: Text -> XML.Name
    qualName n = Name n Nothing Nothing

    qualNode :: Text -> [XML.Node] -> XML.Element
    qualNode n = Element (Name n Nothing Nothing) []

    ---
    xmlRSS :: RSS -> XML.Element
    xmlRSS r =
      (qualNode "rss" $ map NodeElement (xmlChannel (rssChannel r) : rssOther r))
        {elementAttributes = mkAttr "version" (rssVersion r) : rssAttrs r}

    textRSS :: RSS -> Maybe TL.Text
    textRSS = U.renderFeed xmlRSS

    xmlChannel :: RSSChannel -> XML.Element
    xmlChannel ch =
      qualNode "channel" $
      map
        NodeElement
        ([ xmlLeaf "title" (rssTitle ch)
         , xmlLeaf "link" (rssLink ch)
         , xmlLeaf "description" (rssDescription ch)
         ] ++
         map xmlItem (rssItems ch) ++
         mb (xmlLeaf "language") (rssLanguage ch) ++
         mb (xmlLeaf "copyright") (rssCopyright ch) ++
         mb (xmlLeaf "managingEditor") (rssEditor ch) ++
         mb (xmlLeaf "webMaster") (rssWebMaster ch) ++
         mb (xmlLeaf "pubDate") (rssPubDate ch) ++
         mb (xmlLeaf "lastBuildDate") (rssLastUpdate ch) ++
         map xmlCategory (rssCategories ch) ++
         mb (xmlLeaf "generator") (rssGenerator ch) ++
         mb (xmlLeaf "docs") (rssDocs ch) ++
         mb xmlCloud (rssCloud ch) ++
         mb (xmlLeaf "ttl" . pack . show) (rssTTL ch) ++
         mb xmlImage (rssImage ch) ++
         mb (xmlLeaf "rating") (rssRating ch) ++
         mb xmlTextInput (rssTextInput ch) ++
         mb xmlSkipHours (rssSkipHours ch) ++ mb xmlSkipDays (rssSkipDays ch) ++ rssChannelOther ch)

    xmlItem :: RSSItem -> XML.Element
    xmlItem it =
      (qualNode "item" $
       map
         NodeElement
         (mb (xmlLeaf "title") (rssItemTitle it) ++
          mb (xmlLeaf "link") (rssItemLink it) ++
          mb (xmlLeaf "description") (rssItemDescription it) ++
          mb (xmlLeaf "author") (rssItemAuthor it) ++
          map xmlCategory (rssItemCategories it) ++
          mb (xmlLeaf "comments") (rssItemComments it) ++
          mb xmlEnclosure (rssItemEnclosure it) ++
          mb xmlGuid (rssItemGuid it) ++
          mb (xmlLeaf "pubDate") (rssItemPubDate it) ++
          mb xmlSource (rssItemSource it) ++ rssItemOther it))
        {elementAttributes = rssItemAttrs it}

    xmlSource :: RSSSource -> XML.Element
    xmlSource s =
      (xmlLeaf "source" (rssSourceTitle s))
        {elementAttributes = mkAttr "url" (rssSourceURL s) : rssSourceAttrs s}

    xmlEnclosure :: RSSEnclosure -> XML.Element
    xmlEnclosure e =
      (xmlLeaf "enclosure" "")
        { elementAttributes =
            mkAttr "url" (rssEnclosureURL e) :
            mkAttr "type" (rssEnclosureType e) :
            mb (mkAttr "length" . pack . show) (rssEnclosureLength e) ++ rssEnclosureAttrs e
        }

    xmlCategory :: RSSCategory -> XML.Element
    xmlCategory c =
      (xmlLeaf "category" (rssCategoryValue c))
        { elementAttributes =
            maybe id (\n -> (mkAttr "domain" n :)) (rssCategoryDomain c) (rssCategoryAttrs c)
        }

    xmlGuid :: RSSGuid -> XML.Element
    xmlGuid g =
      (xmlLeaf "guid" (rssGuidValue g))
        { elementAttributes =
            maybe
              id
              (\n -> (mkAttr "isPermaLink" (toBool n) :))
              (rssGuidPermanentURL g)
              (rssGuidAttrs g)
        }
      where
        toBool False = "false"
        toBool _ = "true"

    xmlImage :: RSSImage -> XML.Element
    xmlImage im =
      qualNode "image" $
      map
        NodeElement
        ([ xmlLeaf "url" (rssImageURL im)
         , xmlLeaf "title" (rssImageTitle im)
         , xmlLeaf "link" (rssImageLink im)
         ] ++
         mb (xmlLeaf "width" . pack . show) (rssImageWidth im) ++
         mb (xmlLeaf "height" . pack . show) (rssImageHeight im) ++
         mb (xmlLeaf "description") (rssImageDesc im) ++ rssImageOther im)

    xmlCloud :: RSSCloud -> XML.Element
    xmlCloud cl =
      (xmlLeaf "cloud" "")
        { elementAttributes =
            mb (mkAttr "domain") (rssCloudDomain cl) ++
            mb (mkAttr "port") (rssCloudPort cl) ++
            mb (mkAttr "path") (rssCloudPath cl) ++
            mb (mkAttr "registerProcedure") (rssCloudRegisterProcedure cl) ++
            mb (mkAttr "protocol") (rssCloudProtocol cl) ++ rssCloudAttrs cl
        }

    xmlTextInput :: RSSTextInput -> XML.Element
    xmlTextInput ti =
      (qualNode "textInput" $
       map
         NodeElement
         ([ xmlLeaf "title" (rssTextInputTitle ti)
          , xmlLeaf "description" (rssTextInputDesc ti)
          , xmlLeaf "name" (rssTextInputName ti)
          , xmlLeaf "link" (rssTextInputLink ti)
          ] ++
          rssTextInputOther ti))
        {elementAttributes = rssTextInputAttrs ti}

    xmlSkipHours :: [Integer] -> XML.Element
    xmlSkipHours hs =
      qualNode "skipHours" $ map (NodeElement . (\n -> xmlLeaf "hour" (pack $ show n))) hs

    xmlSkipDays :: [Text] -> XML.Element
    xmlSkipDays hs = qualNode "skipDays" $ map (NodeElement . xmlLeaf "day") hs

    xmlAttr :: Text -> Text -> Attr
    xmlAttr k = mkNAttr (qualName k)

    xmlLeaf :: Text -> Text -> XML.Element
    xmlLeaf tg txt =
      Element
        { elementAttributes = []
        , elementName = Name tg Nothing Nothing
        , elementNodes = [NodeContent (ContentText txt)]
        }

    ---
    mb :: (a -> b) -> Maybe a -> [b]
    mb _ Nothing = []
    mb f (Just x) = [f x]