module Text.XML.HXT.Arrow.XmlState.RunIOStateArrow
where
import Control.Arrow
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
runX :: IOSArrow XmlTree c -> IO [c]
runX :: IOSArrow XmlTree c -> IO [c]
runX = XIOState () -> IOSArrow 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 :: XIOState s -> IOStateArrow s XmlTree c -> IO [c]
runXIOState s0 :: XIOState s
s0 f :: IOStateArrow s XmlTree c
f
= do
(_finalState :: XIOState s
_finalState, res :: [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 (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 (a :: * -> * -> *) n.
ArrowXml a =>
[a n XmlTree] -> [a n XmlTree] -> a n XmlTree
root [] []
initialState :: us -> XIOState us
initialState :: us -> XIOState us
initialState s :: us
s = $WXIOState :: forall us. XIOSysState -> us -> XIOState us
XIOState { xioSysState :: XIOSysState
xioSysState = XIOSysState
initialSysState
, xioUserState :: us
xioUserState = us
s
}
initialSysState :: XIOSysState
initialSysState :: XIOSysState
initialSysState = $WXIOSys :: XIOSysWriter -> XIOSysEnv -> XIOSysState
XIOSys
{ xioSysWriter :: XIOSysWriter
xioSysWriter = XIOSysWriter
initialSysWriter
, xioSysEnv :: XIOSysEnv
xioSysEnv = XIOSysEnv
initialSysEnv
}
initialSysWriter :: XIOSysWriter
initialSysWriter :: XIOSysWriter
initialSysWriter = $WXIOwrt :: Int
-> XmlTrees
-> IOSArrow XmlTree XmlTree
-> Int
-> Int
-> AssocList String XmlTrees
-> XIOSysWriter
XIOwrt
{ xioErrorStatus :: Int
xioErrorStatus = Int
c_ok
, xioErrorMsgList :: XmlTrees
xioErrorMsgList = []
, xioExpatErrors :: IOSArrow XmlTree XmlTree
xioExpatErrors = IOSArrow XmlTree XmlTree
forall (a :: * -> * -> *) b c. ArrowList a => a b c
none
, xioRelaxNoOfErrors :: Int
xioRelaxNoOfErrors = 0
, xioRelaxDefineId :: Int
xioRelaxDefineId = 0
, xioRelaxAttrList :: AssocList String XmlTrees
xioRelaxAttrList = []
}
initialSysEnv :: XIOSysEnv
initialSysEnv :: XIOSysEnv
initialSysEnv = $WXIOEnv :: Int
-> (Int -> String -> IO ())
-> (String -> IO ())
-> Bool
-> String
-> String
-> Attributes
-> XIOInputConfig
-> XIOParseConfig
-> XIOOutputConfig
-> XIORelaxConfig
-> XIOXmlSchemaConfig
-> XIOCacheConfig
-> XIOSysEnv
XIOEnv
{ xioTraceLevel :: Int
xioTraceLevel = 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 = ""
, xioDefaultBaseURI :: String
xioDefaultBaseURI = ""
, 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 = $WXIOIcgf :: Bool
-> Bool
-> String
-> IOSArrow XmlTree XmlTree
-> Attributes
-> Bool
-> String
-> XIOInputConfig
XIOIcgf
{ xioStrictInput :: Bool
xioStrictInput = Bool
False
, xioEncodingErrors :: Bool
xioEncodingErrors = Bool
True
, xioInputEncoding :: String
xioInputEncoding = ""
, xioHttpHandler :: IOSArrow XmlTree XmlTree
xioHttpHandler = IOSArrow XmlTree XmlTree
dummyHTTPHandler
, xioInputOptions :: Attributes
xioInputOptions = []
, xioRedirect :: Bool
xioRedirect = Bool
False
, xioProxy :: String
xioProxy = ""
}
initialParseConfig :: XIOParseConfig
initialParseConfig :: XIOParseConfig
initialParseConfig = $WXIOPcfg :: MimeTypeTable
-> MimeTypeHandlers
-> String
-> [String]
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> IOSArrow XmlTree XmlTree
-> Bool
-> IOSArrow XmlTree XmlTree
-> XIOParseConfig
XIOPcfg
{ xioMimeTypes :: MimeTypeTable
xioMimeTypes = MimeTypeTable
defaultMimeTypeTable
, xioMimeTypeHandlers :: MimeTypeHandlers
xioMimeTypeHandlers = MimeTypeHandlers
forall k a. Map k a
empty
, xioMimeTypeFile :: String
xioMimeTypeFile = ""
, xioAcceptedMimeTypes :: [String]
xioAcceptedMimeTypes = []
, xioFileMimeType :: String
xioFileMimeType = ""
, 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 = $WXIOOcfg :: Bool
-> String
-> XIOXoutConfig
-> Bool
-> [String]
-> Bool
-> Bool
-> Bool
-> Bool
-> XIOOutputConfig
XIOOcfg
{ xioIndent :: Bool
xioIndent = Bool
False
, xioOutputEncoding :: String
xioOutputEncoding = ""
, 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 = $WXIORxc :: Bool
-> String
-> Bool
-> Bool
-> Bool
-> Bool
-> IOSArrow XmlTree XmlTree
-> XIORelaxConfig
XIORxc
{ xioRelaxValidate :: Bool
xioRelaxValidate = Bool
False
, xioRelaxSchema :: String
xioRelaxSchema = ""
, 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 = $WXIOScc :: Bool -> String -> IOSArrow XmlTree XmlTree -> XIOXmlSchemaConfig
XIOScc
{ xioXmlSchemaValidate :: Bool
xioXmlSchemaValidate = Bool
False
, xioXmlSchemaSchema :: String
xioXmlSchemaSchema = ""
, xioXmlSchemaValidator :: IOSArrow XmlTree XmlTree
xioXmlSchemaValidator = IOSArrow XmlTree XmlTree
forall b. IOSArrow b b
dummyXmlSchemaValidator
}
initialCacheConfig :: XIOCacheConfig
initialCacheConfig :: XIOCacheConfig
initialCacheConfig = $WXIOCch :: CompressionFct
-> CompressionFct
-> Bool
-> String
-> Int
-> Bool
-> (String -> IOSArrow XmlTree XmlTree)
-> Bool
-> XIOCacheConfig
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 = ""
, xioDocumentAge :: Int
xioDocumentAge = 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
$
[ "HTTP handler not configured,"
, "please install package hxt-curl and use 'withCurl' config option"
, "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 "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 "999"
dummyTagSoupParser :: IOSArrow b b
dummyTagSoupParser :: IOSArrow b b
dummyTagSoupParser = 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
$
[ "TagSoup parser not configured,"
, "please install package hxt-tagsoup"
, " and use 'withTagSoup' parser config option from this package"
]
dummyExpatParser :: IOSArrow b b
dummyExpatParser :: IOSArrow b b
dummyExpatParser = 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
$
[ "Expat parser not configured,"
, "please install package hxt-expat"
, " and use 'withExpat' parser config option from this package"
]
dummyRelaxValidator :: IOSArrow b b
dummyRelaxValidator :: IOSArrow b b
dummyRelaxValidator = 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
$
[ "RelaxNG validator not configured,"
, "please install package hxt-relaxng"
, " and use 'withRelaxNG' config option from this package"
]
dummyXmlSchemaValidator :: IOSArrow b b
dummyXmlSchemaValidator :: IOSArrow b b
dummyXmlSchemaValidator = 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
$
[ "XML Schema validator not configured,"
, "please install package hxt-xmlschema"
, " and use 'withXmlSchema' config option from this package"
]
dummyCacheRead :: String -> IOSArrow b b
dummyCacheRead :: 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
$
[ "Document cache not configured,"
, "please install package hxt-cache and use 'withCache' config option"
]
getConfigAttr :: String -> SysConfigList -> String
getConfigAttr :: String -> SysConfigList -> String
getConfigAttr n :: String
n c :: 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 (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 :: Selector XIOSysState a -> Selector (XIOSysState -> XIOSysState) a
theSysConfigComp sel :: Selector XIOSysState a
sel = S :: forall s a. (s -> a) -> (a -> s -> s) -> Selector s a
S { getS :: (XIOSysState -> XIOSysState) -> a
getS = \ cf :: 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 = \ val :: a
val cf :: 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
}