    --------------------------------------------------------------------
    -- |
    -- 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
      , textFeed
      ) where

    import Prelude.Compat

    import Text.DublinCore.Types
    import Text.RSS1.Syntax
    import Text.RSS1.Utils
    import qualified Data.Text.Util as U

    import Data.List.Compat
    import Data.Text (Text)
    import qualified Data.Text as T
    import qualified Data.Text.Lazy as TL
    import Data.XML.Compat
    import Data.XML.Types as XML

    qualNode :: (Maybe Text, Maybe Text) -> Text -> [XML.Node] -> XML.Element
    qualNode ns n cs = Element {elementName = qualName ns n, elementAttributes = [], elementNodes = cs}

    qualNode' :: (Text, Text) -> Text -> [XML.Node] -> XML.Element
    qualNode' (uri, pre) = qualNode (Just uri, Just pre)

    ---
    xmlFeed :: Feed -> XML.Element
    xmlFeed f =
      (qualNode' (rdfNS, rdfPrefix) "RDF" $
       map
         NodeElement
         (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..?
        { elementAttributes =
            nub $
            mkNAttr (qualName (Nothing, Nothing) "xmlns") rss10NS :
            mkNAttr (qualName (Nothing, Just "xmlns") rdfPrefix) rdfNS :
            mkNAttr (qualName (Nothing, Just "xmlns") synPrefix) synNS :
            mkNAttr (qualName (Nothing, Just "xmlns") taxPrefix) taxNS :
            mkNAttr (qualName (Nothing, Just "xmlns") conPrefix) conNS :
            mkNAttr (qualName (Nothing, Just "xmlns") dcPrefix) dcNS : feedAttrs f
        }

    textFeed :: Feed -> Maybe TL.Text
    textFeed = U.renderFeed xmlFeed

    xmlChannel :: Channel -> XML.Element
    xmlChannel ch =
      (qualNode (Just rss10NS, Nothing) "channel" $
       map
         NodeElement
         ([ 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, Just synPrefix) "updateBase") (channelUpdateBase ch)
            ] ++
          xmlContentItems (channelContent ch) ++ xmlTopics (channelTopics ch) ++ channelOther ch))
        { elementAttributes =
            mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (channelURI ch) : channelAttrs ch
        }

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

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

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

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

    xmlTextInput :: TextInputInfo -> XML.Element
    xmlTextInput ti =
      (qualNode (Just rss10NS, Nothing) "textinput" $
       map NodeElement $
       [ 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)
        {elementAttributes = mkNAttr (rdfName "about") (textInputURI ti) : textInputAttrs ti}

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

    xmlUpdatePeriod :: UpdatePeriod -> XML.Element
    xmlUpdatePeriod u = xmlLeaf (synNS, Just 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, Just synPrefix) "updateFrequency" (T.pack $ show f)

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

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

    rdfResource :: (Text, Text) -> Text -> Text -> XML.Element
    rdfResource (uri, pre) t v = xmlEmpty (uri, Just pre) t [mkNAttr (rdfName "resource") v]

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

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

    xmlTopic :: TaxonomyTopic -> XML.Element
    xmlTopic tt =
      (qualNode' (taxNS, taxPrefix) "topic" $
       map
         NodeElement
         (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))
        {elementAttributes = [mkNAttr (rdfName "about") (taxonomyURI tt)]}

    xmlItem :: Item -> XML.Element
    xmlItem i =
      (qualNode (Just rss10NS, Nothing) "item" $
       map
         NodeElement
         ([ 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))
        {elementAttributes = mkNAttr (qualName' (rdfNS, rdfPrefix) "about") (itemURI i) : itemAttrs i}

    xmlLeaf :: (Text, Maybe Text) -> Text -> Text -> XML.Element
    xmlLeaf (ns, pre) tg txt =
      Element
        { elementName = qualName (Just ns, pre) tg
        , elementAttributes = []
        , elementNodes = [NodeContent $ ContentText txt]
        }

    xmlEmpty :: (Text, Maybe Text) -> Text -> [Attr] -> XML.Element
    xmlEmpty (uri, pre) t as = (qualNode (Just uri, pre) t []) {elementAttributes = as}

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