hxt-filter-8.4.2: A collection of tools for processing XML with Haskell (Filter variant).

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

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

data XmlState state Source

The State has a system and a user part the user state is a type parameter

Constructors

XmlState 

Fields

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

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

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

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