    --------------------------------------------------------------------
    -- |
    -- Module    : Text.RSS1.Export
    -- Copyright : (c) Galois, Inc. 2008,
    --             (c) Sigbjorn Finne 2009-
    -- License   : BSD3
    --
    -- Maintainer: Sigbjorn Finne <sof@forkIO.com>
    -- Stability : provisional
    -- Portability: portable
    --
    --------------------------------------------------------------------

    module Text.RSS1.Export (xmlFeed) where

    import Text.XML.Light as XML
    import Text.RSS1.Syntax
    import Text.RSS1.Utils
    import Text.DublinCore.Types

    import Data.List
    import Data.Maybe

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

    ---
    xmlFeed :: Feed -> XML.Element
    xmlFeed f =
      (qualNode (rdfNS,rdfPrefix) "RDF" $ map Elem $
        (concat  [ [xmlChannel (feedChannel f)]
                 , mb xmlImage (feedImage f)
                 , map xmlItem (feedItems f)
                 , mb xmlTextInput (feedTextInput f)
                 , map xmlTopic (feedTopics f)
                 , feedOther f
                 ] ))
            -- should we expect these to be derived by the XML pretty printer..?
        { elAttribs =   nub $
                        Attr (qualName (Nothing,Nothing) "xmlns") (fromJust rss10NS) :
                        Attr (qualName (Nothing,Just "xmlns") (fromJust rdfPrefix)) (fromJust rdfNS) :
                        Attr (qualName (Nothing,Just "xmlns") (fromJust synPrefix)) (fromJust synNS) :
                        Attr (qualName (Nothing,Just "xmlns") (fromJust taxPrefix)) (fromJust taxNS) :
                        Attr (qualName (Nothing,Just "xmlns") (fromJust conPrefix)) (fromJust conNS) :
                        Attr (qualName (Nothing,Just "xmlns") (fromJust dcPrefix))  (fromJust dcNS)  :
                        feedAttrs f}

    xmlChannel :: Channel -> XML.Element
    xmlChannel ch =
      (qualNode (rss10NS,Nothing) "channel" $ map Elem $
         ([ xmlLeaf  (rss10NS,Nothing) "title" (channelTitle ch)
          , xmlLeaf  (rss10NS,Nothing) "link"  (channelLink ch)
          , xmlLeaf  (rss10NS,Nothing) "description" (channelDesc ch)
          ] ++
          mb xmlTextInputURI (channelTextInputURI ch) ++
          mb xmlImageURI (channelImageURI ch) ++
          xmlItemURIs (channelItemURIs ch) ++ map xmlDC (channelDC ch) ++
          concat [ mb xmlUpdatePeriod (channelUpdatePeriod ch)
                 , mb xmlUpdateFreq   (channelUpdateFreq ch)
                 , mb (xmlLeaf (synNS,synPrefix) "updateBase")   (channelUpdateBase ch)
                 ] ++
          xmlContentItems (channelContent ch) ++
          xmlTopics       (channelTopics ch) ++
          channelOther ch))
        { elAttribs = ( Attr (qualName  (rdfNS,rdfPrefix) "about") (channelURI ch) :
                        channelAttrs ch)}

    xmlImageURI :: URIString -> XML.Element
    xmlImageURI u = xmlEmpty (rss10NS,Nothing) "image" [Attr (rdfName "resource") u ]

    xmlImage :: Image -> XML.Element
    xmlImage i =
     (qualNode (rss10NS,Nothing) "image" $ map Elem $
        ([ xmlLeaf  (rss10NS,Nothing) "title" (imageTitle i)
         ,  xmlLeaf (rss10NS,Nothing) "url"   (imageURL i)
         , xmlLeaf  (rss10NS,Nothing) "link"  (imageLink i)
         ] ++ map xmlDC (imageDC i) ++
         imageOther i))
        { elAttribs = ( Attr (qualName  (rdfNS,rdfPrefix) "about") (imageURI i) :
                        imageAttrs i)}

    xmlItemURIs :: [URIString] -> [XML.Element]
    xmlItemURIs [] = []
    xmlItemURIs xs =
      [qualNode (rss10NS, Nothing) "items" $
          [Elem (qualNode (rdfNS,rdfPrefix) "Seq" (map toRes xs))]]
     where
      toRes u = Elem (xmlEmpty (rdfNS,rdfPrefix) "li" [Attr (rdfName "resource") u])

    xmlTextInputURI :: URIString -> XML.Element
    xmlTextInputURI u = xmlEmpty (rss10NS,Nothing) "textinput" [Attr (rdfName "resource") u ]

    xmlTextInput :: TextInputInfo -> XML.Element
    xmlTextInput ti =
      (qualNode (rss10NS, Nothing) "textinput" $ map Elem $
         [ xmlLeaf (rss10NS,Nothing) "title" (textInputTitle ti)
         , xmlLeaf (rss10NS,Nothing) "description" (textInputDesc ti)
         , xmlLeaf (rss10NS,Nothing) "name" (textInputName ti)
         , xmlLeaf (rss10NS,Nothing) "link" (textInputLink ti)
         ] ++ map xmlDC (textInputDC ti) ++
         textInputOther ti)
         {elAttribs=Attr (rdfName "about") (textInputURI ti) : textInputAttrs ti}

    xmlDC :: DCItem -> XML.Element
    xmlDC dc = xmlLeaf (dcNS,dcPrefix) (infoToTag (dcElt dc)) (dcText dc)

    xmlUpdatePeriod :: UpdatePeriod -> XML.Element
    xmlUpdatePeriod u = xmlLeaf (synNS,synPrefix) "updatePeriod" (toStr u)
     where
      toStr ux =
        case ux of
          Update_Hourly  -> "hourly"
          Update_Daily   -> "daily"
          Update_Weekly  -> "weekly"
          Update_Monthly -> "monthly"
          Update_Yearly  -> "yearly"

    xmlUpdateFreq :: Integer -> XML.Element
    xmlUpdateFreq f = xmlLeaf (synNS,synPrefix) "updateFrequency" (show f)

    xmlContentItems :: [ContentInfo] -> [XML.Element]
    xmlContentItems [] = []
    xmlContentItems xs =
      [qualNode (conNS,conPrefix) "items"
        [Elem $ qualNode (rdfNS,rdfPrefix) "Bag"
                  (map (\ e -> Elem (qualNode (rdfNS,rdfPrefix) "li" [Elem (xmlContentInfo e)]))
                       xs)]]

    xmlContentInfo :: ContentInfo -> XML.Element
    xmlContentInfo ci =
      (qualNode (conNS,conPrefix) "item" $ map Elem $
          (concat [ mb (rdfResource (conNS,conPrefix) "format") (contentFormat ci)
                  , mb (rdfResource (conNS,conPrefix) "encoding") (contentEncoding ci)
                  , mb (rdfValue []) (contentValue ci)
                  ]))
        {elAttribs=mb (Attr (rdfName "about")) (contentURI ci)}

    rdfResource :: (Maybe String,Maybe String) -> String -> String -> XML.Element
    rdfResource ns t v = xmlEmpty ns t [Attr (rdfName "resource") v ]

    rdfValue :: [XML.Attr] -> String -> XML.Element
    rdfValue as s = (xmlLeaf (rdfNS,rdfPrefix) "value" s){elAttribs=as}

    xmlTopics :: [URIString] -> [XML.Element]
    xmlTopics [] = []
    xmlTopics xs =
     [qualNode (taxNS,taxPrefix) "topics"
        [Elem (qualNode (rdfNS,rdfPrefix) "Bag" $
                (map (Elem . rdfResource (rdfNS,rdfPrefix) "li") xs))]]

    xmlTopic :: TaxonomyTopic -> XML.Element
    xmlTopic tt =
      (qualNode (taxNS,taxPrefix) "topic" $ map Elem $
          (xmlLeaf (rss10NS,Nothing) "link"  (taxonomyLink tt):
            mb (xmlLeaf (rss10NS,Nothing) "title") (taxonomyTitle tt) ++
           mb (xmlLeaf (rss10NS,Nothing) "description") (taxonomyDesc tt) ++
           xmlTopics (taxonomyTopics tt) ++
           map xmlDC (taxonomyDC tt) ++
           taxonomyOther tt))
        {elAttribs=[Attr (rdfName "about") (taxonomyURI tt)]}

    xmlItem :: Item -> XML.Element
    xmlItem i =
     (qualNode (rss10NS,Nothing) "item" $ map Elem $
        ([ xmlLeaf  (rss10NS,Nothing) "title" (itemTitle i)
         , xmlLeaf  (rss10NS,Nothing) "link"  (itemLink i)
         ] ++
         mb (xmlLeaf  (rss10NS,Nothing) "description") (itemDesc i) ++
         map xmlDC (itemDC i) ++
         xmlTopics (itemTopics i) ++
         map xmlContentInfo (itemContent i) ++
         itemOther i))
        { elAttribs = ( Attr (qualName  (rdfNS,rdfPrefix) "about") (itemURI i) :
                        itemAttrs i)}

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

    xmlEmpty :: (Maybe String,Maybe String) -> String -> [XML.Attr] -> XML.Element
    xmlEmpty ns t as = (qualNode ns t []){elAttribs=as}

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