    -- ------------------------------------------------------------

    {- |
       Module     : Text.XML.HXT.Arrow.WriteDocument
       Copyright  : Copyright (C) 2005-9 Uwe Schmidt
       License    : MIT

       Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
       Stability  : experimental
       Portability: portable

       Compound arrow for writing XML documents

    -}

    -- ------------------------------------------------------------

    module Text.XML.HXT.Arrow.WriteDocument
        ( writeDocument
        , writeDocument'
        , writeDocumentToString
        , prepareContents
        )
    where

    import Control.Arrow                            -- arrow classes
    import Control.Arrow.ArrowList
    import Control.Arrow.ArrowIf
    import Control.Arrow.ArrowTree

    import Text.XML.HXT.DOM.Interface

    import Text.XML.HXT.Arrow.XmlArrow
    import Text.XML.HXT.Arrow.XmlState
    import Text.XML.HXT.Arrow.XmlState.TypeDefs
    import Text.XML.HXT.Arrow.XmlState.RunIOStateArrow
                                                    ( initialSysState
                                                    )
    import Text.XML.HXT.Arrow.Edit                  ( haskellRepOfXmlDoc
                                                    , indentDoc
                                                    , addDefaultDTDecl
                                                    , preventEmptyElements
                                                    , removeDocWhiteSpace
                                                    , treeRepOfXmlDoc
                                                    )
    import Text.XML.HXT.Arrow.DocumentOutput        ( putXmlDocument
                                                    , encodeDocument
                                                    , encodeDocument'
                                                    )

    -- ------------------------------------------------------------
    --

    {- |
    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

    for available options see 'Text.XML.HXT.Arrow.XmlState.SystemConfig'

    - @withOutputXML@ :
     (default) issue XML: quote special XML chars \>,\<,\",\',& where neccessary
                       add XML processing instruction
                       and encode document with respect to output encoding,

    - @withOutputHTML@ :
     issue HTML: translate all special XML chars and all HTML chars with a corresponding entity reference
     into entity references. Do not generate empty elements, e.g. @<script .../>@ for HTML elements, that are allowed
     to contain a none empty body. Result is for the example is @<script ...></script>@.
     The short form introduces trouble in various browsers.

    - @withOutputXHTML@ :
     same as @withOutputHTML@, but all none ASCII chars are substituted by char references.

    - @withOutputPLAIN@ :
     Do not substitute any chars. This is useful when generating something else than XML/HTML, e.g. Haskell source code.

    - @withXmlPi yes/no@ :
     Add a @<?xml version=... encoding=... ?>@ processing instruction to the beginning of the document.
     Default is yes.

    - @withAddDefaultDTD@ :
      if the document to be written was build by reading another document containing a Document Type Declaration,
      this DTD is inserted into the output document (default: no insert)

    - @withShowTree yes/no@ :
      show DOM tree representation of document (for debugging)

    - @withShowHaskell yes/no@ :
      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.Core
    >
    > main        :: IO ()
    > main
    >     = do
    >       runX ( readDocument  [] "hello.xml"
    >              >>>
    >              writeDocument [] "bye.xml"
    >            )
    >       return ()

    an example for copying a document from the web to standard output with global trace level 1, input trace level 2,
    output encoding isoLatin1,
    and evaluation of
    error code is:

    > module Main
    > where
    >
    > import Text.XML.HXT.Core
    > import Text.XML.HXT.Curl
    > -- or
    > -- import Text.XML.HXT.HTTP
    > import System.Exit
    >
    > main        :: IO ()
    > main
    >     = do
    >       [rc] <- runX
    >               ( configSysVars [ withTrace 1          -- set the defaults for all read-,
    >                               , withCurl []          -- write- and other operations
    >                                 -- or withHTTP []
    >                               ]
    >                 >>>
    >                 readDocument  [ withTrace     2      -- use these additional
    >                               , withParseHTML yes    -- options only for this read
    >                               ]
    >                               "http://www.haskell.org/"
    >                 >>>
    >                 writeDocument [ withOutputEncoding isoLatin1
    >                               ]
    >                               ""                     -- output to stdout
    >                 >>>
    >                 getErrStatus
    >               )
    >       exitWith ( if rc >= c_err
    >                  then ExitFailure 1
    >                  else ExitSuccess
    >                )
    -}

    writeDocument           :: SysConfigList -> String -> IOStateArrow s XmlTree XmlTree
    writeDocument config dst
        = localSysEnv
          $
          configSysVars config
          >>>
          perform ( (flip writeDocument') dst $< getSysVar theTextMode )

    writeDocument'          :: Bool -> String -> IOStateArrow s XmlTree XmlTree
    writeDocument' textMode dst
        = ( traceMsg 1 ("writeDocument: destination is " ++ show dst)
            >>>
            ( (flip prepareContents) encodeDocument $< getSysVar idS )
            >>>
            traceDoc "document after encoding"
            >>>
            putXmlDocument textMode dst
            >>>
            traceMsg 1 "writeDocument: finished"
          )
          `when`
          documentStatusOk

    -- ------------------------------------------------------------

    -- |
    -- Convert a document into a string. Formating is done the same way
    -- and with the same options as in 'writeDocument'. Default output encoding is
    -- no encoding, that means the result is a normal unicode encode haskell string.
    -- The default may be overwritten with the 'Text.XML.HXT.Arrow.XmlState.SystemConfig.withOutputEncoding' option.
    -- The XML PI can be suppressed by the 'Text.XML.HXT.XmlKeywords.a_no_xml_pi' option.
    --
    -- This arrow fails, when the encoding scheme is not supported.
    -- The arrow is pure, it does not run in the IO monad.
    -- The XML PI is suppressed, if not explicitly turned on with an
    -- option @ (a_no_xml_pi, v_0) @

    writeDocumentToString   :: ArrowXml a => SysConfigList  -> a XmlTree String
    writeDocumentToString config
        = prepareContents ( foldr (>>>) id (withOutputEncoding unicodeString :
                                            withXmlPi          no            :
                                            config
                                           )
                            $ initialSysState
                          ) encodeDocument'
          >>>
          xshow getChildren

    -- ------------------------------------------------------------

    -- |
    -- indent and format output

    prepareContents :: ArrowXml a => XIOSysState -> (Bool -> Bool -> String -> a XmlTree XmlTree) -> a XmlTree XmlTree
    prepareContents config encodeDoc
        = indent
          >>>
          addDtd
          >>>
          format
        where
        indent'      = getS theIndent      config
        removeWS'    = getS theRemoveWS    config
        showTree'    = getS theShowTree    config
        showHaskell' = getS theShowHaskell config
        outHtml'     = getS theOutputFmt   config ==  HTMLoutput
        outXhtml'    = getS theOutputFmt   config == XHTMLoutput
        outXml'      = getS theOutputFmt   config ==   XMLoutput
        noPi'        = not $ getS theXmlPi       config
        noEEsFor'    = getS theNoEmptyElemFor  config
        addDDTD'     = getS theAddDefaultDTD   config
        outEnc'      = getS theOutputEncoding  config

        addDtd
            | addDDTD'                      = addDefaultDTDecl
            | otherwise                     = this
        indent
            | indent'                       = indentDoc                     -- document indentation
            | removeWS'                     = removeDocWhiteSpace           -- remove all whitespace between tags
            | otherwise                     = this

        format
            | showTree'                     = treeRepOfXmlDoc
            | showHaskell'                  = haskellRepOfXmlDoc
            | outHtml'                      = preventEmptyElements noEEsFor' True
                                              >>>
                                              encodeDoc                     -- convert doc into text with respect to output encoding with ASCII as default
                                                False noPi' ( if null outEnc' then usAscii else outEnc' )

            | outXhtml'                     = preventEmptyElements noEEsFor' True
                                              >>>
                                              encodeDoc                     -- convert doc into text with respect to output encoding
                                                True noPi' outEnc'
            | outXml'                       = ( if null noEEsFor'
                                                then this
                                                else preventEmptyElements noEEsFor' False
                                              )
                                              >>>
                                              encodeDoc                     -- convert doc into text with respect to output encoding
                                                True noPi' outEnc'
            | otherwise                     = this

    -- ------------------------------------------------------------