hxt-filter-8.2.0: A collection of tools for processing XML with Haskell (Filter variant).Source codeContentsIndex
Text.XML.HXT.DOM.XmlState
Description

This module provides a Monad for an internal state and IO commands. The state consists of two parts, the user state and the system state user state ist a type parameter, the system state is a list name-value pair. If the user state is not needed, the type parameter can be instantiated with ().

Furthermore there are types for Xml filter working on this monad and functions for manipulating the state components and for lifting i/o commands and XmlFilter to monad filters.

Error reporting functions are also located in this module.

Synopsis
data SysState = SysState {
sysStateAttrs :: !SysStateAttrs
sysStateErrorHandler :: !(XmlStateFilter ())
}
type SysStateAttrs = AssocList String XmlTrees
data XmlState state = XmlState {
sysState :: !SysState
userState :: !state
}
type XState state res = StateIO (XmlState state) res
type XmlStateFilter state = XmlTree -> XState state XmlTrees
changeState :: (state -> state) -> XState state state
setState :: state -> XState state state
getState :: XState state state
changeSysState :: (SysState -> SysState) -> XState state SysState
setSysState :: SysState -> XState state SysState
getSysState :: XState state SysState
initialSysState :: SysState
changeSysStateAttrs :: (SysStateAttrs -> SysStateAttrs) -> SysState -> SysState
setSysErrorHandler :: XmlStateFilter () -> XState state ()
getSysErrorHandler :: XState state (XmlStateFilter ())
setSysParamTree :: String -> XmlTrees -> XState state ()
setSysParam :: String -> String -> XState state ()
setSysParamInt :: String -> Int -> XState state ()
setSystemParams :: XmlStateFilter state
getSysParamTree :: String -> XState state XmlTrees
getSysParam :: String -> XState state String
getSysParamWithDefault :: String -> String -> XState state String
getSysParamInt :: String -> Int -> XState state Int
run0 :: XmlState state -> XState state res -> IO (res, XmlState state)
run :: state -> XState state res -> IO res
run' :: XState () res -> IO res
chain' :: state1 -> XState state1 res -> XState state0 (res, state1)
chain :: state1 -> XState state1 res -> XState state0 res
liftF :: XmlFilter -> XmlStateFilter state
io :: IO a -> XState state a
setTraceLevel :: Int -> XState state ()
getTraceLevel :: XState state Int
traceCmd :: Int -> XState state a -> XState state ()
trace :: Int -> String -> XState state ()
traceState :: Int -> (state -> String) -> XState state ()
clearStatus :: XmlStateFilter state
issueError :: XmlStateFilter state
errorMsgHandler :: XmlStateFilter state
setErrorMsgLevel :: XmlStateFilter state
errorMsgToStderr :: XmlStateFilter state
errorMsgLogging :: XmlStateFilter state
errorMsgLoggingAndToStderr :: XmlStateFilter state
getErrorMsg :: XmlStateFilter state
errClass :: Int -> String
issueWarn :: String -> XmlStateFilter state
issueErr :: String -> XmlStateFilter state
issueFatal :: String -> XmlStateFilter state
addFatal :: String -> XmlStateFilter state
checkStatus :: XmlStateFilter state
setStatus :: Int -> String -> XmlFilter
statusOk :: XmlFilter
checkResult :: String -> XmlStateFilter state
processAttrM :: XmlStateFilter a -> XmlStateFilter a
Documentation
data SysState Source
The internal system state consists of a list of name-value pairs of type (String, XmlTrees), so arbitrary lists of trees can be stored. For options, often only strings are used as values, so a set of access functions with string values is available The error handling method can be controlled by an error handler filter, the default filter issues the errors on stderr
Constructors
SysState
sysStateAttrs :: !SysStateAttrs
sysStateErrorHandler :: !(XmlStateFilter ())
type SysStateAttrs = AssocList String XmlTreesSource
data XmlState state Source
The State has a system and a user part the user state is a type parameter
Constructors
XmlState
sysState :: !SysState
userState :: !state
type XState state res = StateIO (XmlState state) resSource
The monad type for commands. It is an instance of StateIO from the general module Control.Monad.MonadStateIO.
type XmlStateFilter state = XmlTree -> XState state XmlTreesSource
The XmlFilter type for filters working on a state
changeState :: (state -> state) -> XState state stateSource

