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

    {- |
       Module     : Text.XML.HXT.Arrow.XmlState.RunIOStateArrow
       Copyright  : Copyright (C) 2010 Uwe Schmidt
       License    : MIT

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

       run an io state arrow
    -}

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

    module Text.XML.HXT.Arrow.XmlState.RunIOStateArrow
    where

    import Control.Arrow                            -- arrow classes
    import Control.Arrow.ArrowList
    import Control.Arrow.IOStateListArrow

    import Data.Map                                 ( empty )
    import Text.XML.HXT.DOM.Interface

    import Text.XML.HXT.Arrow.XmlArrow
    import Text.XML.HXT.Arrow.XmlState.ErrorHandling
    import Text.XML.HXT.Arrow.XmlState.TraceHandling
    import Text.XML.HXT.Arrow.XmlState.TypeDefs

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

    -- |
    -- apply an 'IOSArrow' to an empty root node with 'initialState' () as initial state
    --
    -- the main entry point for running a state arrow with IO
    --
    -- when running @ runX f@ an empty XML root node is applied to @f@.
    -- usually @f@ will start with a constant arrow (ignoring the input), e.g. a 'Text.XML.HXT.Arrow.ReadDocument.readDocument' arrow.
    --
    -- for usage see examples with 'Text.XML.HXT.Arrow.WriteDocument.writeDocument'
    --
    -- if input has to be feed into the arrow use 'Control.Arrow.IOStateListArrow.runIOSLA' like in @ runIOSLA f emptyX inputDoc @

    runX            :: IOSArrow XmlTree c -> IO [c]
    runX            = runXIOState (initialState ())

    runXIOState     :: XIOState s -> IOStateArrow s XmlTree c -> IO [c]
    runXIOState s0 f
        = do
          (_finalState, res) <- runIOSLA (emptyRoot >>> f) s0 undefined
          return res
        where
        emptyRoot    = root [] []

    -- | the default global state, used as initial state when running an 'IOSArrow' with 'runIOSLA' or
    -- 'runX'

    initialState    :: us -> XIOState us
    initialState s  = XIOState { xioSysState       = initialSysState
                               , xioUserState      = s
                               }

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

    initialSysState                 :: XIOSysState
    initialSysState                 = XIOSys
                                      { xioSysWriter         = initialSysWriter
                                      , xioSysEnv            = initialSysEnv
                                      }

    initialSysWriter                :: XIOSysWriter
    initialSysWriter                = XIOwrt
                                      { xioErrorStatus       = c_ok
                                      , xioErrorMsgList      = []
                                      , xioExpatErrors       = none
                                      , xioRelaxNoOfErrors   = 0
                                      , xioRelaxDefineId     = 0
                                      , xioRelaxAttrList     = []
                                      }

    initialSysEnv                   :: XIOSysEnv
    initialSysEnv                   = XIOEnv
                                      { xioTraceLevel        = 0
                                      , xioTraceCmd          = traceOutputToStderr
                                      , xioErrorMsgHandler   = errorOutputToStderr
                                      , xioErrorMsgCollect   = False
                                      , xioBaseURI           = ""
                                      , xioDefaultBaseURI    = ""
                                      , xioAttrList          = []
                                      , xioInputConfig       = initialInputConfig
                                      , xioParseConfig       = initialParseConfig
                                      , xioOutputConfig      = initialOutputConfig
                                      , xioRelaxConfig       = initialRelaxConfig
                                      , xioXmlSchemaConfig   = initialXmlSchemaConfig
                                      , xioCacheConfig       = initialCacheConfig
                                      }

    initialInputConfig              :: XIOInputConfig
    initialInputConfig              = XIOIcgf
                                      { xioStrictInput       = False
                                      , xioEncodingErrors    = True
                                      , xioInputEncoding     = ""
                                      , xioHttpHandler       = dummyHTTPHandler
                                      , xioInputOptions      = []
                                      , xioRedirect          = False
                                      , xioProxy             = ""
                                      }

    initialParseConfig              :: XIOParseConfig
    initialParseConfig              = XIOPcfg
                                      { xioMimeTypes                = defaultMimeTypeTable
                                      , xioMimeTypeHandlers         = empty
                                      , xioMimeTypeFile             = ""
                                      , xioAcceptedMimeTypes        = []
                                      , xioFileMimeType             = ""
                                      , xioWarnings                 = True
                                      , xioRemoveWS                 = False
                                      , xioParseByMimeType          = False
                                      , xioParseHTML                = False
                                      , xioLowerCaseNames           = False
                                      , xioTagSoup                  = False
                                      , xioPreserveComment          = False
                                      , xioValidate                 = True
                                      , xioSubstDTDEntities         = True
                                      , xioSubstHTMLEntities        = False
                                      , xioCheckNamespaces          = False
                                      , xioCanonicalize             = True
                                      , xioIgnoreNoneXmlContents    = False
                                      , xioTagSoupParser            = dummyTagSoupParser
                                      , xioExpat                    = False
                                      , xioExpatParser              = dummyExpatParser
                                      }

    initialOutputConfig             :: XIOOutputConfig
    initialOutputConfig             = XIOOcfg
                                      { xioIndent                   = False
                                      , xioOutputEncoding           = ""
                                      , xioOutputFmt                = XMLoutput
                                      , xioXmlPi                    = True
                                      , xioNoEmptyElemFor           = []
                                      , xioAddDefaultDTD            = False
                                      , xioTextMode                 = False
                                      , xioShowTree                 = False
                                      , xioShowHaskell              = False
                                      }

    initialRelaxConfig              :: XIORelaxConfig
    initialRelaxConfig              = XIORxc
                                      { xioRelaxValidate            = False
                                      , xioRelaxSchema              = ""
                                      , xioRelaxCheckRestr          = True
                                      , xioRelaxValidateExtRef      = True
                                      , xioRelaxValidateInclude     = True
                                      , xioRelaxCollectErrors       = True
                                      , xioRelaxValidator           = dummyRelaxValidator
                                      }

    initialXmlSchemaConfig          :: XIOXmlSchemaConfig
    initialXmlSchemaConfig          = XIOScc
                                      { xioXmlSchemaValidate        = False
                                      , xioXmlSchemaSchema          = ""
                                      , xioXmlSchemaValidator       = dummyXmlSchemaValidator
                                      }

    initialCacheConfig              :: XIOCacheConfig
    initialCacheConfig              = XIOCch
                                       { xioBinaryCompression       = id
                                       , xioBinaryDeCompression     = id
                                       , xioWithCache               = False
                                       , xioCacheDir                = ""
                                       , xioDocumentAge             = 0
                                       , xioCache404Err             = False
                                       , xioCacheRead               = dummyCacheRead
                                       , xioStrictDeserialize       = False
                                       }

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

    dummyHTTPHandler        :: IOSArrow XmlTree XmlTree
    dummyHTTPHandler        = ( issueFatal $
                                unlines $
                                [ "HTTP handler not configured,"
                                , "please install package hxt-curl and use 'withCurl' config option"
                                , "or install package hxt-http and use 'withHTTP' config option"
                                ]
                              )
                              >>>
                              addAttr transferMessage "HTTP handler not configured"
                              >>>
                              addAttr transferStatus "999"

    dummyTagSoupParser      :: IOSArrow b b
    dummyTagSoupParser      =  issueFatal $
                               unlines $
                               [ "TagSoup parser not configured,"
                               , "please install package hxt-tagsoup"
                               , " and use 'withTagSoup' parser config option from this package"
                               ]

    dummyExpatParser        :: IOSArrow b b
    dummyExpatParser        =  issueFatal $
                               unlines $
                               [ "Expat parser not configured,"
                               , "please install package hxt-expat"
                               , " and use 'withExpat' parser config option from this package"
                               ]

    dummyRelaxValidator     :: IOSArrow b b
    dummyRelaxValidator     =  issueFatal $
                               unlines $
                               [ "RelaxNG validator not configured,"
                               , "please install package hxt-relaxng"
                               , " and use 'withRelaxNG' config option from this package"
                               ]

    dummyXmlSchemaValidator :: IOSArrow b b
    dummyXmlSchemaValidator =  issueFatal $
                               unlines $
                               [ "XML Schema validator not configured,"
                               , "please install package hxt-xmlschema"
                               , " and use 'withXmlSchema' config option from this package"
                               ]

    dummyCacheRead          :: String -> IOSArrow b b
    dummyCacheRead          = const $
                              issueFatal $
                              unlines $
                              [ "Document cache not configured,"
                              , "please install package hxt-cache and use 'withCache' config option"
                              ]

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

    getConfigAttr           :: String -> SysConfigList -> String
    getConfigAttr n c       = lookup1 n $ tl
        where
        s                   = (foldr (>>>) id c) initialSysState
        tl                  = getS theAttrList s

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

    theSysConfigComp        :: Selector XIOSysState a -> Selector SysConfig a
    theSysConfigComp sel    = S { getS = \     cf -> getS sel      (cf initialSysState)
                                , setS = \ val cf -> setS sel val . cf
                                }

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