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}
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]