module Text.XML.Writer
(
document, soap
, pprint
, XML
, node
, instruction
, comment
, element, elementMaybe, elementA
, content
, empty
, many
, render, (!:)
, ToXML(..)
) where
import Text.XML
import Control.Monad.Writer.Strict
import Data.Default ()
import qualified Data.DList as DL
import qualified Data.Map as M
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy.IO as TL
import Data.String (IsString(..))
type XML = Writer (DL.DList Node) ()
document :: Name
-> XML
-> Document
document name children = Document { documentPrologue = Prologue def def def
, documentRoot = Element name def (render children)
, documentEpilogue = def
}
pprint :: Document -> IO ()
pprint = TL.putStrLn . renderText def { rsPretty = True }
render :: XML -> [Node]
render = DL.toList . execWriter
empty :: XML
empty = return ()
node :: Node -> XML
node = tell . DL.singleton
element :: (ToXML a) => Name -> a -> XML
element name children = node . NodeElement $! Element name def (render $ toXML children)
elementMaybe :: (ToXML a) => Name -> Maybe a -> XML
elementMaybe name = maybe empty (element name)
elementA :: (ToXML a) => Name -> [(Name, Text)] -> a -> XML
elementA name attrs children = node . NodeElement $! Element name (M.fromList attrs) (render $ toXML children)
instruction :: Text -> Text -> XML
instruction target data_ = node . NodeInstruction $! Instruction target data_
comment :: Text -> XML
comment = node . NodeComment
content :: Text -> XML
content = node . NodeContent
many :: (ToXML a)
=> Name
-> [a]
-> XML
many n = mapM_ (element n . toXML)
(!:) :: Text -> Name -> Name
pref !: name = name { namePrefix = Just pref }
class ToXML a where
toXML :: a -> XML
instance ToXML () where
toXML () = empty
instance ToXML XML where
toXML = id
instance ToXML Text where
toXML = content
instance ToXML Bool where
toXML True = "true"
toXML False = "false"
instance ToXML Float where
toXML = content . T.pack . show
instance ToXML Double where
toXML = content . T.pack . show
instance ToXML Int where
toXML = content . T.pack . show
instance ToXML Integer where
toXML = content . T.pack . show
instance ToXML Char where
toXML = content . T.singleton
instance (ToXML a) => ToXML (Maybe a) where
toXML = maybe empty toXML
instance IsString XML where
fromString = content . T.pack
soap :: (ToXML h, ToXML b)
=> h
-> b
-> Document
soap header body = document (sn "Envelope") $ do
when (not $ null headerContent) $ do
node . NodeElement $! Element (sn "Header") def headerContent
element (sn "Body") (toXML body)
where sn n = Name n (Just ns) (Just "soapenv")
ns = "http://schemas.xmlsoap.org/soap/envelope/"
headerContent = render (toXML header)