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

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

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

       State arrows for document output

    -}

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

    module Text.XML.HXT.Arrow.DocumentOutput
        ( putXmlDocument
        , putXmlTree
        , putXmlSource
        , encodeDocument
        , encodeDocument'
        )
    where

    import           Control.Arrow
    import           Control.Arrow.ArrowExc
    import           Control.Arrow.ArrowIf
    import           Control.Arrow.ArrowIO
    import           Control.Arrow.ArrowList
    import           Control.Arrow.ArrowTree
    import           Control.Arrow.ListArrow

    import qualified Data.ByteString.Lazy                 as BS
    import           Data.Maybe
    import           Data.String.Unicode                  (getOutputEncodingFct')

    import           Text.XML.HXT.DOM.Interface
    import qualified Text.XML.HXT.DOM.ShowXml             as XS

    import           Text.XML.HXT.Arrow.Edit              (addHeadlineToXmlDoc,
                                                           addXmlPi,
                                                           addXmlPiEncoding,
                                                           escapeHtmlRefs,
                                                           escapeXmlRefs, indentDoc,
                                                           numberLinesInXmlDoc,
                                                           treeRepOfXmlDoc)
    import           Text.XML.HXT.Arrow.XmlArrow
    import           Text.XML.HXT.Arrow.XmlState
    import           Text.XML.HXT.Arrow.XmlState.TypeDefs

    import           System.IO                            (Handle, IOMode (..),
                                                           hClose, hPutStrLn,
                                                           hSetBinaryMode,
                                                           openBinaryFile, openFile,
                                                           stdout)

    -- ------------------------------------------------------------
    --
    -- | Write the contents of a document tree into an output stream (file or stdout).
    --
    -- If textMode is set, writing is done with Haskell string output, else (default)
    -- writing is done with lazy ByteString output

    putXmlDocument  :: Bool -> String -> IOStateArrow s XmlTree XmlTree
    putXmlDocument :: Bool -> String -> IOStateArrow s XmlTree XmlTree
    putXmlDocument textMode :: Bool
    textMode dst :: String
    dst
        = IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
    perform IOStateArrow s XmlTree XmlTree
    forall s. IOSLA (XIOState s) XmlTree XmlTree
    putDoc
          where
          putDoc :: IOSLA (XIOState s) XmlTree XmlTree
    putDoc
              = ( if Bool
    textMode
                  then ( IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree String
    forall (a :: * -> * -> *) n.
    ArrowXml a =>
    a n XmlTree -> a n String
    xshow IOSLA (XIOState s) XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                         IOSLA (XIOState s) XmlTree String
    -> IOSLA (XIOState s) String (Either SomeException ())
    -> IOSLA (XIOState s) XmlTree (Either SomeException ())
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         IOSLA (XIOState s) String ()
    -> IOSLA (XIOState s) String (Either SomeException ())
    forall (a :: * -> * -> *) b c.
    ArrowExc a =>
    a b c -> a b (Either SomeException c)
    tryA ((String -> IO ()) -> IOSLA (XIOState s) String ()
    forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
    arrIO (\ s :: String
    s -> (Handle -> IO ()) -> IO ()
    hPutDocument (\h :: Handle
    h -> Handle -> String -> IO ()
    hPutStrLn Handle
    h String
    s)))
                       )
                  else ( IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree Blob
    forall (a :: * -> * -> *) n. ArrowXml a => a n XmlTree -> a n Blob
    xshowBlob IOSLA (XIOState s) XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                         IOSLA (XIOState s) XmlTree Blob
    -> IOSLA (XIOState s) Blob (Either SomeException ())
    -> IOSLA (XIOState s) XmlTree (Either SomeException ())
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                         IOSLA (XIOState s) Blob ()
    -> IOSLA (XIOState s) Blob (Either SomeException ())
    forall (a :: * -> * -> *) b c.
    ArrowExc a =>
    a b c -> a b (Either SomeException c)
    tryA ((Blob -> IO ()) -> IOSLA (XIOState s) Blob ()
    forall (a :: * -> * -> *) b c. ArrowIO a => (b -> IO c) -> a b c
    arrIO (\ s :: Blob
    s -> (Handle -> IO ()) -> IO ()
    hPutDocument (\h :: Handle
    h -> do Handle -> Blob -> IO ()
    BS.hPutStr Handle
    h Blob
    s
                                                                    Handle -> Blob -> IO ()
    BS.hPutStr Handle
    h (String -> Blob
    stringToBlob "\n")
                                                          )
                                     )
                              )
                       )
                )
                IOSLA (XIOState s) XmlTree (Either SomeException ())
    -> IOSLA (XIOState s) (Either SomeException ()) XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                ( ( Int -> String -> IOStateArrow s SomeException SomeException
    forall s b. Int -> String -> IOStateArrow s b b
    traceMsg 1 ("io error, document not written to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    outFile)
                    IOStateArrow s SomeException SomeException
    -> IOSLA (XIOState s) SomeException XmlTree
    -> IOSLA (XIOState s) SomeException XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    (SomeException -> String)
    -> IOSLA (XIOState s) SomeException String
    forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
    arr SomeException -> String
    forall a. Show a => a -> String
    show IOSLA (XIOState s) SomeException String
    -> IOSLA (XIOState s) String XmlTree
    -> IOSLA (XIOState s) SomeException XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Int -> IOSLA (XIOState s) String XmlTree
    forall (a :: * -> * -> *). ArrowXml a => Int -> a String XmlTree
    mkError Int
    c_fatal
                    IOSLA (XIOState s) String XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) String XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    IOSLA (XIOState s) XmlTree XmlTree
    forall s. IOSLA (XIOState s) XmlTree XmlTree
    filterErrorMsg
                  )
                  IOSLA (XIOState s) SomeException XmlTree
    -> IOSLA (XIOState s) () XmlTree
    -> IOSLA (XIOState s) (Either SomeException ()) XmlTree
    forall (a :: * -> * -> *) b d c.
    ArrowChoice a =>
    a b d -> a c d -> a (Either b c) d
    |||
                  ( Int -> String -> IOStateArrow s () ()
    forall s b. Int -> String -> IOStateArrow s b b
    traceMsg 2 ("document written to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    outFile String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ", textMode = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Bool -> String
    forall a. Show a => a -> String
    show Bool
    textMode)
                    IOStateArrow s () ()
    -> IOSLA (XIOState s) () XmlTree -> IOSLA (XIOState s) () XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    IOSLA (XIOState s) () XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
                  )
                )
              where
              isStdout :: Bool
    isStdout  = String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    dst Bool -> Bool -> Bool
    || String
    dst String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "-"

              outFile :: String
    outFile   = if Bool
    isStdout
                          then "stdout"
                          else String -> String
    forall a. Show a => a -> String
    show String
    dst

              hPutDocument      :: (Handle -> IO ()) -> IO ()
              hPutDocument :: (Handle -> IO ()) -> IO ()
    hPutDocument action :: Handle -> IO ()
    action
                  | Bool
    isStdout
                      = do
                        Handle -> Bool -> IO ()
    hSetBinaryMode Handle
    stdout (Bool -> Bool
    not Bool
    textMode)
                        Handle -> IO ()
    action Handle
    stdout
                        Handle -> Bool -> IO ()
    hSetBinaryMode Handle
    stdout Bool
    False
                  | Bool
    otherwise
                      = do
                        Handle
    handle <- ( if Bool
    textMode
                                    then String -> IOMode -> IO Handle
    openFile
                                    else String -> IOMode -> IO Handle
    openBinaryFile
                                  ) String
    dst IOMode
    WriteMode
                        Handle -> IO ()
    action Handle
    handle
                        Handle -> IO ()
    hClose Handle
    handle

    -- |
    -- write the tree representation of a document to a file

    putXmlTree      :: String -> IOStateArrow s XmlTree XmlTree
    putXmlTree :: String -> IOStateArrow s XmlTree XmlTree
    putXmlTree dst :: String
    dst
        = IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
    perform ( IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
    treeRepOfXmlDoc
                    IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    addHeadlineToXmlDoc
                    IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    Bool -> String -> IOStateArrow s XmlTree XmlTree
    forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
    putXmlDocument Bool
    True String
    dst
                  )

    -- |
    -- write a document with indentaion and line numers

    putXmlSource    :: String -> IOStateArrow s XmlTree XmlTree
    putXmlSource :: String -> IOStateArrow s XmlTree XmlTree
    putXmlSource dst :: String
    dst
        = IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b b
    perform ( (IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this ) IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
    `whenNot` IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isRoot
                    IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    indentDoc
                    IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
    numberLinesInXmlDoc
                    IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    addHeadlineToXmlDoc
                    IOStateArrow s XmlTree XmlTree
    -> IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    Bool -> String -> IOStateArrow s XmlTree XmlTree
    forall s. Bool -> String -> IOStateArrow s XmlTree XmlTree
    putXmlDocument Bool
    True String
    dst
                  )

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

    getEncodingParam        :: IOStateArrow s XmlTree String
    getEncodingParam :: IOStateArrow s XmlTree String
    getEncodingParam
        = [IOStateArrow s XmlTree String] -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
    catA [ Selector XIOSysState String -> IOStateArrow s XmlTree String
    forall c s b. Selector XIOSysState c -> IOStateArrow s b c
    getSysVar Selector XIOSysState String
    theOutputEncoding   -- 4. guess: take output encoding parameter from global state
               , Selector XIOSysState String -> IOStateArrow s XmlTree String
    forall c s b. Selector XIOSysState c -> IOStateArrow s b c
    getSysVar Selector XIOSysState String
    theInputEncoding    -- 5. guess: take encoding parameter from global state
               , String -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
    constA String
    utf8                   -- default : utf8
               ]
          IOStateArrow s XmlTree String
    -> ([String] -> String) -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *) b c d.
    ArrowList a =>
    a b c -> ([c] -> d) -> a b d
    >. ([String] -> String
    forall a. [a] -> a
    head ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null))

    getOutputEncoding       :: String -> IOStateArrow s XmlTree String
    getOutputEncoding :: String -> IOStateArrow s XmlTree String
    getOutputEncoding defaultEnc :: String
    defaultEnc
        = String -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *).
    ArrowList a =>
    String -> a XmlTree String
    getEC (String -> IOStateArrow s XmlTree String)
    -> IOStateArrow s XmlTree String -> IOStateArrow s XmlTree String
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< IOStateArrow s XmlTree String
    forall s. IOStateArrow s XmlTree String
    getEncodingParam
        where
        getEC :: String -> a XmlTree String
    getEC enc' :: String
    enc' = LA XmlTree String -> a XmlTree String
    forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
    fromLA (LA XmlTree String -> a XmlTree String)
    -> LA XmlTree String -> a XmlTree String
    forall a b. (a -> b) -> a -> b
    $ String -> String -> LA XmlTree String
    getOutputEncoding' String
    defaultEnc String
    enc'

    encodeDocument  :: Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree
    encodeDocument :: Bool -> Bool -> String -> IOStateArrow s XmlTree XmlTree
    encodeDocument quoteXml :: Bool
    quoteXml supressXmlPi :: Bool
    supressXmlPi defaultEnc :: String
    defaultEnc
        = String -> IOStateArrow s XmlTree XmlTree
    forall s. String -> IOSLA (XIOState s) XmlTree XmlTree
    encode (String -> IOStateArrow s XmlTree XmlTree)
    -> IOSLA (XIOState s) XmlTree String
    -> IOStateArrow s XmlTree XmlTree
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< String -> IOSLA (XIOState s) XmlTree String
    forall s. String -> IOStateArrow s XmlTree String
    getOutputEncoding String
    defaultEnc
        where
        encode :: String -> IOSLA (XIOState s) XmlTree XmlTree
    encode enc :: String
    enc
            = Int -> String -> IOSLA (XIOState s) XmlTree XmlTree
    forall s b. Int -> String -> IOStateArrow s b b
    traceMsg 2 ("encodeDocument: encoding is " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    enc)
              IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
              ( Bool -> Bool -> String -> IOSLA (XIOState s) XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    Bool -> Bool -> String -> a XmlTree XmlTree
    encodeDocument' Bool
    quoteXml Bool
    supressXmlPi String
    enc
                IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
    `orElse`
                ( String -> IOSLA (XIOState s) XmlTree XmlTree
    forall s b. String -> IOStateArrow s b b
    issueFatal ("encoding scheme not supported: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    enc)
                  IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    -> IOSLA (XIOState s) XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                  String -> IOSLA (XIOState s) XmlTree XmlTree
    forall s. String -> IOSLA (XIOState s) XmlTree XmlTree
    setDocumentStatusFromSystemState "encoding document"
                )
              )

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

    isBinaryDoc               :: LA XmlTree XmlTree
    isBinaryDoc :: LA XmlTree XmlTree
    isBinaryDoc               = ( ( String -> LA XmlTree String
    forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
    getAttrValue String
    transferMimeType LA XmlTree String -> (String -> String) -> LA XmlTree String
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> (c -> d) -> a b d
    >>^ String -> String
    stringToLower )
                                  LA XmlTree String -> LA String String -> LA XmlTree String
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                  (String -> Bool) -> LA String String
    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
    isA (\ t :: String
    t -> Bool -> Bool
    not (String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    t Bool -> Bool -> Bool
    || String -> Bool
    isTextMimeType String
    t Bool -> Bool -> Bool
    || String -> Bool
    isXmlMimeType String
    t))
                                )
                                LA XmlTree String -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d
    `guards` LA XmlTree XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this

    getOutputEncoding'      :: String -> String -> LA XmlTree String
    getOutputEncoding' :: String -> String -> LA XmlTree String
    getOutputEncoding' defaultEnc :: String
    defaultEnc defaultEnc2 :: String
    defaultEnc2
        =  [LA XmlTree String] -> LA XmlTree String
    forall (a :: * -> * -> *) b c. ArrowList a => [a b c] -> a b c
    catA [ LA XmlTree XmlTree
    isBinaryDoc
                  LA XmlTree XmlTree -> LA XmlTree String -> LA XmlTree String
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>                               -- 0. guess: binary data found: no encoding at all
                  String -> LA XmlTree String
    forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
    constA String
    isoLatin1                  --           the content should usually be a blob
                                                    --           this handling is like the decoding in DocumentInput,
                                                    --           there nothing is decoded for non text or non xml contents
                , LA XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren                       -- 1. guess: evaluate <?xml ... encoding="..."?>
                  LA XmlTree XmlTree -> LA XmlTree String -> LA XmlTree String
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                  ( ( LA XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isPi LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> String -> LA XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    String -> a XmlTree XmlTree
    hasName String
    t_xml )
                    LA XmlTree XmlTree -> LA XmlTree String -> LA XmlTree String
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d
    `guards`
                    String -> LA XmlTree String
    forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
    getAttrValue String
    a_encoding
                  )
                , String -> LA XmlTree String
    forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
    constA String
    defaultEnc                 -- 2. guess: explicit parameter, may be ""
                , String -> LA XmlTree String
    forall (a :: * -> * -> *). ArrowXml a => String -> a XmlTree String
    getAttrValue String
    a_output_encoding    -- 3. guess: take output encoding parameter in root node
                , String -> LA XmlTree String
    forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
    constA String
    defaultEnc2                -- default : UNICODE or utf8
                ]
          LA XmlTree String -> ([String] -> String) -> LA XmlTree String
    forall (a :: * -> * -> *) b c d.
    ArrowList a =>
    a b c -> ([c] -> d) -> a b d
    >. ([String] -> String
    forall a. [a] -> a
    head ([String] -> String)
    -> ([String] -> [String]) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null))           -- make the filter deterministic: take 1. entry from list of guesses

    encodeDocument' :: ArrowXml a => Bool -> Bool -> String -> a XmlTree XmlTree
    encodeDocument' :: Bool -> Bool -> String -> a XmlTree XmlTree
    encodeDocument' quoteXml :: Bool
    quoteXml supressXmlPi :: Bool
    supressXmlPi defaultEnc :: String
    defaultEnc
        = LA XmlTree XmlTree -> a XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => LA b c -> a b c
    fromLA (String -> LA XmlTree XmlTree
    encode (String -> LA XmlTree XmlTree)
    -> LA XmlTree String -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) c b d.
    ArrowList a =>
    (c -> a b d) -> a b c -> a b d
    $< String -> String -> LA XmlTree String
    getOutputEncoding' String
    defaultEnc String
    utf8)
        where
        encode      :: String -> LA XmlTree XmlTree
        encode :: String -> LA XmlTree XmlTree
    encode encodingScheme :: String
    encodingScheme
            | String
    encodingScheme String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    unicodeString
                = LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b) -> a (t b) (t b)
    replaceChildren
                  ( (LA XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren LA XmlTree XmlTree -> ([XmlTree] -> String) -> LA XmlTree String
    forall (a :: * -> * -> *) b c d.
    ArrowList a =>
    a b c -> ([c] -> d) -> a b d
    >. (Char -> String -> String)
    -> (Char -> String -> String) -> [XmlTree] -> String
    XS.xshow'' Char -> String -> String
    cQuot Char -> String -> String
    aQuot)
                    LA XmlTree String -> LA String XmlTree -> LA XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                    LA String XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a String XmlTree
    mkText
                  )
            | Maybe (Char -> String -> String) -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe (Char -> String -> String)
    encodeFct
                = LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
            | Bool
    otherwise
                = ( if Bool
    supressXmlPi
                    then LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b) -> a (t b) (t b)
    processChildren (LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowIf a => a b b -> a b c -> a b b
    `when` LA XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isXmlPi)
                    else ( LA XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    addXmlPi
                           LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                           String -> LA XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    String -> a XmlTree XmlTree
    addXmlPiEncoding String
    encodingScheme
                         )
                  )
                  LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                  ( LA XmlTree XmlTree
    isLatin1Blob
                    LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b c -> a b c
    `orElse`
                    (Char -> String -> String) -> LA XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    (Char -> String -> String) -> a XmlTree XmlTree
    encodeDoc (Maybe (Char -> String -> String) -> Char -> String -> String
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe (Char -> String -> String)
    encodeFct)
                  )
                  LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                  String -> String -> LA XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    String -> String -> a XmlTree XmlTree
    addAttr String
    a_output_encoding String
    encodingScheme
            where
            (cQuot :: Char -> String -> String
    cQuot, aQuot :: Char -> String -> String
    aQuot)
                | Bool
    quoteXml  = (Char -> String -> String, Char -> String -> String)
    escapeXmlRefs
                | Bool
    otherwise = (Char -> String -> String, Char -> String -> String)
    escapeHtmlRefs

            encodeFct :: Maybe (Char -> String -> String)
    encodeFct       = String -> Maybe (Char -> String -> String)
    getOutputEncodingFct' String
    encodingScheme

            encodeDoc :: (Char -> String -> String) -> a XmlTree XmlTree
    encodeDoc ef :: Char -> String -> String
    ef    = a XmlTree XmlTree -> a XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b) -> a (t b) (t b)
    replaceChildren
                              ( (Char -> String -> String)
    -> (Char -> String -> String)
    -> (Char -> String -> String)
    -> a XmlTree XmlTree
    -> a XmlTree Blob
    forall (a :: * -> * -> *) b.
    ArrowList a =>
    (Char -> String -> String)
    -> (Char -> String -> String)
    -> (Char -> String -> String)
    -> a b XmlTree
    -> a b Blob
    xshowBlobWithEnc Char -> String -> String
    cQuot Char -> String -> String
    aQuot Char -> String -> String
    ef a XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                                a XmlTree Blob -> a Blob XmlTree -> a XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                                a Blob XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a Blob XmlTree
    mkBlob
                              )
            xshowBlobWithEnc :: (Char -> String -> String)
    -> (Char -> String -> String)
    -> (Char -> String -> String)
    -> a b XmlTree
    -> a b Blob
    xshowBlobWithEnc cenc :: Char -> String -> String
    cenc aenc :: Char -> String -> String
    aenc enc :: Char -> String -> String
    enc f :: a b XmlTree
    f
                            = a b XmlTree
    f a b XmlTree -> ([XmlTree] -> Blob) -> a b Blob
    forall (a :: * -> * -> *) b c d.
    ArrowList a =>
    a b c -> ([c] -> d) -> a b d
    >. (Char -> String -> String)
    -> (Char -> String -> String)
    -> (Char -> String -> String)
    -> [XmlTree]
    -> Blob
    XS.xshow' Char -> String -> String
    cenc Char -> String -> String
    aenc Char -> String -> String
    enc

            -- if encoding scheme is isolatin1 and the contents is a single blob (bytestring)
            -- the encoding is the identity.
            -- This optimization enables processing (copying) of none XML contents
            -- without any conversions from and to strings
            isLatin1Blob :: LA XmlTree XmlTree
    isLatin1Blob
                | String
    encodingScheme String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String
    isoLatin1
                            = LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
                | Bool
    otherwise = LA XmlTree XmlTree
    childIsSingleBlob LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
    forall (a :: * -> * -> *) b c d.
    ArrowIf a =>
    a b c -> a b d -> a b d
    `guards` LA XmlTree XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a b b
    this
                where
                childIsSingleBlob :: LA XmlTree XmlTree
    childIsSingleBlob
                            = LA XmlTree XmlTree -> LA XmlTree [XmlTree]
    forall (a :: * -> * -> *) b c. ArrowList a => a b c -> a b [c]
    listA LA XmlTree XmlTree
    forall (a :: * -> * -> *) (t :: * -> *) b.
    (ArrowTree a, Tree t) =>
    a (t b) (t b)
    getChildren
                              LA XmlTree [XmlTree] -> LA [XmlTree] XmlTree -> LA XmlTree XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              ([XmlTree] -> Bool) -> LA [XmlTree] [XmlTree]
    forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
    isA ([XmlTree] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ([XmlTree] -> Int) -> (Int -> Bool) -> [XmlTree] -> Bool
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> (Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1))
                              LA [XmlTree] [XmlTree]
    -> LA [XmlTree] XmlTree -> LA [XmlTree] XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              LA [XmlTree] XmlTree
    forall (a :: * -> * -> *) b. ArrowList a => a [b] b
    unlistA
                              LA [XmlTree] XmlTree -> LA XmlTree XmlTree -> LA [XmlTree] XmlTree
    forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>>
                              LA XmlTree XmlTree
    forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
    isBlob

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