    --------------------------------------------------------------------
    -- |
    -- 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 where

    import Text.XML.Light as XML
    import Text.RSS.Syntax

    import Data.Maybe

    qualNode :: String -> [XML.Content] -> XML.Element
    qualNode n cs =
      blank_element
        { elName    = qualName n
        , elContent = cs
        }

    qualName :: String -> QName
    qualName n = QName{qName=n,qURI=Nothing,qPrefix=Nothing}

    ---
    xmlRSS :: RSS -> XML.Element
    xmlRSS r =
      (qualNode "rss" $ map Elem $
        (  [ xmlChannel (rssChannel r) ]
        ++ rssOther r))
        { elAttribs = (Attr (qualName "version") (rssVersion r)):rssAttrs r }

    xmlChannel :: RSSChannel -> XML.Element
    xmlChannel ch =
       (qualNode "channel" $ map Elem $
         ( [ 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") . 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 Elem $
         (  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))
          { elAttribs = rssItemAttrs it }

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

    xmlEnclosure :: RSSEnclosure -> XML.Element
    xmlEnclosure e =
       (xmlLeaf "enclosure" "")
         { elAttribs =
            (Attr (qualName "url")    (rssEnclosureURL e)) :
            (Attr (qualName "length") (show $ rssEnclosureLength e)) :
            (Attr (qualName "type")   (rssEnclosureType e)) :
    	rssEnclosureAttrs e }

    xmlCategory :: RSSCategory -> XML.Element
    xmlCategory c =
       (xmlLeaf "category" (rssCategoryValue c))
         { elAttribs =
            (fromMaybe id (fmap (\ n -> ((Attr (qualName "domain") n):))
    	                    (rssCategoryDomain c))) $
    	     (rssCategoryAttrs c) }

    xmlGuid :: RSSGuid -> XML.Element
    xmlGuid g =
       (xmlLeaf "guid" (rssGuidValue g))
         { elAttribs =
            (fromMaybe id (fmap (\ n -> ((Attr (qualName "isPermaLink") (toBool n)):))
    	                    (rssGuidPermanentURL g))) $
    	     (rssGuidAttrs g) }
     where
      toBool False = "false"
      toBool _ = "true"

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

    xmlCloud :: RSSCloud -> XML.Element
    xmlCloud cl =
        (xmlLeaf "cloud" "")
         { elAttribs =
             (  mb (Attr (qualName "domain")) (rssCloudDomain cl)
    	 ++ mb (Attr (qualName "port"))   (rssCloudPort cl)
    	 ++ mb (Attr (qualName "path"))   (rssCloudPath cl)
    	 ++ mb (Attr (qualName "register")) (rssCloudRegister cl)
    	 ++ mb (Attr (qualName "protocol")) (rssCloudProtocol cl)
    	 ++ rssCloudAttrs cl) }

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

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

    xmlSkipDays :: [String] -> XML.Element
    xmlSkipDays hs =
      (qualNode "skipDayss" $ map Elem $
        (map (\ n -> xmlLeaf "day" n) hs))

    --

    xmlAttr :: String -> String -> XML.Attr
    xmlAttr k v = Attr (qualName k) v

    xmlLeaf :: String -> String -> XML.Element
    xmlLeaf tg txt =
     blank_element{ elName = qualName tg
     	      , elContent = [ Text blank_cdata { cdData = txt } ]
    	      }

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