This pickler converts a map into a list of pairs.
+ All key value pairs are mapped to an element with name (1.arg),
+ the key is encoded as an attribute named by the 2. argument,
+ the 3. arg is the pickler for the keys, the last one for the values
+
Extra parameter is the element name. THE pickler for constructing
nested structures
Example:
+
xpElem "number" $ xpickle
+
will map an (42::Int) onto
+
<number>42</number>
+
xpElemWithAttrValue :: String -> String -> String -> PU a -> PU a
Pickler for wrapping/unwrapping data into an XML element with an attribute with given value
+
To make XML structures flexible but limit the number of different elements, it's sometimes
+ useful to use a kind of generic element with a key value structure
+
Run two picklers in sequence like with xpSeq.
When during unpickling the first one fails,
an alternative pickler (first argument) is applied.
- This pickler only is used as combinator for unpickling.
+ This pickler is only used as combinator for unpickling.
Pickler for wrapping/unwrapping data into an XML element with an attribute with given value
+
To make XML structures flexible but limit the number of different elements, it's sometimes
+ useful to use a kind of generic element with a key value structure
+
This pickler converts a map into a list of pairs.
+ All key value pairs are mapped to an element with name (1.arg),
+ the key is encoded as an attribute named by the 2. argument,
+ the 3. arg is the pickler for the keys, the last one for the values
+
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Source codea_issue_errors : issue all error messages on stderr (default), or ignore all error messages (default)
+> : issue all error messages on stderr (default), or ignore all error messages
a_ignore_none_xml_contents: ignore document contents of none XML/HTML documents.
+ This option can be useful for implementing crawler like applications, e.g. an URL checker.
+ In those cases net traffic can be reduced.
+
a_tracea_use_curl : for http access via external programm curl, default is native HTTP access
+> : obsolete and ignored, HTTP acccess is always done with curl bindings for libcurl
a_options_curl : more options for external program curl
+> : deprecated but for compatibility reasons still supported.
+ More options passed to the curl binding.
+ Instead of using this option to set a whole bunch of options at once for curl
+ it is recomended to use the curl-.* options syntax described below.
iso8859_16, ...)
+>, ...).
+ Only XML and HTML documents are decoded, documents with none XML/HTML mime types are not decoded. The whole content is returned in a single text node
a_mime_types : set the mime type table for file input with given file. The format of this config file must be in the syntax of a debian linux "mime.types" config file
+
curl options : the HTTP interface with libcurl can be configured with a lot of options. To support these options in an easy way, there is a naming convetion:
+ Every option, which has the prefix curl and the rest of the name forms an option as described in the curl man page, is passed to the curl binding lib.
+ See getCont for examples. Currently most of the options concerning HTTP requests are implemented.
+
All attributes not evaluated by readDocument are stored in the created document root node for easy access of the various
@@ -417,10 +457,11 @@
>
reads document "test.xml" without validation, default encoding reads document "test.php", parses it as HTML or XML depending on the mimetype given from the server, but without validation, default encoding isoLatin1
reads an SVG document from standard input, sets the mime type by looking in the system mimetype config file, default encoding is isoLatin1,
+parsing is done with the lightweight tagsoup parser, which implies no validation.
set the table mapping of file extensions to mime types by an external config file
+
The config file must follow the conventions of etcmime.types on a debian linux system,
+ that means all empty lines and all lines starting with a # are ignored. The other lines
+ must consist of a mime type followed by a possible empty list of extensions.
+ The list of extenstions and mime types overwrites the default list in the system state
+ of the IOStateArrow
+
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
propagate all namespace declarations, check namespace constraints and issue errors.
- If no error was found, result is the unchanged input tree, else the root node "/" with an empty document is returned.
-
propagateNamespaces takes a XML tree and
- attaches extra namespace info at every tag name and attribute name.
- So after processing a tree with propagateNamespaces, the access functions
- namespaceOf and universalNameOf deliver the associated namespace (or "")
- for tag names and attribute names.
-
validateNamespaces checks whether names are wellformed related to the XML namespace definition.
- whether a legal namespace is declared for all prefixes, and whether attribute names are unique
- related to universal names.
-
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.
-
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
-
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 res
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]
-
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
-
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
-
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
-
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
-
monadic filter for reading, parsing and checking a wellformed document.
- the input tree must consist of a root node with a source attribute
- in its attribute list.
-
All attributes from the document root are copied into the system state,
- and may be queried by the monadic filters, e.g. trace options.
-
Result is the single element list containing the well-formed document tree
- or, in case of errors, the document root with an empty list as children
- and attributes a_status and a_module for error level and the module,
- where the error occured.
-
This parser tries to interprete everything as HTML
- no errors are emitted during parsing. If something looks
- weired, warning messages are inserted in the document tree.
-
Module contains state filter for easy parsing and error handling
- real work is done in HtmlParsec
-
read a document and parse it with parseHtmlDoc. The main entry point of this module
-
The input tree must be a root tree like in ' Text.XML.HXT.Parser.MainFunctions.getXmlDoc'. The content is read with getXmlContents,
- is parsed with parseHtmlDoc and canonicalized (char refs are substituted in content and attributes,
- but comment is preserved)
-
The input is parsed with runHtmlParser, everything is interpreted as HTML,
- if errors ocuur, the parser will try to do some meaningfull action and continues
- parsing. Afterwards the entitiy references for defined for XHTML are resovled,
- any unresolved reference is transformed into plain text.
-
Error messages
- during parsing and entity resolving are added as warning nodes into the resulting tree.
-
The warnings are issued, if the 1. parameter noWarnings is set to True,
- afterwards all are removed from the resulting tree.
-
the main building blocks for an application.
- this module exports complex filters and functions for
- common tasks for input and parsing, output and option handling.
-
writes a complete document tree to a file, writing can be
- controlled by options, the real work is done with filter writeDocument.
- useful options are the options of writeDocument.
-
result is a pair: 1.part is a list of error messages, 2. part is the return code,
- the status info of the write filter
-
this filter is useful, when processing XML in an arbitray context in the IO monad
-
an example main program for such an application is:
-
main :: IO ()
- main
- = do
- (input, readErrs, rc) <- getXmlDocument [...] "test.xml"
- if rc >= c_err
- then issueErrors readErrs
- else processTree input
-
- processTree :: XmlTree -> IO ()
- processTree t
- = let res = computeNewTree input
- in do
- (writeErrs, rc2) <- putXmlDocument [...] "out.xml" res
- if rc2 >= c_err
- then issueErrors writeErrs
- else return ()
-
- issueErrors :: XmlTrees -> IO ()
-
- computeNewTree :: XmlTree -> XmlTree
-
this filter can be configured by an option list, a list of
- option name, option value pairs.
- the input tree must be a possibly empty document root tree.
- all the options are stored as attributes in this root node to control processing.
-
available options:
-
a_parse_html: use HTML parser, else use XML parser (default)
-
a_remove_whitespace : remove all whitespace, used for document indentation, else skip this step (default)
-
a_indent : indent document by inserting whitespace, else skip this step (default)
-
a_issue_warnings : issue warnings, when parsing HTML (default), else ignore HTML parser warnings
-
a_issue_errors : issue all error messages on stderr (default), or ignore all error messages
-
a_collect_errors : all error messages are collected during processing and appended to the result document
- for further processing within the calling modules
-
a_trace : trace level: values: 0 -4
-
a_proxy : proxy for http access, e.g. www-cache:3128
-
a_use_curl : for http access via external programm curl, default is native HTTP access
-
a_options_curl : more options for external program curl
-
reads file "test.xml", validates it, checks namespaces, does not issue any erros
- but collects errors and appends the list of errors to the single element list for the document.
- this enables the calling application to define own error handlers.
-
this filter can be configured by an option list like getXmlDocument
-
available options are
-
a_indent : indent document for readability, (default: no indentation)
-
a_remove_whitespace : remove all redundant whitespace for shorten text (default: no removal)
-
a_output_file : destination file for document, default is "-" for stdout
-
a_output_encoding : encoding of document, default is a_encoding or utf8
-
a_output_xml : (default) issue XML: quote special XML chars >,<,",',&
- add XML processing instruction
- and encode document with respect to a_output_encoding,
- if explizitly switched of, the plain text is issued, this is useful
- for non XML output, e.g. generated Haskell code, LaTex, Java, ...
-
a_show_tree : show tree representation of document (for debugging)
-
a_show_haskell : show Haskell representaion of document (for debugging)
-
a_issue_errors, a_collect_errors : see parseDocument
-
a typical main program running in the XmlState monad
- has the following structure:
-
- main :: IO ()
- main
- = do
- argv <- getArgs -- get the commandline arguments
- (inp, outp, options) <- cmdlineOpts argv -- and evaluate them, return a key-value list
- -- and input and output
- res <- run' $ application inp outp options $ emptyRoot -- run the application
-
- exitWith (if null res
- then ExitFailure (-1)
- else exitSuccess
- )
-
- application :: String -> String -> Attributes -> XmlStateFilter ()
- application inp outp al
- = parseDocument (al ++ [(a_source, inp)]) -- set options and source
- .>> -- and parse document
- processDocument -- the hard work
- .>>
- writeDocument [(a_output_file, outp)] -- issue results
- .>>
- checkStatus -- check errors
-
-
filter for reading the content of a XML document
-
input is a root node with the source as an attibute
- the text is read, the encoding scheme is parsed and selected
- and the input is translated into the internal UTF-8 string representation
-
compute the length of the data for a document read previously
- by a call of 'getUrlContents. The result is stored as an attribute
- value in the document root node. the attribute name is a_contentLength
-
the main building blocks for an application.
- this module exports all important functions for parsing, validating and transforming XML.
- it also exports all basic datatypes and functions of the toolbox.
-
Checks if the attribute value meets the lexical constraints of its type.
-
1.parameter dtdPart : the children of the DOCTYPE node
-
2.parameter attrDecl : the declaration of the attribute from the DTD
-
returns : a function which takes an element (XTag or XDTD ATTLIST),
- checks if the attribute value meets the lexical constraints
- of its type and returns a list of errors
-
the input tree must consist of a root node with a complete document and DTD.
- Result is the single element list containing same tree but tranformed with respect to the DTD,
- or, in case of errors, the root with an empty list of children
-
filter for transforming a document with respect to the given DTD.
-
Validating parsers
- are expected to normalize attribute values and add default values.
- This function should be called after a successful validation.
-
returns : a function which expects a complete XML document tree
- and returns the transformed XmlTree
-
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Source codehxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Data.Tree.Classhxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell. (Index)hxt-8.1.0: A collection of tools for processing XML with Haskell. (Index)
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
Contentshxt-8.0.0: A collection of tools for processing XML with Haskell.hxt-8.1.0: A collection of tools for processing XML with Haskell.
hxt-8.0.0: A collection of tools for processing XML with Haskell.
hxt-8.1.0: A collection of tools for processing XML with Haskell.
class(ArrowPlusa,ArrowIfa)=>ArrowTreeawhere
--- | select the children of the root of a tree
+-- | construct a leaf
-getChildren::Treet=>a(tb)(tb)
-getChildren=arrLT.getChildren
+mkLeaf::Treet=>b->ac(tb)
+mkLeaf=constA.T.mkLeaf
--- | select the attribute of the root of a tree
+-- | construct an inner node
-getNode::Treet=>a(tb)b
-getNode=arrT.getNode
+mkTree::Treet=>b->[tb]->ac(tb)
+mkTreen=constA.T.mkTreen
--- | substitute the children of the root of a tree
+-- | select the children of the root of a tree
-setChildren::Treet=>[tb]->a(tb)(tb)
-setChildrencs=arr(T.setChildrencs)
+getChildren::Treet=>a(tb)(tb)
+getChildren=arrLT.getChildren
--- | substitute the attribute of the root of a tree
+-- | select the attribute of the root of a tree
-setNode::Treet=>b->a(tb)(tb)
-setNoden=arr(T.setNoden)
+getNode::Treet=>a(tb)b
+getNode=arrT.getNode
--- | edit the children of the root of a tree
+-- | substitute the children of the root of a tree
-changeChildren::Treet=>([tb]->[tb])->a(tb)(tb)
-changeChildrencsf=arr(T.changeChildrencsf)
+setChildren::Treet=>[tb]->a(tb)(tb)
+setChildrencs=arr(T.setChildrencs)
--- | edit the attribute of the root of a tree
+-- | substitute the attribute of the root of a tree
-changeNode::Treet=>(b->b)->a(tb)(tb)
-changeNodenf=arr(T.changeNodenf)
+setNode::Treet=>b->a(tb)(tb)
+setNoden=arr(T.setNoden)
--- compound arrows
+-- | edit the children of the root of a tree
--- | apply an arrow element wise to all children of the root of a tree
--- collect these results and substitute the children with this result
---
--- example: @ processChildren isText @ deletes all subtrees, for which isText does not hold
---
--- example: @ processChildren (none \`when\` isCmt) @ removes all children, for which isCmt holds
-
-processChildren::Treet=>a(tb)(tb)->a(tb)(tb)
-processChildrenf=arrT.getNode
-&&&
-listA(arrLT.getChildren>>>f)-- new children, deterministic filter: single element result
->>>
-arr2T.mkTree
-
--- | similar to processChildren, but the new children are computed by processing
--- the whole input tree
---
--- example: @ replaceChildren (deep isText) @ selects all subtrees for which isText holds
--- and substitutes the children component of the root node with this list
-
-replaceChildren::Treet=>a(tb)(tb)->a(tb)(tb)
-replaceChildrenf=arrT.getNode
-&&&
-listAf-- compute new children
->>>
-arr2T.mkTree
-
--- |
--- pronounced \"slash\", meaning g inside f
---
--- defined as @ f \/> g = f >>> getChildren >>> g @
---
--- example: @ hasName \"html\" \/> hasName \"body\" \/> hasName \"h1\" @
---
--- This expression selects
--- all \"h1\" elements in the \"body\" element of an \"html\" element, an expression, that
--- corresponds 1-1 to the XPath selection path \"html\/body\/h1\"
-
-(/>)::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
-f/>g=f>>>getChildren>>>g
-
-
--- |
--- pronounced \"outside\" meaning f containing g
---
--- defined as @ f \<\/ g = f \`containing\` (getChildren >>> g) @
-
-(</)::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
-f</g=f`containing`(getChildren>>>g)
-
+changeChildren::Treet=>([tb]->[tb])->a(tb)(tb)
+changeChildrencsf=arr(T.changeChildrencsf)
+
+-- | edit the attribute of the root of a tree
+
+changeNode::Treet=>(b->b)->a(tb)(tb)
+changeNodenf=arr(T.changeNodenf)
+
+-- compound arrows
+
+-- | apply an arrow element wise to all children of the root of a tree
+-- collect these results and substitute the children with this result
+--
+-- example: @ processChildren isText @ deletes all subtrees, for which isText does not hold
+--
+-- example: @ processChildren (none \`when\` isCmt) @ removes all children, for which isCmt holds
+
+processChildren::Treet=>a(tb)(tb)->a(tb)(tb)
+processChildrenf=arrT.getNode
+&&&
+listA(arrLT.getChildren>>>f)-- new children, deterministic filter: single element result
+>>>
+arr2T.mkTree
+
+-- | similar to processChildren, but the new children are computed by processing
+-- the whole input tree
+--
+-- example: @ replaceChildren (deep isText) @ selects all subtrees for which isText holds
+-- and substitutes the children component of the root node with this list
+
+replaceChildren::Treet=>a(tb)(tb)->a(tb)(tb)
+replaceChildrenf=arrT.getNode
+&&&
+listAf-- compute new children
+>>>
+arr2T.mkTree
+
+-- |
+-- pronounced \"slash\", meaning g inside f
+--
+-- defined as @ f \/> g = f >>> getChildren >>> g @
+--
+-- example: @ hasName \"html\" \/> hasName \"body\" \/> hasName \"h1\" @
+--
+-- This expression selects
+-- all \"h1\" elements in the \"body\" element of an \"html\" element, an expression, that
+-- corresponds 1-1 to the XPath selection path \"html\/body\/h1\"
+
+(/>)::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
+f/>g=f>>>getChildren>>>g
--- | recursively searches a whole tree for subtrees, for which a predicate holds.
--- The search is performed top down. When a tree is found, this becomes an element of the result
--- list. The tree found is not further examined for any subtress, for which the predicate also could hold.
--- See 'multi' for this kind of search.
---
--- example: @ deep isHtmlTable @ selects all top level table elements in a document
--- (with an appropriate definition for isHtmlTable) but no tables occuring within a table cell.
-
-deep::Treet=>a(tb)(tb)->a(tb)(tb)
-deepf=f-- success when applying f
-`orElse`
-(getChildren>>>deepf)-- seach children
-
-
--- | recursively searches a whole tree for subrees, for which a predicate holds.
--- The search is performed bottom up.
---
--- example: @ deepest isHtmlTable @ selects all innermost table elements in a document
--- but no table elements containing tables. See 'deep' and 'multi' for other search strategies.
-
-deepest::Treet=>a(tb)(tb)->a(tb)(tb)
-deepestf=(getChildren>>>deepestf)-- seach children
-`orElse`
-f-- no success: apply f to root
-
-
--- | recursively searches a whole tree for subtrees, for which a predicate holds.
--- The search is performed top down. All nodes of the tree are searched, even within the
--- subtrees of trees for which the predicate holds.
---
--- example: @ multy isHtmlTable @ selects all table elements, even nested ones.
-
-multi::Treet=>a(tb)c->a(tb)c
-multif=f-- combine result for root
-<+>
-(getChildren>>>multif)-- with result for all descendants
-
--- | recursively transforms a whole tree by applying an arrow to all subtrees,
--- this is done bottom up depth first, leaves first, root as last tree
+
+-- |
+-- pronounced \"outside\" meaning f containing g
+--
+-- defined as @ f \<\/ g = f \`containing\` (getChildren >>> g) @
+
+(</)::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
+f</g=f`containing`(getChildren>>>g)
+
+
+-- | recursively searches a whole tree for subtrees, for which a predicate holds.
+-- The search is performed top down. When a tree is found, this becomes an element of the result
+-- list. The tree found is not further examined for any subtress, for which the predicate also could hold.
+-- See 'multi' for this kind of search.
+--
+-- example: @ deep isHtmlTable @ selects all top level table elements in a document
+-- (with an appropriate definition for isHtmlTable) but no tables occuring within a table cell.
+
+deep::Treet=>a(tb)(tb)->a(tb)(tb)
+deepf=f-- success when applying f
+`orElse`
+(getChildren>>>deepf)-- seach children
+
+
+-- | recursively searches a whole tree for subrees, for which a predicate holds.
+-- The search is performed bottom up.
+--
+-- example: @ deepest isHtmlTable @ selects all innermost table elements in a document
+-- but no table elements containing tables. See 'deep' and 'multi' for other search strategies.
+
+deepest::Treet=>a(tb)(tb)->a(tb)(tb)
+deepestf=(getChildren>>>deepestf)-- seach children
+`orElse`
+f-- no success: apply f to root
+
+
+-- | recursively searches a whole tree for subtrees, for which a predicate holds.
+-- The search is performed top down. All nodes of the tree are searched, even within the
+-- subtrees of trees for which the predicate holds.--
--- example: @ processBottomUp (getChildren \`when\` isHtmlFont) @ removes all font tags in a HTML document, even nested ones
--- (with an appropriate definition of isHtmlFont)
-
-processBottomUp::Treet=>a(tb)(tb)->a(tb)(tb)
-processBottomUpf=processChildren(processBottomUpf)-- process all descendants first
->>>
-f-- then process root
-
--- | similar to 'processBottomUp', but recursively transforms a whole tree by applying an arrow to all subtrees
--- with a top down depth first traversal strategie. In many cases 'processBottomUp' and 'processTopDown'
--- give same results.
-
-processTopDown::Treet=>a(tb)(tb)->a(tb)(tb)
-processTopDownf=f-- first process root
->>>
-processChildren(processTopDownf)-- then process all descendants of new root
-
+-- example: @ multy isHtmlTable @ selects all table elements, even nested ones.
+
+multi::Treet=>a(tb)c->a(tb)c
+multif=f-- combine result for root
+<+>
+(getChildren>>>multif)-- with result for all descendants
+
+-- | recursively transforms a whole tree by applying an arrow to all subtrees,
+-- this is done bottom up depth first, leaves first, root as last tree
+--
+-- example: @ processBottomUp (getChildren \`when\` isHtmlFont) @ removes all font tags in a HTML document, even nested ones
+-- (with an appropriate definition of isHtmlFont)
+
+processBottomUp::Treet=>a(tb)(tb)->a(tb)(tb)
+processBottomUpf=processChildren(processBottomUpf)-- process all descendants first
+>>>
+f-- then process root
--- | recursively transforms a whole tree by applying an arrow to all subtrees,
--- but transformation stops when a predicte does not hold for a subtree,
--- leaves are transformed first
+-- | similar to 'processBottomUp', but recursively transforms a whole tree by applying an arrow to all subtrees
+-- with a top down depth first traversal strategie. In many cases 'processBottomUp' and 'processTopDown'
+-- give same results.
-processBottomUpWhenNot
-::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
-processBottomUpWhenNotfp
-=(processChildren(processBottomUpWhenNotfp)
->>>
-f
-)`whenNot`p
-
--- | recursively transforms a whole tree by applying an arrow to all subtrees,
--- but transformation stops when a tree is successfully transformed.
--- the transformation is done top down
---
--- example: @ processTopDownUntil (isHtmlTable \`guards\` tranformTable) @
--- transforms all top level table elements into something else, but inner tables remain unchanged
-
-processTopDownUntil::Treet=>a(tb)(tb)->a(tb)(tb)
-processTopDownUntilf
-=f
-`orElse`
-processChildren(processTopDownUntilf)
-
--- | computes a list of trees by applying an arrow to the input
--- and inserts this list in front of index i in the list of children
---
--- example: @ insertChildrenAt 0 (deep isCmt) @ selects all subtrees for which isCmt holds
--- and copies theses in front of the existing children
-
-insertChildrenAt::Treet=>Int->a(tb)(tb)->a(tb)(tb)
-insertChildrenAtif
-=listAf&&&this>>>arr2insertAt
-where
-insertAtnewcs
-=T.changeChildren(\cs->let
-(cs1,cs2)=splitAtics
-in
-cs1++newcs++cs2
-)
-
--- | similar to 'insertChildrenAt', but the insertion position is searched with a predicate
-
-insertChildrenAfter::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
-insertChildrenAfterpf
-=replaceChildren
-(((listAgetChildren
->>>
-spanAp
-)
-&&&
-listAf
-)
->>>arr2L(\(xs1,xs2)xs->xs1++xs++xs2)
-)
-
--- | an arrow for inserting a whole subtree with some holes in it (a template)
--- into a document. The holes can be filled with contents from the input.
---
--- Example
---
--- > insertTreeTemplateTest :: ArrowXml a => a b XmlTree
--- > insertTreeTemplateTest
--- > = doc
--- > >>>
--- > insertTemplate template pattern
--- > where
--- > doc -- the input data
--- > = constA "<x><y>The Title</y><z>The content</z></x>"
--- > >>> xread
--- > template -- the output template with 2 holes: xxx and yyy
--- > = constA "<html><head><title>xxx</title></head><body><h1>yyy</h1></body></html>"
--- > >>> xread
--- > pattern
--- > = [ hasText (== "xxx") -- fill the xxx hole with the input contents from element "x/y"
--- > :-> ( getChildren >>> hasName "y" >>> deep isText )
--- >
--- > , hasText (== "yyy") -- fill the yyy hole with the input contents from element "x/z"
--- > :-> ( getChildren >>> hasName "z" >>> getChildren )
--- > ]
---
--- computes the XML tree for the following document
---
--- > "<html><head><title>The Title</title></head><body><h1>The content</h1></body></html>"
-
-insertTreeTemplate::Treet=>
-a(tb)(tb)->-- the the template
-[IfThen(a(tb)c)(a(tb)(tb))]->-- the list of nodes in the template to be substituted
-a(tb)(tb)
-insertTreeTemplatetemplatechoices
-=insertTree$<this
-where
-insertTreet
-=template-- swap input and template
->>>
-processTemplate
-where
-processTemplate
-=choiceAchoices'-- check whether node is a "hole" within the template
-`orElse`
-processChildrenprocessTemplate-- else descent into template tree
-choices'
-=mapfeedTreechoices-- modify choices, such that the input is feed into the action arrows
-feedTree(cond:->action)
-=cond:->(constAt>>>action)-- the real input becomes the input at the holes
+processTopDown::Treet=>a(tb)(tb)->a(tb)(tb)
+processTopDownf=f-- first process root
+>>>
+processChildren(processTopDownf)-- then process all descendants of new root
+
+
+-- | recursively transforms a whole tree by applying an arrow to all subtrees,
+-- but transformation stops when a predicte does not hold for a subtree,
+-- leaves are transformed first
+
+processBottomUpWhenNot
+::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
+processBottomUpWhenNotfp
+=(processChildren(processBottomUpWhenNotfp)
+>>>
+f
+)`whenNot`p
+
+-- | recursively transforms a whole tree by applying an arrow to all subtrees,
+-- but transformation stops when a tree is successfully transformed.
+-- the transformation is done top down
+--
+-- example: @ processTopDownUntil (isHtmlTable \`guards\` tranformTable) @
+-- transforms all top level table elements into something else, but inner tables remain unchanged
+
+processTopDownUntil::Treet=>a(tb)(tb)->a(tb)(tb)
+processTopDownUntilf
+=f
+`orElse`
+processChildren(processTopDownUntilf)
+
+-- | computes a list of trees by applying an arrow to the input
+-- and inserts this list in front of index i in the list of children
+--
+-- example: @ insertChildrenAt 0 (deep isCmt) @ selects all subtrees for which isCmt holds
+-- and copies theses in front of the existing children
+
+insertChildrenAt::Treet=>Int->a(tb)(tb)->a(tb)(tb)
+insertChildrenAtif
+=listAf&&&this>>>arr2insertAt
+where
+insertAtnewcs
+=T.changeChildren(\cs->let
+(cs1,cs2)=splitAtics
+in
+cs1++newcs++cs2
+)
+
+-- | similar to 'insertChildrenAt', but the insertion position is searched with a predicate
+
+insertChildrenAfter::Treet=>a(tb)(tb)->a(tb)(tb)->a(tb)(tb)
+insertChildrenAfterpf
+=replaceChildren
+(((listAgetChildren
+>>>
+spanAp
+)
+&&&
+listAf
+)
+>>>arr2L(\(xs1,xs2)xs->xs1++xs++xs2)
+)
+
+-- | an arrow for inserting a whole subtree with some holes in it (a template)
+-- into a document. The holes can be filled with contents from the input.
+--
+-- Example
+--
+-- > insertTreeTemplateTest :: ArrowXml a => a b XmlTree
+-- > insertTreeTemplateTest
+-- > = doc
+-- > >>>
+-- > insertTemplate template pattern
+-- > where
+-- > doc -- the input data
+-- > = constA "<x><y>The Title</y><z>The content</z></x>"
+-- > >>> xread
+-- > template -- the output template with 2 holes: xxx and yyy
+-- > = constA "<html><head><title>xxx</title></head><body><h1>yyy</h1></body></html>"
+-- > >>> xread
+-- > pattern
+-- > = [ hasText (== "xxx") -- fill the xxx hole with the input contents from element "x/y"
+-- > :-> ( getChildren >>> hasName "y" >>> deep isText )
+-- >
+-- > , hasText (== "yyy") -- fill the yyy hole with the input contents from element "x/z"
+-- > :-> ( getChildren >>> hasName "z" >>> getChildren )
+-- > ]
+--
+-- computes the XML tree for the following document
+--
+-- > "<html><head><title>The Title</title></head><body><h1>The content</h1></body></html>"
+
+insertTreeTemplate::Treet=>
+a(tb)(tb)->-- the the template
+[IfThen(a(tb)c)(a(tb)(tb))]->-- the list of nodes in the template to be substituted
+a(tb)(tb)
+insertTreeTemplatetemplatechoices
+=insertTree$<this
+where
+insertTreet
+=template-- swap input and template
+>>>
+processTemplate
+where
+processTemplate
+=choiceAchoices'-- check whether node is a "hole" within the template
+`orElse`
+processChildrenprocessTemplate-- else descent into template tree
+choices'
+=mapfeedTreechoices-- modify choices, such that the input is feed into the action arrows
+feedTree(cond:->action)
+=cond:->(constAt>>>action)-- the real input becomes the input at the holes
diff --git a/doc/hdoc/src/Control-Monad-MonadStateIO.html b/doc/hdoc/src/Control-Monad-MonadStateIO.html
deleted file mode 100644
--- a/doc/hdoc/src/Control-Monad-MonadStateIO.html
+++ /dev/null
@@ -1,104 +0,0 @@
-
-
-
-
-Haskell Code by HsColour
-
-
-
-
-- |
--- general usefull state monad for a local state and IO
---
--- Version : $Id: MonadStateIO.hs,v 1.1 2004/09/02 19:11:55 hxml Exp $
-
-
-moduleControl.Monad.MonadStateIO
-(moduleControl.Monad.MonadStateIO
-)
-where
-
-importSystem.IO
-
--- ------------------------------------------------------------
-
-newtypeStateIOstateres=STIO{trans::state->IO(res,state)}
-
-instanceMonad(StateIOstate)where
-returnv
-=STIO(\s->return(v,s))
-
-STIOcmd>>=f
-=STIO(\s->
-cmds>>=\(rl,s')->
-(trans.f)rls'
-)
-
--- ------------------------------------------------------------
--- |
--- lift IO command to 'StateIO'
-
-io::IOa->StateIOstatea
-ioiocmd
-=STIO(\s->
-do
-a<-iocmd
-return(a,s)
-)
-
--- ------------------------------------------------------------
-
--- |
--- state inspection command: a \"show\"-like function is applied to the state
--- and the result is written to stderr.
-
-trcState::(state->String)->StateIOstate()
-trcStatefct
-=STIO(\s->
-do
-hPutStrstderr$fcts
-return((),s)
-)
-
--- ------------------------------------------------------------
---
--- state access commands
-
--- |
--- change the state with a given function and return the new state
-
-changeState::(state->state)->StateIOstatestate
-changeStatef
-=STIO(\s->
-lets'=fs
-in
-return(s',s')
-)
-
--- |
--- set the state
-
-setState::state->StateIOstatestate
-setStates
-=changeState(\_->s)
-
--- |
--- read the state
-
-getState::StateIOstatestate
-getState
-=changeStateid
-
--- ------------------------------------------------------------
--- |
--- run a 'StateIO' command with an initial state
-
-run::state->StateIOstateres->IOres
-runinitialState(STIOcmd)
-=do
-(res,_finalState)<-cmdinitialState
-returnres
-
-
--- ------------------------------------------------------------
-
-- ------------------------------------------------------------
-
-{- |
- Module : System.PipeOpen
- Copyright : Copyright (C) 2005 Uwe Schmidt
- License : MIT
-
- Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
- Stability : experimental
- Portability: none portable
- Version : $Id: PipeOpen.hs,v 1.2 2005/09/02 17:09:39 hxml Exp $
-
-pipe open implemented with System.Process functions
-
--}
-
--- ------------------------------------------------------------
-
-moduleSystem.PipeOpen
-(popen)
-where
-
-importIO
-(hGetContents
-,hClose
-)
-
-importSystem.Exit
-(ExitCode(..)
-)
-
-importSystem.Process
-(runInteractiveProcess
-,waitForProcess
-)
-
--- | call an external program with a list of command line arguments
--- and return content of stdout, content of stderr and return code
-
-popen::String->[String]->IO(String,String,Int)
-popenprgargl
-=do
-(inpH,outH,errH,pH)<-runInteractiveProcessprgarglNothingNothing
-hCloseinpH
-res<-hGetContentsoutH
-errs<-hGetContentserrH
-
--- hack: stdout and stderr must be read completely, otherwise waitForProcess blocks
-if(lengthres==0)thenreturn()elsereturn()
-if(lengtherrs==0)thenreturn()elsereturn()
-
-rc<-waitForProcesspH
-return(res
-,errs
-,casercof
-ExitSuccess->0
-ExitFailurei->i
-)
-
--- eof ------------------------------------------------------------
-
-
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-DocumentInput.html b/doc/hdoc/src/Text-XML-HXT-Arrow-DocumentInput.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-DocumentInput.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-DocumentInput.html
@@ -38,337 +38,392 @@
importControl.Arrow.ArrowTreeimportControl.Arrow.ArrowIO
-importText.XML.HXT.DOM.Unicode
-(getDecodingFct
-,guessEncoding
-,normalizeNL
-)
-
-importqualifiedText.XML.HXT.IO.GetFILEasFILE
-importqualifiedText.XML.HXT.IO.GetHTTPNativeasHTTP
-importqualifiedText.XML.HXT.IO.GetHTTPCurlasCURL
-
-importText.XML.HXT.DOM.Interface
-importText.XML.HXT.Arrow.XmlArrow
-importText.XML.HXT.Arrow.XmlIOStateArrow
-
-importText.XML.HXT.Arrow.ParserInterface
-(parseXmlDocEncodingSpec
-,parseXmlEntityEncodingSpec
-,removeEncodingSpec
-)
+importData.Char
+(toLower
+)
+importData.List
+(isPrefixOf
+)
+importData.Maybe
+
+importSystem.FilePath
+(takeExtension)
+
+importText.XML.HXT.DOM.Unicode
+(getDecodingFct
+,guessEncoding
+,normalizeNL
+)
+
+importqualifiedText.XML.HXT.IO.GetFILEasFILE
+importqualifiedText.XML.HXT.IO.GetHTTPLibCurlasLibCURL
-importData.List
-(isPrefixOf
-)
-
-importData.Char
-(toLower
-)
-
-importData.Maybe
-
--- ----------------------------------------------------------
-
-protocolHandlers::AssocListString(IOStateArrowsXmlTreeXmlTree)
-protocolHandlers
-=[("file",getFileContents)
-,("http",getHttpContents)
-,("stdin",getStdinContents)
-]
-
-getProtocolHandler::IOStateArrowsString(IOStateArrowsXmlTreeXmlTree)
-getProtocolHandler
-=arr(\s->lookupDefgetUnsupportedsprotocolHandlers)
-
-getUnsupported::IOStateArrowsXmlTreeXmlTree
-getUnsupported
-=perform(getAttrValuea_source
->>>
-arr(("unsupported protocol in URI "++).show)
->>>
-applyA(arrissueFatal)
-)
->>>
-setDocumentStatusFromSystemState"accessing documents"
-
-getStringContents::IOStateArrowsXmlTreeXmlTree
-getStringContents
-=setCont$<getAttrValuea_source
->>>
-addAttrtransferMessage"OK"
->>>
-addAttrtransferStatus"200"
-where
-setContcontents
-=replaceChildren(txtcontents')
->>>
-addAttrtransferURI(take7contents)-- the "string:" prefix is stored, this is required by setBaseURIFromDoc
->>>
-addAttra_source(show.prefix48$contents')-- a quoted prefix of the content, max 48 chars is taken as source name
-where
-contents'=drop(lengthstringProtocol)contents
-prefixls
-|lengths'>l=take(l-3)s'++"..."
-|otherwise=s'
-where
-s'=take(l+1)s
-
-getFileContents::IOStateArrowsXmlTreeXmlTree
-getFileContents
-=applyA(getAttrValuetransferURI
->>>
-getPathFromURI
->>>
-arrIOFILE.getCont
->>>
-(arraddError-- io error occured
-|||
-arraddTxtContent-- content read
-)
-)
-
-getStdinContents::IOStateArrowsXmlTreeXmlTree
-getStdinContents
-=applyA(arrIO(\_->FILE.getStdinCont)
->>>
-(arraddError-- io error occured
-|||
-arraddTxtContent-- content read
-)
-)
-
-addError::String->IOStateArrowsXmlTreeXmlTree
-addErrore
-=issueFatale
->>>
-setDocumentStatusFromSystemState"accessing documents"
-
-addTxtContent::String->IOStateArrowsXmlTreeXmlTree
-addTxtContentc
-=replaceChildren(txtc)
->>>
-addAttrtransferMessage"OK"
->>>
-addAttrtransferStatus"200"
-
-getHttpContents::IOStateArrowsXmlTreeXmlTree
-getHttpContents
-=getCont$<<<<(getAttrValuetransferURI
-&&&
-getOpta_proxy
-&&&
-getOpta_use_curl
-&&&
-getOpta_options_curl
-)
-where
-getOptopt
-=getAttrValue0opt
-`orElse`
-getParamStringopt
-
-getConturiproxycurlcurlOpt
-=applyA((ifcurl==v_1
-then(traceMsg2("get HTTP via "
-++show("curl "
-++(ifnullproxythen""else"--proxy "++proxy)
-++(ifnullcurlOptthen""else" "++curlOpt)
-++" "++uri
-)
-)
->>>
-arrIO0(CURL.getContcurlOpturiproxy)
-)
-elsearrIO0(HTTP.getConturiproxy)
-)
->>>
-(arraddError
-|||
-arraddContent
-)
-)
-
-addContent::(AssocListStringString,String)->IOStateArrowsXmlTreeXmlTree
-addContent(al,c)
-=replaceChildren(txtc)
->>>
-seqA(map(uncurryaddAttr)al)
-
-getURIContents::IOStateArrowsXmlTreeXmlTree
-getURIContents
-=getContentsFromString
-`orElse`
-getContentsFromDoc
-where
-getContentsFromString
-=(getAttrValuea_source
->>>
-isA(isPrefixOfstringProtocol)
-)
-`guards`
-getStringContents
-
-getContentsFromDoc
-=((addTransferURI$<getBaseURI
->>>
-getCont
-)
-`when`
-(setAbsURI$<(getAttrValuea_source
->>^
-(\src->(ifnullsrcthen"stdin:"elsesrc))-- empty document name -> read from stdin
-)
-)
-)
->>>
-setDocumentStatusFromSystemState"getURIContents"
-
-setAbsURIsrc
-=ifA(constAsrc>>>changeBaseURI)
-this
-(issueFatal("illegal URI : "++showsrc))
+{- not longer needed, libcurl is used
+import qualified Text.XML.HXT.IO.GetHTTPNative as HTTP
+import qualified Text.XML.HXT.IO.GetHTTPCurl as CURL
+-}
+
+importText.XML.HXT.DOM.Interface
+
+importText.XML.HXT.Arrow.XmlArrow
+importText.XML.HXT.Arrow.XmlIOStateArrow
+importText.XML.HXT.Arrow.ParserInterface
+(parseXmlDocEncodingSpec
+,parseXmlEntityEncodingSpec
+,removeEncodingSpec
+)
+
+-- ----------------------------------------------------------
+
+protocolHandlers::AssocListString(IOStateArrowsXmlTreeXmlTree)
+protocolHandlers
+=[("file",getFileContents)
+,("http",getHttpContents)
+,("stdin",getStdinContents)
+]
+
+getProtocolHandler::IOStateArrowsString(IOStateArrowsXmlTreeXmlTree)
+getProtocolHandler
+=arr(\s->lookupDefgetUnsupportedsprotocolHandlers)
+
+getUnsupported::IOStateArrowsXmlTreeXmlTree
+getUnsupported
+=perform(getAttrValuea_source
+>>>
+arr(("unsupported protocol in URI "++).show)
+>>>
+applyA(arrissueFatal)
+)
+>>>
+setDocumentStatusFromSystemState"accessing documents"
+
+getStringContents::IOStateArrowsXmlTreeXmlTree
+getStringContents
+=setCont$<getAttrValuea_source
+>>>
+addAttrtransferMessage"OK"
+>>>
+addAttrtransferStatus"200"
+where
+setContcontents
+=replaceChildren(txtcontents')
+>>>
+addAttrtransferURI(take7contents)-- the "string:" prefix is stored, this is required by setBaseURIFromDoc
+>>>
+addAttra_source(show.prefix48$contents')-- a quoted prefix of the content, max 48 chars is taken as source name
+where
+contents'=drop(lengthstringProtocol)contents
+prefixls
+|lengths'>l=take(l-3)s'++"..."
+|otherwise=s'
+where
+s'=take(l+1)s
+
+getFileContents::IOStateArrowsXmlTreeXmlTree
+getFileContents
+=applyA(getAttrValuetransferURI
+>>>
+getPathFromURI
+>>>
+arrIOFILE.getCont
+>>>
+(arraddError-- io error occured
+|||
+arraddTxtContent-- content read
+)
+)
+>>>
+addMimeType
+
+getStdinContents::IOStateArrowsXmlTreeXmlTree
+getStdinContents
+=applyA(arrIO(\_->FILE.getStdinCont)
+>>>
+(arraddError-- io error occured
+|||
+arraddTxtContent-- content read
+)
+)
+
+addError::String->IOStateArrowsXmlTreeXmlTree
+addErrore
+=issueFatale
+>>>
+setDocumentStatusFromSystemState"accessing documents"
+
+addMimeType::IOStateArrowsXmlTreeXmlTree
+addMimeType
+=addMime$<(getAttrValuetransferURI
+>>>
+(uriToMime$<getSysParamxio_mimeTypes)
+)
+where
+addMimemt
+=addAttrtransferMimeTypemt
+uriToMimemtt
+=arr$(\uri->extensionToMimeType(drop1.takeExtension$uri)mtt)
+
+addTxtContent::String->IOStateArrowsXmlTreeXmlTree
+addTxtContentc
+=replaceChildren(txtc)
+>>>
+addAttrtransferMessage"OK"
+>>>
+addAttrtransferStatus"200"
+
+getHttpContents::IOStateArrowsXmlTreeXmlTree
+getHttpContents
+=getCont$<<(getAttrValuetransferURI
+&&&
+((getAttrlAsAssoc-- get all attributes of root node
+&&&
+getAllParamsString-- get all system params
+)
+>>^uncurryaddEntries-- merge them, attributes overwrite system params
+)
+)
+where
+getAttrlAsAssoc-- get the attributes as assoc list
+=listA(getAttrl
+>>>(getName
+&&&
+xshowgetChildren
+)
+)
+
+getConturioptions
+=applyA((traceMsg2("get HTTP via libcurl, uri="++showuri++" options="++showoptions)
+>>>
+arrIO0(LibCURL.getContoptionsuri)
+)
+>>>
+(arraddError
+|||
+arraddContent
+)
+)
+
+{- old stuff
+ = applyA ( ( if curl == v_1
+ then ( traceMsg 2 ( "get HTTP via "
+ ++ show ( "curl "
+ ++ (if null proxy then "" else "--proxy " ++ proxy)
+ ++ (if null curlOpt then "" else " " ++ curlOpt)
+ ++ " " ++ uri
+ )
+ )
+ >>>
+ arrIO0 ( CURL.getCont curlOpt uri proxy )
+ )
+ else arrIO0 ( HTTP.getCont uri proxy )
+ )
+ >>>
+ ( arr addError
+ |||
+ arr addContent
+ )
+ )
+ where
+ proxy = lookup1 a_proxy options
+ curl = lookup1 a_use_curl options
+ curlOpt = lookup1 a_options_curl options
+-}
-addTransferURIuri
-=addAttrtransferURIuri
-
-getCont
-=applyA(getBaseURI-- compute the handler and call it
->>>
-traceString2(("getURIContents: reading"++).show)
->>>
-getSchemeFromURI
->>>
-getProtocolHandler
-)
-`orElse`
-this-- don't change tree, when no handler can be found
-
-setBaseURIFromDoc::IOStateArrowsXmlTreeXmlTree
-setBaseURIFromDoc
-=perform(getAttrValuetransferURI
->>>
-isA(isPrefixOfstringProtocol)-- do not change base URI when reading from a string
->>>
-setBaseURI
-)
-
-{- |
- Read the content of a document.
-
- This routine is usually called from 'Text.XML.HXT.Arrow.ProcessDocument.getDocumentContents'.
-
- The input must be a root node (constructed with 'Text.XML.HXT.Arrow.XmlArrow.root'), usually without children.
- The attribute list contains all input parameters, e.g. URI or source file name, encoding preferences, ...
- If the source name is empty, the input is read from standard input.
-
- The source is transformed into an absolute URI. If the source is a relative URI, or a file name,
- it is expanded into an absolut URI with respect to the current base URI.
- The default base URI is of protocol \"file\" and points to the current working directory.
-
- The currently supported protocols are \"http\", \"file\", \"stdin\" and \"string\".
-
- The latter two are internal protocols. An uri of the form \"stdin:\" stands for the content of
- the standard input stream.
-
- \"string:some text\" means, that \"some text\" is taken as input.
- This internal protocol is used for reading from normal 'String' values.
-
--}
-
-getXmlContents::IOStateArrowsXmlTreeXmlTree
-getXmlContents
-=getXmlContents'parseXmlDocEncodingSpec
->>>
-setBaseURIFromDoc
-
-getXmlEntityContents::IOStateArrowsXmlTreeXmlTree
-getXmlEntityContents
-=getXmlContents'parseXmlEntityEncodingSpec
->>>
-processChildrenremoveEncodingSpec
->>>
-setBaseURIFromDoc
-
-getXmlContents'::IOStateArrowsXmlTreeXmlTree->IOStateArrowsXmlTreeXmlTree
-getXmlContents'parseEncodingSpec
-=(getURIContents
->>>
-parseEncodingSpec
->>>
-filterErrorMsg
->>>
-decodeDocument
->>>
-perform(getAttrValuetransferURI
->>>
-traceString1(("getXmlContents: content read and decoded for "++).show)
-)
->>>
-traceTree
->>>
-traceSource
-)
-`when`
-isRoot
-
--- ------------------------------------------------------------
+addContent::(AssocListStringString,String)->IOStateArrowsXmlTreeXmlTree
+addContent(al,c)
+=replaceChildren(txtc)
+>>>
+seqA(map(uncurryaddAttr)al)
+
+getURIContents::IOStateArrowsXmlTreeXmlTree
+getURIContents
+=getContentsFromString
+`orElse`
+getContentsFromDoc
+where
+getContentsFromString
+=(getAttrValuea_source
+>>>
+isA(isPrefixOfstringProtocol)
+)
+`guards`
+getStringContents
+
+getContentsFromDoc
+=((addTransferURI$<getBaseURI
+>>>
+getCont
+)
+`when`
+(setAbsURI$<(getAttrValuea_source
+>>^
+(\src->(ifnullsrcthen"stdin:"elsesrc))-- empty document name -> read from stdin
+)
+)
+)
+>>>
+setDocumentStatusFromSystemState"getURIContents"
+
+setAbsURIsrc
+=ifA(constAsrc>>>changeBaseURI)
+this
+(issueFatal("illegal URI : "++showsrc))
+
+addTransferURIuri
+=addAttrtransferURIuri
+
+getCont
+=applyA(getBaseURI-- compute the handler and call it
+>>>
+traceString2(("getURIContents: reading "++).show)
+>>>
+getSchemeFromURI
+>>>
+getProtocolHandler
+)
+`orElse`
+this-- don't change tree, when no handler can be found
+
+setBaseURIFromDoc::IOStateArrowsXmlTreeXmlTree
+setBaseURIFromDoc
+=perform(getAttrValuetransferURI
+>>>
+isA(isPrefixOfstringProtocol)-- do not change base URI when reading from a string
+>>>
+setBaseURI
+)
+
+{- |
+ Read the content of a document.
+
+ This routine is usually called from 'Text.XML.HXT.Arrow.ProcessDocument.getDocumentContents'.
+
+ The input must be a root node (constructed with 'Text.XML.HXT.Arrow.XmlArrow.root'), usually without children.
+ The attribute list contains all input parameters, e.g. URI or source file name, encoding preferences, ...
+ If the source name is empty, the input is read from standard input.
+
+ The source is transformed into an absolute URI. If the source is a relative URI, or a file name,
+ it is expanded into an absolut URI with respect to the current base URI.
+ The default base URI is of protocol \"file\" and points to the current working directory.
+
+ The currently supported protocols are \"http\", \"file\", \"stdin\" and \"string\".
+
+ The latter two are internal protocols. An uri of the form \"stdin:\" stands for the content of
+ the standard input stream.
+
+ \"string:some text\" means, that \"some text\" is taken as input.
+ This internal protocol is used for reading from normal 'String' values.
-getEncoding::IOStateArrowsXmlTreeString
-getEncoding
-=catA[xshowgetChildren-- 1. guess: guess encoding by looking at the first few bytes
->>>
-arrguessEncoding
-,getAttrValuetransferEncoding-- 2. guess: take the transfer encoding
-,getAttrValuea_encoding-- 4. guess: take encoding parameter in root node
-,getParamStringa_encoding-- 5. guess: take encoding parameter in global state
-,constAutf8-- default : utf8
-]
->.(head.filter(not.null))-- make the filter deterministic: take 1. entry from list of guesses
-
-
-decodeDocument::IOStateArrowsXmlTreeXmlTree
-decodeDocument
-=(decodeArr$<getEncoding)
-`when`
-(isRoot>>>isXmlOrHtmlDoc)
-where
-isXmlOrHtmlDoc
-=(getAttrValuetransferMimeType>>^maptoLower)
->>>
-isA(\t->nullt||isXmlMimeTypet||isHtmlMimeTypet)
-
-decodeArr::String->IOStateArrowsXmlTreeXmlTree
-decodeArrenc
-=maybenotFoundfound.getDecodingFct$enc
-where
-founddf
-=traceMsg2("decodeDocument: encoding is "++showenc)
->>>
-processChildren(decodeTextdf)
->>>
-addAttrtransferEncodingenc
-
-notFound
-=issueFatal("encoding scheme not supported: "++showenc)
->>>
-setDocumentStatusFromSystemState"decoding document"
-
-decodeTextdf
-=getText
->>>arrdf-- result is (string, [errMsg])
->>>(((normalizeNL.fst)^>>mkText)-- take string, normalize newline and build text node
-<+>
-(arrLsnd-- take the error messages
->>>
-arr((enc++).(" encoding error"++))-- prefix with enc error
->>>
-applyA(arrissueErr)-- build issueErr arrow and apply
->>>
-none-- neccessary for type match with <+>
-)
-)
-
--- ------------------------------------------------------------
+-}
+
+getXmlContents::IOStateArrowsXmlTreeXmlTree
+getXmlContents
+=getXmlContents'parseXmlDocEncodingSpec
+>>>
+setBaseURIFromDoc
+
+getXmlEntityContents::IOStateArrowsXmlTreeXmlTree
+getXmlEntityContents
+=getXmlContents'parseXmlEntityEncodingSpec
+>>>
+processChildrenremoveEncodingSpec
+>>>
+setBaseURIFromDoc
+
+getXmlContents'::IOStateArrowsXmlTreeXmlTree->IOStateArrowsXmlTreeXmlTree
+getXmlContents'parseEncodingSpec
+=(getURIContents
+>>>
+((parseEncodingSpec
+>>>
+filterErrorMsg
+>>>
+decodeDocument
+)
+`when`
+isXmlHtml
+)
+>>>
+perform(getAttrValuetransferURI
+>>>
+traceString1(("getXmlContents: content read and decoded for "++).show)
+)
+>>>
+traceTree
+>>>
+traceSource
+)
+`when`
+isRoot
+where
+isXmlHtml
+=getAttrValuetransferMimeType
+>>>
+arr(\mt->isHtmlMimeTypemt||isXmlMimeTypemt)
+
+-- ------------------------------------------------------------
+
+getEncoding::IOStateArrowsXmlTreeString
+getEncoding
+=catA[xshowgetChildren-- 1. guess: guess encoding by looking at the first few bytes
+>>>
+arrguessEncoding
+,getAttrValuetransferEncoding-- 2. guess: take the transfer encoding
+,getAttrValuea_encoding-- 4. guess: take encoding parameter in root node
+,getParamStringa_encoding-- 5. guess: take encoding parameter in global state
+,constAutf8-- default : utf8
+]
+>.(head.filter(not.null))-- make the filter deterministic: take 1. entry from list of guesses
+
+
+decodeDocument::IOStateArrowsXmlTreeXmlTree
+decodeDocument
+=(decodeArr$<getEncoding)
+`when`
+(isRoot>>>isXmlOrHtmlDoc)
+where
+isXmlOrHtmlDoc
+=(getAttrValuetransferMimeType>>^maptoLower)
+>>>
+isA(\t->nullt||isXmlMimeTypet||isHtmlMimeTypet)
+
+decodeArr::String->IOStateArrowsXmlTreeXmlTree
+decodeArrenc
+=maybenotFoundfound.getDecodingFct$enc
+where
+founddf
+=traceMsg2("decodeDocument: encoding is "++showenc)
+>>>
+(decodeTextdf$<getAttrValuea_ignore_encoding_errors)
+>>>
+addAttrtransferEncodingenc
+
+notFound
+=issueFatal("encoding scheme not supported: "++showenc)
+>>>
+setDocumentStatusFromSystemState"decoding document"
+
+decodeTextdfignoreErrs
+=processChildren
+(getText-- get the document content
+>>>arrdf-- decode the text, result is (string, [errMsg])
+>>>(((normalizeNL.fst)^>>mkText)-- take decoded string, normalize newline and build text node
+<+>
+(ifisTrueValueignoreErrs
+thennone-- encoding errors are ignored
+else
+(arrLsnd-- take the error messages
+>>>
+arr((enc++).(" encoding error"++))-- prefix with enc error
+>>>
+applyA(arrissueErr)-- build issueErr arrow and apply
+>>>
+none-- neccessary for type match with <+>
+)
+)
+)
+)
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-Edit.html b/doc/hdoc/src/Text-XML-HXT-Arrow-Edit.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-Edit.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-Edit.html
@@ -745,16 +745,17 @@
addDoctypeDeclrootElempublicsystem=fromLA$replaceChildren
-(mkDTDDoctype[(a_name,rootElem)
-,(k_public,public)
-,(k_system,system)
-]none
-<+>
-txt"\n"
-<+>
-getChildren
-)
-
--- ------------------------------------------------------------
+(mkDTDDoctype((ifnullpublicthenidelse((k_public,public):))
+.
+(ifnullsystemthenidelse((k_system,system):))
+$[(a_name,rootElem)]
+)none
+<+>
+txt"\n"
+<+>
+getChildren
+)
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle-Xml.html b/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle-Xml.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle-Xml.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle-Xml.html
@@ -48,513 +48,642 @@
whereimportData.Maybe
-
-importText.XML.HXT.DOM.Interface
-importqualifiedText.XML.HXT.DOM.XmlNodeasXN
-
-importControl.Arrow.ListArrows
-importText.XML.HXT.Arrow.XmlArrow
-importText.XML.HXT.Arrow.Pickle.Schema
-
--- ------------------------------------------------------------
-
-dataSt=St{attributes::[XmlTree]
-,contents::[XmlTree]
-}
-
-dataPUa=PU{appPickle::(a,St)->St
-,appUnPickle::St->(Maybea,St)
-,theSchema::Schema
-}
-
-emptySt::St
-emptySt=St{attributes=[]
-,contents=[]
-}
-
-addAtt::XmlTree->St->St
-addAttxs=s{attributes=x:attributess}
-
-addCont::XmlTree->St->St
-addContxs=s{contents=x:contentss}
-
-dropCont::St->St
-dropConts=s{contents=drop1(contentss)}
-
-getAtt::String->St->MaybeXmlTree
-getAttnames
-=listToMaybe$
-runLA(arrLattributes
->>>
-isAttr>>>hasNamename
-)s
-
-getCont::St->MaybeXmlTree
-getConts=listToMaybe.contents$s
-
--- ------------------------------------------------------------
-
--- | conversion of an arbitrary value into an XML document tree.
---
--- The pickler, first parameter, controls the conversion process.
--- Result is a complete document tree including a root node
-
-pickleDoc::PUa->a->XmlTree
-pickleDocpv
-=XN.mkRoot(attributesst)(contentsst)
-where
-st=appPicklep(v,emptySt)
-
--- | Conversion of an XML document tree into an arbitrary data type
---
--- The inverse of 'pickleDoc'.
--- This law should hold for all picklers: @ unpickle px . pickle px $ v == Just v @.
--- Not every possible combination of picklers make sense.
--- For reconverting a value from an XML tree, is becomes neccessary,
--- to introduce \"enough\" markup for unpickling the value
-
-unpickleDoc::PUa->XmlTree->Maybea
-unpickleDocpt
-|XN.isRoott
-=fst.appUnPicklep$St{attributes=fromJust.XN.getAttrl$t
-,contents=XN.getChildrent
-}
-|otherwise
-=Nothing
-
--- ------------------------------------------------------------
-
--- | The zero pickler
---
--- Encodes nothing, fails always during unpickling
-
-xpZero::PUa
-xpZero=PU{appPickle=snd
-,appUnPickle=\s->(Nothing,s)
-,theSchema=scNull
-}
-
--- unit pickler
-
-xpUnit::PU()
-xpUnit=xpLift()
-
--- | Lift a value to a pickler
---
--- When pickling, nothing is encoded, when unpickling, the given value is inserted.
--- This pickler always succeeds.
-
-xpLift::a->PUa
-xpLiftx=PU{appPickle=snd
-,appUnPickle=\s->(Justx,s)
-,theSchema=scEmpty
-}
-
--- | Lift a Maybe value to a pickler.
---
--- @Nothing@ is mapped to the zero pickler, @Just x@ is pickled with @xpLift x@.
-
-xpLiftMaybe::Maybea->PUa
-xpLiftMaybev=(xpLiftMaybe'v){theSchema=scOptionscEmpty}
-where
-xpLiftMaybe'Nothing=xpZero
-xpLiftMaybe'(Justx)=xpLiftx
-
-
--- | pickle\/unpickle combinator for sequence and choice.
---
--- When the first unpickler fails,
--- the second one is taken, else the third one configured with the result from the first
--- is taken. This pickler is a generalisation for 'xpSeq' and 'xpChoice' .
---
--- The schema must be attached later, e.g. in xpPair or other higher level combinators
-
-xpCondSeq::PUb->(b->a)->PUa->(a->PUb)->PUb
-xpCondSeqpdfpak
-=PU{appPickle=(\(b,s)->
-let
-a=fb
-pb=ka
-in
-appPicklepa(a,(appPicklepb(b,s)))
-)
-,appUnPickle=(\s->
-let
-(a,s')=appUnPicklepas
-in
-caseaof
-Nothing->appUnPicklepds
-Justa'->appUnPickle(ka')s'
-)
-,theSchema=undefined
-}
-
-
--- | Combine two picklers sequentially.
---
--- If the first fails during
--- unpickling, the whole unpickler fails
-
-xpSeq::(b->a)->PUa->(a->PUb)->PUb
-xpSeq=xpCondSeqxpZero
-
-
--- | combine tow picklers with a choice
---
--- Run two picklers in sequence like with xpSeq.
--- When during unpickling the first one fails,
--- an alternative pickler (first argument) is applied.
--- This pickler only is used as combinator for unpickling.
-
-xpChoice::PUb->PUa->(a->PUb)->PUb
-xpChoicepb=xpCondSeqpbundefined
-
-
--- | map value into another domain and apply pickler there
---
--- One of the most often used picklers.
-
-xpWrap::(a->b,b->a)->PUa->PUb
-xpWrap(i,j)pa=(xpSeqjpa(xpLift.i)){theSchema=theSchemapa}
-
--- | like 'xpWrap', but if the inverse mapping is undefined, the unpickler fails
---
--- Map a value into another domain. If the inverse mapping is
--- undefined (Nothing), the unpickler fails
-
-xpWrapMaybe::(a->Maybeb,b->a)->PUa->PUb
-xpWrapMaybe(i,j)pa=(xpSeqjpa(xpLiftMaybe.i)){theSchema=theSchemapa}
-
--- | pickle a pair of values sequentially
---
--- Used for pairs or together with wrap for pickling
--- algebraic data types with two components
-
-xpPair::PUa->PUb->PU(a,b)
-xpPairpapb
-=(xpSeqfstpa(\a->
-xpSeqsndpb(\b->
-xpLift(a,b)))
-){theSchema=scSeq(theSchemapa)(theSchemapb)}
-
--- | Like 'xpPair' but for triples
-
-xpTriple::PUa->PUb->PUc->PU(a,b,c)
-xpTriplepapbpc
-=xpWrap(toTriple,fromTriple)(xpPairpa(xpPairpbpc))
-where
-toTriple~(a,~(b,c))=(a,b,c)
-fromTriple~(a,b,c)=(a,(b,c))
-
--- | Like 'xpPair' and 'xpTriple' but for 4-tuples
-
-xp4Tuple::PUa->PUb->PUc->PUd->PU(a,b,c,d)
-xp4Tuplepapbpcpd
-=xpWrap(toQuad,fromQuad)(xpPairpa(xpPairpb(xpPairpcpd)))
-where
-toQuad~(a,~(b,~(c,d)))=(a,b,c,d)
-fromQuad~(a,b,c,d)=(a,(b,(c,d)))
-
--- | Like 'xpPair' and 'xpTriple' but for 5-tuples
-
-xp5Tuple::PUa->PUb->PUc->PUd->PUe->PU(a,b,c,d,e)
-xp5Tuplepapbpcpdpe
-=xpWrap(toQuint,fromQuint)(xpPairpa(xpPairpb(xpPairpc(xpPairpdpe))))
-where
-toQuint~(a,~(b,~(c,~(d,e))))=(a,b,c,d,e)
-fromQuint~(a,b,c,d,e)=(a,(b,(c,(d,e))))
-
--- | Like 'xpPair' and 'xpTriple' but for 6-tuples
-
-xp6Tuple::PUa->PUb->PUc->PUd->PUe->PUf->PU(a,b,c,d,e,f)
-xp6Tuplepapbpcpdpepf
-=xpWrap(toSix,fromSix)(xpPairpa(xpPairpb(xpPairpc(xpPairpd(xpPairpepf)))))
-where
-toSix~(a,~(b,~(c,~(d,~(e,f)))))=(a,b,c,d,e,f)
-fromSix~(a,b,c,d,e,f)=(a,(b,(c,(d,(e,f)))))
-
--- | Pickle a string into an XML text node
---
--- One of the most often used primitive picklers. Attention:
--- For pickling empty strings use 'xpText0'. If the text has a more
--- specific datatype than xsd:string, use 'xpTextDT'
-
-xpText::PUString
-xpText=xpTextDTscString1
-
--- | Pickle a string into an XML text node
---
--- Text pickler with a description of the structure of the text
--- by a schema. A schema for a data type can be defined by 'Text.XML.HXT.Arrow.Pickle.Schema.scDT'.
--- In 'Text.XML.HXT.Arrow.Pickle.Schema' there are some more functions for creating
--- simple datatype descriptions.
-
-xpTextDT::Schema->PUString
-xpTextDTsc
-=PU{appPickle=\(s,st)->addCont(XN.mkTexts)st
-,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleStringst)
-,theSchema=sc
-}
-where
-unpickleStringst
-=do
-t<-getContst
-s<-XN.getTextt
-return(Justs,dropContst)
-
--- | Pickle a possibly empty string into an XML node.
---
--- Must be used in all places, where empty strings are legal values.
--- If the content of an element can be an empty string, this string disapears
--- during storing the DOM into a document and reparse the document.
--- So the empty text node becomes nothing, and the pickler must deliver an empty string,
--- if there is no text node in the document.
-
-xpText0::PUString
-xpText0=xpText0DTscString1
-
--- | Pickle a possibly empty string with a datatype description into an XML node.
---
--- Like 'xpText0' but with extra Parameter for datatype description as in 'xpTextDT'.
-
-xpText0DT::Schema->PUString
-xpText0DTsc
-=xpWrap(fromMaybe"",emptyToNothing)$xpOption$xpTextDTsc
-where
-emptyToNothing""=Nothing
-emptyToNothingx=Justx
-
--- | Pickle an arbitrary value by applyling show during pickling
--- and read during unpickling.
---
--- Real pickling is then done with 'xpText'.
--- One of the most often used pimitive picklers. Applicable for all
--- types which are instances of @Read@ and @Show@
-
-xpPrim::(Reada,Showa)=>PUa
-xpPrim
-=xpWrapMaybe(readMaybe,show)xpText
-where
-readMaybe::Reada=>String->Maybea
-readMaybestr
-=val(readsstr)
-where
-val[(x,"")]=Justx
-val_=Nothing
-
--- | Pickle an XmlTree by just adding it
---
--- Usefull for components of type XmlTree in other data structures
-
-xpTree::PUXmlTree
-xpTree=PU{appPickle=\(s,st)->addContsst
-,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleTreest)
-,theSchema=Any
-}
-where
-unpickleTreest
-=do
-t<-getContst
-return(Justt,dropContst)
-
--- | Encoding of optional data by ignoring the Nothing case during pickling
--- and relying on failure during unpickling to recompute the Nothing case
---
--- The default pickler for Maybe types
-
-xpOption::PUa->PU(Maybea)
-xpOptionpa
-=PU{appPickle=(\(a,st)->
-caseaof
-Nothing->st
-Justx->appPicklepa(x,st)
-)
-
-,appUnPickle=appUnPickle$
-xpChoice(xpLiftNothing)pa(xpLift.Just)
-
-,theSchema=scOption(theSchemapa)
-}
-
--- | Encoding of list values by pickling all list elements sequentially.
---
--- Unpickler relies on failure for detecting the end of the list.
--- The standard pickler for lists. Can also be used in combination with 'xpWrap'
--- for constructing set and map picklers
-
-xpList::PUa->PU[a]
-xpListpa
-=PU{appPickle=(\(a,st)->
-caseaof
-[]->st
-_:_->appPicklepc(a,st)
-)
-,appUnPickle=appUnPickle$
-xpChoice(xpLift[])pa
-(\x->xpSeqid(xpListpa)(\xs->xpLift(x:xs)))
-
-,theSchema=scList(theSchemapa)
-}
-where
-pc=xpSeqheadpa(\x->
-xpSeqtail(xpListpa)(\xs->
-xpLift(x:xs)))
-
--- | Encoding of a none empty list of values
---
--- Attention: when calling this pickler with an empty list,
--- an internal error \"head of empty list is raised\".
-
-xpList1::PUa->PU[a]
-xpList1pa
-=(xpWrap(\(x,xs)->x:xs
-,\(x:xs)->(x,xs)
-)$
-xpPairpa(xpListpa)
-){theSchema=scList1(theSchemapa)}
-
--- | Pickler for sum data types.
---
--- Every constructor is mapped to an index into the list of picklers.
--- The index is used only during pickling, not during unpickling, there the 1. match is taken
-
-xpAlt::(a->Int)->[PUa]->PUa
-xpAlttagps
-=PU{appPickle=(\(a,st)->
-let
-pa=ps!!(taga)
-in
-appPicklepa(a,st)
-)
-,appUnPickle=appUnPickle$
-(casepsof
-[]->xpZero
-pa:ps1->xpChoice(xpAlttagps1)paxpLift
-)
-,theSchema=scAlts(maptheSchemaps)
-}
-
--- | Pickler for wrapping\/unwrapping data into an XML element
---
--- Extra parameter is the element name. THE pickler for constructing
--- nested structures
-
-xpElem::String->PUa->PUa
-xpElemnamepa
-=PU{appPickle=(\(a,st)->
-let
-st'=appPicklepa(a,emptySt)
-in
-addCont(XN.mkElement(mkNamename)(attributesst')(contentsst'))st
-)
-,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleElementst)
-,theSchema=scElemname(theSchemapa)
-}
-where
-unpickleElementst
-=do
-t<-getContst
-n<-XN.getElemNamet
-ifqualifiedNamen/=name
-thenfail"element name does not match"
-elsedo
-letcs=XN.getChildrent
-al<-XN.getAttrlt
-res<-fst.appUnPicklepa$St{attributes=al,contents=cs}
-return(Justres,dropContst)
-
--- | Pickler for storing\/retreiving data into\/from an attribute value
---
--- The attribute is inserted in the surrounding element constructed by the 'xpElem' pickler
-
-xpAttr::String->PUa->PUa
-xpAttrnamepa
-=PU{appPickle=(\(a,st)->
-let
-st'=appPicklepa(a,emptySt)
-in
-addAtt(XN.mkAttr(mkNamename)(contentsst'))st
-)
-,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleAttrst)
-,theSchema=scAttrname(theSchemapa)
-}
-where
-unpickleAttrst
-=do
-a<-getAttnamest
-letav=XN.getChildrena
-res<-fst.appUnPicklepa$St{attributes=[],contents=av}
-return(Justres,st)-- attribute is not removed from attribute list,
--- attributes are selected by name
-
--- | Add an optional attribute for an optional value (Maybe a).
-
-xpAttrImplied::String->PUa->PU(Maybea)
-xpAttrImpliednamepa
-=xpOption$xpAttrnamepa
-
-xpAttrFixed::String->String->PU()
-xpAttrFixednameval
-=(xpWrapMaybe(\v->ifv==valthenJust()elseNothing
-,constval
-)$
-xpAttrnamexpText
-){theSchema=scAttrname(scFixedval)}
-
--- | Add an attribute with a fixed value.
---
--- Useful e.g. to declare namespaces. Is implemented by 'xpAttrFixed'
-
-xpAddFixedAttr::String->String->PUa->PUa
-xpAddFixedAttrnamevalpa
-=xpWrap(snd
-,(,)()
-)$
-xpPair(xpAttrFixednameval)pa
-
--- ------------------------------------------------------------
-
--- | The class for overloading 'xpickle', the default pickler
-
-classXmlPicklerawhere
-xpickle::PUa
-
-instanceXmlPicklerIntwhere
-xpickle=xpPrim
-
-instanceXmlPicklerIntegerwhere
-xpickle=xpPrim
-
-{-
- no instance of XmlPickler Char
- because then every text would be encoded
- char by char, because of the instance for lists
-
-instance XmlPickler Char where
- xpickle = xpPrim
--}
-
-instanceXmlPickler()where
-xpickle=xpUnit
-
-instance(XmlPicklera,XmlPicklerb)=>XmlPickler(a,b)where
-xpickle=xpPairxpicklexpickle
-
-instance(XmlPicklera,XmlPicklerb,XmlPicklerc)=>XmlPickler(a,b,c)where
-xpickle=xpTriplexpicklexpicklexpickle
-
-instance(XmlPicklera,XmlPicklerb,XmlPicklerc,XmlPicklerd)=>XmlPickler(a,b,c,d)where
-xpickle=xp4Tuplexpicklexpicklexpicklexpickle
-
-instance(XmlPicklera,XmlPicklerb,XmlPicklerc,XmlPicklerd,XmlPicklere)=>XmlPickler(a,b,c,d,e)where
-xpickle=xp5Tuplexpicklexpicklexpicklexpicklexpickle
-
-instanceXmlPicklera=>XmlPickler[a]where
-xpickle=xpListxpickle
-
-instanceXmlPicklera=>XmlPickler(Maybea)where
-xpickle=xpOptionxpickle
-
--- ------------------------------------------------------------
+importData.Map(Map)
+importqualifiedData.MapasM
+
+importText.XML.HXT.DOM.Interface
+importqualifiedText.XML.HXT.DOM.XmlNodeasXN
+
+importControl.Arrow.ListArrows
+importText.XML.HXT.Arrow.XmlArrow
+importText.XML.HXT.Arrow.Pickle.Schema
+importText.XML.HXT.Arrow.ReadDocument(xread)
+
+-- ------------------------------------------------------------
+
+dataSt=St{attributes::[XmlTree]
+,contents::[XmlTree]
+}
+
+dataPUa=PU{appPickle::(a,St)->St
+,appUnPickle::St->(Maybea,St)
+,theSchema::Schema
+}
+
+emptySt::St
+emptySt=St{attributes=[]
+,contents=[]
+}
+
+addAtt::XmlTree->St->St
+addAttxs=s{attributes=x:attributess}
+
+addCont::XmlTree->St->St
+addContxs=s{contents=x:contentss}
+
+dropCont::St->St
+dropConts=s{contents=drop1(contentss)}
+
+getAtt::String->St->MaybeXmlTree
+getAttnames
+=listToMaybe$
+runLA(arrLattributes
+>>>
+isAttr>>>hasNamename
+)s
+
+getCont::St->MaybeXmlTree
+getConts=listToMaybe.contents$s
+
+-- ------------------------------------------------------------
+
+-- | conversion of an arbitrary value into an XML document tree.
+--
+-- The pickler, first parameter, controls the conversion process.
+-- Result is a complete document tree including a root node
+
+pickleDoc::PUa->a->XmlTree
+pickleDocpv
+=XN.mkRoot(attributesst)(contentsst)
+where
+st=appPicklep(v,emptySt)
+
+-- | Conversion of an XML document tree into an arbitrary data type
+--
+-- The inverse of 'pickleDoc'.
+-- This law should hold for all picklers: @ unpickle px . pickle px $ v == Just v @.
+-- Not every possible combination of picklers make sense.
+-- For reconverting a value from an XML tree, is becomes neccessary,
+-- to introduce \"enough\" markup for unpickling the value
+
+unpickleDoc::PUa->XmlTree->Maybea
+unpickleDocpt
+|XN.isRoott
+=fst.appUnPicklep$St{attributes=fromJust.XN.getAttrl$t
+,contents=XN.getChildrent
+}
+|otherwise
+=unpickleDocp(XN.mkRoot[][t])
+
+-- ------------------------------------------------------------
+
+-- | The zero pickler
+--
+-- Encodes nothing, fails always during unpickling
+
+xpZero::PUa
+xpZero=PU{appPickle=snd
+,appUnPickle=\s->(Nothing,s)
+,theSchema=scNull
+}
+
+-- unit pickler
+
+xpUnit::PU()
+xpUnit=xpLift()
+
+-- | Lift a value to a pickler
+--
+-- When pickling, nothing is encoded, when unpickling, the given value is inserted.
+-- This pickler always succeeds.
+
+xpLift::a->PUa
+xpLiftx=PU{appPickle=snd
+,appUnPickle=\s->(Justx,s)
+,theSchema=scEmpty
+}
+
+-- | Lift a Maybe value to a pickler.
+--
+-- @Nothing@ is mapped to the zero pickler, @Just x@ is pickled with @xpLift x@.
+
+xpLiftMaybe::Maybea->PUa
+xpLiftMaybev=(xpLiftMaybe'v){theSchema=scOptionscEmpty}
+where
+xpLiftMaybe'Nothing=xpZero
+xpLiftMaybe'(Justx)=xpLiftx
+
+
+-- | pickle\/unpickle combinator for sequence and choice.
+--
+-- When the first unpickler fails,
+-- the second one is taken, else the third one configured with the result from the first
+-- is taken. This pickler is a generalisation for 'xpSeq' and 'xpChoice' .
+--
+-- The schema must be attached later, e.g. in xpPair or other higher level combinators
+
+xpCondSeq::PUb->(b->a)->PUa->(a->PUb)->PUb
+xpCondSeqpdfpak
+=PU{appPickle=(\(b,s)->
+let
+a=fb
+pb=ka
+in
+appPicklepa(a,(appPicklepb(b,s)))
+)
+,appUnPickle=(\s->
+let
+(a,s')=appUnPicklepas
+in
+caseaof
+Nothing->appUnPicklepds
+Justa'->appUnPickle(ka')s'
+)
+,theSchema=undefined
+}
+
+
+-- | Combine two picklers sequentially.
+--
+-- If the first fails during
+-- unpickling, the whole unpickler fails
+
+xpSeq::(b->a)->PUa->(a->PUb)->PUb
+xpSeq=xpCondSeqxpZero
+
+
+-- | combine tow picklers with a choice
+--
+-- Run two picklers in sequence like with xpSeq.
+-- When during unpickling the first one fails,
+-- an alternative pickler (first argument) is applied.
+-- This pickler is only used as combinator for unpickling.
+
+xpChoice::PUb->PUa->(a->PUb)->PUb
+xpChoicepb=xpCondSeqpbundefined
+
+
+-- | map value into another domain and apply pickler there
+--
+-- One of the most often used picklers.
+
+xpWrap::(a->b,b->a)->PUa->PUb
+xpWrap(i,j)pa=(xpSeqjpa(xpLift.i)){theSchema=theSchemapa}
+
+-- | like 'xpWrap', but if the inverse mapping is undefined, the unpickler fails
+--
+-- Map a value into another domain. If the inverse mapping is
+-- undefined (Nothing), the unpickler fails
+
+xpWrapMaybe::(a->Maybeb,b->a)->PUa->PUb
+xpWrapMaybe(i,j)pa=(xpSeqjpa(xpLiftMaybe.i)){theSchema=theSchemapa}
+
+-- | pickle a pair of values sequentially
+--
+-- Used for pairs or together with wrap for pickling
+-- algebraic data types with two components
+
+xpPair::PUa->PUb->PU(a,b)
+xpPairpapb
+=(xpSeqfstpa(\a->
+xpSeqsndpb(\b->
+xpLift(a,b)))
+){theSchema=scSeq(theSchemapa)(theSchemapb)}
+
+-- | Like 'xpPair' but for triples
+
+xpTriple::PUa->PUb->PUc->PU(a,b,c)
+xpTriplepapbpc
+=xpWrap(toTriple,fromTriple)(xpPairpa(xpPairpbpc))
+where
+toTriple~(a,~(b,c))=(a,b,c)
+fromTriple~(a,b,c)=(a,(b,c))
+
+-- | Like 'xpPair' and 'xpTriple' but for 4-tuples
+
+xp4Tuple::PUa->PUb->PUc->PUd->PU(a,b,c,d)
+xp4Tuplepapbpcpd
+=xpWrap(toQuad,fromQuad)(xpPairpa(xpPairpb(xpPairpcpd)))
+where
+toQuad~(a,~(b,~(c,d)))=(a,b,c,d)
+fromQuad~(a,b,c,d)=(a,(b,(c,d)))
+
+-- | Like 'xpPair' and 'xpTriple' but for 5-tuples
+
+xp5Tuple::PUa->PUb->PUc->PUd->PUe->PU(a,b,c,d,e)
+xp5Tuplepapbpcpdpe
+=xpWrap(toQuint,fromQuint)(xpPairpa(xpPairpb(xpPairpc(xpPairpdpe))))
+where
+toQuint~(a,~(b,~(c,~(d,e))))=(a,b,c,d,e)
+fromQuint~(a,b,c,d,e)=(a,(b,(c,(d,e))))
+
+-- | Like 'xpPair' and 'xpTriple' but for 6-tuples
+
+xp6Tuple::PUa->PUb->PUc->PUd->PUe->PUf->PU(a,b,c,d,e,f)
+xp6Tuplepapbpcpdpepf
+=xpWrap(toSix,fromSix)(xpPairpa(xpPairpb(xpPairpc(xpPairpd(xpPairpepf)))))
+where
+toSix~(a,~(b,~(c,~(d,~(e,f)))))=(a,b,c,d,e,f)
+fromSix~(a,b,c,d,e,f)=(a,(b,(c,(d,(e,f)))))
+
+-- | Pickle a string into an XML text node
+--
+-- One of the most often used primitive picklers. Attention:
+-- For pickling empty strings use 'xpText0'. If the text has a more
+-- specific datatype than xsd:string, use 'xpTextDT'
+
+xpText::PUString
+xpText=xpTextDTscString1
+
+-- | Pickle a string into an XML text node
+--
+-- Text pickler with a description of the structure of the text
+-- by a schema. A schema for a data type can be defined by 'Text.XML.HXT.Arrow.Pickle.Schema.scDT'.
+-- In 'Text.XML.HXT.Arrow.Pickle.Schema' there are some more functions for creating
+-- simple datatype descriptions.
+
+xpTextDT::Schema->PUString
+xpTextDTsc
+=PU{appPickle=\(s,st)->addCont(XN.mkTexts)st
+,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleStringst)
+,theSchema=sc
+}
+where
+unpickleStringst
+=do
+t<-getContst
+s<-XN.getTextt
+return(Justs,dropContst)
+
+-- | Pickle a possibly empty string into an XML node.
+--
+-- Must be used in all places, where empty strings are legal values.
+-- If the content of an element can be an empty string, this string disapears
+-- during storing the DOM into a document and reparse the document.
+-- So the empty text node becomes nothing, and the pickler must deliver an empty string,
+-- if there is no text node in the document.
+
+xpText0::PUString
+xpText0=xpText0DTscString1
+
+-- | Pickle a possibly empty string with a datatype description into an XML node.
+--
+-- Like 'xpText0' but with extra Parameter for datatype description as in 'xpTextDT'.
+
+xpText0DT::Schema->PUString
+xpText0DTsc
+=xpWrap(fromMaybe"",emptyToNothing)$xpOption$xpTextDTsc
+where
+emptyToNothing""=Nothing
+emptyToNothingx=Justx
+
+-- | Pickle an arbitrary value by applyling show during pickling
+-- and read during unpickling.
+--
+-- Real pickling is then done with 'xpText'.
+-- One of the most often used pimitive picklers. Applicable for all
+-- types which are instances of @Read@ and @Show@
+
+xpPrim::(Reada,Showa)=>PUa
+xpPrim
+=xpWrapMaybe(readMaybe,show)xpText
+where
+readMaybe::Reada=>String->Maybea
+readMaybestr
+=val(readsstr)
+where
+val[(x,"")]=Justx
+val_=Nothing
+
+-- ------------------------------------------------------------
+
+-- | Pickle an XmlTree by just adding it
+--
+-- Usefull for components of type XmlTree in other data structures
+
+xpTree::PUXmlTree
+xpTree=PU{appPickle=\(s,st)->addContsst
+,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleTreest)
+,theSchema=Any
+}
+where
+unpickleTreest
+=do
+t<-getContst
+return(Justt,dropContst)
+
+-- | Pickle a whole list of XmlTrees by just adding the list, unpickle is done by taking all element contens.
+--
+-- This pickler should always combined with 'xpElem' for taking the whole contents of an element.
+
+xpTrees::PU[XmlTree]
+xpTrees=(xpListxpTree){theSchema=Any}
+
+-- | Pickle a string representing XML contents by inserting the tree representation into the XML document.
+--
+-- Unpickling is done by converting the contents with
+-- 'Text.XML.HXT.Arrow.XmlArrow.xshow' into a string,
+-- pickling is done with 'Text.XML.HXT.Arrow.ReadDocument.xread'
+
+xpXmlText::PUString
+xpXmlText
+=xpWrap(showXML,readXML)$xpTrees
+where
+showXML=concat.runLA(xshowunlistA)
+readXML=runLAxread
+
+-- ------------------------------------------------------------
+
+-- | Encoding of optional data by ignoring the Nothing case during pickling
+-- and relying on failure during unpickling to recompute the Nothing case
+--
+-- The default pickler for Maybe types
+
+xpOption::PUa->PU(Maybea)
+xpOptionpa
+=PU{appPickle=(\(a,st)->
+caseaof
+Nothing->st
+Justx->appPicklepa(x,st)
+)
+
+,appUnPickle=appUnPickle$
+xpChoice(xpLiftNothing)pa(xpLift.Just)
+
+,theSchema=scOption(theSchemapa)
+}
+
+-- | Optional conversion with default value
+--
+-- The default value is not encoded in the XML document,
+-- during unpickling the default value is inserted if the pickler fails
+
+xpDefault::(Eqa)=>a->PUa->PUa
+xpDefaultdf
+=xpWrap(fromMaybedf
+,\x->ifx==dfthenNothingelseJustx
+).
+xpOption
+
+-- ------------------------------------------------------------
+
+-- | Encoding of list values by pickling all list elements sequentially.
+--
+-- Unpickler relies on failure for detecting the end of the list.
+-- The standard pickler for lists. Can also be used in combination with 'xpWrap'
+-- for constructing set and map picklers
+
+xpList::PUa->PU[a]
+xpListpa
+=PU{appPickle=(\(a,st)->
+caseaof
+[]->st
+_:_->appPicklepc(a,st)
+)
+,appUnPickle=appUnPickle$
+xpChoice(xpLift[])pa
+(\x->xpSeqid(xpListpa)(\xs->xpLift(x:xs)))
+
+,theSchema=scList(theSchemapa)
+}
+where
+pc=xpSeqheadpa(\x->
+xpSeqtail(xpListpa)(\xs->
+xpLift(x:xs)))
+
+-- | Encoding of a none empty list of values
+--
+-- Attention: when calling this pickler with an empty list,
+-- an internal error \"head of empty list is raised\".
+
+xpList1::PUa->PU[a]
+xpList1pa
+=(xpWrap(\(x,xs)->x:xs
+,\(x:xs)->(x,xs)
+)$
+xpPairpa(xpListpa)
+){theSchema=scList1(theSchemapa)}
+
+-- ------------------------------------------------------------
+
+-- | Standard pickler for maps
+--
+-- This pickler converts a map into a list of pairs.
+-- All key value pairs are mapped to an element with name (1.arg),
+-- the key is encoded as an attribute named by the 2. argument,
+-- the 3. arg is the pickler for the keys, the last one for the values
+
+xpMap::Ordk=>String->String->PUk->PUv->PU(Mapkv)
+xpMapenanxpkxpv
+=xpWrap(M.fromList
+,M.toList
+)$
+xpList$
+xpElemen$
+xpPair(xpAttran$xpk)xpv
+
+
+-- ------------------------------------------------------------
+
+-- | Pickler for sum data types.
+--
+-- Every constructor is mapped to an index into the list of picklers.
+-- The index is used only during pickling, not during unpickling, there the 1. match is taken
+
+xpAlt::(a->Int)->[PUa]->PUa
+xpAlttagps
+=PU{appPickle=(\(a,st)->
+let
+pa=ps!!(taga)
+in
+appPicklepa(a,st)
+)
+,appUnPickle=appUnPickle$
+(casepsof
+[]->xpZero
+pa:ps1->xpChoice(xpAlttagps1)paxpLift
+)
+,theSchema=scAlts(maptheSchemaps)
+}
+
+-- ------------------------------------------------------------
+
+-- | Pickler for wrapping\/unwrapping data into an XML element
+--
+-- Extra parameter is the element name. THE pickler for constructing
+-- nested structures
+--
+-- Example:
+--
+-- > xpElem "number" $ xpickle
+--
+-- will map an (42::Int) onto
+--
+-- > <number>42</number>
+
+xpElem::String->PUa->PUa
+xpElemnamepa
+=PU{appPickle=(\(a,st)->
+let
+st'=appPicklepa(a,emptySt)
+in
+addCont(XN.mkElement(mkNamename)(attributesst')(contentsst'))st
+)
+,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleElementst)
+,theSchema=scElemname(theSchemapa)
+}
+where
+unpickleElementst
+=do
+t<-getContst
+n<-XN.getElemNamet
+ifqualifiedNamen/=name
+thenfail"element name does not match"
+elsedo
+letcs=XN.getChildrent
+al<-XN.getAttrlt
+res<-fst.appUnPicklepa$St{attributes=al,contents=cs}
+return(Justres,dropContst)
+
+-- ------------------------------------------------------------
+
+-- | Pickler for wrapping\/unwrapping data into an XML element with an attribute with given value
+--
+-- To make XML structures flexible but limit the number of different elements, it's sometimes
+-- useful to use a kind of generic element with a key value structure
+--
+-- Example:
+--
+-- > <attr name="key1">value1</attr>
+-- > <attr name="key2">value2</attr>
+-- > <attr name="key3">value3</attr>
+--
+-- the Haskell datatype may look like this
+--
+-- > type T = T { key1 :: Int ; key2 :: String ; key3 :: Double }
+--
+-- Then the picker for that type looks like this
+--
+-- > xpT :: PU T
+-- > xpT = xpWrap ( uncurry3 T, \ t -> (key1 t, key2 t, key3 t) ) $
+-- > xpTriple (xpElemWithAttrValue "attr" "name" "key1" $ xpickle)
+-- > (xpElemWithAttrValue "attr" "name" "key2" $ xpText0)
+-- > (xpElemWithAttrValue "attr" "name" "key3" $ xpickle)
+
+xpElemWithAttrValue::String->String->String->PUa->PUa
+xpElemWithAttrValuenameanavpa
+=PU{appPickle=(\(a,st)->
+let
+st'=appPicklepa'(a,emptySt)
+in
+addCont(XN.mkElement(mkNamename)(attributesst')(contentsst'))st
+)
+,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleElementst)
+,theSchema=scElemname(theSchemapa')
+}
+where
+pa'=xpAddFixedAttranav$pa
+noMatch=null.runLA(isElem
+>>>
+hasNamename
+>>>
+hasAttrValuean(==av)
+)
+unpickleElementst
+=do
+t<-getContst
+ifnoMatcht
+thenfail"element name or attr value does not match"
+elsedo
+letcs=XN.getChildrent
+al<-XN.getAttrlt
+res<-fst.appUnPicklepa$St{attributes=al,contents=cs}
+return(Justres,dropContst)
+
+-- ------------------------------------------------------------
+
+-- | Pickler for storing\/retreiving data into\/from an attribute value
+--
+-- The attribute is inserted in the surrounding element constructed by the 'xpElem' pickler
+
+xpAttr::String->PUa->PUa
+xpAttrnamepa
+=PU{appPickle=(\(a,st)->
+let
+st'=appPicklepa(a,emptySt)
+in
+addAtt(XN.mkAttr(mkNamename)(contentsst'))st
+)
+,appUnPickle=\st->fromMaybe(Nothing,st)(unpickleAttrst)
+,theSchema=scAttrname(theSchemapa)
+}
+where
+unpickleAttrst
+=do
+a<-getAttnamest
+letav=XN.getChildrena
+res<-fst.appUnPicklepa$St{attributes=[],contents=av}
+return(Justres,st)-- attribute is not removed from attribute list,
+-- attributes are selected by name
+
+-- | Add an optional attribute for an optional value (Maybe a).
+
+xpAttrImplied::String->PUa->PU(Maybea)
+xpAttrImpliednamepa
+=xpOption$xpAttrnamepa
+
+xpAttrFixed::String->String->PU()
+xpAttrFixednameval
+=(xpWrapMaybe(\v->ifv==valthenJust()elseNothing
+,constval
+)$
+xpAttrnamexpText
+){theSchema=scAttrname(scFixedval)}
+
+-- | Add an attribute with a fixed value.
+--
+-- Useful e.g. to declare namespaces. Is implemented by 'xpAttrFixed'
+
+xpAddFixedAttr::String->String->PUa->PUa
+xpAddFixedAttrnamevalpa
+=xpWrap(snd
+,(,)()
+)$
+xpPair(xpAttrFixednameval)pa
+
+-- ------------------------------------------------------------
+
+-- | The class for overloading 'xpickle', the default pickler
+
+classXmlPicklerawhere
+xpickle::PUa
+
+instanceXmlPicklerIntwhere
+xpickle=xpPrim
+
+instanceXmlPicklerIntegerwhere
+xpickle=xpPrim
+
+{-
+ no instance of XmlPickler Char
+ because then every text would be encoded
+ char by char, because of the instance for lists
+
+instance XmlPickler Char where
+ xpickle = xpPrim
+-}
+
+instanceXmlPickler()where
+xpickle=xpUnit
+
+instance(XmlPicklera,XmlPicklerb)=>XmlPickler(a,b)where
+xpickle=xpPairxpicklexpickle
+
+instance(XmlPicklera,XmlPicklerb,XmlPicklerc)=>XmlPickler(a,b,c)where
+xpickle=xpTriplexpicklexpicklexpickle
+
+instance(XmlPicklera,XmlPicklerb,XmlPicklerc,XmlPicklerd)=>XmlPickler(a,b,c,d)where
+xpickle=xp4Tuplexpicklexpicklexpicklexpickle
+
+instance(XmlPicklera,XmlPicklerb,XmlPicklerc,XmlPicklerd,XmlPicklere)=>XmlPickler(a,b,c,d,e)where
+xpickle=xp5Tuplexpicklexpicklexpicklexpicklexpickle
+
+instanceXmlPicklera=>XmlPickler[a]where
+xpickle=xpListxpickle
+
+instanceXmlPicklera=>XmlPickler(Maybea)where
+xpickle=xpOptionxpickle
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle.html b/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-Pickle.html
@@ -64,185 +64,191 @@
,xp4Tuple,xp5Tuple
-,xpAddFixedAttr
-,xpAlt
-,xpAttr
-,xpAttrFixed
-,xpAttrImplied
-,xpChoice
-,xpCondSeq
-,xpElem
-,xpickle
-,xpLift
-,xpLiftMaybe
-,xpList
-,xpList1
-,xpOption
-,xpPair
-,xpPrim
-,xpSeq
-,xpText
-,xpText0
-,xpTextDT
-,xpText0DT
-,xpTree
-,xpTriple
-,xpUnit
-,xpWrap
-,xpWrapMaybe
-,xpZero
-
--- from Text.XML.HXT.Arrow.Pickle.Schema
-,Schema
-,Schemas
-,DataTypeDescr
-)
-where
-
-importData.Maybe
-
-importControl.Arrow.ListArrows
-
-importText.XML.HXT.DOM.Interface
-importText.XML.HXT.Arrow.XmlArrow
-importText.XML.HXT.Arrow.XmlIOStateArrow
-importText.XML.HXT.Arrow.ReadDocument
-importText.XML.HXT.Arrow.WriteDocument
+,xp6Tuple
+,xpAddFixedAttr
+,xpAlt
+,xpAttr
+,xpAttrFixed
+,xpAttrImplied
+,xpChoice
+,xpCondSeq
+,xpDefault
+,xpElem
+,xpElemWithAttrValue
+,xpickle
+,xpLift
+,xpLiftMaybe
+,xpList
+,xpList1
+,xpMap
+,xpOption
+,xpPair
+,xpPrim
+,xpSeq
+,xpText
+,xpText0
+,xpTextDT
+,xpText0DT
+,xpTree
+,xpTrees
+,xpTriple
+,xpUnit
+,xpWrap
+,xpWrapMaybe
+,xpXmlText
+,xpZero
+
+-- from Text.XML.HXT.Arrow.Pickle.Schema
+,Schema
+,Schemas
+,DataTypeDescr
+)
+where
+
+importData.Maybe
+
+importControl.Arrow.ListArrows
-importText.XML.HXT.Arrow.Pickle.Xml
-importText.XML.HXT.Arrow.Pickle.Schema
-importText.XML.HXT.Arrow.Pickle.DTD
-
--- ------------------------------------------------------------
+importText.XML.HXT.DOM.Interface
+importText.XML.HXT.Arrow.XmlArrow
+importText.XML.HXT.Arrow.XmlIOStateArrow
+importText.XML.HXT.Arrow.ReadDocument
+importText.XML.HXT.Arrow.WriteDocument
--- the arrow interface for pickling and unpickling
-
--- | store an arbitray value in a persistent XML document
---
--- The pickler converts a value into an XML tree, this is written out with
--- 'Text.XML.HXT.Arrow.writeDocument'. The option list is passed to 'Text.XML.HXT.Arrow.writeDocument'
---
--- An option evaluated by this arrow is 'a_addDTD'.
--- If 'a_addDTD' is set ('v_1'), the pickler DTD is added as an inline DTD into the document.
-
-xpickleDocument::PUa->Attributes->String->IOStateArrowsaXmlTree
-xpickleDocumentxpaldest
-=xpickleValxp
->>>
-traceMsg1"xpickleVal applied"
->>>
-(iflookup1a_addDTDal==v_1
-thenreplaceChildren((constAundefined>>>xpickleDTDxp>>>getChildren)
-<+>
-getChildren
-)
-elsethis
-)
->>>
-writeDocumentaldest
-
--- | Option for generating and adding DTD when document is pickled
-
-a_addDTD::String
-a_addDTD="addDTD"
-
--- | read an arbitray value from an XML document
---
--- The document is read with 'Text.XML.HXT.Arrow.readDocument'. Options are passed
--- to 'Text.XML.HXT.Arrow.readDocument'. The conversion from XmlTree is done with the
--- pickler.
---
--- @ xpickleDocument xp al dest >>> xunpickleDocument xp al' dest @ is the identity arrow
--- when applied with the appropriate options. When during pickling indentation is switched on,
--- the whitespace must be removed during unpickling.
-
-xunpickleDocument::PUa->Attributes->String->IOStateArrowsba
-xunpickleDocumentxpalsrc
-=readDocumentalsrc
->>>
-traceMsg1("xunpickleVal for "++showsrc++" started")
->>>
-xunpickleValxp
->>>
-traceMsg1("xunpickleVal for "++showsrc++" finished")
-
--- | Write out the DTD generated out of a pickler. Calls 'xpicklerDTD'
-
-xpickleWriteDTD::PUb->Attributes->String->IOStateArrowsbXmlTree
-xpickleWriteDTDxpaldest
-=xpickleDTDxp
->>>
-writeDocumentaldest
+importText.XML.HXT.Arrow.Pickle.Xml
+importText.XML.HXT.Arrow.Pickle.Schema
+importText.XML.HXT.Arrow.Pickle.DTD
+
+-- ------------------------------------------------------------
+
+-- the arrow interface for pickling and unpickling
+
+-- | store an arbitray value in a persistent XML document
+--
+-- The pickler converts a value into an XML tree, this is written out with
+-- 'Text.XML.HXT.Arrow.writeDocument'. The option list is passed to 'Text.XML.HXT.Arrow.writeDocument'
+--
+-- An option evaluated by this arrow is 'a_addDTD'.
+-- If 'a_addDTD' is set ('v_1'), the pickler DTD is added as an inline DTD into the document.
+
+xpickleDocument::PUa->Attributes->String->IOStateArrowsaXmlTree
+xpickleDocumentxpaldest
+=xpickleValxp
+>>>
+traceMsg1"xpickleVal applied"
+>>>
+(iflookup1a_addDTDal==v_1
+thenreplaceChildren((constAundefined>>>xpickleDTDxp>>>getChildren)
+<+>
+getChildren
+)
+elsethis
+)
+>>>
+writeDocumentaldest
+
+-- | Option for generating and adding DTD when document is pickled
+
+a_addDTD::String
+a_addDTD="addDTD"
+
+-- | read an arbitray value from an XML document
+--
+-- The document is read with 'Text.XML.HXT.Arrow.readDocument'. Options are passed
+-- to 'Text.XML.HXT.Arrow.readDocument'. The conversion from XmlTree is done with the
+-- pickler.
+--
+-- @ xpickleDocument xp al dest >>> xunpickleDocument xp al' dest @ is the identity arrow
+-- when applied with the appropriate options. When during pickling indentation is switched on,
+-- the whitespace must be removed during unpickling.
+
+xunpickleDocument::PUa->Attributes->String->IOStateArrowsba
+xunpickleDocumentxpalsrc
+=readDocumentalsrc
+>>>
+traceMsg1("xunpickleVal for "++showsrc++" started")
+>>>
+xunpickleValxp
+>>>
+traceMsg1("xunpickleVal for "++showsrc++" finished")
+
+-- | Write out the DTD generated out of a pickler. Calls 'xpicklerDTD'
--- | The arrow for generating the DTD out of a pickler
---
--- A DTD is generated from a pickler and check for consistency.
--- Errors concerning the DTD are issued.
-
-xpickleDTD::PUb->IOStateArrowsbXmlTree
-xpickleDTDxp=root[][constL(thePicklerDTDxp)
->>>
-filterErrorMsg
-]
+xpickleWriteDTD::PUb->Attributes->String->IOStateArrowsbXmlTree
+xpickleWriteDTDxpaldest
+=xpickleDTDxp
+>>>
+writeDocumentaldest
+
+-- | The arrow for generating the DTD out of a pickler
+--
+-- A DTD is generated from a pickler and check for consistency.
+-- Errors concerning the DTD are issued.
--- | An arrow for checking picklers
---
--- A value is transformed into an XML document by a given pickler,
--- the associated DTD is extracted from the pickler and checked,
--- the document including the DTD is tranlated into a string,
--- this string is read and validated against the included DTD,
--- and unpickled.
--- The last step is the equality with the input.
---
--- If the check succeeds, the arrow works like this, else it fails.
-
-checkPickler::Eqa=>PUa->IOStateArrowsaa
-checkPicklerxp=((((xpickleValxp
->>>
-replaceChildren((constAundefined>>>xpickleDTDxp>>>getChildren)
-<+>
-getChildren
-)
->>>
-writeDocumentToString[]
->>>
-readFromString[(a_validate,v_1)]
->>>
-(xunpickleValxp
-`orElse`
-(issueErr"unpickling the document failed"
->>>
-none
-)
-)
-)
-&&&
-this
-)
->>>isA(uncurry(==))
-)
-`guards`this
-)
-`orElse`issueErr"pickle/unpickle combinators failed"
-
--- | The arrow version of the pickler function
-
-xpickleVal::ArrowXmla=>PUb->abXmlTree
-xpickleValxp=arr(pickleDocxp)
-
--- | The arrow version of the unpickler function
-
-xunpickleVal::ArrowXmla=>PUb->aXmlTreeb
-xunpickleValxp=arrL(maybeToList.unpickleDocxp)
-
+xpickleDTD::PUb->IOStateArrowsbXmlTree
+xpickleDTDxp=root[][constL(thePicklerDTDxp)
+>>>
+filterErrorMsg
+]
+
+-- | An arrow for checking picklers
+--
+-- A value is transformed into an XML document by a given pickler,
+-- the associated DTD is extracted from the pickler and checked,
+-- the document including the DTD is tranlated into a string,
+-- this string is read and validated against the included DTD,
+-- and unpickled.
+-- The last step is the equality with the input.
+--
+-- If the check succeeds, the arrow works like this, else it fails.
+
+checkPickler::Eqa=>PUa->IOStateArrowsaa
+checkPicklerxp=((((xpickleValxp
+>>>
+replaceChildren((constAundefined>>>xpickleDTDxp>>>getChildren)
+<+>
+getChildren
+)
+>>>
+writeDocumentToString[]
+>>>
+readFromString[(a_validate,v_1)]
+>>>
+(xunpickleValxp
+`orElse`
+(issueErr"unpickling the document failed"
+>>>
+none
+)
+)
+)
+&&&
+this
+)
+>>>isA(uncurry(==))
+)
+`guards`this
+)
+`orElse`issueErr"pickle/unpickle combinators failed"
+
+-- | The arrow version of the pickler function
+
+xpickleVal::ArrowXmla=>PUb->abXmlTree
+xpickleValxp=arr(pickleDocxp)
--- | Compute the associated DTD of a pickler
+-- | The arrow version of the unpickler function
-thePicklerDTD::PUb->XmlTrees
-thePicklerDTD=dtdDescrToXml.dtdDescr.theSchema
+xunpickleVal::ArrowXmla=>PUb->aXmlTreeb
+xunpickleValxp=arrL(maybeToList.unpickleDocxp)
--- ------------------------------------------------------------
-
+
+-- | Compute the associated DTD of a pickler
+thePicklerDTD::PUb->XmlTrees
+thePicklerDTD=dtdDescrToXml.dtdDescr.theSchema
+
+-- ------------------------------------------------------------
+
+
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-ProcessDocument.html b/doc/hdoc/src/Text-XML-HXT-Arrow-ProcessDocument.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-ProcessDocument.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-ProcessDocument.html
@@ -251,46 +251,44 @@
>>>propagateNamespaces>>>
-traceTree
+traceDoc"propagating namespaces done">>>
-traceSource
+traceMsg1"validating namespaces">>>
-traceMsg1"validating namespaces"
->>>
-(setDocumentStatusFromSystemState"namespace propagation"
-`when`
-(validateNamespaces>>>performfilterErrorMsg)
-)
->>>
-traceMsg1"namespace validation finished"
-)
-`when`
-documentStatusOk
+(setDocumentStatusFromSystemState"namespace propagation"
+`when`
+(validateNamespaces>>>performfilterErrorMsg)
+)
+>>>
+traceMsg1"namespace validation finished"
+)
+`when`
+documentStatusOk
+
+-- ------------------------------------------------------------
--- ------------------------------------------------------------
-
-{- |
- creates a new document root, adds all options
- as attributes to the document root and calls 'getXmlContents'.
-
- If the document name is the empty string, the document will be read
- from standard input.
-
- For supported protocols see 'Text.XML.HXT.Arrow.DocumentInput.getXmlContents'
--}
-
-getDocumentContents::Attributes->String->IOStateArrowsbXmlTree
-getDocumentContentsoptionssrc
-=root[][]
+{- |
+ creates a new document root, adds all options
+ as attributes to the document root and calls 'getXmlContents'.
+
+ If the document name is the empty string, the document will be read
+ from standard input.
+
+ For supported protocols see 'Text.XML.HXT.Arrow.DocumentInput.getXmlContents'
+-}
+
+getDocumentContents::Attributes->String->IOStateArrowsbXmlTree
+getDocumentContentsoptionssrc
+=root[][]
+>>>
+addAttra_sourcesrc>>>
-addAttra_sourcesrc
->>>
-seqA(map(uncurryaddAttr)options)-- add all options to doc root
->>>-- e.g. getXmlContents needs some of these
-traceMsg1("readDocument: start processing document "++showsrc)
->>>
-getXmlContents
-
--- ------------------------------------------------------------
+seqA(map(uncurryaddAttr)options)-- add all options to doc root
+>>>-- e.g. getXmlContents needs some of these
+traceMsg1("readDocument: start processing document "++showsrc)
+>>>
+getXmlContents
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-ReadDocument.html b/doc/hdoc/src/Text-XML-HXT-Arrow-ReadDocument.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-ReadDocument.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-ReadDocument.html
@@ -103,252 +103,284 @@
- 'a_issue_warnings' : issue warnings, when parsing HTML (default), else ignore HTML parser warnings
-- 'a_issue_errors' : issue all error messages on stderr (default), or ignore all error messages (default)
+- 'a_issue_errors' : issue all error messages on stderr (default), or ignore all error messages
-- 'a_trace' : trace level: values: 0 - 4
+- 'a_ignore_encoding_errors': ignore all encoding errors, default is issue all encoding errors
-- 'a_proxy' : proxy for http access, e.g. www-cache:3128
-
-- 'a_use_curl' : for http access via external programm curl, default is native HTTP access
+- 'a_ignore_none_xml_contents': ignore document contents of none XML\/HTML documents.
+ This option can be useful for implementing crawler like applications, e.g. an URL checker.
+ In those cases net traffic can be reduced.
-- 'a_options_curl' : more options for external program curl
+- 'a_trace' : trace level: values: 0 - 4
-- 'a_encoding' : default document encoding ('utf8', 'isoLatin1', 'usAscii', 'iso8859_2', ... , 'iso8859_16', ...)
+- 'a_proxy' : proxy for http access, e.g. www-cache:3128
-All attributes not evaluated by readDocument are stored in the created document root node for easy access of the various
-options in e.g. the input\/output modules
-
-If the document name is the empty string or an uri of the form \"stdin:\", the document is read from standard input.
-
-examples:
+- 'a_use_curl' : obsolete and ignored, HTTP acccess is always done with curl bindings for libcurl
+
+- 'a_options_curl' : deprecated but for compatibility reasons still supported.
+ More options passed to the curl binding.
+ Instead of using this option to set a whole bunch of options at once for curl
+ it is recomended to use the @curl-.*@ options syntax described below.
-> readDocument [ ] "test.xml"
-
-reads and validates a document \"test.xml\", no namespace propagation, only canonicalization is performed
-
-> readDocument [ (a_validate, "0")
-> , (a_encoding, isoLatin1)
-> ] "test.xml"
-
-reads document \"test.xml\" without validation, default encoding 'isoLatin1'.
-
-
-> readDocument [ (a_parse_html, "1")
-> , (a_encoding, isoLatin1)
-> , (a_tagsoup, "1")
-> ] ""
+- 'a_encoding' : default document encoding ('utf8', 'isoLatin1', 'usAscii', 'iso8859_2', ... , 'iso8859_16', ...).
+ Only XML and HTML documents are decoded, documents with none XML\/HTML mime types are not decoded. The whole content is returned in a single text node
+
+- 'a_mime_types' : set the mime type table for file input with given file. The format of this config file must be in the syntax of a debian linux \"mime.types\" config file
+
+- curl options : the HTTP interface with libcurl can be configured with a lot of options. To support these options in an easy way, there is a naming convetion:
+ Every option, which has the prefix @curl@ and the rest of the name forms an option as described in the curl man page, is passed to the curl binding lib.
+ See 'Text.XML.HXT.IO.GetHTTPLibCurl.getCont' for examples. Currently most of the options concerning HTTP requests are implemented.
+
+All attributes not evaluated by readDocument are stored in the created document root node for easy access of the various
+options in e.g. the input\/output modules
+
+If the document name is the empty string or an uri of the form \"stdin:\", the document is read from standard input.
+
+examples:
-reads a HTML document from standard input, no validation is done when parsing HTML, default encoding is 'isoLatin1',
-parsing is done with tagsoup parser
-
-> readDocument [ (a_parse_html, "1")
-> , (a_proxy, "www-cache:3128")
-> , (a_curl, "1")
-> , (a_issue_warnings, "0")
-> ] "http://www.haskell.org/"
+> readDocument [ ] "test.xml"
+
+reads and validates a document \"test.xml\", no namespace propagation, only canonicalization is performed
+
+> readDocument [ (a_validate, "0")
+> , (a_encoding, isoLatin1)
+> , (a_parse_by_mimetype, "1")
+> ] "http://localhost/test.php"
-reads Haskell homepage with HTML parser ignoring any warnings, with http access via external program curl and proxy \"www-cache\" at port 3128
+reads document \"test.php\", parses it as HTML or XML depending on the mimetype given from the server, but without validation, default encoding 'isoLatin1'.
-> readDocument [ (a_validate, "1")
-> , (a_check_namespace, "1")
-> , (a_remove_whitespace, "1")
-> , (a_trace, "2")
-> ] "http://www.w3c.org/"
-
-read w3c home page (xhtml), validate and check namespaces, remove whitespace between tags, trace activities with level 2
+
+> readDocument [ (a_parse_html, "1")
+> , (a_encoding, isoLatin1)
+> ] ""
+
+reads a HTML document from standard input, no validation is done when parsing HTML, default encoding is 'isoLatin1',
+parsing is done with tagsoup parser
-for minimal complete examples see 'Text.XML.HXT.Arrow.WriteDocument.writeDocument' and 'runX', the main starting point for running an XML arrow.
--}
-
-readDocument::Attributes->String->IOStateArrowsbXmlTree
-readDocumentuserOptionssrc
-=traceLevel
->>>
-addInputOptionsToSystemState
->>>
-getDocumentContentsremainingOptionssrc
->>>
-(processDoc$<getMimeType)
->>>
-traceMsg1("readDocument: "++showsrc++" processed")
->>>
-traceSource
->>>
-traceTree
-where
-options
-=addEntriesuserOptionsdefaultOptions
+> readDocument [ (a_encoding, isoLatin1)
+> , (a_mime_type, "/etc/mime.types")
+> , (a_tagsoup, "1")
+> ] "test.svg"
+
+reads an SVG document from standard input, sets the mime type by looking in the system mimetype config file, default encoding is 'isoLatin1',
+parsing is done with the lightweight tagsoup parser, which implies no validation.
+
+> readDocument [ (a_parse_html, "1")
+> , (a_proxy, "www-cache:3128")
+> , (a_curl, "1")
+> , (a_issue_warnings, "0")
+> ] "http://www.haskell.org/"
+
+reads Haskell homepage with HTML parser ignoring any warnings, with http access via external program curl and proxy \"www-cache\" at port 3128
+
+> readDocument [ (a_validate, "1")
+> , (a_check_namespace, "1")
+> , (a_remove_whitespace, "1")
+> , (a_trace, "2")
+> ] "http://www.w3c.org/"
-defaultOptions
-=[(a_parse_html,v_0)
-,(a_tagsoup,v_0)
-,(a_validate,v_1)
-,(a_issue_warnings,v_1)
-,(a_check_namespaces,v_0)
-,(a_canonicalize,v_1)
-,(a_preserve_comment,v_0)
-,(a_remove_whitespace,v_0)
-,(a_parse_by_mimetype,v_0)
-]
-
-httpOptions
-=[a_proxy,a_use_curl,a_options_curl]
-
-remainingOptions
-=filter(not.fliphasEntrydefaultOptions.fst)options
-
-traceLevel
-=maybethis(setTraceLevel.read).lookupa_trace$options
-
-addInputOptionsToSystemState
-=addSysOptions(filter((`elem`httpOptions).fst)remainingOptions)
-where
-addSysOptions
-=seqA.map(uncurrysetParamString)
-
-getMimeType
-=getAttrValuetransferMimeType>>^maptoLower
-
-processDocmimeType
-=traceMsg1("readDocument: "++showsrc++" (mime type: "++showmimeType++") will be processed")
->>>
-parse
->>>
-(ifisXmlOrHtml
-then(checknamespaces
->>>
-canonicalize
->>>
-whitespace
->>>
-relax
-)
-elsethis
-)
-where
-parse
-|isHtml
-||
-withTagSoup=parseHtmlDocument-- parse as HTML or with tagsoup XML
-withTagSoup
-withNamespaces
-issueW
-(not(hasOptiona_canonicalize)&&preserveCmt)
-removeWS
-isHtml
-|validateWithRelax=parseXmlDocumentFalse-- for Relax NG use XML parser without validation
-|isXml=parseXmlDocumentvalidate-- parse as XML
-|otherwise=this-- don't parse, mime type is not XML nor HTML
-checknamespaces
-|(withNamespaces&¬withTagSoup)
-||
-validateWithRelax=propagateAndValidateNamespaces
-|otherwise=this
-canonicalize
-|withTagSoup=this-- tagsoup already removes redundant struff
-|validateWithRelax=canonicalizeAllNodes
-|hasOptiona_canonicalize
-&&
-preserveCmt=canonicalizeForXPath
-|hasOptiona_canonicalize=canonicalizeAllNodes
-|otherwise=this
-relax
-|validateWithRelax=validateDocumentWithRelaxSchemaremainingOptionsrelaxSchema
-|otherwise=this
-whitespace
-|removeWS
-&&
-notwithTagSoup=removeDocWhiteSpace-- tagsoup already removes whitespace
-|otherwise=this
-validateWithRelax=hasEntrya_relax_schemaoptions
-relaxSchema=lookup1a_relax_schemaoptions
-parseHtml=hasOptiona_parse_html
-parseXml=hasOptiona_parse_xml
-isHtml=parseHtml-- force HTML
-||
-mimeTypeIsHtml
-isXml=parseXml-- force XML parsing
-||
-(notparseHtml
-&&
-(mimeTypeIsXml||nullmimeType)-- mime type is XML or not there
-)
-isXmlOrHtml=isHtml||isXml
-parseByMimeType=hasOptiona_parse_by_mimetype
-validate=hasOptiona_validate
-withNamespaces=hasOptiona_check_namespaces
-withTagSoup=hasOptiona_tagsoup
-issueW=hasOptiona_issue_warnings
-removeWS=hasOptiona_remove_whitespace
-preserveCmt=hasOptiona_preserve_comment
-mimeTypeIsHtml=parseByMimeType&&isHtmlMimeTypemimeType
-mimeTypeIsXml=parseByMimeType&&isXmlMimeTypemimeType
-hasOptionn=optionIsSetnoptions
-
--- ------------------------------------------------------------
-
--- |
--- the arrow version of 'readDocument', the arrow input is the source URI
-
-readFromDocument::Attributes->IOStateArrowsStringXmlTree
-readFromDocumentuserOptions
-=applyA(arr$\s->readDocumentuserOptionss)
-
--- ------------------------------------------------------------
-
--- |
--- read a document that is stored in a normal Haskell String
---
--- the same function as readDocument, but the parameter forms the input.
--- All options available for 'readDocument' are applicable for readString.
---
--- Default encoding: No encoding is done, the String argument is taken as Unicode string
-
-readString::Attributes->String->IOStateArrowsbXmlTree
-readStringuserOptionscontent
-=readDocument((a_encoding,unicodeString):userOptions)(stringProtocol++content)
-
--- ------------------------------------------------------------
-
--- |
--- the arrow version of 'readString', the arrow input is the source URI
-
-readFromString::Attributes->IOStateArrowsStringXmlTree
-readFromStringuserOptions
-=applyA(arr$\s->readStringuserOptionss)
+read w3c home page (xhtml), validate and check namespaces, remove whitespace between tags, trace activities with level 2
+
+for minimal complete examples see 'Text.XML.HXT.Arrow.WriteDocument.writeDocument' and 'runX', the main starting point for running an XML arrow.
+-}
+
+readDocument::Attributes->String->IOStateArrowsbXmlTree
+readDocumentuserOptionssrc
+=traceLevel
+>>>
+addInputOptionsToSystemState
+>>>
+getDocumentContentsremainingOptionssrc
+>>>
+(processDoc$<getMimeType)
+>>>
+traceMsg1("readDocument: "++showsrc++" processed")
+>>>
+traceSource
+>>>
+traceTree
+where
+options
+=addEntriesuserOptionsdefaultOptions
+
+defaultOptions
+=[(a_parse_html,v_0)
+,(a_tagsoup,v_0)
+,(a_validate,v_1)
+,(a_issue_warnings,v_1)
+,(a_check_namespaces,v_0)
+,(a_canonicalize,v_1)
+,(a_preserve_comment,v_0)
+,(a_remove_whitespace,v_0)
+,(a_parse_by_mimetype,v_0)
+,(a_ignore_encoding_errors,v_0)
+,(a_ignore_none_xml_contents,v_0)
+]
+
+httpOptions
+=[a_proxy,a_use_curl,a_options_curl,a_mime_types]
+
+remainingOptions
+=options-- filter (not . flip hasEntry defaultOptions . fst) options
+
+traceLevel
+=maybethis(setTraceLevel.read).lookupa_trace$options
+
+addInputOptionsToSystemState
+=addSysOptions(filter((`elem`httpOptions).fst)remainingOptions)
+>>>
+loadMineTypes(lookup1a_mime_typesuserOptions)
+where
+addSysOptions
+=seqA.map(uncurrysetParamString)
+loadMineTypes""=this
+loadMineTypesf=setMimeTypeTableFromFilef
+
+getMimeType
+=getAttrValuetransferMimeType>>^maptoLower
+
+processDocmimeType
+=traceMsg1("readDocument: "++showsrc++" (mime type: "++showmimeType++") will be processed")
+>>>
+parse
+>>>
+(ifisXmlOrHtml
+then(checknamespaces
+>>>
+canonicalize
+>>>
+whitespace
+>>>
+relax
+)
+elsethis
+)
+where
+parse
+|isHtml
+||
+withTagSoup=parseHtmlDocument-- parse as HTML or with tagsoup XML
+withTagSoup
+withNamespaces
+issueW
+(not(hasOptiona_canonicalize)&&preserveCmt)
+removeWS
+isHtml
+|validateWithRelax=parseXmlDocumentFalse-- for Relax NG use XML parser without validation
+|isXml=parseXmlDocumentvalidate-- parse as XML
+|removeNoneXml=replaceChildrennone-- don't parse, if mime type is not XML nore HTML
+|otherwise=this-- but remove contents when option is set
+checknamespaces
+|(withNamespaces&¬withTagSoup)
+||
+validateWithRelax=propagateAndValidateNamespaces
+|otherwise=this
+canonicalize
+|withTagSoup=this-- tagsoup already removes redundant struff
+|validateWithRelax=canonicalizeAllNodes
+|hasOptiona_canonicalize
+&&
+preserveCmt=canonicalizeForXPath
+|hasOptiona_canonicalize=canonicalizeAllNodes
+|otherwise=this
+relax
+|validateWithRelax=validateDocumentWithRelaxSchemaremainingOptionsrelaxSchema
+|otherwise=this
+whitespace
+|removeWS
+&&
+notwithTagSoup=removeDocWhiteSpace-- tagsoup already removes whitespace
+|otherwise=this
+validateWithRelax=hasEntrya_relax_schemaoptions
+relaxSchema=lookup1a_relax_schemaoptions
+parseHtml=hasOptiona_parse_html
+isHtml=parseHtml-- force HTML
+||
+(parseByMimeType&&isHtmlMimeTypemimeType)
+isXml=(notparseByMimeType&¬parseHtml)
+||
+(parseByMimeType
+&&
+(isXmlMimeTypemimeType
+||
+nullmimeType
+)-- mime type is XML or not known
+)
+isXmlOrHtml=isHtml||isXml
+parseByMimeType=hasOptiona_parse_by_mimetype
+validate=hasOptiona_validate
+withNamespaces=hasOptiona_check_namespaces
+withTagSoup=hasOptiona_tagsoup
+issueW=hasOptiona_issue_warnings
+removeWS=hasOptiona_remove_whitespace
+preserveCmt=hasOptiona_preserve_comment
+removeNoneXml=hasOptiona_ignore_none_xml_contents
+hasOptionn=optionIsSetnoptions-- -------------------------------------------------------------- |
--- parse a string as HTML content, substitute all HTML entity refs and canonicalize tree
--- (substitute char refs, ...). Errors are ignored.
---
--- A simpler version of 'readFromString' but with less functionality.
--- Does not run in the IO monad
+-- the arrow version of 'readDocument', the arrow input is the source URI
+
+readFromDocument::Attributes->IOStateArrowsStringXmlTree
+readFromDocumentuserOptions
+=applyA(arr$\s->readDocumentuserOptionss)
-hread::ArrowXmla=>aStringXmlTree
-hread
-=parseHtmlContent
->>>
-substHtmlEntityRefs
->>>
-processTopDown(none`when`isError)
->>>
-canonicalizeContents
+-- ------------------------------------------------------------
+
+-- |
+-- read a document that is stored in a normal Haskell String
+--
+-- the same function as readDocument, but the parameter forms the input.
+-- All options available for 'readDocument' are applicable for readString.
+--
+-- Default encoding: No encoding is done, the String argument is taken as Unicode string
--- |
--- parse a string as XML content, substitute all predefined XML entity refs and canonicalize tree
--- (substitute char refs, ...)
+readString::Attributes->String->IOStateArrowsbXmlTree
+readStringuserOptionscontent
+=readDocument((a_encoding,unicodeString):userOptions)(stringProtocol++content)
-xread::ArrowXmla=>aStringXmlTree
-xread
-=parseXmlContent
->>>
-substXmlEntityRefs
->>>
-canonicalizeContents
-
--- ------------------------------------------------------------
-
+-- ------------------------------------------------------------
+
+-- |
+-- the arrow version of 'readString', the arrow input is the source URI
+
+readFromString::Attributes->IOStateArrowsStringXmlTree
+readFromStringuserOptions
+=applyA(arr$\s->readStringuserOptionss)
+
+-- ------------------------------------------------------------
+
+-- |
+-- parse a string as HTML content, substitute all HTML entity refs and canonicalize tree
+-- (substitute char refs, ...). Errors are ignored.
+--
+-- A simpler version of 'readFromString' but with less functionality.
+-- Does not run in the IO monad
+
+hread::ArrowXmla=>aStringXmlTree
+hread
+=parseHtmlContent
+>>>
+substHtmlEntityRefs
+>>>
+processTopDown(none`when`isError)
+>>>
+canonicalizeContents
+
+-- |
+-- parse a string as XML content, substitute all predefined XML entity refs and canonicalize tree
+-- (substitute char refs, ...)
+
+xread::ArrowXmla=>aStringXmlTree
+xread
+=parseXmlContent
+>>>
+substXmlEntityRefs
+>>>
+canonicalizeContents
+
+-- ------------------------------------------------------------
+
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow-XmlIOStateArrow.html b/doc/hdoc/src/Text-XML-HXT-Arrow-XmlIOStateArrow.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow-XmlIOStateArrow.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow-XmlIOStateArrow.html
@@ -67,846 +67,888 @@
unsetParam,getParam,getAllParams,
-setParamString,
-getParamString,
-setParamInt,
-getParamInt,
-
--- * Error Message Handling
-clearErrStatus,
-setErrStatus,
-getErrStatus,
-setErrMsgStatus,
-setErrorMsgHandler,
-
-errorMsgStderr,
-errorMsgCollect,
-errorMsgStderrAndCollect,
-errorMsgIgnore,
-
-getErrorMessages,
-
-filterErrorMsg,
-issueWarn,
-issueErr,
-issueFatal,
-setDocumentStatus,
-setDocumentStatusFromSystemState,
-documentStatusOk,
-
--- * Document Base
-setBaseURI,
-getBaseURI,
-changeBaseURI,
-setDefaultBaseURI,
-getDefaultBaseURI,
-runInLocalURIContext,
-
--- * Tracing
-setTraceLevel,
-getTraceLevel,
-withTraceLevel,
-trace,
-traceMsg,
-traceString,
-traceSource,
-traceTree,
-traceDoc,
-traceState,
-
--- * URI Manipulation
-expandURIString,
-expandURI,
-mkAbsURI,
-
-getFragmentFromURI,
-getPathFromURI,
-getPortFromURI,
-getQueryFromURI,
-getRegNameFromURI,
-getSchemeFromURI,
-getUserInfoFromURI
-)
-where
-
-importControl.Arrow-- arrow classes
-importControl.Arrow.ArrowList
-importControl.Arrow.ArrowIf
-importControl.Arrow.ArrowTree
-importControl.Arrow.ArrowIO
-importControl.Arrow.IOStateListArrow
-
-importControl.Strategies.DeepSeq
-
-importText.XML.HXT.DOM.Interface
-importText.XML.HXT.Arrow.XmlArrow
-
-importText.XML.HXT.Arrow.Edit
-(addHeadlineToXmlDoc
-,treeRepOfXmlDoc
-,indentDoc
-)
-
-importData.Maybe
-
-importNetwork.URI
-(URI
-,escapeURIChar
-,isUnescapedInURI
-,nonStrictRelativeTo
-,parseURIReference
-,uriAuthority
-,uriFragment
-,uriPath
-,uriPort
-,uriQuery
-,uriRegName
-,uriScheme
-,uriUserInfo
-)
-
-importSystem.IO
-(hPutStrLn
-,hFlush
-,stderr
-)
-
-importSystem.Directory
-(getCurrentDirectory
-)
-
--- ------------------------------------------------------------
-{- $datatypes -}
-
-
--- |
--- predefined system state data type with all components for the
--- system functions, like trace, error handling, ...
-
-dataXIOSysState=XIOSys{xio_trace::!Int
-,xio_errorStatus::!Int
-,xio_errorModule::!String
-,xio_errorMsgHandler::String->IO()
-,xio_errorMsgCollect::!Bool
-,xio_errorMsgList::!XmlTrees
-,xio_baseURI::!String
-,xio_defaultBaseURI::!String
-,xio_attrList::!(AssocListStringXmlTrees)
-}
-
-instanceDeepSeqXIOSysStatewhere
-deepSeq(XIOSystresememhemcemlbudual)y
-=deepSeqtr$deepSeqes$deepSeqem$deepSeqemh$deepSeqemc$deepSeqeml$deepSeqbu$deepSeqdu$deepSeqaly
-
--- |
--- state datatype consists of a system state and a user state
--- the user state is not fixed
-
-dataXIOStateus=XIOState{xio_sysState::!XIOSysState
-,xio_userState::!us
-}
-
-instance(DeepSequs)=>DeepSeq(XIOStateus)where
-deepSeq(XIOStatesysusr)y=deepSeqsys$deepSequsry
-
--- |
--- The arrow type for stateful arrows
-
-typeIOStateArrowsbc=IOSLA(XIOStates)bc
-
--- |
--- The arrow for stateful arrows with no user defined state
-
-typeIOSArrowbc=IOStateArrow()bc
-
--- ------------------------------------------------------------
-
-
--- | the default global state, used as initial state when running an 'IOSArrow' with 'runIOSLA' or
--- 'runX'
-
-initialState::us->XIOStateus
-initialStates=XIOState{xio_sysState=initialSysState
-,xio_userState=s
-}
-
-initialSysState::XIOSysState
-initialSysState=XIOSys{xio_trace=0
-,xio_errorStatus=c_ok
-,xio_errorModule=""
-,xio_errorMsgHandler=hPutStrLnstderr
-,xio_errorMsgCollect=False
-,xio_errorMsgList=[]
-,xio_baseURI=""
-,xio_defaultBaseURI=""
-,xio_attrList=[]
-}
-
--- ------------------------------------------------------------
-
--- |
--- 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::IOSArrowXmlTreec->IO[c]
-runX=runXIOState(initialState())
-
-runXIOState::XIOStates->IOStateArrowsXmlTreec->IO[c]
-runXIOStates0f
-=do
-(_finalState,res)<-runIOSLA(emptyRoot>>>f)s0undefined
-returnres
-where
-emptyRoot=root[][]
-
--- ------------------------------------------------------------
-
-{- user state -}
-
--- | read the user defined part of the state
-
-getUserState::IOStateArrowsbs
-getUserState
-=IOSLA$\s_->
-return(s,[xio_userStates])
-
--- | change the user defined part of the state
-
-changeUserState::(b->s->s)->IOStateArrowsbb
-changeUserStatecf
-=IOSLA$\sv->
-lets'=s{xio_userState=cfv(xio_userStates)}
-inreturn(s',[v])
-
--- | set the user defined part of the state
-
-setUserState::IOStateArrowsss
-setUserState
-=changeUserStateconst
-
--- | 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)bc->IOStateArrows0bc
-withExtendedUserStateinitS1f
-=IOSLA$\s0x->
-do
-~(finalS,res)<-runIOSLAf(XIOState{xio_sysState=xio_sysStates0
-,xio_userState=(initS1,xio_userStates0)
-}
-)x
-return(XIOState{xio_sysState=xio_sysStatefinalS
-,xio_userState=snd(xio_userStatefinalS)
-}
-,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->IOStateArrows1bc->IOStateArrows0bc
-withOtherUserStates1f
-=IOSLA$\sx->
-do
-(s',res)<-runIOSLAf(XIOState{xio_sysState=xio_sysStates
-,xio_userState=s1
-}
-)x
-return(XIOState{xio_sysState=xio_sysStates'
-,xio_userState=xio_userStates
-}
-,res
-)
-
--- ------------------------------------------------------------
-
-{- $system state params -}
-
-getSysParam::(XIOSysState->c)->IOStateArrowsbc
-getSysParamf
-=IOSLA$\s_x->
-return(s,(:[]).f.xio_sysState$s)
-
-changeSysParam::(b->XIOSysState->XIOSysState)->IOStateArrowsbb
-changeSysParamcf
-=(IOSLA$\sv->
-lets'=changeSysState(cfv)s
-inreturn(s',[v])
-)
-where
-changeSysStatecsss=s{xio_sysState=css(xio_sysStates)}
-
--- | store a single XML tree in global state under a given attribute name
-
-setParam::String->IOStateArrowsXmlTreeXmlTree
-setParamn
-=(:[])^>>setParamListn
-
--- | store a list of XML trees in global system state under a given attribute name
-
-setParamList::String->IOStateArrowsXmlTreesXmlTree
-setParamListn
-=changeSysParamaddE
->>>
-arrLid
-where
-addExs=s{xio_attrList=addEntrynx(xio_attrLists)}
-
--- | remove an entry in global state, arrow input remains unchanged
-
-unsetParam::String->IOStateArrowsbb
-unsetParamn
-=changeSysParamdelE
-where
-delE_s=s{xio_attrList=delEntryn(xio_attrLists)}
-
--- | read an attribute value from global state
-
-getParam::String->IOStateArrowsbXmlTree
-getParamn
-=getAllParams
->>>
-arrL(lookup1n)
-
--- | read all attributes from global state
-
-getAllParams::IOStateArrowsb(AssocListStringXmlTrees)
-getAllParams
-=getSysParamxio_attrList
-
-setParamString::String->String->IOStateArrowsbb
-setParamStringnv
-=perform(txtv
->>>
-setParamn
-)
-
--- | read a string value from global state,
--- if parameter not set \"\" is returned
-
-getParamString::String->IOStateArrowsbString
-getParamStringn
-=xshow(getParamn)
-
--- | store an int value in global state
-
-setParamInt::String->Int->IOStateArrowsbb
-setParamIntnv
-=setParamStringn(showv)
-
--- | read an int value from global state
---
--- > getParamInt 0 myIntAttr
-
-getParamInt::Int->String->IOStateArrowsbInt
-getParamIntdefn
-=getParamStringn
->>^
-(\x->ifnullxthendefelsereadx)
-
--- ------------------------------------------------------------
-
--- | reset global error variable
-
-changeErrorStatus::(Int->Int->Int)->IOStateArrowsIntInt
-changeErrorStatusf
-=changeSysParam(\ls->s{xio_errorStatus=fl(xio_errorStatuss)})
-
-clearErrStatus::IOStateArrowsbb
-clearErrStatus
-=perform(constA0>>>changeErrorStatusmin)
-
--- | set global error variable
-
-setErrStatus::IOStateArrowsIntInt
-setErrStatus
-=changeErrorStatusmax
-
--- | read current global error status
-
-getErrStatus::IOStateArrowsXmlTreeInt
-getErrStatus
-=getSysParamxio_errorStatus
-
--- | raise the global error status level to that of the input tree
-
-setErrMsgStatus::IOStateArrowsXmlTreeXmlTree
-setErrMsgStatus
-=perform(getErrorLevel
->>>
-setErrStatus
-)
-
--- | set the error message handler and the flag for collecting the errors
-
-setErrorMsgHandler::Bool->(String->IO())->IOStateArrowsbb
-setErrorMsgHandlercf
-=changeSysParamcf
-where
-cf_s=s{xio_errorMsgHandler=f
-,xio_errorMsgCollect=c}
-
--- | error message handler for output to stderr
-
-sysErrorMsg::IOStateArrowsXmlTreeXmlTree
-sysErrorMsg
-=perform(getErrorLevel&&&getErrorMsg
->>>
-arrformatErrorMsg
->>>
-(IOSLA$\se->
-do
-(xio_errorMsgHandler.xio_sysState$s)e
-return(s,undefined)
-)
-)
-where
-formatErrorMsg(level,msg)="\n"++errClasslevel++": "++msg
-errClassl
-=fromMaybe"fatal error".lookupl$msgList
-where
-msgList=[(c_ok,"no error")
-,(c_warn,"warning")
-,(c_err,"error")
-,(c_fatal,"fatal error")
-]
-
-
--- | the default error message handler: error output to stderr
-
-errorMsgStderr::IOStateArrowsbb
-errorMsgStderr=setErrorMsgHandlerFalse(hPutStrLnstderr)
-
--- | error message handler for collecting errors
-
-errorMsgCollect::IOStateArrowsbb
-errorMsgCollect=setErrorMsgHandlerTrue(const$return())
-
--- | error message handler for output to stderr and collecting
-
-errorMsgStderrAndCollect::IOStateArrowsbb
-errorMsgStderrAndCollect=setErrorMsgHandlerTrue(hPutStrLnstderr)
-
--- | error message handler for ignoring errors
-
-errorMsgIgnore::IOStateArrowsbb
-errorMsgIgnore=setErrorMsgHandlerFalse(const$return())
-
--- |
--- if error messages are collected by the error handler for
--- processing these messages by the calling application,
--- this arrow reads the stored messages and clears the error message store
-
-getErrorMessages::IOStateArrowsbXmlTree
-getErrorMessages
-=getSysParam(reverse.xio_errorMsgList)-- reverse the list of errors
->>>
-clearErrorMsgList-- clear the error list in the system state
->>>
-arrLid
-
-clearErrorMsgList::IOStateArrowsbb
-clearErrorMsgList
-=changeSysParam(\_s->s{xio_errorMsgList=[]})
-
-addToErrorMsgList::IOStateArrowsXmlTreeXmlTree
-addToErrorMsgList
-=changeSysParamcf
-where
-cfts=ifxio_errorMsgCollects
-thens{xio_errorMsgList=t:xio_errorMsgLists}
-elses
-
--- ------------------------------------------------------------
-
--- |
--- filter error messages from input trees and issue errors
-
-filterErrorMsg::IOStateArrowsXmlTreeXmlTree
-filterErrorMsg
-=(setErrMsgStatus
->>>
-sysErrorMsg
->>>
-addToErrorMsgList
->>>
-none
-)
-`when`
-isError
-
--- | generate a warnig message
-
-issueWarn::String->IOStateArrowsbb
-issueWarnmsg=perform(warnmsg>>>filterErrorMsg)
-
--- | generate an error message
-issueErr::String->IOStateArrowsbb
-issueErrmsg=perform(errmsg>>>filterErrorMsg)
-
--- | generate a fatal error message, e.g. document not found
-
-issueFatal::String->IOStateArrowsbb
-issueFatalmsg=perform(fatalmsg>>>filterErrorMsg)
-
--- |
--- 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'.
--- called by 'setDocumentStatusFromSystemState' when the system state indicates an error
-
-setDocumentStatus::Int->String->IOStateArrowsXmlTreeXmlTree
-setDocumentStatuslevelmsg
-=(addAttrl(sattra_status(showlevel)
-<+>
-sattra_modulemsg
-)
->>>
-(iflevel>=c_err
-thensetChildren[]
-elsethis
-)
-)
-`when`
-isRoot
-
--- |
--- 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 the module name where the error occured and the error level are added as attributes with 'setDocumentStatus'
--- else nothing is changed
-
-setDocumentStatusFromSystemState::String->IOStateArrowsXmlTreeXmlTree
-setDocumentStatusFromSystemStatemsg
-=setStatus$<getErrStatus
-where
-setStatuslevel
-|level<=c_warn=this
-|otherwise=setDocumentStatuslevelmsg
-
-
--- |
--- check whether tree is a document root and the status attribute has a value less than 'c_err'
-
-documentStatusOk::ArrowXmla=>aXmlTreeXmlTree
-documentStatusOk
-=isRoot
->>>
-((getAttrValuea_status
->>>
-isA(\v->nullv||((readv)::Int)<=c_warn)
-)
-`guards`
-this
-)
-
--- ------------------------------------------------------------
-
--- | set the base URI of a document, used e.g. for reading includes, e.g. external entities,
--- the input must be an absolute URI
-
-setBaseURI::IOStateArrowsStringString
-setBaseURI
-=changeSysParam(\bs->s{xio_baseURI=b})
->>>
-traceString2(("setBaseURI: new base URI is "++).show)
-
--- | read the base URI from the globale state
-
-getBaseURI::IOStateArrowsbString
-getBaseURI
-=getSysParamxio_baseURI
->>>
-((getDefaultBaseURI
->>>
-setBaseURI
->>>
-getBaseURI
-)
-`when`
-isAnull-- set and get it, if not yet done
-)
-
--- | change the base URI with a possibly relative URI, can be used for
--- evaluating the xml:base attribute. Returns the new absolute base URI.
--- Fails, if input is not parsable with parseURIReference
---
--- see also: 'setBaseURI', 'mkAbsURI'
-
-changeBaseURI::IOStateArrowsStringString
-changeBaseURI
-=mkAbsURI
->>>
-setBaseURI
-
--- | set the default base URI, if parameter is null, the system base (@ file:\/\/\/\<cwd\>\/ @) is used,
--- else the parameter, must be called before any document is read
-
-setDefaultBaseURI::String->IOStateArrowsbString
-setDefaultBaseURIbase
-=(ifnullbase
-thenarrIOgetDir
-elseconstAbase
-)
->>>
-changeSysParam(\bs->s{xio_defaultBaseURI=b})
->>>
-traceString2(("setDefaultBaseURI: new default base URI is "++).show)
-where
-getDir_=do
-cwd<-getCurrentDirectory
-return("file://"++normalizecwd++"/")
-
--- under Windows getCurrentDirectory returns something like: "c:\path\to\file"
--- backslaches are not allowed in URIs and paths must start with a /
--- so this is transformed into "/c:/path/to/file"
-
-normalizewd'@(d:':':_)
-|d`elem`['A'..'Z']||d`elem`['a'..'z']
-='/':concatMapwin32ToUriCharwd'
-normalizewd'
-=concatMapescapeNonUriCharwd'
-
-win32ToUriChar'\\'="/"
-win32ToUriCharc=escapeNonUriCharc
-
-escapeNonUriCharc=escapeURICharisUnescapedInURIc-- from Network.URI
-
-
--- | get the default base URI
-
-getDefaultBaseURI::IOStateArrowsbString
-getDefaultBaseURI
-=getSysParamxio_defaultBaseURI-- read default uri in system state
->>>
-(setDefaultBaseURI""-- set the default uri in system state
->>>
-getDefaultBaseURI)`when`isAnull-- when uri not yet set
-
--- ------------------------------------------------------------
-
--- | remember base uri, run an arrow and restore the base URI, used with external entity substitution
-
-runInLocalURIContext::IOStateArrowsbc->IOStateArrowsbc
-runInLocalURIContextf
-=(getBaseURI&&&this)
->>>
-(this***listAf)
->>>
-(setBaseURI***this)
->>>
-arrLsnd
-
--- ------------------------------------------------------------
-
--- | set the global trace level
-
-setTraceLevel::Int->IOStateArrowsbb
-setTraceLevell
-=changeSysParam(\_s->s{xio_trace=l})
-
--- | read the global trace level
-
-getTraceLevel::IOStateArrowsbInt
-getTraceLevel
-=getSysParamxio_trace
-
--- | run an arrow with a given trace level, the old trace level is restored after the arrow execution
-
-withTraceLevel::Int->IOStateArrowsbc->IOStateArrowsbc
-withTraceLevellevelf
-=(getTraceLevel&&&this)
->>>
-(setTraceLevellevel***listAf)
->>>
-(restoreTraceLevel***this)
->>>
-arrLsnd
-where
-restoreTraceLevel::IOStateArrowsIntInt
-restoreTraceLevel
-=setTraceLevel$<this
-
--- | apply a trace arrow and issue message to stderr
-
-trace::Int->IOStateArrowsbString->IOStateArrowsbb
-traceleveltrc
-=perform(trc
->>>
-arrIO(\s->(do
-hPutStrLnstderrs
-hFlushstderr
-)
-)
-)
-`when`(getTraceLevel
->>>
-isA(>=level)
-)
-
--- | issue a string message as trace
-traceMsg::Int->String->IOStateArrowsbb
-traceMsglevelmsg
-=perform(tracelevel$
-constA('-':"- ("++showlevel++") "++msg)
-)
-
--- | issue the string input of an arrow
-traceString::Int->(String->String)->IOStateArrowsStringString
-traceStringlevelf
-=perform(applyA(arrf>>>arr(traceMsglevel)))
-
--- | issue the source representation of a document if trace level >= 3
---
--- for better readability the source is formated with indentDoc
-
-traceSource::IOStateArrowsXmlTreeXmlTree
-traceSource
-=trace3$
-xshow
-(choiceA[isRoot:->(indentDoc
->>>
-getChildren
-)
-,isElem:->(root[][this]
->>>indentDoc
->>>getChildren
->>>isElem
-)
-,this:->this
-]
-)
-
--- | issue the tree representation of a document if trace level >= 4
-traceTree::IOStateArrowsXmlTreeXmlTree
-traceTree
-=trace4$
-xshow(treeRepOfXmlDoc
->>>
-addHeadlineToXmlDoc
->>>
-getChildren
-)
-
--- | trace a main computation step
--- issue a message when trace level >= 1, issue document source if level >= 3, issue tree when level is >= 4
-
-traceDoc::String->IOStateArrowsXmlTreeXmlTree
-traceDocmsg
-=traceMsg1msg
->>>
-traceSource
->>>
-traceTree
-
--- | trace the global state
-
-traceState::IOStateArrowsbb
-traceState
-=perform(xshow((getAllParams>>.concat)
->>>
-applyA(arrformatParam)
-)
->>>
-traceString2("global state:\n"++)
-)
-where
--- formatParam :: (String, XmlTrees) -> IOStateArrow s b1 XmlTree
-formatParam(n,v)
-=mkelem"param"[sattr"name"n][arrL(constv)]<+>txt"\n"
-
--- ----------------------------------------------------------
-
--- | compute the absolut URI for a given URI and a base URI
-
-expandURIString::String->String->MaybeString
-expandURIStringuribase
-=do
-base'<-parseURIReferencebase
-uri'<-parseURIReferenceuri
-abs'<-nonStrictRelativeTouri'base'
-return$showabs'
-
--- | arrow variant of 'expandURIString', fails if 'expandURIString' returns Nothing
-
-expandURI::ArrowXmla=>a(String,String)String
-expandURI
-=arrL(maybeToList.uncurryexpandURIString)
-
--- | arrow for expanding an input URI into an absolute URI using global base URI, fails if input is not a legal URI
-
-mkAbsURI::IOStateArrowsStringString
-mkAbsURI
-=(this&&&getBaseURI)>>>expandURI
-
--- | arrow for selecting the scheme (protocol) of the URI, fails if input is not a legal URI.
---
--- See Network.URI for URI components
-
-getSchemeFromURI::ArrowLista=>aStringString
-getSchemeFromURI=getPartFromURIscheme
-where
-scheme=init.uriScheme
-
--- | arrow for selecting the registered name (host) of the URI, fails if input is not a legal URI
-
-getRegNameFromURI::ArrowLista=>aStringString
-getRegNameFromURI=getPartFromURIhost
-where
-host=maybe""uriRegName.uriAuthority
-
--- | arrow for selecting the port number of the URI without leading \':\', fails if input is not a legal URI
-
-getPortFromURI::ArrowLista=>aStringString
-getPortFromURI=getPartFromURIport
-where
-port=dropWhile(==':').maybe""uriPort.uriAuthority
-
--- | arrow for selecting the user info of the URI without trailing \'\@\', fails if input is not a legal URI
-
-getUserInfoFromURI::ArrowLista=>aStringString
-getUserInfoFromURI=getPartFromURIui
-where
-ui=reverse.dropWhile(=='@').reverse.maybe""uriUserInfo.uriAuthority
-
--- | arrow for computing the path component of an URI, fails if input is not a legal URI
-
-getPathFromURI::ArrowLista=>aStringString
-getPathFromURI=getPartFromURIuriPath
-
--- | arrow for computing the query component of an URI, fails if input is not a legal URI
-
-getQueryFromURI::ArrowLista=>aStringString
-getQueryFromURI=getPartFromURIuriQuery
-
--- | arrow for computing the fragment component of an URI, fails if input is not a legal URI
-
-getFragmentFromURI::ArrowLista=>aStringString
-getFragmentFromURI=getPartFromURIuriFragment
-
--- | arrow for computing the path component of an URI, fails if input is not a legal URI
-
-getPartFromURI::ArrowLista=>(URI->String)->aStringString
-getPartFromURIsel
-=arrL(maybeToList.getPart)
-where
-getParts=do
-uri<-parseURIReferences
-return(seluri)
-
--- ------------------------------------------------------------
+getAllParamsString,
+setParamString,
+getParamString,
+setParamInt,
+getParamInt,
+
+-- * Error Message Handling
+clearErrStatus,
+setErrStatus,
+getErrStatus,
+setErrMsgStatus,
+setErrorMsgHandler,
+
+errorMsgStderr,
+errorMsgCollect,
+errorMsgStderrAndCollect,
+errorMsgIgnore,
+
+getErrorMessages,
+
+filterErrorMsg,
+issueWarn,
+issueErr,
+issueFatal,
+setDocumentStatus,
+setDocumentStatusFromSystemState,
+documentStatusOk,
+
+-- * Document Base
+setBaseURI,
+getBaseURI,
+changeBaseURI,
+setDefaultBaseURI,
+getDefaultBaseURI,
+runInLocalURIContext,
+
+-- * Tracing
+setTraceLevel,
+getTraceLevel,
+withTraceLevel,
+trace,
+traceMsg,
+traceString,
+traceSource,
+traceTree,
+traceDoc,
+traceState,
+
+-- * URI Manipulation
+expandURIString,
+expandURI,
+mkAbsURI,
+
+getFragmentFromURI,
+getPathFromURI,
+getPortFromURI,
+getQueryFromURI,
+getRegNameFromURI,
+getSchemeFromURI,
+getUserInfoFromURI,
+
+-- * Mime Type Handling
+setMimeTypeTable,
+setMimeTypeTableFromFile
+)
+where
+
+importControl.Arrow-- arrow classes
+importControl.Arrow.ArrowList
+importControl.Arrow.ArrowIf
+importControl.Arrow.ArrowTree
+importControl.Arrow.ArrowIO
+importControl.Arrow.IOStateListArrow
+
+importControl.Strategies.DeepSeq
+
+importText.XML.HXT.DOM.Interface
+importText.XML.HXT.Arrow.XmlArrow
+
+importText.XML.HXT.Arrow.Edit
+(addHeadlineToXmlDoc
+,treeRepOfXmlDoc
+,indentDoc
+)
+
+importData.Maybe
+
+importNetwork.URI
+(URI
+,escapeURIChar
+,isUnescapedInURI
+,nonStrictRelativeTo
+,parseURIReference
+,uriAuthority
+,uriFragment
+,uriPath
+,uriPort
+,uriQuery
+,uriRegName
+,uriScheme
+,uriUserInfo
+)
+
+importSystem.IO
+(hPutStrLn
+,hFlush
+,stderr
+)
+
+importSystem.Directory
+(getCurrentDirectory
+)
+
+-- ------------------------------------------------------------
+{- $datatypes -}
+
+
+-- |
+-- predefined system state data type with all components for the
+-- system functions, like trace, error handling, ...
+
+dataXIOSysState=XIOSys{xio_trace::!Int
+,xio_errorStatus::!Int
+,xio_errorModule::!String
+,xio_errorMsgHandler::String->IO()
+,xio_errorMsgCollect::!Bool
+,xio_errorMsgList::!XmlTrees
+,xio_baseURI::!String
+,xio_defaultBaseURI::!String
+,xio_attrList::!(AssocListStringXmlTrees)
+,xio_mimeTypes::MimeTypeTable
+}
+
+instanceDeepSeqXIOSysStatewhere
+deepSeq(XIOSystresem_emhemcemlbudual_mt)y
+=deepSeqtr$deepSeqes$deepSeqem$deepSeqemc$deepSeqeml$deepSeqbu$deepSeqdu$deepSeqaly
+
+-- |
+-- state datatype consists of a system state and a user state
+-- the user state is not fixed
+
+dataXIOStateus=XIOState{xio_sysState::!XIOSysState
+,xio_userState::!us
+}
+
+instance(DeepSequs)=>DeepSeq(XIOStateus)where
+deepSeq(XIOStatesysusr)y=deepSeqsys$deepSequsry
+
+-- |
+-- The arrow type for stateful arrows
+
+typeIOStateArrowsbc=IOSLA(XIOStates)bc
+
+-- |
+-- The arrow for stateful arrows with no user defined state
+
+typeIOSArrowbc=IOStateArrow()bc
+
+-- ------------------------------------------------------------
+
+
+-- | the default global state, used as initial state when running an 'IOSArrow' with 'runIOSLA' or
+-- 'runX'
+
+initialState::us->XIOStateus
+initialStates=XIOState{xio_sysState=initialSysState
+,xio_userState=s
+}
+
+initialSysState::XIOSysState
+initialSysState=XIOSys{xio_trace=0
+,xio_errorStatus=c_ok
+,xio_errorModule=""
+,xio_errorMsgHandler=hPutStrLnstderr
+,xio_errorMsgCollect=False
+,xio_errorMsgList=[]
+,xio_baseURI=""
+,xio_defaultBaseURI=""
+,xio_attrList=[]
+,xio_mimeTypes=defaultMimeTypeTable
+}
+
+-- ------------------------------------------------------------
+
+-- |
+-- 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::IOSArrowXmlTreec->IO[c]
+runX=runXIOState(initialState())
+
+runXIOState::XIOStates->IOStateArrowsXmlTreec->IO[c]
+runXIOStates0f
+=do
+(_finalState,res)<-runIOSLA(emptyRoot>>>f)s0undefined
+returnres
+where
+emptyRoot=root[][]
+
+-- ------------------------------------------------------------
+
+{- user state -}
+
+-- | read the user defined part of the state
+
+getUserState::IOStateArrowsbs
+getUserState
+=IOSLA$\s_->
+return(s,[xio_userStates])
+
+-- | change the user defined part of the state
+
+changeUserState::(b->s->s)->IOStateArrowsbb
+changeUserStatecf
+=IOSLA$\sv->
+lets'=s{xio_userState=cfv(xio_userStates)}
+inreturn(s',[v])
+
+-- | set the user defined part of the state
+
+setUserState::IOStateArrowsss
+setUserState
+=changeUserStateconst
+
+-- | 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)bc->IOStateArrows0bc
+withExtendedUserStateinitS1f
+=IOSLA$\s0x->
+do
+~(finalS,res)<-runIOSLAf(XIOState{xio_sysState=xio_sysStates0
+,xio_userState=(initS1,xio_userStates0)
+}
+)x
+return(XIOState{xio_sysState=xio_sysStatefinalS
+,xio_userState=snd(xio_userStatefinalS)
+}
+,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->IOStateArrows1bc->IOStateArrows0bc
+withOtherUserStates1f
+=IOSLA$\sx->
+do
+(s',res)<-runIOSLAf(XIOState{xio_sysState=xio_sysStates
+,xio_userState=s1
+}
+)x
+return(XIOState{xio_sysState=xio_sysStates'
+,xio_userState=xio_userStates
+}
+,res
+)
+
+-- ------------------------------------------------------------
+
+{- $system state params -}
+
+getSysParam::(XIOSysState->c)->IOStateArrowsbc
+getSysParamf
+=IOSLA$\s_x->
+return(s,(:[]).f.xio_sysState$s)
+
+changeSysParam::(b->XIOSysState->XIOSysState)->IOStateArrowsbb
+changeSysParamcf
+=(IOSLA$\sv->
+lets'=changeSysState(cfv)s
+inreturn(s',[v])
+)
+where
+changeSysStatecsss=s{xio_sysState=css(xio_sysStates)}
+
+-- | store a single XML tree in global state under a given attribute name
+
+setParam::String->IOStateArrowsXmlTreeXmlTree
+setParamn
+=(:[])^>>setParamListn
+
+-- | store a list of XML trees in global system state under a given attribute name
+
+setParamList::String->IOStateArrowsXmlTreesXmlTree
+setParamListn
+=changeSysParamaddE
+>>>
+arrLid
+where
+addExs=s{xio_attrList=addEntrynx(xio_attrLists)}
+
+-- | remove an entry in global state, arrow input remains unchanged
+
+unsetParam::String->IOStateArrowsbb
+unsetParamn
+=changeSysParamdelE
+where
+delE_s=s{xio_attrList=delEntryn(xio_attrLists)}
+
+-- | read an attribute value from global state
+
+getParam::String->IOStateArrowsbXmlTree
+getParamn
+=getAllParams
+>>>
+arrL(lookup1n)
+
+-- | read all attributes from global state
+
+getAllParams::IOStateArrowsb(AssocListStringXmlTrees)
+getAllParams
+=getSysParamxio_attrList
+
+-- | read all attributes from global state
+-- and convert the values to strings
+
+getAllParamsString::IOStateArrowsb(AssocListStringString)
+getAllParamsString
+=getAllParams
+>>>
+listA(unlistA
+>>>
+second(xshowunlistA)
+)
+
+setParamString::String->String->IOStateArrowsbb
+setParamStringnv
+=perform(txtv
+>>>
+setParamn
+)
+
+-- | read a string value from global state,
+-- if parameter not set \"\" is returned
+
+getParamString::String->IOStateArrowsbString
+getParamStringn
+=xshow(getParamn)
+
+-- | store an int value in global state
+
+setParamInt::String->Int->IOStateArrowsbb
+setParamIntnv
+=setParamStringn(showv)
+
+-- | read an int value from global state
+--
+-- > getParamInt 0 myIntAttr
+
+getParamInt::Int->String->IOStateArrowsbInt
+getParamIntdefn
+=getParamStringn
+>>^
+(\x->ifnullxthendefelsereadx)
+
+-- ------------------------------------------------------------
+
+-- | reset global error variable
+
+changeErrorStatus::(Int->Int->Int)->IOStateArrowsIntInt
+changeErrorStatusf
+=changeSysParam(\ls->s{xio_errorStatus=fl(xio_errorStatuss)})
+
+clearErrStatus::IOStateArrowsbb
+clearErrStatus
+=perform(constA0>>>changeErrorStatusmin)
+
+-- | set global error variable
+
+setErrStatus::IOStateArrowsIntInt
+setErrStatus
+=changeErrorStatusmax
+
+-- | read current global error status
+
+getErrStatus::IOStateArrowsXmlTreeInt
+getErrStatus
+=getSysParamxio_errorStatus
+
+-- | raise the global error status level to that of the input tree
+
+setErrMsgStatus::IOStateArrowsXmlTreeXmlTree
+setErrMsgStatus
+=perform(getErrorLevel
+>>>
+setErrStatus
+)
+
+-- | set the error message handler and the flag for collecting the errors
+
+setErrorMsgHandler::Bool->(String->IO())->IOStateArrowsbb
+setErrorMsgHandlercf
+=changeSysParamcf
+where
+cf_s=s{xio_errorMsgHandler=f
+,xio_errorMsgCollect=c}
+
+-- | error message handler for output to stderr
+
+sysErrorMsg::IOStateArrowsXmlTreeXmlTree
+sysErrorMsg
+=perform(getErrorLevel&&&getErrorMsg
+>>>
+arrformatErrorMsg
+>>>
+(IOSLA$\se->
+do
+(xio_errorMsgHandler.xio_sysState$s)e
+return(s,undefined)
+)
+)
+where
+formatErrorMsg(level,msg)="\n"++errClasslevel++": "++msg
+errClassl
+=fromMaybe"fatal error".lookupl$msgList
+where
+msgList=[(c_ok,"no error")
+,(c_warn,"warning")
+,(c_err,"error")
+,(c_fatal,"fatal error")
+]
+
+
+-- | the default error message handler: error output to stderr
+
+errorMsgStderr::IOStateArrowsbb
+errorMsgStderr=setErrorMsgHandlerFalse(hPutStrLnstderr)
+
+-- | error message handler for collecting errors
+
+errorMsgCollect::IOStateArrowsbb
+errorMsgCollect=setErrorMsgHandlerTrue(const$return())
+
+-- | error message handler for output to stderr and collecting
+
+errorMsgStderrAndCollect::IOStateArrowsbb
+errorMsgStderrAndCollect=setErrorMsgHandlerTrue(hPutStrLnstderr)
+
+-- | error message handler for ignoring errors
+
+errorMsgIgnore::IOStateArrowsbb
+errorMsgIgnore=setErrorMsgHandlerFalse(const$return())
+
+-- |
+-- if error messages are collected by the error handler for
+-- processing these messages by the calling application,
+-- this arrow reads the stored messages and clears the error message store
+
+getErrorMessages::IOStateArrowsbXmlTree
+getErrorMessages
+=getSysParam(reverse.xio_errorMsgList)-- reverse the list of errors
+>>>
+clearErrorMsgList-- clear the error list in the system state
+>>>
+arrLid
+
+clearErrorMsgList::IOStateArrowsbb
+clearErrorMsgList
+=changeSysParam(\_s->s{xio_errorMsgList=[]})
+
+addToErrorMsgList::IOStateArrowsXmlTreeXmlTree
+addToErrorMsgList
+=changeSysParamcf
+where
+cfts=ifxio_errorMsgCollects
+thens{xio_errorMsgList=t:xio_errorMsgLists}
+elses
+
+-- ------------------------------------------------------------
+
+-- |
+-- filter error messages from input trees and issue errors
+
+filterErrorMsg::IOStateArrowsXmlTreeXmlTree
+filterErrorMsg
+=(setErrMsgStatus
+>>>
+sysErrorMsg
+>>>
+addToErrorMsgList
+>>>
+none
+)
+`when`
+isError
+
+-- | generate a warnig message
+
+issueWarn::String->IOStateArrowsbb
+issueWarnmsg=perform(warnmsg>>>filterErrorMsg)
+
+-- | generate an error message
+issueErr::String->IOStateArrowsbb
+issueErrmsg=perform(errmsg>>>filterErrorMsg)
+
+-- | generate a fatal error message, e.g. document not found
+
+issueFatal::String->IOStateArrowsbb
+issueFatalmsg=perform(fatalmsg>>>filterErrorMsg)
+
+-- |
+-- 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'.
+-- called by 'setDocumentStatusFromSystemState' when the system state indicates an error
+
+setDocumentStatus::Int->String->IOStateArrowsXmlTreeXmlTree
+setDocumentStatuslevelmsg
+=(addAttrl(sattra_status(showlevel)
+<+>
+sattra_modulemsg
+)
+>>>
+(iflevel>=c_err
+thensetChildren[]
+elsethis
+)
+)
+`when`
+isRoot
+
+-- |
+-- 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 the module name where the error occured and the error level are added as attributes with 'setDocumentStatus'
+-- else nothing is changed
+
+setDocumentStatusFromSystemState::String->IOStateArrowsXmlTreeXmlTree
+setDocumentStatusFromSystemStatemsg
+=setStatus$<getErrStatus
+where
+setStatuslevel
+|level<=c_warn=this
+|otherwise=setDocumentStatuslevelmsg
+
+
+-- |
+-- check whether tree is a document root and the status attribute has a value less than 'c_err'
+
+documentStatusOk::ArrowXmla=>aXmlTreeXmlTree
+documentStatusOk
+=isRoot
+>>>
+((getAttrValuea_status
+>>>
+isA(\v->nullv||((readv)::Int)<=c_warn)
+)
+`guards`
+this
+)
+
+-- ------------------------------------------------------------
+
+-- | set the base URI of a document, used e.g. for reading includes, e.g. external entities,
+-- the input must be an absolute URI
+
+setBaseURI::IOStateArrowsStringString
+setBaseURI
+=changeSysParam(\bs->s{xio_baseURI=b})
+>>>
+traceString2(("setBaseURI: new base URI is "++).show)
+
+-- | read the base URI from the globale state
+
+getBaseURI::IOStateArrowsbString
+getBaseURI
+=getSysParamxio_baseURI
+>>>
+((getDefaultBaseURI
+>>>
+setBaseURI
+>>>
+getBaseURI
+)
+`when`
+isAnull-- set and get it, if not yet done
+)
+
+-- | change the base URI with a possibly relative URI, can be used for
+-- evaluating the xml:base attribute. Returns the new absolute base URI.
+-- Fails, if input is not parsable with parseURIReference
+--
+-- see also: 'setBaseURI', 'mkAbsURI'
+
+changeBaseURI::IOStateArrowsStringString
+changeBaseURI
+=mkAbsURI
+>>>
+setBaseURI
+
+-- | set the default base URI, if parameter is null, the system base (@ file:\/\/\/\<cwd\>\/ @) is used,
+-- else the parameter, must be called before any document is read
+
+setDefaultBaseURI::String->IOStateArrowsbString
+setDefaultBaseURIbase
+=(ifnullbase
+thenarrIOgetDir
+elseconstAbase
+)
+>>>
+changeSysParam(\bs->s{xio_defaultBaseURI=b})
+>>>
+traceString2(("setDefaultBaseURI: new default base URI is "++).show)
+where
+getDir_=do
+cwd<-getCurrentDirectory
+return("file://"++normalizecwd++"/")
+
+-- under Windows getCurrentDirectory returns something like: "c:\path\to\file"
+-- backslaches are not allowed in URIs and paths must start with a /
+-- so this is transformed into "/c:/path/to/file"
+
+normalizewd'@(d:':':_)
+|d`elem`['A'..'Z']||d`elem`['a'..'z']
+='/':concatMapwin32ToUriCharwd'
+normalizewd'
+=concatMapescapeNonUriCharwd'
+
+win32ToUriChar'\\'="/"
+win32ToUriCharc=escapeNonUriCharc
+
+escapeNonUriCharc=escapeURICharisUnescapedInURIc-- from Network.URI
+
+
+-- | get the default base URI
+
+getDefaultBaseURI::IOStateArrowsbString
+getDefaultBaseURI
+=getSysParamxio_defaultBaseURI-- read default uri in system state
+>>>
+(setDefaultBaseURI""-- set the default uri in system state
+>>>
+getDefaultBaseURI)`when`isAnull-- when uri not yet set
+
+-- ------------------------------------------------------------
+
+-- | remember base uri, run an arrow and restore the base URI, used with external entity substitution
+
+runInLocalURIContext::IOStateArrowsbc->IOStateArrowsbc
+runInLocalURIContextf
+=(getBaseURI&&&this)
+>>>
+(this***listAf)
+>>>
+(setBaseURI***this)
+>>>
+arrLsnd
+
+-- ------------------------------------------------------------
+
+-- | set the global trace level
+
+setTraceLevel::Int->IOStateArrowsbb
+setTraceLevell
+=changeSysParam(\_s->s{xio_trace=l})
+
+-- | read the global trace level
+
+getTraceLevel::IOStateArrowsbInt
+getTraceLevel
+=getSysParamxio_trace
+
+-- | run an arrow with a given trace level, the old trace level is restored after the arrow execution
+
+withTraceLevel::Int->IOStateArrowsbc->IOStateArrowsbc
+withTraceLevellevelf
+=(getTraceLevel&&&this)
+>>>
+(setTraceLevellevel***listAf)
+>>>
+(restoreTraceLevel***this)
+>>>
+arrLsnd
+where
+restoreTraceLevel::IOStateArrowsIntInt
+restoreTraceLevel
+=setTraceLevel$<this
+
+-- | apply a trace arrow and issue message to stderr
+
+trace::Int->IOStateArrowsbString->IOStateArrowsbb
+traceleveltrc
+=perform(trc
+>>>
+arrIO(\s->(do
+hPutStrLnstderrs
+hFlushstderr
+)
+)
+)
+`when`(getTraceLevel
+>>>
+isA(>=level)
+)
+
+-- | issue a string message as trace
+traceMsg::Int->String->IOStateArrowsbb
+traceMsglevelmsg
+=perform(tracelevel$
+constA('-':"- ("++showlevel++") "++msg)
+)
+
+-- | issue the string input of an arrow
+traceString::Int->(String->String)->IOStateArrowsStringString
+traceStringlevelf
+=perform(applyA(arrf>>>arr(traceMsglevel)))
+
+-- | issue the source representation of a document if trace level >= 3
+--
+-- for better readability the source is formated with indentDoc
+
+traceSource::IOStateArrowsXmlTreeXmlTree
+traceSource
+=trace3$
+xshow
+(choiceA[isRoot:->(indentDoc
+>>>
+getChildren
+)
+,isElem:->(root[][this]
+>>>indentDoc
+>>>getChildren
+>>>isElem
+)
+,this:->this
+]
+)
+
+-- | issue the tree representation of a document if trace level >= 4
+traceTree::IOStateArrowsXmlTreeXmlTree
+traceTree
+=trace4$
+xshow(treeRepOfXmlDoc
+>>>
+addHeadlineToXmlDoc
+>>>
+getChildren
+)
+
+-- | trace a main computation step
+-- issue a message when trace level >= 1, issue document source if level >= 3, issue tree when level is >= 4
+
+traceDoc::String->IOStateArrowsXmlTreeXmlTree
+traceDocmsg
+=traceMsg1msg
+>>>
+traceSource
+>>>
+traceTree
+
+-- | trace the global state
+
+traceState::IOStateArrowsbb
+traceState
+=perform(xshow((getAllParams>>.concat)
+>>>
+applyA(arrformatParam)
+)
+>>>
+traceString2("global state:\n"++)
+)
+where
+-- formatParam :: (String, XmlTrees) -> IOStateArrow s b1 XmlTree
+formatParam(n,v)
+=mkelem"param"[sattr"name"n][arrL(constv)]<+>txt"\n"
+
+-- ----------------------------------------------------------
+
+-- | compute the absolut URI for a given URI and a base URI
+
+expandURIString::String->String->MaybeString
+expandURIStringuribase
+=do
+base'<-parseURIReferencebase
+uri'<-parseURIReferenceuri
+abs'<-nonStrictRelativeTouri'base'
+return$showabs'
+
+-- | arrow variant of 'expandURIString', fails if 'expandURIString' returns Nothing
+
+expandURI::ArrowXmla=>a(String,String)String
+expandURI
+=arrL(maybeToList.uncurryexpandURIString)
+
+-- | arrow for expanding an input URI into an absolute URI using global base URI, fails if input is not a legal URI
+
+mkAbsURI::IOStateArrowsStringString
+mkAbsURI
+=(this&&&getBaseURI)>>>expandURI
+
+-- | arrow for selecting the scheme (protocol) of the URI, fails if input is not a legal URI.
+--
+-- See Network.URI for URI components
+
+getSchemeFromURI::ArrowLista=>aStringString
+getSchemeFromURI=getPartFromURIscheme
+where
+scheme=init.uriScheme
+
+-- | arrow for selecting the registered name (host) of the URI, fails if input is not a legal URI
+
+getRegNameFromURI::ArrowLista=>aStringString
+getRegNameFromURI=getPartFromURIhost
+where
+host=maybe""uriRegName.uriAuthority
+
+-- | arrow for selecting the port number of the URI without leading \':\', fails if input is not a legal URI
+
+getPortFromURI::ArrowLista=>aStringString
+getPortFromURI=getPartFromURIport
+where
+port=dropWhile(==':').maybe""uriPort.uriAuthority
+
+-- | arrow for selecting the user info of the URI without trailing \'\@\', fails if input is not a legal URI
+
+getUserInfoFromURI::ArrowLista=>aStringString
+getUserInfoFromURI=getPartFromURIui
+where
+ui=reverse.dropWhile(=='@').reverse.maybe""uriUserInfo.uriAuthority
+
+-- | arrow for computing the path component of an URI, fails if input is not a legal URI
+
+getPathFromURI::ArrowLista=>aStringString
+getPathFromURI=getPartFromURIuriPath
+
+-- | arrow for computing the query component of an URI, fails if input is not a legal URI
+
+getQueryFromURI::ArrowLista=>aStringString
+getQueryFromURI=getPartFromURIuriQuery
+
+-- | arrow for computing the fragment component of an URI, fails if input is not a legal URI
+
+getFragmentFromURI::ArrowLista=>aStringString
+getFragmentFromURI=getPartFromURIuriFragment
+
+-- | arrow for computing the path component of an URI, fails if input is not a legal URI
+
+getPartFromURI::ArrowLista=>(URI->String)->aStringString
+getPartFromURIsel
+=arrL(maybeToList.getPart)
+where
+getParts=do
+uri<-parseURIReferences
+return(seluri)
+
+-- ------------------------------------------------------------
+
+-- | set the table mapping of file extensions to mime types in the system state
+--
+-- Default table is defined in 'Text.XML.HXT.DOM.MimeTypeDefaults'.
+-- This table is used when reading loacl files, (file: protocol) to determine the mime type
+
+setMimeTypeTable::MimeTypeTable->IOStateArrowsbb
+setMimeTypeTablemtt
+=changeSysParam(\_s->s{xio_mimeTypes=mtt})
+
+-- | set the table mapping of file extensions to mime types by an external config file
+--
+-- The config file must follow the conventions of /etc/mime.types on a debian linux system,
+-- that means all empty lines and all lines starting with a # are ignored. The other lines
+-- must consist of a mime type followed by a possible empty list of extensions.
+-- The list of extenstions and mime types overwrites the default list in the system state
+-- of the IOStateArrow
+
+setMimeTypeTableFromFile::FilePath->IOStateArrowsbb
+setMimeTypeTableFromFilefile
+=setMimeTypeTable$<arrIO0(readMimeTypeTablefile)
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-Arrow.html b/doc/hdoc/src/Text-XML-HXT-Arrow.html
--- a/doc/hdoc/src/Text-XML-HXT-Arrow.html
+++ b/doc/hdoc/src/Text-XML-HXT-Arrow.html
@@ -48,30 +48,34 @@
,moduleText.XML.HXT.Arrow.Pickle,moduleText.XML.HXT.XSLT.XsltArrows
-)
-where
-
-importControl.Arrow.ListArrows-- arrow classes
+
+,moduleText.XML.HXT.Version
+)
+where
-importText.XML.HXT.DOM.Interface
-importText.XML.HXT.Arrow.DocumentInput
-importText.XML.HXT.Arrow.DocumentOutput
-importText.XML.HXT.Arrow.Edit
-importText.XML.HXT.Arrow.GeneralEntitySubstitution
-importText.XML.HXT.Arrow.Namespace
-importText.XML.HXT.Arrow.Pickle
-importText.XML.HXT.Arrow.ProcessDocument
-importText.XML.HXT.Arrow.ReadDocument
-importText.XML.HXT.Arrow.WriteDocument
-importText.XML.HXT.Arrow.XmlArrow
-importText.XML.HXT.Arrow.XmlIOStateArrow
-importText.XML.HXT.Arrow.XmlRegex()-- import this "by hand"
-importText.XML.HXT.Arrow.XPath
-importqualified-- just for adding the module to the lib
-Text.XML.HXT.Arrow.XPathSimpleasXPS()
-
-importText.XML.HXT.XSLT.XsltArrows
+importControl.Arrow.ListArrows-- arrow classes
+
+importText.XML.HXT.DOM.Interface
+importText.XML.HXT.Arrow.DocumentInput
+importText.XML.HXT.Arrow.DocumentOutput
+importText.XML.HXT.Arrow.Edit
+importText.XML.HXT.Arrow.GeneralEntitySubstitution
+importText.XML.HXT.Arrow.Namespace
+importText.XML.HXT.Arrow.Pickle
+importText.XML.HXT.Arrow.ProcessDocument
+importText.XML.HXT.Arrow.ReadDocument
+importText.XML.HXT.Arrow.WriteDocument
+importText.XML.HXT.Arrow.XmlArrow
+importText.XML.HXT.Arrow.XmlIOStateArrow
+importText.XML.HXT.Arrow.XmlRegex()-- import this "by hand"
+importText.XML.HXT.Arrow.XPath
+importqualified-- just for adding the module to the lib
+Text.XML.HXT.Arrow.XPathSimpleasXPS()
--- ------------------------------------------------------------
+importText.XML.HXT.XSLT.XsltArrows
+
+importText.XML.HXT.Version
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-DOM-Interface.html b/doc/hdoc/src/Text-XML-HXT-DOM-Interface.html
--- a/doc/hdoc/src/Text-XML-HXT-DOM-Interface.html
+++ b/doc/hdoc/src/Text-XML-HXT-DOM-Interface.html
@@ -31,16 +31,18 @@
,moduleText.XML.HXT.DOM.NamespacePredicates,moduleText.XML.HXT.DOM.Util,moduleText.XML.HXT.DOM.XmlOptions
-)
-where
-
-importText.XML.HXT.DOM.XmlKeywords-- constants
-importText.XML.HXT.DOM.TypeDefs-- XML Tree types
-importText.XML.HXT.DOM.NamespacePredicates
-importText.XML.HXT.DOM.Util
-importText.XML.HXT.DOM.XmlOptions-- predefined options
-
-
--- ------------------------------------------------------------
+,moduleText.XML.HXT.DOM.MimeTypes
+)
+where
+
+importText.XML.HXT.DOM.XmlKeywords-- constants
+importText.XML.HXT.DOM.TypeDefs-- XML Tree types
+importText.XML.HXT.DOM.NamespacePredicates
+importText.XML.HXT.DOM.Util
+importText.XML.HXT.DOM.XmlOptions-- predefined options
+importText.XML.HXT.DOM.MimeTypes-- mime types related stuff
+
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-DOM-MimeTypeDefaults.html b/doc/hdoc/src/Text-XML-HXT-DOM-MimeTypeDefaults.html
new file mode 100644
--- /dev/null
+++ b/doc/hdoc/src/Text-XML-HXT-DOM-MimeTypeDefaults.html
@@ -0,0 +1,594 @@
+
+
+
+
+Haskell Code by HsColour
+
+
+
+
-- |
--- Namespace filter
---
--- $Id: NamespaceFilter.hs,v 1.4 2006/11/12 14:53:00 hxml Exp $
---
--- Namespaces are processed with two main filter, 'propagateNamespaces'
--- and 'validateNamespaces'.
---
--- 'propagateNamespaces' takes a XML tree and
--- attaches extra namespace info at every tag name and attribute name.
--- So after processing a tree with 'propagateNamespaces', the access functions
--- "namespaceOf" and "universalNameOf" deliver the associated namespace (or \"\")
--- for tag names and attribute names.
---
--- 'validateNamespaces' checks whether names are wellformed related to the XML namespace definition.
--- whether a legal namespace is declared for all prefixes, and whether attribute names are unique
--- related to universal names.
-
-moduleText.XML.HXT.DOM.NamespaceFilter
-(moduleText.XML.HXT.DOM.NamespaceFilter
-,moduleText.XML.HXT.DOM.NamespacePredicates
-)
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.DOM.NamespacePredicates
-
-importText.XML.HXT.DOM.Util
-(doubles)
-
--- -----------------------------------------------------------------------------
---
-
--- |
--- Type for the namespace association list, used when propagating namespaces by
--- modifying the 'QName' values in a tree
-
-typeNamespaceTable=NsEnv
-
--- -----------------------------------------------------------------------------
-
--- |
--- propagate all namespace declarations \"xmlns:ns=...\" to all
--- tag and attribute nodes of a document.
---
--- This filter does not check for illegal use of namespaces.
--- The real work is done by 'propagateNamespaceEnv'.
---
--- The filter may be applied repeatedly if neccessary.
-
-propagateNamespaces::XmlFilter
-propagateNamespaces=propagateNamespaceEnv[(a_xml,xmlNamespace),(a_xmlns,xmlnsNamespace)]
-
--- |
--- attaches the namespace info given by the namespace table
--- to a tag node and its attributes and children.
-
-propagateNamespaceEnv::NamespaceTable->XmlFilter
-propagateNamespaceEnvenvn
-=((processAttr(attachNamespaceUrisToAttrnewEnv)
-.>
-processChildren(propagateNamespaceEnvnewEnv)
-.>
-modifyQName(setNamespacenewEnv)
-)
-`when`
-isXTag
-)
-$n
-where
-nsAttrs=getAttrl-- scan all attributes
-.>
-isOfAttr((\(px,lp)
-->(px==a_xmlns-- check for prefix or whole name is "xmlns"
-&&
-lp/=":"-- check for none empty local part, "xmlns:" is not a legal name
-)
-)
-.span(/=':')-- break the name into a pair ("prefix", ":localPart")
-.qualifiedName-- select attribute name
-)
-$n
-nsDecl=zip(map(drop1-- drop the ":", empty local part represents default name space
-.snd-- take the local part with leading ":"
-.span(/=':')-- break it like above
-.nameOf-- select attribute name
-)nsAttrs)
-(map(xshow
-.
-getChildren
-)nsAttrs)
-newEnv=addEntriesnsDeclenv
-
-attachNamespaceUrisToAttr::NamespaceTable->XmlFilter
-attachNamespaceUrisToAttrattrEnv
-=(isOfAttr((\(px,lp)
-->((not.null.drop1)lp-- prefix and local part must not be empty
-&&
-(not.null)px
-)
-)
-.span(/=':')-- break the name into a pair ("prefix", ":localPart")
-.qualifiedName-- select attribute name
-)
-`guards`
-modifyQName(setNamespaceattrEnv)
-)
-`orElse`
-(modifyQName(constxmlnsQN)-- "xmlns" ist the only attr name without prefix but with an associated namespace URI
-`when`
-isAttra_xmlns
-)
-
--- -----------------------------------------------------------------------------
-
--- |
--- validate the namespace constraints in a whole tree.
--- result is the list of errors concerning namespaces.
--- Work is done by applying 'validate1Namespaces' to all nodes.
--- Predicates 'isWellformedQName', 'isWellformedQualifiedName', 'isDeclaredNamespace'
--- and 'isWellformedNSDecl' are applied to the appropriate tags and attributes.
-
-validateNamespaces::XmlFilter
-validateNamespaces
-=choice[isRoot
-:->getChildren.>validateNamespaces-- root is correct by definition
-,this
-:->multivalidate1Namespaces
-]
-
--- |
--- a single node for namespace constrains.
-
-validate1Namespaces::XmlFilter
-validate1Namespaces
-=choice[isXTag
-:->
-cat[isOfTag(not.isWellformedQName)
-`guards`
-(\n->err("tag name "++show(nameOfn)++" is not a wellformed qualified name")n)
-
-,isOfTag(not.isDeclaredNamespace)
-`guards`
-(\n->err("namespace for prefix in tag name "++show(nameOfn)++" is undefined")n)
-
-,(\n->(let
-dbls=doubles((mapuniversalNameOf.getAttrl)n)
-in
-ifnulldbls
-thennone
-elseerr("multiple occurences of universal names for attributes of tag "
-++show(nameOfn)
-++" : "++foldr1(\xy->x++", "++y)(mapshowdbls)
-)
-)$n
-)
-
-,getAttrl.>validate1Namespaces
-]
-
-,isXAttr
-:->
-cat[isOfAttr(not.isWellformedQName)
-`guards`
-(\n->err("attribute name "++show(nameOfn)++" is not a wellformed qualified name")n)
-
-,isOfAttr(not.isDeclaredNamespace)
-`guards`
-(\n->err("namespace for prefix in attribute name "++show(nameOfn)++" is undefined")n)
-
-,(hasPrefixa_xmlns.>neg(xmlTreesToText.getChildren))
-`guards`
-(\n->err("namespace value of namespace declaration for "++show(nameOfn)++" has no value")n)
-
-,isOfAttr(not.isWellformedNSDecl)
-`guards`
-(\n->err("illegal namespace declaration with reserved prefix "++show(localPartOfn)++" starting with \"xml\"")n)
-]
-
-,isXDTD
-:->
-cat[((isDoctype+++isAttlist+++isElement+++isDTDName)
-.>
-isOf(not.isWellformedQualifiedName.valueOfDTDa_name)
-)
-`guards`
-(\n->err("a DTD part contains a not wellformed qualified Name: "++show(valueOfDTDa_namen))n)
-
-,(isAttlist
-.>
-isOf(not.isWellformedQualifiedName.valueOfDTDa_value)
-)
-`guards`
-(\n->err("an ATTLIST declaration contains as attribute name a not wellformed qualified Name: "++show(valueOfDTDa_valuen))n)
-
-,((isEntity+++isParameterEntity+++isNotation)
-.>
-isOf(not.isNCName.valueOfDTDa_name)
-)
-`guards`
-(\n->err("an entity or notation declaration contains a not wellformed NCName: "++show(valueOfDTDa_namen))n)
-]
-,isXPi
-:->
-(isOf(not.isNCName.nameOf)
-`guards`
-(\n->err("a PI contains a not wellformed NCName: "++show(nameOfn))n)
-)
-]
-
--- -----------------------------------------------------------------------------
-
-isNamespaceDecl::XmlFilter
-isNamespaceDecl
-=isOfAttrxmlnsName
-where
-xmlnsName::AttrName->Bool
-xmlnsNamea
-=px==a_xmlns
-&&
-(nullln||headln==':')
-where
-(px,ln)=splitAt5.qualifiedName$a
-
--- -----------------------------------------------------------------------------
-
-
diff --git a/doc/hdoc/src/Text-XML-HXT-DOM-XmlKeywords.html b/doc/hdoc/src/Text-XML-HXT-DOM-XmlKeywords.html
--- a/doc/hdoc/src/Text-XML-HXT-DOM-XmlKeywords.html
+++ b/doc/hdoc/src/Text-XML-HXT-DOM-XmlKeywords.html
@@ -16,388 +16,349 @@
Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
Stability : experimental
Portability: portable
- Version : $Id: XmlKeywords.hs,v 1.10 2006/11/02 09:34:09 hxml Exp $
-
- Constants for XML keywords, for special attribute names
- and special attribute values
-
--}
-
--- ------------------------------------------------------------
-
-moduleText.XML.HXT.DOM.XmlKeywords
-where
-
-importData.List
-(isSuffixOf
-)
-
--- ------------------------------------------------------------
---
--- string constants for representing DTD keywords and attributes
-
-t_xml,-- tag names
-t_root::String
-
-a_canonicalize,
-a_default,-- attribute names
-a_check_namespaces,
-a_contentLength,
-a_collect_errors,
-a_column,
-a_default_baseuri,
-a_do_not_canonicalize,
-a_do_not_check_namespaces,
-a_do_not_issue_errors,
-a_do_not_issue_warnings,
-a_do_not_preserve_comment,
-a_do_not_remove_whitespace,
-a_do_not_use_curl,
-a_do_not_validate,
-a_encoding,
-a_error,
-a_error_log,
-a_help,
-a_indent,
-a_issue_errors,
-a_issue_warnings,
-a_kind,
-a_line,
-a_module,
-a_modifier,
-a_name,
-a_no_xml_pi,
-a_options_curl,
-a_output_encoding,
-a_output_file,
-a_output_xml,
-a_output_html,
-a_parse_by_mimetype,
-a_parse_html,
-a_parse_xml,
-a_peref,
-a_preserve_comment,
-a_propagate_errors,
-a_proxy,
-a_remove_whitespace,
-a_show_haskell,
-a_show_tree,
-a_source,
-a_status,
-a_standalone,
-a_tagsoup,
-a_trace,
-a_type,
-a_use_curl,
-a_url,
-a_validate,
-a_value,
-a_verbose,
-a_version,
-a_xml,
-a_xmlns::String
-
-v_0,-- attribute values
-v_1,
-v_yes,
-v_no,
-v_any,
-v_children,
-v_choice,
-v_empty,
-v_mixed,
-v_seq,
-v_null,
-v_option,
-v_pcdata,
-v_star,
-v_plus::String
-
-k_any,-- DTD keywords
-k_cdata,
-k_empty,
-k_entity,
-k_entities,
-k_id,
-k_idref,
-k_idrefs,
-k_include,
-k_ignore,
-k_nmtoken,
-k_nmtokens,
-k_peref,
-k_public,
-k_system,
-k_enumeration,
-k_fixed,
-k_implied,
-k_ndata,
-k_notation,
-k_pcdata,
-k_required,
-k_default::String
+
+ Constants for XML keywords, for special attribute names
+ and special attribute values
+
+-}
+
+-- ------------------------------------------------------------
+
+moduleText.XML.HXT.DOM.XmlKeywords
+where
+
+-- ------------------------------------------------------------
+--
+-- string constants for representing DTD keywords and attributes
+
+t_xml,-- tag names
+t_root::String
+
+a_canonicalize,
+a_default,-- attribute names
+a_check_namespaces,
+a_contentLength,
+a_collect_errors,
+a_column,
+a_default_baseuri,
+a_do_not_canonicalize,
+a_do_not_check_namespaces,
+a_do_not_issue_errors,
+a_do_not_issue_warnings,
+a_do_not_preserve_comment,
+a_do_not_remove_whitespace,
+a_do_not_use_curl,
+a_do_not_validate,
+a_encoding,
+a_error,
+a_error_log,
+a_help,
+a_ignore_encoding_errors,
+a_ignore_none_xml_contents,
+a_indent,
+a_issue_errors,
+a_issue_warnings,
+a_kind,
+a_line,
+a_mime_types,
+a_module,
+a_modifier,
+a_name,
+a_no_xml_pi,
+a_options_curl,
+a_output_encoding,
+a_output_file,
+a_output_xml,
+a_output_html,
+a_parse_by_mimetype,
+a_parse_html,
+a_parse_xml,
+a_peref,
+a_preserve_comment,
+a_propagate_errors,
+a_proxy,
+a_remove_whitespace,
+a_show_haskell,
+a_show_tree,
+a_source,
+a_status,
+a_standalone,
+a_tagsoup,
+a_trace,
+a_type,
+a_use_curl,
+a_url,
+a_validate,
+a_value,
+a_verbose,
+a_version,
+a_xml,
+a_xmlns::String
+
+v_0,-- attribute values
+v_1,
+v_yes,
+v_no,
+v_any,
+v_children,
+v_choice,
+v_empty,
+v_mixed,
+v_seq,
+v_null,
+v_option,
+v_pcdata,
+v_star,
+v_plus::String
+
+k_any,-- DTD keywords
+k_cdata,
+k_empty,
+k_entity,
+k_entities,
+k_id,
+k_idref,
+k_idrefs,
+k_include,
+k_ignore,
+k_nmtoken,
+k_nmtokens,
+k_peref,
+k_public,
+k_system,
+k_enumeration,
+k_fixed,
+k_implied,
+k_ndata,
+k_notation,
+k_pcdata,
+k_required,
+k_default::String
+
+-- ------------------------------------------------------------
--- ------------------------------------------------------------
-
-t_xml="xml"
-t_root="/"-- name of root node tag
-
-a_canonicalize="canonicalize"
-a_check_namespaces="check-namespaces"
-a_collect_errors="collect-errors"
-a_column="column"
-a_contentLength="Content-Length"
-a_default="default"
-a_default_baseuri="default-base-URI"
-a_do_not_canonicalize="do-not-canonicalize"
-a_do_not_check_namespaces="do-not-check-namespaces"
-a_do_not_issue_errors="do-not-issue-errors"
-a_do_not_issue_warnings="do-not-issue-warnings"
-a_do_not_preserve_comment="do-not-preserve-comment"
-a_do_not_remove_whitespace="do-not-remove-whitespace"
-a_do_not_use_curl="do-not-use-curl"
-a_do_not_validate="do-not-validate"
-a_encoding="encoding"
-a_error="error"
-a_error_log="errorLog"
-a_help="help"
+t_xml="xml"
+t_root="/"-- name of root node tag
+
+a_canonicalize="canonicalize"
+a_check_namespaces="check-namespaces"
+a_collect_errors="collect-errors"
+a_column="column"
+a_contentLength="Content-Length"
+a_default="default"
+a_default_baseuri="default-base-URI"
+a_do_not_canonicalize="do-not-canonicalize"
+a_do_not_check_namespaces="do-not-check-namespaces"
+a_do_not_issue_errors="do-not-issue-errors"
+a_do_not_issue_warnings="do-not-issue-warnings"
+a_do_not_preserve_comment="do-not-preserve-comment"
+a_do_not_remove_whitespace="do-not-remove-whitespace"
+a_do_not_use_curl="do-not-use-curl"
+a_do_not_validate="do-not-validate"
+a_encoding="encoding"
+a_error="error"
+a_error_log="errorLog"
+a_help="help"
+a_ignore_encoding_errors="ignore-encoding-errors"
+a_ignore_none_xml_contents="ignore-none-xml-contents"a_indent="indent"a_issue_warnings="issue-warnings"a_issue_errors="issue-errors"a_kind="kind"a_line="line"
-a_module="module"
-a_modifier="modifier"
-a_name="name"
-a_no_xml_pi="no-xml-pi"
-a_options_curl="options-curl"
-a_output_file="output-file"
-a_output_encoding="output-encoding"
-a_output_html="output-html"
-a_output_xml="output-xml"
-a_parse_by_mimetype="parse-by-mimetype"
-a_parse_html="parse-html"
-a_parse_xml="parse-xml"
-a_peref=k_peref
-a_preserve_comment="preserve-comment"
-a_propagate_errors="propagate-errors"
-a_proxy="proxy"
-a_remove_whitespace="remove-whitespace"
-a_show_haskell="show-haskell"
-a_show_tree="show-tree"
-a_source="source"
-a_standalone="standalone"
-a_status="status"
-a_tagsoup="tagsoup"
-a_trace="trace"
-a_type="type"
-a_url="url"
-a_use_curl="use-curl"
-a_validate="validate"
-a_value="value"
-a_verbose="verbose"
-a_version="version"
-a_xml="xml"
-a_xmlns="xmlns"
-
-v_yes="yes"
-v_no="no"
-v_1="1"
-v_0="0"
-
-v_any=k_any
-v_children="children"
-v_choice="choice"
-v_empty=k_empty
-v_pcdata=k_pcdata
-v_mixed="mixed"
-v_seq="seq"
-
-v_null=""
-v_option="?"
-v_star="*"
-v_plus="+"
-
-k_any="ANY"
-k_cdata="CDATA"
-k_empty="EMPTY"
-k_entity="ENTITY"
-k_entities="ENTITIES"
-k_id="ID"
-k_idref="IDREF"
-k_idrefs="IDREFS"
-k_include="INCLUDE"
-k_ignore="IGNORE"
-k_nmtoken="NMTOKEN"
-k_nmtokens="NMTOKENS"
-k_peref="PERef"
-k_public="PUBLIC"
-k_system="SYSTEM"
-
-k_enumeration="#ENUMERATION"
-k_fixed="#FIXED"
-k_implied="#IMPLIED"
-k_ndata="NDATA"
-k_notation="NOTATION"
-k_pcdata="#PCDATA"
-k_required="#REQUIRED"
-k_default="#DEFAULT"
-
+a_mime_types="mimetypes"
+a_module="module"
+a_modifier="modifier"
+a_name="name"
+a_no_xml_pi="no-xml-pi"
+a_options_curl="options-curl"
+a_output_file="output-file"
+a_output_encoding="output-encoding"
+a_output_html="output-html"
+a_output_xml="output-xml"
+a_parse_by_mimetype="parse-by-mimetype"
+a_parse_html="parse-html"
+a_parse_xml="parse-xml"
+a_peref=k_peref
+a_preserve_comment="preserve-comment"
+a_propagate_errors="propagate-errors"
+a_proxy="proxy"
+a_remove_whitespace="remove-whitespace"
+a_show_haskell="show-haskell"
+a_show_tree="show-tree"
+a_source="source"
+a_standalone="standalone"
+a_status="status"
+a_tagsoup="tagsoup"
+a_trace="trace"
+a_type="type"
+a_url="url"
+a_use_curl="use-curl"
+a_validate="validate"
+a_value="value"
+a_verbose="verbose"
+a_version="version"
+a_xml="xml"
+a_xmlns="xmlns"
+
+v_yes="yes"
+v_no="no"
+v_1="1"
+v_0="0"
+
+v_any=k_any
+v_children="children"
+v_choice="choice"
+v_empty=k_empty
+v_pcdata=k_pcdata
+v_mixed="mixed"
+v_seq="seq"
+
+v_null=""
+v_option="?"
+v_star="*"
+v_plus="+"
+
+k_any="ANY"
+k_cdata="CDATA"
+k_empty="EMPTY"
+k_entity="ENTITY"
+k_entities="ENTITIES"
+k_id="ID"
+k_idref="IDREF"
+k_idrefs="IDREFS"
+k_include="INCLUDE"
+k_ignore="IGNORE"
+k_nmtoken="NMTOKEN"
+k_nmtokens="NMTOKENS"
+k_peref="PERef"
+k_public="PUBLIC"
+k_system="SYSTEM"
+
+k_enumeration="#ENUMERATION"
+k_fixed="#FIXED"
+k_implied="#IMPLIED"
+k_ndata="NDATA"
+k_notation="NOTATION"
+k_pcdata="#PCDATA"
+k_required="#REQUIRED"
+k_default="#DEFAULT"
--- ------------------------------------------------------------
---
-
--- attribute names for transfer protocol attributes
--- used in XmlInput for describing header information
--- of http and other requests
-
-transferPrefix
-,transferProtocol
-,transferMimeType
-,transferEncoding
-,transferURI
-,transferDefaultURI
-,transferStatus
-,transferMessage
-,transferVersion::String
-
-transferPrefix="transfer-"
-
-transferProtocol=transferPrefix++"Protocol"
-transferVersion=transferPrefix++"Version"
-transferMimeType=transferPrefix++"MimeType"
-transferEncoding=transferPrefix++"Encoding"
-transferDefaultURI=transferPrefix++"DefaultURI"
-transferStatus=transferPrefix++"Status"
-transferMessage=transferPrefix++"Message"
-transferURI=transferPrefix++"URI"
-
--- ------------------------------------------------------------
---
-
-httpPrefix::String
-httpPrefix="http-"
-
-stringProtocol::String
-stringProtocol="string:"
-
--- ------------------------------------------------------------
---
--- encoding names
-
-isoLatin1
-,iso8859_1,iso8859_2,iso8859_3,iso8859_4,iso8859_5
-,iso8859_6,iso8859_7,iso8859_8,iso8859_9,iso8859_10
-,iso8859_11,iso8859_13,iso8859_14,iso8859_15,iso8859_16
-,usAscii,ucs2,utf8,utf16,utf16be,utf16le,unicodeString::String
-
-isoLatin1=iso8859_1
-iso8859_1="ISO-8859-1"
-iso8859_2="ISO-8859-2"
-iso8859_3="ISO-8859-3"
-iso8859_4="ISO-8859-4"
-iso8859_5="ISO-8859-5"
-iso8859_6="ISO-8859-6"
-iso8859_7="ISO-8859-7"
-iso8859_8="ISO-8859-8"
-iso8859_9="ISO-8859-9"
-iso8859_10="ISO-8859-10"
-iso8859_11="ISO-8859-11"
-iso8859_13="ISO-8859-13"
-iso8859_14="ISO-8859-14"
-iso8859_15="ISO-8859-15"
-iso8859_16="ISO-8859-16"
-usAscii="US-ASCII"
-ucs2="ISO-10646-UCS-2"
-utf8="UTF-8"
-utf16="UTF-16"
-utf16be="UTF-16BE"
-utf16le="UTF-16LE"
-unicodeString="UNICODE"
-
--- ------------------------------------------------------------
---
--- known namespaces
-
--- |
--- the predefined namespace uri for xml: \"http:\/\/www.w3.org\/XML\/1998\/namespace\"
-
-xmlNamespace::String
-xmlNamespace="http://www.w3.org/XML/1998/namespace"
-
--- |
--- the predefined namespace uri for xmlns: \"http:\/\/www.w3.org\/2000\/xmlns\/\"
-
-xmlnsNamespace::String
-xmlnsNamespace="http://www.w3.org/2000/xmlns/"
-
--- | Relax NG namespace
-relaxNamespace::String
-relaxNamespace="http://relaxng.org/ns/structure/1.0"
-
--- ------------------------------------------------------------
--- option for Relax NG
-
-a_relax_schema,
-a_do_not_check_restrictions,
-a_check_restrictions,
-a_do_not_validate_externalRef,
-a_validate_externalRef,
-a_do_not_validate_include,
-a_validate_include,
-a_output_changes,
-a_do_not_collect_errors::String
-
-a_relax_schema="relax-schema"
-a_do_not_check_restrictions="do-not-check-restrictions"
-a_check_restrictions="check-restrictions"
-a_do_not_validate_externalRef="do-not-validate-externalRef"
-a_validate_externalRef="validate-externalRef"
-a_do_not_validate_include="do-not-validate-include"
-a_validate_include="validate-include"
-a_output_changes="output-pattern-transformations"
-a_do_not_collect_errors="do-not-collect-errors"
-
--- ------------------------------------------------------------
-
--- mime types
---
--- see RFC \"http:\/\/www.rfc-editor.org\/rfc\/rfc3023.txt\"
-
-application_xhtml,
-application_xml,
-application_xml_external_parsed_entity,
-application_xml_dtd,
-text_html,
-text_xml,
-text_xml_external_parsed_entity::String
-
-application_xhtml="application/xhtml+xml"
-application_xml="application/xml"
-application_xml_external_parsed_entity="application/xml-external-parsed-entity"
-application_xml_dtd="application/xml-dtd"
-
-text_html="text/html"
-text_xml="text/xml"
-text_xml_external_parsed_entity="text/xml-external-parsed-entity"
-
-isHtmlMimeType::String->Bool
-isHtmlMimeTypet
-=t==text_html
-
-isXmlMimeType::String->Bool
-isXmlMimeTypet
-=(t`elem`[application_xhtml
-,application_xml
-,application_xml_external_parsed_entity
-,application_xml_dtd
-,text_xml
-,text_xml_external_parsed_entity
-]
-||
-"+xml"`isSuffixOf`t-- application/mathml+xml
-)-- or image/svg+xml
-
--- ------------------------------------------------------------
+
+-- ------------------------------------------------------------
+--
+
+-- attribute names for transfer protocol attributes
+-- used in XmlInput for describing header information
+-- of http and other requests
+
+transferPrefix
+,transferProtocol
+,transferMimeType
+,transferEncoding
+,transferURI
+,transferDefaultURI
+,transferStatus
+,transferMessage
+,transferVersion::String
+
+transferPrefix="transfer-"
+
+transferProtocol=transferPrefix++"Protocol"
+transferVersion=transferPrefix++"Version"
+transferMimeType=transferPrefix++"MimeType"
+transferEncoding=transferPrefix++"Encoding"
+transferDefaultURI=transferPrefix++"DefaultURI"
+transferStatus=transferPrefix++"Status"
+transferMessage=transferPrefix++"Message"
+transferURI=transferPrefix++"URI"
+
+-- ------------------------------------------------------------
+--
+
+httpPrefix::String
+httpPrefix="http-"
+
+stringProtocol::String
+stringProtocol="string:"
+
+-- ------------------------------------------------------------
+--
+-- encoding names
+
+isoLatin1
+,iso8859_1,iso8859_2,iso8859_3,iso8859_4,iso8859_5
+,iso8859_6,iso8859_7,iso8859_8,iso8859_9,iso8859_10
+,iso8859_11,iso8859_13,iso8859_14,iso8859_15,iso8859_16
+,usAscii,ucs2,utf8,utf16,utf16be,utf16le,unicodeString::String
+
+isoLatin1=iso8859_1
+iso8859_1="ISO-8859-1"
+iso8859_2="ISO-8859-2"
+iso8859_3="ISO-8859-3"
+iso8859_4="ISO-8859-4"
+iso8859_5="ISO-8859-5"
+iso8859_6="ISO-8859-6"
+iso8859_7="ISO-8859-7"
+iso8859_8="ISO-8859-8"
+iso8859_9="ISO-8859-9"
+iso8859_10="ISO-8859-10"
+iso8859_11="ISO-8859-11"
+iso8859_13="ISO-8859-13"
+iso8859_14="ISO-8859-14"
+iso8859_15="ISO-8859-15"
+iso8859_16="ISO-8859-16"
+usAscii="US-ASCII"
+ucs2="ISO-10646-UCS-2"
+utf8="UTF-8"
+utf16="UTF-16"
+utf16be="UTF-16BE"
+utf16le="UTF-16LE"
+unicodeString="UNICODE"
+
+-- ------------------------------------------------------------
+--
+-- known namespaces
+
+-- |
+-- the predefined namespace uri for xml: \"http:\/\/www.w3.org\/XML\/1998\/namespace\"
+
+xmlNamespace::String
+xmlNamespace="http://www.w3.org/XML/1998/namespace"
+
+-- |
+-- the predefined namespace uri for xmlns: \"http:\/\/www.w3.org\/2000\/xmlns\/\"
+
+xmlnsNamespace::String
+xmlnsNamespace="http://www.w3.org/2000/xmlns/"
+
+-- | Relax NG namespace
+relaxNamespace::String
+relaxNamespace="http://relaxng.org/ns/structure/1.0"
+
+-- ------------------------------------------------------------
+-- option for Relax NG
+
+a_relax_schema,
+a_do_not_check_restrictions,
+a_check_restrictions,
+a_do_not_validate_externalRef,
+a_validate_externalRef,
+a_do_not_validate_include,
+a_validate_include,
+a_output_changes,
+a_do_not_collect_errors::String
+
+a_relax_schema="relax-schema"
+a_do_not_check_restrictions="do-not-check-restrictions"
+a_check_restrictions="check-restrictions"
+a_do_not_validate_externalRef="do-not-validate-externalRef"
+a_validate_externalRef="validate-externalRef"
+a_do_not_validate_include="do-not-validate-include"
+a_validate_include="validate-include"
+a_output_changes="output-pattern-transformations"
+a_do_not_collect_errors="do-not-collect-errors"
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-DOM-XmlOptions.html b/doc/hdoc/src/Text-XML-HXT-DOM-XmlOptions.html
--- a/doc/hdoc/src/Text-XML-HXT-DOM-XmlOptions.html
+++ b/doc/hdoc/src/Text-XML-HXT-DOM-XmlOptions.html
@@ -24,154 +24,166 @@
,selectOptions,removeOptions,optionIsSet
-)
-where
-
-importText.XML.HXT.DOM.XmlKeywords
-importText.XML.HXT.DOM.TypeDefs
-
-importData.Maybe
-
-importSystem.Console.GetOpt
-
--- ------------------------------------------------------------
---
-
--- |
--- commonly useful options for XML input
---
--- can be used for option definition with haskell getopt
---
--- defines options: 'a_trace', 'a_proxy', 'a_use_curl', 'a_do_not_use_curl', 'a_options_curl', 'a_encoding',
--- 'a_issue_errors', 'a_do_not_issue_errors', 'a_parse_html', 'a_parse_by_mimetype', 'a_tagsoup' 'a_issue_warnings', 'a_do_not_issue_warnings',
--- 'a_parse_xml', 'a_validate', 'a_do_not_validate', 'a_canonicalize', 'a_do_not_canonicalize',
---- 'a_preserve_comment', 'a_do_not_preserve_comment', 'a_check_namespaces', 'a_do_not_check_namespaces',
--- 'a_remove_whitespace', 'a_do_not_remove_whitespace'
-
-inputOptions::[OptDescr(String,String)]
-inputOptions
-=[Option"t"[a_trace](OptArgtrc"LEVEL")"trace level (0-4), default 1"
-,Option"p"[a_proxy](ReqArg(atta_proxy)"PROXY")"proxy for http access (e.g. \"www-cache:3128\")"
-,Option""[a_use_curl](NoArg(atta_use_curlv_1))"HTTP access via external program \"curl\", more functionality, supports HTTP/1.0, less efficient"
-,Option""[a_do_not_use_curl](NoArg(atta_use_curlv_0))"HTTP access via built in HTTP/1.1 module (default)"
-,Option""[a_options_curl](ReqArg(atta_options_curl)"STR")"additional curl options, e.g. for timeout, ..."
-,Option""[a_default_baseuri](ReqArg(atttransferURI)"URI")"default base URI, default: \"file:///<cwd>/\""
-,Option"e"[a_encoding](ReqArg(atta_encoding)"CHARSET")("default document encoding ("++utf8++", "++isoLatin1++", "++usAscii++", ...)")
-,Option""[a_issue_errors](NoArg(atta_issue_errorsv_1))"issue all errorr messages on stderr (default)"
-,Option""[a_do_not_issue_errors](NoArg(atta_issue_errorsv_0))"ignore all error messages"
-,Option"H"[a_parse_html](NoArg(atta_parse_htmlv_1))"parse input as HTML, try to interprete everything as HTML, no validation"
-,Option"M"[a_parse_by_mimetype](NoArg(atta_parse_by_mimetypev_1))"parse dependent on mime type: text/html as HTML, text/xml and text/xhtml as XML, else no parse"
-,Option"T"[a_tagsoup](NoArg(atta_tagsoupv_1))"lasy tagsoup parser, for HTML and XML, no DTD, no validation, no PIs, only XHTML entityrefs"
-,Option""[a_issue_warnings](NoArg(atta_issue_warningsv_1))"issue warnings, when parsing HTML (default)"
-,Option"Q"[a_do_not_issue_warnings](NoArg(atta_issue_warningsv_0))"ignore warnings, when parsing HTML"
-,Option""[a_parse_xml](NoArg(atta_parse_htmlv_0))"parse input as XML (default)"
-,Option""[a_validate](NoArg(atta_validatev_1))"document validation when parsing XML (default)"
-,Option"w"[a_do_not_validate](NoArg(atta_validatev_0))"only wellformed check, no validation"
-,Option""[a_canonicalize](NoArg(atta_canonicalizev_1))"canonicalize document, remove DTD, comment, transform CDATA, CharRef's, ... (default)"
-,Option"c"[a_do_not_canonicalize](NoArg(atta_canonicalizev_0))"do not canonicalize document, don't remove DTD, comment, don't transform CDATA, CharRef's, ..."
-,Option"C"[a_preserve_comment](NoArg(atta_preserve_commentv_1))"don't remove comments during canonicalisation"
-,Option""[a_do_not_preserve_comment](NoArg(atta_preserve_commentv_0))"remove comments during canonicalisation (default)"
-,Option"n"[a_check_namespaces](NoArg(atta_check_namespacesv_1))"tag tree with namespace information and check namespaces"
-,Option""[a_do_not_check_namespaces](NoArg(atta_check_namespacesv_0))"ignore namespaces (default)"
-,Option"r"[a_remove_whitespace](NoArg(atta_remove_whitespacev_1))"remove redundant whitespace, simplifies tree and processing"
-,Option""[a_do_not_remove_whitespace](NoArg(atta_remove_whitespacev_0))"don't remove redundant whitespace (default)"
-]
-where
-attnv=(n,v)
-trc=atta_trace.show.max0.min9.(read::String->Int).('0':).filter(`elem`"0123456789").fromMaybev_1
-
-
--- | available Relax NG validation options
---
--- defines options
--- 'a_check_restrictions', 'a_validate_externalRef', 'a_validate_include', 'a_do_not_check_restrictions',
--- 'a_do_not_validate_externalRef', 'a_do_not_validate_include'
-
-relaxOptions::[OptDescr(String,String)]
-relaxOptions
-=[Option"X"[a_relax_schema](ReqArg(atta_relax_schema)"SCHEMA")"validation with Relax NG, SCHEMA is the URI for the Relax NG schema"
-,Option""[a_check_restrictions](NoArg(a_check_restrictions,v_1))"check Relax NG schema restrictions during schema simplification (default)"
-,Option""[a_do_not_check_restrictions](NoArg(a_check_restrictions,v_0))"do not check Relax NG schema restrictions"
-,Option""[a_validate_externalRef](NoArg(a_validate_externalRef,v_1))"validate a Relax NG schema referenced by a externalRef-Pattern (default)"
-,Option""[a_do_not_validate_externalRef](NoArg(a_validate_externalRef,v_0))"do not validate a Relax NG schema referenced by an externalRef-Pattern"
-,Option""[a_validate_include](NoArg(a_validate_include,v_1))"validate a Relax NG schema referenced by an include-Pattern (default)"
-,Option""[a_do_not_validate_include](NoArg(a_validate_include,v_0))"do not validate a Relax NG schema referenced by an include-Pattern"
-{-
- , Option "" [a_output_changes] (NoArg (a_output_changes, v_1)) "output Pattern transformations in case of an error"
- , Option "" [a_do_not_collect_errors] (NoArg (a_do_not_collect_errors, v_1)) "stop Relax NG simplification after the first error has occurred"
- -}
-]
-where
-attnv=(n,v)
-
--- |
--- commonly useful options for XML output
---
--- defines options: 'a_indent', 'a_output_encoding', 'a_output_file', 'a_output_html'
-
-outputOptions::[OptDescr(String,String)]
-outputOptions
-=[Option"i"[a_indent](NoArg(atta_indentv_1))"indent XML output for readability"
-,Option"o"[a_output_encoding](ReqArg(atta_output_encoding)"CHARSET")("encoding of output ("++utf8++", "++isoLatin1++", "++usAscii++")")
-,Option"f"[a_output_file](ReqArg(atta_output_file)"FILE")"output file for resulting document (default: stdout)"
-,Option""[a_output_html](NoArg(atta_output_htmlv_1))"output of none ASCII chars as HTMl entity references"
-,Option""[a_no_xml_pi](NoArg(atta_no_xml_piv_1))("output without <?xml ...?> processing instruction, useful in combination with --"++showa_output_html)
-]
-where
-attnv=(n,v)
-
--- |
--- commonly useful options
---
--- defines options: 'a_verbose', 'a_help'
-
-generalOptions::[OptDescr(String,String)]
-generalOptions
-=[Option"v"[a_verbose](NoArg(a_verbose,v_1))"verbose output"
-,Option"h?"[a_help](NoArg(a_help,v_1))"this message"
-]
-
--- |
--- defines 'a_version' option
-
-versionOptions::[OptDescr(String,String)]
-versionOptions
-=[Option"V"[a_version](NoArg(a_version,v_1))"show program version"
-]
-
--- |
--- debug output options
-
-showOptions::[OptDescr(String,String)]
-showOptions
-=[Option""[a_show_tree](NoArg(a_show_tree,v_1))"output tree representation instead of document source"
-,Option""[a_show_haskell](NoArg(a_show_haskell,v_1))"output internal Haskell representation instead of document source"
-]
-
--- ------------------------------------------------------------
-
--- |
--- select options from a predefined list of option desciptions
-
-selectOptions::[String]->[OptDescr(String,String)]->[OptDescr(String,String)]
-selectOptionsolos
-=concat.map(\on->filter(\(Option_ons__)->on`elem`ons)os)$ol
+,isTrueValue
+)
+where
+
+importText.XML.HXT.DOM.XmlKeywords
+importText.XML.HXT.DOM.TypeDefs
+
+importData.Maybe
+
+importSystem.Console.GetOpt
+
+-- ------------------------------------------------------------
+--
+
+-- |
+-- commonly useful options for XML input
+--
+-- can be used for option definition with haskell getopt
+--
+-- defines options: 'a_trace', 'a_proxy', 'a_use_curl', 'a_do_not_use_curl', 'a_options_curl', 'a_encoding',
+-- 'a_issue_errors', 'a_do_not_issue_errors', 'a_parse_html', 'a_parse_by_mimetype', 'a_tagsoup' 'a_issue_warnings', 'a_do_not_issue_warnings',
+-- 'a_parse_xml', 'a_validate', 'a_do_not_validate', 'a_canonicalize', 'a_do_not_canonicalize',
+--- 'a_preserve_comment', 'a_do_not_preserve_comment', 'a_check_namespaces', 'a_do_not_check_namespaces',
+-- 'a_remove_whitespace', 'a_do_not_remove_whitespace'
+
+inputOptions::[OptDescr(String,String)]
+inputOptions
+=[Option"t"[a_trace](OptArgtrc"LEVEL")"trace level (0-4), default 1"
+,Option"p"[a_proxy](ReqArg(atta_proxy)"PROXY")"proxy for http access (e.g. \"www-cache:3128\")"
+,Option""[a_use_curl](NoArg(atta_use_curlv_1))"obsolete, since hxt-8.1 HTTP access is always done with curl bindings"
+,Option""[a_do_not_use_curl](NoArg(atta_use_curlv_0))"obsolete, since hxt-8.1 HTTP access is always done with curl bindings"
+,Option""[a_options_curl](ReqArg(atta_options_curl)"STR")"additional curl options, e.g. for timeout, ..."
+,Option""[a_default_baseuri](ReqArg(atttransferURI)"URI")"default base URI, default: \"file:///<cwd>/\""
+,Option"e"[a_encoding](ReqArg(atta_encoding)"CHARSET")("default document encoding ("++utf8++", "++isoLatin1++", "++usAscii++", ...)")
+,Option""[a_mime_types](ReqArg(atta_mime_types)"FILE")"set mime type configuration file, e.g. \"/etc/mime.types\""
+,Option""[a_issue_errors](NoArg(atta_issue_errorsv_1))"issue all errorr messages on stderr (default)"
+,Option""[a_do_not_issue_errors](NoArg(atta_issue_errorsv_0))"ignore all error messages"
+,Option""[a_ignore_encoding_errors](NoArg(atta_ignore_encoding_errorsv_1))"ignore encoding errors"
+,Option""[a_ignore_none_xml_contents](NoArg(atta_ignore_none_xml_contentsv_1))"discards all contents of none XML/HTML documents, only the meta info remains stays in the doc tree"
+,Option"H"[a_parse_html](NoArg(atta_parse_htmlv_1))"parse input as HTML, try to interprete everything as HTML, no validation"
+,Option"M"[a_parse_by_mimetype](NoArg(atta_parse_by_mimetypev_1))"parse dependent on mime type: text/html as HTML, text/xml and text/xhtml and others as XML, else no parse"
+,Option""[a_parse_xml](NoArg(atta_parse_htmlv_0))"parse input as XML, (default)"
+,Option"T"[a_tagsoup](NoArg(atta_tagsoupv_1))"lasy tagsoup parser, for HTML and XML, no DTD, no validation, no PIs, only XHTML entityrefs"
+,Option""[a_issue_warnings](NoArg(atta_issue_warningsv_1))"issue warnings, when parsing HTML (default)"
+,Option"Q"[a_do_not_issue_warnings](NoArg(atta_issue_warningsv_0))"ignore warnings, when parsing HTML"
+,Option""[a_validate](NoArg(atta_validatev_1))"document validation when parsing XML (default)"
+,Option"w"[a_do_not_validate](NoArg(atta_validatev_0))"only wellformed check, no validation"
+,Option""[a_canonicalize](NoArg(atta_canonicalizev_1))"canonicalize document, remove DTD, comment, transform CDATA, CharRef's, ... (default)"
+,Option"c"[a_do_not_canonicalize](NoArg(atta_canonicalizev_0))"do not canonicalize document, don't remove DTD, comment, don't transform CDATA, CharRef's, ..."
+,Option"C"[a_preserve_comment](NoArg(atta_preserve_commentv_1))"don't remove comments during canonicalisation"
+,Option""[a_do_not_preserve_comment](NoArg(atta_preserve_commentv_0))"remove comments during canonicalisation (default)"
+,Option"n"[a_check_namespaces](NoArg(atta_check_namespacesv_1))"tag tree with namespace information and check namespaces"
+,Option""[a_do_not_check_namespaces](NoArg(atta_check_namespacesv_0))"ignore namespaces (default)"
+,Option"r"[a_remove_whitespace](NoArg(atta_remove_whitespacev_1))"remove redundant whitespace, simplifies tree and processing"
+,Option""[a_do_not_remove_whitespace](NoArg(atta_remove_whitespacev_0))"don't remove redundant whitespace (default)"
+]
+where
+attnv=(n,v)
+trc=atta_trace.show.max0.min9.(read::String->Int).('0':).filter(`elem`"0123456789").fromMaybev_1
+
+
+-- | available Relax NG validation options
+--
+-- defines options
+-- 'a_check_restrictions', 'a_validate_externalRef', 'a_validate_include', 'a_do_not_check_restrictions',
+-- 'a_do_not_validate_externalRef', 'a_do_not_validate_include'
+
+relaxOptions::[OptDescr(String,String)]
+relaxOptions
+=[Option"X"[a_relax_schema](ReqArg(atta_relax_schema)"SCHEMA")"validation with Relax NG, SCHEMA is the URI for the Relax NG schema"
+,Option""[a_check_restrictions](NoArg(a_check_restrictions,v_1))"check Relax NG schema restrictions during schema simplification (default)"
+,Option""[a_do_not_check_restrictions](NoArg(a_check_restrictions,v_0))"do not check Relax NG schema restrictions"
+,Option""[a_validate_externalRef](NoArg(a_validate_externalRef,v_1))"validate a Relax NG schema referenced by a externalRef-Pattern (default)"
+,Option""[a_do_not_validate_externalRef](NoArg(a_validate_externalRef,v_0))"do not validate a Relax NG schema referenced by an externalRef-Pattern"
+,Option""[a_validate_include](NoArg(a_validate_include,v_1))"validate a Relax NG schema referenced by an include-Pattern (default)"
+,Option""[a_do_not_validate_include](NoArg(a_validate_include,v_0))"do not validate a Relax NG schema referenced by an include-Pattern"
+{-
+ , Option "" [a_output_changes] (NoArg (a_output_changes, v_1)) "output Pattern transformations in case of an error"
+ , Option "" [a_do_not_collect_errors] (NoArg (a_do_not_collect_errors, v_1)) "stop Relax NG simplification after the first error has occurred"
+ -}
+]
+where
+attnv=(n,v)
+
+-- |
+-- commonly useful options for XML output
+--
+-- defines options: 'a_indent', 'a_output_encoding', 'a_output_file', 'a_output_html'
+
+outputOptions::[OptDescr(String,String)]
+outputOptions
+=[Option"i"[a_indent](NoArg(atta_indentv_1))"indent XML output for readability"
+,Option"o"[a_output_encoding](ReqArg(atta_output_encoding)"CHARSET")("encoding of output ("++utf8++", "++isoLatin1++", "++usAscii++")")
+,Option"f"[a_output_file](ReqArg(atta_output_file)"FILE")"output file for resulting document (default: stdout)"
+,Option""[a_output_html](NoArg(atta_output_htmlv_1))"output of none ASCII chars as HTMl entity references"
+,Option""[a_no_xml_pi](NoArg(atta_no_xml_piv_1))("output without <?xml ...?> processing instruction, useful in combination with --"++showa_output_html)
+]
+where
+attnv=(n,v)
+
+-- |
+-- commonly useful options
+--
+-- defines options: 'a_verbose', 'a_help'
+
+generalOptions::[OptDescr(String,String)]
+generalOptions
+=[Option"v"[a_verbose](NoArg(a_verbose,v_1))"verbose output"
+,Option"h?"[a_help](NoArg(a_help,v_1))"this message"
+]
+
+-- |
+-- defines 'a_version' option
+
+versionOptions::[OptDescr(String,String)]
+versionOptions
+=[Option"V"[a_version](NoArg(a_version,v_1))"show program version"
+]
+
+-- |
+-- debug output options
+
+showOptions::[OptDescr(String,String)]
+showOptions
+=[Option""[a_show_tree](NoArg(a_show_tree,v_1))"output tree representation instead of document source"
+,Option""[a_show_haskell](NoArg(a_show_haskell,v_1))"output internal Haskell representation instead of document source"
+]
+
+-- ------------------------------------------------------------
+
+-- |
+-- select options from a predefined list of option desciptions
-removeOptions::[String]->[OptDescr(String,String)]->[OptDescr(String,String)]
-removeOptionsolos
-=filter(\(Option_ons__)->not.any(`elem`ol)$ons)os
+selectOptions::[String]->[OptDescr(String,String)]->[OptDescr(String,String)]
+selectOptionsolos
+=concat.map(\on->filter(\(Option_ons__)->on`elem`ons)os)$ol
--- |
--- check whether an option is set
---
--- reads the value of an attribute, usually applied to a document root node,
--- and checks if the value represents True. The following strings are interpreted
--- as true: \"1\", \"True\", \"true\", \"yes\", \"Yes\".
-
-optionIsSet::String->Attributes->Bool
-optionIsSetn
-=(`elem`["1","True","true","Yes","yes"]).lookupDef""n
+removeOptions::[String]->[OptDescr(String,String)]->[OptDescr(String,String)]
+removeOptionsolos
+=filter(\(Option_ons__)->not.any(`elem`ol)$ons)os
+
+-- |
+-- check whether an option is set
+--
+-- reads the value of an attribute, usually applied to a document root node,
+-- and checks if the value represents True. The following strings are interpreted
+-- as true: \"1\", \"True\", \"true\", \"yes\", \"Yes\".
--- ------------------------------------------------------------
+optionIsSet::String->Attributes->Bool
+optionIsSetn=isTrueValue.lookupDef""n
+
+-- | check whether a string represents True
+--
+-- definition:
+--
+-- > isTrueValue = (`elem` ["1", "True", "true", "Yes", "yes"])
+
+isTrueValue::String->Bool
+isTrueValue=(`elem`["1","True","true","Yes","yes"])
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-DOM-XmlState.html b/doc/hdoc/src/Text-XML-HXT-DOM-XmlState.html
deleted file mode 100644
--- a/doc/hdoc/src/Text-XML-HXT-DOM-XmlState.html
+++ /dev/null
@@ -1,699 +0,0 @@
-
-
-
-
-Haskell Code by HsColour
-
-
-
-
-- |
--- 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.
---
--- Version : $Id: XmlState.hs,v 1.3 2005/05/27 13:15:23 hxml Exp $
-
-moduleText.XML.HXT.DOM.XmlState
-(moduleText.XML.HXT.DOM.XmlState
-)
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importqualifiedControl.Monad.MonadStateIOasMonadStateIO
-
-importSystem.IO
-importData.Maybe
-
--- ------------------------------------------------------------
-
--- |
--- 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
-
-dataSysState=SysState{sysStateAttrs::!SysStateAttrs
-,sysStateErrorHandler::!(XmlStateFilter())
-}
-
-typeSysStateAttrs=AssocListStringXmlTrees
-
--- |
--- The State has a system and a user part
--- the user state is a type parameter
-
-dataXmlStatestate=XmlState{sysState::!SysState
-,userState::!state
-}
-
--- |
--- The monad type for commands. It is an instance of "StateIO" from the
--- general module "Control.Monad.MonadStateIO".
-
-typeXStatestateres=MonadStateIO.StateIO(XmlStatestate)res
-
--- |
--- The "XmlFilter" type for filters working on a state
-
-typeXmlStateFilterstate=XmlTree->XStatestateXmlTrees
-
--- ------------------------------------------------------------
---
--- user defined state
--- access functions
-
--- |
--- change the user state
---
--- * 1.parameter fct : the user state change function
---
--- - returns : the new state
-
-changeState::(state->state)->XStatestatestate
-changeStatef
-=do
-ns<-MonadStateIO.changeStatef'
-return(userStatens)
-where
-f's=s{userState=f(userStates)}
-
--- |
--- set the user state.
---
--- * 1.parameter s : the new state
---
--- - returns : the new state
-
-setState::state->XStatestatestate
-setStates
-=changeState(\_->s)
-
--- |
--- read the user state
---
--- - returns : the current state
-
-getState::XStatestatestate
-getState
-=changeStateid
-
--- ------------------------------------------------------------
-
--- |
--- change the system part of the state.
---
--- see also : 'changeState'
-
-changeSysState::(SysState->SysState)->XStatestateSysState
-changeSysStatef
-=do
-ns<-MonadStateIO.changeStatef'
-return(sysStatens)
-where
-f's=s{sysState=f(sysStates)}
-
--- |
--- set the system part of the state.
---
--- see also : 'setState'
-
-setSysState::SysState->XStatestateSysState
-setSysStates
-=changeSysState(\_->s)
-
--- |
--- read the system part of the state.
---
--- see also : 'getState'
-
-getSysState::XStatestateSysState
-getSysState
-=changeSysStateid
-
--- |
--- the initial system state
---
--- an empty list of attribute value pairs
-
-initialSysState::SysState
-initialSysState
-=SysState{sysStateAttrs=[]
-,sysStateErrorHandler=errorMsgToStderr
-}
-
--- |
--- change the attributes in the system state
-
-changeSysStateAttrs::(SysStateAttrs->SysStateAttrs)->(SysState->SysState)
-changeSysStateAttrscfsstate
-=sstate{sysStateAttrs=cf(sysStateAttrssstate)}
-
-
--- |
--- set the error message handler
-
-setSysErrorHandler::XmlStateFilter()->XStatestate()
-setSysErrorHandlerehf
-=do
-changeSysState(\s->s{sysStateErrorHandler=ehf})
-return()
-
--- |
--- get the error handler
-
-getSysErrorHandler::XStatestate(XmlStateFilter())
-getSysErrorHandler
-=do
-s<-getSysState
-return(sysStateErrorHandlers)
-
--- ------------------------------------------------------------
-
--- |
--- 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'
-
-setSysParamTree::String->XmlTrees->XStatestate()
-setSysParamTreenameval
-=do
-changeSysState(changeSysStateAttrs(addEntrynameval))
-return()
-
--- |
--- 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
-
-setSysParam::String->String->XStatestate()
-setSysParamnameval
-=setSysParamTreename(xtextval)
-
--- |
--- set or change a single integer type system parameter
---
--- see also : 'setSysParam'
-
-setSysParamInt::String->Int->XStatestate()
-setSysParamIntnameval=setSysParamname(showval)
-
--- |
--- add (or change) all attributes of the document root to the system state
--- - returns : this
-
-setSystemParams::XmlStateFilterstate
-setSystemParamst
-=do
-changeSysState(changeSysStateAttrs(addEntries(toTreel.getAttrl$t)))
-thisMt
-
--- ------------------------------------------------------------
-
--- |
--- 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
-
-getSysParamTree::String->XStatestateXmlTrees
-getSysParamTreename
-=do
-s<-getSysState
-return(lookup1name(sysStateAttrss))
-
--- |
--- read a system string parameter
---
--- * 1.parameter name : the name of the parameter
---
--- - returns : the value, or the empty string for unknown parameters
-
-getSysParam::String->XStatestateString
-getSysParamname
-=do
-ts<-getSysParamTreename
-return(xshowts)
-
--- |
--- 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
-
-getSysParamWithDefault::String->String->XStatestateString
-getSysParamWithDefaultnamedef
-=do
-val<-getSysParamname
-return(ifnullval
-thendef
-elseval
-)
-
--- |
--- read an integer system parameter
---
--- * 1.parameter name :
---
--- - 2.parameter default :
---
--- see also : 'getSysParamWithDefault'
-
-getSysParamInt::String->Int->XStatestateInt
-getSysParamIntvardef
-=do
-val<-getSysParamWithDefaultvar(showdef)
-return(readval)
-
--- ------------------------------------------------------------
-
--- |
--- 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
-
-run0::XmlStatestate->XStatestateres->IO(res,XmlStatestate)
-run0initialState(MonadStateIO.STIOcmd)
-=do
-(res,finalState)<-cmdinitialState
-return(res,finalState)
-
--- |
--- exec a XState command with initial user state.
--- ignore final user state.
--- like run0, but ignore the resulting user state
-
-run::state->XStatestateres->IOres
-runinitialUserStatecmd
-=do
-(res,_finalState)<-run0(XmlStateinitialSysStateinitialUserState)cmd
-returnres
-
--- |
--- exec a XState command in th IO monad.
--- like run with the empty state ().
-
-run'::XState()res->IOres
-run'=run()
-
--- ------------------------------------------------------------
-
--- |
--- 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->XStatestate1res->XStatestate0(res,state1)
-chain'initialUserState1cmd1
-=do
-sysState0<-getSysState
-(res,finalState1)<-io$run0(XmlStatesysState0initialUserState1)cmd1
-setSysState(sysStatefinalState1)
-return(res,(userStatefinalState1))
-
--- |
--- 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
-
-chain::state1->XStatestate1res->XStatestate0res
-chaininitialUserState1cmd1
-=do
-(res,_)<-chain'initialUserState1cmd1
-returnres
-
--- ------------------------------------------------------------
---
--- lift functions
-
--- |
--- 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
-
-liftF::XmlFilter->XmlStateFilterstate
-liftFf=liftMff.>>issueError
-
--- |
--- lift an I\/O command
---
--- * 1.parameter cmd : the i\/o command
---
--- - returns : the i\/o command lifted to the XML state monad
-
-io::IOa->XStatestatea
-io=MonadStateIO.io
-
--- ------------------------------------------------------------
---
-
--- |
--- 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
-
-setTraceLevel::Int->XStatestate()
-setTraceLevell=setSysParamInta_tracel
-
--- |
--- get the current trace level.
---
--- - returns : the current trace level
-
-getTraceLevel::XStatestateInt
-getTraceLevel=getSysParamInta_trace0
-
--- |
--- 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
-
-traceCmd::Int->XStatestatea->XStatestate()
-traceCmdlevelcmd
-=do
-trcLevel<-getTraceLevel
-iflevel<=trcLevel
-thendo
-_<-cmd
-return()
-elsereturn()
-
--- |
--- trace output function for simple text.
---
--- * 1.parameter level : like in traceCmd
---
--- - 2.parameter str : the test
---
--- - returns : nothing
-
-trace::Int->String->XStatestate()
-tracelevelstr
-=traceCmdlevel
-$do
-io$hPutStrLnstderr("-- ("++showlevel++") "++str)
-
--- |
--- trace output of the user part of the program state.
---
--- * 1.parameter level : like in traceCmd
---
--- - 2.parameter showFct : the toString function
---
--- - returns : nothing
-
-traceState::Int->(state->String)->XStatestate()
-traceStatelevelfct
-=traceCmdlevel
-$do
-s<-getState
-io$hPutStrLnstderr(fcts)
-
--- ------------------------------------------------------------
---
--- error functions
-
--- |
--- filter to reset the state attribute 'a_status'
--- - returns : this
-
-clearStatus::XmlStateFilterstate
-clearStatust
-=do
-setSysParamInta_statusc_ok
-thisMt
-
--- |
--- 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'
-
-issueError::XmlStateFilterstate
-issueError
-=(setErrorMsgLevel.>>errorMsgHandler.>>noneM)
-`whenM`
-isXError
-
-errorMsgHandler::XmlStateFilterstate
-errorMsgHandler
-=performAction
-(\t->chain'()(do
-ehf<-getSysErrorHandler
-ehft
-return()
-)
-)
-
--- |
--- set the error level in system state
-
-setErrorMsgLevel::XmlStateFilterstate
-setErrorMsgLevel
-=performAction
-(\(NTree(XErrorlevel_str)_cs)->
-do
-errLevel<-getSysParamInta_status0
-setSysParamInta_status(maxerrLevellevel)
-)
-
--- |
--- default error handler for writing errors to stderr
-
-errorMsgToStderr::XmlStateFilterstate
-errorMsgToStderr
-=performAction
-(\(NTree(XErrorlevelstr)_cs)->
-io$hPutStrLnstderr("\n"++errClasslevel++": "++str)
-)
-
--- |
--- 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
-
-errorMsgLogging::XmlStateFilterstate
-errorMsgLogging
-=performAction
-(\t->
-do
-errLog<-getSysParamTreea_error_log
-setSysParamTreea_error_log(t:errLog)
-)
-
-errorMsgLoggingAndToStderr::XmlStateFilterstate
-errorMsgLoggingAndToStderr=errorMsgLogging.>>errorMsgToStderr
-
--- |
--- the filter for reading all collected error mesages
---
--- result is the list of error messages, the input tree is ignored
-
-getErrorMsg::XmlStateFilterstate
-getErrorMsg_t
-=do
-el<-getSysParamTreea_error_log
-setSysParamTreea_error_log[]
-return(reverseel)
-
--- |
--- 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, ...)
-
-errClass::Int->String
-errClassl
-=fromMaybe"fatal error".lookupl$msgList
-where
-msgList=[(c_ok,"no error")
-,(c_warn,"warning")
-,(c_err,"error")
-,(c_fatal,"fatal error")
-]
-
--- |
--- short cut for issuing a warning
---
--- see also : 'issueError', 'issueErr'
-
-issueWarn::String->XmlStateFilterstate
-issueWarnmsg=liftMf(warnmsg).>>issueError
-
--- |
--- short cut for issuing an error
---
--- see also : 'issueError'
-
-issueErr::String->XmlStateFilterstate
-issueErrmsg=liftMf(errmsg).>>issueError
-
--- |
--- short cut for issuing a fatal error
---
--- see also : 'issueError', 'issueErr'
-
-issueFatal::String->XmlStateFilterstate
-issueFatalmsg=liftMf(fatalmsg).>>issueError
-
-
--- ------------------------------------------------------------
---
--- issue an error, add the error to the document root tree
--- and return the tree
-
-addFatal::String->XmlStateFilterstate
-addFatalmsg
-=liftF(fatalmsg
-+++
-setStatusc_fatal"accessing documents"
-)
-
--- ------------------------------------------------------------
-
--- |
--- 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
-
-checkStatus::XmlStateFilterstate
-checkStatust
-=ifstatus>=c_err
-thendo
-errorMsgHandler(mkXErrorTreec_warn(errClassstatus++"s detected in "++msg)[])
-noneMt
-else
-thisMt
-where
-status=intValueOfa_statust
-msg=valueOfa_modulet
-
--- |
--- 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'
-
-setStatus::Int->String->XmlFilter
-setStatuslevelmsg
-=(addAttrInta_statuslevel
-.>
-addAttra_modulemsg
-.>
-(iflevel>=c_err
-thenreplaceChildren[]
-elsethis
-)
-)
-`when`isRoot
-
--- |
--- check whether tree is a document root and the status attribute has a value less than 'c_err'
-
-statusOk::XmlFilter
-statusOk
-=isRoot
-.>
-isOf(\t->not(intValueOfa_statust>=c_err))
--- |
--- 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
-
-checkResult::String->XmlStateFilterstate
-checkResultmsgt
-=do
-level<-getSysParamInta_status0
-(iflevel<=c_warn
-thenthisM
-elseliftMf(setStatuslevelmsg)
-)t
-
--- |
--- monadic filter for processing the attribute list of a tag.
--- for other trees this filter acts like 'noneM'
---
--- see also : 'processAttr', 'processAttrl'
-
-processAttrM::XmlStateFiltera->XmlStateFiltera
-processAttrMft
-=do
-res<-f$$<al
-return$replaceAttrlrest
-where
-al=getAttrlt
-
--- ------------------------------------------------------------
-
-- ------------------------------------------------------------
---
--- defaut uri computation
--- this routine is platform dependent
--- and must be exchanged when porting the toolbox e.g. to windows
---
--- Version : $Id: DefaultURI.hs,v 1.4 2006/03/02 10:13:57 hxml Exp $
-
-moduleText.XML.HXT.Parser.DefaultURI
-(setDefaultURI
-)
-
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.DOM.XmlState
-
-importSystem.Directory
-(getCurrentDirectory
-)
-
-importNetwork.URI
-(escapeURIChar
-,isUnescapedInURI
-)
-
-setDefaultURI::XStatestate()
-setDefaultURI
-=do
-wd<-iogetCurrentDirectory
-setSysParamtransferDefaultURI("file://"++normalizewd++"/")
-
-where
-
--- under Windows getCurrentDirectory returns something like: "c:\path\to\file"
--- backslaches are not allowed in URIs and paths must start with a /
--- so this is transformed into "/c:/path/to/file"
-
-normalizewd'@(d:':':_)
-|d`elem`['A'..'Z']||d`elem`['a'..'z']
-='/':concatMapwin32ToUriCharwd'
-normalizewd'
-=concatMapescapeNonUriCharwd'
-
-win32ToUriChar'\\'="/"
-win32ToUriCharc=escapeNonUriCharc
-
-escapeNonUriCharc=escapeURICharisUnescapedInURIc-- from Network.URI
-
-- ------------------------------------------------------------
-
-{- |
- Module : Text.XML.HXT.Parser.HtmlParser
- Copyright : Copyright (C) 2005 Uwe Schmidt
- License : MIT
-
- Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
- Stability : stable
- Portability: portable
-
- This parser tries to interprete everything as HTML
- no errors are emitted during parsing. If something looks
- weired, warning messages are inserted in the document tree.
-
- Module contains state filter for easy parsing and error handling
- real work is done in 'Text.XML.HXT.Parser.HtmlParsec'
-
--}
-
--- ------------------------------------------------------------
-
-moduleText.XML.HXT.Parser.HtmlParser
-(getHtmlDoc
-,parseHtmlDoc
-,runHtmlParser
-,substHtmlEntities
-,moduleText.XML.HXT.Parser.HtmlParsec
-)
-
-where
-
-importText.XML.HXT.DOM.XmlTree
-importText.XML.HXT.DOM.XmlState
-importText.XML.HXT.Parser.HtmlParsec
-
-importText.XML.HXT.Parser.XmlInput
-(getXmlContents
-)
-
-importText.XML.HXT.Parser.XmlOutput
-(traceTree
-,traceSource
-,traceMsg
-)
-
-importText.XML.HXT.Parser.XhtmlEntities
-(xhtmlEntities
-)
-
--- ------------------------------------------------------------
-
--- |
--- read a document and parse it with 'parseHtmlDoc'. The main entry point of this module
---
--- The input tree must be a root tree like in ' Text.XML.HXT.Parser.MainFunctions.getXmlDoc'. The content is read with 'Text.XML.HXT.Parser.XmlInput.getXmlContents',
--- is parsed with 'parseHtmlDoc' and canonicalized (char refs are substituted in content and attributes,
--- but comment is preserved)
---
--- see also : 'Text.XML.HXT.Parser.DTDProcessing.getWellformedDoc'
-
-getHtmlDoc::XmlStateFilterstate
-getHtmlDoc
-=setSystemParams
-.>>
-getXmlContents
-.>>
-parseHtmlDoc
-
--- | The HTML parsing filter
---
--- The input is parsed with 'runHtmlParser', everything is interpreted as HTML,
--- if errors ocuur, the parser will try to do some meaningfull action and continues
--- parsing. Afterwards the entitiy references for defined for XHTML are resovled,
--- any unresolved reference is transformed into plain text.
---
--- Error messages
--- during parsing and entity resolving are added as warning nodes into the resulting tree.
---
--- The warnings are issued, if the 1. parameter noWarnings is set to True,
--- afterwards all are removed from the resulting tree.
-
-parseHtmlDoc::XmlStateFiltera
-parseHtmlDoc
-=parseDoc
-`whenM`(isRoot.>getChildren.>isXText)
-where
-parseDoct'
-=(traceMsg2("parseHtmlDoc: parse HTML document "++showloc)
-.>>
-runHtmlParser
-.>>
-liftMf(processTopDownsubstHtmlEntities)
-.>>
-removeWarnings
-.>>
-traceTree
-.>>
-traceSource
-)$t'
-where
-loc=valueOfa_sourcet'-- get document source uri
-
-removeWarnings::XmlStateFiltera
-removeWarningst'
-=let
-noWarnings=not(satisfies(hasOptiona_issue_warnings)t')
-selWarnings=deep
-(choice[isWarning:->this
-,isXTag:->(getAttrl.>selWarnings)
-]
-)
-remWarnings=processTopDown
-(choice[isWarning:->none
-,isXTag:->(processAttrl(remWarnings$$))
-,this:->this
-]
-)
-warnings=selWarningst'
-indo
-ifnullwarnings
-thenthisMt'
-elsedo
-ifnoWarnings
-thenreturn[]
-elsedo
-issueError$$<warnings
-return(remWarningst')
-
--- | The pure HTML parser, usually called via 'parseHtmlDoc'.
---
-
-runHtmlParser::XmlStateFiltera
-runHtmlParsert
-=ifnullerrs
-thendo
-return(replaceChildrenrest)
-elsedo
-issueError$$<errs
-return(setStatusc_err"parsing HTML"t)
-where
-res=getChildren.>parseHtmlTextloc$t
-errs=isXError.>negisWarning$$res
-loc=valueOfa_sourcet
-
-
--- ------------------------------------------------------------
---
--- XHTML entities
-
-substHtmlEntities::XmlTree->XmlTrees
-substHtmlEntities
-=choice[isXEntityRef:->substEntity
-,isXTag:->processAttr(processChildrensubstHtmlEntities)
-,this:->this
-]
-where
-substEntityt'@(NTree(XEntityRefen)_)
-=case(lookupenxhtmlEntities)of
-Justi
-->[mkXCharRefTreei]
-Nothing
-->xwarn("no XHTML entity found for reference: \"&"++en++";\"")
-++
-(xmlTreesToText[t'])
-
-substEntity_
-=error"substHtmlEntities: illegal argument"
-
--- ------------------------------------------------------------
-
-- |
--- Simple parse functions.
---
--- Version : $Id: MainFunctions.hs,v 1.2 2004/11/20 16:53:15 hxml Exp $
---
---
--- the main building blocks for an application.
--- this module exports complex filters and functions for
--- common tasks for input and parsing, output and option handling.
---
-
-moduleText.XML.HXT.Parser.MainFunctions
-(getXmlDocument
-,putXmlDocument
-
-,parseDocument
-,writeDocument
-)
-where
-
-importText.XML.HXT.DOM.XmlTree
-importText.XML.HXT.DOM.XmlState
-importText.XML.HXT.Parser.HtmlParser
-importText.XML.HXT.Parser.XmlInput
-importText.XML.HXT.Parser.XmlOutput
-importText.XML.HXT.Parser.DTDProcessing
-importText.XML.HXT.Validator.Validation
-importText.XML.HXT.DOM.EditFilters
-importText.XML.HXT.DOM.Namespace
-
-importSystem.IO
-
--- ------------------------------------------------------------
-
--- |
--- convenient function for reading a XML document without
--- dealing with state monads, error messages collection and other details
---
--- getXmlDocument calls 'parseDocument' with the list of parsing options
--- and an url or filename as document source.
---
--- result is a triple
---
--- * the resulting document tree with a root node containing all
--- meta info about the document (options, status info, http header, ...)
---
--- - the list of errors and warnings
---
--- - the error level: one of 'c_ok', 'c_warn', 'c_err', 'c_fatal'
---
--- example for input (see also example in 'putXmlDocument' and example in 'writeDocument')
---
--- > main :: IO ()
--- > main
--- > = do
--- > (res, errs, rc) <- getXmlDocument [] "test.xml"
--- > if rc >= c_err
--- > then issueErrors errs
--- > else processTree res
--- >
--- > issueErrors :: XmlTrees -> IO ()
--- >
--- > processTree :: XmlTree -> IO ()
---
--- for options see 'parseDocument', 'a_collect_errors' is set implicitly
-
-getXmlDocument::Attributes->String->IO(XmlTree,XmlTrees,Int)
-getXmlDocumentoptionsurl
-=do
-letoptions'=[(a_collect_errors,v_1)-- collect errors
-,(a_issue_errors,v_0)-- but don't issue
-]-- can be overwritten by supporting other values in options
-++
-options
-++
-[(a_source,url)-- set the source url
-]
-res<-run'$parseDocumentoptions'emptyRoot
-letroot=headres
-leterrs=tailres
-letelvl=intValueOfa_statusroot
-return(root,errs,elvl)
-
-
--- |
--- the inverse operation to 'getXmlDocument'
---
--- writes a complete document tree to a file, writing can be
--- controlled by options, the real work is done with filter 'writeDocument'.
--- useful options are the options of 'writeDocument'.
---
--- result is a pair: 1.part is a list of error messages, 2. part is the return code,
--- the status info of the write filter
---
--- this filter is useful, when processing XML in an arbitray context in the IO monad
---
--- an example main program for such an application is:
---
--- > main :: IO ()
--- > main
--- > = do
--- > (input, readErrs, rc) <- getXmlDocument [...] "test.xml"
--- > if rc >= c_err
--- > then issueErrors readErrs
--- > else processTree input
--- >
--- > processTree :: XmlTree -> IO ()
--- > processTree t
--- > = let res = computeNewTree input
--- > in do
--- > (writeErrs, rc2) <- putXmlDocument [...] "out.xml" res
--- > if rc2 >= c_err
--- > then issueErrors writeErrs
--- > else return ()
--- >
--- > issueErrors :: XmlTrees -> IO ()
--- >
--- > computeNewTree :: XmlTree -> XmlTree
-
-
-putXmlDocument::Attributes->String->XmlTree->IO(XmlTrees,Int)
-putXmlDocumentoptionsfileNamet
-=do
-letoptions'=[(a_collect_errors,v_1)-- collect errors
-,(a_issue_errors,v_0)-- but don't issue
-]-- can be overwritten by supporting other values in options
-++
-options
-++
-[(a_output_file,fileName)-- set the source url
-]
-res<-run'$writeDocumentoptions't
-letroot=headres
-leterrs=tailres
-letelvl=intValueOfa_statusroot
-return(errs,elvl)
-
--- ------------------------------------------------------------
-
--- |
--- the main parsing filter
---
--- this filter can be configured by an option list, a list of
--- option name, option value pairs.
--- the input tree must be a possibly empty document root tree.
--- all the options are stored as attributes in this root node to control processing.
---
--- available options:
---
--- * 'a_parse_html': use HTML parser, else use XML parser (default)
---
--- - 'a_validate' : validate document (default), else skip validation
---
--- - 'a_check_namespaces' : check namespaces, else skip namespace processing (default)
---
--- - 'a_canonicalize' : canonicalize document (default), else skip canonicalization
---
--- - 'a_preserve_comment' : preserve comments during canonicalization, else remove comments (default)
---
--- - 'a_remove_whitespace' : remove all whitespace, used for document indentation, else skip this step (default)
---
--- - 'a_indent' : indent document by inserting whitespace, else skip this step (default)
---
--- - 'a_issue_warnings' : issue warnings, when parsing HTML (default), else ignore HTML parser warnings
---
--- - 'a_issue_errors' : issue all error messages on stderr (default), or ignore all error messages
---
--- - 'a_collect_errors' : all error messages are collected during processing and appended to the result document
--- for further processing within the calling modules
---
--- - 'a_trace' : trace level: values: 0 -4
---
--- - 'a_proxy' : proxy for http access, e.g. www-cache:3128
---
--- - 'a_use_curl' : for http access via external programm curl, default is native HTTP access
---
--- - 'a_options_curl' : more options for external program curl
---
--- - 'a_source' : the document source url
---
--- - 'a_encoding' : default document encoding ('utf8', 'isoLatin1', 'usAscii', ...)
---
--- examples:
---
--- > parseDocument [ (a_source, "test.xml")
--- > , (a_validate, "0")
--- > , (a_encoding, isoLatin1)
--- > ] emptyRoot
---
--- reads document \"test.xml\" without validation and default encoding 'isoLatin1'
---
--- > parseDocument [ (a_source, "http://www.haskell.org/")
--- > , (a_parse_html, "1")
--- > , (a_proxy, "www-cache:3128")
--- > , (a_curl, "1")
--- > , (a_issue_warnings, "0")
--- > ] emptyRoot
---
--- reads Haskell homepage with HTML parser ignoring any warnings and with http access via external program curl and proxy \"www-cache\" at port 3128
---
--- > parseDocument [ (a_source, "http://www.w3c.org/")
--- > , (a_parse_html, "0") -- default
--- > , (a_validate, "1") -- default
--- > , (a_check_namespace, "1")
--- > , (a_remove_whitespace, "1")
--- > , (a_trace, "2")
--- > ] emptyRoot
---
--- read w3c home page, validate and chech namespaces, remove whitespace between tags, trace activities with level 2
---
--- > parseDocument [ (a_source, "test.xml")
--- > , (a_validate, "1")
--- > , (a_check_namespace, "1")
--- > , (a_collect_errors, "1")
--- > , (a_issue_errors, "0")
--- > ] emptyRoot
---
--- reads file \"test.xml\", validates it, checks namespaces, does not issue any erros
--- but collects errors and appends the list of errors to the single element list for the document.
--- this enables the calling application to define own error handlers.
-
-parseDocument::Attributes->XmlStateFilterstate
-parseDocumentuserOptions
-=processDocumentuserOptionsdefaultOptions
-(traceMsg1"parseDocument: options added, start processing"
-.>>
-traceTree
-.>>
-getXmlContents-- get the content as text
-.>>
-choiceM-- select parser
-[hasOptiona_parse_html
-:->parseHtmlDoc-- parse everything as HTML
-,this
-:->checkWellformedDoc-- parse XML and process entities
-.>>
-(getValidatedDoc-- validate
-`whenM`
-hasOptiona_validate
-)
-]
-.>>
-(propagateAndValidateNamespaces-- namespace processing
-`whenM`
-hasOptiona_check_namespaces
-)
-.>>
-liftMf-- canonicalization
-(choice
-[hasOptiona_preserve_comment-- don't remove comments (in XPath required)
-:->canonicalizeForXPath
-,this
-:->canonicalizeAllNodes-- do normal canonicaliazion
-]
-`when`
-hasOptiona_canonicalize-- caconicalization can be switched off
-)
-.>>
-liftMf
-(removeDocWhiteSpace-- remove all whitespace between tags
-`when`
-hasOptiona_remove_whitespace
-)
-.>>
-traceMsg1"parseDocument: document processed"-- trace output
-.>>
-traceSource
-.>>
-traceTree
-)
-where
-defaultOptions
-=[(a_parse_html,v_0)
-,(a_validate,v_1)
-,(a_issue_errors,v_1)
-,(a_issue_warnings,v_1)
-,(a_check_namespaces,v_0)
-,(a_canonicalize,v_1)
-,(a_preserve_comment,v_0)
-,(a_remove_whitespace,v_0)
-]
-
--- ------------------------------------------------------------
-
-addOptions::Attributes->XmlFilter
-addOptions
-=seqF.map(\(n,v)->addAttrnv)
-
-addDefaultOptions::Attributes->XmlFilter
-addDefaultOptions
-=seqF.map(\(n,v)->addAttrnv`whenNot`hasAttrn)
-
--- ------------------------------------------------------------
-
--- |
--- the main filter for writing documents
---
--- this filter can be configured by an option list like 'getXmlDocument'
---
--- available options are
---
--- * 'a_indent' : indent document for readability, (default: no indentation)
---
--- - 'a_remove_whitespace' : remove all redundant whitespace for shorten text (default: no removal)
---
--- - 'a_output_file' : destination file for document, default is \"-\" for stdout
---
--- - 'a_output_encoding' : encoding of document, default is 'a_encoding' or 'utf8'
---
--- - 'a_output_xml' : (default) issue XML: quote special XML chars \>,\<,\",\',&
--- add XML processing instruction
--- and encode document with respect to 'a_output_encoding',
--- if explizitly switched of, the plain text is issued, this is useful
--- for non XML output, e.g. generated Haskell code, LaTex, Java, ...
---
--- - 'a_show_tree' : show tree representation of document (for debugging)
---
--- - 'a_show_haskell' : show Haskell representaion of document (for debugging)
---
--- - 'a_issue_errors', 'a_collect_errors' : see 'parseDocument'
---
--- a typical main program running in the XmlState monad
--- has the following structure:
---
--- >
--- > main :: IO ()
--- > main
--- > = do
--- > argv <- getArgs -- get the commandline arguments
--- > (inp, outp, options) <- cmdlineOpts argv -- and evaluate them, return a key-value list
--- > -- and input and output
--- > res <- run' $ application inp outp options $ emptyRoot -- run the application
--- >
--- > exitWith (if null res
--- > then ExitFailure (-1)
--- > else exitSuccess
--- > )
--- >
--- > application :: String -> String -> Attributes -> XmlStateFilter ()
--- > application inp outp al
--- > = parseDocument (al ++ [(a_source, inp)]) -- set options and source
--- > .>> -- and parse document
--- > processDocument -- the hard work
--- > .>>
--- > writeDocument [(a_output_file, outp)] -- issue results
--- > .>>
--- > checkStatus -- check errors
--- >
-
-
-writeDocument::Attributes->XmlStateFilterstate
-writeDocumentuserOptions
-=processDocumentuserOptionsdefaultOptions
-(traceMsg1"writeDocument: options added, start processing"
-.>>
-liftMf
-(choice
-[hasOptiona_indent:->indentDoc-- document indentation
-,hasOptiona_remove_whitespace:->removeDocWhiteSpace-- remove all whitespace between tags
-,this:->this
-]
-)
-.>>
-liftMf
-(choice
-[hasOptiona_show_tree:->treeRepOfXmlDoc
-,hasOptiona_show_haskell:->haskellRepOfXmlDoc
-,hasOptiona_output_xml:->(escapeXmlDoc-- escape lt, gt, amp, quot,
-.>
-addXmlPiToDoc-- add <?xml ... > pi
-.>
-unparseXmlDoc-- convert doc into text with respect to output encoding
-)
-,this:->this
-]
-)
-.>>
-writeXmlDoc
-.>>
-traceMsg1"writeDocument: finished"
-)
-where
-defaultOptions
-=[(a_output_file,"-")
-,(a_indent,v_0)
-,(a_remove_whitespace,v_0)
-,(a_output_xml,v_1)
-,(a_output_encoding,utf8)
-,(a_show_tree,v_0)
-,(a_show_haskell,v_0)
-]
-
-writeXmlDoc::XmlStateFilterstate
-writeXmlDoct'
-=putt'
-where
-put
-|nullfn||fn=="-"=putXmlDoc
-|otherwise=putXmlDocToFilefn
-
-fn=xshow.getValuea_output_file$t'
-
-
--- ------------------------------------------------------------
---
-
--- |
--- wrapper filter for running a monadic filter
--- controlled by common options
---
--- input tree must be a complete document
--- parameters and default parameters can be used to contol
--- the filer and common tasks like error message handling
-
-processDocument::Attributes->Attributes->XmlStateFilterstate->XmlStateFilterstate
-processDocumentuserOptionsdefaultOptionsprocessFilter
-=liftMfisRoot
-.>>
-liftMf(addOptionsuserOptions
-.>
-addOptions[(a_status,showc_ok)]
-)
-.>>
-liftMf(addDefaultOptionsdefaultOptions)
-.>>
-setSystemParams-- store options in system state
-.>>
-choiceM
-[hasOptiona_propagate_errors-- error handling is set by calling environment
-:->thisM
-
-,hasOptiona_collect_errors
-.>
-hasOptiona_issue_errors
-:->performAction(\_->setSysErrorHandler(errorMsgLogging.>>errorMsgToStderr))
-
-,hasOptiona_collect_errors
-:->performAction(\_->setSysErrorHandlererrorMsgLogging)
-
-,hasOptiona_issue_errors
-:->performAction(\_->setSysErrorHandlererrorMsgToStderr)
-
-,this
-:->performAction(\_->setSysErrorHandlernoneM)
-]
-.>>
-processFilter
-.>>
-(thisM
-+++>>
-(hasOptiona_collect_errors
-`guardsM`
-getErrorMsg
-)
-)
-
--- ------------------------------------------------------------
-
-
-
diff --git a/doc/hdoc/src/Text-XML-HXT-Parser-TagSoup.html b/doc/hdoc/src/Text-XML-HXT-Parser-TagSoup.html
--- a/doc/hdoc/src/Text-XML-HXT-Parser-TagSoup.html
+++ b/doc/hdoc/src/Text-XML-HXT-Parser-TagSoup.html
@@ -31,442 +31,461 @@
-- ------------------------------------------------------------
--- The table contains the id map. All element and attribute names are stored
--- the first time they are ecountered, and later always this name is used,
--- not a string built by the parser.
+importData.Char(toLower)
+importData.Maybe
+importqualifiedData.MapasM
-importText.HTML.TagSoup
-importText.HTML.TagSoup.Entity
-(lookupNumericEntity
-)
-
-importText.XML.HXT.DOM.Unicode
-(isXmlSpaceChar
-)
-
-importText.XML.HXT.DOM.NamespacePredicates
-(isWellformedQualifiedName
-)
-
-importText.XML.HXT.Parser.XmlEntities
-(-- xmlEntities
-)
-
-importText.XML.HXT.Parser.XhtmlEntities
-(xhtmlEntities
-)
-
-importText.XML.HXT.Parser.HtmlParsec
-(isEmptyHtmlTag
-,isInnerHtmlTagOf
-,closesHtmlTag
-)
-
-importText.XML.HXT.DOM.Interface
-(XmlTrees
-,QName
-,NsEnv
-,mkQName
-,mkName
-,mkPrefixLocalPart
-,c_warn
-,a_xml
-,a_xmlns
-,xmlNamespace
-,xmlnsNamespace
-)
-
-importText.XML.HXT.DOM.XmlNode
-(isElem
-,mkError
-,mkCmt
-,mkText
-,mkElement
-,mkAttr
-)
-
-importData.Maybe
-
-importqualifiedData.MapasM
-
--- ----------------------------------------
-
-typeTags=[Tag]
-
-typeNameTable=M.MapQNameQName
-
-typeContext=([String],NsEnv)
-
-dataState=S!Tags!NameTable-- the name table must be evaluated striktly, else a stack overflow occurs
-
-newtypeParsera=P{parse::State->(a,State)}
-
-instanceMonadParserwhere
-returnx=P$\ts->(x,ts)
-p>>=f=P$\ts->let
-(res,ts')=parsepts
-in
-parse(fres)ts'
-
-runParser::Parsera->Tags->a
-runParserpts=fst.parsep$StsM.empty
-
--- ----------------------------------------
-
-cond::ParserBool->Parsera->Parsera->Parsera
-condcte=do
-p<-c
-ifpthentelsee
-
-lookAhead::(Tag->Bool)->ParserBool
-lookAheadp=P$\s@(Sts_)->(not(nullts)&&p(headts),s)
-
--- ----------------------------------------
--- primitive look ahead tests
-
-isEof::ParserBool
-isEof=P$\s@(Sts_)->(nullts,s)
-
-isText::ParserBool
-isText=lookAheadis
-where
-is(TagText_)=True
-is_=False
-
-isCmt::ParserBool
-isCmt=lookAheadis
-where
-is(TagComment_)=True
-is_=False
-
-isWarn::ParserBool
-isWarn=lookAheadis
-where
-is(TagWarning_)=True
-is_=False
-
-isPos::ParserBool
-isPos=lookAheadis
-where
-is(TagPosition__)=True
-is_=False
-
-isCls::ParserBool
-isCls=lookAheadis
-where
-is(TagClose_)=True
-is_=False
-
-isOpn::ParserBool
-isOpn=lookAheadis
-where
-is(TagOpen__)=True
-is_=False
-
--- ----------------------------------------
--- primitive symbol parsers
-
-getTag::ParserTag
-getTag=P$\(S(t1:ts1)nt)->(t1,Sts1nt)
-
-getSym::(Tag->a)->Parsera
-getSymf=do
-t<-getTag
-return(ft)
-
-getText::ParserString
-getText=getSymsym
-where
-sym(TagTextt)=t
-sym_=undefined
-
-getCmt::ParserString
-getCmt=getSymsym
-where
-sym(TagCommentc)=c
-sym_=undefined
-
-getWarn::ParserString
-getWarn=getSymsym
-where
-sym(TagWarningw)=w
-sym_=undefined
-
-getPos::Parser(Int,Int)
-getPos=getSymsym
-where
-sym(TagPositionlc)=(l,c)
-sym_=undefined
-
-getCls::ParserString
-getCls=getSymsym
-where
-sym(TagClosen)=n
-sym_=undefined
-
-getOpn::Parser(String,[(String,String)])
-getOpn=getSymsym
-where
-sym(TagOpennal)=(n,al)
-sym_=undefined
-
--- ----------------------------------------
--- pushback parsers for inserting missing tags
-
-pushBack::Tag->Parser()
-pushBackt=P$\(Stsnt)->((),S(t:ts)nt)
-
-insCls::String->Parser()
-insClsn=pushBack(TagClosen)
-
-insOpn::String->[(String,String)]->Parser()
-insOpnnal=pushBack(TagOpennal)
-
--- ----------------------------------------
-
-insertQName::QName->ParserQName
-insertQNamen=P$\(Stsnt)->let
-(n',nt')=insertnnt
-in
-(n',Stsnt')
-where
-insertsnt
-|isJustr=(fromJustr,nt)
-|otherwise=(s,M.insertssnt)
-where
-r=M.lookupsnt
-
-mkQN::Bool->Bool->NsEnv->String->ParserQName
-mkQNwithNamespacesisAttrenvs
-|withNamespaces
-=insertQNameqn1
-|otherwise
-=insertQNameqn0
-where
-qn1
-|isAttr&&isSimpleName=mkNames
-|isSimpleName=mkQName""s(nsUri"")
-|isWellformedQualifiedNames=mkQNamepxlp(nsUripx)
-|otherwise=mkNames
-qn0
-|isSimpleName=mkNames
-|isWellformedQualifiedNames=mkPrefixLocalPartpxlp
-|otherwise=mkNames
-
-nsUrix=fromMaybe"".lookupx$env
-isSimpleName=all(/=':')s
-(px,(_:lp))=span(/=':')s
-
-extendNsEnv::Bool->[(String,String)]->NsEnv->NsEnv
-extendNsEnvwithNamespacesal1env
-|withNamespaces
-=concatMap(uncurryaddNs)al1++env
-|otherwise
-=env
-where
-addNsnv
-|px==a_xmlns
-&&
-(nulllp||(not.null.tail$lp))
-=[(drop1lp,v)]
-|otherwise
-=[]
-where
-(px,lp)=span(/=':')n
-
--- ----------------------------------------
-
--- own entity lookup to prevent problems with & and tagsoup hack for IE
-
-lookupEntity::Bool->Bool->String->[Tag]
-lookupEntitywithWarnings_asHtmle0@('#':e)
-=caselookupNumericEntityeof
-Justc->[TagText[c]]
-Nothing->(TagText$"&"++e0++";"):
-ifwithWarnings
-then[TagWarning$"illegal char reference: &"++e++";"]
-else[]
-
-lookupEntitywithWarningsasHtmle
-=case(lookupeentities)of
-Justx->[TagText[toEnumx]]
-Nothing->(TagText$"&"++e++";"):
-ifwithWarnings
-then[TagWarning$"Unknown entity reference: &"++e++";"]
-else[]
-where
-entities
-|asHtml=xhtmlEntities
-|otherwise=xhtmlEntities-- xmlEntities (TODO: xhtml is xml and html)
-
--- ----------------------------------------
--- the main parser
+
+importText.HTML.TagSoup
+importText.HTML.TagSoup.Entity
+(lookupNumericEntity
+)
+
+importText.XML.HXT.DOM.Unicode
+(isXmlSpaceChar
+)
+
+importText.XML.HXT.DOM.NamespacePredicates
+(isWellformedQualifiedName
+)
+
+importText.XML.HXT.Parser.XmlEntities
+(-- xmlEntities
+)
+
+importText.XML.HXT.Parser.XhtmlEntities
+(xhtmlEntities
+)
+
+importText.XML.HXT.Parser.HtmlParsec
+(isEmptyHtmlTag
+,isInnerHtmlTagOf
+,closesHtmlTag
+)
+
+importText.XML.HXT.DOM.Interface
+(XmlTrees
+,QName
+,NsEnv
+,mkQName
+,mkName
+,mkPrefixLocalPart
+,c_warn
+,a_xml
+,a_xmlns
+,xmlNamespace
+,xmlnsNamespace
+)
+
+importText.XML.HXT.DOM.XmlNode
+(isElem
+,mkError
+,mkCmt
+,mkText
+,mkElement
+,mkAttr
+)
+
+-- ----------------------------------------
+
+-- The name table contains the id map. All element and attribute names are stored
+-- the first time they are ecountered, and later always this name is used,
+-- not a string built by the parser.
+
+typeTags=[Tag]
+
+typeNameTable=M.MapQNameQName
+
+typeContext=([String],NsEnv)
+
+dataState=S!Tags!NameTable-- the name table must be evaluated striktly, else a stack overflow occurs
+
+newtypeParsera=P{parse::State->(a,State)}
+
+instanceMonadParserwhere
+returnx=P$\ts->(x,ts)
+p>>=f=P$\ts->let
+(res,ts')=parsepts
+in
+parse(fres)ts'
+
+runParser::Parsera->Tags->a
+runParserpts=fst.parsep$StsM.empty
+
+-- ----------------------------------------
+
+cond::ParserBool->Parsera->Parsera->Parsera
+condcte=do
+p<-c
+ifpthentelsee
+
+lookAhead::(Tag->Bool)->ParserBool
+lookAheadp=P$\s@(Sts_)->(not(nullts)&&p(headts),s)
+
+-- ----------------------------------------
+-- primitive look ahead tests
+
+isEof::ParserBool
+isEof=P$\s@(Sts_)->(nullts,s)
+
+isText::ParserBool
+isText=lookAheadis
+where
+is(TagText_)=True
+is_=False
+
+isCmt::ParserBool
+isCmt=lookAheadis
+where
+is(TagComment_)=True
+is_=False
+
+isWarn::ParserBool
+isWarn=lookAheadis
+where
+is(TagWarning_)=True
+is_=False
+
+isPos::ParserBool
+isPos=lookAheadis
+where
+is(TagPosition__)=True
+is_=False
+
+isCls::ParserBool
+isCls=lookAheadis
+where
+is(TagClose_)=True
+is_=False
+
+isOpn::ParserBool
+isOpn=lookAheadis
+where
+is(TagOpen__)=True
+is_=False
+
+-- ----------------------------------------
+-- primitive symbol parsers
+
+getTag::ParserTag
+getTag=P$\(S(t1:ts1)nt)->(t1,Sts1nt)
+
+getSym::(Tag->a)->Parsera
+getSymf=do
+t<-getTag
+return(ft)
+
+getText::ParserString
+getText=getSymsym
+where
+sym(TagTextt)=t
+sym_=undefined
+
+getCmt::ParserString
+getCmt=getSymsym
+where
+sym(TagCommentc)=c
+sym_=undefined
+
+getWarn::ParserString
+getWarn=getSymsym
+where
+sym(TagWarningw)=w
+sym_=undefined
+
+getPos::Parser(Int,Int)
+getPos=getSymsym
+where
+sym(TagPositionlc)=(l,c)
+sym_=undefined
+
+getCls::ParserString
+getCls=getSymsym
+where
+sym(TagClosen)=n
+sym_=undefined
+
+getOpn::Parser(String,[(String,String)])
+getOpn=getSymsym
+where
+sym(TagOpennal)=(n,al)
+sym_=undefined
+
+-- ----------------------------------------
+-- pushback parsers for inserting missing tags
+
+pushBack::Tag->Parser()
+pushBackt=P$\(Stsnt)->((),S(t:ts)nt)
+
+insCls::String->Parser()
+insClsn=pushBack(TagClosen)
+
+insOpn::String->[(String,String)]->Parser()
+insOpnnal=pushBack(TagOpennal)
+
+-- ----------------------------------------
+
+insertQName::QName->ParserQName
+insertQNamen=P$\(Stsnt)->let
+(n',nt')=insertnnt
+in
+(n',Stsnt')
+where
+insertsnt
+|isJustr=(fromJustr,nt)
+|otherwise=(s,M.insertssnt)
+where
+r=M.lookupsnt
+
+mkQN::Bool->Bool->NsEnv->String->ParserQName
+mkQNwithNamespacesisAttrenvs
+|withNamespaces
+=insertQNameqn1
+|otherwise
+=insertQNameqn0
+where
+qn1
+|isAttr&&isSimpleName=mkNames
+|isSimpleName=mkQName""s(nsUri"")
+|isWellformedQualifiedNames=mkQNamepxlp(nsUripx)
+|otherwise=mkNames
+qn0
+|isSimpleName=mkNames
+|isWellformedQualifiedNames=mkPrefixLocalPartpxlp
+|otherwise=mkNames
+
+nsUrix=fromMaybe"".lookupx$env
+isSimpleName=all(/=':')s
+(px,(_:lp))=span(/=':')s
+
+extendNsEnv::Bool->[(String,String)]->NsEnv->NsEnv
+extendNsEnvwithNamespacesal1env
+|withNamespaces
+=concatMap(uncurryaddNs)al1++env
+|otherwise
+=env
+where
+addNsnv
+|px==a_xmlns
+&&
+(nulllp||(not.null.tail$lp))
+=[(drop1lp,v)]
+|otherwise
+=[]
+where
+(px,lp)=span(/=':')n
+
+-- ----------------------------------------
+
+-- own entity lookup to prevent problems with & and tagsoup hack for IE
+
+lookupEntity::Bool->Bool->String->[Tag]
+lookupEntitywithWarnings_asHtmle0@('#':e)
+=caselookupNumericEntityeof
+Justc->[TagText[c]]
+Nothing->(TagText$"&"++e0++";"):
+ifwithWarnings
+then[TagWarning$"illegal char reference: &"++e++";"]
+else[]
+
+lookupEntitywithWarningsasHtmle
+=case(lookupeentities)of
+Justx->[TagText[toEnumx]]
+Nothing->(TagText$"&"++e++";"):
+ifwithWarnings
+then[TagWarning$"Unknown entity reference: &"++e++";"]
+else[]
+where
+entities
+|asHtml=xhtmlEntities
+|otherwise=xhtmlEntities-- xmlEntities (TODO: xhtml is xml and html)
+
+-- ----------------------------------------
-parseHtmlTagSoup::Bool->Bool->Bool->Bool->Bool->String->String->XmlTrees
-parseHtmlTagSoupwithNamespaceswithWarningswithCommentremoveWhiteSpaceasHtmldoc
-=(docRootElem
-.runParser(buildContinitContext)
-.(ifasHtml
-thencanonicalizeTags
-elseid
-)
-.parseTagsOptions(parseOptions{optTagWarning=withWarnings
-,optLookupEntity=lookupEntitywithWarningsasHtml
-}
-)
-)
-where
--- This is essential for lasy parsing:
--- the call of "take 1" stops parsing, when the first element is detected
--- no check on end of input sequence is required to build this (0- or 1-element list)
--- so eof is never checked unneccessarily
+-- |
+-- Turns all element and attribute names to lower case
+-- even !DOCTYPE stuff. But this is discarded when parsing the tagsoup
+
+lowerCaseNames::[Tag]->[Tag]
+lowerCaseNames
+=mapf
+where
+f(TagOpennameattrs)
+=TagOpen(nameToLowername)(mapattrToLowerattrs)
+f(TagClosename)
+=TagClose(nameToLowername)
+fa=a
+nameToLower=maptoLower
+attrToLower(an,av)=(nameToLoweran,av)
+
+-- ----------------------------------------
+-- the main parser
-docRootElem
-=take1.filterisElem
-
-initContext=([]
-,[(a_xml,xmlNamespace)
-,(a_xmlns,xmlnsNamespace)
-]
-)
-
-wrap=(:[])
-
-warn
-|withWarnings=wrap.mkErrorc_warn.show.(doc++).(" "++)
-|otherwise=const[]
-cmt
-|withComment=wrap.mkCmt
-|otherwise=const[]
-txt
-|removeWhiteSpace
-=\t->
-ifallisXmlSpaceChart
-then[]
-elsewrap.mkText$t
-|otherwise=wrap.mkText
-
-isEmptyElem
-|asHtml=isEmptyHtmlTag
-|otherwise=constFalse
-
-isInnerElem
-|asHtml=isInnerHtmlTagOf
-|otherwise=const(constFalse)
-
-closesElem
-|asHtml=\nsn1->
-not(nullns)
-&&
-n1`closesHtmlTag`(headns)
-|otherwise=const(constFalse)
-
-buildCont::Context->ParserXmlTrees
-buildContns
-=condisText(do
-t<-getText
-rl<-buildContns
-return(txtt++rl)
-)
-(condisOpn(do
-(n,al)<-getOpn
-openTagnsnal
-)
-(condisCls(do
-n<-getCls
-closeTagnsn
-)
-(condisCmt(do
-c<-getCmt
-rl<-buildContns
-return(cmtc++rl)
-)
-(condisWarn(do
-w<-getWarn
-rl<-buildContns
-return(warnw++rl)
-)
-(condisPos(do
-getPos
-buildContns
-)
-(condisEof(do
-isEof
-closeAllns
-)
-(return(warn"parse error in tagsoup tree construction")
-)
-)
-)
-)
-)
-)
-)
-where
-closeTag::Context->String->ParserXmlTrees
-closeTag((n':_),_)n1
-|n'==n1=return[]-- a normal closing tag
--- all other cases try to repair wrong html
-closeTagns'@((n':_),_)n1-- n1 closes n implicitly
-|n'`isInnerElem`n1-- e.g. <td>...</tr>
-=do
-insClsn1-- pushback </n1>
-insClsn'-- insert a </n'>
-buildContns'-- try again
-closeTagns'n1
-|isEmptyElemn1=buildContns'-- ignore a redundant closing tag for empty element
-closeTagns'@((n':ns1'),_)n1-- insert a missing closing tag
-|n1`elem`ns1'=do
-insClsn1
-insClsn'
-rl<-buildContns'
-return(warn("closing tag "++shown'++
-" expected, but "++shown1++" found")
-++rl
-)
-closeTagns'n1-- ignore a wrong closing tag
-=do
-rl<-buildContns'
-return(warn("no opening tag for closing tag "++shown1)
-++rl
-)
-
-openTag::Context->String->[(String,String)]->ParserXmlTrees
-openTagcx'@(ns',env')n1al1
-|isPiDTn1=buildContcx'
-|isEmptyElemn1
-=do
-qn<-mkElemQNnenvn1
-al<-mkAttrsal1
-rl<-buildContcx'
-return(mkElementqnal[]:rl)
-|closesElemns'n1=do
-insOpnn1al1
-insCls(headns')
-buildContcx'
-|otherwise=do
-qn<-mkElemQNnenvn1
-al<-mkAttrsal1
-cs<-buildCont((n1:ns'),nenv)
-rl<-buildContcx'
-return(mkElementqnalcs:rl)
-where
-nenv=extendNsEnvwithNamespacesal1env'
-mkElemQN=mkQNwithNamespacesFalse
-mkAttrQN=mkQNwithNamespacesTrue
-isPiDT('?':_)=True
-isPiDT('!':_)=True
-isPiDT_=False
-mkAttrs=mapM(uncurrymkA)
-mkAanav=do
-qan<-mkAttrQNnenvan
-return(mkAttrqan(wrap.mkText$av))
-
-closeAll::([String],NsEnv)->ParserXmlTrees
-closeAll(ns',_)=return(concatMapwrnns')
-where
-wrn=warn.("insert missing closing tag "++).show
-
--- ------------------------------------------------------------
+parseHtmlTagSoup::Bool->Bool->Bool->Bool->Bool->String->String->XmlTrees
+parseHtmlTagSoupwithNamespaceswithWarningswithCommentremoveWhiteSpaceasHtmldoc
+=(docRootElem
+.runParser(buildContinitContext)
+.(ifasHtml
+thenlowerCaseNames
+elseid
+)
+.parseTagsOptions(parseOptions{optTagWarning=withWarnings
+,optLookupEntity=lookupEntitywithWarningsasHtml
+}
+)
+)
+where
+-- This is essential for lasy parsing:
+-- the call of "take 1" stops parsing, when the first element is detected
+-- no check on end of input sequence is required to build this (0- or 1-element list)
+-- so eof is never checked unneccessarily
+
+docRootElem
+=take1.filterisElem
+
+initContext=([]
+,[(a_xml,xmlNamespace)
+,(a_xmlns,xmlnsNamespace)
+]
+)
+
+wrap=(:[])
+
+warn
+|withWarnings=wrap.mkErrorc_warn.show.(doc++).(" "++)
+|otherwise=const[]
+cmt
+|withComment=wrap.mkCmt
+|otherwise=const[]
+txt
+|removeWhiteSpace
+=\t->
+ifallisXmlSpaceChart
+then[]
+elsewrap.mkText$t
+|otherwise=wrap.mkText
+
+isEmptyElem
+|asHtml=isEmptyHtmlTag
+|otherwise=constFalse
+
+isInnerElem
+|asHtml=isInnerHtmlTagOf
+|otherwise=const(constFalse)
+
+closesElem
+|asHtml=\nsn1->
+not(nullns)
+&&
+n1`closesHtmlTag`(headns)
+|otherwise=const(constFalse)
+
+buildCont::Context->ParserXmlTrees
+buildContns
+=condisText(do
+t<-getText
+rl<-buildContns
+return(txtt++rl)
+)
+(condisOpn(do
+(n,al)<-getOpn
+openTagnsnal
+)
+(condisCls(do
+n<-getCls
+closeTagnsn
+)
+(condisCmt(do
+c<-getCmt
+rl<-buildContns
+return(cmtc++rl)
+)
+(condisWarn(do
+w<-getWarn
+rl<-buildContns
+return(warnw++rl)
+)
+(condisPos(do
+getPos
+buildContns
+)
+(condisEof(do
+isEof
+closeAllns
+)
+(return(warn"parse error in tagsoup tree construction")
+)
+)
+)
+)
+)
+)
+)
+where
+closeTag::Context->String->ParserXmlTrees
+closeTag((n':_),_)n1
+|n'==n1=return[]-- a normal closing tag
+-- all other cases try to repair wrong html
+closeTagns'@((n':_),_)n1-- n1 closes n implicitly
+|n'`isInnerElem`n1-- e.g. <td>...</tr>
+=do
+insClsn1-- pushback </n1>
+insClsn'-- insert a </n'>
+buildContns'-- try again
+closeTagns'n1
+|isEmptyElemn1=buildContns'-- ignore a redundant closing tag for empty element
+closeTagns'@((n':ns1'),_)n1-- insert a missing closing tag
+|n1`elem`ns1'=do
+insClsn1
+insClsn'
+rl<-buildContns'
+return(warn("closing tag "++shown'++
+" expected, but "++shown1++" found")
+++rl
+)
+closeTagns'n1-- ignore a wrong closing tag
+=do
+rl<-buildContns'
+return(warn("no opening tag for closing tag "++shown1)
+++rl
+)
+
+openTag::Context->String->[(String,String)]->ParserXmlTrees
+openTagcx'@(ns',env')n1al1
+|isPiDTn1=buildContcx'
+|isEmptyElemn1
+=do
+qn<-mkElemQNnenvn1
+al<-mkAttrsal1
+rl<-buildContcx'
+return(mkElementqnal[]:rl)
+|closesElemns'n1=do
+insOpnn1al1
+insCls(headns')
+buildContcx'
+|otherwise=do
+qn<-mkElemQNnenvn1
+al<-mkAttrsal1
+cs<-buildCont((n1:ns'),nenv)
+rl<-buildContcx'
+return(mkElementqnalcs:rl)
+where
+nenv=extendNsEnvwithNamespacesal1env'
+mkElemQN=mkQNwithNamespacesFalse
+mkAttrQN=mkQNwithNamespacesTrue
+isPiDT('?':_)=True
+isPiDT('!':_)=True
+isPiDT_=False
+mkAttrs=mapM(uncurrymkA)
+mkAanav=do
+qan<-mkAttrQNnenvan
+return(mkAttrqan(wrap.mkText$av))
+
+closeAll::([String],NsEnv)->ParserXmlTrees
+closeAll(ns',_)=return(concatMapwrnns')
+where
+wrn=warn.("insert missing closing tag "++).show
+
+-- ------------------------------------------------------------
diff --git a/doc/hdoc/src/Text-XML-HXT-Parser-XmlInput.html b/doc/hdoc/src/Text-XML-HXT-Parser-XmlInput.html
deleted file mode 100644
--- a/doc/hdoc/src/Text-XML-HXT-Parser-XmlInput.html
+++ /dev/null
@@ -1,394 +0,0 @@
-
-
-
-
-Haskell Code by HsColour
-
-
-
-
-- ------------------------------------------------------------
---
--- input functions
--- implemented as filer
---
--- Version : $Id: XmlInput.hs,v 1.9 2006/03/03 14:20:17 hxml Exp $
-
-moduleText.XML.HXT.Parser.XmlInput
-(getXmlContents
-,getXmlEntityContents
-,getUrlContents
-,getContentLength
-,guessDocEncoding
-,runInLocalURIContext
-,runInNewURIContext
-,getBaseURI
-,setBaseURI
-,getAbsolutURI
-,isStandaloneDocument
-)
-
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.DOM.XmlState
-
-importText.XML.HXT.Parser.DefaultURI
-(setDefaultURI
-)
-
-importText.XML.HXT.Parser.XmlParser
-(parseXmlDocEncodingSpec
-,parseXmlEntityEncodingSpec
-,removeEncodingSpec
-)
-
-importText.XML.HXT.DOM.Unicode
-(getDecodingFct
-,guessEncoding
-,normalizeNL
-)
-
-importText.XML.HXT.Parser.XmlOutput
-(traceTree
-,traceSource
-,traceMsg
-)
-
-importText.XML.HXT.Parser.ProtocolHandler
-(getProtocolHandler
-)
-
--- ------------------------------------------------------------
---
--- URI manipulation
-
-importNetwork.URI
-(parseURIReference
-,relativeTo
-,uriScheme
-)
-
--- ------------------------------------------------------------
---
--- utilities
-
-importData.Maybe
-
--- ------------------------------------------------------------
---
--- filter for reading the content
--- input: a root node with arguments in tag attribute list
--- and without any children.
-
--- attribute a_source ("source") for input file or uri
---
--- attribute a_encoding ("encoding") for encoding scheme
---
--- attribute a_proxy ("proxy") for proxy tob be used in http access
-
-getXmlContents'::XmlFilter->XmlStateFiltera
-getXmlContents'parseEncodingSpec
-=getContent'
-`whenM`isRoot
-where
-getContent't'
-=(liftMf(setStatusc_ok"getXmlContents")
-.>>
-getUrlContents
-.>>
-liftFparseEncodingSpec
-.>>
-guessDocEncoding
-.>>
-traceMsg1("getXmlContents: content read and decoded from "++showinput')
-.>>
-traceTree
-.>>
-traceSource
-)t'
-where
-input'=valueOfa_sourcet'
-
--- |
--- filter for reading the content of a XML document
---
--- input is a root node with the source as an attibute
--- the text is read, the encoding scheme is parsed and selected
--- and the input is translated into the internal UTF-8 string representation
-
-getXmlContents::XmlStateFiltera
-getXmlContents
-=getXmlContents'parseXmlDocEncodingSpec
-.>>
-setBaseURIFilter
-.>>
-setStandAloneFilter
-
--- |
--- filter for reading the content of an external XML entity
---
---
--- see also : 'getXmlContents'
-
-getXmlEntityContents::XmlStateFiltera
-getXmlEntityContents
-=getXmlContents'parseXmlEntityEncodingSpec
-.>>
-liftF(processChildrenremoveEncodingSpec)-- remove encoding spec, it's not part of the entity value
-.>>
-setBaseURIFilter
-
--- ------------------------------------------------------------
-
-setBaseURIFilter::XmlStateFiltera
-setBaseURIFilter
-=performAction(\t->setBaseURI(valueOftransferURIt))
-`whenM`isRoot
-
--- |
--- filter command for saving and restoring
--- the base URI
---
--- * 1.parameter f : the filter that possible changes the base URI
---
---
--- - returns : a filter with the same effect as f, that restores the base URI after application of f
-
-runInLocalURIContext::XmlStateFiltera->XmlStateFiltera
-runInLocalURIContextft
-=do
-oldContext<-getBaseURI
-trace2("runInLocalURIContext: save base URI "++showoldContext)
-res<-ft
-setBaseURIoldContext
-trace2("runInLocalURIContext: restore base URI "++showoldContext)
-returnres
-
--- |
--- filter command for running an action in a new URI context
-
-runInNewURIContext::String->XmlStateFiltera->XmlStateFiltera
-runInNewURIContexturif
-|nulluri
-=f
-|otherwise
-=runInLocalURIContext
-(\t->(do
-trace2("runInNewURIContext: new base URI "++showuri)
-setBaseURIuri
-ft
-)
-)
-
--- ------------------------------------------------------------
--- |
--- guessEncoding uses encoding attribute and content
--- to determine the encoding scheme.
---
--- it's assumed that an encoding spec has been tried to parse before guessing the encoding.
---
--- UTF-8 is the default encoding
---
--- other supported encodings are ISO-8859-1 (also known as ISO-Latin-1),
--- US-ASCII, UTF-16 or ISO-10646-UCS-2, UTF-16BE, UTF-16LE
-
-guessDocEncoding::XmlStateFiltera
-guessDocEncoding
-=addDocEncoding
-`whenM`isRoot
-where
-addDocEncodingn'
-=do
-trace2("guessDocEncoding: encoding is "++showguess)
-(encFilter(getDecodingFctguess)
-.>>
-issueError
-.>>
-liftMf(addAttrtransferEncodingguess))n'
-where
-guess::String
-guess=head.filter(not.null)
-$[(guessEncoding.showXText.getChildren)n'
-,valueOftransferEncodingn'
-,valueOfa_encodingn'
-,utf8
-]
-encFilter(Justfct)
-=decodeDocfct
-
-encFilterNothing
-=addFatal("encoding scheme not supported: "++showguess)
-
-decodeDocdfn''
-|nullerrs=liftMf(replaceChildren(xtext(normalizeNLres)))$n''
-|otherwise=(liftMf(replaceChildren(xtext""))
-.>>
-(issueDecodingErrs
-+++>>
-addFatal"decoding errors detected"
-)
-)n''
-where
-str=xshow.getChildren$n''
-(res,errs)=dfstr
-issueDecodingErrs=catM.map(issueErr.(guess++).(" encoding error"++))$errs
-
--- ------------------------------------------------------------
-
-getDefaultURI::XStatestateString
-getDefaultURI
-=do
-uri<-getSysParamtransferDefaultURI
-ifnulluri
-thendo
-setDefaultURI
-getDefaultURI
-elsereturnuri
-
--- |
--- set the base URI, all other URIs are handled relative to this base URI
---
--- the default base URI is @file:\/\/\/\<current-working-dir\>\/@
---
--- see also : 'getBaseURI'
-
-setBaseURI::String->XStatestate()
-setBaseURIstr
-=do
-trace2("setBaseURI: new base URI: "++showstr)
-setSysParamtransferURIstr
-
--- |
--- read the current base URI
---
--- see also : 'setBaseURI'
-
-getBaseURI::XStatestateString
-getBaseURI
-=do
-uri<-getSysParamtransferURI
-ifnulluri
-thendo
-res<-getDefaultURI
-setBaseURIres
-getBaseURI
-elsereturnuri
-
--- |
--- transform an URI into an absolut URI using the current base URI
---
---
--- * 1.parameter uri : the URI as string
---
---
--- - returns : the absolut URI as string or \"\" in case of an error
-
-getAbsolutURI::String->XStatestateString
-getAbsolutURIuri
-=do
-baseUri<-getBaseURI
-return$expandURIuribaseUri
-
-expandURI::String->String->String
-expandURIuribase
-=fromMaybe""$expand
-where
-expand=do
-base'<-parseURIReferencebase
-uri'<-parseURIReferenceuri
-abs'<-relativeTouri'base'
-return$showabs'
-
--- ------------------------------------------------------------
-
-setStandAloneFilter::XmlStateFiltera
-setStandAloneFilter
-=performActionsetStandAlone
-where
-setStandAlonet
-=do
-ifnullstandalone
-thenreturn()
-elsedo
-trace2("setStandAloneFilter: standalone="++showstandaloneVal)
-setSysParama_standalonestandaloneVal
-where
-standalone=getValuea_standalonet
-standaloneVal=showXTextstandalone
-
--- |
--- predicate for testing the standalone document attribute
-
-isStandaloneDocument::XStatestateBool
-isStandaloneDocument
-=do
-val<-getSysParama_standalone
-return(val=="yes")
-
--- ------------------------------------------------------------
-
--- |
--- the hard io operations
---
--- for reading a file or accessing a document via http
--- input must be a root node with a @source@ attribute specifying the URI
-
-getUrlContents::XmlStateFiltera
-getUrlContents
-=getCont
-`whenM`isRoot
-where
-getContn'
-=do
-trace1("getUrlContent: reading "++showsrc)
-uri<-getAbsolutURIsrc
-ifnulluri
-thenurlErr("illegal URI for input: "++showsrc)
-elselet
-uri'=fromJust$parseURIReferenceuri
-proto=init.uriScheme$uri'
-handler=getProtocolHandlerproto
-in
-(liftMf(addAttrtransferProtocolproto
-.>
-addAttrtransferURIuri
-)
-.>>
-handleruri'
-)$n'
-where
-src=valueOfa_sourcen'
-urlErrmsg=addFatalmsgn'
-
--- ------------------------------------------------------------
-
--- |
--- compute the length of the data for a document read previously
--- by a call of 'getUrlContents. The result is stored as an attribute
--- value in the document root node. the attribute name is 'a_contentLength'
-
-getContentLength::XmlFilter
-getContentLength
-=addAttrlcontentLengthAttr
-`when`isRoot
-where
-http_contentLength=httpPrefix++"Content-Length"
-
-contentLengthAttr::XmlFilter
-contentLengthAttrt
-=choice[hasAttra_contentLength
-:->none
-,hasAttrhttp_contentLength
-:->mkXAttra_contentLength(getValuehttp_contentLength)
-,this
-:->mkXAttra_contentLengthgetLength
-]t
-
-getLength::XmlFilter
-getLengtht
-=xtext(show.length.xshow.getChildren$t)
-
--- ------------------------------------------------------------
-
-- |
--- This module provides functions for validating attributes.
-
--- The main functions are:
---
--- - Check if the attribute value meets the lexical constraints of its type
---
--- - Normalization of an attribute value
---
-
--- Special namings in source code:
---
--- - nd - XDTD node
---
--- - n - XTag node
---
--- Version : $Id: AttributeValueValidation.hs,v 1.1 2004/09/02 19:12:02 hxml Exp $
---
-moduleText.XML.HXT.Validator.AttributeValueValidation
-(checkAttributeValue
-,normalizeAttributeValue
-)
-where
-
-importText.XML.HXT.Parser.XmlParser
-(parseNMToken
-,parseName
-)
-
-importText.XML.HXT.DOM.XmlTree
-importText.XML.HXT.DOM.Util
-
--- |
--- Checks if the attribute value meets the lexical constraints of its type.
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - returns : a function which takes an element (XTag or XDTD ATTLIST),
--- checks if the attribute value meets the lexical constraints
--- of its type and returns a list of errors
-
-checkAttributeValue::XmlTrees->XmlTree->XmlFilter
-checkAttributeValuedtdPartattrDecl@(NTree(XDTDATTLISTal)_)n@(NTree(XTag__al')_)
-=checkValueattrTypedtdPartnormalizedValattrDecln
-where
-attrType=lookup1a_typeal
-attrValue=valueOf(getAttrNameal)n
-normalizedVal=normalizeAttributeValue(JustattrDecl)attrValue
-
-checkAttributeValuedtdPartattrDecl@(NTree(XDTDATTLISTal)_)n@(NTree(XDTDATTLISTal')_)
-=checkValueattrTypedtdPartnormalizedValattrDecln
-where
-attrType=lookup1a_typeal
-attrValue=lookup1a_defaultal'
-normalizedVal=normalizeAttributeValue(JustattrDecl)attrValue
-
-checkAttributeValue_ndn
-=error("checkAttributeValue: illegeal parameter:\n"++shownd++shown)
-
-
--- |
--- Dispatches the attibute check by the attribute type.
---
--- * 1.parameter typ : the attribute type
---
--- - 2.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 3.parameter attrValue : the normalized attribute value to be checked
---
--- - 4.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - returns : a functions which takes an element (XTag or XDTD ATTLIST),
--- checks if the attribute value meets the lexical constraints
--- of its type and returns a list of errors
-
-checkValue::String->XmlTrees->String->XmlTree->XmlFilter
-checkValuetypdtdPartattrValueattrDecl
-|typ==k_cdata=none
-|typ==k_enumeration=checkValueEnumerationattrDeclattrValue
-|typ==k_entity=checkValueEntitydtdPartattrDeclattrValue
-|typ==k_entities=checkValueEntitiesdtdPartattrDeclattrValue
-|typ==k_id=checkValueIdattrDeclattrValue
-|typ==k_idref=checkValueIdrefattrDeclattrValue
-|typ==k_idrefs=checkValueIdrefsattrDeclattrValue
-|typ==k_nmtoken=checkValueNmtokenattrDeclattrValue
-|typ==k_nmtokens=checkValueNmtokensattrDeclattrValue
-|typ==k_notation=checkValueEnumerationattrDeclattrValue
-|otherwise=error("Attribute type "++showtyp++" unknown.")
-
--- |
--- Checks the value of Enumeration attribute types. (3.3.1 \/ p.27 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 2.parameter attrValue : the normalized attribute value to be checked
-
-checkValueEnumeration::XmlTree->String->XmlFilter
-checkValueEnumeration(NTree(XDTDATTLISTal)cs)attrValue
-=ifattrValue`elem`enumVals
-thennone
-elseerr("Attribute "++show(getAttrNameal)++" for element "++show(getElemNameal)++
-" must have a value from list "++showenumVals++".")
-where
-enumVals::[String]
-enumVals=map(getEnumVal)cs
-
-getEnumVal::XmlTree->String
-getEnumVal(NTree(XDTDNAMEal')_)=lookup1a_nameal'
-getEnumVal_=""
-
-checkValueEnumerationn_
-=error("checkValueEnumeration: illegeal parameter:\n"++shown)
-
-
--- |
--- Checks the value of ENTITY attribute types. (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node, to get the
--- unparsed entity declarations
---
--- - 2.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 3.parameter attrValue : the normalized attribute value to be checked
-
-checkValueEntity::XmlTrees->XmlTree->String->XmlFilter
-checkValueEntitydtdPart(NTree(XDTDATTLISTal)_)attrValue
-=ifattrValue`elem`upEntities
-thennone
-elseerr("Entity "++showattrValue++" of attribute "++show(getAttrNameal)++
-" for element "++show(getElemNameal)++" is not unparsed. "++
-"The following unparsed entities exist: "++showupEntities++".")
-where
-upEntities::[String]
-upEntities=map(getEnumVal)(isUnparsedEntity$$dtdPart)
-
-getEnumVal::XmlTree->String
-getEnumVal(NTree(XDTDENTITYal')_)=lookup1a_nameal'
-getEnumVal_=""
-
-
-checkValueEntity_n_
-=error("checkValueEntity: illegeal parameter:\n"++shown)
-
-
--- |
--- Checks the value of ENTITIES attribute types. (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node, to get the
--- unparsed entity declarations
---
--- - 2.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 3.parameter attrValue : the normalized attribute value to be checked
-
-checkValueEntities::XmlTrees->XmlTree->String->XmlFilter
-checkValueEntitiesdtdPartattrDecl@(NTree(XDTDATTLISTal)_)attrValue
-=ifnullvalueList
-thenerr("Attribute "++show(getAttrNameal)++" of element "++
-show(getElemNameal)++" must be one or more names.")
-elsecat(map(checkValueEntitydtdPartattrDecl)valueList)
-where
-valueList=wordsattrValue
-
-checkValueEntities_n_
-=error("checkValueEntities: illegeal parameter:\n"++shown)
-
-
--- |
--- Checks the value of NMTOKEN attribute types. (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 2.parameter attrValue : the normalized attribute value to be checked
-
-checkValueNmtoken::XmlTree->String->XmlFilter
-checkValueNmtoken(NTree(XDTDATTLISTal)_)attrValue
-=checkNmtokenparseRes
-where
-parseRes::XmlTrees
-parseRes=parseNMToken""(mkXTextTreeattrValue)
-
-checkNmtoken::XmlTrees->XmlFilter
-checkNmtoken((NTree(XError_s)_):_)
-=err("Attribute value "++showattrValue++" of attribute "++show(getAttrNameal)++
-" for element "++show(getElemNameal)++" must be a name token, "++(liness)!!1++".")
-
-checkNmtoken_=none
-
-
-checkValueNmtokenn_
-=error("checkValueNmtoken: illegeal parameter:\n"++shown)
-
-
--- |
--- Checks the value of NMTOKENS attribute types. (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 2.parameter attrValue : the normalized attribute value to be checked
-
-checkValueNmtokens::XmlTree->String->XmlFilter
-checkValueNmtokensattrDecl@(NTree(XDTDATTLISTal)_)attrValue
-=ifnullvalueList
-thenerr("Attribute "++show(getAttrNameal)++" of element "++
-show(getElemNameal)++" must be one or more name tokens.")
-elsecat(map(checkValueNmtokenattrDecl)valueList)
-where
-valueList=wordsattrValue
-
-checkValueNmtokensn_
-=error("checkValueNmtokens: illegeal parameter:\n"++shown)
-
-
--- |
--- Checks the value of ID attribute types. (3.3.1 \/ p.25 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 2.parameter attrValue : the normalized attribute value to be checked
-
-checkValueId::XmlTree->String->XmlFilter
-checkValueIdattrDeclattrValue
-=checkForName"Attribute value"attrDeclattrValue
-
-
--- |
--- Checks the value of IDREF attribute types. (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 2.parameter attrValue : the normalized attribute value to be checked
-
-checkValueIdref::XmlTree->String->XmlFilter
-checkValueIdrefattrDeclattrValue
-=checkForName"Attribute value"attrDeclattrValue
-
-
--- |
--- Checks the value of IDREFS attribute types. (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 2.parameter attrValue : the normalized attribute value to be checked
-
-checkValueIdrefs::XmlTree->String->XmlFilter
-checkValueIdrefsattrDeclattrValue
-=cat(map(checkValueIdrefattrDecl)(wordsattrValue))
-
-
-
--- -----------------------------------------------------------------------------
--- General helper functions for checking attribute values
---
-
--- |
--- Checks if the value of an attribute is a name.
---
--- * 1.parameter msg : error message, should be "Entity" or "Attribute value"
---
--- - 2.parameter attrDecl : the declaration of the attribute from the DTD
---
--- - 3.parameter attrValue : the normalized attribute value to be checked
-
-checkForName::String->XmlTree->String->XmlFilter
-checkForNamemsg(NTree(XDTDATTLISTal)_)attrValue
-=checkNameparseRes
-where
-parseRes::XmlTrees
-parseRes=parseName""(mkXTextTreeattrValue)
-
-checkName::XmlTrees->XmlFilter
-checkName((NTree(XError_s)_):_)
-=err(msg++" "++showattrValue++" of attribute "++show(getAttrNameal)++
-" for element "++show(getElemNameal)++" must be a name, "++(liness)!!1++".")
-
-checkName_=none
-
-
-checkForName_n_
-=error("checkForName: illegeal parameter:\n"++shown)
-
-
--- |
--- Gets the element name from an attribute list of an XDTD ATTLIST node.
---
--- * 1.parameter tag : the attibute list of an XDTD ATTLIST
---
--- - returns : the element name
-
-getElemName::Attributes->String
-getElemName=lookup1a_name
-
-
--- |
--- Gets the attribute name from an attribute list of an XDTD ATTLIST node.
---
--- * 1.parameter tag : the attibute list of an XDTD ATTLIST
---
--- - returns : the attribute name
-
-getAttrName::Attributes->String
-getAttrName=lookup1a_value
-
-
-
--- -----------------------------------------------------------------------------
-
-
--- |
--- Normalizes an attribute value with respect to its type. (3.3.3 \/ p.29 in Spec)
---
--- * 1.parameter attrDecl : the declaration of the attribute from the DTD. Expected
--- is a list. If the list is empty, no declaration exists.
---
--- - 2.parameter value : the attribute value to be normalized
---
--- - returns : the normalized value
---
-normalizeAttributeValue::MaybeXmlTree->String->String
-normalizeAttributeValue(Just(NTree(XDTDATTLISTal)_))value
-=normalizeAttributeattrType
-where
-attrType=lookup1a_typeal
-
-normalizeAttribute::String->String
-normalizeAttributetyp
-|typ==k_cdata=cdataNormalizationvalue
-|otherwise=otherNormalizationvalue
-
-
--- Attribute not declared in DTD, normalization as CDATA
-normalizeAttributeValue_value
-=cdataNormalizationvalue
-
-
--- ------------------------------------------------------------
--- Helper functions for normalization
-
-
--- |
--- Normalization of CDATA attribute values.
--- is already done when parsing
--- during entity substituion for attribute values
-cdataNormalization::String->String
-cdataNormalization=id
-
-
--- | Normalization of attribute values other than CDATA.
-otherNormalization::String->String
-otherNormalization=reduceWSSequences.stringTrim.cdataNormalization
-
--- | Reduce whitespace sequences to a single whitespace.
-reduceWSSequences::String->String
-reduceWSSequencesstr=unwords(wordsstr)
-
-
-
-- |
--- This module provides functions for validating the DTD of XML documents
--- represented as XmlTree.
-
--- Unlike other popular XML validation tools the validation process returns
--- a list of errors instead of aborting after the first error was found.
-
-
--- Unlike validation of the document, the DTD branch is traversed four times:
---
--- - Validation of Notations
---
--- - Validation of Unparsed Entities
---
--- - Validation of Element declarations
---
--- - Validation of Attribute declarations
-
--- Special namings in source code:
---
--- - nd - XDTD node
---
--- Author : .\\artin Schmidt
--- Version : $Id: DTDValidation.hs,v 1.1 2004/09/02 19:12:02 hxml Exp $
-
-moduleText.XML.HXT.Validator.DTDValidation
-(removeDoublicateDefs
-,validateDTD
-)
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.Validator.AttributeValueValidation
-
-
-
--- |
--- Validate a DTD.
---
--- - returns : a functions which takes the DTD subset of the XmlTree, checks
--- if the DTD is valid and returns a list of errors
-
-validateDTD::XmlFilter
-validateDTDdtdPart
-={-# SCC "validateNotations" #-}validateNotationsdtdPart'
-++
-{-# SCC "validateEntities" #-}validateEntitiesdtdPart'notationNames
-++
-{-# SCC "validateElements" #-}validateElementsdtdPart'elemNames
-++
-{-# SCC "validateAttributes" #-}validateAttributesdtdPart'elemNamesnotationNames
-
-where
-dtdPart'=getChildrendtdPart
-
-notationNames::[String]
-notationNames
-=getXTextValues(isNotation.>getDTDValuea_name$$dtdPart')
-
-elemNames::[String]
-elemNames
-=getXTextValues(isElement.>getDTDValuea_name$$dtdPart')
-
-
-
-
--- ------------------------------------------------------------
-
--- |
--- Returns a list of XText values.
---
--- * 1.parameter xtextList : a list of XText nodes
---
--- - returns : the values of the XText nodes
-
-getXTextValues::XmlTrees->[String]
-getXTextValues
-=concatMapshowT
-where
-showT(NTreen_)
-|isXTextNoden=[textOfXNoden]
-showT_=[]
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Validation of Notations, checks if all notation names are unique.
--- Validity constraint: Unique Notation Name (4.7 \/ p.44 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - returns : a list of errors
-
-validateNotations::XmlTrees->XmlTrees
-validateNotationsdtdPart
-=checkForUniqueNotationnotations[]
-where
-notations=isNotation$$dtdPart
-
-checkForUniqueNotation::XmlTrees->[String]->XmlTrees
-checkForUniqueNotation(x@(NTree(XDTDNOTATIONal)_):xs)used
-=ifname`elem`used
-thenerr("Notation "++showname++" was already specified.")x
-++
-checkForUniqueNotationxsused
-
-elsecheckForUniqueNotationxs(name:used)
-where
-name=lookup1a_nameal
-
-checkForUniqueNotation[]_=[]
-
-checkForUniqueNotationnd_
-=error("checkForUniqueNotation: illegeal parameter:\n"++shownd)
-
-
--- |
--- Validation of Entities.
---
--- 1. Issues a warning if entities are declared multiple times.
---
--- Optional warning: (4.2 \/ p.35 in Spec)
---
---
--- 2. Validates that a notation is declared for an unparsed entity.
---
--- Validity constraint: Notation Declared (4.2.2 \/ p.36 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter notationNames : list of all notation names declared in the DTD
---
--- - returns : a list of errors
-
-validateEntities::XmlTrees->[String]->XmlTrees
-validateEntitiesdtdPartnotationNames
-=checkForUniqueEntityentities[]
-++
-checkNotationDeclsnotationNamesupEntities
-
-where
-entities=isEntity$$dtdPart
-upEntities=isUnparsedEntity$$dtdPart
-
--- Check if entities are declared multiple times
-checkForUniqueEntity::XmlTrees->[String]->XmlTrees
-checkForUniqueEntity(x@(NTree(XDTDENTITYal)_):xs)used
-=ifname`elem`used
-thenwarn("Entity "++showname++" was already specified. "++
-"First declaration will be used.")x
-++
-checkForUniqueEntityxsused
-
-elsecheckForUniqueEntityxs(name:used)
-where
-name=lookup1a_nameal
-
-checkForUniqueEntity[]_=[]
-
-checkForUniqueEntitynd_
-=error("checkForUniqueEntity: illegeal parameter:\n"++shownd)
-
-
--- Find unparsed entities for which no notation is specified
-checkNotationDecls::[String]->XmlTrees->XmlTrees
-checkNotationDeclsnotationNames'upEntities'
-=concatMap(checkNotationDecl)upEntities'
-where
-checkNotationDecl::XmlTree->XmlTrees
-checkNotationDecln@(NTree(XDTDENTITYal)_)
-=if(notationNameal)`elem`notationNames'
-then[]
-elseerr("The notation "++show(notationNameal)++" must be declared "++
-"when referenced in the unparsed entity declaration for "++
-show(upEntityNameal)++".")n
-where
-notationName=lookup1k_ndata
-upEntityName=lookup1a_name
-
-checkNotationDeclnd
-=error("checkNotationDecl: illegeal parameter:\n"++shownd)
-
-
-
--- |
--- Validation of Element declarations.
---
--- 1. Validates that an element is not declared multiple times.
---
--- Validity constraint: Unique Element Type Declaration (3.2 \/ p.21 in Spec)
---
---
--- 2. Validates that an element name only appears once in a mixed-content declaration.
---
--- Validity constraint: No Duplicate Types (3.2 \/ p.21 in Spec)
---
---
--- 3. Issues a warning if an element mentioned in a content model is not declared in the
--- DTD.
---
--- Optional warning: (3.2 \/ p.21 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter elemNames : list of all element names declared in the DTD
---
--- - returns : a list of errors
-
-
-validateElements::XmlTrees->[String]->XmlTrees
-validateElementsdtdPartelemNames
-=checkForUniqueElementelements[]
-++
-checkMixedContentsmixedContentElems
-++
-checkContentModelselemNameselements
-
-where
-elements=isElement$$dtdPart
-mixedContentElems=isMixedContentElement$$dtdPart
-
-
--- Validates that an element is not declared multiple times
-checkForUniqueElement::XmlTrees->[String]->XmlTrees
-checkForUniqueElement(x@(NTree(XDTDELEMENTal)_):xs)used
-=ifname`elem`used
-thenerr("Element type "++showname++
-" must not be declared more than once.")x
-++
-checkForUniqueElementxsused
-
-elsecheckForUniqueElementxs(name:used)
-where
-name=lookup1a_nameal
-
-checkForUniqueElement[]_=[]
-
-checkForUniqueElementnd_
-=error("checkForUniqueElement: illegeal parameter:\n"++shownd)
-
-
--- Validates that an element name only appears once in a mixed-content declaration
-checkMixedContentselems
-=concatMap(checkMixedContent)elems
-where
-checkMixedContent(NTree(XDTDELEMENTal)cs)
-=checkMC(getChildren(headcs))[]
-where
-elemName=lookup1a_nameal
-
-checkMC::XmlTrees->[String]->XmlTrees
-checkMC(x@(NTree(XDTDNAMEal')_):xs)used
-=ifname`elem`used
-thenerr("The element type "++showname++
-" was already specified in the mixed-content model of the element declaration "++
-showelemName++".")x
-++
-checkMCxsused
-
-elsecheckMCxs(name:used)
-where
-name=lookup1a_nameal'
-
-checkMC[]_=[]
-
-checkMCnd_
-=error("checkMC: illegeal parameter:\n"++shownd)
-
-checkMixedContentnd
-=error("checkMixedContent: illegeal parameter:\n"++shownd)
-
-
--- Issues a warning if an element mentioned in a content model is not
--- declared in the DTD.
-checkContentModelsnameselems
-=concatMapcheckContentModelelems
-where
-checkContentModel::XmlFilter
-checkContentModel(NTree(XDTDELEMENTal)cs)
-=validateContent(lookup1a_typeal)
-where
-elemName=lookup1a_nameal
-
-validateContent::String->XmlTrees
-validateContentcm
-|cm==v_children=checkContent(headcs)
-|cm==v_mixed=checkContent(headcs)
-|otherwise=[]-- no child elements to check
-
-checkContent::XmlFilter
-checkContentn@(NTree(XDTDNAMEal')_)
-=ifchildElemName`elem`names
-then[]
-elsewarn("The element type "++showchildElemName++
-", used in content model of element "++showelemName++
-", is not declared.")n
-where
-childElemName=lookup1a_nameal'
-
-checkContent(NTree(XDTDCONTENT_)cs')
-=concatMap(checkContent)cs'
-
-checkContentnd
-=error("checkContent: illegeal parameter:\n"++shownd)
-
-checkContentModelnd
-=error("checkContentModel: illegeal parameter:\n"++shownd)
-
-
--- |
--- Validation of Attribute declarations.
---
--- (1) Issues a warning if an attribute is declared for an element type not itself
--- decared.
---
--- Optinal warning: (3.3 \/ p. 24 in Spec)
---
---
--- 2. Issues a warning if more than one definition is provided for the same
--- attribute of a given element type. Fist declaration is binding, later
--- definitions are ignored.
---
--- Optional warning: (3.3 \/ p.24 in Spec)
---
---
--- 3. Issues a warning if the same Nmtoken occures more than once in enumerated
--- attribute types of a single element type.
---
--- Optional warning: (3.3.1 \/ p.27 in Spec)
---
---
--- 4. Validates that an element type has not more than one ID attribute defined.
---
--- Validity constraint: One ID per Element Type (3.3.1 \/ p.26 in Spec)
---
---
--- 5. Validates that an element type has not more than one NOTATION attribute defined.
---
--- Validity constraint: One Notation per Element Type (3.3.1 \/ p.27 in Spec)
---
---
--- 6. Validates that an ID attributes has the type #IMPLIED or #REQUIRED.
---
--- Validity constraint: ID Attribute Default (3.3.1 \/ p.26 in Spec)
---
---
--- 7. Validates that all referenced notations are declared.
---
--- Validity constraint: Notation Attributes (3.3.1 \/ p.27 in Spec)
---
---
--- 8. Validates that notations are not declared for EMPTY elements.
---
--- Validity constraint: No Notation on Empty Element (3.3.1 \/p.27 in Spec)
---
---
--- 9. Validates that the default value matches the lexical constraints of it's type.
---
--- Validity constraint: Attribute default legal (3.3.2 \/ p.28 in Spec)
---
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter elemNames : list of all element names declared in the DTD
---
--- - 3.parameter notationNames : list of all notation names declared in the DTD
---
--- - returns : a list of errors
-
-validateAttributes::XmlTrees->[String]->[String]->XmlTrees
-validateAttributesdtdPartelemNamesnotationNames
-=-- 1. Find attributes for which no elements are declared
-((checkDeclaredElementselemNames)$$attributes)
-++
--- 2. Find attributes which are declared more than once
-(checkForUniqueAttributeDeclarationattributes[])
-++
--- 3. Find enumerated attribute types which nmtokens are declared more than once
-(checkEnumeratedTypes
-`o`
-(isEnumAttrType`orElse`isNotationAttrType)$$attributes)
-++
--- 4. Validate that there exists only one ID attribute for an element
-(checkForUniqueIdidAttributes[])
-++
--- 5. Validate that there exists only one NOTATION attribute for an element
-(checkForUniqueNotationnotationAttributes[])
-++
--- 6. Validate that ID attributes have the type #IMPLIED or #REQUIRED
-(checkIdKindConstraint$$idAttributes)
-++
--- 7. Validate that all referenced notations are declared
-((checkNotationDeclarationnotationNames)$$notationAttributes)
-++
--- 8. Validate that notations are not declared for EMPTY elements
-((checkNoNotationForEmptyElement
-(
-getXTextValues(getDTDValuea_name$$(isEmptyElement$$dtdPart))
-)
-)$$notationAttributes)
-++
--- 9. Validate that the default value matches the lexical constraints of it's type
-((checkDefaultValueTypesdtdPart)$$(isDefaultAttrKind$$attributes))
-
-where
---------------------------------------------------------------------------
--- helper functions
-attributes=isAttlist$$dtdPart
-idAttributes=isIdAttrType$$attributes
-notationAttributes=isNotationAttrType$$attributes
-
-
-elemName=lookup1a_name
-attName=lookup1a_value
-
---------------------------------------------------------------------------
--- 1. Find attributes for which no elements are declared
-checkDeclaredElements::[String]->XmlFilter
-checkDeclaredElementselemNames'n@(NTree(XDTDATTLISTal)_)
-=if(elemNameal)`elem`elemNames'
-then[]
-elsewarn("The element type \""++elemNameal++"\" used in declaration "++
-"of attribute \""++attNameal++"\" is not declared.")n
-
-checkDeclaredElements_nd
-=error("checkDeclaredElements: illegeal parameter:\n"++shownd)
-
---------------------------------------------------------------------------
--- 2. Find attributes which are declared more than once
-checkForUniqueAttributeDeclaration::XmlTrees->[String]->XmlTrees
-checkForUniqueAttributeDeclaration(x@(NTree(XDTDATTLISTal)_):xs)used
-=ifname`elem`used
-thenwarn("Attribute \""++aname++"\" for element type \""++
-ename++"\" is already declared. First "++
-"declaration will be used.")x
-++
-checkForUniqueAttributeDeclarationxsused
-
-elsecheckForUniqueAttributeDeclarationxs(name:used)
-where
-ename=elemNameal
-aname=attNameal
-name=ename++"|"++aname
-
-checkForUniqueAttributeDeclaration[]_=[]
-
-checkForUniqueAttributeDeclarationnd_
-=error("checkForUniqueAttributeDeclaration: illegeal parameter:\n"++shownd)
-
-
---------------------------------------------------------------------------
--- 3. Find enumerated attribute types which nmtokens are declared more than once
-checkEnumeratedTypes::XmlFilter
-checkEnumeratedTypes(NTree(XDTDATTLISTal)cs)
-=checkForUniqueTypecs[]
-where
-checkForUniqueType::XmlTrees->[String]->XmlTrees
-checkForUniqueType(x@(NTree(XDTDNAMEal')_):xs)used
-=ifnmtoken`elem`used
-thenwarn("Nmtoken \""++nmtoken++"\" should not "++
-"occur more than once in attribute \""++attNameal++
-"\" for element \""++elemNameal++"\".")x
-++
-checkForUniqueTypexsused
-
-elsecheckForUniqueTypexs(nmtoken:used)
-where
-nmtoken=lookup1a_nameal'
-
-checkForUniqueType[]_=[]
-
-checkForUniqueTypend_
-=error("checkForUniqueType: illegeal parameter:\n"++shownd)
-
-checkEnumeratedTypesnd
-=error("checkEnumeratedTypes: illegeal parameter:\n"++shownd)
-
-
---------------------------------------------------------------------------
--- 4. Validate that there exists only one ID attribute for an element
-checkForUniqueId::XmlTrees->[String]->XmlTrees
-checkForUniqueId(x@(NTree(XDTDATTLISTal)_):xs)used
-=ifename`elem`used
-thenerr("Element \""++ename++"\" already has attribute of type "++
-"ID, another attribute \""++attNameal++"\" of type ID is "++
-"not permitted.")x
-++
-checkForUniqueIdxsused
-
-elsecheckForUniqueIdxs(ename:used)
-where
-ename=elemNameal
-
-checkForUniqueId[]_=[]
-
-checkForUniqueIdnd_
-=error("checkForUniqueId: illegeal parameter:\n"++shownd)
-
---------------------------------------------------------------------------
--- 5. Validate that there exists only one NOTATION attribute for an element
-checkForUniqueNotation::XmlTrees->[String]->XmlTrees
-checkForUniqueNotation(x@(NTree(XDTDATTLISTal)_):xs)used
-=ifename`elem`used
-thenerr("Element \""++elemNameal++"\" already has attribute of type "++
-"NOTATION, another attribute \""++attNameal++"\" of type NOTATION "++
-"is not permitted.")x
-++
-checkForUniqueNotationxsused
-
-elsecheckForUniqueNotationxs(ename:used)
-where
-ename=elemNameal
-
-checkForUniqueNotation[]_=[]
-
-checkForUniqueNotationnd_
-=error("checkForUniqueNotation: illegeal parameter:\n"++shownd)
-
---------------------------------------------------------------------------
--- 6. Validate that ID attributes have the type #IMPLIED or #REQUIRED
-checkIdKindConstraint::XmlFilter
-checkIdKindConstraintnd@(NTree(XDTDATTLISTal)_)
-=if(attKind==k_implied)||(attKind==k_required)
-then[]
-elseerr("ID attribute \""++attNameal++"\" must have a declared default "++
-"of \"#IMPLIED\" or \"REQUIRED\"")nd
-where
-attKind=lookup1a_kindal
-
-checkIdKindConstraintnd
-=error("checkIdKindConstraint: illegeal parameter:\n"++shownd)
-
-
---------------------------------------------------------------------------
--- 7. Validate that all referenced notations are declared
-checkNotationDeclaration::[String]->XmlFilter
-checkNotationDeclarationnotations(NTree(XDTDATTLISTal)cs)
-=checkNotations$$cs
-where
-checkNotations::XmlFilter
-checkNotationsnd@(NTree(XDTDNAMEal')_)
-=ifnotation`elem`notations
-then[]
-elseerr("The notation \""++notation++"\" must be declared when "++
-"referenced in the notation type list for attribute \""++attNameal++
-"\" of element \""++elemNameal++"\".")nd
-where
-notation=lookup1a_nameal'
-
-checkNotationsnd
-=error("checkNotations: illegeal parameter:\n"++shownd)
-
-checkNotationDeclaration_nd
-=error("checkNotationDeclaration: illegeal parameter:\n"++shownd)
-
---------------------------------------------------------------------------
--- 8. Validate that notations are not declared for EMPTY elements
-checkNoNotationForEmptyElement::[String]->XmlFilter
-checkNoNotationForEmptyElementemptyElemsnd@(NTree(XDTDATTLISTal)_)
-=if(elemNameal)`elem`emptyElems
-thenerr("Attribute \""++attNameal++"\" of type NOTATION must not be "++
-"declared on the element \""++elemNameal++"\" declared EMPTY.")
-nd
-else[]
-
-checkNoNotationForEmptyElement_nd
-=error("checkNoNotationForEmptyElement: illegeal parameter:\n"++shownd)
-
---------------------------------------------------------------------------
--- 9. Validate that default values meet the lexical constraints of the attribute types
-checkDefaultValueTypes::XmlTrees->XmlFilter
-checkDefaultValueTypesdtdPart'n@(NTree(XDTDATTLIST_)_)
-=checkAttributeValuedtdPart'nn
-
-checkDefaultValueTypes_nd
-=error("checkDefaultValueTypes: illegeal parameter:\n"++shownd)
-
-
-
--- ------------------------------------------------------------
-
--- |
--- Removes doublicate declarations from the DTD, which first declaration is
--- binding. This is the case for ATTLIST and ENTITY declarations.
---
--- - returns : A function that replaces the children of DOCTYPE nodes by a list
--- where all multiple declarations are removed.
-
-removeDoublicateDefs::XmlFilter
-removeDoublicateDefsn@(NTree(XDTDDOCTYPE_)cs)
-=replaceChildren(removeDoubleDefs[]cs)n
-where
-removeDoubleDefs::[String]->XmlTrees->XmlTrees
-removeDoubleDefsused(x@(NTree(XDTDATTLISTal)_):xs)
-=ifelemAttr`elem`used
-thenremoveDoubleDefsusedxs
-elsex
-:
-removeDoubleDefs(elemAttr:used)xs
-where
-elemAttr=elemName++"|"++attrName
-attrName=lookup1a_valueal
-elemName=lookup1a_nameal
-
-
-removeDoubleDefsused(x@(NTree(XDTDENTITYal)_):xs)
-=ifname`elem`used
-thenremoveDoubleDefsusedxs
-elsex
-:
-removeDoubleDefs(name:used)xs
-where
-name=lookup1a_nameal
-
-
-removeDoubleDefsused(x:xs)
-=x:removeDoubleDefsusedxs
-
-removeDoubleDefs_[]
-=[]
-
-
-removeDoublicateDefsn
-=[n]
-
-
-- |
--- This module provides functions for transforming XML documents represented as
--- XmlTree with respect to its DTD.
-
--- Transforming an XML document with respect to its DTD means:
---
--- - add all attributes with default values
---
--- - normalize all attribute values
---
--- - sort all attributes in lexical order
---
-
-
--- Note: Transformation should be started after validation.
-
-
--- Before the document is validated, a lookup-table is build on the basis of
--- the DTD which maps element names to their transformation functions.
--- After this initialization phase the whole document is traversed in preorder
--- and every element is transformed by the XmlFilter from the lookup-table.
-
--- Special namings in source code:
---
--- - nd - XDTD node
---
--- - n - XTag node
---
--- Author : .\\artin Schmidt
--- Version : $Id: DocTransformation.hs,v 1.1 2004/09/02 19:12:03 hxml Exp $
-
-moduleText.XML.HXT.Validator.DocTransformation
-(transform
-)
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.Validator.AttributeValueValidation
-
-importData.Maybe
-importData.List
-
-
-
--- |
--- Lookup-table which maps element names to their transformation functions. The
--- transformation functions are XmlFilters.
-
-typeTransEnvTable=[TransEnv]
-typeTransEnv=(ElemName,TransFct)
-typeElemName=String
-typeTransFct=XmlFilter
-
-
--- ------------------------------------------------------------
-
-
--- |
--- filter for transforming the document.
---
--- * 1.parameter dtdPart : the DTD subset (Node @DOCTYPE@) of the XmlTree
---
--- - 2.parameter doc : the document subset of the XmlTree
---
--- - returns : a list of errors
-
-transform::XmlTree->XmlTree->XmlTrees
-transformdtdPartdom
-=traverseTreetransTabledom
-where
-transTable={-# SCC "buildAllTransFcts" #-}buildAllTransformationFunctionsdtdPart
-
-
-
--- |
--- Traverse the XmlTree in preorder.
---
--- * 1.parameter transEnv : lookup-table which maps element names to their transformation functions
---
--- - returns : the whole transformed document
-
-traverseTree::TransEnvTable->XmlFilter
-traverseTreetransEnvn@(NTree(XTagname_)cs)
-=replaceChildren(concatMap(traverseTreetransEnv)cs)(head(transFctn))
-where
-transFct=case(lookup(qualifiedNamename)transEnv)of
-Nothing->this-- element not in DTD, can't be transformed
-Justf->f
-
-traverseTree_n=[n]
-
-
--- |
--- Build all transformation functions.
---
--- * 1.parameter dtdPart : the DTD subset, root node should be of type @DOCTYPE@
---
--- - returns : lookup-table which maps element names to their transformation functions
-
-buildAllTransformationFunctions::XmlTree->TransEnvTable
-buildAllTransformationFunctionsdtdPart
-=buildTransRoot
-:
--- construct the list of filters
-map(buildTransformationFunctionsdtdNodes)(isElement$$dtdNodes)
-where
-dtdNodes=getChildrendtdPart
-
-
--- |
--- Build a transformation function for the document root. By root @\/@
--- is meant, which is the topmost dummy created by the parser. This function is only a
--- dummy, too.
---
--- * returns : entry for the lookup-table
-
-buildTransRoot::TransEnv
-buildTransRoot=(t_root,this)
-
-
-
--- |
--- Build transformation functions for an element.
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- * 1.parameter nd : element declaration for which the transformation functions are
--- created
---
--- - returns : entry for the lookup-table
-
-buildTransformationFunctions::XmlTrees->XmlTree->TransEnv
-
-buildTransformationFunctionsdtdPartn@(NTree(XDTDELEMENTal)_)
-=(name,transFct)
-where
-name=lookup1a_nameal
-transFct=lexicographicAttributeOrder
-`o`
-normalizeAttributeValuesndtdPart
-`o`
-setDefaultAttributeValuesndtdPart
-
-buildTransformationFunctions_n
-=error("buildTransformationFunctions: illegeal parameter:\n"++shown)
-
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Sort the attributes of an element in lexicographic order.
---
--- * returns : a function which takes an element (XTag), sorts its
--- attributes in lexicographic order and returns the changed element
-
-lexicographicAttributeOrder::XmlFilter
-lexicographicAttributeOrder
-=processAttrlsortAttrl
-where
-sortAttrlal
-=map(al!!)ixs
-where
-ns=mapnameOfal
-ixs=mapsnd.sort.zipns$[(0::Int)..]
-
--- |
--- Normalize attribute values.
---
--- * returns : a function which takes an element (XTag), normalizes its
--- attribute values and returns the changed element
-
-normalizeAttributeValues::XmlTree->XmlTrees->XmlFilter
-normalizeAttributeValueselemDescr@(NTree(XDTDELEMENT_)_)dtdPart
-=processAttrnormalizeAttr
-where
-elemName=valueOfDTDa_nameelemDescr
-declaredAtts=isAttlistOfElementelemName$$dtdPart
-
-normalizeAttr::XmlFilter
-normalizeAttratt
-=normalizeAttrValue(ifnullattDescr
-thenNothing
-elseJust(headattDescr))att
-where
-attDescr=filter(\x->(valueOfDTDa_valuex)==nameOfatt)declaredAtts
-
-normalizeAttrValue::MaybeXmlTree->XmlFilter
-normalizeAttrValuedescr
-=modifyChildren((modifyText(normalizeAttributeValuedescr)$$).xmlTreesToText)
-
-normalizeAttributeValuesn_
-=error("normalizeAttributeValues: illegeal parameter:\n"++shown)
-
-
-
--- |
--- Set default attribute values if they are not set.
---
--- * returns : a function which takes an element (XTag), adds missing attribute
--- defaults and returns the changed element
-
-setDefaultAttributeValues::XmlTree->XmlTrees->XmlFilter
-setDefaultAttributeValueselemDescr@(NTree(XDTDELEMENT_)_)dtdPart
-=seqF(mapsetDefaultdefaultAtts)
-where
--- select the element name from the dtd
-elemName=valueOfDTDa_nameelemDescr
-
-defaultAtts=(isFixedAttrKind-- select attributes with default values
-`orElse`
-isDefaultAttrKind
-)
-$$
-(isAttlistOfElementelemName$$dtdPart)
-
-setDefault::XmlTree->XmlFilter
-setDefaultattrDescr-- add the default attributes
-=(addAttrattNamedefaultValue-- to tag nodes with missing attributes
-`whenNot`
-hasAttrattName
-)
-`when`
-isXTag
-where
-attName=valueOfDTDa_valueattrDescr
-defaultValue=valueOfDTDa_defaultattrDescr
-
-
-setDefaultAttributeValuesn_
-=error("setDefaultAttributeValues: illegeal parameter:\n"++shown)
-
-
-
-- |
--- This module provides functions for validating XML Documents represented as
--- XmlTree.
-
--- Unlike other popular XML validation tools the validation process returns
--- a list of errors instead of aborting after the first error was found.
-
-
--- Before the document is validated, a lookup-table is build on the basis of
--- the DTD which maps element names to their validation functions.
--- After this initialization phase the whole document is traversed in preorder
--- and every element is validated by the XmlFilter from the lookup-table.
-
--- Special namings in source code:
---
--- - nd - XDTD node
---
--- - n - XTag node
---
--- Author : .\\artin Schmidt
--- Version : $Id: DocValidation.hs,v 1.1 2004/09/02 19:12:03 hxml Exp $
-
-moduleText.XML.HXT.Validator.DocValidation
-(validateDoc
-)
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.Validator.AttributeValueValidation
-importText.XML.HXT.Validator.XmlRE
-
-importData.Maybe
-
--- |
--- Lookup-table which maps element names to their validation functions. The
--- validation functions are XmlFilters.
-
-typeValiEnvTable=[ValiEnv]
-typeValiEnv=(ElemName,ValFct)
-typeElemName=String
-typeValFct=XmlFilter
-
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Validate a document.
---
--- * 1.parameter dtdPart : the DTD subset (Node @DOCTYPE@) of the XmlTree
---
--- - 2.parameter doc : the document subset of the XmlTree
---
--- - returns : a list of errors
-
-validateDoc::XmlTree->XmlTree->XmlTrees
-validateDocdtdPartdoc
-=traverseTreevalTabledoc
-where
-valTable={-# SCC "buildAllValFcts" #-}buildAllValidationFunctionsdtdPart
-
-
--- |
--- Traverse the XmlTree in preorder.
---
--- * 1.parameter valiEnv : lookup-table which maps element names to their validation functions
---
--- - returns : list of errors
-
-traverseTree::ValiEnvTable->XmlFilter
-traverseTreevaliEnvn@(NTree(XTagname_)cs)
-=(valFctn)++concatMap(traverseTreevaliEnv)cs
-where
-valFct::XmlFilter
-valFct
-=case(lookup(qualifiedNamename)valiEnv)of
-Nothing->err("Element "++show(qualifiedNamename)++" not declared in DTD.")
-Justf->f
-
-traverseTree__=[]
-
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Build all validation functions.
---
--- * 1.parameter dtdPart : DTD subset, root node should be of type @DOCTYPE@
---
--- - returns : lookup-table which maps element names to their validation functions
-
-buildAllValidationFunctions::XmlTree->ValiEnvTable
-buildAllValidationFunctionsdtdPart
-=buildValidateRootdtdPart
-:
--- construct a list of validation filters for all element declarations
-map(buildValidateFunctionsdtdNodes)(isElement$$dtdNodes)
-where
-dtdNodes=getChildrendtdPart
-
-
--- |
--- Build a validation function for the document root. By root node @\/@
--- is meant, which is the topmost dummy created by the parser.
---
--- * 1.parameter dtdPart : DTD subset, root node should be of type @DOCTYPE@
---
--- - returns : entry for the lookup-table
-
-buildValidateRoot::XmlTree->ValiEnv
-buildValidateRoot(NTree(XDTDDOCTYPEal)_)
-=(t_root,valFct)
-where
-name=lookup1a_nameal
-
-valFct::XmlFilter
-valFctnd@(NTree(XTag__)cs)
-=ifmsg==""
-then[]
-elseerr("Root Element must be "++showname++". "++msg)nd
-where
-re=re_sym(name)
-msg=checkRE(matchesrecs)
-
-valFctn=error("buildValidateRoot: illegeal parameter:\n"++shown)
-
-buildValidateRootnd
-=error("buildValidateRoot: illegeal parameter:\n"++shownd)
-
-
--- |
--- Build validation functions for an element.
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter nd : element declaration for which the validation functions are
--- created
---
--- - returns : entry for the lookup-table
-
-buildValidateFunctions::XmlTrees->XmlTree->ValiEnv
-
-buildValidateFunctionsdtdPartnd@(NTree(XDTDELEMENTal)_)
-=(elemName,valFct)
-where
-elemName=lookup1a_nameal
-
-valFct::XmlFilter
-valFct=buildContentValidationnd
-+++
-buildAttributeValidationdtdPartnd
-
-buildValidateFunctions_nd
-=error("buildValidateFunctions: illegeal parameter:\n"++shownd)
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Build validation functions for the content model of an element.
--- Validity constraint: Element Valid (3 \/ p.18 in Spec)
---
--- * 1.parameter nd : element declaration for which the content validation functions
--- are built
---
--- - returns : a function which takes an element (XTag), checks if its
--- children match its content model and returns a list of errors
-
-buildContentValidation::XmlTree->XmlFilter
-buildContentValidationnd@(NTree(XDTDELEMENTal)_)
-=contentValidationattrTypend
-where
-attrType=lookup1a_typeal
-
-
--- Delegates construction of the validation function on the basis of the
--- content model type
-contentValidation::String->XmlTree->XmlFilter
-contentValidationtyp(NTree(XDTDELEMENT_)cs)
-|typ==k_pcdata=contentValidationPcdata
-|typ==k_empty=contentValidationEmpty
-|typ==k_any=contentValidationAny
-|typ==v_children=contentValidationChildrencs
-|typ==v_mixed=contentValidationMixedcs
-|otherwise=error("contentValidation: unknown type: "++showtyp)
-
-contentValidation_nd'
-=error("contentValidation: illegeal parameter:\n"++shownd')
-
-
--- Checks #PCDATA content models
-contentValidationPcdata::XmlFilter
-contentValidationPcdatan@(NTree(XTagname_)cs)
-=ifmsg==""
-then[]
-elseerr("The content of element "++show(qualifiedNamename)++
-" must match (#PCDATA). "++msg)n
-where
-re=re_rep(re_symk_pcdata)
-msg=checkRE(matchesrecs)
-
-contentValidationPcdatan
-=error("contentValidationPcdata: illegeal parameter:\n"++shown)
-
-
--- Checks EMPTY content models
-contentValidationEmpty::XmlFilter
-contentValidationEmptyn@(NTree(XTagname_)cs)
-=ifmsg==""
-then[]
-elseerr("The content of element "++show(qualifiedNamename)++
-" must match EMPTY. "++msg)n
-where
-re=re_unit
-msg=checkRE(matchesrecs)
-
-contentValidationEmptyn
-=error("contentValidationEmpty: illegeal parameter:\n"++shown)
-
-
--- Checks ANY content models
-contentValidationAny::XmlFilter
-contentValidationAnyn@(NTree(XTagname_)cs)
-=ifmsg==""
-then[]
-elseerr("The content of element "++show(qualifiedNamename)++
-" must match ANY. "++msg)n
-where
-re=re_rep(re_dot)
-msg=checkRE(matchesrecs)
-
-contentValidationAnyn
-=error("contentValidationAny: illegeal parameter:\n"++shown)
-
-
--- Checks "children" content models
-contentValidationChildren::XmlTrees->XmlFilter
-contentValidationChildrencmn@(NTree(XTagname_)cs)
-=ifmsg==""
-then[]
-elseerr("The content of element "++show(qualifiedNamename)++
-" must match "++printREre++". "++msg)n
-where
-re=createRE(headcm)
-msg=checkRE(matchesrecs)
-
-contentValidationChildren_n
-=error("contentValidationChildren: illegeal parameter:\n"++shown)
-
-
--- Checks "mixed content" content models
-contentValidationMixed::XmlTrees->XmlFilter
-contentValidationMixedcmn@(NTree(XTagname_)cs)
-=ifmsg==""
-then[]
-elseerr("The content of element "++show(qualifiedNamename)++
-" must match "++printREre++". "++msg)n
-where
-re=re_rep(re_alt(re_symk_pcdata)(createRE(headcm)))
-msg=checkRE(matchesrecs)
-
-contentValidationMixed_n
-=error("contentValidationMixed: illegeal parameter:\n"++shown)
-
-
-buildContentValidationnd
-=error("buildContentValidation: illegeal parameter:\n"++shownd)
-
-
-
--- |
--- Build a regular expression from the content model. The regular expression
--- is provided by the module XmlRE.
---
--- * 1.parameter nd : node of the content model. Expected: @CONTENT@ or
--- @NAME@
---
--- - returns : regular expression of the content model
-
-createRE::XmlTree->REString
-createRE(NTree(XDTDCONTENTal)cs)
-=processModifiermodifier
-where
-modifier=lookup1a_modifieral
-kind=lookup1a_kindal
-
-processModifier::String->REString
-processModifierm
-|m==v_plus=re_plus(processKindkind)
-|m==v_star=re_rep(processKindkind)
-|m==v_option=re_opt(processKindkind)
-|m==v_null=processKindkind
-|otherwise=error("Unknown modifier: "++showm)
-
-processKind::String->REString
-processKindk
-|k==v_seq=makeSequencecs
-|k==v_choice=makeChoicecs
-|otherwise=error("Unknown kind: "++showk)
-
-makeSequence::XmlTrees->REString
-makeSequence[]=re_unit
-makeSequence(x:xs)=re_seq(createREx)(makeSequencexs)
-
-makeChoice::XmlTrees->REString
-makeChoice[]=re_zero""
-makeChoice(x:xs)=re_alt(createREx)(makeChoicexs)
-
-createRE(NTree(XDTDNAMEal)_)
-=re_sym(lookup1a_nameal)
-
-createREnd
-=error("createRE: illegeal parameter:\n"++shownd)
-
-
-
--- ------------------------------------------------------------
-
-
-
--- |
--- Build validation functions for the attributes of an element.
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter nd : element declaration for which the attribute validation functions
--- are created
---
--- - returns : a function which takes an element (XTag), checks if its
--- attributes are valid and returns a list of errors
-
-buildAttributeValidation::XmlTrees->XmlTree->XmlFilter
-buildAttributeValidationdtdPartnd=
-noDoublicateAttributes
-+++
-checkNotDeclardAttributesattrDeclsnd
-+++
-checkRequiredAttributesattrDeclsnd
-+++
-checkFixedAttributesattrDeclsnd
-+++
-checkValuesOfAttributesattrDeclsdtdPartnd
-where
-attrDecls=isAttlist$$dtdPart
-
-
--- |
--- Validate that all attributes of an element are unique.
--- Well-formdness constraint: Unique AttSpec (3.1 \/ p.19 in Spec)
---
--- - returns : a function which takes an element (XTag), checks if its
--- attributes are unique and returns a list of errors
-
-noDoublicateAttributes::XmlFilter
-noDoublicateAttributesn@(NTree(XTag__)_)
-=doubles.reverse$names
-where
-tagname=nameOfn
-names=mapnameOf.getAttrl$n
-
-doubles::[String]->XmlTrees
-doubles[]
-=[]
-doubles(n1:ns)
-=(ifn1`elem`ns
-thenerr("Attribute "++shown1++" was already specified for element "++showtagname++".")n
-else[]
-)++doublesns
-
-noDoublicateAttributesn
-=error("noDoublicateAttributes: illegeal parameter:\n"++shown)
-
-
--- |
--- Validate that all \#REQUIRED attributes are provided.
--- Validity constraint: Required Attributes (3.3.2 \/ p.28 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter nd : element declaration which attributes have to be checked
---
--- - returns : a function which takes an element (XTag), checks if all
--- required attributes are provided and returns a list of errors
-
-checkRequiredAttributes::XmlTrees->XmlTree->XmlFilter
-checkRequiredAttributesattrDecls(NTree(XDTDELEMENTal)_)
-=checkRequiredrequiredAtts
-where
-elemName=lookup1a_nameal
-requiredAtts=isRequiredAttrKind$$(isAttlistOfElementelemName$$attrDecls)
-
-
-checkRequired::XmlTrees->XmlFilter
-checkRequired((NTree(XDTDATTLISTal')_):xs)n@(NTree(XTagname_)_)
-=ifsatisfies(hasAttrattName)n
-thencheckRequiredxsn
-elseerr("Attribute "++showattName++" must be declared for element type "++
-show(qualifiedNamename)++".")n
-++
-checkRequiredxsn
-where
-attName=lookup1a_valueal'
-
-checkRequired[]_=[]
-
-checkRequiredndn
-=error("checkRequired: illegeal parameter:\n"++shownd++shown)
-
-
-checkRequiredAttributes_nd
-=error("checkRequiredAttributes: illegeal parameter:\n"++shownd)
-
-
-
--- |
--- Validate that \#FIXED attributes match the default value.
--- Validity constraint: Fixed Attribute Default (3.3.2 \/ p.28 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter nd : element declaration which attributes have to be checked
---
--- - returns : a function which takes an element (XTag), checks if all
--- fixed attributes match the default value and returns a list of errors
-
-checkFixedAttributes::XmlTrees->XmlTree->XmlFilter
-checkFixedAttributesattrDecls(NTree(XDTDELEMENTal)_)
-=checkFixedfixedAtts
-where
-elemName=lookup1a_nameal
-fixedAtts=isFixedAttrKind$$(isAttlistOfElementelemName$$attrDecls)
-
-
-checkFixed::XmlTrees->XmlFilter
-checkFixed(x@(NTree(XDTDATTLISTal')_):xs)n@(NTree(XTagname_)_)
-=ifsatisfies(hasAttrattName)n
-thenifattValue==fixedValue
-thencheckFixedxsn
-elseerr("Attribute "++showattName++" of element "++show(qualifiedNamename)++
-" with value "++showattValue++" must have a value of "++
-showfixedValue++".")n
-++
-checkFixedxsn
-elsecheckFixedxsn
-where
-attName=lookup1a_valueal'
-fixedValue=normalizeAttributeValue(Justx)(lookup1a_defaultal')
-attValue=normalizeAttributeValue(Justx)(valueOfattNamen)
-
-checkFixed[]_=[]
-
-checkFixedndn
-=error("checkFixed: illegeal parameter:\n"++shownd++shown)
-
-
-checkFixedAttributes_nd
-=error("checkFixedAttributes: illegeal parameter:\n"++shownd)
-
-
--- |
--- Validate that an element has no attributes which are not declared.
--- Validity constraint: Attribute Value Type (3.1 \/ p.19 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter nd : element declaration which attributes have to be checked
---
--- - returns : a function which takes an element (XTag), checks if all
--- attributes are declared and returns a list of errors
-
-checkNotDeclardAttributes::XmlTrees->XmlTree->XmlFilter
-checkNotDeclardAttributesattrDeclselemDescr
-=checkNotDeclared
-where
-elemName=valueOfDTDa_nameelemDescr
-decls=isAttlistOfElementelemName$$attrDecls
-
-checkNotDeclared::XmlFilter
-checkNotDeclaredn
-=(isXTag
-`guards`
-cat(map(searchForDeclaredAttelemNamedecls)(getAttrln))
-)n
-
-searchForDeclaredAtt::String->XmlTrees->XmlTree->XmlFilter
-searchForDeclaredAttname((NTree(XDTDATTLISTal')_):xs)att
-=if(lookup1a_valueal')==nameOfatt
-thennone
-elsesearchForDeclaredAttnamexsatt
-
-searchForDeclaredAttname[](NTree(XAttrattrName)_)
-=err("Attribute "++show(qualifiedNameattrName)++" of element "++showname++" is not declared in DTD.")
-
-searchForDeclaredAtt_nda
-=error("searchForDeclaredAtt: illegeal paramter:\n"++shownd++showa)
-
--- |
--- Validate that the attribute value meets the lexical constraints of its type.
--- Validity constaint: Attribute Value Type (3.1 \/ p.19 in Spec)
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter nd : element declaration which attributes have to be checked
---
--- - returns : a function which takes an element (XTag), checks if all
--- attributes meet the lexical constraints and returns a list of errors
-
-checkValuesOfAttributes::XmlTrees->XmlTrees->XmlTree->XmlFilter
-checkValuesOfAttributesattrDeclsdtdPartelemDescr
-=checkValues
-where
-elemName=valueOfDTDa_nameelemDescr
-decls=isAttlistOfElementelemName$$attrDecls
-
-checkValues::XmlFilter
-checkValuesn
-=(isXTag
-`guards`
-cat(map(checkValuedecls)(getAttrln))
-)n
-
-checkValue::XmlTrees->XmlTree->XmlFilter
-checkValue(attrDecl@(NTree(XDTDATTLISTal')_):xs)att
-=if(lookup1a_valueal')==nameOfatt
-thencheckAttributeValuedtdPartattrDecl
-elsecheckValuexsatt
-
-checkValue[]_
-=none-- undeclared attribute, reported by separate function
-
-checkValuen_
-=error("checkValue: illegeal parameter:\n"++shown)
-
-
-- |
--- This module provides functions for checking special ID/IDREF/IDREFS constraints.
-
--- Checking special ID/IDREF/IDREFS constraints means:
---
--- - checking that all ID values are unique.
---
--- - checking that all IDREF/IDREFS values match the value of some ID attribute
---
-
-
--- ID-Validation should be started before or after validating the document.
-
-
--- First all nodes with ID attributes are collected from the document, then
--- it is validated that values of ID attributes do not occure more than once.
--- During a second iteration over the document it is validated that there exists
--- an ID attribute value for IDREF/IDREFS attribute values.
-
--- Special namings in source code:
---
--- - nd - XDTD node
---
--- - n - XTag node
---
--- Author : .\\artin Schmidt
--- Version : $Id: IdValidation.hs,v 1.1 2004/09/02 19:12:03 hxml Exp $
-
-moduleText.XML.HXT.Validator.IdValidation
-(validateIds
-)
-where
-
-
-importText.XML.HXT.DOM.XmlTree
-importText.XML.HXT.Validator.AttributeValueValidation
-
-
-
--- |
--- Lookup-table which maps element names to their validation functions. The
--- validation functions are XmlFilters.
-
-typeIdEnvTable=[IdEnv]
-typeIdEnv=(ElemName,IdFct)
-typeElemName=String
-typeIdFct=XmlFilter
-
-
-
--- |
--- Perform the validation of the ID/IDREF/IDREFS constraints.
---
--- * 1.parameter dtdPart : the DTD subset (Node @DOCTYPE@) of the XmlTree
---
--- - 2.parameter doc : the document subset of the XmlTree
---
--- - returns : a list of errors
-
-validateIds::XmlTree->XmlTree->XmlTrees
-validateIdsdtdPartdoc
-={-# SCC "checkForUniqueIds" #-}checkForUniqueIdsidNodeListdtdNodes
-++
-{-# SCC "checkIdReferences" #-}checkIdReferencesidRefEnvdoc
-where
-idEnv=buildIdCollectorFctsdtdNodes
-idRefEnv=buildIdrefValidationFctsdtdNodesidNodeList
-idNodeList=traverseTreeidEnvdoc
-dtdNodes=getChildrendtdPart
-
-
--- |
--- Traverse the XmlTree in preorder.
---
--- * 1.parameter idEnv : lookup-table which maps element names to their validation functions
---
--- - returns : list of errors
-
-traverseTree::IdEnvTable->XmlFilter
-traverseTreeidEnvn@(NTree(XTagname_)cs)
-=(idFctn)++concatMap(traverseTreeidEnv)cs
-where
-idFct::XmlFilter
-idFct
-=case(lookup(qualifiedNamename)idEnv)of
-Nothing->none
-Justf->f
-
-traverseTree__=[]
-
-
-
--- |
--- Returns the value of an element's ID attribute. The attribute name has to be
--- retrieved first from the DTD.
---
--- * 1.parameter dtdPart : list of ID attribute definitions from the DTD
---
--- - 2.parameter n : element which ID attribute value should be returned
---
--- - returns : normalized value of the ID attribute
-
-getIdValue::XmlTrees->XmlTree->String
-getIdValue(x@(NTree(XDTDATTLISTal)_):xs)n@(NTree(XTagname_al')_)
-=if(qualifiedNamename)==elemName
-thenattrValue
-elsegetIdValuexsn
-where
-elemName=lookup1a_nameal
-attrName=lookup1a_valueal
-attrValue=normalizeAttributeValue(Justx)(valueOfattrNamen)
-
-getIdValue__=""
-
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Build collector functions which return XTag nodes with ID attributes from
--- a document.
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - returns : lookup-table which maps element names to their collector function
-
-buildIdCollectorFcts::XmlTrees->IdEnvTable
-buildIdCollectorFctsdtdPart
-=map(buildIdCollectorFct)(isIdAttrType$$dtdPart)
-where
-buildIdCollectorFct::XmlTree->IdEnv
-buildIdCollectorFct(NTree(XDTDATTLISTal)_)
-=(elemName,hasAttrattrName)
-where
-elemName=lookup1a_nameal
-attrName=lookup1a_valueal
-
-buildIdCollectorFctnd
-=error("buildIdCollectorFct: illegeal parameter:\n"++shownd)
-
-
--- |
--- Build validation functions for checking if IDREF\/IDREFS values match a value
--- of some ID attributes.
---
--- * 1.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - 2.parameter idNodeList : list of all XTag nodes with ID attributes
---
--- - returns : lookup-table which maps element names to their validation function
-
-buildIdrefValidationFcts::XmlTrees->XmlTrees->IdEnvTable
-buildIdrefValidationFctsdtdPartidNodeList
-=mapbuildElemValidationFctelements
-where
-elements=isElement$$dtdPart
-idValueList=getIdValues(isIdAttrType$$dtdPart)
-
-getIdValues::XmlTrees->[String]
-getIdValuesidAttrTypes
-=map(getIdValueidAttrTypes)idNodeList
-
-
-buildElemValidationFct::XmlTree->IdEnv
-buildElemValidationFct(NTree(XDTDELEMENTal)_)
-=(elemName,buildIdrefValidationFctidRefAttrTypes)
-where
-elemName=lookup1a_nameal
-idRefAttrTypes=isIdRefAttrType$$(isAttlistOfElementelemName)$$dtdPart
-
-buildElemValidationFctnd
-=error("buildIdrefValidationFct: illegeal parameter:\n"++shownd)
-
-
-buildIdrefValidationFct::XmlTrees->XmlFilter
-buildIdrefValidationFct(nd@(NTree(XDTDATTLISTal)_):xs)
-=checkIdref+++buildIdrefValidationFctxs
-where
-attrName=lookup1a_valueal
-attrType=lookup1a_typeal
-
-checkIdref::XmlFilter
-checkIdrefn@(NTree(XTagname_)_)
-=ifsatisfies(hasAttrattrName)n
-thenifattrType==k_idref
-thencheckValueDeclarednattrValue
-elseletvalueList=wordsattrValue
-inifnullvalueList
-thenerr("Attribute "++showattrName++
-" of Element "++show(qualifiedNamename)++
-" must have at least one name.")n
-elseconcatMap(checkValueDeclaredn)(wordsattrValue)
-else[]
-where
-attrValue=normalizeAttributeValue(Justnd)(valueOfattrNamen)
-
-checkIdref_=[]
-
-
-checkValueDeclared::XmlTree->String->XmlTrees
-checkValueDeclaredn@(NTree(XTag__)_)attrValue
-=ifattrValue`elem`idValueList
-then[]
-elseerr("An Element with identifier "++showattrValue++
-" must appear in the document.")n
-
-checkValueDeclared__=[]
-
-buildIdrefValidationFct[]
-=none
-
-buildIdrefValidationFctnd
-=error("buildIdCollectorFct: illegeal parameter:\n"++shownd)
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Validate that all ID values are unique within a document.
--- Validity constraint: ID (3.3.1 \/p. 25 in Spec)
---
--- * 1.parameter idNodeList : list of all XTag nodes with ID attributes
---
--- - 2.parameter dtdPart : the children of the @DOCTYPE@ node
---
--- - returns : a list of errors
-
-checkForUniqueIds::XmlTrees->XmlTrees->XmlTrees
-checkForUniqueIdsidNodeListdtdPart
-=checkForUniqueIdidNodeList[]
-where
-idAttrTypes=isIdAttrType$$dtdPart
-
-checkForUniqueId::XmlTrees->[String]->XmlTrees
-checkForUniqueId(x@(NTree(XTagname_)_):xs)used
-=ifattrValue`elem`used
-thenerr("Attribute value "++showattrValue++" of type ID for element "++
-show(qualifiedNamename)++" must be unique within the document.")x
-++
-checkForUniqueIdxsused
-
-elsecheckForUniqueIdxs(attrValue:used)
-where
-attrValue=getIdValue(isAttlistOfElement(qualifiedNamename)$$idAttrTypes)x
-
-checkForUniqueId__=[]
-
-
-
--- |
--- Validate that all IDREF\/IDREFS values match the value of some ID attribute.
--- Validity constraint: IDREF (3.3.1 \/ p.26 in Spec)
---
--- * 1.parameter idRefEnv : lookup-table which maps element names to their validation function
---
--- - 2.parameter doc : the document to validate
---
--- - returns : a list of errors
-
-checkIdReferences::IdEnvTable->XmlTree->XmlTrees
-checkIdReferencesidRefEnvdoc
-=traverseTreeidRefEnvdoc
-
-
-
-
-
-
-- |
--- A module for regular expression matching based on derivatives of regular expressions.
---
--- The code was taken from Joe English (<http://www.flightlab.com/~joe/sgml/validate.html>).
--- Tested and extended by Martin Schmidt.
---
--- Further references for the algorithm:
---
--- Janusz A. Brzozowski.
---
--- Derivatives of Regular Expressions. Journal of the ACM, Volume 11, Issue 4, 1964.
---
--- Mark Hopkins.
---
--- Regular Expression Package. Posted to comp.compilers, 1994.
--- Available per FTP at <ftp://iecc.com/pub/file/regex.tar.gz>.
---
--- Version : $Id: RE.hs,v 1.1 2004/09/02 19:12:03 hxml Exp $
-
-moduleText.XML.HXT.Validator.RE
-(RE(..)
-
-,re_unit
-,re_zero
-,re_sym
-,re_rep
-,re_plus
-,re_opt
-,re_seq
-,re_alt
-,re_dot
-
-,checkRE
-,matches
-,nullable
-,printRE
-)
-where
-
--- |
--- Data type for regular expressions.
-
-dataREa=
-RE_ZEROString--' L(0) = {} (empty set)
-|RE_UNIT--' L(1) = { [] } (empty sequence)
-|RE_SYMa--' L(x) = { [x] }
-|RE_DOT--' accept any single symbol
-|RE_REP(REa)--' L(e*) = { [] } `union` L(e+)
-|RE_PLUS(REa)--' L(e+) = { x ++ y | x <- L(e), y <- L(e*) }
-|RE_OPT(REa)--' L(e?) = L(e) `union` { [] }
-|RE_SEQ(REa)(REa)--' L(e,f) = { x ++ y | x <- L(e), y <- L(f) }
-|RE_ALT(REa)(REa)--' L(e|f) = L(e) `union` L(f)
-deriving(Show,Eq)
-
-
-
--- ------------------------------------------------------------
--- Constructor functions to simplify regular expressions when constructing them.
-
--- |
--- Constructs a regular expression for an empty set.
---
--- * 1.parameter errMsg : error message
---
--- - returns : regular expression for an empty set
-
-re_zero::String->REa
-re_zerom=RE_ZEROm
-
-
--- |
--- Constructs a regular expression for an empty sequence.
---
--- - returns : regular expression for an empty sequence
-
-re_unit::REa
-re_unit=RE_UNIT
-
-
--- |
--- Constructs a regular expression for accepting a symbol
---
--- * 1.parameter sym : the symbol to be accepted
---
--- - returns : regular expression for accepting a symbol
-
-re_sym::a->REa
-re_symx=RE_SYMx
-
-
--- |
--- Constructs a regular expression for accepting any singel symbol
---
--- - returns : regular expression for accepting any singel symbol
-
-re_dot::REa
-re_dot=RE_DOT
-
-
--- |
--- Constructs an optional repetition (*) of a regular expression
---
--- * 1.parameter re_a : regular expression to be repeted
---
--- - returns : new regular expression
-
-re_rep::REa->REa
-re_repRE_UNIT=RE_UNIT
-re_rep(RE_ZERO_)=RE_UNIT
-re_repe@(RE_REP_)=RE_REP(rem_repe)-- remove nested reps
-re_repe@(RE_ALT__)=RE_REP(rem_repe)-- remove nested reps in alternatives
-re_repe=RE_REPe
-
--- |
--- remove redundant nested *'s in RE
--- theoretically this is unneccessary,
--- but without this simplification the runtime can increase exponentally
--- when computing deltas, e.g. for a** or (a|b*)* which is the same as (a|b)*
-
-rem_rep::REa->REa
-rem_rep(RE_ALTe1e2)=RE_ALT(rem_repe1)(rem_repe2)
-rem_rep(RE_REPe1)=rem_repe1
-rem_repe1=e1
-
-
--- |
--- Constructs a repetition (+) of a regular expression
---
--- * 1.parameter re_a : regular expression to be repeted
---
--- - returns : new regular expression
-
-re_plus::REa->REa
-re_plusRE_UNIT=RE_UNIT
-re_plus(RE_ZEROm)=RE_ZEROm
-re_pluse=RE_PLUSe
-
-
--- |
--- Constructs an option (?) of a regular expression
---
--- * 1.parameter re_a : regular expression to be optional
---
--- - returns : new regular expression
-
-re_opt::REa->REa
-re_optRE_UNIT=RE_UNIT
-re_opt(RE_ZERO_)=RE_UNIT
-re_opte=RE_OPTe
-
-
--- |
--- Constructs a sequence (,) of two regular expressions
---
--- * 1.parameter re_a : first regular expression in sequence
---
--- - 2.parameter re_b : second regular expression in sequence
---
--- - returns : new regular expression
-
-re_seq::REa->REa->REa
-re_seq(RE_ZEROm)_=RE_ZEROm
-re_seqRE_UNITf=f
-re_seq_(RE_ZEROm)=RE_ZEROm
-re_seqeRE_UNIT=e
-re_seqef=RE_SEQef
-
-
--- |
--- Constructs an alternative (|) of two regular expressions
---
--- * 1.parameter re_a : first regular expression of alternative
---
--- - 2.parameter re_b : second regular expression of alternative
---
--- - returns : new regular expression
-
-re_alt::REa->REa->REa
-re_alt(RE_ZERO_)f=f
-re_alte(RE_ZERO_)=e
-re_altef=RE_ALTef
-
-
-
--- ------------------------------------------------------------
-
-
--- |
--- Checks if a regular expression matches the empty sequence.
---
--- nullable e == [] `in` L(e)
---
--- This check indicates if a regular expression fits to a sentence or not.
---
--- * 1.parameter re : regular expression to be checked
---
--- - returns : true if regular expression matches the empty sequence,
--- otherwise false
-
-nullable::(Showa)=>REa->Bool
-nullable(RE_ZERO_)=False
-nullableRE_UNIT=True
-nullable(RE_SYM_)=False
-nullable(RE_REP_)=True
-nullable(RE_PLUSe)=nullablee
-nullable(RE_OPT_)=True
-nullable(RE_SEQef)=nullablee&&nullablef
-nullable(RE_ALTef)=nullablee||nullablef
-nullableRE_DOT=False
-
-
--- |
--- Derives a regular expression with respect to one symbol.
---
--- L(delta e x) = x \ L(e)
---
--- * 1.parameter re : regular expression to be derived
---
--- - 2.parameter sym : the symbol on which the regular expression is applied
---
--- - returns : the derived regular expression
-
-delta::(Eqa,Showa)=>REa->a->REa
-deltarex=casereof
-RE_ZERO_->re-- re_zero m
-RE_UNIT->re_zero("Symbol "++showx++" unexpected.")
-RE_SYMsym
-|x==sym->re_unit
-|otherwise->re_zero("Symbol "++showsym++" expected, but symbol "++showx++" found.")
-RE_REPe->re_seq(deltaex)re-- (re_rep e)
-RE_PLUSe->re_seq(deltaex)(re_repe)
-RE_OPTe->deltaex
-RE_SEQef
-|nullablee->re_alt(re_seq(deltaex)f)(deltafx)
-|otherwise->re_seq(deltaex)f
-RE_ALTef->re_alt(deltaex)(deltafx)
-RE_DOT->re_unit
-
-
--- |
--- Derives a regular expression with respect to a sentence.
---
--- * 1.parameter re : regular expression
---
--- - 2.parameter s : sentence to which the regular expression is applied
---
--- - returns : the derived regular expression
-
-matches::(Eqa,Showa)=>REa->[a]->REa
-matchese=foldldeltae
-
-
--- |
--- Checks if an input matched a regular expression. The function should be
--- called after matches.
---
--- Was the sentence used in @matches@ in the language of the regular expression?
--- -> matches e s == s `in` L(e)?
---
--- * 1.parameter re : the derived regular expression
---
--- - returns : empty String if input matched the regular expression, otherwise
--- an error message is returned
-
-checkRE::(Showa)=>REa->String
-checkRE(RE_UNIT)=""
-checkRE(RE_ZEROm)=m
-checkREre
-|nullablere=""
-|otherwise="Input must match "++printREre
-
-
-
--- ------------------------------------------------------------
-
-
-
--- |
--- Constructs a string representation of a regular expression.
---
--- * 1.parameter re : a regular expression
---
--- - returns : the string representation of the regular expression
-
-printRE::(Showa)=>REa->String
-printREre'
-="( "++printRE1re'++" )"
-where
-printRE1::(Showa)=>REa->String
-printRE1re=casereof
-RE_ZEROm->"ERROR: "++m
-RE_UNIT->""
-RE_SYMsym->showsym
-RE_DOT->"."
-RE_REPe
-|isSinglee->printRE1e++"*"
-|otherwise->"("++printRE1e++")*"
-RE_PLUSe
-|isSinglee->printRE1e++"+"
-|otherwise->"("++printRE1e++")+"
-RE_OPTe
-|isSinglee->printRE1e++"?"
-|otherwise->"("++printRE1e++")?"
-RE_SEQef
-|isAlte&¬(isAltf)->"("++printRE1e++") , "++printRE1f
-|not(isAlte)&&isAltf->printRE1e++" , ("++printRE1f++")"
-|isAlte&&isAltf->"("++printRE1e++") , ("++printRE1f++")"
-|otherwise->printRE1e++" , "++printRE1f
-RE_ALTef
-|isSeqe&¬(isSeqf)->"("++printRE1e++") | "++printRE1f
-|not(isSeqe)&&isSeqf->printRE1e++" | ("++printRE1f++")"
-|isSeqe&&isSeqf->"("++printRE1e++") | ("++printRE1f++")"
-|otherwise->printRE1e++" | "++printRE1f
-
-
-isSingle::REa->Bool
-isSingle(RE_ZERO_)=True
-isSingleRE_UNIT=True
-isSingle(RE_SYM_)=True
-isSingle_=False
-
-
-isSeq::REa->Bool
-isSeq(RE_SEQ__)=True
-isSeq_=False
-
-
-isAlt::REa->Bool
-isAlt(RE_ALT__)=True
-isAlt_=False
-
-- |
--- This module provides a state filter as a main function for validating XML documents.
---
--- The real validation is done with pure filters from module 'Text.XML.HXT.Validator.ValidationFilter'
---
--- Author : .\\artin Schmidt
--- Version : $Id: Validation.hs,v 1.2 2004/11/23 15:50:23 hxml Exp $
-
-moduleText.XML.HXT.Validator.Validation
-(getValidatedDoc
-,moduleText.XML.HXT.Validator.ValidationFilter
-)
-
-where
-
-importText.XML.HXT.DOM.XmlTree
-importText.XML.HXT.DOM.XmlState
-
-importText.XML.HXT.Validator.ValidationFilter
-
-importText.XML.HXT.Parser.XmlOutput
-(traceTree
-,traceSource
-,traceMsg
-)
-
--- ------------------------------------------------------------
-
--- |
--- monadic filter for validating and transforming a wellformed document.
---
--- the "main" function for validation.
---
--- the input tree must consist of a root node with a complete document and DTD.
--- Result is the single element list containing same tree but tranformed with respect to the DTD,
--- or, in case of errors, the root with an empty list of children
-
-getValidatedDoc::XmlStateFilterstate
-getValidatedDoc
-=traceMsg1"validating document"
-.>>
-((runValidation
-.>>
-traceTree
-.>>
-traceSource
-)
-`whenM`(isRoot.>getChildren)
-)
-where
-runValidationt
-=do
-issueError$$<res
-(ifnullerrs
-then(traceMsg1"transforming validated document"
-.>>
-liftMftransform
-)
-elseliftMf(setStatusc_err"validating document")
-)t
-where
-res=validatet
-errs=isXError.>negisWarning$$res
-
--- ------------------------------------------------------------
-
-- |
--- This module provides functions for validating XML documents represented as
--- XmlTree.
-
--- Unlike other popular XML validation tools the validation functions return
--- a list of errors instead of aborting after the first error was found.
---
--- Note: The validation process has been split into validation and transformation!
--- If @validate@ did not report any errors, @transform@
--- should be called, to change the document the way a validating parser
--- is expected to do.
-
---
--- Author : .\\artin Schmidt
--- Version : $Id: ValidationFilter.hs,v 1.1 2004/11/23 15:50:23 hxml Exp $
-
-moduleText.XML.HXT.Validator.ValidationFilter
-(getDTDSubset
-,validate
-,validateDTD
-,validateDoc
-,removeDoublicateDefs
-,transform
-)
-
-where
-
-importText.XML.HXT.DOM.XmlTree
-
-importqualifiedText.XML.HXT.Validator.DTDValidationasDTDValidation
-importqualifiedText.XML.HXT.Validator.DocValidationasDocValidation
-importqualifiedText.XML.HXT.Validator.IdValidationasIdValidation
-importqualifiedText.XML.HXT.Validator.DocTransformationasDocTransformation
-
--- |
--- Main validation filter. Check if the DTD and the document are valid.
---
---
--- - returns : a function which expects a complete document as XmlTree input
--- and returns a list of all errors found.
-
-validate::XmlFilter
-validate=validateDTD+++validateDoc
-
--- |
--- Check if the DTD is valid.
---
---
--- - returns : a function which expects an XmlTree from the parser as input
--- and returns a list of all errors found in the DTD.
-
-validateDTD::XmlFilter
-validateDTD
-=choice[getDTDSubset
-:->DTDValidation.validateDTD
-,this
-:->err"Can't validate DTD: There is no DOCTYPE declaration in the document."
-]
--- |
--- Check if the document corresponds to the given DTD.
---
---
--- - returns : a function which expects a complete document as XmlTree input
--- and returns a list of all errors found in the content part.
-
-validateDoc::XmlFilter
-validateDoct
-=(ifnulldtds
-thenerr"Can't validate document: There is no DOCTYPE declaration in the document."
-else(DocValidation.validateDocdtdPart
-+++
-IdValidation.validateIdsdtdPart
-)
-)$t
-where
-dtds=getDTDSubset.>processBottomUpremoveDoublicateDefs$t
-dtdPart=headdtds
-
--- |
--- filter for transforming a document with respect to the given DTD.
---
--- Validating parsers
--- are expected to normalize attribute values and add default values.
--- This function should be called after a successful validation.
---
---
--- - returns : a function which expects a complete XML document tree
--- and returns the transformed XmlTree
-
-transform::XmlFilter
-transform
-=choice[isRoot
-:->transformDoc
-,this
-:->fatal"Can't transform document: No document root given"
-]
-where
-transformDoct
-|nulldtds
-=thist
-|otherwise
-=DocTransformation.transform(headdtds)t
-where
-dtds=getDTDSubset.>processBottomUpremoveDoublicateDefs$t
-
--- |
--- Removes doublicate declarations from the DTD which first declaration is
--- binding. This is the case for ATTLIST and ENTITY declarations.
---
---
--- - returns : A function that replaces the children of DOCTYPE nodes by a list
--- where all multiple declarations are removed.
-
-removeDoublicateDefs::XmlFilter
-removeDoublicateDefs
-=DTDValidation.removeDoublicateDefs
-
---
--- selects the DTD part of a document
--- but only, if there is more than the internal part for the 4 predefined XML entities
-
-getDTDSubset::XmlFilter
-getDTDSubset
-=getChildren.>isDoctype.>hasRootName
-where
-hasRootName=isOf(hasEntrya_name.attrlOfDTD)
-
-- |
--- A module for regular expression matching, adapted for XML DTDs.
---
--- This module is based on the module RE.
---
--- Author .\\artin Schmidt
-
--- Version : $Id: XmlRE.hs,v 1.1 2004/09/02 19:12:03 hxml Exp $
-
-moduleText.XML.HXT.Validator.XmlRE
-(RE
-
-,checkRE
-,matches
-,printRE
-
-,re_unit
-,re_zero
-,re_sym
-,re_rep
-,re_plus
-,re_opt
-,re_seq
-,re_alt
-,re_dot
-)
-where
-
--- import Debug.Trace(trace)
-
-importText.XML.HXT.Validator.REhiding(matches)
-
-importText.XML.HXT.DOM.XmlTree
-
-importText.XML.HXT.DOM.EditFilters
-(removeComment
-,removeWhiteSpace
-)
-
--- |
--- Derives a regular expression with respect to a list of elements.
---
--- * 1.parameter re : regular expression
---
--- - 2.parameter list : list of elements to which the regular expression is applied
---
--- - returns : the derived regular expression
-
-matches::REString->XmlTrees->REString
-matchesrelist
-=foldldeltare(removeUnimportantStuff$$list)
-where
-removeUnimportantStuff::XmlFilter
-removeUnimportantStuff=processBottomUp(removeWhiteSpace`o`removeComment)
--- trace of growth of REs
--- delta' re el = delta (trace (("RE : " ++) . (++ "\n" ) . show $ re) re) el
-
-
--- |
--- Derives a regular expression with respect to one element.
---
--- L(delta e x) = x \ L(e)
---
--- * 1.parameter re : regular expression to be derived
---
--- - 2.parameter el : the element on which the regular expression is applied
---
--- - returns : the derived regular expression
-
-delta::REString->XmlTree->REString
-deltareel
-|not(allowedel)=re
-|otherwise=casereof
-RE_ZEROm->re_zerom
-RE_UNIT->re_zero(elemNameel++" unexpected.")
-RE_SYMsym
-|sym==k_pcdata->letnode=getNodeelin
-if((isXTextNodenode)||(isXCdataNodenode))
-thenre_unit
-elsere_zero("Character data expected, but "++elemNameel++" found.")
-|expectedNodeelsym->re_unit
-|otherwise->re_zero("Element "++showsym++" expected, but "++elemNameel++" found.")
-RE_REPe->re_seq(deltaeel)(re_repe)
-RE_PLUSe->re_seq(deltaeel)(re_repe)
-RE_OPTe->deltaeel
-RE_SEQef
-|nullablee->re_alt(re_seq(deltaeel)f)(deltafel)
-|otherwise->re_seq(deltaeel)f
-RE_ALTef->re_alt(deltaeel)(deltafel)
-RE_DOT->re_unit
-
-where
-expectedNode::XmlTree->String->Bool
-expectedNode(NTree(XTagn_)_)sym=(qualifiedNamen)==sym
-expectedNode__=False
-
-elemName::XmlTree->String
-elemName(NTree(XTagn_)_)="element "++show(qualifiedNamen)
-elemName_="character data"
-
-allowed::XmlTree->Bool
-allowed(NTree(XTag__)_)=True
-allowed(NTree(XText_)_)=True
-allowed(NTree(XCdata_)_)=True
-allowed_=False
-
This version works with ghc 6.8 and ghc 6.6 with cabal
@@ -229,7 +229,7 @@
Before installing this version, install the Haskell HTTP module.
For a quick install with Cabal execute the following commands in
- .../HXT-8.0.0
+ .../HXT-8.1.0
+ HTTP interface changed to work with libcurl
+ via curl bindings with package curl.
+ So the HTTP package is not longer needed, also the old
+ and somewhat inefficent interface to curl by starting an external process and
+ communicate via a pipe is not longer needed.
+ When installing the curl bindings, be aware that the
+ libcurl development packages including the C header files
+ must be installed. Otherwise the Setup.hs will complain of
+ missing files.
+
+
+ New input option for ignoring none XML/HTML contents
+ when reading documents (useful for crawler like applications).
+
+
+ Mime type support for the file: protocol. Mime type mapping
+ can be controlled by a config file in the format of
+ /etc/mime.types on some linux systems.
+
+ A few more picklers for de-serialization from/to XML, e.g. for maps.
+
+
+ A new option for ignoring decoding errors when reading XML documents.
+ This may be useful for crawler like applications.
+
Instances