change the user state

  • 1.parameter fct : the user state change function
  • returns : the new state
setState :: state -> XState state stateSource

set the user state.

  • 1.parameter s : the new state
  • returns : the new state
getState :: XState state stateSource

read the user state

  • returns : the current state
changeSysState :: (SysState -> SysState) -> XState state SysStateSource

change the system part of the state.

see also : changeState

setSysState :: SysState -> XState state SysStateSource

set the system part of the state.

see also : setState

getSysState :: XState state SysStateSource

read the system part of the state.

see also : getState

initialSysState :: SysStateSource

the initial system state

an empty list of attribute value pairs

changeSysStateAttrs :: (SysStateAttrs -> SysStateAttrs) -> SysState -> SysStateSource
change the attributes in the system state
setSysErrorHandler :: XmlStateFilter () -> XState state ()Source
set the error message handler
getSysErrorHandler :: XState state (XmlStateFilter ())Source
get the error handler
setSysParamTree :: String -> XmlTrees -> XState state ()Source

set or change a single system parameter.

  • 1.parameter name : the name of the parameter
  • 2.parameter value : the list of associated trees
  • returns : nothing

see also : setSysParam, setSysParamInt

setSysParam :: String -> String -> XState state ()Source

set or change a single system parameter of type string.

  • 1.parameter name : the name of the parameter
  • 2.parameter value : the (new) string value
  • returns : nothing

see also : setSysParamTree, setSysParamInt

setSysParamInt :: String -> Int -> XState state ()Source

set or change a single integer type system parameter

see also : setSysParam

setSystemParams :: XmlStateFilter stateSource
add (or change) all attributes of the document root to the system state - returns : this
getSysParamTree :: String -> XState state XmlTreesSource

read a system parameter

  • 1.parameter name : the name of the parameter
  • returns : the list of tres associated with the key, or the empty list for unknown parameters
getSysParam :: String -> XState state StringSource

read a system string parameter

  • 1.parameter name : the name of the parameter
  • returns : the value, or the empty string for unknown parameters
getSysParamWithDefault :: String -> String -> XState state StringSource

read a system parameter or return a default value

  • 1.parameter name : the name of the parameter
  • 2.parameter default : the default value
  • returns : the value if found, else the default
getSysParamInt :: String -> Int -> XState state IntSource

read an integer system parameter

  • 1.parameter name :
  • 2.parameter default :

see also : getSysParamWithDefault

run0 :: XmlState state -> XState state res -> IO (res, XmlState state)Source

exec a XState command with initial state.

  • 1.parameter initalState : the inital user state
  • 2.parameter cmd : the command
  • returns : the i/o command with result and user state
run :: state -> XState state res -> IO resSource
exec a XState command with initial user state. ignore final user state. like run0, but ignore the resulting user state
run' :: XState () res -> IO resSource
exec a XState command in th IO monad. like run with the empty state ().
chain' :: state1 -> XState state1 res -> XState state0 (res, state1)Source

run a command in a new user state. chain the system state part, init new system state with the current one, run the command and update the old system state with the resulting new system state

  • 1.parameter initialUserState : the initial user state
  • 2.parameter cmd : the command
  • returns : the result of executing cmd and the final state
chain :: state1 -> XState state1 res -> XState state0 resSource

like chain' but forget the final user state

  • 1.parameter initialUserState : the initial user state
  • 2.parameter cmd : the command
  • returns : only the result of executing cmd
liftF :: XmlFilter -> XmlStateFilter stateSource

