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

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

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

       the basic state arrows for XML processing

       A state is needed for global processing options,
       like encoding options, document base URI, trace levels
       and error message handling

       The state is separated into a user defined state
       and a system state. The system state contains variables
       for error message handling, for tracing, for the document base
       for accessing XML documents with relative references, e.g. DTDs,
       and a global key value store. This assoc list has strings as keys
       and lists of XmlTrees as values. It is used to store arbitrary
       XML and text values, e.g. user defined global options.

       The user defined part of the store is in the default case empty, defined as ().
       It can be extended with an arbitray data type

    -}

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

    module Text.XML.HXT.Arrow.XmlState.TypeDefs
        ( module Text.XML.HXT.Arrow.XmlState.TypeDefs
        , Selector(..)
        , chgS
        , idS
        , (.&&&.)
        )
    where

    import           Control.Arrow
    import           Control.Arrow.ArrowList
    import           Control.Arrow.IOStateListArrow
    import           Control.DeepSeq

    import           Data.ByteString.Lazy           (ByteString)
    import           Data.Char                      (isDigit)
    import           Data.Function.Selector         (Selector (..), chgS, idS,
                                                     (.&&&.))
    import qualified Data.Map                       as M

    import           Text.XML.HXT.DOM.Interface

    -- ------------------------------------------------------------
    {- datatypes -}

    -- |
    -- state datatype consists of a system state and a user state
    -- the user state is not fixed

    data XIOState us        = XIOState { xioSysState  :: ! XIOSysState
                                       , xioUserState :: ! us
                                       }

    instance (NFData us) => NFData (XIOState us) where
        rnf (XIOState sys usr)      = rnf sys `seq` rnf usr

    -- |
    -- The arrow type for stateful arrows

    type IOStateArrow s b c = IOSLA (XIOState s) b c

    -- |
    -- The arrow for stateful arrows with no user defined state

    type IOSArrow b c       = IOStateArrow () b c

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

    -- user state functions

    -- | read the user defined part of the state

    getUserState    :: IOStateArrow s b s
    getUserState
        = IOSLA $ \ s _ ->
          return (s, [xioUserState s])

    -- | change the user defined part of the state

    changeUserState         :: (b -> s -> s) -> IOStateArrow s b b
    changeUserState cf
        = IOSLA $ \ s v ->
          let s' = s { xioUserState = cf v (xioUserState s) }
          in return (s', [v])

    -- | set the user defined part of the state

    setUserState            :: IOStateArrow s s s
    setUserState
        = changeUserState const

    -- | extend user state
    --
    -- Run an arrow with an extended user state component, The old component
    -- is stored together with a new one in a pair, the arrow is executed with this
    -- extended state, and the augmented state component is removed form the state
    -- when the arrow has finished its execution

    withExtendedUserState   :: s1 -> IOStateArrow (s1, s0) b c -> IOStateArrow s0 b c
    withExtendedUserState initS1 f
        = IOSLA $ \ s0 x ->
          do
          ~(finalS, res) <- runIOSLA f ( XIOState { xioSysState  =          xioSysState  s0
                                                  , xioUserState = (initS1, xioUserState s0)
                                                  }
                                       ) x
          return ( XIOState { xioSysState  =      xioSysState  finalS
                            , xioUserState = snd (xioUserState finalS)
                            }
                 , res
                 )

    -- | change the type of user state
    --
    -- This conversion is useful, when running a state arrow with another
    -- structure of the user state, e.g. with () when executing some IO arrows

    withOtherUserState      :: s1 -> IOStateArrow s1 b c -> IOStateArrow s0 b c
    withOtherUserState s1 f
        = IOSLA $ \ s x ->
          do
          (s', res) <- runIOSLA f ( XIOState { xioSysState  = xioSysState s
                                             , xioUserState = s1
                                             }
                                  ) x
          return ( XIOState { xioSysState  = xioSysState  s'
                            , xioUserState = xioUserState s
                            }
                 , res
                 )

    withoutUserState      :: IOSArrow b c -> IOStateArrow s0 b c
    withoutUserState      = withOtherUserState ()

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

    -- system state structure and acces functions

    -- |
    -- predefined system state data type with all components for the
    -- system functions, like trace, error handling, ...

    data XIOSysState        = XIOSys  { xioSysWriter :: ! XIOSysWriter
                                      , xioSysEnv    :: ! XIOSysEnv
                                      }

    instance NFData XIOSysState where
        rnf x = seq x ()    -- all fields of interest are strict

    data XIOSysWriter       = XIOwrt  { xioErrorStatus     :: ! Int
                                      , xioErrorMsgList    :: ! XmlTrees
                                      , xioExpatErrors     ::   IOSArrow XmlTree XmlTree
                                      , xioRelaxNoOfErrors :: ! Int
                                      , xioRelaxDefineId   :: ! Int
                                      , xioRelaxAttrList   ::   AssocList String XmlTrees
                                      }

    data XIOSysEnv          = XIOEnv  { xioTraceLevel      :: ! Int
                                      , xioTraceCmd        ::   Int -> String -> IO ()
                                      , xioErrorMsgHandler ::   String -> IO ()
                                      , xioErrorMsgCollect :: ! Bool
                                      , xioBaseURI         :: ! String
                                      , xioDefaultBaseURI  :: ! String
                                      , xioAttrList        :: ! Attributes
                                      , xioInputConfig     :: ! XIOInputConfig
                                      , xioParseConfig     :: ! XIOParseConfig
                                      , xioOutputConfig    :: ! XIOOutputConfig
                                      , xioRelaxConfig     :: ! XIORelaxConfig
                                      , xioXmlSchemaConfig :: ! XIOXmlSchemaConfig
                                      , xioCacheConfig     :: ! XIOCacheConfig
                                      }

    data XIOInputConfig     = XIOIcgf { xioStrictInput    :: ! Bool
                                      , xioEncodingErrors :: ! Bool
                                      , xioInputEncoding  ::   String
                                      , xioHttpHandler    ::   IOSArrow XmlTree XmlTree
                                      , xioInputOptions   :: ! Attributes
                                      , xioRedirect       :: ! Bool
                                      , xioProxy          ::   String
                                      }

    data XIOParseConfig     = XIOPcfg { xioMimeTypes             ::   MimeTypeTable
                                      , xioMimeTypeHandlers      ::   MimeTypeHandlers
                                      , xioMimeTypeFile          ::   String
                                      , xioAcceptedMimeTypes     ::   [String]
                                      , xioFileMimeType          ::   String
                                      , xioWarnings              :: ! Bool
                                      , xioRemoveWS              :: ! Bool
                                      , xioParseByMimeType       :: ! Bool
                                      , xioParseHTML             :: ! Bool
                                      , xioLowerCaseNames        :: ! Bool
                                      , xioPreserveComment       :: ! Bool
                                      , xioValidate              :: ! Bool
                                      , xioSubstDTDEntities      :: ! Bool
                                      , xioSubstHTMLEntities     :: ! Bool
                                      , xioCheckNamespaces       :: ! Bool
                                      , xioCanonicalize          :: ! Bool
                                      , xioIgnoreNoneXmlContents :: ! Bool
                                      , xioTagSoup               :: ! Bool
                                      , xioTagSoupParser         ::   IOSArrow XmlTree XmlTree
                                      , xioExpat                 :: ! Bool
                                      , xioExpatParser           ::   IOSArrow XmlTree XmlTree
                                      }

    data XIOOutputConfig    = XIOOcfg { xioIndent         :: ! Bool
                                      , xioOutputEncoding :: ! String
                                      , xioOutputFmt      :: ! XIOXoutConfig
                                      , xioXmlPi          :: ! Bool
                                      , xioNoEmptyElemFor :: ! [String]
                                      , xioAddDefaultDTD  :: ! Bool
                                      , xioTextMode       :: ! Bool
                                      , xioShowTree       :: ! Bool
                                      , xioShowHaskell    :: ! Bool
                                      }
    data XIOXoutConfig      = XMLoutput | XHTMLoutput | HTMLoutput | PLAINoutput
                              deriving (Eq)

    data XIORelaxConfig     = XIORxc  { xioRelaxValidate        :: ! Bool
                                      , xioRelaxSchema          ::   String
                                      , xioRelaxCheckRestr      :: ! Bool
                                      , xioRelaxValidateExtRef  :: ! Bool
                                      , xioRelaxValidateInclude :: ! Bool
                                      , xioRelaxCollectErrors   :: ! Bool
                                      , xioRelaxValidator       ::   IOSArrow XmlTree XmlTree
                                      }

    data XIOXmlSchemaConfig = XIOScc  { xioXmlSchemaValidate  :: ! Bool
                                      , xioXmlSchemaSchema    ::   String
                                      , xioXmlSchemaValidator ::   IOSArrow XmlTree XmlTree
                                      }

    data XIOCacheConfig     = XIOCch  { xioBinaryCompression   ::   CompressionFct
                                      , xioBinaryDeCompression ::   DeCompressionFct
                                      , xioWithCache           :: ! Bool
                                      , xioCacheDir            :: ! String
                                      , xioDocumentAge         :: ! Int
                                      , xioCache404Err         :: ! Bool
                                      , xioCacheRead           ::   String -> IOSArrow XmlTree XmlTree
                                      , xioStrictDeserialize   :: ! Bool
                                      }

    type MimeTypeHandlers   = M.Map String (IOSArrow XmlTree XmlTree)

    type CompressionFct     = ByteString -> ByteString
    type DeCompressionFct   = ByteString -> ByteString

    type SysConfig          = XIOSysState -> XIOSysState
    type SysConfigList      = [SysConfig]

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

    theSysState                     :: Selector (XIOState us) XIOSysState
    theSysState                     = S { getS = xioSysState
                                        , setS = \ x s -> s { xioSysState = x}
                                        }

    theUserState                    :: Selector (XIOState us) us
    theUserState                    = S { getS = xioUserState
                                        , setS = \ x s -> s { xioUserState = x}
                                        }

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

    theSysWriter                    :: Selector XIOSysState XIOSysWriter
    theSysWriter                    = S { getS = xioSysWriter
                                        , setS = \ x s -> s { xioSysWriter = x}
                                        }

    theErrorStatus                  :: Selector XIOSysState Int
    theErrorStatus                  = theSysWriter
                                      >>>
                                      S { getS = xioErrorStatus
                                        , setS = \ x s -> s { xioErrorStatus = x }
                                        }

    theErrorMsgList                 :: Selector XIOSysState XmlTrees
    theErrorMsgList                 = theSysWriter
                                      >>>
                                      S { getS = xioErrorMsgList
                                        , setS = \ x s -> s { xioErrorMsgList = x }
                                        }

    theRelaxNoOfErrors              :: Selector XIOSysState Int
    theRelaxNoOfErrors              = theSysWriter
                                      >>>
                                      S { getS = xioRelaxNoOfErrors
                                        , setS = \ x s -> s { xioRelaxNoOfErrors = x}
                                        }

    theRelaxDefineId                :: Selector XIOSysState Int
    theRelaxDefineId                = theSysWriter
                                      >>>
                                      S { getS = xioRelaxDefineId
                                        , setS = \ x s -> s { xioRelaxDefineId = x}
                                        }

    theRelaxAttrList                :: Selector XIOSysState (AssocList String XmlTrees)
    theRelaxAttrList                = theSysWriter
                                      >>>
                                      S { getS = xioRelaxAttrList
                                        , setS = \ x s -> s { xioRelaxAttrList = x}
                                        }

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

    theSysEnv                       :: Selector XIOSysState XIOSysEnv
    theSysEnv                       = S { getS = xioSysEnv
                                        , setS = \ x s -> s { xioSysEnv = x}
                                        }

    theInputConfig                  :: Selector XIOSysState XIOInputConfig
    theInputConfig                  = theSysEnv
                                      >>>
                                      S { getS = xioInputConfig
                                        , setS = \ x s -> s { xioInputConfig = x}
                                        }

    theStrictInput                  :: Selector XIOSysState Bool
    theStrictInput                  = theInputConfig
                                      >>>
                                      S { getS = xioStrictInput
                                        , setS = \ x s -> s { xioStrictInput = x}
                                        }

    theEncodingErrors               :: Selector XIOSysState Bool
    theEncodingErrors               = theInputConfig
                                      >>>
                                      S { getS = xioEncodingErrors
                                        , setS = \ x s -> s { xioEncodingErrors = x}
                                        }

    theInputEncoding                :: Selector XIOSysState String
    theInputEncoding                = theInputConfig
                                      >>>
                                      S { getS = xioInputEncoding
                                        , setS = \ x s -> s { xioInputEncoding = x}
                                        }

    theHttpHandler                  :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
    theHttpHandler                  = theInputConfig
                                      >>>
                                      S { getS = xioHttpHandler
                                        , setS = \ x s -> s { xioHttpHandler = x}
                                        }

    theInputOptions                 :: Selector XIOSysState Attributes
    theInputOptions                 = theInputConfig
                                      >>>
                                      S { getS = xioInputOptions
                                        , setS = \ x s -> s { xioInputOptions = x}
                                        }

    theRedirect                     :: Selector XIOSysState Bool
    theRedirect                     = theInputConfig
                                      >>>
                                      S { getS = xioRedirect
                                        , setS = \ x s -> s { xioRedirect = x}
                                        }

    theProxy                        :: Selector XIOSysState String
    theProxy                        = theInputConfig
                                      >>>
                                      S { getS = xioProxy
                                        , setS = \ x s -> s { xioProxy = x}
                                        }

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

    theOutputConfig                 :: Selector XIOSysState XIOOutputConfig
    theOutputConfig                 = theSysEnv
                                      >>>
                                      S { getS = xioOutputConfig
                                        , setS = \ x s -> s { xioOutputConfig = x}
                                        }

    theIndent                       :: Selector XIOSysState Bool
    theIndent                       = theOutputConfig
                                      >>>
                                      S { getS = xioIndent
                                        , setS = \ x s -> s { xioIndent = x}
                                        }

    theOutputEncoding               :: Selector XIOSysState String
    theOutputEncoding               = theOutputConfig
                                      >>>
                                      S { getS = xioOutputEncoding
                                        , setS = \ x s -> s { xioOutputEncoding = x}
                                        }

    theOutputFmt                    :: Selector XIOSysState XIOXoutConfig
    theOutputFmt                    = theOutputConfig
                                      >>>
                                      S { getS = xioOutputFmt
                                        , setS = \ x s -> s { xioOutputFmt = x}
                                        }

    theXmlPi                        :: Selector XIOSysState Bool
    theXmlPi                        = theOutputConfig
                                      >>>
                                      S { getS = xioXmlPi
                                        , setS = \ x s -> s { xioXmlPi = x}
                                        }

    theNoEmptyElemFor               :: Selector XIOSysState [String]
    theNoEmptyElemFor               = theOutputConfig
                                      >>>
                                      S { getS = xioNoEmptyElemFor
                                        , setS = \ x s -> s { xioNoEmptyElemFor = x}
                                        }

    theAddDefaultDTD                :: Selector XIOSysState Bool
    theAddDefaultDTD                = theOutputConfig
                                      >>>
                                      S { getS = xioAddDefaultDTD
                                        , setS = \ x s -> s { xioAddDefaultDTD = x}
                                        }

    theTextMode                     :: Selector XIOSysState Bool
    theTextMode                     = theOutputConfig
                                      >>>
                                      S { getS = xioTextMode
                                        , setS = \ x s -> s { xioTextMode = x}
                                        }

    theShowTree                     :: Selector XIOSysState Bool
    theShowTree                     = theOutputConfig
                                      >>>
                                      S { getS = xioShowTree
                                        , setS = \ x s -> s { xioShowTree = x}
                                        }

    theShowHaskell                  :: Selector XIOSysState Bool
    theShowHaskell                  = theOutputConfig
                                      >>>
                                      S { getS = xioShowHaskell
                                        , setS = \ x s -> s { xioShowHaskell = x}
                                        }

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

    theRelaxConfig                  :: Selector XIOSysState XIORelaxConfig
    theRelaxConfig                  = theSysEnv
                                      >>>
                                      S { getS = xioRelaxConfig
                                        , setS = \ x s -> s { xioRelaxConfig = x}
                                        }

    theRelaxValidate                :: Selector XIOSysState Bool
    theRelaxValidate                = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxValidate
                                        , setS = \ x s -> s { xioRelaxValidate = x}
                                        }

    theRelaxSchema                  :: Selector XIOSysState String
    theRelaxSchema                  = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxSchema
                                        , setS = \ x s -> s { xioRelaxSchema = x}
                                        }

    theRelaxCheckRestr              :: Selector XIOSysState Bool
    theRelaxCheckRestr              = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxCheckRestr
                                        , setS = \ x s -> s { xioRelaxCheckRestr = x}
                                        }

    theRelaxValidateExtRef          :: Selector XIOSysState Bool
    theRelaxValidateExtRef          = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxValidateExtRef
                                        , setS = \ x s -> s { xioRelaxValidateExtRef = x}
                                        }

    theRelaxValidateInclude         :: Selector XIOSysState Bool
    theRelaxValidateInclude         = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxValidateInclude
                                        , setS = \ x s -> s { xioRelaxValidateInclude = x}
                                        }

    theRelaxCollectErrors           :: Selector XIOSysState Bool
    theRelaxCollectErrors           = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxCollectErrors
                                        , setS = \ x s -> s { xioRelaxCollectErrors = x}
                                        }

    theRelaxValidator               :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
    theRelaxValidator               = theRelaxConfig
                                      >>>
                                      S { getS = xioRelaxValidator
                                        , setS = \ x s -> s { xioRelaxValidator = x}
                                        }

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

    theXmlSchemaConfig              :: Selector XIOSysState XIOXmlSchemaConfig
    theXmlSchemaConfig              = theSysEnv
                                      >>>
                                      S { getS = xioXmlSchemaConfig
                                        , setS = \ x s -> s { xioXmlSchemaConfig = x}
                                        }

    theXmlSchemaValidate            :: Selector XIOSysState Bool
    theXmlSchemaValidate            = theXmlSchemaConfig
                                      >>>
                                      S { getS = xioXmlSchemaValidate
                                        , setS = \ x s -> s { xioXmlSchemaValidate = x}
                                        }

    theXmlSchemaSchema              :: Selector XIOSysState String
    theXmlSchemaSchema              = theXmlSchemaConfig
                                      >>>
                                      S { getS = xioXmlSchemaSchema
                                        , setS = \ x s -> s { xioXmlSchemaSchema = x}
                                        }

    theXmlSchemaValidator           :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
    theXmlSchemaValidator           = theXmlSchemaConfig
                                      >>>
                                      S { getS = xioXmlSchemaValidator
                                        , setS = \ x s -> s { xioXmlSchemaValidator = x}
                                        }

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

    theParseConfig                  :: Selector XIOSysState XIOParseConfig
    theParseConfig                  = theSysEnv
                                      >>>
                                      S { getS = xioParseConfig
                                        , setS = \ x s -> s { xioParseConfig = x}
                                        }

    theErrorMsgHandler              :: Selector XIOSysState (String -> IO ())
    theErrorMsgHandler              = theSysEnv
                                      >>>
                                      S { getS = xioErrorMsgHandler
                                        , setS = \ x s -> s { xioErrorMsgHandler = x }
                                        }

    theErrorMsgCollect              :: Selector XIOSysState Bool
    theErrorMsgCollect              = theSysEnv
                                      >>>
                                      S { getS = xioErrorMsgCollect
                                        , setS = \ x s -> s { xioErrorMsgCollect = x }
                                        }

    theBaseURI                      :: Selector XIOSysState String
    theBaseURI                      = theSysEnv
                                      >>>
                                      S { getS = xioBaseURI
                                        , setS = \ x s -> s { xioBaseURI = x }
                                        }

    theDefaultBaseURI               :: Selector XIOSysState String
    theDefaultBaseURI               = theSysEnv
                                      >>>
                                      S { getS = xioDefaultBaseURI
                                        , setS = \ x s -> s { xioDefaultBaseURI = x }
                                        }

    theTraceLevel                   :: Selector XIOSysState Int
    theTraceLevel                   = theSysEnv
                                      >>>
                                      S { getS = xioTraceLevel
                                        , setS = \ x s -> s { xioTraceLevel = x }
                                        }

    theTraceCmd                     :: Selector XIOSysState (Int -> String -> IO ())
    theTraceCmd                     = theSysEnv
                                      >>>
                                      S { getS = xioTraceCmd
                                        , setS = \ x s -> s { xioTraceCmd = x }
                                        }

    theTrace                        :: Selector XIOSysState (Int, Int -> String -> IO ())
    theTrace                        = theTraceLevel .&&&. theTraceCmd

    theAttrList                     :: Selector XIOSysState Attributes
    theAttrList                     = theSysEnv
                                      >>>
                                      S { getS = xioAttrList
                                        , setS = \ x s -> s { xioAttrList = x }
                                        }

    theMimeTypes                    :: Selector XIOSysState MimeTypeTable
    theMimeTypes                    = theParseConfig
                                      >>>
                                      S { getS = xioMimeTypes
                                        , setS = \ x s -> s { xioMimeTypes = x }
                                        }

    theMimeTypeHandlers             :: Selector XIOSysState MimeTypeHandlers
    theMimeTypeHandlers             = theParseConfig
                                      >>>
                                      S { getS = xioMimeTypeHandlers
                                        , setS = \ x s -> s { xioMimeTypeHandlers = x }
                                        }

    theMimeTypeFile                 :: Selector XIOSysState String
    theMimeTypeFile                 = theParseConfig
                                      >>>
                                      S { getS = xioMimeTypeFile
                                        , setS = \ x s -> s { xioMimeTypeFile = x }
                                        }

    theAcceptedMimeTypes            :: Selector XIOSysState [String]
    theAcceptedMimeTypes            = theParseConfig
                                      >>>
                                      S { getS = xioAcceptedMimeTypes
                                        , setS = \ x s -> s { xioAcceptedMimeTypes = x }
                                        }

    theFileMimeType                 :: Selector XIOSysState String
    theFileMimeType                 = theParseConfig
                                      >>>
                                      S { getS = xioFileMimeType
                                        , setS = \ x s -> s { xioFileMimeType = x }
                                        }

    theWarnings                     :: Selector XIOSysState Bool
    theWarnings                     = theParseConfig
                                      >>>
                                      S { getS = xioWarnings
                                        , setS = \ x s -> s { xioWarnings = x }
                                        }

    theRemoveWS                     :: Selector XIOSysState Bool
    theRemoveWS                     = theParseConfig
                                      >>>
                                      S { getS = xioRemoveWS
                                        , setS = \ x s -> s { xioRemoveWS = x }
                                        }

    thePreserveComment              :: Selector XIOSysState Bool
    thePreserveComment              = theParseConfig
                                      >>>
                                      S { getS = xioPreserveComment
                                        , setS = \ x s -> s { xioPreserveComment = x }
                                        }

    theParseByMimeType              :: Selector XIOSysState Bool
    theParseByMimeType              = theParseConfig
                                      >>>
                                      S { getS = xioParseByMimeType
                                        , setS = \ x s -> s { xioParseByMimeType = x }
                                        }

    theParseHTML                    :: Selector XIOSysState Bool
    theParseHTML                    = theParseConfig
                                      >>>
                                      S { getS = xioParseHTML
                                        , setS = \ x s -> s { xioParseHTML = x }
                                        }

    theLowerCaseNames               :: Selector XIOSysState Bool
    theLowerCaseNames               = theParseConfig
                                      >>>
                                      S { getS = xioLowerCaseNames
                                        , setS = \ x s -> s { xioLowerCaseNames = x }
                                        }

    theValidate                     :: Selector XIOSysState Bool
    theValidate                     = theParseConfig
                                      >>>
                                      S { getS = xioValidate
                                        , setS = \ x s -> s { xioValidate = x }
                                        }

    theSubstDTDEntities            :: Selector XIOSysState Bool
    theSubstDTDEntities            = theParseConfig
                                      >>>
                                      S { getS = xioSubstDTDEntities
                                        , setS = \ x s -> s { xioSubstDTDEntities = x }
                                        }

    theSubstHTMLEntities            :: Selector XIOSysState Bool
    theSubstHTMLEntities            = theParseConfig
                                      >>>
                                      S { getS = xioSubstHTMLEntities
                                        , setS = \ x s -> s { xioSubstHTMLEntities = x }
                                        }

    theCheckNamespaces              :: Selector XIOSysState Bool
    theCheckNamespaces              = theParseConfig
                                      >>>
                                      S { getS = xioCheckNamespaces
                                        , setS = \ x s -> s { xioCheckNamespaces = x }
                                        }

    theCanonicalize                 :: Selector XIOSysState Bool
    theCanonicalize                 = theParseConfig
                                      >>>
                                      S { getS = xioCanonicalize
                                        , setS = \ x s -> s { xioCanonicalize = x }
                                        }

    theIgnoreNoneXmlContents        :: Selector XIOSysState Bool
    theIgnoreNoneXmlContents        = theParseConfig
                                      >>>
                                      S { getS = xioIgnoreNoneXmlContents
                                        , setS = \ x s -> s { xioIgnoreNoneXmlContents = x }
                                        }

    theTagSoup                      :: Selector XIOSysState Bool
    theTagSoup                      = theParseConfig
                                      >>>
                                      S { getS = xioTagSoup
                                        , setS = \ x s -> s { xioTagSoup = x }
                                        }

    theTagSoupParser                :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
    theTagSoupParser                = theParseConfig
                                      >>>
                                      S { getS = xioTagSoupParser
                                        , setS = \ x s -> s { xioTagSoupParser = x }
                                        }

    theExpat                        :: Selector XIOSysState Bool
    theExpat                        = theParseConfig
                                      >>>
                                      S { getS = xioExpat
                                        , setS = \ x s -> s { xioExpat = x }
                                        }

    theExpatParser                  :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
    theExpatParser                  = theParseConfig
                                      >>>
                                      S { getS = xioExpatParser
                                        , setS = \ x s -> s { xioExpatParser = x }
                                        }

    theExpatErrors                  :: Selector XIOSysState (IOSArrow XmlTree XmlTree)
    theExpatErrors                  = theSysWriter
                                      >>>
                                      S { getS = xioExpatErrors
                                        , setS = \ x s -> s { xioExpatErrors = x }
                                        }

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

    theCacheConfig                  :: Selector XIOSysState XIOCacheConfig
    theCacheConfig                  = theSysEnv
                                      >>>
                                      S { getS = xioCacheConfig
                                        , setS = \ x s -> s { xioCacheConfig = x}
                                        }

    theBinaryCompression            :: Selector XIOSysState (ByteString -> ByteString)
    theBinaryCompression            = theCacheConfig
                                      >>>
                                      S { getS = xioBinaryCompression
                                        , setS = \ x s -> s { xioBinaryCompression = x}
                                        }

    theBinaryDeCompression          :: Selector XIOSysState (ByteString -> ByteString)
    theBinaryDeCompression          = theCacheConfig
                                      >>>
                                      S { getS = xioBinaryDeCompression
                                        , setS = \ x s -> s { xioBinaryDeCompression = x}
                                        }

    theWithCache                    :: Selector XIOSysState Bool
    theWithCache                    = theCacheConfig
                                      >>>
                                      S { getS = xioWithCache
                                        , setS = \ x s -> s { xioWithCache = x}
                                        }

    theCacheDir                     :: Selector XIOSysState String
    theCacheDir                     = theCacheConfig
                                      >>>
                                      S { getS = xioCacheDir
                                        , setS = \ x s -> s { xioCacheDir = x}
                                        }

    theDocumentAge                  :: Selector XIOSysState Int
    theDocumentAge                  = theCacheConfig
                                      >>>
                                      S { getS = xioDocumentAge
                                        , setS = \ x s -> s { xioDocumentAge = x}
                                        }

    theCache404Err                  :: Selector XIOSysState Bool
    theCache404Err                  = theCacheConfig
                                      >>>
                                      S { getS = xioCache404Err
                                        , setS = \ x s -> s { xioCache404Err = x}
                                        }

    theCacheRead                    :: Selector XIOSysState (String -> IOSArrow XmlTree XmlTree)
    theCacheRead                    = theCacheConfig
                                      >>>
                                      S { getS = xioCacheRead
                                        , setS = \ x s -> s { xioCacheRead = x}
                                        }

    theStrictDeserialize            :: Selector XIOSysState Bool
    theStrictDeserialize            = theCacheConfig
                                      >>>
                                      S { getS = xioStrictDeserialize
                                        , setS = \ x s -> s { xioStrictDeserialize = x}
                                        }

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

    getSysVar                       :: Selector XIOSysState c -> IOStateArrow s b c
    getSysVar sel                   = IOSLA $ \ s _x ->
                                      return (s, (:[]) . getS (theSysState >>> sel) $ s)

    setSysVar                       :: Selector XIOSysState c -> IOStateArrow s c c
    setSysVar sel                   = (\ v -> configSysVar $ setS sel v) $< this

    chgSysVar                       :: Selector XIOSysState c -> (b -> c -> c) -> IOStateArrow s b b
    chgSysVar sel op                = (\ v -> configSysVar $ chgS sel (op v)) $< this

    configSysVar                    :: SysConfig -> IOStateArrow s c c
    configSysVar cf                 = IOSLA $ \ s v ->
                                      return (chgS theSysState cf s, [v])

    configSysVars                   :: SysConfigList -> IOStateArrow s c c
    configSysVars cfs               = configSysVar $ foldr (>>>) id $ cfs

    localSysVar                     :: Selector XIOSysState c -> IOStateArrow s a b -> IOStateArrow s a b
    localSysVar sel f               = IOSLA $ \ s0 v ->
                                      let sel' = theSysState >>> sel in
                                      let c0   = getS sel' s0 in
                                      do
                                      (s1, res) <- runIOSLA f s0 v
                                      return (setS sel' c0 s1, res)

    localSysEnv                     :: IOStateArrow s a b -> IOStateArrow s a b
    localSysEnv                     = localSysVar theSysEnv

    incrSysVar                      :: Selector XIOSysState Int -> IOStateArrow s a Int
    incrSysVar cnt                  = getSysVar cnt
                                      >>>
                                      arr (+1)
                                      >>>
                                      setSysVar cnt
                                      >>>
                                      arr (\ x -> x - 1)

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

    -- | store a string in global state under a given attribute name

    setSysAttr              :: String -> IOStateArrow s String String
    setSysAttr n            = chgSysVar theAttrList (addEntry n)

    -- | remove an entry in global state, arrow input remains unchanged

    unsetSysAttr            :: String -> IOStateArrow s b b
    unsetSysAttr n            = configSysVar $ chgS theAttrList (delEntry n)

    -- | read an attribute value from global state

    getSysAttr                :: String -> IOStateArrow s b String
    getSysAttr n              = getSysVar theAttrList
                              >>^
                              lookup1 n

    -- | read all attributes from global state

    getAllSysAttrs            :: IOStateArrow s b Attributes
    getAllSysAttrs            = getSysVar theAttrList

    setSysAttrString        :: String -> String -> IOStateArrow s b b
    setSysAttrString n v    = perform ( constA v
                                        >>>
                                        setSysAttr n
                                      )

    -- | store an int value in global state

    setSysAttrInt           :: String -> Int -> IOStateArrow s b b
    setSysAttrInt n v       = setSysAttrString n (show v)

    -- | read an int value from global state
    --
    -- > getSysAttrInt 0 myIntAttr

    getSysAttrInt           :: Int -> String -> IOStateArrow s b Int
    getSysAttrInt def n     = getSysAttr n
                              >>^
                              toInt def

    toInt                   :: Int -> String -> Int
    toInt def s
        | not (null s)
          &&
          all isDigit s     = read s
        | otherwise         = def

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