content: -- ------------------------------------------------------------
  
  {- |
     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
                              }
  
  -- ------------------------------------------------------------
  