hxt-7.5: A collection of tools for processing XML with Haskell.ContentsIndex
Text.XML.HXT.Arrow.WriteDocument
Portabilityportable
Stabilityexperimental
MaintainerUwe Schmidt (uwe@fh-wedel.de)
Description

Version : $Id: WriteDocument.hs,v 1.8 20061109 20:27:42 hxml Exp $

Compound arrow for writing XML documents

Synopsis
writeDocument :: Attributes -> String -> IOStateArrow s XmlTree XmlTree
writeDocumentToString :: Attributes -> IOStateArrow s XmlTree String
prepareContents :: Attributes -> IOStateArrow s XmlTree XmlTree
Documentation
writeDocument :: Attributes -> String -> IOStateArrow s XmlTree XmlTree

the main filter for writing documents

this filter can be configured by an option list like Text.XML.HXT.Arrow.ReadDocument.readDocument

usage: writeDocument optionList destination

if destination is the empty string or "-", stdout is used as output device

available options are

  • a_indent : indent document for readability, (default: no indentation)
  • a_remove_whitespace : remove all redundant whitespace for shorten text (default: no removal)
  • a_output_encoding : encoding of document, default is a_encoding or utf8
  • a_output_xml : (default) issue XML: quote special XML chars >,<,",',& where neccessary add XML processing instruction and encode document with respect to a_output_encoding, if explicitly switched of, the plain text is issued, this is useful for non XML output, e.g. generated Haskell code, LaTex, Java, ...
  • a_output_html : issue XHTML: quote alle XML chars, use HTML entity refs or char refs for none ASCII chars
  • a_no_xml_pi : suppress generation of <?xml ... ?> processing instruction
  • a_show_tree : show tree representation of document (for debugging)
  • a_show_haskell : show Haskell representaion of document (for debugging)

a minimal main program for copying a document has the following structure:

 module Main
 where
 
 import Text.XML.HXT.Arrow
 
 main        :: IO ()
 main
     = do
       runX ( readDocument  [] "hello.xml"
              >>>
              writeDocument [] "bye.xml"
            )
       return ()

an example for copying a document to standard output with tracing and evaluation of error code is:

 module Main
 where
 
 import Text.XML.HXT.Arrow
 import System.Exit
 
 main        :: IO ()
 main
     = do
       [rc] <- runX ( readDocument  [ (a_trace, "1")
                                    ] "hello.xml"
                      >>>
                      writeDocument [ (a_output_encoding, isoLatin1)
                                    ] "-"        -- output to stdout
                      >>>
                      getErrStatus
                    )
       exitWith ( if rc >= c_err
                  then ExitFailure 1
                  else ExitSuccess
                )
writeDocumentToString :: Attributes -> IOStateArrow s XmlTree String
Convert a document into a string. Formating is done the same way and with the same options as in writeDocument.
prepareContents :: Attributes -> IOStateArrow s XmlTree XmlTree
indent and format output
Produced by Haddock version 2.1.0