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

    {- |
       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 :: forall c. IOSArrow XmlTree c -> IO [c]
    runX            = XIOState () -> IOStateArrow () XmlTree c -> IO [c]
    forall s c. XIOState s -> IOStateArrow s XmlTree c -> IO [c]
    runXIOState (() -> XIOState ()
    forall us. us -> XIOState us
    initialState ())

    runXIOState     :: XIOState s -> IOStateArrow s XmlTree c -> IO [c]
    runXIOState :: forall s c. XIOState s -> IOStateArrow s XmlTree c -> IO [c]
    runXIOState XIOState s
    s0 IOStateArrow s XmlTree c
    f
        = do
          (XIOState s
    _finalState, [c]
    res) <- IOSLA (XIOState s) Any c
    -> XIOState s -> Any -> IO (XIOState s, [c])
    forall s a b. IOSLA s a b -> s -> a -> IO (s, [b])
    runIOSLA (IOSLA (XIOState s) Any XmlTree
    forall {n}. IOSLA (XIOState s) n XmlTree
    emptyRoot IOSLA (XIOState s) Any XmlTree
    -> IOStateArrow s XmlTree c -> IOSLA (XIOState s) Any c
    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 c
    f) XIOState s
    s0 Any
    forall a. HasCallStack => a
    undefined
          [c] -> IO [c]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [c]
    res
        where
        emptyRoot :: IOSLA (XIOState s) n XmlTree
    emptyRoot    = [IOSLA (XIOState s) n XmlTree]
    -> [IOSLA (XIOState s) n XmlTree] -> IOSLA (XIOState s) n XmlTree
    forall n.
    [IOSLA (XIOState s) n XmlTree]
    -> [IOSLA (XIOState s) n XmlTree] -> IOSLA (XIOState s) n XmlTree
    forall (a :: * -> * -> *) n.
    ArrowXml a =>
    [a n XmlTree] -> [a n XmlTree] -> a n XmlTree
    root [] []

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

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

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

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

    initialSysWriter                :: XIOSysWriter
    initialSysWriter :: XIOSysWriter
    initialSysWriter                = XIOwrt
                                      { xioErrorStatus :: Int
    xioErrorStatus       = Int
    c_ok
                                      , xioErrorMsgList :: XmlTrees
    xioErrorMsgList      = []
                                      , xioExpatErrors :: IOSArrow XmlTree XmlTree
    xioExpatErrors       = IOSArrow XmlTree XmlTree
    forall b c. IOSLA (XIOState ()) b c
    forall (a :: * -> * -> *) b c. ArrowList a => a b c
    none
                                      , xioRelaxNoOfErrors :: Int
    xioRelaxNoOfErrors   = Int
    0
                                      , xioRelaxDefineId :: Int
    xioRelaxDefineId     = Int
    0
                                      , xioRelaxAttrList :: AssocList String XmlTrees
    xioRelaxAttrList     = []
                                      }

    initialSysEnv                   :: XIOSysEnv
    initialSysEnv :: XIOSysEnv
    initialSysEnv                   = XIOEnv
                                      { xioTraceLevel :: Int
    xioTraceLevel        = Int
    0
                                      , xioTraceCmd :: Int -> String -> IO ()
    xioTraceCmd          = Int -> String -> IO ()
    traceOutputToStderr
                                      , xioErrorMsgHandler :: String -> IO ()
    xioErrorMsgHandler   = String -> IO ()
    errorOutputToStderr
                                      , xioErrorMsgCollect :: Bool
    xioErrorMsgCollect   = Bool
    False
                                      , xioBaseURI :: String
    xioBaseURI           = String
    ""
                                      , xioDefaultBaseURI :: String
    xioDefaultBaseURI    = String
    ""
                                      , xioAttrList :: Attributes
    xioAttrList          = []
                                      , xioInputConfig :: XIOInputConfig
    xioInputConfig       = XIOInputConfig
    initialInputConfig
                                      , xioParseConfig :: XIOParseConfig
    xioParseConfig       = XIOParseConfig
    initialParseConfig
                                      , xioOutputConfig :: XIOOutputConfig
    xioOutputConfig      = XIOOutputConfig
    initialOutputConfig
                                      , xioRelaxConfig :: XIORelaxConfig
    xioRelaxConfig       = XIORelaxConfig
    initialRelaxConfig
                                      , xioXmlSchemaConfig :: XIOXmlSchemaConfig
    xioXmlSchemaConfig   = XIOXmlSchemaConfig
    initialXmlSchemaConfig
                                      , xioCacheConfig :: XIOCacheConfig
    xioCacheConfig       = XIOCacheConfig
    initialCacheConfig
                                      }

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

    initialParseConfig              :: XIOParseConfig
    initialParseConfig :: XIOParseConfig
    initialParseConfig              = XIOPcfg
                                      { xioMimeTypes :: MimeTypeTable
    xioMimeTypes                = MimeTypeTable
    defaultMimeTypeTable
                                      , xioMimeTypeHandlers :: MimeTypeHandlers
    xioMimeTypeHandlers         = MimeTypeHandlers
    forall k a. Map k a
    empty
                                      , xioMimeTypeFile :: String
    xioMimeTypeFile             = String
    ""
                                      , xioAcceptedMimeTypes :: [String]
    xioAcceptedMimeTypes        = []
                                      , xioFileMimeType :: String
    xioFileMimeType             = String
    ""
                                      , xioWarnings :: Bool
    xioWarnings                 = Bool
    True
                                      , xioRemoveWS :: Bool
    xioRemoveWS                 = Bool
    False
                                      , xioParseByMimeType :: Bool
    xioParseByMimeType          = Bool
    False
                                      , xioParseHTML :: Bool
    xioParseHTML                = Bool
    False
                                      , xioLowerCaseNames :: Bool
    xioLowerCaseNames           = Bool
    False
                                      , xioTagSoup :: Bool
    xioTagSoup                  = Bool
    False
                                      , xioPreserveComment :: Bool
    xioPreserveComment          = Bool
    False
                                      , xioValidate :: Bool
    xioValidate                 = Bool
    True
                                      , xioSubstDTDEntities :: Bool
    xioSubstDTDEntities         = Bool
    True
                                      , xioSubstHTMLEntities :: Bool
    xioSubstHTMLEntities        = Bool
    False
                                      , xioCheckNamespaces :: Bool
    xioCheckNamespaces          = Bool
    False
                                      , xioCanonicalize :: Bool
    xioCanonicalize             = Bool
    True
                                      , xioIgnoreNoneXmlContents :: Bool
    xioIgnoreNoneXmlContents    = Bool
    False
                                      , xioTagSoupParser :: IOSArrow XmlTree XmlTree
    xioTagSoupParser            = IOSArrow XmlTree XmlTree
    forall b. IOSArrow b b
    dummyTagSoupParser
                                      , xioExpat :: Bool
    xioExpat                    = Bool
    False
                                      , xioExpatParser :: IOSArrow XmlTree XmlTree
    xioExpatParser              = IOSArrow XmlTree XmlTree
    forall b. IOSArrow b b
    dummyExpatParser
                                      }

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

    initialRelaxConfig              :: XIORelaxConfig
    initialRelaxConfig :: XIORelaxConfig
    initialRelaxConfig              = XIORxc
                                      { xioRelaxValidate :: Bool
    xioRelaxValidate            = Bool
    False
                                      , xioRelaxSchema :: String
    xioRelaxSchema              = String
    ""
                                      , xioRelaxCheckRestr :: Bool
    xioRelaxCheckRestr          = Bool
    True
                                      , xioRelaxValidateExtRef :: Bool
    xioRelaxValidateExtRef      = Bool
    True
                                      , xioRelaxValidateInclude :: Bool
    xioRelaxValidateInclude     = Bool
    True
                                      , xioRelaxCollectErrors :: Bool
    xioRelaxCollectErrors       = Bool
    True
                                      , xioRelaxValidator :: IOSArrow XmlTree XmlTree
    xioRelaxValidator           = IOSArrow XmlTree XmlTree
    forall b. IOSArrow b b
    dummyRelaxValidator
                                      }

    initialXmlSchemaConfig          :: XIOXmlSchemaConfig
    initialXmlSchemaConfig :: XIOXmlSchemaConfig
    initialXmlSchemaConfig          = XIOScc
                                      { xioXmlSchemaValidate :: Bool
    xioXmlSchemaValidate        = Bool
    False
                                      , xioXmlSchemaSchema :: String
    xioXmlSchemaSchema          = String
    ""
                                      , xioXmlSchemaValidator :: IOSArrow XmlTree XmlTree
    xioXmlSchemaValidator       = IOSArrow XmlTree XmlTree
    forall b. IOSArrow b b
    dummyXmlSchemaValidator
                                      }

    initialCacheConfig              :: XIOCacheConfig
    initialCacheConfig :: XIOCacheConfig
    initialCacheConfig              = XIOCch
                                       { xioBinaryCompression :: CompressionFct
    xioBinaryCompression       = CompressionFct
    forall a. a -> a
    id
                                       , xioBinaryDeCompression :: CompressionFct
    xioBinaryDeCompression     = CompressionFct
    forall a. a -> a
    id
                                       , xioWithCache :: Bool
    xioWithCache               = Bool
    False
                                       , xioCacheDir :: String
    xioCacheDir                = String
    ""
                                       , xioDocumentAge :: Int
    xioDocumentAge             = Int
    0
                                       , xioCache404Err :: Bool
    xioCache404Err             = Bool
    False
                                       , xioCacheRead :: String -> IOSArrow XmlTree XmlTree
    xioCacheRead               = String -> IOSArrow XmlTree XmlTree
    forall b. String -> IOSArrow b b
    dummyCacheRead
                                       , xioStrictDeserialize :: Bool
    xioStrictDeserialize       = Bool
    False
                                       }

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

    dummyHTTPHandler        :: IOSArrow XmlTree XmlTree
    dummyHTTPHandler :: IOSArrow XmlTree XmlTree
    dummyHTTPHandler        = ( String -> IOSArrow XmlTree XmlTree
    forall s b. String -> IOStateArrow s b b
    issueFatal (String -> IOSArrow XmlTree XmlTree)
    -> String -> IOSArrow XmlTree XmlTree
    forall a b. (a -> b) -> a -> b
    $
                                [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                                [ String
    "HTTP handler not configured,"
                                , String
    "please install package hxt-curl and use 'withCurl' config option"
                                , String
    "or install package hxt-http and use 'withHTTP' config option"
                                ]
                              )
                              IOSArrow XmlTree XmlTree
    -> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    String -> String -> a XmlTree XmlTree
    addAttr String
    transferMessage String
    "HTTP handler not configured"
                              IOSArrow XmlTree XmlTree
    -> IOSArrow XmlTree XmlTree -> IOSArrow 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 -> IOSArrow XmlTree XmlTree
    forall (a :: * -> * -> *).
    ArrowXml a =>
    String -> String -> a XmlTree XmlTree
    addAttr String
    transferStatus String
    "999"

    dummyTagSoupParser      :: IOSArrow b b
    dummyTagSoupParser :: forall b. IOSArrow b b
    dummyTagSoupParser      =  String -> IOStateArrow () b b
    forall s b. String -> IOStateArrow s b b
    issueFatal (String -> IOStateArrow () b b) -> String -> IOStateArrow () b b
    forall a b. (a -> b) -> a -> b
    $
                               [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                               [ String
    "TagSoup parser not configured,"
                               , String
    "please install package hxt-tagsoup"
                               , String
    " and use 'withTagSoup' parser config option from this package"
                               ]

    dummyExpatParser        :: IOSArrow b b
    dummyExpatParser :: forall b. IOSArrow b b
    dummyExpatParser        =  String -> IOStateArrow () b b
    forall s b. String -> IOStateArrow s b b
    issueFatal (String -> IOStateArrow () b b) -> String -> IOStateArrow () b b
    forall a b. (a -> b) -> a -> b
    $
                               [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                               [ String
    "Expat parser not configured,"
                               , String
    "please install package hxt-expat"
                               , String
    " and use 'withExpat' parser config option from this package"
                               ]

    dummyRelaxValidator     :: IOSArrow b b
    dummyRelaxValidator :: forall b. IOSArrow b b
    dummyRelaxValidator     =  String -> IOStateArrow () b b
    forall s b. String -> IOStateArrow s b b
    issueFatal (String -> IOStateArrow () b b) -> String -> IOStateArrow () b b
    forall a b. (a -> b) -> a -> b
    $
                               [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                               [ String
    "RelaxNG validator not configured,"
                               , String
    "please install package hxt-relaxng"
                               , String
    " and use 'withRelaxNG' config option from this package"
                               ]

    dummyXmlSchemaValidator :: IOSArrow b b
    dummyXmlSchemaValidator :: forall b. IOSArrow b b
    dummyXmlSchemaValidator =  String -> IOStateArrow () b b
    forall s b. String -> IOStateArrow s b b
    issueFatal (String -> IOStateArrow () b b) -> String -> IOStateArrow () b b
    forall a b. (a -> b) -> a -> b
    $
                               [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $
                               [ String
    "XML Schema validator not configured,"
                               , String
    "please install package hxt-xmlschema"
                               , String
    " and use 'withXmlSchema' config option from this package"
                               ]

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

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

    getConfigAttr           :: String -> SysConfigList -> String
    getConfigAttr :: String -> SysConfigList -> String
    getConfigAttr String
    n SysConfigList
    c       = String -> Attributes -> String
    forall k e. Eq k => k -> AssocList k [e] -> [e]
    lookup1 String
    n (Attributes -> String) -> Attributes -> String
    forall a b. (a -> b) -> a -> b
    $ Attributes
    tl
        where
        s :: XIOSysState
    s                   = (((XIOSysState -> XIOSysState)
     -> (XIOSysState -> XIOSysState) -> XIOSysState -> XIOSysState)
    -> (XIOSysState -> XIOSysState)
    -> SysConfigList
    -> XIOSysState
    -> XIOSysState
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (XIOSysState -> XIOSysState)
    -> (XIOSysState -> XIOSysState) -> XIOSysState -> XIOSysState
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    (>>>) XIOSysState -> XIOSysState
    forall a. a -> a
    id SysConfigList
    c) XIOSysState
    initialSysState
        tl :: Attributes
    tl                  = Selector XIOSysState Attributes -> XIOSysState -> Attributes
    forall s a. Selector s a -> s -> a
    getS Selector XIOSysState Attributes
    theAttrList XIOSysState
    s

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

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

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