module Text.XML.HXT.Parser.XmlOutput
( putXmlDoc
, putXmlDocToFile
, putXmlTree
, putXmlSource
, hPutXmlDoc
, hPutXmlTree
, hPutXmlSource
, traceF
, traceMsg
, traceTree
, traceSource
)
where
import Text.XML.HXT.DOM.XmlTree
import Text.XML.HXT.DOM.XmlState
import Text.XML.HXT.DOM.EditFilters ( indentDoc
, numberLinesInXmlDoc
, treeRepOfXmlDoc
, addHeadlineToXmlDoc
)
import System.IO
import System.IO.Error
putXmlDoc :: XmlStateFilter a
putXmlDoc = hPutXmlDoc stdout
hPutXmlDoc :: Handle -> XmlStateFilter a
hPutXmlDoc handle t
= do
res <- io $ try (hPutStr handle content)
case res of
Left ioerr
-> ( issueFatal (show ioerr)
+++>>
thisM
) t
Right _
-> thisM t
where
content = xshow . getChildren $ t
putXmlDocToFile :: String -> XmlStateFilter a
putXmlDocToFile fn t
= do
res <- io $ try (openFile fn WriteMode)
case res of
Left ioerr
-> ( issueFatal (show ioerr)
+++>>
thisM
) t
Right h
-> do
t' <- hPutXmlDoc h t
io $ try (hClose h)
trace 2 ("document written to file: " ++ fn)
return t'
hPutXmlTree :: Handle -> XmlStateFilter a
hPutXmlTree handle
= performAction
(\ n -> liftMf (treeRepOfXmlDoc
.>
addHeadlineToXmlDoc
)
.>>
hPutXmlDoc handle
$ n
)
putXmlTree :: XmlStateFilter a
putXmlTree = hPutXmlTree stdout
hPutXmlSource :: Handle -> XmlStateFilter a
hPutXmlSource handle
= performAction
(\ n -> liftMf ( ( rootTag
[ sattr a_source "internal tree" ]
[ this ]
`whenNot` isRoot
)
.>
indentDoc
.>
numberLinesInXmlDoc
.>
addHeadlineToXmlDoc
)
.>>
hPutXmlDoc handle
$ n
)
putXmlSource :: XmlStateFilter a
putXmlSource = hPutXmlSource stdout
traceF :: Int -> XmlStateFilter a -> XmlStateFilter a
traceF level cmd
= performAction (\ t -> traceCmd level (cmd t))
traceMsg :: Int -> String -> XmlStateFilter a
traceMsg level msg
= performAction (\ _ -> trace level msg)
traceTree :: XmlStateFilter a
traceTree
= traceF 4 (hPutXmlTree stderr)
traceSource :: XmlStateFilter a
traceSource
= traceF 3 (hPutXmlSource stderr)