lift a XmlFilter to a XmlStateFilter filter issue all error nodes as error messages and remove the error nodes from the result

  • 1.parameter f : the filter
  • returns : the filter running in the state monad

all errors are filtered from the result and issued on stderr

io :: IO a -> XState state aSource

lift an I/O command

  • 1.parameter cmd : the i/o command
  • returns : the i/o command lifted to the XML state monad
setTraceLevel :: Int -> XState state ()Source

set the trace level.

convention:

0: no trace output (default)

1: trace important computation steps, e.g. accessing a document

2: trace small computation steps

3: output an intermediate result XmlTree in XML source format

4: output an intermediate result XmlTree in tree representation

  • 1.parameter level : the trace level
  • returns : nothing
getTraceLevel :: XState state IntSource

get the current trace level.

  • returns : the current trace level
traceCmd :: Int -> XState state a -> XState state ()Source

trace output for arbitray commands.

  • 1.parameter level : the trace level, for which the command will be execuded if level <= current trace level
  • 2.parameter cmd : the command to be executed
  • returns : nothing
trace :: Int -> String -> XState state ()Source

trace output function for simple text.

  • 1.parameter level : like in traceCmd
  • 2.parameter str : the test
  • returns : nothing
traceState :: Int -> (state -> String) -> XState state ()Source

trace output of the user part of the program state.

  • 1.parameter level : like in traceCmd
  • 2.parameter showFct : the toString function
  • returns : nothing
clearStatus :: XmlStateFilter stateSource
filter to reset the state attribute a_status - returns : this
issueError :: XmlStateFilter stateSource

report an error message.

  • returns : if the input tree n represents an error, res = [] and the error is processed by the errror handler filter (default: error is issued on stderr) else res = [n]

see also : issueErr

errorMsgHandler :: XmlStateFilter stateSource
setErrorMsgLevel :: XmlStateFilter stateSource
set the error level in system state
errorMsgToStderr :: XmlStateFilter stateSource
default error handler for writing errors to stderr
errorMsgLogging :: XmlStateFilter stateSource
error message handler for collecting all error messages all messages are stored under attribute a_error_log they can be read with getSysParamTree a_error_log or by applying the filter getErrorMsg to the root node
errorMsgLoggingAndToStderr :: XmlStateFilter stateSource
getErrorMsg :: XmlStateFilter stateSource

the filter for reading all collected error mesages

result is the list of error messages, the input tree is ignored

errClass :: Int -> StringSource
error level translation c_warn (1) : warning, c_err (2): error (e.g. parse error, validation error, ...), c_fatal (3) : fatal error (document access error, internal error, ...)
issueWarn :: String -> XmlStateFilter stateSource

short cut for issuing a warning

see also : issueError, issueErr

issueErr :: String -> XmlStateFilter stateSource

short cut for issuing an error

see also : issueError

issueFatal :: String -> XmlStateFilter stateSource

short cut for issuing a fatal error

see also : issueError, issueErr

addFatal :: String -> XmlStateFilter stateSource
checkStatus :: XmlStateFilter stateSource
checks the value of the attribute a_status in a document root. if it contains a value greater or equal to c_err, an error with error message stored in attribute a_module is issued and the filter acts as the noneM filter else its the thisM filter
setStatus :: Int -> String -> XmlFilterSource
add the error level and the module where the error occured to the attributes of a document root node and remove the children when level is greater or equal to c_err
statusOk :: XmlFilterSource
check whether tree is a document root and the status attribute has a value less than c_err
checkResult :: String -> XmlStateFilter stateSource
check whether the error level attribute in the system state is set to error, in this case the children of the document root are removed and error info is added as attributes with setStatus else nothing is changed
processAttrM :: XmlStateFilter a -> XmlStateFilter aSource

monadic filter for processing the attribute list of a tag. for other trees this filter acts like noneM

see also : processAttr, processAttrl

Produced by Haddock version 2.3.0