--------------------------------------------------------------------
-- |
-- Module    : Text.OPML.Export
-- Copyright : (c) Galois, Inc. 2007
-- License   : BSD3
--
-- Stability : provisional
-- Portability:
--
--------------------------------------------------------------------
--
-- Exporting OPML
--

module Text.OPML.Export where

import Text.XML.Light as XML
import Text.OPML.Syntax

import Data.List
import Data.Maybe

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

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

-- Translate OPML back to XML.
--
xmlOPML :: OPML -> XML.Element
xmlOPML o =
  (opmlNode "opml" $ map Elem $
    (  [ xmlHead (opmlHead o) ]
    ++ [ xmlBody (opmlBody o) ]
    ++ opmlOther o))
    { elAttribs = (Attr (opmlName "version") (opmlVersion o)):opmlAttrs o }

xmlHead :: OPMLHead -> XML.Element
xmlHead h =
  (opmlNode "head" $ map Elem $
      (  [ xmlLeaf "title" (opmlTitle h) ]
      ++ mb (xmlLeaf "dateCreated")  (opmlCreated h)
      ++ mb (xmlLeaf "dateModified") (opmlModified h)
      ++ mb (xmlLeaf "ownerName")    (opmlOwner h >>= opmlOwnerId)
      ++ mb (xmlLeaf "ownerEmail")   (opmlOwner h >>= opmlOwnerEmail)
      ++ mb (xmlLeaf "ownerId")      (opmlOwner h >>= opmlOwnerId)
      ++ mb (xmlLeaf "docs")         (opmlDocs h)
      ++ mb (xmlLeaf "expansionState")  (fmap showInts $ opmlExpansionState h)
      ++ mb (xmlLeaf "vertScrollState") (fmap show $ opmlVertScrollState h)
      ++ mb (xmlLeaf "windowTop") (fmap show $ opmlWindowTop h)
      ++ mb (xmlLeaf "windowLeft") (fmap show $ opmlWindowLeft h)
      ++ mb (xmlLeaf "windowBottom") (fmap show $ opmlWindowBottom h)
      ++ mb (xmlLeaf "windowRight") (fmap show $ opmlWindowRight h)
      ++ opmlHeadOther h))
      { elAttribs = opmlHeadAttrs h}

xmlBody :: [Outline] -> XML.Element
xmlBody os = opmlNode "body" (map (Elem . xmlOutline) os)

xmlOutline :: Outline -> XML.Element
xmlOutline o =
  (opmlNode "outline"
           (map Elem $
             (map xmlOutline (opmlOutlineChildren o) ++
              opmlOutlineOther o)))
    { elAttribs =
           [ xmlAttr "text" (opmlText o) ]
        ++ mb (xmlAttr "type") (opmlType o)
        ++ mb (xmlAttr "category") (fmap showCats $ opmlCategories o)
        ++ mb (xmlAttr "isComment") (fmap showBool $ opmlIsComment o)
        ++ mb (xmlAttr "isBreakpoint") (fmap showBool $ opmlIsBreakpoint o)
        ++ opmlOutlineAttrs o}

showCats :: [String] -> String
showCats xs = concat (intersperse "," xs)

showBool :: Bool -> String
showBool True = "true"
showBool _    = "false"

showInts :: [Int] -> String
showInts [] = ""
showInts xs = concat (intersperse "," (map show xs))

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

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

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