hxt 8.5.2 → 8.5.4

raw patch · 94 files changed

+11716/−11686 lines, 94 filesdep ~tagsoupPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: tagsoup

API changes (from Hackage documentation)

Files

• LICENCE +0/−9
• LICENSE +9/−0
• examples/arrows/hparser/Makefile +2/−0
• examples/arrows/hparser/lousy.html +3/−3
• hxt.cabal +24/−14
• src/Control/Arrow/ArrowIO.hs +10/−10
• src/Control/Arrow/ArrowIf.hs +45/−45
• src/Control/Arrow/ArrowList.hs +54/−54
• src/Control/Arrow/ArrowNF.hs +4/−4
• src/Control/Arrow/ArrowState.hs +12/−12
• src/Control/Arrow/ArrowTree.hs +119/−119
• src/Control/Arrow/IOListArrow.hs +51/−51
• src/Control/Arrow/IOStateListArrow.hs +79/−79
• src/Control/Arrow/ListArrow.hs +33/−33
• src/Control/Arrow/ListArrows.hs +4/−4
• src/Control/Arrow/StateListArrow.hs +82/−82
• src/Data/AssocList.hs +18/−18
• src/Data/Atom.hs +32/−32
• src/Data/Tree/Class.hs +20/−20
• src/Data/Tree/NTree/TypeDefs.hs +37/−37
• src/Text/XML/HXT/Arrow.hs +3/−3
• src/Text/XML/HXT/Arrow/DTDProcessing.hs +318/−318
• src/Text/XML/HXT/Arrow/DocumentInput.hs +234/−234
• src/Text/XML/HXT/Arrow/DocumentOutput.hs +106/−106
• src/Text/XML/HXT/Arrow/Edit.hs +281/−281
• src/Text/XML/HXT/Arrow/GeneralEntitySubstitution.hs +213/−213
• src/Text/XML/HXT/Arrow/Namespace.hs +183/−183
• src/Text/XML/HXT/Arrow/ParserInterface.hs +59/−59
• src/Text/XML/HXT/Arrow/Pickle.hs +61/−61
• src/Text/XML/HXT/Arrow/Pickle/DTD.hs +148/−148
• src/Text/XML/HXT/Arrow/Pickle/Schema.hs +121/−121
• src/Text/XML/HXT/Arrow/Pickle/Xml.hs +219/−219
• src/Text/XML/HXT/Arrow/ProcessDocument.hs +102/−102
• src/Text/XML/HXT/Arrow/ReadDocument.hs +159/−159
• src/Text/XML/HXT/Arrow/WriteDocument.hs +63/−63
• src/Text/XML/HXT/Arrow/XmlArrow.hs +258/−258
• src/Text/XML/HXT/Arrow/XmlIOStateArrow.hs +283/−283
• src/Text/XML/HXT/Arrow/XmlRegex.hs +145/−145
• src/Text/XML/HXT/DOM/FormatXmlTree.hs +17/−17
• src/Text/XML/HXT/DOM/Interface.hs +4/−4
• src/Text/XML/HXT/DOM/IsoLatinTables.hs +14/−14
• src/Text/XML/HXT/DOM/MimeTypeDefaults.hs +581/−581
• src/Text/XML/HXT/DOM/MimeTypes.hs +52/−52
• src/Text/XML/HXT/DOM/QualifiedName.hs +4/−4
• src/Text/XML/HXT/DOM/ShowXml.hs +118/−118
• src/Text/XML/HXT/DOM/TypeDefs.hs +69/−69
• src/Text/XML/HXT/DOM/UTF8Decoding.hs +4/−4
• src/Text/XML/HXT/DOM/Unicode.hs +190/−190
• src/Text/XML/HXT/DOM/Util.hs +86/−86
• src/Text/XML/HXT/DOM/XmlKeywords.hs +166/−166
• src/Text/XML/HXT/DOM/XmlNode.hs +213/−213
• src/Text/XML/HXT/DOM/XmlOptions.hs +71/−71
• src/Text/XML/HXT/DTDValidation/AttributeValueValidation.hs +63/−63
• src/Text/XML/HXT/DTDValidation/DTDValidation.hs +238/−238
• src/Text/XML/HXT/DTDValidation/DocTransformation.hs +53/−53
• src/Text/XML/HXT/DTDValidation/DocValidation.hs +183/−183
• src/Text/XML/HXT/DTDValidation/IdValidation.hs +90/−90
• src/Text/XML/HXT/DTDValidation/RE.hs +98/−98
• src/Text/XML/HXT/DTDValidation/TypeDefs.hs +68/−68
• src/Text/XML/HXT/DTDValidation/Validation.hs +30/−30
• src/Text/XML/HXT/DTDValidation/XmlRE.hs +17/−17
• src/Text/XML/HXT/IO/GetFILE.hs +66/−66
• src/Text/XML/HXT/IO/GetHTTPLibCurl.hs +155/−155
• src/Text/XML/HXT/Parser/HtmlParsec.hs +219/−219
• src/Text/XML/HXT/Parser/ProtocolHandlerUtil.hs +21/−21
• src/Text/XML/HXT/Parser/TagSoup.hs +327/−312
• src/Text/XML/HXT/Parser/XhtmlEntities.hs +252/−252
• src/Text/XML/HXT/Parser/XmlCharParser.hs +19/−19
• src/Text/XML/HXT/Parser/XmlDTDParser.hs +245/−245
• src/Text/XML/HXT/Parser/XmlDTDTokenParser.hs +31/−31
• src/Text/XML/HXT/Parser/XmlEntities.hs +7/−7
• src/Text/XML/HXT/Parser/XmlParsec.hs +223/−223
• src/Text/XML/HXT/Parser/XmlTokenParser.hs +115/−115
• src/Text/XML/HXT/RelaxNG.hs +0/−0
• src/Text/XML/HXT/RelaxNG/BasicArrows.hs +157/−157
• src/Text/XML/HXT/RelaxNG/CreatePattern.hs +70/−70
• src/Text/XML/HXT/RelaxNG/DataTypeLibMysql.hs +64/−64
• src/Text/XML/HXT/RelaxNG/DataTypeLibUtils.hs +132/−132
• src/Text/XML/HXT/RelaxNG/DataTypeLibraries.hs +33/−33
• src/Text/XML/HXT/RelaxNG/DataTypes.hs +76/−76
• src/Text/XML/HXT/RelaxNG/PatternFunctions.hs +16/−16
• src/Text/XML/HXT/RelaxNG/PatternToString.hs +54/−54
• src/Text/XML/HXT/RelaxNG/Schema.hs +26/−26
• src/Text/XML/HXT/RelaxNG/SchemaGrammar.hs +26/−26
• src/Text/XML/HXT/RelaxNG/Simplification.hs +2249/−2249
• src/Text/XML/HXT/RelaxNG/Unicode/Blocks.hs +197/−197
• src/Text/XML/HXT/RelaxNG/Unicode/CharProps.hs +36/−36
• src/Text/XML/HXT/RelaxNG/Utils.hs +23/−23
• src/Text/XML/HXT/RelaxNG/Validation.hs +135/−135
• src/Text/XML/HXT/RelaxNG/Validator.hs +75/−75
• src/Text/XML/HXT/RelaxNG/XmlSchema/DataTypeLibW3C.hs +306/−306
• src/Text/XML/HXT/RelaxNG/XmlSchema/Regex.hs +188/−188
• src/Text/XML/HXT/RelaxNG/XmlSchema/RegexMatch.hs +46/−43
• src/Text/XML/HXT/RelaxNG/XmlSchema/RegexParser.hs +104/−104

@@ -1,9 +0,0 @@-The MIT License--Copyright (c) 2005 Uwe Schmidt, Martin Schmidt, Torben Kuseler--Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.--THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,9 @@+The MIT License++Copyright (c) 2005 Uwe Schmidt, Martin Schmidt, Torben Kuseler++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -140,6 +140,8 @@  test6		: 		@echo "===> tagsoup parsing examples" ; echo ; sleep 2+		@echo "===> lousy HTML document" ; echo ; sleep 2+		$(prog) --tagsoup --parse-html lousy.html 		@echo "===> www.w3c.org homepage (valid XHTML)" ; echo ; sleep 2 		$(prog) --tagsoup http://www.w3c.org/ 		@echo "===> same again with removed whitespace and tree output" ; echo ; sleep 2

@@ -9,9 +9,9 @@     <h2>html 	<p>some text and a &xxx; 	  <p>more text-      &apos; &apos; &apos;+      &apos; &apos; &apos; &yyy       &unknown;-      &#65;+      &#65; &#66       &#x41;       &Auml; 	    </p@@ -32,6 +32,6 @@ 		Schmidt</a></address> <!-- Created: Tue Apr 29 16:07:57 CEST 2003 --> <!-- hhmts start -->-Last modified: Mon Feb 18 13:56:28 CET 2008+Last modified: Tue Aug 17 15:56:59 CEST 2010 <!-- hhmts end --> </html>

@@ -1,17 +1,27 @@ -- arch-tag: Haskell XML Toolbox main description file-name: hxt-version: 8.5.2-license: OtherLicense-license-file: LICENCE-maintainer: Uwe Schmidt <uwe@fh-wedel.de>-stability: stable-category: XML-synopsis: A collection of tools for processing XML with Haskell. -description:  The Haskell XML Toolbox bases on the ideas of HaXml and HXML, but introduces a more general approach for processing XML with Haskell. The Haskell XML Toolbox uses a generic data model for representing XML documents, including the DTD subset and the document subset, in Haskell. It contains a validating XML parser, a HTML parser, namespace support, an XPath expression evaluator, an XSLT library, a RelaxNG schema validator and funtions for serialization and deserialization of user defined data. The library make extensive use of the arrow approach for processing XML. Since version 8.5 XPath and XSLT have been moved to separate packages hxt-xpath and hxt-xslt.-homepage: http://www.fh-wedel.de/~si/HXmlToolbox/index.html-copyright: Copyright (c) 2005-2010 Uwe Schmidt-build-type: Simple-cabal-version: >=1.6+Name:           hxt+Version:        8.5.4+Synopsis:       A collection of tools for processing XML with Haskell. +Description:    The Haskell XML Toolbox bases on the ideas of HaXml and HXML,+                but introduces a more general approach for processing XML with Haskell.+                The Haskell XML Toolbox uses a generic data model for representing XML documents,+                including the DTD subset and the document subset, in Haskell.+                It contains a validating XML parser, a HTML parser, namespace support,+                an XPath expression evaluator, an XSLT library, a RelaxNG schema validator+                and funtions for serialization and deserialization of user defined data.+                The library makes extensive use of the arrow approach for processing XML.+                Since version 8.5 XPath and XSLT have been moved to separate packages hxt-xpath and hxt-xslt,+                serialisation is in package hxt-binary+License:        OtherLicense+License-file:   LICENSE+Author:         Uwe Schmidt, Martin Schmidt, Torben Kuseler+Maintainer:     Uwe Schmidt <uwe@fh-wedel.de>+Stability:      Stable+Category:       XML+Homepage:       http://www.fh-wedel.de/~si/HXmlToolbox/index.html+Copyright:      Copyright (c) 2005-2010 Uwe Schmidt+Build-type:     Simple+Cabal-version:  >=1.6  extra-source-files:  examples/arrows/absurls/AbsURIs.hs@@ -173,5 +183,5 @@                 network    >= 2.1 && < 3,                 deepseq    >= 1.1 && < 2,                 bytestring >= 0.9 && < 1,-                tagsoup    >= 0.8 && < 0.9,+                tagsoup    >= 0.10 && < 0.11,                 curl       >= 1.3 && < 2

@@ -29,32 +29,32 @@ class Arrow a => ArrowIO a where      -- | construct an arrow from an IO action-    arrIO		:: (b -> IO c) -> a b c+    arrIO               :: (b -> IO c) -> a b c      -- | construct an arrow from an IO action without any parameter-    arrIO0		:: IO c -> a b c-    arrIO0 f		= arrIO (const f)+    arrIO0              :: IO c -> a b c+    arrIO0 f            = arrIO (const f)      -- | construction of a 2 argument arrow from a binary IO action     -- |     -- | example: @ a1 &&& a2 >>> arr2 f @ -    arrIO2		:: (b1 -> b2 -> IO c) -> a (b1, b2) c-    arrIO2 f		= arrIO (\ ~(x1, x2) -> f x1 x2)+    arrIO2              :: (b1 -> b2 -> IO c) -> a (b1, b2) c+    arrIO2 f            = arrIO (\ ~(x1, x2) -> f x1 x2)      -- | construction of a 3 argument arrow from a 3-ary IO action     -- |     -- | example: @ a1 &&& a2 &&& a3 >>> arr3 f @ -    arrIO3		:: (b1 -> b2 -> b3 -> IO c) -> a (b1, (b2, b3)) c-    arrIO3 f		= arrIO (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)+    arrIO3              :: (b1 -> b2 -> b3 -> IO c) -> a (b1, (b2, b3)) c+    arrIO3 f            = arrIO (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)      -- | construction of a 4 argument arrow from a 4-ary IO action     -- |     -- | example: @ a1 &&& a2 &&& a3 &&& a4 >>> arr4 f @ -    arrIO4		:: (b1 -> b2 -> b3 -> b4 -> IO c) -> a (b1, (b2, (b3, b4))) c-    arrIO4 f		= arrIO (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)+    arrIO4              :: (b1 -> b2 -> b3 -> b4 -> IO c) -> a (b1, (b2, (b3, b4))) c+    arrIO4 f            = arrIO (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)   -- | the interface for converting an IO predicate into a list arrow@@ -66,6 +66,6 @@     -- if the predicate holds, the single list containing the input is returned, else the empty list,     -- similar to 'Control.Arrow.ArrowList.isA' -    isIOA		:: (b -> IO Bool) -> a b b+    isIOA               :: (b -> IO Bool) -> a b b  -- ------------------------------------------------------------

@@ -43,84 +43,84 @@      -- | if lifted to arrows -    ifA			:: a b c -> a b d -> a b d -> a b d+    ifA                 :: a b c -> a b d -> a b d -> a b d      -- | shortcut: @ ifP p = ifA (isA p) @ -    ifP			:: (b -> Bool) -> a b d -> a b d -> a b d-    ifP p		= ifA (isA p)+    ifP                 :: (b -> Bool) -> a b d -> a b d -> a b d+    ifP p               = ifA (isA p)      -- | negation: @ neg f = ifA f none this @ -    neg			:: a b c -> a b b-    neg	f		= ifA f none this+    neg                 :: a b c -> a b b+    neg f               = ifA f none this      -- | @ f \`when\` g @ : when the predicate g holds, f is applied, else the identity filter this -    when		:: a b b -> a b c -> a b b-    f `when` g		= ifA g f this+    when                :: a b b -> a b c -> a b b+    f `when` g          = ifA g f this      -- | shortcut: @ f \`whenP\` p = f \`when\` (isA p) @ -    whenP		:: a b b -> (b -> Bool) -> a b b-    f `whenP` g		= ifP g f this+    whenP               :: a b b -> (b -> Bool) -> a b b+    f `whenP` g         = ifP g f this      -- | @ f \`whenNot\` g @ : when the predicate g does not hold, f is applied, else the identity filter this -    whenNot		:: a b b -> a b c -> a b b-    f `whenNot` g	= ifA g this f+    whenNot             :: a b b -> a b c -> a b b+    f `whenNot` g       = ifA g this f      -- | like 'whenP' -    whenNotP		:: a b b -> (b -> Bool) -> a b b-    f `whenNotP` g	= ifP g this f+    whenNotP            :: a b b -> (b -> Bool) -> a b b+    f `whenNotP` g      = ifP g this f      -- | @ g \`guards\` f @ : when the predicate g holds, f is applied, else none -    guards		:: a b c -> a b d -> a b d-    f `guards` g	= ifA f g none+    guards              :: a b c -> a b d -> a b d+    f `guards` g        = ifA f g none      -- | like 'whenP' -    guardsP		:: (b -> Bool) -> a b d -> a b d-    f `guardsP` g	= ifP f g none+    guardsP             :: (b -> Bool) -> a b d -> a b d+    f `guardsP` g       = ifP f g none      -- | shortcut for @ f `guards` this @ -    filterA		:: a b c -> a b b-    filterA f		= ifA f this none+    filterA             :: a b c -> a b b+    filterA f           = ifA f this none      -- | @ f \`containing\` g @ : keep only those results from f for which g holds     --     -- definition: @ f \`containing\` g = f >>> g \`guards\` this @ -    containing		:: a b c -> a c d -> a b c-    f `containing` g	= f >>> g `guards` this+    containing          :: a b c -> a c d -> a b c+    f `containing` g    = f >>> g `guards` this      -- | @ f \`notContaining\` g @ : keep only those results from f for which g does not hold     --     -- definition: @ f \`notContaining\` g = f >>> ifA g none this @ -    notContaining	:: a b c -> a c d -> a b c-    f `notContaining` g	= f >>> ifA g none this+    notContaining       :: a b c -> a c d -> a b c+    f `notContaining` g = f >>> ifA g none this      -- | @ f \`orElse\` g @ : directional choice: if f succeeds, the result of f is the result, else g is applied-    orElse		:: a b c -> a b c -> a b c+    orElse              :: a b c -> a b c -> a b c      -- | generalisation of 'orElse' for multi way branches like in case expressions.     --     -- An auxiliary data type 'IfThen' with an infix constructor ':->' is used for writing multi way branches     --     -- example: @ choiceA [ p1 :-> e1, p2 :-> e2, this :-> default ] @-    choiceA		:: [IfThen (a b c) (a b d)] -> a b d-    choiceA 		= foldr ifA' none-			  where-			  ifA' (g :-> f) = ifA g f+    choiceA             :: [IfThen (a b c) (a b d)] -> a b d+    choiceA             = foldr ifA' none+                          where+                          ifA' (g :-> f) = ifA g f       -- | tag a value with Left or Right, if arrow has success, input is tagged with Left, else with Right-    tagA		:: a b c -> a b (Either b b)-    tagA p		= ifA p (arr Left) (arr Right)+    tagA                :: a b c -> a b (Either b b)+    tagA p              = ifA p (arr Left) (arr Right)       -- | split a list value with an arrow and returns a pair of lists.@@ -128,31 +128,31 @@     --     -- example: @ runLA (spanA (isA (\/= \'-\'))) \"abc-def\" @ gives @ [(\"abc\",\"-def\")] @ as result -    spanA		:: a b b -> a [b] ([b],[b])-    spanA p		= ifA ( arrL (take 1) >>> p )-			  ( arr head &&& (arr tail >>> spanA p)-			    >>>-			    arr (\ ~(x, ~(xs,ys)) -> (x : xs, ys))-			  )+    spanA               :: a b b -> a [b] ([b],[b])+    spanA p             = ifA ( arrL (take 1) >>> p )+                          ( arr head &&& (arr tail >>> spanA p)+                            >>>+                            arr (\ ~(x, ~(xs,ys)) -> (x : xs, ys))+                          )                           ( arr (\ l -> ([],l)) )      -- | partition a list of values into a pair of lists     --     -- This is the arrow Version of 'Data.List.partition' -    partitionA		:: a b b -> a [b] ([b],[b])-    partitionA	p	= listA ( arrL id >>> tagA p )-			  >>^-			  ( (\ ~(l1, l2) -> (unTag l1, unTag l2) ) . partition (isLeft) )-	                  where-			  isLeft (Left _) = True-			  isLeft _        = False-			  unTag	= map (either id id)+    partitionA          :: a b b -> a [b] ([b],[b])+    partitionA  p       = listA ( arrL id >>> tagA p )+                          >>^+                          ( (\ ~(l1, l2) -> (unTag l1, unTag l2) ) . partition (isLeft) )+                          where+                          isLeft (Left _) = True+                          isLeft _        = False+                          unTag = map (either id id)  -- ------------------------------------------------------------  -- | an auxiliary data type for 'choiceA' -data IfThen a b	= a :-> b+data IfThen a b = a :-> b  -- ------------------------------------------------------------

@@ -48,50 +48,50 @@     -- |     -- | example: @ a1 &&& a2 >>> arr2 f @ -    arr2		:: (b1 -> b2 -> c) -> a (b1, b2) c-    arr2		= arr . uncurry+    arr2                :: (b1 -> b2 -> c) -> a (b1, b2) c+    arr2                = arr . uncurry      -- | construction of a 3 argument arrow from a 3-ary function     -- |     -- | example: @ a1 &&& a2 &&& a3 >>> arr3 f @ -    arr3		:: (b1 -> b2 -> b3 -> c) -> a (b1, (b2, b3)) c-    arr3 f		= arr (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)+    arr3                :: (b1 -> b2 -> b3 -> c) -> a (b1, (b2, b3)) c+    arr3 f              = arr (\ ~(x1, ~(x2, x3)) -> f x1 x2 x3)      -- | construction of a 4 argument arrow from a 4-ary function     -- |     -- | example: @ a1 &&& a2 &&& a3 &&& a4 >>> arr4 f @ -    arr4		:: (b1 -> b2 -> b3 -> b4 -> c) -> a (b1, (b2, (b3, b4))) c-    arr4 f		= arr (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)+    arr4                :: (b1 -> b2 -> b3 -> b4 -> c) -> a (b1, (b2, (b3, b4))) c+    arr4 f              = arr (\ ~(x1, ~(x2, ~(x3, x4))) -> f x1 x2 x3 x4)      -- | construction of a 2 argument arrow from a singe argument arrow -    arr2A		:: (b -> a c d) -> a (b, c) d+    arr2A               :: (b -> a c d) -> a (b, c) d      -- | constructor for a list arrow from a function with a list as result -    arrL		:: (b -> [c]) -> a b c+    arrL                :: (b -> [c]) -> a b c      -- | constructor for a list arrow with 2 arguments -    arr2L		:: (b -> c -> [d]) -> a (b, c) d-    arr2L		= arrL . uncurry+    arr2L               :: (b -> c -> [d]) -> a (b, c) d+    arr2L               = arrL . uncurry      -- | constructor for a const arrow: @ constA = arr . const @ -    constA		:: c -> a b c-    constA		= arr . const+    constA              :: c -> a b c+    constA              = arr . const      -- | constructor for a const arrow: @ constL = arrL . const @ -    constL		:: [c] -> a b c-    constL		= arrL . const+    constL              :: [c] -> a b c+    constL              = arrL . const      -- | builds an arrow from a predicate.     -- If the predicate holds, the single list containing the input is returned, else the empty list -    isA			:: (b -> Bool) -> a b b+    isA                 :: (b -> Bool) -> a b b      -- | combinator for converting the result of a list arrow into another list     --@@ -99,12 +99,12 @@     --     -- example: @ foo >>. take 1 @ constructs a deterministic version of foo by deleting all further results -    (>>.)		:: a b c -> ([c] -> [d]) -> a b d+    (>>.)               :: a b c -> ([c] -> [d]) -> a b d      -- | combinator for converting the result of an arrow into a single element result -    (>.)		:: a b c -> ([c] ->  d ) -> a b d-    af >. f		= af >>. ((:[]) . f)+    (>.)                :: a b c -> ([c] ->  d ) -> a b d+    af >. f             = af >>. ((:[]) . f)      -- | combinator for converting an arrow into a determinstic version with all results collected in a single element list     --@@ -118,8 +118,8 @@     -- >     -- > collectAndSort collect = listA collect >>> arrL sort -    listA		:: a b c -> a b [c]-    listA af		= af >>.  (:[])+    listA               :: a b c -> a b [c]+    listA af            = af >>.  (:[])      -- | the inverse of 'listA'     --@@ -127,25 +127,25 @@     --     -- unlistA is defined as @ arrL id @ -    unlistA		:: a [b] b-    unlistA		= arrL id+    unlistA             :: a [b] b+    unlistA             = arrL id      -- | the identity arrow, alias for returnA -    this		:: a b b-    this		= returnA+    this                :: a b b+    this                = returnA      -- | the zero arrow, alias for zeroArrow -    none		:: a b c-    none		= zeroArrow+    none                :: a b c+    none                = zeroArrow      -- | converts an arrow, that may fail, into an arrow that always succeeds     --     -- example: @ withDefault none \"abc\" @ is equivalent to @ constA \"abc\" @ -    withDefault		:: a b c -> c -> a b c-    withDefault	a d	= a >>. \ x -> if null x then [d] else x+    withDefault         :: a b c -> c -> a b c+    withDefault a d     = a >>. \ x -> if null x then [d] else x      -- | makes a list arrow deterministic, the number of results is at most 1     --@@ -161,8 +161,8 @@     -- >         (constA "y"     -- >          <+> this ) ) "x" == ["y"] -    single		:: a b c -> a b c-    single f		= f >>. take 1+    single              :: a b c -> a b c+    single f            = f >>. take 1      -- | compute an arrow from the input and apply the arrow to this input     --@@ -176,7 +176,7 @@     --     -- see also: '$<', '$<<', '$<<<', '$<<<<', '$<$' -    applyA		:: a b (a b c) -> a b c+    applyA              :: a b (a b c) -> a b c     applyA f            = (f &&& this) >>> app      -- | compute the parameter for an arrow with extra parameters from the input@@ -210,8 +210,8 @@     --     -- see also: 'applyA', '$<<', '$<<<', '$<<<<', '$<$' -    ($<)		:: (c -> a b d) -> a b c -> a b d-    g $< f		= applyA (f >>> arr g)+    ($<)                :: (c -> a b d) -> a b c -> a b d+    g $< f              = applyA (f >>> arr g)      -- | binary version of '$<'     --@@ -226,8 +226,8 @@     -- > runLA ( infixString $<< constA "y"     -- >                         &&& (constA "z" <+> this) ) "x" = ["yxz", "yxx"] -    ($<<)		:: (c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d-    f $<< g		= applyA (g >>> arr2 f)+    ($<<)               :: (c1 -> c2 -> a b d) -> a b (c1, c2) -> a b d+    f $<< g             = applyA (g >>> arr2 f)      -- | version of '$<' for arrows with 3 extra parameters     --@@ -235,8 +235,8 @@     --     -- > f $<<< g1 &&& g2 &&& g3 -    ($<<<)		:: (c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d-    f $<<< g		= applyA (g >>> arr3 f)+    ($<<<)              :: (c1 -> c2 -> c3 -> a b d) -> a b (c1, (c2, c3)) -> a b d+    f $<<< g            = applyA (g >>> arr3 f)      -- | version of '$<' for arrows with 4 extra parameters     --@@ -244,8 +244,8 @@     --     -- > f $<<<< g1 &&& g2 &&& g3 &&& g4 -    ($<<<<)		:: (c1 -> c2 -> c3 -> c4 -> a b d) -> a b (c1, (c2, (c3, c4))) -> a b d-    f $<<<< g		= applyA (g >>> arr4 f)+    ($<<<<)             :: (c1 -> c2 -> c3 -> c4 -> a b d) -> a b (c1, (c2, (c3, c4))) -> a b d+    f $<<<< g           = applyA (g >>> arr4 f)      -- | compute the parameter for an arrow @f@ with an extra parameter by an arrow @g@     -- and apply all the results from @g@ sequentially to the input@@ -293,14 +293,14 @@     -- > g2 :: a b c2     -- >     -- > f          :: (c1, c2) -> a b b-    -- > f (x1, x2) =  ... x1 ... x2 ... +    -- > f (x1, x2) =  ... x1 ... x2 ...     -- >     -- > f $<$ g1 &&& g2     --     -- see also: 'applyA', '$<' -    ($<$)		:: (c -> (a b b)) -> a b c -> a b b-    g $<$ f		= applyA (listA (f >>> arr g) >>> arr seqA)+    ($<$)               :: (c -> (a b b)) -> a b c -> a b b+    g $<$ f             = applyA (listA (f >>> arr g) >>> arr seqA)      -- | merge the result pairs of an arrow with type @a a1 (b1, b2)@     -- by combining the tuple components with the @op@ arrow@@ -309,38 +309,38 @@     --     -- >     a1 :: a String (XmlTree, XmlTree)     -- >     a1 = selem "foo" [this >>> mkText]-    -- > 	  &&&-    -- > 	  selem "bar" [arr (++"0") >>> mkText]-    -- > +    -- >          &&&+    -- >          selem "bar" [arr (++"0") >>> mkText]+    -- >     -- >     runLA (a1 >>> mergeA (<+>) >>> xshow this) "42" == ["<foo>42</foo>","<bar>420</bar>"]     -- >     runLA (a1 >>> mergeA (+=)  >>> xshow this) "42" == ["<foo>42<bar>420</bar></foo>"]     --     -- see also: 'applyA', '$<' and '+=' in class 'Text.XML.HXT.Arrow.ArrowXml' -    mergeA		:: (a (a1, b1) a1 -> a (a1, b1) b1 -> a (a1, b1) c) ->-			   a (a1, b1) c-    mergeA op		= (\ x -> arr fst `op` constA (snd x)) $< this+    mergeA              :: (a (a1, b1) a1 -> a (a1, b1) b1 -> a (a1, b1) c) ->+                           a (a1, b1) c+    mergeA op           = (\ x -> arr fst `op` constA (snd x)) $< this      -- | useful only for arrows with side effects: perform applies an arrow to the input     -- ignores the result and returns the input     --     -- example: @ ... >>> perform someTraceArrow >>> ... @ -    perform		:: a b c -> a b b-    perform f		= listA f &&& this >>> arr snd+    perform             :: a b c -> a b b+    perform f           = listA f &&& this >>> arr snd      -- | generalization of arrow combinator '<+>'     --     -- definition: @ catA = foldl (\<+\>) none @ -    catA		:: [a b c] -> a b c-    catA		= foldl (<+>) none+    catA                :: [a b c] -> a b c+    catA                = foldl (<+>) none      -- | generalization of arrow combinator '>>>'     --     -- definition: @ seqA = foldl (>>>) this @ -    seqA		:: [a b b] -> a b b-    seqA		= foldl (>>>) this+    seqA                :: [a b b] -> a b b+    seqA                = foldl (>>>) this  -- ------------------------------------------------------------

@@ -28,11 +28,11 @@ -- and validation of a document, all DTD stuff is not longer in use and can be -- recycled by the GC. -strictA	:: (Arrow a, NFData b) => a b b-strictA	= arr $ \ x -> deepseq x x+strictA :: (Arrow a, NFData b) => a b b+strictA = arr $ \ x -> deepseq x x  class (Arrow a) => ArrowNF a where-    rnfA	:: (NFData c) => a b c -> a b c-    rnfA f	= f >>> strictA+    rnfA        :: (NFData c) => a b c -> a b c+    rnfA f      = f >>> strictA  -- ------------------------------------------------------------

@@ -37,25 +37,25 @@     -- for computing a new state from the old and the arrow input.     -- Result is the arrow input -    changeState		:: (s -> b -> s) -> a b b+    changeState         :: (s -> b -> s) -> a b b      -- | access the state with a function using the arrow input     -- as data for selecting state components. -    accessState		:: (s -> b -> c) -> a b c+    accessState         :: (s -> b -> c) -> a b c      -- | read the complete state, ignore arrow input     ---    -- definition: @ getState = accessState (\\ s x -> s) @ +    -- definition: @ getState = accessState (\\ s x -> s) @ -    getState		:: a b s-    getState		= accessState (\ s _x -> s)+    getState            :: a b s+    getState            = accessState (\ s _x -> s)      -- | overwrite the old state     --     -- definition: @ setState = changeState (\\ s x -> x) @-    setState		:: a s s-    setState		= changeState (\ _s x -> x)	-- changeState (const id)+    setState            :: a s s+    setState            = changeState (\ _s x -> x)     -- changeState (const id)      -- | change state (and ignore input) and return new state     --@@ -68,13 +68,13 @@     -- > newId = nextState (+1)     -- >         >>>     -- >         arr (('#':) . show)-    -- > +    -- >     -- > runSLA 0 (newId <+> newId <+> newId) undefined     -- >   = ["#1", "#2", "#3"] -    nextState		:: (s -> s) -> a b s-    nextState sf	= changeState (\s -> const (sf s))-			  >>>-			  getState+    nextState           :: (s -> s) -> a b s+    nextState sf        = changeState (\s -> const (sf s))+                          >>>+                          getState  -- ------------------------------------------------------------

@@ -44,45 +44,45 @@      -- | construct a leaf -    mkLeaf		:: Tree t => b -> a c (t b)-    mkLeaf		= constA . T.mkLeaf+    mkLeaf              :: Tree t => b -> a c (t b)+    mkLeaf              = constA . T.mkLeaf      -- | construct an inner node -    mkTree		:: Tree t => b -> [t b] -> a c (t b)-    mkTree n		= constA . T.mkTree n+    mkTree              :: Tree t => b -> [t b] -> a c (t b)+    mkTree n            = constA . T.mkTree n      -- | select the children of the root of a tree -    getChildren		:: Tree t => a (t b) (t b)-    getChildren		= arrL T.getChildren+    getChildren         :: Tree t => a (t b) (t b)+    getChildren         = arrL T.getChildren      -- | select the attribute of the root of a tree -    getNode		:: Tree t => a (t b) b-    getNode		= arr T.getNode+    getNode             :: Tree t => a (t b) b+    getNode             = arr T.getNode      -- | substitute the children of the root of a tree -    setChildren		:: Tree t =>            [t b] -> a (t b) (t b)-    setChildren cs	= arr (T.setChildren cs)+    setChildren         :: Tree t =>            [t b] -> a (t b) (t b)+    setChildren cs      = arr (T.setChildren cs)      -- | substitute the attribute of the root of a tree -    setNode		:: Tree t =>                b -> a (t b) (t b)-    setNode n		= arr (T.setNode n)+    setNode             :: Tree t =>                b -> a (t b) (t b)+    setNode n           = arr (T.setNode n)      -- | edit the children of the root of a tree -    changeChildren	:: Tree t => ([t b] -> [t b]) -> a (t b) (t b)-    changeChildren csf	= arr (T.changeChildren csf)+    changeChildren      :: Tree t => ([t b] -> [t b]) -> a (t b) (t b)+    changeChildren csf  = arr (T.changeChildren csf)      -- | edit the attribute of the root of a tree -    changeNode		:: Tree t =>        (b  -> b) -> a (t b) (t b)-    changeNode nf	= arr (T.changeNode nf)+    changeNode          :: Tree t =>        (b  -> b) -> a (t b) (t b)+    changeNode nf       = arr (T.changeNode nf) -								-- compound arrows+                                                                -- 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@@ -91,12 +91,12 @@     --     -- example: @ processChildren (none \`when\` isCmt) @ removes all children, for which isCmt holds -    processChildren	:: Tree t => a (t b) (t b) -> a (t b) (t b)-    processChildren f	= arr T.getNode-			  &&&-			  listA (arrL T.getChildren >>> f)	-- new children, deterministic filter: single element result-			  >>>-			  arr2 T.mkTree+    processChildren     :: Tree t => a (t b) (t b) -> a (t b) (t b)+    processChildren f   = arr T.getNode+                          &&&+                          listA (arrL T.getChildren >>> f)      -- new children, deterministic filter: single element result+                          >>>+                          arr2 T.mkTree      -- | similar to processChildren, but the new children are computed by processing     -- the whole input tree@@ -104,12 +104,12 @@     -- example: @ replaceChildren (deep isText) @ selects all subtrees for which isText holds     -- and substitutes the children component of the root node with this list -    replaceChildren	:: Tree t => a (t b) (t b) -> a (t b) (t b)-    replaceChildren f	= arr T.getNode-			  &&&-			  listA f				-- compute new children-			  >>>-			  arr2 T.mkTree+    replaceChildren     :: Tree t => a (t b) (t b) -> a (t b) (t b)+    replaceChildren f   = arr T.getNode+                          &&&+                          listA f                               -- compute new children+                          >>>+                          arr2 T.mkTree      -- |     -- pronounced \"slash\", meaning g inside f@@ -120,10 +120,10 @@     --     -- 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\" +    -- corresponds 1-1 to the XPath selection path \"html\/body\/h1\" -    (/>)		:: Tree t => a b (t c) -> a (t c) d -> a b d-    f /> g		= f >>> getChildren >>> g+    (/>)                :: Tree t => a b (t c) -> a (t c) d -> a b d+    f /> g              = f >>> getChildren >>> g      -- |     -- pronounced \"double slash\", meaning g arbitrarily deep inside f@@ -138,8 +138,8 @@     -- to the XPath selection path \"html\/\/table\". The latter on matches all table elements     -- even nested ones, but @\/\/>@ gives in many cases the appropriate functionality. -    (//>)		:: Tree t => a b (t c) -> a (t c) d -> a b d-    f //> g		= f >>> getChildren >>> deep g+    (//>)               :: Tree t => a b (t c) -> a (t c) d -> a b d+    f //> g             = f >>> getChildren >>> deep g       -- |@@ -147,8 +147,8 @@     --     -- defined as @ f \<\/ g = f \`containing\` (getChildren >>> g) @ -    (</)		:: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)-    f </ g		= f `containing` (getChildren >>> g)+    (</)                :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)+    f </ g              = f `containing` (getChildren >>> g)       -- | recursively searches a whole tree for subtrees, for which a predicate holds.@@ -159,10 +159,10 @@     -- 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		:: Tree t => a (t b) c -> a (t b) c-    deep f		= f					-- success when applying f-			  `orElse`-			  (getChildren >>> deep f)		-- seach children+    deep                :: Tree t => a (t b) c -> a (t b) c+    deep f              = f                                     -- success when applying f+                          `orElse`+                          (getChildren >>> deep f)              -- seach children       -- | recursively searches a whole tree for subrees, for which a predicate holds.@@ -171,10 +171,10 @@     -- 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		:: Tree t => a (t b) c -> a (t b) c-    deepest f		= (getChildren >>> deepest f)		-- seach children-			  `orElse`-			  f					-- no success: apply f to root+    deepest             :: Tree t => a (t b) c -> a (t b) c+    deepest f           = (getChildren >>> deepest f)           -- seach children+                          `orElse`+                          f                                     -- no success: apply f to root       -- | recursively searches a whole tree for subtrees, for which a predicate holds.@@ -183,10 +183,10 @@     --     -- example: @ multy isHtmlTable @ selects all table elements, even nested ones. -    multi		:: Tree t => a (t b) c -> a (t b) c-    multi f		= f					-- combine result for root-			  <+>-			  (getChildren >>> multi f)		-- with result for all descendants+    multi               :: Tree t => a (t b) c -> a (t b) c+    multi f             = f                                     -- combine result for root+                          <+>+                          (getChildren >>> multi f)             -- 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@@ -194,19 +194,19 @@     -- example: @ processBottomUp (getChildren \`when\` isHtmlFont) @ removes all font tags in a HTML document, even nested ones     -- (with an appropriate definition of isHtmlFont) -    processBottomUp	:: Tree t => a (t b) (t b) -> a (t b) (t b)-    processBottomUp f	= processChildren (processBottomUp f)	-- process all descendants first-			  >>>-			  f					-- then process root+    processBottomUp     :: Tree t => a (t b) (t b) -> a (t b) (t b)+    processBottomUp f   = processChildren (processBottomUp f)   -- 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	:: Tree t => a (t b) (t b) -> a (t b) (t b)-    processTopDown f	= f					-- first process root-			  >>>-			  processChildren (processTopDown f)	-- then process all descendants of new root+    processTopDown      :: Tree t => a (t b) (t b) -> a (t b) (t b)+    processTopDown f    = f                                     -- first process root+                          >>>+                          processChildren (processTopDown f)    -- then process all descendants of new root       -- | recursively transforms a whole tree by applying an arrow to all subtrees,@@ -214,12 +214,12 @@     -- leaves are transformed first      processBottomUpWhenNot-			:: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)+                        :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)     processBottomUpWhenNot f p-			= ( processChildren (processBottomUpWhenNot f p)-			    >>>-			    f-			  ) `whenNot` p+                        = ( processChildren (processBottomUpWhenNot f p)+                            >>>+                            f+                          ) `whenNot` p      -- | recursively transforms a whole tree by applying an arrow to all subtrees,     -- but transformation stops when a tree is successfully transformed.@@ -228,11 +228,11 @@     -- example: @ processTopDownUntil (isHtmlTable \`guards\` tranformTable) @     -- transforms all top level table elements into something else, but inner tables remain unchanged -    processTopDownUntil	:: Tree t => a (t b) (t b) -> a (t b) (t b)+    processTopDownUntil :: Tree t => a (t b) (t b) -> a (t b) (t b)     processTopDownUntil f-			= f-			  `orElse`-			  processChildren (processTopDownUntil f)+                        = f+                          `orElse`+                          processChildren (processTopDownUntil f)      -- | 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@@ -240,78 +240,78 @@     -- example: @ insertChildrenAt 0 (deep isCmt) @ selects all subtrees for which isCmt holds     -- and copies theses in front of the existing children -    insertChildrenAt	:: Tree t =>           Int -> a (t b) (t b) -> a (t b) (t b)+    insertChildrenAt    :: Tree t =>           Int -> a (t b) (t b) -> a (t b) (t b)     insertChildrenAt i f-			= listA f &&& this >>> arr2 insertAt-			  where-			  insertAt newcs-			      = T.changeChildren (\ cs -> let-						          (cs1, cs2) = splitAt i cs-						          in-						          cs1 ++ newcs ++ cs2-						 )+                        = listA f &&& this >>> arr2 insertAt+                          where+                          insertAt newcs+                              = T.changeChildren (\ cs -> let+                                                          (cs1, cs2) = splitAt i cs+                                                          in+                                                          cs1 ++ newcs ++ cs2+                                                 )      -- | similar to 'insertChildrenAt', but the insertion position is searched with a predicate -    insertChildrenAfter	:: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)+    insertChildrenAfter :: Tree t => a (t b) (t b) -> a (t b) (t b) -> a (t b) (t b)     insertChildrenAfter p f-			= replaceChildren-			  ( ( ( listA getChildren-				>>>-				spanA p-			      )-			      &&&-			      listA f-			    )-			    >>> arr2L (\ (xs1, xs2) xs -> xs1 ++ xs ++ xs2)-			  )-			  +                        = replaceChildren+                          ( ( ( listA getChildren+                                >>>+                                spanA p+                              )+                              &&&+                              listA f+                            )+                            >>> 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 :: ArrowXml a => a b XmlTree     -- > insertTreeTemplateTest     -- >     = doc     -- >       >>>-    -- >       insertTemplate template pattern+    -- >       insertTreeTemplate 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+    -- >     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 )-    -- > 	  ]+    -- >        = [ 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	:: Tree t =>-			   a (t b) (t b) ->					-- the the template-			   [IfThen (a (t b) c) (a (t b) (t b))] ->		-- the list of nodes in the template to be substituted-			   a (t b) (t b)+    insertTreeTemplate  :: Tree t =>+                           a (t b) (t b) ->                                     -- the the template+                           [IfThen (a (t b) c) (a (t b) (t b))] ->              -- the list of nodes in the template to be substituted+                           a (t b) (t b)     insertTreeTemplate template choices-	= insertTree $< this-	  where-	  insertTree t-	      = template					-- swap input and template-		>>>-		processTemplate-	      where-	      processTemplate-		  = choiceA choices'				-- check whether node is a "hole" within the template-		    `orElse`-		    processChildren processTemplate		-- else descent into template tree-	      choices'-		  = map feedTree choices			-- modify choices, such that the input is feed into the action arrows-	      feedTree (cond :-> action)-		  = cond :-> (constA t >>> action)		-- the real input becomes the input at the holes+        = insertTree $< this+          where+          insertTree t+              = template                                        -- swap input and template+                >>>+                processTemplate+              where+              processTemplate+                  = choiceA choices'                            -- check whether node is a "hole" within the template+                    `orElse`+                    processChildren processTemplate             -- else descent into template tree+              choices'+                  = map feedTree choices                        -- modify choices, such that the input is feed into the action arrows+              feedTree (cond :-> action)+                  = cond :-> (constA t >>> action)              -- the real input becomes the input at the holes

@@ -41,92 +41,92 @@ instance Category IOLA where     id                  = IOLA $ return . (:[]) -    IOLA g . IOLA f	= IOLA $ \ x -> do-					ys <- f x-					zs <- sequence . map g $ ys-					return (concat zs)+    IOLA g . IOLA f     = IOLA $ \ x -> do+                                        ys <- f x+                                        zs <- sequence . map g $ ys+                                        return (concat zs)  instance Arrow IOLA where-    arr f		= IOLA $ \ x -> return [f x]+    arr f               = IOLA $ \ x -> return [f x] -    first (IOLA f)	= IOLA $ \ ~(x1, x2) -> do-					        ys1 <- f x1-					        return [ (y1, x2) | y1 <- ys1 ]+    first (IOLA f)      = IOLA $ \ ~(x1, x2) -> do+                                                ys1 <- f x1+                                                return [ (y1, x2) | y1 <- ys1 ]      -- just for efficiency-    second (IOLA g)	= IOLA $ \ ~(x1, x2) -> do-					        ys2 <- g x2-					        return [ (x1, y2) | y2 <- ys2 ]+    second (IOLA g)     = IOLA $ \ ~(x1, x2) -> do+                                                ys2 <- g x2+                                                return [ (x1, y2) | y2 <- ys2 ]      -- just for efficiency-    IOLA f *** IOLA g	= IOLA $ \ ~(x1, x2) -> do-						ys1 <- f x1-					        ys2 <- g x2-					        return [ (y1, y2) | y1 <- ys1, y2 <- ys2 ]+    IOLA f *** IOLA g   = IOLA $ \ ~(x1, x2) -> do+                                                ys1 <- f x1+                                                ys2 <- g x2+                                                return [ (y1, y2) | y1 <- ys1, y2 <- ys2 ]      -- just for efficiency-    IOLA f &&& IOLA g	= IOLA $ \ x -> do-					ys1 <- f x-					ys2 <- g x-					return [ (y1, y2) | y1 <- ys1, y2 <- ys2 ]+    IOLA f &&& IOLA g   = IOLA $ \ x -> do+                                        ys1 <- f x+                                        ys2 <- g x+                                        return [ (y1, y2) | y1 <- ys1, y2 <- ys2 ]   instance ArrowZero IOLA where-    zeroArrow		= IOLA $ const (return [])+    zeroArrow           = IOLA $ const (return [])   instance ArrowPlus IOLA where-    IOLA f <+> IOLA g	= IOLA $ \ x -> do-					rs1 <- f x-					rs2 <- g x-					return (rs1 ++ rs2)+    IOLA f <+> IOLA g   = IOLA $ \ x -> do+                                        rs1 <- f x+                                        rs2 <- g x+                                        return (rs1 ++ rs2)   instance ArrowChoice IOLA where-    left (IOLA f)	= IOLA $ either-			           (\ x -> f x >>= (\ y -> return (map Left y)))+    left (IOLA f)       = IOLA $ either+                                   (\ x -> f x >>= (\ y -> return (map Left y)))                                    (return . (:[]) . Right)-    right (IOLA f)	= IOLA $ either+    right (IOLA f)      = IOLA $ either                                    (return . (:[]) . Left)-			           (\ x -> f x >>= (\ y -> return (map Right y)))+                                   (\ x -> f x >>= (\ y -> return (map Right y)))  instance ArrowApply IOLA where-    app			= IOLA $ \ (IOLA f, x) -> f x+    app                 = IOLA $ \ (IOLA f, x) -> f x  instance ArrowList IOLA where-    arrL f		= IOLA $ \ x -> return (f x)-    arr2A f		= IOLA $ \ ~(x, y) -> runIOLA (f x) y-    constA c		= IOLA $ const (return [c])-    isA p		= IOLA $ \x -> return (if p x then [x] else [])-    IOLA f >>. g	= IOLA $ \x -> do-				       ys <- f x-				       return (g ys)+    arrL f              = IOLA $ \ x -> return (f x)+    arr2A f             = IOLA $ \ ~(x, y) -> runIOLA (f x) y+    constA c            = IOLA $ const (return [c])+    isA p               = IOLA $ \x -> return (if p x then [x] else [])+    IOLA f >>. g        = IOLA $ \x -> do+                                       ys <- f x+                                       return (g ys)   instance ArrowIf IOLA where-    ifA (IOLA p) ta ea	= IOLA $ \x -> do-				       res <- p x-				       runIOLA (if null res then ea else ta) x+    ifA (IOLA p) ta ea  = IOLA $ \x -> do+                                       res <- p x+                                       runIOLA (if null res then ea else ta) x     (IOLA f) `orElse` g-			= IOLA $ \x -> do-				       res <- f x-				       if null res then runIOLA g x else return res+                        = IOLA $ \x -> do+                                       res <- f x+                                       if null res then runIOLA g x else return res  instance ArrowIO IOLA where-    arrIO cmd		= IOLA $ \x -> do-			       	       res <- cmd x-				       return [res]+    arrIO cmd           = IOLA $ \x -> do+                                       res <- cmd x+                                       return [res]  instance ArrowIOIf IOLA where-    isIOA p		= IOLA $ \x -> do-				       res <- p x-				       return (if res then [x] else [])+    isIOA p             = IOLA $ \x -> do+                                       res <- p x+                                       return (if res then [x] else [])  instance ArrowTree IOLA  instance ArrowNF IOLA where-    rnfA (IOLA f)	= IOLA $ \ x -> do-					res <- f x-					deepseq res $ return res+    rnfA (IOLA f)       = IOLA $ \ x -> do+                                        res <- f x+                                        deepseq res $ return res  -- ------------------------------------------------------------

@@ -45,114 +45,114 @@ newtype IOSLA s a b = IOSLA { runIOSLA :: s -> a -> IO (s, [b]) }  instance Category (IOSLA s) where-    id                  = IOSLA $ \ s x -> return (s, [x])	-- don't defined id = arr id, this gives loops during optimization+    id                  = IOSLA $ \ s x -> return (s, [x])      -- don't defined id = arr id, this gives loops during optimization -    IOSLA g . IOSLA f	= IOSLA $ \ s x -> do-					   (s1, ys) <- f s x-					   sequence' s1 ys-					   where-					   sequence' s' []	 = return (s', [])-					   sequence' s' (x':xs') = do-								   (s1', ys') <- g s' x'-								   (s2', zs') <- sequence' s1' xs'-								   return (s2', ys' ++ zs')+    IOSLA g . IOSLA f   = IOSLA $ \ s x -> do+                                           (s1, ys) <- f s x+                                           sequence' s1 ys+                                           where+                                           sequence' s' []       = return (s', [])+                                           sequence' s' (x':xs') = do+                                                                   (s1', ys') <- g s' x'+                                                                   (s2', zs') <- sequence' s1' xs'+                                                                   return (s2', ys' ++ zs')  instance Arrow (IOSLA s) where-    arr f		= IOSLA $ \ s x -> return (s, [f x])+    arr f               = IOSLA $ \ s x -> return (s, [f x]) -    first (IOSLA f)	= IOSLA $ \ s (x1, x2) -> do-					           (s', ys1) <- f s x1-					           return (s', [ (y1, x2) | y1 <- ys1 ])+    first (IOSLA f)     = IOSLA $ \ s (x1, x2) -> do+                                                   (s', ys1) <- f s x1+                                                   return (s', [ (y1, x2) | y1 <- ys1 ])      -- just for efficiency-    second (IOSLA g)	= IOSLA $ \ s (x1, x2) -> do-					          (s', ys2) <- g s x2-					          return (s', [ (x1, y2) | y2 <- ys2 ])+    second (IOSLA g)    = IOSLA $ \ s (x1, x2) -> do+                                                  (s', ys2) <- g s x2+                                                  return (s', [ (x1, y2) | y2 <- ys2 ])      -- just for efficiency-    IOSLA f *** IOSLA g	= IOSLA $ \ s (x1, x2) -> do-						   (s1, ys1) <- f s  x1-					           (s2, ys2) <- g s1 x2-					           return (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])+    IOSLA f *** IOSLA g = IOSLA $ \ s (x1, x2) -> do+                                                   (s1, ys1) <- f s  x1+                                                   (s2, ys2) <- g s1 x2+                                                   return (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])      -- just for efficiency-    IOSLA f &&& IOSLA g	= IOSLA $ \ s x -> do-					   (s1, ys1) <- f s  x-					   (s2, ys2) <- g s1 x-					   return (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])+    IOSLA f &&& IOSLA g = IOSLA $ \ s x -> do+                                           (s1, ys1) <- f s  x+                                           (s2, ys2) <- g s1 x+                                           return (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])    instance ArrowZero (IOSLA s) where-    zeroArrow		= IOSLA $ \ s -> const (return (s, []))+    zeroArrow           = IOSLA $ \ s -> const (return (s, []))   instance ArrowPlus (IOSLA s) where-    IOSLA f <+> IOSLA g	= IOSLA $ \ s x -> do-					   (s1, rs1) <- f s  x-					   (s2, rs2) <- g s1 x-					   return (s2, rs1 ++ rs2)+    IOSLA f <+> IOSLA g = IOSLA $ \ s x -> do+                                           (s1, rs1) <- f s  x+                                           (s2, rs2) <- g s1 x+                                           return (s2, rs1 ++ rs2)  instance ArrowChoice (IOSLA s) where-    left (IOSLA f)	= IOSLA $ \ s -> either-			                 (\ x -> do-					         (s1, y) <- f s x-					         return (s1, map Left y)-					 )+    left (IOSLA f)      = IOSLA $ \ s -> either+                                         (\ x -> do+                                                 (s1, y) <- f s x+                                                 return (s1, map Left y)+                                         )                                          (\ x -> return (s, [Right x])) -    right (IOSLA f)	= IOSLA $ \ s -> either+    right (IOSLA f)     = IOSLA $ \ s -> either                                          (\ x -> return (s, [Left x]))-			                 (\ x -> do-					         (s1, y) <- f s x-					         return (s1, map Right y)-					 )+                                         (\ x -> do+                                                 (s1, y) <- f s x+                                                 return (s1, map Right y)+                                         )  instance ArrowApply (IOSLA s) where-    app			= IOSLA $ \ s (IOSLA f, x) -> f s x+    app                 = IOSLA $ \ s (IOSLA f, x) -> f s x  instance ArrowList (IOSLA s) where-    arrL f		= IOSLA $ \ s x -> return (s, (f x))-    arr2A f		= IOSLA $ \ s (x, y) -> runIOSLA (f x) s y-    constA c		= IOSLA $ \ s   -> const (return (s, [c]))-    isA p		= IOSLA $ \ s x -> return (s, if p x then [x] else [])-    IOSLA f >>. g	= IOSLA $ \ s x -> do-				           (s1, ys) <- f s x-					   return (s1, g ys)+    arrL f              = IOSLA $ \ s x -> return (s, (f x))+    arr2A f             = IOSLA $ \ s (x, y) -> runIOSLA (f x) s y+    constA c            = IOSLA $ \ s   -> const (return (s, [c]))+    isA p               = IOSLA $ \ s x -> return (s, if p x then [x] else [])+    IOSLA f >>. g       = IOSLA $ \ s x -> do+                                           (s1, ys) <- f s x+                                           return (s1, g ys)     -- just for efficency-    perform (IOSLA f)	= IOSLA $ \ s x -> do-					   (s1, _ys) <- f s x-					   return (s1, [x])+    perform (IOSLA f)   = IOSLA $ \ s x -> do+                                           (s1, _ys) <- f s x+                                           return (s1, [x])  instance ArrowIf (IOSLA s) where-    ifA (IOSLA p) ta ea	= IOSLA $ \ s x -> do-				           (s1, res) <- p s x-					   runIOSLA ( if null res-						      then ea-						      else ta-						    ) s1 x+    ifA (IOSLA p) ta ea = IOSLA $ \ s x -> do+                                           (s1, res) <- p s x+                                           runIOSLA ( if null res+                                                      then ea+                                                      else ta+                                                    ) s1 x      (IOSLA f) `orElse` g-			= IOSLA $ \ s x -> do-				           r@(s1, res) <- f s x-					   if null res-					      then runIOSLA g s1 x-					      else return r+                        = IOSLA $ \ s x -> do+                                           r@(s1, res) <- f s x+                                           if null res+                                              then runIOSLA g s1 x+                                              else return r   instance ArrowIO (IOSLA s) where-    arrIO cmd		= IOSLA $ \ s x -> do-					   res <- cmd x-					   return (s, [res])+    arrIO cmd           = IOSLA $ \ s x -> do+                                           res <- cmd x+                                           return (s, [res])  instance ArrowIOIf (IOSLA s) where-    isIOA p		= IOSLA $ \ s x -> do-					   res <- p x-					   return (s, if res then [x] else [])+    isIOA p             = IOSLA $ \ s x -> do+                                           res <- p x+                                           return (s, if res then [x] else [])  instance ArrowState s (IOSLA s) where-    changeState cf	= IOSLA $ \ s x -> let s' = cf s x in return (seq s' s', [x])-    accessState	af	= IOSLA $ \ s x -> return (s, [af s x])+    changeState cf      = IOSLA $ \ s x -> let s' = cf s x in return (seq s' s', [x])+    accessState af      = IOSLA $ \ s x -> return (s, [af s x])  -- ------------------------------------------------------------ @@ -162,11 +162,11 @@ -- This is uesful, when running predefined IO arrows, e.g. for document input, -- in a context with a more complex state component. -liftSt		:: IOSLA s1 b c -> IOSLA (s1, s2) b c+liftSt          :: IOSLA s1 b c -> IOSLA (s1, s2) b c liftSt (IOSLA f)     = IOSLA $ \ (s1, s2) x -> do-			      (s1', ys) <- f s1 x-			      return ((s1', s2), ys)+                              (s1', ys) <- f s1 x+                              return ((s1', s2), ys)   -- |@@ -176,19 +176,19 @@ -- This is useful, when running an arrow with an extra environment component, e.g. -- for namespace handling in XML. -runSt		:: s2 -> IOSLA (s1, s2) b c -> IOSLA s1 b c+runSt           :: s2 -> IOSLA (s1, s2) b c -> IOSLA s1 b c runSt s2 (IOSLA f)     = IOSLA $ \ s1 x -> do-			((s1', _s2'), ys) <- f (s1, s2) x-			return (s1', ys)+                        ((s1', _s2'), ys) <- f (s1, s2) x+                        return (s1', ys)  -- ------------------------------------------------------------  instance ArrowTree (IOSLA s)  instance (NFData s) => ArrowNF (IOSLA s) where-    rnfA (IOSLA f)	= IOSLA $ \ s x -> do-					   res <- f s x-					   deepseq res $ return res+    rnfA (IOSLA f)      = IOSLA $ \ s x -> do+                                           res <- f s x+                                           deepseq res $ return res  -- ------------------------------------------------------------

@@ -43,67 +43,67 @@  instance Category LA where     id                  = LA $ (:[])-    LA g . LA f		= LA $ concatMap g . f+    LA g . LA f         = LA $ concatMap g . f  instance Arrow LA where-    arr f		= LA $ \ x -> [f x]-    first (LA f)	= LA $ \ ~(x1, x2) -> [ (y1, x2) | y1 <- f x1 ]+    arr f               = LA $ \ x -> [f x]+    first (LA f)        = LA $ \ ~(x1, x2) -> [ (y1, x2) | y1 <- f x1 ]      -- just for efficiency -    second (LA g)	= LA $ \ ~(x1, x2) -> [ (x1, y2) | y2 <- g x2 ]-    LA f *** LA g	= LA $ \ ~(x1, x2) -> [ (y1, y2) | y1 <- f x1, y2 <- g x2]-    LA f &&& LA g	= LA $ \ x         -> [ (y1, y2) | y1 <- f x , y2 <- g x ]+    second (LA g)       = LA $ \ ~(x1, x2) -> [ (x1, y2) | y2 <- g x2 ]+    LA f *** LA g       = LA $ \ ~(x1, x2) -> [ (y1, y2) | y1 <- f x1, y2 <- g x2]+    LA f &&& LA g       = LA $ \ x         -> [ (y1, y2) | y1 <- f x , y2 <- g x ]  instance ArrowZero LA where-    zeroArrow		= LA $ const []+    zeroArrow           = LA $ const []   instance ArrowPlus LA where-    LA f <+> LA g	= LA $ \ x -> f x ++ g x+    LA f <+> LA g       = LA $ \ x -> f x ++ g x   instance ArrowChoice LA where-    left  (LA f)	= LA $ either (map Left . f) ((:[]) . Right)-    right (LA f)	= LA $ either ((:[]) . Left) (map Right . f)-    LA f +++ LA g	= LA $ either (map Left . f) (map Right . g)-    LA f ||| LA g	= LA $ either f g+    left  (LA f)        = LA $ either (map Left . f) ((:[]) . Right)+    right (LA f)        = LA $ either ((:[]) . Left) (map Right . f)+    LA f +++ LA g       = LA $ either (map Left . f) (map Right . g)+    LA f ||| LA g       = LA $ either f g   instance ArrowApply LA where-    app			= LA $ \ (LA f, x) -> f x+    app                 = LA $ \ (LA f, x) -> f x  instance ArrowList LA where-    arrL			= LA-    arr2A f		= LA $ \ ~(x, y) -> runLA (f x) y-    isA p		= LA $ \ x -> if p x then [x] else []-    LA f >>. g		= LA $ g . f-    withDefault	a d	= a >>. \ x -> if null x then [d] else x+    arrL                        = LA+    arr2A f             = LA $ \ ~(x, y) -> runLA (f x) y+    isA p               = LA $ \ x -> if p x then [x] else []+    LA f >>. g          = LA $ g . f+    withDefault a d     = a >>. \ x -> if null x then [d] else x   instance ArrowIf LA where-    ifA (LA p) t e	= LA $ \ x -> runLA ( if null (p x)-					      then e-					      else t-					    ) x+    ifA (LA p) t e      = LA $ \ x -> runLA ( if null (p x)+                                              then e+                                              else t+                                            ) x      (LA f) `orElse` (LA g)-			= LA $ \ x -> ( let-					res = f x-					in-					if null res-					then g x-					else res-				      )+                        = LA $ \ x -> ( let+                                        res = f x+                                        in+                                        if null res+                                        then g x+                                        else res+                                      )      spanA p             = LA $ (:[]) . span (not . null . runLA p) -    partitionA	p	= LA $ (:[]) . partition (not . null . runLA p)+    partitionA  p       = LA $ (:[]) . partition (not . null . runLA p)  instance ArrowTree LA  instance ArrowNF LA where-    rnfA (LA f)		= LA $ \ x -> let res = f x+    rnfA (LA f)         = LA $ \ x -> let res = f x                                       in                                       deepseq res res @@ -112,8 +112,8 @@ -- | conversion of pure list arrows into other possibly more complex -- list arrows -fromLA		:: ArrowList a => LA b c -> a b c-fromLA f	=  arrL (runLA f)+fromLA          :: ArrowList a => LA b c -> a b c+fromLA f        =  arrL (runLA f)  -- ------------------------------------------------------------ 

@@ -16,7 +16,7 @@ -- ------------------------------------------------------------  module Control.Arrow.ListArrows-    ( module Control.Arrow			-- arrow classes+    ( module Control.Arrow                      -- arrow classes     , module Control.Arrow.ArrowList     , module Control.Arrow.ArrowIf     , module Control.Arrow.ArrowNF@@ -24,14 +24,14 @@     , module Control.Arrow.ArrowTree     , module Control.Arrow.ArrowIO -    , module Control.Arrow.ListArrow		-- arrow types+    , module Control.Arrow.ListArrow            -- arrow types     , module Control.Arrow.StateListArrow     , module Control.Arrow.IOListArrow     , module Control.Arrow.IOStateListArrow     ) where -import Control.Arrow				-- arrow classes+import Control.Arrow                            -- arrow classes import Control.Arrow.ArrowList import Control.Arrow.ArrowIf import Control.Arrow.ArrowNF@@ -39,7 +39,7 @@ import Control.Arrow.ArrowTree import Control.Arrow.ArrowIO -import Control.Arrow.ListArrow			-- arrow types+import Control.Arrow.ListArrow                  -- arrow types import Control.Arrow.StateListArrow import Control.Arrow.IOListArrow import Control.Arrow.IOStateListArrow

@@ -45,122 +45,122 @@ instance Category (SLA s) where     id                  = SLA $ \ s x -> (s, [x]) -    SLA g . SLA f	= SLA $ \ s x -> let-					 ~(s1, ys) = f s x-					 sequence' s' []-					     = (s', [])-					 sequence' s' (x':xs')-					     = let-					       ~(s1', ys') = g s' x'-					       ~(s2', zs') = sequence' s1' xs'-					       in-					       (s2', ys' ++ zs')-					 in-					 sequence' s1 ys-	                                 +    SLA g . SLA f       = SLA $ \ s x -> let+                                         ~(s1, ys) = f s x+                                         sequence' s' []+                                             = (s', [])+                                         sequence' s' (x':xs')+                                             = let+                                               ~(s1', ys') = g s' x'+                                               ~(s2', zs') = sequence' s1' xs'+                                               in+                                               (s2', ys' ++ zs')+                                         in+                                         sequence' s1 ys+ instance Arrow (SLA s) where-    arr f		= SLA $ \ s x -> (s, [f x])+    arr f               = SLA $ \ s x -> (s, [f x]) -    first (SLA f)	= SLA $ \ s ~(x1, x2) -> let-						 ~(s', ys1) = f s x1-						 in-						 (s', [ (y1, x2) | y1 <- ys1 ])+    first (SLA f)       = SLA $ \ s ~(x1, x2) -> let+                                                 ~(s', ys1) = f s x1+                                                 in+                                                 (s', [ (y1, x2) | y1 <- ys1 ])      -- just for efficiency-    second (SLA g)	= SLA $ \ s ~(x1, x2) -> let-						 ~(s', ys2) = g s x2-						 in-						 (s', [ (x1, y2) | y2 <- ys2 ])+    second (SLA g)      = SLA $ \ s ~(x1, x2) -> let+                                                 ~(s', ys2) = g s x2+                                                 in+                                                 (s', [ (x1, y2) | y2 <- ys2 ])      -- just for efficiency-    SLA f *** SLA g	= SLA $ \ s ~(x1, x2) -> let-						 ~(s1, ys1) = f s  x1-						 ~(s2, ys2) = g s1 x2-						 in-						 (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])+    SLA f *** SLA g     = SLA $ \ s ~(x1, x2) -> let+                                                 ~(s1, ys1) = f s  x1+                                                 ~(s2, ys2) = g s1 x2+                                                 in+                                                 (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])      -- just for efficiency-    SLA f &&& SLA g	= SLA $ \ s x -> let-					 ~(s1, ys1) = f s  x-					 ~(s2, ys2) = g s1 x-					 in-					 (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])+    SLA f &&& SLA g     = SLA $ \ s x -> let+                                         ~(s1, ys1) = f s  x+                                         ~(s2, ys2) = g s1 x+                                         in+                                         (s2, [ (y1, y2) | y1 <- ys1, y2 <- ys2 ])   instance ArrowZero (SLA s) where-    zeroArrow		= SLA $ \ s -> const (s, [])+    zeroArrow           = SLA $ \ s -> const (s, [])   instance ArrowPlus (SLA s) where-    SLA f <+> SLA g	= SLA $ \ s x -> let-					 ~(s1, rs1) = f s  x-					 ~(s2, rs2) = g s1 x-					 in-					 (s2, rs1 ++ rs2)+    SLA f <+> SLA g     = SLA $ \ s x -> let+                                         ~(s1, rs1) = f s  x+                                         ~(s2, rs2) = g s1 x+                                         in+                                         (s2, rs1 ++ rs2)  instance ArrowChoice (SLA s) where-    left (SLA f)	= SLA $ \ s -> let-			               lf x = (s1, map Left y)-					      where-					      ~(s1, y) = f s x+    left (SLA f)        = SLA $ \ s -> let+                                       lf x = (s1, map Left y)+                                              where+                                              ~(s1, y) = f s x                                        rf x = (s, [Right x])-				       in-				       either lf rf+                                       in+                                       either lf rf -    right (SLA f)	= SLA $ \ s -> let-				       lf x = (s, [Left x])-			               rf x = (s1, map Right y)-					      where-					      ~(s1, y) = f s x-				       in-				       either lf rf+    right (SLA f)       = SLA $ \ s -> let+                                       lf x = (s, [Left x])+                                       rf x = (s1, map Right y)+                                              where+                                              ~(s1, y) = f s x+                                       in+                                       either lf rf   instance ArrowApply (SLA s) where-    app			= SLA $ \ s (SLA f, x) -> f s x+    app                 = SLA $ \ s (SLA f, x) -> f s x   instance ArrowList (SLA s) where-    arrL f		= SLA $ \ s x -> (s, (f x))-    arr2A f		= SLA $ \ s ~(x, y) -> runSLA (f x) s y-    constA c		= SLA $ \ s   -> const (s, [c])-    isA p		= SLA $ \ s x -> (s, if p x then [x] else [])-    SLA f >>. g		= SLA $ \ s x -> let-				         ~(s1, ys) = f s x-					 in-					 (s1, g ys)+    arrL f              = SLA $ \ s x -> (s, (f x))+    arr2A f             = SLA $ \ s ~(x, y) -> runSLA (f x) s y+    constA c            = SLA $ \ s   -> const (s, [c])+    isA p               = SLA $ \ s x -> (s, if p x then [x] else [])+    SLA f >>. g         = SLA $ \ s x -> let+                                         ~(s1, ys) = f s x+                                         in+                                         (s1, g ys)     -- just for efficency-    perform (SLA f)	= SLA $ \ s x -> let-					 ~(s1, _ys) = f s x-					 in-					 (s1, [x])+    perform (SLA f)     = SLA $ \ s x -> let+                                         ~(s1, _ys) = f s x+                                         in+                                         (s1, [x])  instance ArrowIf (SLA s) where-    ifA (SLA p) ta ea	= SLA $ \ s x -> let-				         ~(s1, res) = p s x-					 in-					 runSLA ( if null res-						  then ea-						  else ta-						) s1 x+    ifA (SLA p) ta ea   = SLA $ \ s x -> let+                                         ~(s1, res) = p s x+                                         in+                                         runSLA ( if null res+                                                  then ea+                                                  else ta+                                                ) s1 x      (SLA f) `orElse` g-			= SLA $ \ s x ->  let-				          r@(s1, res) = f s x-					  in-					  if null res-					  then runSLA g s1 x-					  else r+                        = SLA $ \ s x ->  let+                                          r@(s1, res) = f s x+                                          in+                                          if null res+                                          then runSLA g s1 x+                                          else r   instance ArrowState s (SLA s) where-    changeState cf	= SLA $ \ s x -> (cf s x, [x])-    accessState	af	= SLA $ \ s x -> (s, [af s x])+    changeState cf      = SLA $ \ s x -> (cf s x, [x])+    accessState af      = SLA $ \ s x -> (s, [af s x])  instance ArrowTree (SLA s)  instance (NFData s) => ArrowNF (SLA s) where-    rnfA (SLA f)	= SLA $ \ s x -> let res = f s x+    rnfA (SLA f)        = SLA $ \ s x -> let res = f s x                                          in                                          deepseq res res @@ -178,8 +178,8 @@ -- runs a state arrow with initial state 0 (e..g. an Int) within -- another arrow sequence -fromSLA		:: ArrowList a => s -> SLA s b c -> a b c-fromSLA s f	=  arrL (snd . (runSLA f s))+fromSLA         :: ArrowList a => s -> SLA s b c -> a b c+fromSLA s f     =  arrL (snd . (runSLA f s))   -- ------------------------------------------------------------

@@ -13,48 +13,48 @@  type AssocList k v = [(k, v)] --- lookup 	= lookup from Prelude+-- lookup       = lookup from Prelude  -- | lookup with default value -lookupDef	:: Eq k => v -> k -> AssocList k v -> v-lookupDef d k	= fromMaybe d . lookup k+lookupDef       :: Eq k => v -> k -> AssocList k v -> v+lookupDef d k   = fromMaybe d . lookup k  -- | lookup with empty list (empty string) as default value -lookup1		:: Eq k => k -> AssocList k [e] -> [e]-lookup1 k	= fromMaybe [] . lookup k+lookup1         :: Eq k => k -> AssocList k [e] -> [e]+lookup1 k       = fromMaybe [] . lookup k  -- | test for existence of a key -hasEntry	:: Eq k => k -> AssocList k v -> Bool-hasEntry k	= isJust . lookup k+hasEntry        :: Eq k => k -> AssocList k v -> Bool+hasEntry k      = isJust . lookup k  -- | add an entry, remove an existing entry before adding the new one at the top of the list, addEntry is strict -addEntry	:: Eq k => k -> v -> AssocList k v -> AssocList k v-addEntry k v l	= ( (k,v) : ) $! delEntry k l+addEntry        :: Eq k => k -> v -> AssocList k v -> AssocList k v+addEntry k v l  = ( (k,v) : ) $! delEntry k l   -- let l' = delEntry k l in seq l' ((k, v) : l')  -- | add a whole list of entries with 'addEntry' -addEntries	:: Eq k => AssocList k v -> AssocList k v -> AssocList k v-addEntries	= foldr (.) id . map (uncurry addEntry) . reverse+addEntries      :: Eq k => AssocList k v -> AssocList k v -> AssocList k v+addEntries      = foldr (.) id . map (uncurry addEntry) . reverse  -- | delete an entry, delEntry is strict-delEntry	:: Eq k => k -> AssocList k v -> AssocList k v-delEntry _ []	= []+delEntry        :: Eq k => k -> AssocList k v -> AssocList k v+delEntry _ []   = [] delEntry k (x@(k1,_) : rest)-    | k == k1	= rest-    | otherwise	= ( x : ) $! delEntry k rest+    | k == k1   = rest+    | otherwise = ( x : ) $! delEntry k rest --- delEntry k	= filter ((/= k) . fst)+-- delEntry k   = filter ((/= k) . fst)  -- | delete a list of entries with 'delEntry' -delEntries	:: Eq k => [k] -> AssocList k v -> AssocList k v-delEntries	= foldl (.) id . map delEntry+delEntries      :: Eq k => [k] -> AssocList k v -> AssocList k v+delEntries      = foldl (.) id . map delEntry  -- ----------------------------------------------------------------------------- 

@@ -54,9 +54,9 @@  module Data.Atom (    -- * Atom objects-   Atom,		-- instance (Eq, Ord, Read, Show)-   newAtom, 		-- :: String -> Atom-   share		-- :: String -> String+   Atom,                -- instance (Eq, Ord, Read, Show)+   newAtom,             -- :: String -> Atom+   share                -- :: String -> String  ) where  import           Control.Concurrent.MVar@@ -64,75 +64,75 @@  import           Data.ByteString.Internal       ( toForeignPtr, c2w, w2c ) import           Data.ByteString                ( ByteString, pack, unpack )-import qualified Data.Map                 	as M+import qualified Data.Map                       as M import           Data.Typeable  import           System.IO.Unsafe               ( unsafePerformIO ) -import           Text.XML.HXT.DOM.Unicode	( unicodeToUtf8 )-import           Text.XML.HXT.DOM.UTF8Decoding	( decodeUtf8 )+import           Text.XML.HXT.DOM.Unicode       ( unicodeToUtf8 )+import           Text.XML.HXT.DOM.UTF8Decoding  ( decodeUtf8 )  -- ------------------------------------------------------------ -type Atoms	= M.Map ByteString ByteString+type Atoms      = M.Map ByteString ByteString -newtype Atom	= A { bs :: ByteString }+newtype Atom    = A { bs :: ByteString }                   deriving (Typeable)  -- ------------------------------------------------------------  -- | the internal cache for the strings -theAtoms	:: MVar Atoms-theAtoms	= unsafePerformIO (newMVar M.empty)+theAtoms        :: MVar Atoms+theAtoms        = unsafePerformIO (newMVar M.empty) {-# NOINLINE theAtoms #-}  -- | insert a bytestring into the atom cache -insertAtom	:: ByteString -> Atoms -> (Atoms, Atom)-insertAtom s m	= maybe (M.insert s s m, A s)+insertAtom      :: ByteString -> Atoms -> (Atoms, Atom)+insertAtom s m  = maybe (M.insert s s m, A s)                         (\ s' -> (m, A s'))-		  .-		  M.lookup s $ m+                  .+                  M.lookup s $ m  -- | creation of an @Atom@ from a @String@ -newAtom		:: String -> Atom-newAtom		= unsafePerformIO . newAtom'+newAtom         :: String -> Atom+newAtom         = unsafePerformIO . newAtom' {-# NOINLINE newAtom #-}  -- | The internal operation running in the IO monad-newAtom'	:: String -> IO Atom-newAtom' s	= do-		  m <- takeMVar theAtoms-		  let (m', a) = insertAtom (pack. map c2w . unicodeToUtf8 $ s) m-		  putMVar theAtoms m'-		  return a+newAtom'        :: String -> IO Atom+newAtom' s      = do+                  m <- takeMVar theAtoms+                  let (m', a) = insertAtom (pack. map c2w . unicodeToUtf8 $ s) m+                  putMVar theAtoms m'+                  return a  -- | Insert a @String@ into the atom cache and convert the atom back into a @String@. -- -- locically @share == id@ holds, but internally equal strings share the same memory. -share		:: String -> String-share		= show . newAtom+share           :: String -> String+share           = show . newAtom  instance Eq Atom where-    a1 == a2	= fp1 == fp2-	          where-		  (fp1, _, _) = toForeignPtr . bs $ a1-		  (fp2, _, _) = toForeignPtr . bs $ a2+    a1 == a2    = fp1 == fp2+                  where+                  (fp1, _, _) = toForeignPtr . bs $ a1+                  (fp2, _, _) = toForeignPtr . bs $ a2  instance Ord Atom where     compare a1 a2-	        | a1 == a2	= EQ-		| otherwise     = compare (bs a1) (bs a2)+                | a1 == a2      = EQ+                | otherwise     = compare (bs a1) (bs a2)  instance Read Atom where     readsPrec p str = [ (newAtom x, y) | (x, y) <- readsPrec p str ]  instance Show Atom where-    show	= fst . decodeUtf8 . map w2c . unpack . bs-    -- show	= show . toForeignPtr . bs			-- for debug only+    show        = fst . decodeUtf8 . map w2c . unpack . bs+    -- show     = show . toForeignPtr . bs                      -- for debug only  instance NFData Atom where 

@@ -22,71 +22,71 @@  class Tree t where     -- | tree construction: a new tree is constructed by a node attribute and a list of children-    mkTree		::              a -> [t a] -> t a+    mkTree              ::              a -> [t a] -> t a      -- | leaf construction: leafs don't have any children     --     -- definition: @ mkLeaf n = mkTree n [] @ -    mkLeaf		::                       a -> t a-    mkLeaf n		= mkTree n []+    mkLeaf              ::                       a -> t a+    mkLeaf n            = mkTree n []      -- | leaf test: list of children empty? -    isLeaf		::		       t a -> Bool-    isLeaf		= null . getChildren+    isLeaf              ::                     t a -> Bool+    isLeaf              = null . getChildren      -- | innner node test: @ not . isLeaf @ -    isInner		::		       t a -> Bool-    isInner		= not . isLeaf+    isInner             ::                     t a -> Bool+    isInner             = not . isLeaf      -- | select node attribute -    getNode		::                     t a -> a+    getNode             ::                     t a -> a      -- | select children -    getChildren		::                     t a -> [t a]+    getChildren         ::                     t a -> [t a]      -- | edit node attribute -    changeNode		::         (a -> a) -> t a -> t a+    changeNode          ::         (a -> a) -> t a -> t a      -- | edit children -    changeChildren	:: ([t a] -> [t a]) -> t a -> t a+    changeChildren      :: ([t a] -> [t a]) -> t a -> t a      -- | substitute node: @ setNode n = changeNode (const n) @ -    setNode		::                a -> t a -> t a-    setNode n		= changeNode (const n)+    setNode             ::                a -> t a -> t a+    setNode n           = changeNode (const n)      -- | substitute children: @ setChildren cl = changeChildren (const cl) @ -    setChildren		::            [t a] -> t a -> t a-    setChildren cl	= changeChildren (const cl)+    setChildren         ::            [t a] -> t a -> t a+    setChildren cl      = changeChildren (const cl)      -- | fold for trees -    foldTree		::  (a -> [b] -> b) -> t a -> b+    foldTree            ::  (a -> [b] -> b) -> t a -> b      -- | all nodes of a tree -    nodesTree		::		       t a -> [a]+    nodesTree           ::                     t a -> [a]      -- | depth of a tree -    depthTree		::		       t a -> Int+    depthTree           ::                     t a -> Int      -- | number of nodes in a tree -    cardTree		::                     t a -> Int+    cardTree            ::                     t a -> Int      -- | format tree for readable trace output     --     -- a /graphical/ representation of the tree in text format -    formatTree		::    (a -> String) -> t a -> String+    formatTree          ::    (a -> String) -> t a -> String  -- ------------------------------------------------------------

@@ -38,76 +38,76 @@ -- -- NTree implements Eq, Ord, Show and Read -data NTree  a	= NTree a (NTrees a)+data NTree  a   = NTree a (NTrees a)     deriving     (Eq, Ord, Show, Read, Typeable)  -- | shortcut for a sequence of n-ary trees -type NTrees   a	= [NTree a]+type NTrees   a = [NTree a]  -- ------------------------------------------------------------  instance (NFData a) => NFData (NTree a) where-    rnf (NTree n cl)			= rnf n `seq` rnf cl+    rnf (NTree n cl)                    = rnf n `seq` rnf cl  -- | NTree implements class Functor  instance Functor NTree where-    fmap f ~(NTree n cl)		= NTree (f n) (map (fmap f) cl)+    fmap f ~(NTree n cl)                = NTree (f n) (map (fmap f) cl)   -- | Implementation of "Data.Tree.Class" interface for rose trees  instance Tree NTree where-    mkTree n cl				= NTree n cl+    mkTree n cl                         = NTree n cl -    getNode           ~(NTree n _ )	= n-    getChildren       ~(NTree _ cl)	= cl+    getNode           ~(NTree n _ )     = n+    getChildren       ~(NTree _ cl)     = cl -    changeNode     cf ~(NTree n cl)	= NTree (cf n) cl-    changeChildren cf ~(NTree n cl)	= NTree n (cf cl)+    changeNode     cf ~(NTree n cl)     = NTree (cf n) cl+    changeChildren cf ~(NTree n cl)     = NTree n (cf cl) -    foldTree        f ~(NTree n cs)	= f n (map (foldTree f) cs)+    foldTree        f ~(NTree n cs)     = f n (map (foldTree f) cs) -    nodesTree		= foldTree (\ n rs -> n : concat rs)-    depthTree		= foldTree (\ _ rs -> 1 + maximum (0 : rs))-    cardTree		= foldTree (\ _ rs -> 1 + sum rs)-    formatTree nf n	= formatNTreeF nf (showString "---") (showString "   ") n ""+    nodesTree           = foldTree (\ n rs -> n : concat rs)+    depthTree           = foldTree (\ _ rs -> 1 + maximum (0 : rs))+    cardTree            = foldTree (\ _ rs -> 1 + sum rs)+    formatTree nf n     = formatNTreeF nf (showString "---") (showString "   ") n ""  -- ------------------------------------------------------------ -- | -- convert a tree into a pseudo graphical string reprsentation -formatNTreeF	:: (node -> String) -> (String -> String) -> (String -> String) -> NTree node -> String -> String+formatNTreeF    :: (node -> String) -> (String -> String) -> (String -> String) -> NTree node -> String -> String  formatNTreeF node2String pf1 pf2 (NTree n l)     = formatNode       . formatChildren pf2 l     where-    formatNode	= pf1 . foldr (.) id (map trNL (node2String n)) . showNL-    trNL '\n'	= showNL . pf2-    trNL c	= showChar c-    showNL	= showChar '\n'+    formatNode  = pf1 . foldr (.) id (map trNL (node2String n)) . showNL+    trNL '\n'   = showNL . pf2+    trNL c      = showChar c+    showNL      = showChar '\n'     formatChildren _ []-	= id+        = id     formatChildren pf (t:ts)-	| null ts-	    = pfl'-	      . formatTr pf2' t-	| otherwise-	    = pfl'-	      . formatTr pf1' t-	      . formatChildren pf ts-	where-	pf0'	= pf . showString indent1-	pf1'	= pf . showString indent2-	pf2'	= pf . showString indent3-	pfl'	= pf . showString indent4-	formatTr	= formatNTreeF node2String pf0'-	indent1 = "+---"-	indent2 = "|   "-	indent3 = "    "-	indent4 = "|\n"+        | null ts+            = pfl'+              . formatTr pf2' t+        | otherwise+            = pfl'+              . formatTr pf1' t+              . formatChildren pf ts+        where+        pf0'    = pf . showString indent1+        pf1'    = pf . showString indent2+        pf2'    = pf . showString indent3+        pfl'    = pf . showString indent4+        formatTr        = formatNTreeF node2String pf0'+        indent1 = "+---"+        indent2 = "|   "+        indent3 = "    "+        indent4 = "|\n"  -- eof ------------------------------------------------------------

@@ -41,9 +41,9 @@     ) where -import Control.Arrow.ListArrows			-- arrow classes+import Control.Arrow.ListArrows                 -- arrow classes -import Data.Atom ()				-- import this explicitly+import Data.Atom ()                             -- import this explicitly  import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.DocumentInput@@ -57,7 +57,7 @@ import Text.XML.HXT.Arrow.WriteDocument import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlIOStateArrow-import Text.XML.HXT.Arrow.XmlRegex ()		-- import this explicitly+import Text.XML.HXT.Arrow.XmlRegex ()           -- import this explicitly  import Text.XML.HXT.Version 

@@ -25,7 +25,7 @@     ) where -import Control.Arrow				-- arrow classes+import Control.Arrow                            -- arrow classes import Control.Arrow.ArrowList import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree@@ -63,36 +63,36 @@ -- ------------------------------------------------------------ -- -data DTDPart		= Internal-			| External-			  deriving (Eq)+data DTDPart            = Internal+                        | External+                          deriving (Eq) -type RecList		= [String]+type RecList            = [String] -type DTDStateArrow b c	= IOStateArrow PEEnv b c+type DTDStateArrow b c  = IOStateArrow PEEnv b c  -- ------------------------------------------------------------ -newtype PEEnv		= PEEnv (M.Map String XmlTree)+newtype PEEnv           = PEEnv (M.Map String XmlTree) -emptyPeEnv	:: PEEnv-emptyPeEnv	= PEEnv M.empty+emptyPeEnv      :: PEEnv+emptyPeEnv      = PEEnv M.empty -lookupPeEnv	:: String -> PEEnv -> Maybe XmlTree+lookupPeEnv     :: String -> PEEnv -> Maybe XmlTree lookupPeEnv k (PEEnv env)     = M.lookup k env -addPeEntry	:: String -> XmlTree -> PEEnv -> PEEnv+addPeEntry      :: String -> XmlTree -> PEEnv -> PEEnv addPeEntry k a (PEEnv env)     = PEEnv $ M.insert k a env -getPeValue	:: DTDStateArrow String XmlTree+getPeValue      :: DTDStateArrow String XmlTree getPeValue     = (this &&& getUserState)       >>>       arrL (\ (n, env) -> maybeToList . lookupPeEnv n $ env) -addPe		:: String -> DTDStateArrow XmlTree XmlTree+addPe           :: String -> DTDStateArrow XmlTree XmlTree addPe n     = traceMsg 2 ("substParamEntity: add entity " ++ show n ++ " to env")       >>>@@ -111,402 +111,402 @@ -- -- input tree must represent a complete document including root node -processDTD		:: IOStateArrow s XmlTree XmlTree+processDTD              :: IOStateArrow s XmlTree XmlTree processDTD     = runInLocalURIContext          ( processRoot-	   >>>-	   traceTree-	   >>>-	   traceSource-	 )+           >>>+           traceTree+           >>>+           traceSource+         )       `when` ( isRoot >>> getChildren )       where -      processRoot	:: IOStateArrow s XmlTree XmlTree+      processRoot       :: IOStateArrow s XmlTree XmlTree       processRoot-	  = ( traceMsg 1 ("processDTD: process parameter entities")-	      >>>-	      setParamString a_standalone ""-	      >>>-	      ( addDocType-		`whenNot`-		( getChildren >>> isDTDDoctype )-	      )-	      >>>-	      processChildren substParamEntities-	      >>>-	      setDocumentStatusFromSystemState "in XML DTD processing"-	    )+          = ( traceMsg 1 ("processDTD: process parameter entities")+              >>>+              setParamString a_standalone ""+              >>>+              ( addDocType+                `whenNot`+                ( getChildren >>> isDTDDoctype )+              )+              >>>+              processChildren substParamEntities+              >>>+              setDocumentStatusFromSystemState "in XML DTD processing"+            )             `when`-	    documentStatusOk-	  where-	  addDocType-	      = replaceChildren ( (getChildren >>> isXmlPi)-				  <+>-				  mkDTDDoctype [] none-				  <+>-				  (getChildren >>> neg isXmlPi)-				)+            documentStatusOk+          where+          addDocType+              = replaceChildren ( (getChildren >>> isXmlPi)+                                  <+>+                                  mkDTDDoctype [] none+                                  <+>+                                  (getChildren >>> neg isXmlPi)+                                ) -substParamEntities	:: IOStateArrow s XmlTree XmlTree+substParamEntities      :: IOStateArrow s XmlTree XmlTree substParamEntities     = withOtherUserState emptyPeEnv processParamEntities       `when`       isDTDDoctype       where -      processParamEntities	:: DTDStateArrow XmlTree XmlTree+      processParamEntities      :: DTDStateArrow XmlTree XmlTree       processParamEntities-	  = mergeEntities $<<< ( listA processPredef-				 &&&-				 listA processInt-				 &&&-				 listA (runInLocalURIContext processExt)-			       )-	  where-	  mergeEntities dtdPre dtdInt dtdExt-	      =  replaceChildren (arrL $ const $ foldl1 mergeDTDs [dtdPre, dtdInt, dtdExt])+          = mergeEntities $<<< ( listA processPredef+                                 &&&+                                 listA processInt+                                 &&&+                                 listA (runInLocalURIContext processExt)+                               )+          where+          mergeEntities dtdPre dtdInt dtdExt+              =  replaceChildren (arrL $ const $ foldl1 mergeDTDs [dtdPre, dtdInt, dtdExt]) -	  processPredef-	      = predefDTDPart   >>> substParamEntity Internal []+          processPredef+              = predefDTDPart   >>> substParamEntity Internal [] -	  processInt-	      = getChildren     >>> substParamEntity Internal []+          processInt+              = getChildren     >>> substParamEntity Internal [] -	  processExt-	      = externalDTDPart >>> substParamEntity External []+          processExt+              = externalDTDPart >>> substParamEntity External [] -	  mergeDTDs	:: XmlTrees -> XmlTrees -> XmlTrees-	  mergeDTDs dtdInt dtdExt-	      = dtdInt ++ (filter (filterDTDNodes dtdInt) dtdExt)+          mergeDTDs     :: XmlTrees -> XmlTrees -> XmlTrees+          mergeDTDs dtdInt dtdExt+              = dtdInt ++ (filter (filterDTDNodes dtdInt) dtdExt) -	  filterDTDNodes	:: XmlTrees -> XmlTree -> Bool-	  filterDTDNodes dtdPart t-	      = not (any (filterDTDNode t) dtdPart)+          filterDTDNodes        :: XmlTrees -> XmlTree -> Bool+          filterDTDNodes dtdPart t+              = not (any (filterDTDNode t) dtdPart) -	  filterDTDNode	:: XmlTree -> XmlTree -> Bool+          filterDTDNode :: XmlTree -> XmlTree -> Bool -	  filterDTDNode	t1 t2-	      = fromMaybe False $-	        do-		dp1 <- XN.getDTDPart t1-		dp2 <- XN.getDTDPart t2-		al1 <- XN.getDTDAttrl t1-		al2 <- XN.getDTDAttrl t2-		return ( dp1 == dp2-			 &&-			 ( dp1 `elem` [ELEMENT, NOTATION, ENTITY, ATTLIST] )-			 &&-			 ( lookup a_name al1 == lookup a_name al2 )-			 &&-			 ( dp1 /= ATTLIST-			   ||-			   lookup a_value al1 == lookup a_value al2-			 )-		       )+          filterDTDNode t1 t2+              = fromMaybe False $+                do+                dp1 <- XN.getDTDPart t1+                dp2 <- XN.getDTDPart t2+                al1 <- XN.getDTDAttrl t1+                al2 <- XN.getDTDAttrl t2+                return ( dp1 == dp2+                         &&+                         ( dp1 `elem` [ELEMENT, NOTATION, ENTITY, ATTLIST] )+                         &&+                         ( lookup a_name al1 == lookup a_name al2 )+                         &&+                         ( dp1 /= ATTLIST+                           ||+                           lookup a_value al1 == lookup a_value al2+                         )+                       ) -substParamEntity	:: DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree+substParamEntity        :: DTDPart -> RecList -> DTDStateArrow XmlTree XmlTree substParamEntity loc recList     = choiceA-      [ isDTDEntity	:-> ( traceDTD "ENTITY declaration before DTD declaration parsing"-			      >>>-			      processChildren (substPeRefsInDTDdecl recList)-			      >>>-			      parseXmlDTDdecl-			      >>>-			      substRefsInEntityValue-			      >>>-			      processEntityDecl-			      >>>-			      traceDTD "ENTITY declaration after DTD declaration parsing"-			    )+      [ isDTDEntity     :-> ( traceDTD "ENTITY declaration before DTD declaration parsing"+                              >>>+                              processChildren (substPeRefsInDTDdecl recList)+                              >>>+                              parseXmlDTDdecl+                              >>>+                              substRefsInEntityValue+                              >>>+                              processEntityDecl+                              >>>+                              traceDTD "ENTITY declaration after DTD declaration parsing"+                            )       , ( isDTDElement-	  <+>-	  isDTDAttlist-	  <+>-	  isDTDNotation-	)		:-> ( traceDTD "DTD declaration before PE substitution"-			      >>>-			      processChildren (substPeRefsInDTDdecl recList)-			      >>>-			      parseXmlDTDdecl-			      >>>-			      traceDTD "DTD declaration after DTD declaration parsing"-			    )-      , isDTDPERef	:-> substPeRefsInDTDpart recList+          <+>+          isDTDAttlist+          <+>+          isDTDNotation+        )               :-> ( traceDTD "DTD declaration before PE substitution"+                              >>>+                              processChildren (substPeRefsInDTDdecl recList)+                              >>>+                              parseXmlDTDdecl+                              >>>+                              traceDTD "DTD declaration after DTD declaration parsing"+                            )+      , isDTDPERef      :-> substPeRefsInDTDpart recList -      , isDTDCondSect	:-> ( if loc == Internal-			      then issueErr "conditional sections in internal part of the DTD is not allowed"-			      else evalCondSect $< getDTDAttrValue a_value-			    )-      , isCmt		:-> none-      , this		:-> this+      , isDTDCondSect   :-> ( if loc == Internal+                              then issueErr "conditional sections in internal part of the DTD is not allowed"+                              else evalCondSect $< getDTDAttrValue a_value+                            )+      , isCmt           :-> none+      , this            :-> this       ]     where-    processEntityDecl		:: DTDStateArrow XmlTree XmlTree+    processEntityDecl           :: DTDStateArrow XmlTree XmlTree     processEntityDecl-	= choiceA-	  [ isDTDEntity	:-> ( ifA (hasDTDAttr k_system)-			      processExternalEntity-			      processInternalEntity-			    )-	  , isDTDPEntity-			:-> ( processParamEntity $< getDTDAttrValue a_name )-	  , this	:-> none-	  ]-	where-	processExternalEntity	:: DTDStateArrow XmlTree XmlTree	-- processing external entities is delayed until first usage-	processExternalEntity						-- only the current base uri must be remembered-	    = setDTDAttrValue a_url $< ( getDTDAttrValue k_system >>> mkAbsURI )+        = choiceA+          [ isDTDEntity :-> ( ifA (hasDTDAttr k_system)+                              processExternalEntity+                              processInternalEntity+                            )+          , isDTDPEntity+                        :-> ( processParamEntity $< getDTDAttrValue a_name )+          , this        :-> none+          ]+        where+        processExternalEntity   :: DTDStateArrow XmlTree XmlTree        -- processing external entities is delayed until first usage+        processExternalEntity                                           -- only the current base uri must be remembered+            = setDTDAttrValue a_url $< ( getDTDAttrValue k_system >>> mkAbsURI ) -	processInternalEntity	:: DTDStateArrow XmlTree XmlTree	-- just combine all parts of the entity value-	processInternalEntity						-- into one string-	    = replaceChildren (xshow getChildren >>> mkText)+        processInternalEntity   :: DTDStateArrow XmlTree XmlTree        -- just combine all parts of the entity value+        processInternalEntity                                           -- into one string+            = replaceChildren (xshow getChildren >>> mkText) -	processParamEntity	:: String -> DTDStateArrow XmlTree XmlTree-	processParamEntity peName-	    = ifA (constA peName >>> getPeValue)-	      ( issueWarn ("parameter entity " ++ show peName ++ " already defined") )-	      ( ( ifA ( hasDTDAttr k_system )				-- is external param entity ?-		  ( runInLocalURIContext getExternalParamEntityValue )-		  ( replaceChildren (xshow getChildren >>> mkText) )	-- just combine all parts of the entity value into one string-		)+        processParamEntity      :: String -> DTDStateArrow XmlTree XmlTree+        processParamEntity peName+            = ifA (constA peName >>> getPeValue)+              ( issueWarn ("parameter entity " ++ show peName ++ " already defined") )+              ( ( ifA ( hasDTDAttr k_system )                           -- is external param entity ?+                  ( runInLocalURIContext getExternalParamEntityValue )+                  ( replaceChildren (xshow getChildren >>> mkText) )    -- just combine all parts of the entity value into one string+                )                 >>>                 addPe peName-	      )+              ) -    substPERef			:: String -> DTDStateArrow XmlTree XmlTree+    substPERef                  :: String -> DTDStateArrow XmlTree XmlTree     substPERef pn-	= choiceA-	  [ isInternalRef	:-> issueErr ("a parameter entity reference of " ++ show pn ++ " occurs in the internal subset of the DTD")-	  , isUndefinedRef	:-> issueErr ("parameter entity " ++ show pn ++ " not found (forward reference?)")-	  , this		:-> substPE-	  ]-	  `when`-	  isDTDPERef-	where-	isInternalRef	= isA (const (loc == Internal))-	peVal		= constA pn >>> getPeValue-	isUndefinedRef	= neg peVal-	substPE-	    = replaceChildren (peVal >>> getChildren)			-- store PE value in children component-	      >>>-	      ( ( setBase $< (peVal >>> getDTDAttrValue a_url) )	-- store base uri for external refs-		`orElse`-		this-	      )-	    where-	    setBase uri	= setDTDAttrValue a_url uri+        = choiceA+          [ isInternalRef       :-> issueErr ("a parameter entity reference of " ++ show pn ++ " occurs in the internal subset of the DTD")+          , isUndefinedRef      :-> issueErr ("parameter entity " ++ show pn ++ " not found (forward reference?)")+          , this                :-> substPE+          ]+          `when`+          isDTDPERef+        where+        isInternalRef   = isA (const (loc == Internal))+        peVal           = constA pn >>> getPeValue+        isUndefinedRef  = neg peVal+        substPE+            = replaceChildren (peVal >>> getChildren)                   -- store PE value in children component+              >>>+              ( ( setBase $< (peVal >>> getDTDAttrValue a_url) )        -- store base uri for external refs+                `orElse`+                this+              )+            where+            setBase uri = setDTDAttrValue a_url uri -    substRefsInEntityValue	:: DTDStateArrow XmlTree XmlTree+    substRefsInEntityValue      :: DTDStateArrow XmlTree XmlTree     substRefsInEntityValue-	= ( ( processChildren ( transfCharRef-				>>>-				substPeRefsInValue []-			      )-	    )-	    `whenNot`-	    hasDTDAttr k_system						-- only apply for internal entities-	  )-	  `when` -	  ( isDTDEntity <+> isDTDPEntity )				-- only apply for entity declarations+        = ( ( processChildren ( transfCharRef+                                >>>+                                substPeRefsInValue []+                              )+            )+            `whenNot`+            hasDTDAttr k_system                                         -- only apply for internal entities+          )+          `when`+          ( isDTDEntity <+> isDTDPEntity )                              -- only apply for entity declarations -    substPeRefsInDTDpart	:: RecList -> DTDStateArrow XmlTree XmlTree+    substPeRefsInDTDpart        :: RecList -> DTDStateArrow XmlTree XmlTree     substPeRefsInDTDpart rl-	= recursionCheck "DTD part" rl subst-	where-	subst	:: RecList -> String -> DTDStateArrow XmlTree XmlTree-	subst recl pn-	    = substPERef pn-	      >>>-	      traceDTD "substPeRefsInDTDdecl: before parseXmlDTDPart"-	      >>>-	      ( runInPeContext ( getChildren-				 >>>-				 ( (constA ("parameter entity: " ++ pn)) &&& this )-				 >>>-				 parseXmlDTDPart-				 >>>-				 traceDTD "substPeRefsInDTDpart: after parseXmlDTDPart"-				 >>>-				 substParamEntity loc (pn : recl)-			       )-		`when`-		isDTDPERef-	      )+        = recursionCheck "DTD part" rl subst+        where+        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree+        subst recl pn+            = substPERef pn+              >>>+              traceDTD "substPeRefsInDTDdecl: before parseXmlDTDPart"+              >>>+              ( runInPeContext ( getChildren+                                 >>>+                                 ( (constA ("parameter entity: " ++ pn)) &&& this )+                                 >>>+                                 parseXmlDTDPart+                                 >>>+                                 traceDTD "substPeRefsInDTDpart: after parseXmlDTDPart"+                                 >>>+                                 substParamEntity loc (pn : recl)+                               )+                `when`+                isDTDPERef+              ) -    substPeRefsInDTDdecl	:: RecList -> DTDStateArrow XmlTree XmlTree+    substPeRefsInDTDdecl        :: RecList -> DTDStateArrow XmlTree XmlTree     substPeRefsInDTDdecl rl-	= recursionCheck "DTD declaration" rl subst-	where-	subst	:: RecList -> String -> DTDStateArrow XmlTree XmlTree-	subst recl pn-	    = substPERef pn-	      >>>-	      traceDTD "substPeRefsInDTDdecl: before parseXmlDTDdeclPart"-	      >>>-	      ( runInPeContext ( parseXmlDTDdeclPart-				 >>>-				 traceDTD "substPeRefsInDTDdecl: after parseXmlDTDdeclPart"-				 >>>-				 processChildren ( substPeRefsInDTDdecl (pn : recl) )-			       )-		`when`-		isDTDPERef-	      )+        = recursionCheck "DTD declaration" rl subst+        where+        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree+        subst recl pn+            = substPERef pn+              >>>+              traceDTD "substPeRefsInDTDdecl: before parseXmlDTDdeclPart"+              >>>+              ( runInPeContext ( parseXmlDTDdeclPart+                                 >>>+                                 traceDTD "substPeRefsInDTDdecl: after parseXmlDTDdeclPart"+                                 >>>+                                 processChildren ( substPeRefsInDTDdecl (pn : recl) )+                               )+                `when`+                isDTDPERef+              ) -    substPeRefsInValue		:: RecList -> DTDStateArrow XmlTree XmlTree+    substPeRefsInValue          :: RecList -> DTDStateArrow XmlTree XmlTree     substPeRefsInValue rl-	= recursionCheck "entity value" rl subst-	where-	subst	:: RecList -> String -> DTDStateArrow XmlTree XmlTree-	subst recl pn-	    = substPERef pn-	      >>>-	      parseXmlDTDEntityValue-	      >>>-	      transfCharRef-	      >>>-	      substPeRefsInValue (pn : recl)+        = recursionCheck "entity value" rl subst+        where+        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree+        subst recl pn+            = substPERef pn+              >>>+              parseXmlDTDEntityValue+              >>>+              transfCharRef+              >>>+              substPeRefsInValue (pn : recl) -    substPeRefsInCondSect	:: RecList -> DTDStateArrow XmlTree XmlTree+    substPeRefsInCondSect       :: RecList -> DTDStateArrow XmlTree XmlTree     substPeRefsInCondSect rl-	= recursionCheck "conditional section" rl subst-	where-	subst	:: RecList -> String -> DTDStateArrow XmlTree XmlTree-	subst recl pn-	    = substPERef pn-	      >>>-	      traceDTD "substPeRefsInCondSect: parseXmlDTDdeclPart"-	      >>>-	      runInPeContext ( parseXmlDTDdeclPart-			       >>>-			       traceDTD "substPeRefsInCondSect: after parseXmlDTDdeclPart"-			       >>>-			       processChildren ( substPeRefsInCondSect (pn : recl) )-			     )+        = recursionCheck "conditional section" rl subst+        where+        subst   :: RecList -> String -> DTDStateArrow XmlTree XmlTree+        subst recl pn+            = substPERef pn+              >>>+              traceDTD "substPeRefsInCondSect: parseXmlDTDdeclPart"+              >>>+              runInPeContext ( parseXmlDTDdeclPart+                               >>>+                               traceDTD "substPeRefsInCondSect: after parseXmlDTDdeclPart"+                               >>>+                               processChildren ( substPeRefsInCondSect (pn : recl) )+                             ) -    recursionCheck	:: String -> RecList -> (RecList -> String -> DTDStateArrow XmlTree XmlTree) -> DTDStateArrow XmlTree XmlTree+    recursionCheck      :: String -> RecList -> (RecList -> String -> DTDStateArrow XmlTree XmlTree) -> DTDStateArrow XmlTree XmlTree     recursionCheck wher rl subst-	= ( recusiveSubst  $< getDTDAttrValue a_peref )-	  `when`-	  isDTDPERef-	where-	recusiveSubst name-	    | name `elem` rl-		= issueErr ("recursive call of parameter entity " ++ show name ++ " in " ++ wher)+        = ( recusiveSubst  $< getDTDAttrValue a_peref )+          `when`+          isDTDPERef+        where+        recusiveSubst name+            | name `elem` rl+                = issueErr ("recursive call of parameter entity " ++ show name ++ " in " ++ wher)             | otherwise-		= subst rl name+                = subst rl name -    runInPeContext	:: DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree+    runInPeContext      :: DTDStateArrow XmlTree XmlTree -> DTDStateArrow XmlTree XmlTree     runInPeContext f-	= ( runWithNewBase $< getDTDAttrValue a_url )-	  `orElse`-	  f-	where-	runWithNewBase base-	    = runInLocalURIContext-	      ( perform (constA base >>> setBaseURI)-		>>>-		f-	      )+        = ( runWithNewBase $< getDTDAttrValue a_url )+          `orElse`+          f+        where+        runWithNewBase base+            = runInLocalURIContext+              ( perform (constA base >>> setBaseURI)+                >>>+                f+              ) -    evalCondSect	:: String ->  DTDStateArrow XmlTree XmlTree+    evalCondSect        :: String ->  DTDStateArrow XmlTree XmlTree     evalCondSect content-	= traceDTD "evalCondSect: process conditional section"-	  >>>-	  processChildren (substPeRefsInCondSect [])-	  >>>-	  parseXmlDTDdecl-	  >>>-	  ( hasText (== k_include)-	    `guards`-	    ( ( constA "conditional section" &&& txt content )-	      >>>-	      parseXmlDTDPart-	      >>>-	      traceMsg 2 "evalCond: include DTD part"-	      >>>-	      substParamEntity External recList-	    )-	  )+        = traceDTD "evalCondSect: process conditional section"+          >>>+          processChildren (substPeRefsInCondSect [])+          >>>+          parseXmlDTDdecl+          >>>+          ( hasText (== k_include)+            `guards`+            ( ( constA "conditional section" &&& txt content )+              >>>+              parseXmlDTDPart+              >>>+              traceMsg 2 "evalCond: include DTD part"+              >>>+              substParamEntity External recList+            )+          ) -predefDTDPart		:: DTDStateArrow XmlTree XmlTree+predefDTDPart           :: DTDStateArrow XmlTree XmlTree predefDTDPart     = ( constA "predefined entities"-	&&&-	( constA predefinedEntities >>> mkText)+        &&&+        ( constA predefinedEntities >>> mkText)       )       >>>       parseXmlDTDPart     where-    predefinedEntities	:: String+    predefinedEntities  :: String     predefinedEntities-	= concat [ "<!ENTITY lt   '&#38;#60;'>"-		 , "<!ENTITY gt   '&#62;'>"-		 , "<!ENTITY amp  '&#38;#38;'>"-		 , "<!ENTITY apos '&#39;'>"-		 , "<!ENTITY quot '&#34;'>"-		 ]+        = concat [ "<!ENTITY lt   '&#38;#60;'>"+                 , "<!ENTITY gt   '&#62;'>"+                 , "<!ENTITY amp  '&#38;#38;'>"+                 , "<!ENTITY apos '&#39;'>"+                 , "<!ENTITY quot '&#34;'>"+                 ] -externalDTDPart		:: DTDStateArrow XmlTree XmlTree+externalDTDPart         :: DTDStateArrow XmlTree XmlTree externalDTDPart     = isDTDDoctype       `guards`       ( hasDTDAttr k_system-	`guards`-	( getExternalDTDPart $< getDTDAttrValue k_system )+        `guards`+        ( getExternalDTDPart $< getDTDAttrValue k_system )       ) -getExternalDTDPart	:: String -> DTDStateArrow XmlTree XmlTree+getExternalDTDPart      :: String -> DTDStateArrow XmlTree XmlTree getExternalDTDPart src     = root [sattr a_source src] []       >>>       getXmlEntityContents       >>>       replaceChildren ( ( constA src &&& getChildren )-			>>>-			parseXmlDTDPart-		      )+                        >>>+                        parseXmlDTDPart+                      )       >>>       traceDoc "processExternalDTD: parsing DTD part done"       >>>       getChildren -getExternalParamEntityValue	:: DTDStateArrow XmlTree XmlTree+getExternalParamEntityValue     :: DTDStateArrow XmlTree XmlTree getExternalParamEntityValue     = isDTDPEntity       `guards`       ( setEntityValue $<<< ( getDTDAttrl-			      &&&-			      listA ( getEntityValue $< getDTDAttrl )-			      &&&-			      getBaseURI-			    )+                              &&&+                              listA ( getEntityValue $< getDTDAttrl )+                              &&&+                              getBaseURI+                            )       )     where-    getEntityValue	:: Attributes -> DTDStateArrow XmlTree XmlTree+    getEntityValue      :: Attributes -> DTDStateArrow XmlTree XmlTree     getEntityValue al-	= root [sattr a_source (lookup1 k_system al){- <+> catA (map (uncurry sattr) al)-}] []-	  >>>-	  getXmlEntityContents-	  >>>-	  traceMsg 2 "getExternalParamEntityValue: contents read"+        = root [sattr a_source (lookup1 k_system al){- <+> catA (map (uncurry sattr) al)-}] []           >>>-	  getChildren+          getXmlEntityContents+          >>>+          traceMsg 2 "getExternalParamEntityValue: contents read"+          >>>+          getChildren -    setEntityValue	:: Attributes -> XmlTrees -> String -> DTDStateArrow XmlTree XmlTree+    setEntityValue      :: Attributes -> XmlTrees -> String -> DTDStateArrow XmlTree XmlTree     setEntityValue al res base-	| null res-	    = issueErr ("illegal external parameter entity value for entity %" ++ peName ++";")-	| otherwise-	    = mkDTDElem PENTITY ((a_url, base) : al) (arrL $ const res)-	where-	peName = lookup1 a_name al+        | null res+            = issueErr ("illegal external parameter entity value for entity %" ++ peName ++";")+        | otherwise+            = mkDTDElem PENTITY ((a_url, base) : al) (arrL $ const res)+        where+        peName = lookup1 a_name al -traceDTD	:: String -> DTDStateArrow XmlTree XmlTree-traceDTD msg	= traceMsg 3 msg >>> traceTree+traceDTD        :: String -> DTDStateArrow XmlTree XmlTree+traceDTD msg    = traceMsg 3 msg >>> traceTree  -- ------------------------------------------------------------ 

@@ -25,59 +25,59 @@     ) where -import Control.Arrow				-- arrow classes+import Control.Arrow                            -- arrow classes import Control.Arrow.ArrowList import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree import Control.Arrow.ArrowIO import Control.Arrow.ListArrow -import Data.List				( isPrefixOf )+import Data.List                                ( isPrefixOf ) -import System.FilePath				( takeExtension )+import System.FilePath                          ( takeExtension ) -import Text.XML.HXT.DOM.Unicode			( getDecodingFct-						, guessEncoding-						, normalizeNL-						)+import Text.XML.HXT.DOM.Unicode                 ( getDecodingFct+                                                , guessEncoding+                                                , normalizeNL+                                                ) -import qualified Text.XML.HXT.IO.GetFILE	as FILE-import qualified Text.XML.HXT.IO.GetHTTPLibCurl	as LibCURL+import qualified Text.XML.HXT.IO.GetFILE        as FILE+import qualified Text.XML.HXT.IO.GetHTTPLibCurl as LibCURL  import Text.XML.HXT.DOM.Interface -import Text.XML.HXT.Arrow.ParserInterface	( parseXmlDocEncodingSpec-						, parseXmlEntityEncodingSpec-						, removeEncodingSpec-						)+import Text.XML.HXT.Arrow.ParserInterface       ( parseXmlDocEncodingSpec+                                                , parseXmlEntityEncodingSpec+                                                , removeEncodingSpec+                                                ) import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlIOStateArrow  -- ---------------------------------------------------------- -protocolHandlers	:: AssocList String (IOStateArrow s XmlTree XmlTree)+protocolHandlers        :: AssocList String (IOStateArrow s XmlTree XmlTree) protocolHandlers-    = [ ("file",	getFileContents)-      , ("http",	getHttpContents)-      , ("stdin",	getStdinContents)+    = [ ("file",        getFileContents)+      , ("http",        getHttpContents)+      , ("stdin",       getStdinContents)       ] -getProtocolHandler	:: IOStateArrow s String (IOStateArrow s XmlTree XmlTree)+getProtocolHandler      :: IOStateArrow s String (IOStateArrow s XmlTree XmlTree) getProtocolHandler     = arr (\ s -> lookupDef getUnsupported s protocolHandlers) -getUnsupported		:: IOStateArrow s XmlTree XmlTree+getUnsupported          :: IOStateArrow s XmlTree XmlTree getUnsupported     = perform ( getAttrValue a_source-		>>>-		arr (("unsupported protocol in URI " ++) . show)-		>>>-		applyA (arr issueFatal)-	      )+                >>>+                arr (("unsupported protocol in URI " ++) . show)+                >>>+                applyA (arr issueFatal)+              )       >>>       setDocumentStatusFromSystemState "accessing documents"-	-getStringContents		:: IOStateArrow s XmlTree XmlTree++getStringContents               :: IOStateArrow s XmlTree XmlTree getStringContents     = setCont $< getAttrValue a_source       >>>@@ -86,59 +86,59 @@       addAttr transferStatus "200"     where     setCont contents-	= replaceChildren (txt contents')-	  >>>-	  addAttr transferURI (take 7 contents)			-- the "string:" prefix is stored, this is required by setBaseURIFromDoc-	  >>>-	  addAttr a_source (show . prefix 48 $ contents')	-- a quoted prefix of the content, max 48 chars is taken as source name-	where-	contents'  = drop (length stringProtocol) contents-	prefix l s-	    | length s' > l = take (l - 3) s' ++ "..."-	    | otherwise     = s'-	    where-	    s' = take (l + 1) s+        = replaceChildren (txt contents')+          >>>+          addAttr transferURI (take 7 contents)                 -- the "string:" prefix is stored, this is required by setBaseURIFromDoc+          >>>+          addAttr a_source (show . prefix 48 $ contents')       -- a quoted prefix of the content, max 48 chars is taken as source name+        where+        contents'  = drop (length stringProtocol) contents+        prefix l s+            | length s' > l = take (l - 3) s' ++ "..."+            | otherwise     = s'+            where+            s' = take (l + 1) s -getFileContents		:: IOStateArrow s XmlTree XmlTree+getFileContents         :: IOStateArrow s XmlTree XmlTree getFileContents     = applyA ( ( ( getAttrValue  a_strict_input-		   >>>-		   arr isTrueValue-		 )-		 &&&-		 ( getAttrValue transferURI-		   >>>-		   getPathFromURI-		 )-	       )-	       >>>-	       traceValue 2 (\ (b, f) -> "read file " ++ show f ++ " (strict input = " ++ show b ++ ")")-	       >>>-	       arrIO (uncurry FILE.getCont)-	       >>>-	       ( arr (uncurry addError)	-- io error occured-		 |||-		 arr addTxtContent	-- content read-	       )-	     )+                   >>>+                   arr isTrueValue+                 )+                 &&&+                 ( getAttrValue transferURI+                   >>>+                   getPathFromURI+                 )+               )+               >>>+               traceValue 2 (\ (b, f) -> "read file " ++ show f ++ " (strict input = " ++ show b ++ ")")+               >>>+               arrIO (uncurry FILE.getCont)+               >>>+               ( arr (uncurry addError) -- io error occured+                 |||+                 arr addTxtContent      -- content read+               )+             )       >>>       addMimeType -getStdinContents		:: IOStateArrow s XmlTree XmlTree+getStdinContents                :: IOStateArrow s XmlTree XmlTree getStdinContents     = applyA (  getAttrValue  a_strict_input-		>>>-		arr isTrueValue-		>>>-		arrIO FILE.getStdinCont-	       >>>-	       ( arr (uncurry addError)	-- io error occured-		 |||-		 arr addTxtContent	-- content read-	       )-	     )+                >>>+                arr isTrueValue+                >>>+                arrIO FILE.getStdinCont+               >>>+               ( arr (uncurry addError) -- io error occured+                 |||+                 arr addTxtContent      -- content read+               )+             ) -addError		:: [(String, String)] -> String -> IOStateArrow s XmlTree XmlTree+addError                :: [(String, String)] -> String -> IOStateArrow s XmlTree XmlTree addError al e     = issueFatal e       >>>@@ -146,19 +146,19 @@       >>>       setDocumentStatusFromSystemState "accessing documents" -addMimeType	:: IOStateArrow s XmlTree XmlTree+addMimeType     :: IOStateArrow s XmlTree XmlTree addMimeType     = addMime $< ( getAttrValue transferURI-		   >>>-		   ( uriToMime $< getSysParam xio_mimeTypes )-		 )+                   >>>+                   ( uriToMime $< getSysParam xio_mimeTypes )+                 )     where     addMime mt-	= addAttr transferMimeType mt+        = addAttr transferMimeType mt     uriToMime mtt-	= arr $ ( \ uri -> extensionToMimeType (drop 1 . takeExtension $ uri) mtt )+        = arr $ ( \ uri -> extensionToMimeType (drop 1 . takeExtension $ uri) mtt ) -addTxtContent	:: String -> IOStateArrow s XmlTree XmlTree+addTxtContent   :: String -> IOStateArrow s XmlTree XmlTree addTxtContent c     = replaceChildren (txt c)       >>>@@ -166,101 +166,101 @@       >>>       addAttr transferStatus "200" -getHttpContents		:: IOStateArrow s XmlTree XmlTree+getHttpContents         :: IOStateArrow s XmlTree XmlTree getHttpContents     = getCont $<< ( getAttrValue transferURI-		    &&&-		    ( ( getAttrlAsAssoc		-- get all attributes of root node-			&&&-			getAllParamsString	-- get all system params-		      )-		      >>^ uncurry addEntries	-- merge them, attributes overwrite system params-		    )-		  )+                    &&&+                    ( ( getAttrlAsAssoc         -- get all attributes of root node+                        &&&+                        getAllParamsString      -- get all system params+                      )+                      >>^ uncurry addEntries    -- merge them, attributes overwrite system params+                    )+                  )       where-      getAttrlAsAssoc				-- get the attributes as assoc list-	  = listA ( getAttrl-		    >>> ( getName-			  &&&-			  xshow getChildren-			)-		  )+      getAttrlAsAssoc                           -- get the attributes as assoc list+          = listA ( getAttrl+                    >>> ( getName+                          &&&+                          xshow getChildren+                        )+                  )        getCont uri options-	  = applyA ( ( traceMsg 2 ( "get HTTP via libcurl, uri=" ++ show uri ++ " options=" ++ show options )-		       >>>-		       arrIO0 ( LibCURL.getCont options uri )-		     )-		     >>>-		     ( arr (uncurry addError)-		       |||-		       arr addContent-		     )-		   )+          = applyA ( ( traceMsg 2 ( "get HTTP via libcurl, uri=" ++ show uri ++ " options=" ++ show options )+                       >>>+                       arrIO0 ( LibCURL.getCont options uri )+                     )+                     >>>+                     ( arr (uncurry addError)+                       |||+                       arr addContent+                     )+                   ) -      addContent	:: (AssocList String String, String) -> IOStateArrow s XmlTree XmlTree+      addContent        :: (AssocList String String, String) -> IOStateArrow s XmlTree XmlTree       addContent (al, c)-	  = replaceChildren (txt c)-	    >>>-	    seqA (map (uncurry addAttr) al)+          = replaceChildren (txt c)+            >>>+            seqA (map (uncurry addAttr) al) -getURIContents		:: IOStateArrow s XmlTree XmlTree+getURIContents          :: IOStateArrow s XmlTree XmlTree getURIContents     = getContentsFromString       `orElse`       getContentsFromDoc     where     getContentsFromString-	= ( getAttrValue a_source-	    >>>-	    isA (isPrefixOf stringProtocol)-	  )-	  `guards`-	  getStringContents-	  +        = ( getAttrValue a_source+            >>>+            isA (isPrefixOf stringProtocol)+          )+          `guards`+          getStringContents+     getContentsFromDoc-	= ( ( addTransferURI $< getBaseURI-	      >>>-	      getCont-	    )-	    `when`-	    ( setAbsURI $< ( getAttrValue a_source-			     >>^-			     ( \ src-> (if null src then "stdin:" else src) )	-- empty document name -> read from stdin-			   )-	    )-	  )+        = ( ( addTransferURI $< getBaseURI+              >>>+              getCont+            )+            `when`+            ( setAbsURI $< ( getAttrValue a_source+                             >>^+                             ( \ src-> (if null src then "stdin:" else src) )   -- empty document name -> read from stdin+                           )+            )+          )           >>>           setDocumentStatusFromSystemState "getURIContents"      setAbsURI src-	= ifA ( constA src >>> changeBaseURI )-	  this-	  ( issueFatal ("illegal URI : " ++ show src) )+        = ifA ( constA src >>> changeBaseURI )+          this+          ( issueFatal ("illegal URI : " ++ show src) )      addTransferURI uri-	= addAttr transferURI uri+        = addAttr transferURI uri      getCont-	= applyA ( getBaseURI				-- compute the handler and call it-		   >>>-		   traceValue 2 (("getURIContents: reading " ++) . show)-		   >>>-		   getSchemeFromURI-		   >>>-		   getProtocolHandler-		 )-	  `orElse`-	  this						-- don't change tree, when no handler can be found-	  -setBaseURIFromDoc	:: IOStateArrow s XmlTree XmlTree+        = applyA ( getBaseURI                           -- compute the handler and call it+                   >>>+                   traceValue 2 (("getURIContents: reading " ++) . show)+                   >>>+                   getSchemeFromURI+                   >>>+                   getProtocolHandler+                 )+          `orElse`+          this                                          -- don't change tree, when no handler can be found++setBaseURIFromDoc       :: IOStateArrow s XmlTree XmlTree setBaseURIFromDoc     = perform ( getAttrValue transferURI-		>>>-		isA (isPrefixOf stringProtocol)		-- do not change base URI when reading from a string-		>>>-		setBaseURI-	      )+                >>>+                isA (isPrefixOf stringProtocol)         -- do not change base URI when reading from a string+                >>>+                setBaseURI+              )  {- |    Read the content of a document.@@ -285,13 +285,13 @@  -} -getXmlContents		:: IOStateArrow s XmlTree XmlTree+getXmlContents          :: IOStateArrow s XmlTree XmlTree getXmlContents     = getXmlContents' parseXmlDocEncodingSpec       >>>       setBaseURIFromDoc -getXmlEntityContents		:: IOStateArrow s XmlTree XmlTree+getXmlEntityContents            :: IOStateArrow s XmlTree XmlTree getXmlEntityContents     = getXmlContents' parseXmlEntityEncodingSpec       >>>@@ -299,72 +299,72 @@       >>>       setBaseURIFromDoc -getXmlContents'		:: IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree+getXmlContents'         :: IOStateArrow s XmlTree XmlTree -> IOStateArrow s XmlTree XmlTree getXmlContents' parseEncodingSpec     = ( getURIContents-	>>>-	choiceA-	[ isXmlHtmlDoc	:-> ( parseEncodingSpec-			      >>>-			      filterErrorMsg-			      >>>-			      decodeDocument-			    )-	, isTextDoc	:->  decodeDocument-	, this		:-> this-	]-	>>>-	perform ( getAttrValue transferURI-		  >>>-		  traceValue 1 (("getXmlContents: content read and decoded for " ++) . show)-		)-	>>>-	traceTree-	>>>-	traceSource+        >>>+        choiceA+        [ isXmlHtmlDoc  :-> ( parseEncodingSpec+                              >>>+                              filterErrorMsg+                              >>>+                              decodeDocument+                            )+        , isTextDoc     :->  decodeDocument+        , this          :-> this+        ]+        >>>+        perform ( getAttrValue transferURI+                  >>>+                  traceValue 1 (("getXmlContents: content read and decoded for " ++) . show)+                )+        >>>+        traceTree+        >>>+        traceSource       )       `when`       isRoot -isMimeDoc		:: (String -> Bool) -> IOStateArrow s XmlTree XmlTree-isMimeDoc isMT		= fromLA $-			  ( ( getAttrValue transferMimeType >>^ stringToLower )-			    >>>-			    isA (\ t -> null t || isMT t)-			  )-			  `guards` this+isMimeDoc               :: (String -> Bool) -> IOStateArrow s XmlTree XmlTree+isMimeDoc isMT          = fromLA $+                          ( ( getAttrValue transferMimeType >>^ stringToLower )+                            >>>+                            isA (\ t -> null t || isMT t)+                          )+                          `guards` this -isTextDoc, isXmlHtmlDoc	:: IOStateArrow s XmlTree XmlTree+isTextDoc, isXmlHtmlDoc :: IOStateArrow s XmlTree XmlTree -isTextDoc		= isMimeDoc isTextMimeType+isTextDoc               = isMimeDoc isTextMimeType -isXmlHtmlDoc		= isMimeDoc (\ mt -> isHtmlMimeType mt || isXmlMimeType mt)+isXmlHtmlDoc            = isMimeDoc (\ mt -> isHtmlMimeType mt || isXmlMimeType mt)  -- ------------------------------------------------------------ -getEncoding	:: IOStateArrow s XmlTree String+getEncoding     :: IOStateArrow s XmlTree String getEncoding-    = catA [ xshow getChildren			-- 1. guess: guess encoding by looking at the first few bytes-	     >>>-	     arr guessEncoding-	   , getAttrValue transferEncoding	-- 2. guess: take the transfer encoding-	   , getAttrValue a_encoding		-- 3. guess: take encoding parameter in root node-	   , getParamString a_encoding		-- 4. guess: take encoding parameter in global state-	   , constA utf8			-- default : utf8-	   ]-      >. (head . filter (not . null))		-- make the filter deterministic: take 1. entry from list of guesses+    = catA [ xshow getChildren                  -- 1. guess: guess encoding by looking at the first few bytes+             >>>+             arr guessEncoding+           , getAttrValue transferEncoding      -- 2. guess: take the transfer encoding+           , getAttrValue a_encoding            -- 3. guess: take encoding parameter in root node+           , getParamString a_encoding          -- 4. guess: take encoding parameter in global state+           , constA utf8                        -- default : utf8+           ]+      >. (head . filter (not . null))           -- make the filter deterministic: take 1. entry from list of guesses -getTextEncoding	:: IOStateArrow s XmlTree String+getTextEncoding :: IOStateArrow s XmlTree String getTextEncoding-    = catA [ getAttrValue transferEncoding	-- 1. guess: take the transfer encoding-	   , getAttrValue a_encoding		-- 2. guess: take encoding parameter in root node-	   , getParamString a_encoding		-- 3. guess: take encoding parameter in global state-	   , constA isoLatin1			-- default : no encoding-	   ]-      >. (head . filter (not . null))		-- make the filter deterministic: take 1. entry from list of guesses+    = catA [ getAttrValue transferEncoding      -- 1. guess: take the transfer encoding+           , getAttrValue a_encoding            -- 2. guess: take encoding parameter in root node+           , getParamString a_encoding          -- 3. guess: take encoding parameter in global state+           , constA isoLatin1                   -- default : no encoding+           ]+      >. (head . filter (not . null))           -- make the filter deterministic: take 1. entry from list of guesses  -decodeDocument	:: IOStateArrow s XmlTree XmlTree+decodeDocument  :: IOStateArrow s XmlTree XmlTree decodeDocument     = choiceA       [ ( isRoot >>> isXmlHtmlDoc )   :-> ( decodeArr normalizeNL  $< getEncoding )@@ -372,43 +372,43 @@       , this                          :-> this       ]     where-    decodeArr	:: (String -> String) -> String -> IOStateArrow s XmlTree XmlTree+    decodeArr   :: (String -> String) -> String -> IOStateArrow s XmlTree XmlTree     decodeArr normalizeNewline enc-	= maybe notFound found . getDecodingFct $ enc-	where-	found df-	    = traceMsg 2 ("decodeDocument: encoding is " ++ show enc)-	      >>>-	      ( decodeText df $< getAttrValue a_ignore_encoding_errors )-	      >>>-	      addAttr transferEncoding enc+        = maybe notFound found . getDecodingFct $ enc+        where+        found df+            = traceMsg 2 ("decodeDocument: encoding is " ++ show enc)+              >>>+              ( decodeText df $< getAttrValue a_ignore_encoding_errors )+              >>>+              addAttr transferEncoding enc -	notFound-	    = issueFatal ("encoding scheme not supported: " ++ show enc)-	      >>>-	      setDocumentStatusFromSystemState "decoding document"+        notFound+            = issueFatal ("encoding scheme not supported: " ++ show enc)+              >>>+              setDocumentStatusFromSystemState "decoding document" -	decodeText df ignoreErrs-	    = processChildren-	      ( getText							-- get the document content-		>>> arr df						-- decode the text, result is (string, [errMsg])-		>>> ( ( (fst >>> normalizeNewline)			-- take decoded string, normalize newline and build text node-			^>> mkText-		      )-		      <+>-		      ( if isTrueValue ignoreErrs-			then none					-- encoding errors are ignored-			else-			( arrL snd					-- take the error messages-			  >>>-			  arr ((enc ++) . (" encoding error" ++))	-- prefix with enc error-			  >>>-			  applyA (arr issueErr)				-- build issueErr arrow and apply-			  >>>-			  none						-- neccessary for type match with <+>-			)-		      )-		    )-	      )-      +        decodeText df ignoreErrs+            = processChildren+              ( getText                                                 -- get the document content+                >>> arr df                                              -- decode the text, result is (string, [errMsg])+                >>> ( ( (fst >>> normalizeNewline)                      -- take decoded string, normalize newline and build text node+                        ^>> mkText+                      )+                      <+>+                      ( if isTrueValue ignoreErrs+                        then none                                       -- encoding errors are ignored+                        else+                        ( arrL snd                                      -- take the error messages+                          >>>+                          arr ((enc ++) . (" encoding error" ++))       -- prefix with enc error+                          >>>+                          applyA (arr issueErr)                         -- build issueErr arrow and apply+                          >>>+                          none                                          -- neccessary for type match with <+>+                        )+                      )+                    )+              )+ -- ------------------------------------------------------------

@@ -24,183 +24,183 @@     ) where -import Control.Arrow				-- arrow classes+import Control.Arrow                            -- arrow classes import Control.Arrow.ArrowList import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree import Control.Arrow.ArrowIO import Control.Arrow.ListArrow -import Text.XML.HXT.DOM.Unicode			( getOutputEncodingFct )+import Text.XML.HXT.DOM.Unicode                 ( getOutputEncodingFct ) import Text.XML.HXT.DOM.Interface  import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlIOStateArrow -import Text.XML.HXT.Arrow.Edit			( addHeadlineToXmlDoc-						, addXmlPi-						, addXmlPiEncoding-						, indentDoc-						, numberLinesInXmlDoc-						, treeRepOfXmlDoc-						)+import Text.XML.HXT.Arrow.Edit                  ( addHeadlineToXmlDoc+                                                , addXmlPi+                                                , addXmlPiEncoding+                                                , indentDoc+                                                , numberLinesInXmlDoc+                                                , treeRepOfXmlDoc+                                                ) -import System.IO				( Handle-						, IOMode(..)-						, openFile-						, openBinaryFile+import System.IO                                ( Handle+                                                , IOMode(..)+                                                , openFile+                                                , openBinaryFile                                                 , hSetBinaryMode-						, hPutStrLn-						, hClose-						, stdout-						)+                                                , hPutStrLn+                                                , hClose+                                                , stdout+                                                ) -import System.IO.Error				( try )+import System.IO.Error                          ( try )  -- ------------------------------------------------------------ -- -- output arrows -putXmlDocument	:: Bool -> String -> IOStateArrow s XmlTree XmlTree+putXmlDocument  :: Bool -> String -> IOStateArrow s XmlTree XmlTree putXmlDocument textMode dst     = perform ( xshow getChildren-		>>>-		arrIO (\ s -> try ( hPutDocument (\h -> hPutStrLn h s)))-		>>>-		( ( traceMsg 1 ("io error, document not written to " ++ outFile)-		    >>>-		    arr show >>> mkError c_fatal-		    >>>-		    filterErrorMsg-		  )-		  |||-		  ( traceMsg 2 ("document written to " ++ outFile)-		    >>>-		    none-		  )-		)-	      )+                >>>+                arrIO (\ s -> try ( hPutDocument (\h -> hPutStrLn h s)))+                >>>+                ( ( traceMsg 1 ("io error, document not written to " ++ outFile)+                    >>>+                    arr show >>> mkError c_fatal+                    >>>+                    filterErrorMsg+                  )+                  |||+                  ( traceMsg 2 ("document written to " ++ outFile)+                    >>>+                    none+                  )+                )+              )       where-      isStdout	= null dst || dst == "-"+      isStdout  = null dst || dst == "-" -      outFile	= if isStdout-		  then "stdout"-		       else show dst+      outFile   = if isStdout+                  then "stdout"+                       else show dst -      hPutDocument	:: (Handle -> IO ()) -> IO ()+      hPutDocument      :: (Handle -> IO ()) -> IO ()       hPutDocument action-	  | isStdout-	      = do+          | isStdout+              = do                 hSetBinaryMode stdout (not textMode)                 action stdout                 hSetBinaryMode stdout False-	  | otherwise-	      = do-		handle <- ( if textMode-			    then openFile-			    else openBinaryFile-			  ) dst WriteMode-		action handle-		hClose handle+          | otherwise+              = do+                handle <- ( if textMode+                            then openFile+                            else openBinaryFile+                          ) dst WriteMode+                action handle+                hClose handle  -- | -- write the tree representation of a document to a file -putXmlTree	:: String -> IOStateArrow s XmlTree XmlTree+putXmlTree      :: String -> IOStateArrow s XmlTree XmlTree putXmlTree dst     = perform ( treeRepOfXmlDoc-		>>>-		addHeadlineToXmlDoc-	        >>>-		putXmlDocument True dst-	      )+                >>>+                addHeadlineToXmlDoc+                >>>+                putXmlDocument True dst+              )  -- | -- write a document with indentaion and line numers -putXmlSource	:: String -> IOStateArrow s XmlTree XmlTree+putXmlSource    :: String -> IOStateArrow s XmlTree XmlTree putXmlSource dst     = perform ( (this ) `whenNot` isRoot-		>>>-		indentDoc-		>>>-		numberLinesInXmlDoc-		>>>-		addHeadlineToXmlDoc-	        >>>-		putXmlDocument True dst-	      )+                >>>+                indentDoc+                >>>+                numberLinesInXmlDoc+                >>>+                addHeadlineToXmlDoc+                >>>+                putXmlDocument True dst+              )  -- ------------------------------------------------------------ -getEncodingParam	:: IOStateArrow s XmlTree String+getEncodingParam        :: IOStateArrow s XmlTree String getEncodingParam-    = catA [ getParamString a_output_encoding	-- 4. guess: take output encoding parameter from global state-	   , getParamString a_encoding		-- 5. guess: take encoding parameter from global state-	   , constA utf8			-- default : utf8+    = catA [ getParamString a_output_encoding   -- 4. guess: take output encoding parameter from global state+           , getParamString a_encoding          -- 5. guess: take encoding parameter from global state+           , constA utf8                        -- default : utf8            ]       >. (head . filter (not . null)) -getOutputEncoding	:: String -> IOStateArrow s XmlTree String+getOutputEncoding       :: String -> IOStateArrow s XmlTree String getOutputEncoding defaultEnc     = getEC $< getEncodingParam     where     getEC enc' = fromLA $ getOutputEncoding' defaultEnc enc' -encodeDocument	:: Bool -> String -> IOStateArrow s XmlTree XmlTree+encodeDocument  :: Bool -> String -> IOStateArrow s XmlTree XmlTree encodeDocument supressXmlPi defaultEnc     = encode $< getOutputEncoding defaultEnc     where     encode enc         = traceMsg 2 ("encodeDocument: encoding is " ++ show enc)-	  >>>+          >>>           ( encodeDocument' supressXmlPi enc             `orElse`             ( issueFatal ("encoding scheme not supported: " ++ show enc)-	      >>>-	      setDocumentStatusFromSystemState "encoding document"+              >>>+              setDocumentStatusFromSystemState "encoding document"             )           )  -- ------------------------------------------------------------ -getOutputEncoding'	:: String -> String -> LA XmlTree String+getOutputEncoding'      :: String -> String -> LA XmlTree String getOutputEncoding' defaultEnc defaultEnc2-    =  catA [ getChildren			-- 1. guess: evaluate <?xml ... encoding="..."?>-	      >>>-	      ( ( isPi >>> hasName t_xml )-		`guards`-		getAttrValue a_encoding-	      )-	    , constA defaultEnc			-- 2. guess: explicit parameter, may be ""-	    , getAttrValue a_output_encoding	-- 3. guess: take output encoding parameter in root node-	    , constA defaultEnc2		-- default : UNICODE or utf8-	    ]-      >. (head . filter (not . null))		-- make the filter deterministic: take 1. entry from list of guesses+    =  catA [ getChildren                       -- 1. guess: evaluate <?xml ... encoding="..."?>+              >>>+              ( ( isPi >>> hasName t_xml )+                `guards`+                getAttrValue a_encoding+              )+            , constA defaultEnc                 -- 2. guess: explicit parameter, may be ""+            , getAttrValue a_output_encoding    -- 3. guess: take output encoding parameter in root node+            , constA defaultEnc2                -- default : UNICODE or utf8+            ]+      >. (head . filter (not . null))           -- make the filter deterministic: take 1. entry from list of guesses -encodeDocument'	:: ArrowXml a => Bool -> String -> a XmlTree XmlTree+encodeDocument' :: ArrowXml a => Bool -> String -> a XmlTree XmlTree encodeDocument' supressXmlPi defaultEnc     = fromLA (encode $< getOutputEncoding' defaultEnc utf8)     where-    encode	:: String -> LA XmlTree XmlTree+    encode      :: String -> LA XmlTree XmlTree     encode encodingScheme         = case getOutputEncodingFct encodingScheme of-          Nothing	-> none-          Just ef	-> ( if supressXmlPi-		             then processChildren (none `when` isXmlPi)-		             else ( addXmlPi-			            >>>-			            addXmlPiEncoding encodingScheme-			          )-		           )-		           >>>-		           replaceChildren ( xshow getChildren-				             >>>-				             arr ef-				             >>>-				             mkText-				           )-		           >>>-		           addAttr a_output_encoding encodingScheme+          Nothing       -> none+          Just ef       -> ( if supressXmlPi+                             then processChildren (none `when` isXmlPi)+                             else ( addXmlPi+                                    >>>+                                    addXmlPiEncoding encodingScheme+                                  )+                           )+                           >>>+                           replaceChildren ( xshow getChildren+                                             >>>+                                             arr ef+                                             >>>+                                             mkText+                                           )+                           >>>+                           addAttr a_output_encoding encodingScheme  -- ------------------------------------------------------------

@@ -34,7 +34,7 @@     , indentDoc     , numberLinesInXmlDoc     , preventEmptyElements- +     , removeComment     , removeAllComment     , removeWhiteSpace@@ -64,19 +64,19 @@ import           Control.Arrow.ArrowList import           Control.Arrow.ArrowIf import           Control.Arrow.ArrowTree-import 		 Control.Arrow.ListArrow+import           Control.Arrow.ListArrow  import           Text.XML.HXT.Arrow.XmlArrow import           Text.XML.HXT.DOM.Interface-import qualified Text.XML.HXT.DOM.XmlNode 	as XN-import           Text.XML.HXT.DOM.Unicode		( isXmlSpaceChar )-import           Text.XML.HXT.DOM.FormatXmlTree 	( formatXmlTree )+import qualified Text.XML.HXT.DOM.XmlNode       as XN+import           Text.XML.HXT.DOM.Unicode               ( isXmlSpaceChar )+import           Text.XML.HXT.DOM.FormatXmlTree         ( formatXmlTree ) import           Text.XML.HXT.Parser.HtmlParsec         ( emptyHtmlTags )-import           Text.XML.HXT.Parser.XmlEntities	( xmlEntities )-import           Text.XML.HXT.Parser.XhtmlEntities	( xhtmlEntities )+import           Text.XML.HXT.Parser.XmlEntities        ( xmlEntities )+import           Text.XML.HXT.Parser.XhtmlEntities      ( xhtmlEntities )  import           Data.List                              ( isPrefixOf )-import qualified Data.Map 			as M+import qualified Data.Map                       as M import           Data.Maybe  -- ------------------------------------------------------------@@ -100,30 +100,30 @@ -- -- see 'canonicalizeAllNodes' and 'canonicalizeForXPath' -canonicalizeTree'	:: LA XmlTree XmlTree -> LA XmlTree XmlTree+canonicalizeTree'       :: LA XmlTree XmlTree -> LA XmlTree XmlTree canonicalizeTree' toBeRemoved     = processChildren (none `when` isText)       >>>       processBottomUp canonicalize1Node       where-      canonicalize1Node	:: LA XmlTree XmlTree+      canonicalize1Node :: LA XmlTree XmlTree       canonicalize1Node-	  = (deep isPi `when` isDTD)		-- remove DTD parts, except PIs-	    >>>-	    (none `when` toBeRemoved)		-- remove unintersting nodes-	    >>>-	    ( processAttrl ( processChildren transfCharRef-			     >>>-			     collapseXText-			   )-	      `when` isElem-	    )-	    >>>-	    transfCdata				-- CDATA -> text-	    >>>-	    transfCharRef			-- Char refs -> text-	    >>>-	    collapseXText			-- combine text+          = (deep isPi `when` isDTD)            -- remove DTD parts, except PIs+            >>>+            (none `when` toBeRemoved)           -- remove unintersting nodes+            >>>+            ( processAttrl ( processChildren transfCharRef+                             >>>+                             collapseXText+                           )+              `when` isElem+            )+            >>>+            transfCdata                         -- CDATA -> text+            >>>+            transfCharRef                       -- Char refs -> text+            >>>+            collapseXText                       -- combine text   -- |@@ -145,13 +145,13 @@ -- --  - Special characters in attribute values and character content are replaced by character references -canonicalizeAllNodes	:: ArrowList a => a XmlTree XmlTree+canonicalizeAllNodes    :: ArrowList a => a XmlTree XmlTree canonicalizeAllNodes     = fromLA $-      canonicalizeTree' ( isCmt		-- remove comment-			  <+>-			  isXmlPi	-- remove xml declaration-			)+      canonicalizeTree' ( isCmt         -- remove comment+                          <+>+                          isXmlPi       -- remove xml declaration+                        )  -- | -- Canonicalize a tree for XPath@@ -159,7 +159,7 @@ -- -- see 'canonicalizeAllNodes' -canonicalizeForXPath	:: ArrowList a => a XmlTree XmlTree+canonicalizeForXPath    :: ArrowList a => a XmlTree XmlTree canonicalizeForXPath     = fromLA $       canonicalizeTree' isXmlPi@@ -173,49 +173,49 @@ -- -- see 'canonicalizeAllNodes' -canonicalizeContents	:: ArrowList a => a XmlTree XmlTree+canonicalizeContents    :: ArrowList a => a XmlTree XmlTree canonicalizeContents     = fromLA $       processBottomUp canonicalize1Node       where-      canonicalize1Node	:: LA XmlTree XmlTree+      canonicalize1Node :: LA XmlTree XmlTree       canonicalize1Node-	  = ( processAttrl ( processChildren transfCharRef-			     >>>-			     collapseXText-			   )-	      `when` isElem-	    )-	    >>>-	    transfCdata				-- CDATA -> text-	    >>>-	    transfCharRef			-- Char refs -> text-	    >>>-	    collapseXText			-- combine text+          = ( processAttrl ( processChildren transfCharRef+                             >>>+                             collapseXText+                           )+              `when` isElem+            )+            >>>+            transfCdata                         -- CDATA -> text+            >>>+            transfCharRef                       -- Char refs -> text+            >>>+            collapseXText                       -- combine text  -- ------------------------------------------------------------ -collapseXText'		:: LA XmlTree XmlTree+collapseXText'          :: LA XmlTree XmlTree collapseXText'     = replaceChildren ( listA getChildren >>> arrL (foldr mergeText' []) )     where-    mergeText'	:: XmlTree -> XmlTrees -> XmlTrees+    mergeText'  :: XmlTree -> XmlTrees -> XmlTrees     mergeText' t1 (t2 : ts2)-	| XN.isText t1 && XN.isText t2-	    = let-	      s1 = fromJust . XN.getText $ t1-	      s2 = fromJust . XN.getText $ t2-	      t  = XN.mkText (s1 ++ s2)-	      in-	      t : ts2+        | XN.isText t1 && XN.isText t2+            = let+              s1 = fromJust . XN.getText $ t1+              s2 = fromJust . XN.getText $ t2+              t  = XN.mkText (s1 ++ s2)+              in+              t : ts2     mergeText' t1 ts-	= t1 : ts+        = t1 : ts  -- | -- Collects sequences of text nodes in the list of children of a node into one single text node. -- This is useful, e.g. after char and entity reference substitution -collapseXText		:: ArrowList a => a XmlTree XmlTree+collapseXText           :: ArrowList a => a XmlTree XmlTree collapseXText     = fromLA $       collapseXText'@@ -226,7 +226,7 @@ -- -- see also : 'collapseXText' -collapseAllXText	:: ArrowList a => a XmlTree XmlTree+collapseAllXText        :: ArrowList a => a XmlTree XmlTree collapseAllXText     = fromLA $       processBottomUp collapseXText'@@ -243,8 +243,8 @@ -- -- > xshowEscape f >>> xread == f -xshowEscapeXml		:: ArrowXml a => a n XmlTree -> a n String-xshowEscapeXml f	= xshow (f >>> escapeXmlDoc)+xshowEscapeXml          :: ArrowXml a => a n XmlTree -> a n String+xshowEscapeXml f        = xshow (f >>> escapeXmlDoc)  -- ------------------------------------------------------------ @@ -252,50 +252,50 @@ -- escape XmlText, -- transform all special XML chars into char- or entity- refs -type EntityRefTable	= M.Map Int String+type EntityRefTable     = M.Map Int String  xmlEntityRefTable- , xhtmlEntityRefTable	:: EntityRefTable+ , xhtmlEntityRefTable  :: EntityRefTable  xmlEntityRefTable   = buildEntityRefTable $ xmlEntities xhtmlEntityRefTable = buildEntityRefTable $ xhtmlEntities -buildEntityRefTable	:: [(String, Int)] -> EntityRefTable-buildEntityRefTable	= M.fromList . map (\ (x,y) -> (y,x) )+buildEntityRefTable     :: [(String, Int)] -> EntityRefTable+buildEntityRefTable     = M.fromList . map (\ (x,y) -> (y,x) ) -escapeText''	:: (Char -> XmlTree) -> (Char -> Bool) -> XmlTree -> XmlTrees+escapeText''    :: (Char -> XmlTree) -> (Char -> Bool) -> XmlTree -> XmlTrees escapeText'' escChar isEsc t     = maybe [t] escape' . XN.getText $ t     where-    escape' "" = [t]		-- empty text nodes remain empty text nodes-    escape' s  = escape s	-- they do not disapear+    escape' "" = [t]            -- empty text nodes remain empty text nodes+    escape' s  = escape s       -- they do not disapear      escape ""-	= []+        = []     escape (c:s1)-	| isEsc c-	    = escChar c : escape s1+        | isEsc c+            = escChar c : escape s1     escape s-	= XN.mkText s1 : escape s2-	where-	(s1, s2) = break isEsc s+        = XN.mkText s1 : escape s2+        where+        (s1, s2) = break isEsc s  {--escapeCharRef	:: Char -> XmlTree-escapeCharRef	= XN.mkCharRef . fromEnum+escapeCharRef   :: Char -> XmlTree+escapeCharRef   = XN.mkCharRef . fromEnum -} -escapeEntityRef	:: EntityRefTable -> Char -> XmlTree+escapeEntityRef :: EntityRefTable -> Char -> XmlTree escapeEntityRef entityTable c     = maybe (XN.mkCharRef c') XN.mkEntityRef . M.lookup c' $ entityTable     where     c' = fromEnum c -escapeXmlEntityRef	:: Char -> XmlTree-escapeXmlEntityRef	= escapeEntityRef xmlEntityRefTable+escapeXmlEntityRef      :: Char -> XmlTree+escapeXmlEntityRef      = escapeEntityRef xmlEntityRefTable -escapeHtmlEntityRef	:: Char -> XmlTree-escapeHtmlEntityRef	= escapeEntityRef xhtmlEntityRefTable+escapeHtmlEntityRef     :: Char -> XmlTree+escapeHtmlEntityRef     = escapeEntityRef xhtmlEntityRefTable  -- ------------------------------------------------------------ @@ -306,12 +306,12 @@ -- in attribute values also \', \", \>, \\n, \\r and \\t are converted into entity or char references, -- in comments nothing is converted (see XML standard 2.4, useful e.g. for JavaScript). -escapeXmlDoc		:: ArrowList a => a XmlTree XmlTree+escapeXmlDoc            :: ArrowList a => a XmlTree XmlTree escapeXmlDoc     = fromLA $ escapeDoc escXmlText escXmlAttrValue     where     escXmlText-	= arrL $ escapeText'' escapeXmlEntityRef (`elem` "<&")		-- no escape for ", ' and > required: XML standard 2.4+        = arrL $ escapeText'' escapeXmlEntityRef (`elem` "<&")          -- no escape for ", ' and > required: XML standard 2.4     escXmlAttrValue         = arrL $ escapeText'' escapeXmlEntityRef (`elem` "<>\"\'&\n\r\t") @@ -325,62 +325,62 @@  -- ------------------------------------------------------------ -escapeHtmlDoc		:: ArrowList a => a XmlTree XmlTree+escapeHtmlDoc           :: ArrowList a => a XmlTree XmlTree escapeHtmlDoc     = fromLA $ escapeDoc escHtmlText escHtmlAttrValue     where     escHtmlText-	= arrL $ escapeText'' escapeHtmlEntityRef isHtmlTextEsc+        = arrL $ escapeText'' escapeHtmlEntityRef isHtmlTextEsc     escHtmlAttrValue         = arrL $ escapeText'' escapeHtmlEntityRef isHtmlAttrEsc      isHtmlTextEsc c-	= c >= toEnum(128) || ( c `elem` "<&" )+        = c >= toEnum(128) || ( c `elem` "<&" )     isHtmlAttrEsc c-	= c >= toEnum(128) || ( c `elem` "<>\"\'&\n\r\t" )+        = c >= toEnum(128) || ( c `elem` "<>\"\'&\n\r\t" )  -- ------------------------------------------------------------ -escapeDoc		:: LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree+escapeDoc               :: LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree escapeDoc escText escAttr     = escape     where     escape-	= choiceA-	  [ isElem  :-> ( processChildren escape-			  >>>-			  processAttrl escVal-			)-	  , isText  :-> escText-	  -- , isCmt   :-> escCmt-	  , isDTD   :-> processTopDown escDTD-	  , this    :-> this-	  ]+        = choiceA+          [ isElem  :-> ( processChildren escape+                          >>>+                          processAttrl escVal+                        )+          , isText  :-> escText+          -- , isCmt   :-> escCmt+          , isDTD   :-> processTopDown escDTD+          , this    :-> this+          ]     escVal   = processChildren escAttr     escDTD   = escVal `when` ( isDTDEntity <+> isDTDPEntity )  -- ------------------------------------------------------------ -preventEmptyElements	:: ArrowList a => [String] -> Bool -> a XmlTree XmlTree+preventEmptyElements    :: ArrowList a => [String] -> Bool -> a XmlTree XmlTree preventEmptyElements ns isHtml     = fromLA $ insertDummyElem     where     isNoneEmpty         | not (null ns) = hasNameWith (localPart >>> (`elem` ns))-	| isHtml	= hasNameWith (localPart >>> (`notElem` emptyHtmlTags))-	| otherwise	= this+        | isHtml        = hasNameWith (localPart >>> (`notElem` emptyHtmlTags))+        | otherwise     = this      insertDummyElem-	= processBottomUp-	  ( replaceChildren (txt "")-	    `when`-	    ( isElem-	      >>>-	      isNoneEmpty-	      >>>-	      neg getChildren-	    )-	  )+        = processBottomUp+          ( replaceChildren (txt "")+            `when`+            ( isElem+              >>>+              isNoneEmpty+              >>>+              neg getChildren+            )+          )  -- ------------------------------------------------------------ @@ -390,30 +390,30 @@ -- Useful for debugging and trace output. -- see also : 'treeRepOfXmlDoc', 'numberLinesInXmlDoc' -haskellRepOfXmlDoc	:: ArrowList a => a XmlTree XmlTree+haskellRepOfXmlDoc      :: ArrowList a => a XmlTree XmlTree haskellRepOfXmlDoc     = fromLA $       root [getAttrl] [show ^>> mkText]  -- | -- convert a document into a text and add line numbers to the text representation.--- +-- -- Result is a root node with a single text node as child. -- Useful for debugging and trace output. -- see also : 'haskellRepOfXmlDoc', 'treeRepOfXmlDoc' -numberLinesInXmlDoc	:: ArrowList a => a XmlTree XmlTree+numberLinesInXmlDoc     :: ArrowList a => a XmlTree XmlTree numberLinesInXmlDoc     = fromLA $       processChildren (changeText numberLines)     where-    numberLines	:: String -> String+    numberLines :: String -> String     numberLines str-	= concat $-	  zipWith (\ n l -> lineNr n ++ l ++ "\n") [1..] (lines str)-	where-	lineNr	 :: Int -> String-	lineNr n = (reverse (take 6 (reverse (show n) ++ replicate 6 ' '))) ++ "  "+        = concat $+          zipWith (\ n l -> lineNr n ++ l ++ "\n") [1..] (lines str)+        where+        lineNr   :: Int -> String+        lineNr n = (reverse (take 6 (reverse (show n) ++ replicate 6 ' '))) ++ "  "  -- | -- convert a document into a text representation in tree form.@@ -421,44 +421,44 @@ -- Useful for debugging and trace output. -- see also : 'haskellRepOfXmlDoc', 'numberLinesInXmlDoc' -treeRepOfXmlDoc	:: ArrowList a => a XmlTree XmlTree+treeRepOfXmlDoc :: ArrowList a => a XmlTree XmlTree treeRepOfXmlDoc     = fromLA $       root [getAttrl] [formatXmlTree ^>> mkText] -addHeadlineToXmlDoc	:: ArrowXml a => a XmlTree XmlTree+addHeadlineToXmlDoc     :: ArrowXml a => a XmlTree XmlTree addHeadlineToXmlDoc     = fromLA $ ( addTitle $< (getAttrValue a_source >>^ formatTitle) )     where     addTitle str-	= replaceChildren ( txt str <+> getChildren <+> txt "\n" )+        = replaceChildren ( txt str <+> getChildren <+> txt "\n" )     formatTitle str-	= "\n" ++ headline ++ "\n" ++ underline ++ "\n\n"-	where-	headline  = "content of: " ++ str+        = "\n" ++ headline ++ "\n" ++ underline ++ "\n\n"+        where+        headline  = "content of: " ++ str         underline = map (const '=') headline  -- ------------------------------------------------------------ -removeComment'		:: LA XmlTree XmlTree-removeComment'		= none `when` isCmt+removeComment'          :: LA XmlTree XmlTree+removeComment'          = none `when` isCmt  -- | -- remove Comments: @none `when` isCmt@ -removeComment		:: ArrowXml a => a XmlTree XmlTree-removeComment		= fromLA $ removeComment'+removeComment           :: ArrowXml a => a XmlTree XmlTree+removeComment           = fromLA $ removeComment'  -- | -- remove all comments recursively -removeAllComment	:: ArrowXml a => a XmlTree XmlTree-removeAllComment	= fromLA $ processBottomUp removeComment'+removeAllComment        :: ArrowXml a => a XmlTree XmlTree+removeAllComment        = fromLA $ processBottomUp removeComment'  -- ---------- -removeWhiteSpace'	:: LA XmlTree XmlTree-removeWhiteSpace'	= none `when` isWhiteSpace+removeWhiteSpace'       :: LA XmlTree XmlTree+removeWhiteSpace'       = none `when` isWhiteSpace  -- | -- simple filter for removing whitespace.@@ -468,8 +468,8 @@ -- -- see also : 'removeAllWhiteSpace', 'removeDocWhiteSpace' -removeWhiteSpace	:: ArrowXml a => a XmlTree XmlTree-removeWhiteSpace	= fromLA $ removeWhiteSpace'+removeWhiteSpace        :: ArrowXml a => a XmlTree XmlTree+removeWhiteSpace        = fromLA $ removeWhiteSpace'  -- | -- simple recursive filter for removing all whitespace.@@ -479,8 +479,8 @@ -- -- see also : 'removeWhiteSpace', 'removeDocWhiteSpace' -removeAllWhiteSpace	:: ArrowXml a => a XmlTree XmlTree-removeAllWhiteSpace	= fromLA $ processBottomUp removeWhiteSpace'+removeAllWhiteSpace     :: ArrowXml a => a XmlTree XmlTree+removeAllWhiteSpace     = fromLA $ processBottomUp removeWhiteSpace'  -- | -- filter for removing all not significant whitespace.@@ -499,28 +499,28 @@ -- -- see also : 'indentDoc', 'removeAllWhiteSpace' -removeDocWhiteSpace	:: ArrowXml a => a XmlTree XmlTree-removeDocWhiteSpace	= fromLA $ removeRootWhiteSpace+removeDocWhiteSpace     :: ArrowXml a => a XmlTree XmlTree+removeDocWhiteSpace     = fromLA $ removeRootWhiteSpace  -removeRootWhiteSpace	:: LA XmlTree XmlTree+removeRootWhiteSpace    :: LA XmlTree XmlTree removeRootWhiteSpace     =  processChildren processRootElement        `when`        isRoot     where-    processRootElement	:: LA XmlTree XmlTree+    processRootElement  :: LA XmlTree XmlTree     processRootElement-	= removeWhiteSpace >>> processChild-	where-	processChild-	    = choiceA [ isDTD-			:-> removeAllWhiteSpace			-- whitespace in DTD is redundant-		      , this-			:-> replaceChildren ( getChildren-					      >>. indentTrees insertNothing False 1-					    )-		      ]+        = removeWhiteSpace >>> processChild+        where+        processChild+            = choiceA [ isDTD+                        :-> removeAllWhiteSpace                 -- whitespace in DTD is redundant+                      , this+                        :-> replaceChildren ( getChildren+                                              >>. indentTrees insertNothing False 1+                                            )+                      ]  -- ------------------------------------------------------------ @@ -544,37 +544,37 @@ -- -- see also : 'removeDocWhiteSpace' -indentDoc		:: ArrowXml a => a XmlTree XmlTree-indentDoc		= fromLA $-			  ( ( isRoot `guards` indentRoot )-			    `orElse`-			    (root [] [this] >>> indentRoot >>> getChildren)-			  )+indentDoc               :: ArrowXml a => a XmlTree XmlTree+indentDoc               = fromLA $+                          ( ( isRoot `guards` indentRoot )+                            `orElse`+                            (root [] [this] >>> indentRoot >>> getChildren)+                          )  -- ------------------------------------------------------------ -indentRoot		:: LA XmlTree XmlTree-indentRoot		= processChildren indentRootChildren+indentRoot              :: LA XmlTree XmlTree+indentRoot              = processChildren indentRootChildren     where     indentRootChildren-	= removeText >>> indentChild >>> insertNL-	where-	removeText	= none `when` isText-	insertNL	= this <+> txt "\n"-	indentChild	= ( replaceChildren-			    ( getChildren-			      >>.-			      indentTrees (insertIndentation 2) False 1-			    )-			    `whenNot` isDTD-			  )+        = removeText >>> indentChild >>> insertNL+        where+        removeText      = none `when` isText+        insertNL        = this <+> txt "\n"+        indentChild     = ( replaceChildren+                            ( getChildren+                              >>.+                              indentTrees (insertIndentation 2) False 1+                            )+                            `whenNot` isDTD+                          )  -- ------------------------------------------------------------ -- -- copied from EditFilter and rewritten for arrows -- to remove dependency to the filter module -indentTrees	:: (Int -> LA XmlTree XmlTree) -> Bool -> Int -> XmlTrees -> XmlTrees+indentTrees     :: (Int -> LA XmlTree XmlTree) -> Bool -> Int -> XmlTrees -> XmlTrees indentTrees _ _ _ []     = [] indentTrees indentFilter preserveSpace level ts@@ -583,136 +583,136 @@       indentRest rs       where       runLAs f l-	  = runLA (constL l >>> f) undefined+          = runLA (constL l >>> f) undefined        (ls, rs)-	  = break XN.isElem ts+          = break XN.isElem ts -      isSignificant	:: Bool+      isSignificant     :: Bool       isSignificant-	  = preserveSpace-	    ||-	    (not . null . runLAs isSignificantPart) ls+          = preserveSpace+            ||+            (not . null . runLAs isSignificantPart) ls -      isSignificantPart	:: LA XmlTree XmlTree+      isSignificantPart :: LA XmlTree XmlTree       isSignificantPart-	  = catA-	    [ isText `guards` neg isWhiteSpace-	    , isCdata-	    , isCharRef-	    , isEntityRef-	    ]+          = catA+            [ isText `guards` neg isWhiteSpace+            , isCdata+            , isCharRef+            , isEntityRef+            ] -      lsf	:: LA XmlTree XmlTree+      lsf       :: LA XmlTree XmlTree       lsf-	  | isSignificant-	      = this-	  | otherwise-	      = (none `when` isWhiteSpace)+          | isSignificant+              = this+          | otherwise+              = (none `when` isWhiteSpace)                 >>>                 (indentFilter level <+> this) -      indentRest	:: XmlTrees -> XmlTrees+      indentRest        :: XmlTrees -> XmlTrees       indentRest []-	  | isSignificant-	      = []-	  | otherwise-	      = runLA (indentFilter (level - 1)) undefined+          | isSignificant+              = []+          | otherwise+              = runLA (indentFilter (level - 1)) undefined        indentRest (t':ts')-	  = runLA ( ( indentElem-		      >>>-		      lsf-		    )-		    `when` isElem-		  ) t'+          = runLA ( ( indentElem+                      >>>+                      lsf+                    )+                    `when` isElem+                  ) t'             ++-	    ( if null ts'-	      then indentRest-	      else indentTrees indentFilter preserveSpace level-	    ) ts'-	  where-	  indentElem-	      = replaceChildren	( getChildren-				  >>.-				  indentChildren-				)+            ( if null ts'+              then indentRest+              else indentTrees indentFilter preserveSpace level+            ) ts'+          where+          indentElem+              = replaceChildren ( getChildren+                                  >>.+                                  indentChildren+                                ) -	  xmlSpaceAttrValue	:: String-	  xmlSpaceAttrValue-	      = concat . runLA (getAttrValue "xml:space") $ t'+          xmlSpaceAttrValue     :: String+          xmlSpaceAttrValue+              = concat . runLA (getAttrValue "xml:space") $ t' -	  preserveSpace'	:: Bool-	  preserveSpace'-	      = ( fromMaybe preserveSpace-		  .-		  lookup xmlSpaceAttrValue-	        ) [ ("preserve", True)-		  , ("default",  False)-		  ]+          preserveSpace'        :: Bool+          preserveSpace'+              = ( fromMaybe preserveSpace+                  .+                  lookup xmlSpaceAttrValue+                ) [ ("preserve", True)+                  , ("default",  False)+                  ] -	  indentChildren	:: XmlTrees -> XmlTrees-	  indentChildren cs'-	      | all (maybe False (all isXmlSpaceChar) . XN.getText) cs'-		  = []-	      | otherwise-		  = indentTrees indentFilter preserveSpace' (level + 1) cs'+          indentChildren        :: XmlTrees -> XmlTrees+          indentChildren cs'+              | all (maybe False (all isXmlSpaceChar) . XN.getText) cs'+                  = []+              | otherwise+                  = indentTrees indentFilter preserveSpace' (level + 1) cs' -	+ -- filter for indenting elements -insertIndentation	:: Int -> Int -> LA a XmlTree+insertIndentation       :: Int -> Int -> LA a XmlTree insertIndentation indentWidth level     = txt ('\n' : replicate (level * indentWidth) ' ')  -- filter for removing all whitespace -insertNothing		:: Int -> LA a XmlTree-insertNothing _		= none+insertNothing           :: Int -> LA a XmlTree+insertNothing _         = none  -- ------------------------------------------------------------ -transfCdata'		:: LA XmlTree XmlTree-transfCdata'		= (getCdata >>> mkText) `when` isCdata+transfCdata'            :: LA XmlTree XmlTree+transfCdata'            = (getCdata >>> mkText) `when` isCdata  -- | -- converts a CDATA section node into a normal text node -transfCdata		:: ArrowXml a => a XmlTree XmlTree-transfCdata		= fromLA $-			  transfCdata'+transfCdata             :: ArrowXml a => a XmlTree XmlTree+transfCdata             = fromLA $+                          transfCdata'  -- | -- converts CDATA sections in whole document tree into normal text nodes -transfAllCdata		:: ArrowXml a => a XmlTree XmlTree-transfAllCdata		= fromLA $-			  processBottomUp transfCdata'-			  +transfAllCdata          :: ArrowXml a => a XmlTree XmlTree+transfAllCdata          = fromLA $+                          processBottomUp transfCdata'+ -- -transfCharRef'		:: LA XmlTree XmlTree-transfCharRef'		= ( getCharRef >>> arr (\ i -> [toEnum i]) >>> mkText )-		          `when`-			  isCharRef+transfCharRef'          :: LA XmlTree XmlTree+transfCharRef'          = ( getCharRef >>> arr (\ i -> [toEnum i]) >>> mkText )+                          `when`+                          isCharRef  -- | -- converts character references to normal text -transfCharRef		:: ArrowXml a => a XmlTree XmlTree-transfCharRef		= fromLA $-			  transfCharRef'+transfCharRef           :: ArrowXml a => a XmlTree XmlTree+transfCharRef           = fromLA $+                          transfCharRef'  -- | -- recursively converts all character references to normal text -transfAllCharRef	:: ArrowXml a => a XmlTree XmlTree-transfAllCharRef	= fromLA $-			  processBottomUp transfCharRef'+transfAllCharRef        :: ArrowXml a => a XmlTree XmlTree+transfAllCharRef        = fromLA $+                          processBottomUp transfCharRef'  -- ------------------------------------------------------------ -rememberDTDAttrl	:: ArrowList a => a XmlTree XmlTree+rememberDTDAttrl        :: ArrowList a => a XmlTree XmlTree rememberDTDAttrl     = fromLA $       ( ( addDTDAttrl $< ( getChildren >>> isDTDDoctype >>> getDTDAttrl ) )@@ -723,7 +723,7 @@     addDTDAttrl al         = seqA . map (uncurry addAttr) . map (first (dtdPrefix ++)) $ al -addDefaultDTDecl	:: ArrowList a => a XmlTree XmlTree+addDefaultDTDecl        :: ArrowList a => a XmlTree XmlTree addDefaultDTDecl     = fromLA $       ( addDTD $< listA (getAttrl >>> (getName &&& xshow getChildren) >>> hasDtdPrefix) )@@ -740,53 +740,53 @@             <+>             txt "\n"             <+>-            ( getChildren >>> (none `when` isDTDDoctype) )	-- remove old DTD stuff+            ( getChildren >>> (none `when` isDTDDoctype) )      -- remove old DTD stuff           )  -- ------------------------------------------------------------ -hasXmlPi		:: ArrowXml a => a XmlTree XmlTree+hasXmlPi                :: ArrowXml a => a XmlTree XmlTree hasXmlPi     = fromLA       ( getChildren-	>>>-	isPi-	>>>-	hasName t_xml+        >>>+        isPi+        >>>+        hasName t_xml       )  -- | add an \<?xml version=\"1.0\"?\> processing instruction -- if it's not already there -addXmlPi		:: ArrowXml a => a XmlTree XmlTree+addXmlPi                :: ArrowXml a => a XmlTree XmlTree addXmlPi     = fromLA       ( insertChildrenAt 0 ( ( mkPi (mkSNsName t_xml) none-			       >>>-			       addAttr a_version "1.0"-			     )-			     <+>-			     txt "\n"-			   )-	`whenNot`-	hasXmlPi+                               >>>+                               addAttr a_version "1.0"+                             )+                             <+>+                             txt "\n"+                           )+        `whenNot`+        hasXmlPi       )  -- | add an encoding spec to the \<?xml version=\"1.0\"?\> processing instruction -addXmlPiEncoding	:: ArrowXml a => String -> a XmlTree XmlTree+addXmlPiEncoding        :: ArrowXml a => String -> a XmlTree XmlTree addXmlPiEncoding enc     = fromLA $       processChildren ( addAttr a_encoding enc-		        `when`-			( isPi >>> hasName t_xml )-		      )+                        `when`+                        ( isPi >>> hasName t_xml )+                      )  -- | add an XHTML strict doctype declaration to a document  addXHtmlDoctypeStrict   , addXHtmlDoctypeTransitional-  , addXHtmlDoctypeFrameset	:: ArrowXml a => a XmlTree XmlTree+  , addXHtmlDoctypeFrameset     :: ArrowXml a => a XmlTree XmlTree  -- | add an XHTML strict doctype declaration to a document @@ -807,19 +807,19 @@ -- -- The arguments are the root element name, the PUBLIC id and the SYSTEM id -addDoctypeDecl	:: ArrowXml a => String -> String -> String -> a XmlTree XmlTree+addDoctypeDecl  :: ArrowXml a => String -> String -> String -> a XmlTree XmlTree addDoctypeDecl rootElem public system     = fromLA $       replaceChildren       ( mkDTDDoctype ( ( if null public then id else ( (k_public, public) : ) )-		       .-		       ( if null system then id else ( (k_system, system) : ) )-		       $  [ (a_name, rootElem) ]-		     ) none-	<+>-	txt "\n"-	<+>-	getChildren+                       .+                       ( if null system then id else ( (k_system, system) : ) )+                       $  [ (a_name, rootElem) ]+                     ) none+        <+>+        txt "\n"+        <+>+        getChildren       )  -- ------------------------------------------------------------

@@ -20,7 +20,7 @@     ( processGeneralEntities ) where -import Control.Arrow				-- arrow classes+import Control.Arrow                            -- arrow classes import Control.Arrow.ArrowList import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree@@ -55,27 +55,27 @@     = ReferenceInContent     | ReferenceInAttributeValue     | ReferenceInEntityValue-    -- or OccursInAttributeValue				-- not used during substitution but during validation-    -- or ReferenceInDTD					-- not used: syntax check detects errors+    -- or OccursInAttributeValue                                -- not used during substitution but during validation+    -- or ReferenceInDTD                                        -- not used: syntax check detects errors -type GESubstArrow	= GEContext -> RecList -> GEArrow XmlTree XmlTree+type GESubstArrow       = GEContext -> RecList -> GEArrow XmlTree XmlTree -type GEArrow b c	= IOStateArrow GEEnv b c+type GEArrow b c        = IOStateArrow GEEnv b c -type RecList		= [String]+type RecList            = [String]  -- ------------------------------------------------------------ -newtype GEEnv	= GEEnv (M.Map String GESubstArrow)+newtype GEEnv   = GEEnv (M.Map String GESubstArrow) -emptyGeEnv	:: GEEnv-emptyGeEnv	= GEEnv M.empty+emptyGeEnv      :: GEEnv+emptyGeEnv      = GEEnv M.empty -lookupGeEnv		:: String -> GEEnv -> Maybe GESubstArrow+lookupGeEnv             :: String -> GEEnv -> Maybe GESubstArrow lookupGeEnv k (GEEnv env)     = M.lookup k env -addGeEntry	:: String -> GESubstArrow -> GEEnv -> GEEnv+addGeEntry      :: String -> GESubstArrow -> GEEnv -> GEEnv addGeEntry k a (GEEnv env)     = GEEnv $ M.insert k a env @@ -86,258 +86,258 @@ -- -- input: a complete document tree including root node -processGeneralEntities	:: IOStateArrow s XmlTree XmlTree+processGeneralEntities  :: IOStateArrow s XmlTree XmlTree processGeneralEntities     = ( traceMsg 1 "processGeneralEntities: collect and substitute general entities"-	>>>-	withOtherUserState emptyGeEnv (processChildren (processGeneralEntity ReferenceInContent []))-	>>>-	setDocumentStatusFromSystemState "in general entity processing"-	>>>-	traceTree-	>>>-	traceSource+        >>>+        withOtherUserState emptyGeEnv (processChildren (processGeneralEntity ReferenceInContent []))+        >>>+        setDocumentStatusFromSystemState "in general entity processing"+        >>>+        traceTree+        >>>+        traceSource       )       `when`       documentStatusOk -      -processGeneralEntity	:: GESubstArrow++processGeneralEntity    :: GESubstArrow processGeneralEntity context recl-    = choiceA [ isElem		:-> ( processAttrl (processChildren substEntitiesInAttrValue)-		                      >>>-		                      processChildren (processGeneralEntity context recl)-				    )-	      , isDTDDoctype	:-> processChildren (processGeneralEntity context recl)-	      , isDTDEntity	:-> addEntityDecl-	      , isDTDAttlist	:-> substEntitiesInAttrDefaultValue-	      , isEntityRef	:-> substEntityRef-	      , this 		:-> this-	      ]+    = choiceA [ isElem          :-> ( processAttrl (processChildren substEntitiesInAttrValue)+                                      >>>+                                      processChildren (processGeneralEntity context recl)+                                    )+              , isDTDDoctype    :-> processChildren (processGeneralEntity context recl)+              , isDTDEntity     :-> addEntityDecl+              , isDTDAttlist    :-> substEntitiesInAttrDefaultValue+              , isEntityRef     :-> substEntityRef+              , this            :-> this+              ]     where-    addEntityDecl	:: GEArrow XmlTree XmlTree+    addEntityDecl       :: GEArrow XmlTree XmlTree     addEntityDecl-	= perform ( choiceA [ isIntern		:-> addInternalEntity		-- don't change sequence of cases-			    , isExtern		:-> addExternalEntity-			    , isUnparsed	:-> addUnparsedEntity-			    ]-		  )-	where-	isIntern	= none `when` hasDTDAttr k_system-	isExtern	= none `when` hasDTDAttr k_ndata-	isUnparsed	= this+        = perform ( choiceA [ isIntern          :-> addInternalEntity           -- don't change sequence of cases+                            , isExtern          :-> addExternalEntity+                            , isUnparsed        :-> addUnparsedEntity+                            ]+                  )+        where+        isIntern        = none `when` hasDTDAttr k_system+        isExtern        = none `when` hasDTDAttr k_ndata+        isUnparsed      = this -    addInternalEntity	:: GEArrow XmlTree b+    addInternalEntity   :: GEArrow XmlTree b     addInternalEntity-	= ( ( getDTDAttrValue a_name-	      >>>-	      traceValue 2 (("processGeneralEntity: general entity definition for " ++) . show)-	    )-	    &&&-	    xshow (getChildren >>> isText)-	  )+        = ( ( getDTDAttrValue a_name+              >>>+              traceValue 2 (("processGeneralEntity: general entity definition for " ++) . show)+            )+            &&&+            xshow (getChildren >>> isText)+          )           >>>-	  applyA ( arr2 $ \ entity str ->-		   listA ( ( ( txt str-			       >>>-			       parseXmlGeneralEntityValue ("general internal entity" ++ show entity)-			       >>>-			       filterErrorMsg-			     )-			     `orElse` txt ""-			   )-			   >>>-			   processGeneralEntity ReferenceInEntityValue (entity : recl)-			 )-		   >>>-		   applyA (arr $ \ ts -> insertEntity (substInternal ts) entity)-		 )-	  >>>-	  none+          applyA ( arr2 $ \ entity str ->+                   listA ( ( ( txt str+                               >>>+                               parseXmlGeneralEntityValue ("general internal entity" ++ show entity)+                               >>>+                               filterErrorMsg+                             )+                             `orElse` txt ""+                           )+                           >>>+                           processGeneralEntity ReferenceInEntityValue (entity : recl)+                         )+                   >>>+                   applyA (arr $ \ ts -> insertEntity (substInternal ts) entity)+                 )+          >>>+          none -    addExternalEntity	:: GEArrow XmlTree b+    addExternalEntity   :: GEArrow XmlTree b     addExternalEntity-	= ( ( getDTDAttrValue a_name-	      >>>-	      traceValue 2 (("processGeneralEntity: external entity definition for " ++) . show)+        = ( ( getDTDAttrValue a_name+              >>>+              traceValue 2 (("processGeneralEntity: external entity definition for " ++) . show)             )-	    &&&-	    getDTDAttrValue a_url 			-- the absolute URL, not the relative in attr: k_system-	  )-	  >>>-	  applyA (arr2 $ \ entity uri -> insertEntity (substExternalParsed1Time uri) entity)-	  >>>-	  none+            &&&+            getDTDAttrValue a_url                       -- the absolute URL, not the relative in attr: k_system+          )+          >>>+          applyA (arr2 $ \ entity uri -> insertEntity (substExternalParsed1Time uri) entity)+          >>>+          none -    addUnparsedEntity	:: GEArrow XmlTree b+    addUnparsedEntity   :: GEArrow XmlTree b     addUnparsedEntity-	= getDTDAttrValue a_name-	  >>>-	  traceValue 2 (("processGeneralEntity: unparsed entity definition for " ++) . show)+        = getDTDAttrValue a_name           >>>-	  applyA (arr (insertEntity substUnparsed))-	  >>>-	  none+          traceValue 2 (("processGeneralEntity: unparsed entity definition for " ++) . show)+          >>>+          applyA (arr (insertEntity substUnparsed))+          >>>+          none -    insertEntity	:: (String -> GESubstArrow) -> String -> GEArrow b b+    insertEntity        :: (String -> GESubstArrow) -> String -> GEArrow b b     insertEntity fct entity-	= ( getUserState-	    >>>-	    applyA (arr checkDefined)-	  )-	  `guards`-	  addEntity fct entity-	where-	checkDefined geEnv-	    = maybe ok alreadyDefined . lookupGeEnv entity $ geEnv-	    where-	    ok	= this-	    alreadyDefined _-		= issueWarn ("entity " ++ show entity ++ " already defined, repeated definition ignored")+        = ( getUserState+            >>>+            applyA (arr checkDefined)+          )+          `guards`+          addEntity fct entity+        where+        checkDefined geEnv+            = maybe ok alreadyDefined . lookupGeEnv entity $ geEnv+            where+            ok  = this+            alreadyDefined _+                = issueWarn ("entity " ++ show entity ++ " already defined, repeated definition ignored") -    addEntity	:: (String -> GESubstArrow) -> String -> GEArrow b b+    addEntity   :: (String -> GESubstArrow) -> String -> GEArrow b b     addEntity fct entity-	= changeUserState ins-	where-	ins _ geEnv = addGeEntry entity (fct entity) geEnv+        = changeUserState ins+        where+        ins _ geEnv = addGeEntry entity (fct entity) geEnv -    substEntitiesInAttrDefaultValue	:: GEArrow XmlTree XmlTree+    substEntitiesInAttrDefaultValue     :: GEArrow XmlTree XmlTree     substEntitiesInAttrDefaultValue-	= applyA ( xshow ( getDTDAttrValue a_default			-- parse the default value-			   >>>						-- substitute entities-			   mkText					-- and convert value into a string-			   >>>-			   parseXmlAttrValue "default value of attribute"-			   >>>-			   filterErrorMsg-			   >>>-			   substEntitiesInAttrValue-			 )-		   >>> arr (setDTDAttrValue a_default)-		 )+        = applyA ( xshow ( getDTDAttrValue a_default                    -- parse the default value+                           >>>                                          -- substitute entities+                           mkText                                       -- and convert value into a string+                           >>>+                           parseXmlAttrValue "default value of attribute"+                           >>>+                           filterErrorMsg+                           >>>+                           substEntitiesInAttrValue+                         )+                   >>> arr (setDTDAttrValue a_default)+                 )           `when` hasDTDAttr a_default -    substEntitiesInAttrValue	:: GEArrow XmlTree XmlTree+    substEntitiesInAttrValue    :: GEArrow XmlTree XmlTree     substEntitiesInAttrValue-	= ( processGeneralEntity ReferenceInAttributeValue recl-	    `when`-	    isEntityRef-	  )+        = ( processGeneralEntity ReferenceInAttributeValue recl+            `when`+            isEntityRef+          )           >>>-	  changeText normalizeWhiteSpace-	  >>>-	  transfCharRef-	where-	normalizeWhiteSpace = map ( \c -> if c `elem` "\n\t\r" then ' ' else c )+          changeText normalizeWhiteSpace+          >>>+          transfCharRef+        where+        normalizeWhiteSpace = map ( \c -> if c `elem` "\n\t\r" then ' ' else c )  -    substEntityRef	:: GEArrow XmlTree XmlTree+    substEntityRef      :: GEArrow XmlTree XmlTree     substEntityRef-	= applyA ( ( ( getEntityRef				-- get the entity name and the env-		       >>>					-- and compute the arrow to be applied-		       traceValue 2 (("processGeneralEntity: entity reference for entity " ++) . show)-		       >>>-		       traceMsg 3 ("recursion list = " ++ show recl)-		     )-		     &&&-		     getUserState-		   ) >>>-		   arr2 substA-		 )-	  `orElse` this-	  where-	  substA	:: String -> GEEnv -> GEArrow XmlTree XmlTree-	  substA entity geEnv-	      = maybe entityNotFound entityFound . lookupGeEnv entity $ geEnv-	      where-	      errMsg msg-		  = issueErr msg+        = applyA ( ( ( getEntityRef                             -- get the entity name and the env+                       >>>                                      -- and compute the arrow to be applied+                       traceValue 2 (("processGeneralEntity: entity reference for entity " ++) . show)+                       >>>+                       traceMsg 3 ("recursion list = " ++ show recl)+                     )+                     &&&+                     getUserState+                   ) >>>+                   arr2 substA+                 )+          `orElse` this+          where+          substA        :: String -> GEEnv -> GEArrow XmlTree XmlTree+          substA entity geEnv+              = maybe entityNotFound entityFound . lookupGeEnv entity $ geEnv+              where+              errMsg msg+                  = issueErr msg -	      entityNotFound-		  = errMsg ("general entity reference \"&" ++ entity ++ ";\" not processed, no definition found, (forward reference?)")+              entityNotFound+                  = errMsg ("general entity reference \"&" ++ entity ++ ";\" not processed, no definition found, (forward reference?)") -	      entityFound fct-		  | entity `elem` recl-		      = errMsg ("general entity reference \"&" ++ entity ++ ";\" not processed, cyclic definition")-		  | otherwise-		      = fct context recl+              entityFound fct+                  | entity `elem` recl+                      = errMsg ("general entity reference \"&" ++ entity ++ ";\" not processed, cyclic definition")+                  | otherwise+                      = fct context recl -    substExternalParsed1Time				:: String -> String -> GESubstArrow+    substExternalParsed1Time                            :: String -> String -> GESubstArrow     substExternalParsed1Time uri entity cx rl- 	= perform ( traceMsg 2 ("substExternalParsed1Time: read and parse external parsed entity " ++ show entity)-		    >>>-		    runInLocalURIContext ( root [sattr a_source uri] []		-- uri must be an absolute uri-					   >>>					-- abs uri is computed during parameter entity handling-					   listA ( getXmlEntityContents-						   >>>-						   processExternalEntityContents-						 )-					 )-		    >>>-		    applyA ( arr $ \ ts -> addEntity (substExternalParsed ts) entity )-		  )-	  >>>-	  processGeneralEntity cx rl-	where-	processExternalEntityContents	:: IOStateArrow s XmlTree XmlTree-	processExternalEntityContents-	    = ( ( documentStatusOk				-- reading entity succeeded-		  >>>						-- with content stored in a text node-		  (getChildren >>> isText)-		)-		`guards`-		( getChildren-		  >>>-		  parseXmlGeneralEntityValue ("external parsed entity " ++ show entity)-		  >>>-		  filterErrorMsg-		)-	      )-	      `orElse`-	      issueErr ("illegal value for external parsed entity " ++ show entity)+        = perform ( traceMsg 2 ("substExternalParsed1Time: read and parse external parsed entity " ++ show entity)+                    >>>+                    runInLocalURIContext ( root [sattr a_source uri] []         -- uri must be an absolute uri+                                           >>>                                  -- abs uri is computed during parameter entity handling+                                           listA ( getXmlEntityContents+                                                   >>>+                                                   processExternalEntityContents+                                                 )+                                         )+                    >>>+                    applyA ( arr $ \ ts -> addEntity (substExternalParsed ts) entity )+                  )+          >>>+          processGeneralEntity cx rl+        where+        processExternalEntityContents   :: IOStateArrow s XmlTree XmlTree+        processExternalEntityContents+            = ( ( documentStatusOk                              -- reading entity succeeded+                  >>>                                           -- with content stored in a text node+                  (getChildren >>> isText)+                )+                `guards`+                ( getChildren+                  >>>+                  parseXmlGeneralEntityValue ("external parsed entity " ++ show entity)+                  >>>+                  filterErrorMsg+                )+              )+              `orElse`+              issueErr ("illegal value for external parsed entity " ++ show entity) -    substExternalParsed					:: XmlTrees -> String -> GESubstArrow-    substExternalParsed	ts entity ReferenceInContent rl	= includedIfValidating ts rl entity-    substExternalParsed	_  entity ReferenceInAttributeValue _+    substExternalParsed                                 :: XmlTrees -> String -> GESubstArrow+    substExternalParsed ts entity ReferenceInContent rl = includedIfValidating ts rl entity+    substExternalParsed _  entity ReferenceInAttributeValue _                                                         = forbidden entity "external parsed general" "in attribute value"-    substExternalParsed	_  _      ReferenceInEntityValue _+    substExternalParsed _  _      ReferenceInEntityValue _                                                         = bypassed -    substInternal					:: XmlTrees -> String -> GESubstArrow-    substInternal ts entity ReferenceInContent rl	= included          ts rl entity+    substInternal                                       :: XmlTrees -> String -> GESubstArrow+    substInternal ts entity ReferenceInContent rl       = included          ts rl entity     substInternal ts entity ReferenceInAttributeValue rl= includedInLiteral ts rl entity-    substInternal _  _      ReferenceInEntityValue _	= bypassed+    substInternal _  _      ReferenceInEntityValue _    = bypassed -    substUnparsed					:: String -> GESubstArrow-    substUnparsed entity ReferenceInContent        _	= forbidden entity "unparsed" "content"-    substUnparsed entity ReferenceInAttributeValue _	= forbidden entity "unparsed" "attribute value"-    substUnparsed entity ReferenceInEntityValue    _	= forbidden entity "unparsed" "entity value"+    substUnparsed                                       :: String -> GESubstArrow+    substUnparsed entity ReferenceInContent        _    = forbidden entity "unparsed" "content"+    substUnparsed entity ReferenceInAttributeValue _    = forbidden entity "unparsed" "attribute value"+    substUnparsed entity ReferenceInEntityValue    _    = forbidden entity "unparsed" "entity value" -									-- XML 1.0 chapter 4.4.2-    included		:: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree+                                                                        -- XML 1.0 chapter 4.4.2+    included            :: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree     included ts rl entity-	= arrL (const ts)-	  >>>-	  processGeneralEntity context (entity : rl)+        = arrL (const ts)+          >>>+          processGeneralEntity context (entity : rl) -									-- XML 1.0 chapter 4.4.3-    includedIfValidating		:: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree+                                                                        -- XML 1.0 chapter 4.4.3+    includedIfValidating                :: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree     includedIfValidating-	= included+        = included -									-- XML 1.0 chapter 4.4.4-    forbidden		:: String -> String -> String -> GEArrow XmlTree XmlTree+                                                                        -- XML 1.0 chapter 4.4.4+    forbidden           :: String -> String -> String -> GEArrow XmlTree XmlTree     forbidden entity msg cx- 	= issueErr ("reference of " ++ msg ++ show entity ++ " forbidden in " ++ cx)+        = issueErr ("reference of " ++ msg ++ show entity ++ " forbidden in " ++ cx) -									-- XML 1.0 chapter 4.4.5-    includedInLiteral		:: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree+                                                                        -- XML 1.0 chapter 4.4.5+    includedInLiteral           :: XmlTrees -> RecList -> String -> GEArrow XmlTree XmlTree     includedInLiteral-	= included+        = included -									-- XML 1.0 chapter 4.4.7-    bypassed		:: GEArrow XmlTree XmlTree+                                                                        -- XML 1.0 chapter 4.4.7+    bypassed            :: GEArrow XmlTree XmlTree     bypassed-	= this+        = this  -- ------------------------------------------------------------

@@ -31,7 +31,7 @@     ) where -import Control.Arrow				-- arrow classes+import Control.Arrow                            -- arrow classes import Control.Arrow.ArrowList import Control.Arrow.ArrowIf import Control.Arrow.ArrowTree@@ -40,16 +40,16 @@ import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.XmlArrow -import Data.Maybe		    ( isNothing-				    , fromJust-				    )-import Data.List		    ( nub )+import Data.Maybe                   ( isNothing+                                    , fromJust+                                    )+import Data.List                    ( nub )  -- ------------------------------------------------------------  -- | test whether an attribute node contains an XML Namespace declaration -isNamespaceDeclAttr	:: ArrowXml a => a XmlTree XmlTree+isNamespaceDeclAttr     :: ArrowXml a => a XmlTree XmlTree isNamespaceDeclAttr     = fromLA $       (getAttrName >>> isA isNameSpaceName) `guards` this@@ -58,19 +58,19 @@ -- an attribute tree with a namespace declaration (see 'isNamespaceDeclAttr') -- for all other nodes this arrow fails -getNamespaceDecl	:: ArrowXml a => a XmlTree (String, String)+getNamespaceDecl        :: ArrowXml a => a XmlTree (String, String) getNamespaceDecl     = fromLA $       isNamespaceDeclAttr       >>>       ( ( getAttrName-	  >>>-	  arr getNsPrefix-	)-	&&& xshow getChildren+          >>>+          arr getNsPrefix+        )+        &&& xshow getChildren       )       where-      getNsPrefix = drop 6 . qualifiedName	-- drop "xmlns:"+      getNsPrefix = drop 6 . qualifiedName      -- drop "xmlns:"  -- ------------------------------------------------------------ @@ -78,7 +78,7 @@ -- -- apply 'getNamespaceDecl' to a whole XmlTree -collectNamespaceDecl	:: LA XmlTree (String, String)+collectNamespaceDecl    :: LA XmlTree (String, String) collectNamespaceDecl    = multi getAttrl >>> getNamespaceDecl  -- | collect all (namePrefix, namespaceUri) pairs from a tree@@ -88,7 +88,7 @@ -- namespace cleanup, e.g. for documents generated with XSLT. It can be used -- together with 'collectNamespaceDecl' to 'cleanupNamespaces' -collectPrefixUriPairs	:: LA XmlTree (String, String)+collectPrefixUriPairs   :: LA XmlTree (String, String) collectPrefixUriPairs     = multi (isElem <+> getAttrl <+> isPi)       >>>@@ -96,16 +96,16 @@       >>>       arrL getPrefixUri     where-    getPrefixUri	:: QName -> [(String, String)]+    getPrefixUri        :: QName -> [(String, String)]     getPrefixUri n-	| null uri	= []-	| px == a_xmlns-	  ||-	  px == a_xml	= []				-- these ones are reserved an predefined-	| otherwise	= [(namePrefix n, uri)]-	where-	uri = namespaceUri n-	px  = namePrefix   n+        | null uri      = []+        | px == a_xmlns+          ||+          px == a_xml   = []                            -- these ones are reserved an predefined+        | otherwise     = [(namePrefix n, uri)]+        where+        uri = namespaceUri n+        px  = namePrefix   n  -- ------------------------------------------------------------ @@ -113,7 +113,7 @@ -- -- Calls 'cleanupNamespaces' with 'collectNamespaceDecl' -uniqueNamespaces		:: ArrowXml a => a XmlTree XmlTree+uniqueNamespaces                :: ArrowXml a => a XmlTree XmlTree uniqueNamespaces     = fromLA $       cleanupNamespaces collectNamespaceDecl@@ -123,7 +123,7 @@ -- useful for cleanup of namespaces in generated documents. -- Calls 'cleanupNamespaces' with @ collectNamespaceDecl \<+> collectPrefixUriPairs @ -uniqueNamespacesFromDeclAndQNames	:: ArrowXml a => a XmlTree XmlTree+uniqueNamespacesFromDeclAndQNames       :: ArrowXml a => a XmlTree XmlTree uniqueNamespacesFromDeclAndQNames     = fromLA $       cleanupNamespaces (collectNamespaceDecl <+> collectPrefixUriPairs)@@ -132,58 +132,58 @@ -- -- The parameter is used for collecting namespace uris and prefixes from the input tree -cleanupNamespaces	:: LA XmlTree (String, String) -> LA XmlTree XmlTree+cleanupNamespaces       :: LA XmlTree (String, String) -> LA XmlTree XmlTree cleanupNamespaces collectNamespaces     = renameNamespaces $< (listA collectNamespaces >>^ (toNsEnv >>> nub))     where     renameNamespaces :: NsEnv -> LA XmlTree XmlTree     renameNamespaces env-	= processBottomUp-	  ( processAttrl-	    ( ( none `when` isNamespaceDeclAttr )	-- remove all namespace declarations-	      >>>-	      changeQName renamePrefix			-- update namespace prefix of attribute names, if namespace uri is set-	    )-	    >>>-	    changeQName renamePrefix			-- update namespace prefix of element names-	  )-	  >>>-	  attachEnv env1				-- all all namespaces as attributes to the root node attribute list-	where-	renamePrefix	:: QName -> QName-	renamePrefix n-	    | isNullXName uri	= n-	    | isNothing newPx	= n-	    | otherwise		= setNamePrefix' (fromJust newPx) n-	    where-	    uri   = namespaceUri' n-	    newPx = lookup uri revEnv1-	    +        = processBottomUp+          ( processAttrl+            ( ( none `when` isNamespaceDeclAttr )       -- remove all namespace declarations+              >>>+              changeQName renamePrefix                  -- update namespace prefix of attribute names, if namespace uri is set+            )+            >>>+            changeQName renamePrefix                    -- update namespace prefix of element names+          )+          >>>+          attachEnv env1                                -- all all namespaces as attributes to the root node attribute list+        where+        renamePrefix    :: QName -> QName+        renamePrefix n+            | isNullXName uri   = n+            | isNothing newPx   = n+            | otherwise         = setNamePrefix' (fromJust newPx) n+            where+            uri   = namespaceUri' n+            newPx = lookup uri revEnv1+         revEnv1 = map (\ (x, y) -> (y, x)) env1 -	env1 :: NsEnv-	env1 = newEnv [] uris+        env1 :: NsEnv+        env1 = newEnv [] uris -	uris :: [XName]-	uris = nub . map snd $ env+        uris :: [XName]+        uris = nub . map snd $ env -	genPrefixes :: [XName]+        genPrefixes :: [XName]         genPrefixes = map (newXName . ("ns" ++) . show) [(0::Int)..] -        newEnv	:: NsEnv -> [XName] -> NsEnv-	newEnv env' []-	    = env'+        newEnv  :: NsEnv -> [XName] -> NsEnv+        newEnv env' []+            = env' -	newEnv env' (uri:rest)-	    = newEnv env'' rest-	    where-	    env''    = (prefix, uri) : env'-	    prefix-		= head (filter notAlreadyUsed $ preferedPrefixes ++ genPrefixes)-	    preferedPrefixes-		= map fst . filter ((==uri).snd) $ env-	    notAlreadyUsed s-		= isNothing . lookup s $ env'+        newEnv env' (uri:rest)+            = newEnv env'' rest+            where+            env''    = (prefix, uri) : env'+            prefix+                = head (filter notAlreadyUsed $ preferedPrefixes ++ genPrefixes)+            preferedPrefixes+                = map fst . filter ((==uri).snd) $ env+            notAlreadyUsed s+                = isNothing . lookup s $ env'  -- ------------------------------------------------------------ @@ -194,29 +194,29 @@ -- The namespace environment is implemented as a 'Data.AssocList.AssocList'. -- Processing of attributes can be controlled by a boolean parameter -processWithNsEnv1	:: ArrowXml a => Bool -> (NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree+processWithNsEnv1       :: ArrowXml a => Bool -> (NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree processWithNsEnv1 withAttr f env-    = ifA isElem						-- the test is just an optimization-      ( processWithExtendedEnv $< arr (extendEnv env) )		-- only element nodes contain namespace declarations+    = ifA isElem                                                -- the test is just an optimization+      ( processWithExtendedEnv $< arr (extendEnv env) )         -- only element nodes contain namespace declarations       ( processWithExtendedEnv env )     where     processWithExtendedEnv env'-	= f env'						-- apply the env filter-	  >>>-	  ( ( if withAttr-	      then processAttrl (f env')			-- apply the env to all attributes-	      else this-	    )-	    >>>-	    processChildren (processWithNsEnv f env')		-- apply the env recursively to all children-	  )-          `when` isElem						-- attrl and children only need processing for elem nodes+        = f env'                                                -- apply the env filter+          >>>+          ( ( if withAttr+              then processAttrl (f env')                        -- apply the env to all attributes+              else this+            )+            >>>+            processChildren (processWithNsEnv f env')           -- apply the env recursively to all children+          )+          `when` isElem                                         -- attrl and children only need processing for elem nodes -    extendEnv	:: NsEnv -> XmlTree -> NsEnv+    extendEnv   :: NsEnv -> XmlTree -> NsEnv     extendEnv env' t'-	= addEntries (toNsEnv newDecls) env'-	where-	newDecls = runLA ( getAttrl >>> getNamespaceDecl ) t'+        = addEntries (toNsEnv newDecls) env'+        where+        newDecls = runLA ( getAttrl >>> getNamespaceDecl ) t'  -- ------------------------------------------------------------ @@ -225,16 +225,16 @@ -- -- The namespace environment is implemented as a 'Data.AssocList.AssocList' -processWithNsEnv		:: ArrowXml a => (NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree-processWithNsEnv		= processWithNsEnv1 True+processWithNsEnv                :: ArrowXml a => (NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree+processWithNsEnv                = processWithNsEnv1 True  -- | process all element nodes of a document tree with an arrow, containing always the -- valid namespace environment as extra parameter. Attribute lists are not processed. -- -- See also: 'processWithNsEnv' -processWithNsEnvWithoutAttrl	:: ArrowXml a => (NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree-processWithNsEnvWithoutAttrl	= processWithNsEnv1 False+processWithNsEnvWithoutAttrl    :: ArrowXml a => (NsEnv -> a XmlTree XmlTree) -> NsEnv -> a XmlTree XmlTree+processWithNsEnvWithoutAttrl    = processWithNsEnv1 False  -- ----------------------------------------------------------------------------- @@ -243,29 +243,29 @@ -- This arrow is useful for document processing, that requires access to all namespace -- declarations at any element node, but which cannot be done with a simple 'processWithNsEnv'. -attachNsEnv	:: ArrowXml a => NsEnv -> a XmlTree XmlTree+attachNsEnv     :: ArrowXml a => NsEnv -> a XmlTree XmlTree attachNsEnv initialEnv     = fromLA $ processWithNsEnvWithoutAttrl attachEnv initialEnv     where -attachEnv	:: NsEnv -> LA XmlTree XmlTree+attachEnv       :: NsEnv -> LA XmlTree XmlTree attachEnv env     = ( processAttrl (none `when` isNamespaceDeclAttr)-	>>>-	addAttrl (catA nsAttrl)+        >>>+        addAttrl (catA nsAttrl)       )       `when` isElem     where-    nsAttrl		:: [LA XmlTree XmlTree]-    nsAttrl		= map nsDeclToAttr env+    nsAttrl             :: [LA XmlTree XmlTree]+    nsAttrl             = map nsDeclToAttr env -    nsDeclToAttr	:: (XName, XName) -> LA XmlTree XmlTree+    nsDeclToAttr        :: (XName, XName) -> LA XmlTree XmlTree     nsDeclToAttr (n, uri)-	= mkAttr qn (txt (show uri))-	where-	qn :: QName-	qn | isNullXName n	= mkQName' nullXName  xmlnsXName xmlnsNamespaceXName-	   | otherwise		= mkQName' xmlnsXName n          xmlnsNamespaceXName+        = mkAttr qn (txt (show uri))+        where+        qn :: QName+        qn | isNullXName n      = mkQName' nullXName  xmlnsXName xmlnsNamespaceXName+           | otherwise          = mkQName' xmlnsXName n          xmlnsNamespaceXName  -- ----------------------------------------------------------------------------- @@ -277,39 +277,39 @@ -- -- The arrow may be applied repeatedly if neccessary. -propagateNamespaces	:: ArrowXml a => a XmlTree XmlTree-propagateNamespaces	= fromLA $-			  propagateNamespaceEnv [ (xmlXName,   xmlNamespaceXName)-						, (xmlnsXName, xmlnsNamespaceXName)-						]+propagateNamespaces     :: ArrowXml a => a XmlTree XmlTree+propagateNamespaces     = fromLA $+                          propagateNamespaceEnv [ (xmlXName,   xmlNamespaceXName)+                                                , (xmlnsXName, xmlnsNamespaceXName)+                                                ]  -- | -- attaches the namespace info given by the namespace table -- to a tag node and its attributes and children. -propagateNamespaceEnv	:: NsEnv -> LA XmlTree XmlTree+propagateNamespaceEnv   :: NsEnv -> LA XmlTree XmlTree propagateNamespaceEnv     = processWithNsEnv addNamespaceUri     where-    addNamespaceUri	:: NsEnv -> LA XmlTree XmlTree+    addNamespaceUri     :: NsEnv -> LA XmlTree XmlTree     addNamespaceUri env'-	= choiceA [ isElem :-> changeElemName (setNamespace env')-		  , isAttr :-> attachNamespaceUriToAttr env'-		  , isPi   :-> changePiName   (setNamespace env')-		  , this   :-> this-		  ]+        = choiceA [ isElem :-> changeElemName (setNamespace env')+                  , isAttr :-> attachNamespaceUriToAttr env'+                  , isPi   :-> changePiName   (setNamespace env')+                  , this   :-> this+                  ] -    attachNamespaceUriToAttr	:: NsEnv -> LA XmlTree XmlTree+    attachNamespaceUriToAttr    :: NsEnv -> LA XmlTree XmlTree     attachNamespaceUriToAttr attrEnv-	= ( ( getQName >>> isA (not . null . namePrefix) )-	    `guards`-	    changeAttrName (setNamespace attrEnv)-	  )+        = ( ( getQName >>> isA (not . null . namePrefix) )+            `guards`+            changeAttrName (setNamespace attrEnv)+          )           `orElse`-	  ( changeAttrName (const xmlnsQN)-	    `when`-	    hasName a_xmlns-	  )+          ( changeAttrName (const xmlnsQN)+            `when`+            hasName a_xmlns+          )  -- ----------------------------------------------------------------------------- @@ -320,96 +320,96 @@ -- Predicates 'isWellformedQName', 'isWellformedQualifiedName', 'isDeclaredNamespace' -- and 'isWellformedNSDecl' are applied to the appropriate elements and attributes. -validateNamespaces	:: ArrowXml a => a XmlTree XmlTree-validateNamespaces	= fromLA validateNamespaces1+validateNamespaces      :: ArrowXml a => a XmlTree XmlTree+validateNamespaces      = fromLA validateNamespaces1 -validateNamespaces1	:: LA XmlTree XmlTree+validateNamespaces1     :: LA XmlTree XmlTree validateNamespaces1-    = choiceA [ isRoot	:-> ( getChildren >>> validateNamespaces1 )		-- root is correct by definition-	      , this	:-> multi validate1Namespaces-	      ]+    = choiceA [ isRoot  :-> ( getChildren >>> validateNamespaces1 )             -- root is correct by definition+              , this    :-> multi validate1Namespaces+              ]  -- | -- a single node for namespace constrains. -validate1Namespaces	:: LA XmlTree XmlTree+validate1Namespaces     :: LA XmlTree XmlTree validate1Namespaces     = choiceA-      [ isElem	:-> catA [ ( getQName >>> isA ( not . isWellformedQName )-			   )-			   `guards` nsError (\ n -> "element name " ++ show n ++ " is not a wellformed qualified name" )+      [ isElem  :-> catA [ ( getQName >>> isA ( not . isWellformedQName )+                           )+                           `guards` nsError (\ n -> "element name " ++ show n ++ " is not a wellformed qualified name" ) -			 , ( getQName >>> isA ( not . isDeclaredNamespace )-			   )-			   `guards` nsError (\ n -> "namespace for prefix in element name " ++ show n ++ " is undefined" )+                         , ( getQName >>> isA ( not . isDeclaredNamespace )+                           )+                           `guards` nsError (\ n -> "namespace for prefix in element name " ++ show n ++ " is undefined" ) -		         , doubleOcc $< ( (getAttrl >>> getUniversalName) >>. doubles )+                         , doubleOcc $< ( (getAttrl >>> getUniversalName) >>. doubles ) -			 , getAttrl >>> validate1Namespaces-		         ]+                         , getAttrl >>> validate1Namespaces+                         ] -      , isAttr	:-> catA [ ( getQName >>> isA ( not . isWellformedQName )-			   )-			   `guards` nsError (\ n -> "attribute name " ++ show n ++ " is not a wellformed qualified name" )+      , isAttr  :-> catA [ ( getQName >>> isA ( not . isWellformedQName )+                           )+                           `guards` nsError (\ n -> "attribute name " ++ show n ++ " is not a wellformed qualified name" ) -			 , ( getQName >>> isA ( not . isDeclaredNamespace )-			   )-			   `guards` nsError (\ n -> "namespace for prefix in attribute name " ++ show n ++ " is undefined" )+                         , ( getQName >>> isA ( not . isDeclaredNamespace )+                           )+                           `guards` nsError (\ n -> "namespace for prefix in attribute name " ++ show n ++ " is undefined" ) -			 , ( hasNamePrefix a_xmlns >>> xshow getChildren >>> isA null-			   )-			   `guards` nsError (\ n -> "namespace value of namespace declaration for " ++ show n ++ " has no value" )+                         , ( hasNamePrefix a_xmlns >>> xshow getChildren >>> isA null+                           )+                           `guards` nsError (\ n -> "namespace value of namespace declaration for " ++ show n ++ " has no value" )                           , ( getQName >>> isA (not . isWellformedNSDecl )-			   )-			   `guards`  nsError (\ n -> "illegal namespace declaration for name " ++ n ++ " starting with reserved prefix " ++ show "xml" )-			 ]+                           )+                           `guards`  nsError (\ n -> "illegal namespace declaration for name " ++ n ++ " starting with reserved prefix " ++ show "xml" )+                         ] -      , isDTD	:-> catA [ isDTDDoctype <+> isDTDAttlist <+> isDTDElement <+> isDTDName-		           >>>-			   getDTDAttrValue a_name-			   >>>-			   ( isA (not . isWellformedQualifiedName)-			     `guards`-			     nsErr (\ n -> "a DTD part contains a not wellformed qualified Name: " ++ show n)-			   )+      , isDTD   :-> catA [ isDTDDoctype <+> isDTDAttlist <+> isDTDElement <+> isDTDName+                           >>>+                           getDTDAttrValue a_name+                           >>>+                           ( isA (not . isWellformedQualifiedName)+                             `guards`+                             nsErr (\ n -> "a DTD part contains a not wellformed qualified Name: " ++ show n)+                           ) -			 , isDTDAttlist-			   >>>-			   getDTDAttrValue a_value-			   >>>-			   ( isA (not . isWellformedQualifiedName)-			     `guards`-			     nsErr (\ n -> "an ATTLIST declaration contains as attribute name a not wellformed qualified Name: " ++ show n)-			   )+                         , isDTDAttlist+                           >>>+                           getDTDAttrValue a_value+                           >>>+                           ( isA (not . isWellformedQualifiedName)+                             `guards`+                             nsErr (\ n -> "an ATTLIST declaration contains as attribute name a not wellformed qualified Name: " ++ show n)+                           )                           , isDTDEntity <+> isDTDPEntity <+> isDTDNotation-			   >>>-			   getDTDAttrValue a_name-			   >>>-			   ( isA (not . isNCName)+                           >>>+                           getDTDAttrValue a_name+                           >>>+                           ( isA (not . isNCName)                              `guards`-			     nsErr (\ n -> "an entity or notation declaration contains a not wellformed NCName: " ++ show n)-			   )-			 ]-      , isPi	:-> catA [ getName-		           >>>-			   ( isA (not . isNCName)-			     `guards`-			     nsErr (\ n -> "a PI contains a not wellformed NCName: " ++ show n)-			   )-			 ]+                             nsErr (\ n -> "an entity or notation declaration contains a not wellformed NCName: " ++ show n)+                           )+                         ]+      , isPi    :-> catA [ getName+                           >>>+                           ( isA (not . isNCName)+                             `guards`+                             nsErr (\ n -> "a PI contains a not wellformed NCName: " ++ show n)+                           )+                         ]       ]     where-    nsError	:: (String -> String) -> LA XmlTree XmlTree+    nsError     :: (String -> String) -> LA XmlTree XmlTree     nsError msg-	= (getQName >>> arr show) >>> nsErr msg+        = (getQName >>> arr show) >>> nsErr msg -    nsErr	:: (String -> String) -> LA String XmlTree-    nsErr msg	= arr msg >>> mkError c_err+    nsErr       :: (String -> String) -> LA String XmlTree+    nsErr msg   = arr msg >>> mkError c_err -    doubleOcc	:: String -> LA XmlTree XmlTree+    doubleOcc   :: String -> LA XmlTree XmlTree     doubleOcc an-	= nsError (\ n -> "multiple occurences of universal name for attributes of tag " ++ show n ++ " : " ++ show an )+        = nsError (\ n -> "multiple occurences of universal name for attributes of tag " ++ show n ++ " : " ++ show an )  -- ------------------------------------------------------------

@@ -13,80 +13,80 @@ import Control.Arrow.ArrowTree import Control.Arrow.ListArrow -import Text.XML.HXT.Parser.XmlEntities	( xmlEntities   )+import Text.XML.HXT.Parser.XmlEntities  ( xmlEntities   ) import Text.XML.HXT.Parser.XhtmlEntities( xhtmlEntities )  import Text.XML.HXT.DOM.Interface import Text.XML.HXT.Arrow.XmlArrow -import qualified Text.XML.HXT.Parser.TagSoup		 as TS+import qualified Text.XML.HXT.Parser.TagSoup             as TS import qualified Text.XML.HXT.Parser.HtmlParsec          as HP import qualified Text.XML.HXT.Parser.XmlParsec           as XP-import qualified Text.XML.HXT.Parser.XmlDTDParser	 as DP+import qualified Text.XML.HXT.Parser.XmlDTDParser        as DP import qualified Text.XML.HXT.DTDValidation.Validation   as VA  -- ------------------------------------------------------------ -parseXmlDoc			:: ArrowXml a => a (String, String) XmlTree-parseXmlDoc			=  arr2L XP.parseXmlDocument+parseXmlDoc                     :: ArrowXml a => a (String, String) XmlTree+parseXmlDoc                     =  arr2L XP.parseXmlDocument -parseXmlDTDPart			:: ArrowXml a => a (String, XmlTree) XmlTree-parseXmlDTDPart			=  arr2L XP.parseXmlDTDPart+parseXmlDTDPart                 :: ArrowXml a => a (String, XmlTree) XmlTree+parseXmlDTDPart                 =  arr2L XP.parseXmlDTDPart -parseXmlContent			:: ArrowXml a => a String XmlTree-parseXmlContent			=  arrL XP.xread+parseXmlContent                 :: ArrowXml a => a String XmlTree+parseXmlContent                 =  arrL XP.xread  parseXmlEntityEncodingSpec   , parseXmlDocEncodingSpec-  , removeEncodingSpec		:: ArrowXml a => a XmlTree XmlTree+  , removeEncodingSpec          :: ArrowXml a => a XmlTree XmlTree -parseXmlDocEncodingSpec		=  arrL XP.parseXmlDocEncodingSpec-parseXmlEntityEncodingSpec	=  arrL XP.parseXmlEntityEncodingSpec+parseXmlDocEncodingSpec         =  arrL XP.parseXmlDocEncodingSpec+parseXmlEntityEncodingSpec      =  arrL XP.parseXmlEntityEncodingSpec -removeEncodingSpec		=  arrL XP.removeEncodingSpec+removeEncodingSpec              =  arrL XP.removeEncodingSpec -parseXmlDTDdeclPart		:: ArrowXml a => a XmlTree XmlTree-parseXmlDTDdeclPart		=  arrL DP.parseXmlDTDdeclPart+parseXmlDTDdeclPart             :: ArrowXml a => a XmlTree XmlTree+parseXmlDTDdeclPart             =  arrL DP.parseXmlDTDdeclPart -parseXmlDTDdecl			:: ArrowXml a => a XmlTree XmlTree-parseXmlDTDdecl			=  arrL DP.parseXmlDTDdecl+parseXmlDTDdecl                 :: ArrowXml a => a XmlTree XmlTree+parseXmlDTDdecl                 =  arrL DP.parseXmlDTDdecl -parseXmlDTDEntityValue		:: ArrowXml a => a XmlTree XmlTree-parseXmlDTDEntityValue		=  arrL DP.parseXmlDTDEntityValue+parseXmlDTDEntityValue          :: ArrowXml a => a XmlTree XmlTree+parseXmlDTDEntityValue          =  arrL DP.parseXmlDTDEntityValue -parseXmlAttrValue		:: ArrowXml a => String -> a XmlTree XmlTree-parseXmlAttrValue context	=  arrL (XP.parseXmlAttrValue context)+parseXmlAttrValue               :: ArrowXml a => String -> a XmlTree XmlTree+parseXmlAttrValue context       =  arrL (XP.parseXmlAttrValue context) -parseXmlGeneralEntityValue	:: ArrowXml a => String -> a XmlTree XmlTree+parseXmlGeneralEntityValue      :: ArrowXml a => String -> a XmlTree XmlTree parseXmlGeneralEntityValue context-				=  arrL (XP.parseXmlGeneralEntityValue context)+                                =  arrL (XP.parseXmlGeneralEntityValue context)  -- ------------------------------------------------------------ -parseHtmlDoc			:: ArrowList a => a (String, String) XmlTree-parseHtmlDoc			= arr2L HP.parseHtmlDocument+parseHtmlDoc                    :: ArrowList a => a (String, String) XmlTree+parseHtmlDoc                    = arr2L HP.parseHtmlDocument -parseHtmlContent		:: ArrowList a => a String XmlTree-parseHtmlContent		= arrL  HP.parseHtmlContent+parseHtmlContent                :: ArrowList a => a String XmlTree+parseHtmlContent                = arrL  HP.parseHtmlContent -parseHtmlTagSoup		:: ArrowList a => Bool -> Bool -> Bool -> Bool -> Bool -> a (String, String) XmlTree+parseHtmlTagSoup                :: ArrowList a => Bool -> Bool -> Bool -> Bool -> Bool -> a (String, String) XmlTree parseHtmlTagSoup withNamespaces withWarnings preserveCmt removeWS asHtml-				= arr2L (TS.parseHtmlTagSoup withNamespaces withWarnings preserveCmt removeWS asHtml)+                                = arr2L (TS.parseHtmlTagSoup withNamespaces withWarnings preserveCmt removeWS asHtml)  -- ------------------------------------------------------------ -validateDoc			:: ArrowList a => a XmlTree XmlTree-validateDoc			= fromLA ( VA.validate-					   `when`-					   VA.getDTDSubset	-- validate only when DTD decl is present-					 )+validateDoc                     :: ArrowList a => a XmlTree XmlTree+validateDoc                     = fromLA ( VA.validate+                                           `when`+                                           VA.getDTDSubset      -- validate only when DTD decl is present+                                         ) -transformDoc			:: ArrowList a => a XmlTree XmlTree-transformDoc			= fromLA VA.transform+transformDoc                    :: ArrowList a => a XmlTree XmlTree+transformDoc                    = fromLA VA.transform  -- old stuff--- validateDoc			= arrL VA.validate--- transformDoc			= arrL VA.transform+-- validateDoc                  = arrL VA.validate+-- transformDoc                 = arrL VA.transform  -- ------------------------------------------------------------ @@ -98,38 +98,38 @@ -- -- Unknown entity refs remain unchanged -substHtmlEntityRefs		:: ArrowList a => a XmlTree XmlTree-substHtmlEntityRefs		= substEntityRefs xhtmlEntities+substHtmlEntityRefs             :: ArrowList a => a XmlTree XmlTree+substHtmlEntityRefs             = substEntityRefs xhtmlEntities   -- | substitution of the five predefined XMT entities, works like 'substHtmlEntityRefs' -substXmlEntityRefs		:: ArrowList a => a XmlTree XmlTree-substXmlEntityRefs		= substEntityRefs xmlEntities+substXmlEntityRefs              :: ArrowList a => a XmlTree XmlTree+substXmlEntityRefs              = substEntityRefs xmlEntities  -- | the entity substitution arrow called from 'substXmlEntityRefs' and 'substHtmlEntityRefs' -substEntityRefs		:: ArrowList a => [(String, Int)] -> a XmlTree XmlTree+substEntityRefs         :: ArrowList a => [(String, Int)] -> a XmlTree XmlTree substEntityRefs entities     = fromLA substEntities     where-    substEntities		:: LA XmlTree XmlTree+    substEntities               :: LA XmlTree XmlTree     substEntities-	= choiceA-	  [ isEntityRef	:-> ( substEntity $< getEntityRef )-	  , isElem	:-> ( processAttrl (processChildren substEntities)-			      >>>-			      processChildren substEntities-			    )-	  , this	:-> this-	  ]-	where-	substEntity en-	    = case (lookup en entities) of-	      Just i-		  -> txt [toEnum i] 	-- constA i >>> mkCharRef-	      Nothing-		  -> this+        = choiceA+          [ isEntityRef :-> ( substEntity $< getEntityRef )+          , isElem      :-> ( processAttrl (processChildren substEntities)+                              >>>+                              processChildren substEntities+                            )+          , this        :-> this+          ]+        where+        substEntity en+            = case (lookup en entities) of+              Just i+                  -> txt [toEnum i]     -- constA i >>> mkCharRef+              Nothing+                  -> this   -- ------------------------------------------------------------

@@ -37,7 +37,7 @@ -- ------------------------------------------------------------  module Text.XML.HXT.Arrow.Pickle-    ( xpickleDocument		 -- from this module Text.XML.HXT.Arrow.Pickle+    ( xpickleDocument            -- from this module Text.XML.HXT.Arrow.Pickle     , xunpickleDocument     , xpickleWriteDTD     , xpickleDTD@@ -123,26 +123,26 @@ -- 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		:: PU a -> Attributes -> String -> IOStateArrow s a XmlTree+xpickleDocument         :: PU a -> Attributes -> String -> IOStateArrow s a XmlTree xpickleDocument xp al dest     = xpickleVal xp       >>>       traceMsg 1 "xpickleVal applied"       >>>       ( if lookup1 a_addDTD al == v_1-	then replaceChildren ( (constA undefined >>> xpickleDTD xp >>> getChildren)-			       <+>-			       getChildren-			     )-	else this+        then replaceChildren ( (constA undefined >>> xpickleDTD xp >>> getChildren)+                               <+>+                               getChildren+                             )+        else this       )       >>>       writeDocument al dest  -- | Option for generating and adding DTD when document is pickled -a_addDTD	:: String-a_addDTD	= "addDTD"+a_addDTD        :: String+a_addDTD        = "addDTD"  -- | read an arbitray value from an XML document --@@ -154,34 +154,34 @@ -- when applied with the appropriate options. When during pickling indentation is switched on, -- the whitespace must be removed during unpickling. -xunpickleDocument	:: PU a -> Attributes -> String -> IOStateArrow s b a+xunpickleDocument       :: PU a -> Attributes -> String -> IOStateArrow s b a xunpickleDocument xp al src-			= readDocument al src-			  >>>-			  traceMsg 1 ("xunpickleVal for " ++ show src ++ " started")-			  >>>-			  xunpickleVal xp-			  >>>-			  traceMsg 1 ("xunpickleVal for " ++ show src ++ " finished")+                        = readDocument al src+                          >>>+                          traceMsg 1 ("xunpickleVal for " ++ show src ++ " started")+                          >>>+                          xunpickleVal xp+                          >>>+                          traceMsg 1 ("xunpickleVal for " ++ show src ++ " finished")  -- | Write out the DTD generated out of a pickler. Calls 'xpicklerDTD' -xpickleWriteDTD		:: PU b -> Attributes -> String -> IOStateArrow s b XmlTree-xpickleWriteDTD	xp al dest-			= xpickleDTD xp-			  >>>-			  writeDocument al dest+xpickleWriteDTD         :: PU b -> Attributes -> String -> IOStateArrow s b XmlTree+xpickleWriteDTD xp al dest+                        = xpickleDTD xp+                          >>>+                          writeDocument al dest  -- | 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		:: PU b -> IOStateArrow s b XmlTree-xpickleDTD xp		= root [] [ constL (thePicklerDTD xp)-				    >>>-				    filterErrorMsg-				  ]+xpickleDTD              :: PU b -> IOStateArrow s b XmlTree+xpickleDTD xp           = root [] [ constL (thePicklerDTD xp)+                                    >>>+                                    filterErrorMsg+                                  ]  -- | An arrow for checking picklers --@@ -194,50 +194,50 @@ -- -- If the check succeeds, the arrow works like this, else it fails. -checkPickler		:: Eq a => PU a -> IOStateArrow s a a-checkPickler xp		= ( ( ( ( xpickleVal xp-				  >>>-				  replaceChildren ( (constA undefined >>> xpickleDTD xp >>> getChildren)-						    <+>-						    getChildren-						  )-				  >>>-				  writeDocumentToString []-				  >>>-				  readFromString [(a_validate, v_1)]-				  >>>-				  ( xunpickleVal xp-				    `orElse`-				    ( issueErr "unpickling the document failed"-				      >>>-				      none-				    )-				  )-				)-				&&& -				this-			      )-			      >>> isA (uncurry (==))-			    )-			    `guards` this-			  )-			  `orElse` issueErr "pickle/unpickle combinators failed"+checkPickler            :: Eq a => PU a -> IOStateArrow s a a+checkPickler xp         = ( ( ( ( xpickleVal xp+                                  >>>+                                  replaceChildren ( (constA undefined >>> xpickleDTD xp >>> getChildren)+                                                    <+>+                                                    getChildren+                                                  )+                                  >>>+                                  writeDocumentToString []+                                  >>>+                                  readFromString [(a_validate, v_1)]+                                  >>>+                                  ( xunpickleVal xp+                                    `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		:: ArrowXml a => PU b -> a b XmlTree-xpickleVal xp		= arr (pickleDoc xp)+xpickleVal              :: ArrowXml a => PU b -> a b XmlTree+xpickleVal xp           = arr (pickleDoc xp)  -- | The arrow version of the unpickler function -xunpickleVal		:: ArrowXml a => PU b -> a XmlTree b-xunpickleVal xp		= arrL (maybeToList . unpickleDoc xp)+xunpickleVal            :: ArrowXml a => PU b -> a XmlTree b+xunpickleVal xp         = arrL (maybeToList . unpickleDoc xp)   -- | Compute the associated DTD of a pickler -thePicklerDTD		:: PU b -> XmlTrees-thePicklerDTD		= dtdDescrToXml . dtdDescr . theSchema+thePicklerDTD           :: PU b -> XmlTrees+thePicklerDTD           = dtdDescrToXml . dtdDescr . theSchema  -- ------------------------------------------------------------ 

@@ -30,27 +30,27 @@  -- ------------------------------------------------------------ -data DTDdescr			= DTDdescr Name Schemas [(Name,Schemas)]+data DTDdescr                   = DTDdescr Name Schemas [(Name,Schemas)]  instance Show DTDdescr where     show (DTDdescr n es as)-	= "root element: " ++ n ++ "\n"-	  ++-	  "elements:\n"-	  ++-	  concatMap ((++ "\n") .show) es-	  ++-	  "attributes:\n"-	  ++-	  concatMap ((++ "\n") . showAttr) as-	where-	showAttr (n1, sc) = n1 ++ ": " ++ show sc+        = "root element: " ++ n ++ "\n"+          +++          "elements:\n"+          +++          concatMap ((++ "\n") .show) es+          +++          "attributes:\n"+          +++          concatMap ((++ "\n") . showAttr) as+        where+        showAttr (n1, sc) = n1 ++ ": " ++ show sc  -- ------------------------------------------------------------  -- | convert a DTD descr into XmlTrees -dtdDescrToXml	:: DTDdescr -> XmlTrees+dtdDescrToXml   :: DTDdescr -> XmlTrees dtdDescrToXml (DTDdescr rt es as)     = checkErr (null rt) "no unique root element found in pickler DTD, add an \"xpElem\" pickler"       ++@@ -61,61 +61,61 @@       concatMap (uncurry checkAttrModell) as       ++       [ XN.mkDTDElem DOCTYPE docAttrs ( concatMap elemDTD es1-					++-					concatMap (uncurry attrDTDs) as-				      ) ]+                                        +++                                        concatMap (uncurry attrDTDs) as+                                      ) ]     where-    es1 		= filter isScElem es-    -    docAttrs		= [(a_name, if null rt then "no-unique-root-element-found" else rt)]+    es1                 = filter isScElem es +    docAttrs            = [(a_name, if null rt then "no-unique-root-element-found" else rt)]+     elemDTD (Element n sc)-	| lookup1 a_type al == "unknown"-	    = cl-	| otherwise-	    = [ XN.mkDTDElem ELEMENT ((a_name, n) : al) cl ]-	where-	(al, cl) = scContToXml sc+        | lookup1 a_type al == "unknown"+            = cl+        | otherwise+            = [ XN.mkDTDElem ELEMENT ((a_name, n) : al) cl ]+        where+        (al, cl) = scContToXml sc     elemDTD _-	= error "illegal case in elemDTD"+        = error "illegal case in elemDTD" -    attrDTDs en		= concatMap (attrDTD en)+    attrDTDs en         = concatMap (attrDTD en)     attrDTD en (Attribute an sc)-	    		= [ XN.mkDTDElem ATTLIST ((a_name, en) : (a_value, an) : al) cl ]-			  where-			  (al, cl) = scAttrToXml sc-    attrDTD _ _		= error "illegal case in attrDTD"+                        = [ XN.mkDTDElem ATTLIST ((a_name, en) : (a_value, an) : al) cl ]+                          where+                          (al, cl) = scAttrToXml sc+    attrDTD _ _         = error "illegal case in attrDTD"  -checkAttrModell					:: Name -> Schemas -> XmlTrees-checkAttrModell n				= concatMap (checkAM n)+checkAttrModell                                 :: Name -> Schemas -> XmlTrees+checkAttrModell n                               = concatMap (checkAM n) -checkAM						:: Name -> Schema -> XmlTrees-checkAM en (Attribute an sc)			= checkAMC en an sc-checkAM _ _					= []+checkAM                                         :: Name -> Schema -> XmlTrees+checkAM en (Attribute an sc)                    = checkAMC en an sc+checkAM _ _                                     = [] -checkAMC					:: Name -> Name -> Schema -> XmlTrees-checkAMC _en _an (CharData _)			= []+checkAMC                                        :: Name -> Name -> Schema -> XmlTrees+checkAMC _en _an (CharData _)                   = [] checkAMC en an sc-    | isScCharData sc	= []+    | isScCharData sc   = []     | isScList sc       &&       (sc_1 sc == scNmtoken)-			= []-    | isScOpt sc	= checkAMC en an (sc_1 sc)-    | otherwise		= foundErr-			  ( "weird attribute type found for attribute "-			    ++ show an-			    ++ " for element "-			    ++ show en-			    ++ "\n\t(internal structure: " ++ show sc ++ ")"-			    ++ "\n\thint: create an element instead of an attribute for "-			    ++ show an-			  )+                        = []+    | isScOpt sc        = checkAMC en an (sc_1 sc)+    | otherwise         = foundErr+                          ( "weird attribute type found for attribute "+                            ++ show an+                            ++ " for element "+                            ++ show en+                            ++ "\n\t(internal structure: " ++ show sc ++ ")"+                            ++ "\n\thint: create an element instead of an attribute for "+                            ++ show an+                          )  -- checkContentModell1 n sc = foundErr (n ++ " : " ++ show sc) ++ checkContentModell n sc -checkContentModell				:: Name -> Schema -> XmlTrees+checkContentModell                              :: Name -> Schema -> XmlTrees  checkContentModell _ Any     = []@@ -132,13 +132,13 @@ checkContentModell n (Seq scs)     = checkErr pcDataInCM       ( "PCDATA found in a sequence spec in the content modell for "-	++ show n-	++ "\n\thint: create an element for this data"+        ++ show n+        ++ "\n\thint: create an element for this data"       )       ++       checkErr somethingElseInCM       ( "something weired found in a sequence spec in the content modell for "-	++ show n+        ++ show n       )       ++       concatMap (checkContentModell n) scs@@ -149,17 +149,17 @@ checkContentModell n (Alt scs)     = checkErr mixedCM       ( "PCDATA mixed up with illegal content spec in mixed contents for "-	++ show n-	++ "\n\thint: create an element for this data"+        ++ show n+        ++ "\n\thint: create an element for this data"       )       ++       concatMap (checkContentModell n) scs     where     mixedCM-	| any isScCharData scs-	    = any (not . isScElemRef) . filter (not . isScCharData) $ scs-	| otherwise-	    = False+        | any isScCharData scs+            = any (not . isScElemRef) . filter (not . isScCharData) $ scs+        | otherwise+            = False  checkContentModell _ (Rep _ _ (ElemRef _))     = []@@ -173,99 +173,99 @@ checkContentModell n (Rep _ _ _)     = foundErr       ( "illegal content spec found for "-	++ show n+        ++ show n       )  checkContentModell _ _     = []  -scContToXml			:: Schema -> (Attributes, XmlTrees)+scContToXml                     :: Schema -> (Attributes, XmlTrees) -scContToXml Any			= ( [(a_type, v_any)],    [] )-scContToXml (CharData _)	= ( [(a_type, v_pcdata)], [] )-scContToXml (Seq [])		= ( [(a_type, v_empty)],  [] )-scContToXml sc@(ElemRef _)	= scContToXml (Seq [sc])-scContToXml sc@(Seq _)		= ( [(a_type, v_children)]-				  , scCont [] sc-				  )+scContToXml Any                 = ( [(a_type, v_any)],    [] )+scContToXml (CharData _)        = ( [(a_type, v_pcdata)], [] )+scContToXml (Seq [])            = ( [(a_type, v_empty)],  [] )+scContToXml sc@(ElemRef _)      = scContToXml (Seq [sc])+scContToXml sc@(Seq _)          = ( [(a_type, v_children)]+                                  , scCont [] sc+                                  ) scContToXml sc@(Alt sc1)-    | isMixed sc1		= ( [(a_type, v_mixed)]-				  , scCont [ (a_modifier, "*") ] sc-				  )-    | otherwise			= ( [(a_type, v_children)]-				  , scCont [] sc-				  ) +    | isMixed sc1               = ( [(a_type, v_mixed)]+                                  , scCont [ (a_modifier, "*") ] sc+                                  )+    | otherwise                 = ( [(a_type, v_children)]+                                  , scCont [] sc+                                  )     where-    isMixed			= not . null . filter isScCharData-scContToXml sc@(Rep _ _ _)	= ( [(a_type, v_children)]-				  , scCont [] sc-				  )-scContToXml _sc			= ( [(a_type, v_any)]		-- default: everything is allowed-				  , []-				  )+    isMixed                     = not . null . filter isScCharData+scContToXml sc@(Rep _ _ _)      = ( [(a_type, v_children)]+                                  , scCont [] sc+                                  )+scContToXml _sc                 = ( [(a_type, v_any)]           -- default: everything is allowed+                                  , []+                                  ) -scWrap				:: Schema -> Schema-scWrap sc@(Alt _)		= sc-scWrap sc@(Seq _)		= sc-scWrap sc@(Rep _ _  _)		= sc-scWrap sc			= Seq [sc]+scWrap                          :: Schema -> Schema+scWrap sc@(Alt _)               = sc+scWrap sc@(Seq _)               = sc+scWrap sc@(Rep _ _  _)          = sc+scWrap sc                       = Seq [sc] -scCont				:: Attributes -> Schema -> XmlTrees-scCont al (Seq scs)		= scConts ((a_kind, v_seq   ) : al) scs-scCont al (Alt scs)		= scConts ((a_kind, v_choice) : al) scs-scCont al (Rep 0 (-1) sc)	= scCont ((a_modifier, "*")   : al) (scWrap sc)-scCont al (Rep 1 (-1) sc)	= scCont ((a_modifier, "+")   : al) (scWrap sc)-scCont al (Rep 0 1    sc)	= scCont ((a_modifier, "?")   : al) (scWrap sc)-scCont al (ElemRef n)		= [XN.mkDTDElem NAME ((a_name, n) : al) []]-scCont _  (CharData _)		= [XN.mkDTDElem NAME [(a_name, "#PCDATA")] []]-scCont _  _sc			= [XN.mkDTDElem NAME [(a_name, "bad-content-spec")] []]		-- error case+scCont                          :: Attributes -> Schema -> XmlTrees+scCont al (Seq scs)             = scConts ((a_kind, v_seq   ) : al) scs+scCont al (Alt scs)             = scConts ((a_kind, v_choice) : al) scs+scCont al (Rep 0 (-1) sc)       = scCont ((a_modifier, "*")   : al) (scWrap sc)+scCont al (Rep 1 (-1) sc)       = scCont ((a_modifier, "+")   : al) (scWrap sc)+scCont al (Rep 0 1    sc)       = scCont ((a_modifier, "?")   : al) (scWrap sc)+scCont al (ElemRef n)           = [XN.mkDTDElem NAME ((a_name, n) : al) []]+scCont _  (CharData _)          = [XN.mkDTDElem NAME [(a_name, "#PCDATA")] []]+scCont _  _sc                   = [XN.mkDTDElem NAME [(a_name, "bad-content-spec")] []]         -- error case -scConts				:: Attributes -> Schemas -> XmlTrees-scConts al scs			= [XN.mkDTDElem CONTENT al (concatMap (scCont []) scs)]+scConts                         :: Attributes -> Schemas -> XmlTrees+scConts al scs                  = [XN.mkDTDElem CONTENT al (concatMap (scCont []) scs)] -scAttrToXml			:: Schema -> (Attributes, XmlTrees)+scAttrToXml                     :: Schema -> (Attributes, XmlTrees)  scAttrToXml sc-    | isScFixed	sc		= ( [ (a_kind, k_fixed)-				    , (a_type, k_cdata)-				    , (a_default, (xsdParam xsd_enumeration sc))-				    ]-				  , [])-    | isScEnum sc		= ( [ (a_kind, k_required)-				    , (a_type, k_enumeration)-				    ]-				  , map (\ n -> XN.mkDTDElem NAME [(a_name, n)] []) enums-				  )-    | isScCharData sc		= ( [ (a_kind, k_required)-				    , (a_type, d_type)-				    ]-				  , [])-    | isScOpt sc		= (addEntry a_kind k_implied al, cl)-    | isScList sc		= (addEntry a_type k_nmtokens al, cl)-    | otherwise			= ( [ (a_kind, k_fixed)-				    , (a_default, "bad-attribute-type: " ++ show sc)-				    ]-				  , [] )+    | isScFixed sc              = ( [ (a_kind, k_fixed)+                                    , (a_type, k_cdata)+                                    , (a_default, (xsdParam xsd_enumeration sc))+                                    ]+                                  , [])+    | isScEnum sc               = ( [ (a_kind, k_required)+                                    , (a_type, k_enumeration)+                                    ]+                                  , map (\ n -> XN.mkDTDElem NAME [(a_name, n)] []) enums+                                  )+    | isScCharData sc           = ( [ (a_kind, k_required)+                                    , (a_type, d_type)+                                    ]+                                  , [])+    | isScOpt sc                = (addEntry a_kind k_implied al, cl)+    | isScList sc               = (addEntry a_type k_nmtokens al, cl)+    | otherwise                 = ( [ (a_kind, k_fixed)+                                    , (a_default, "bad-attribute-type: " ++ show sc)+                                    ]+                                  , [] )     where-    (al, cl)			= scAttrToXml (sc_1 sc)+    (al, cl)                    = scAttrToXml (sc_1 sc)     d_type-	| sc == scNmtoken	= k_nmtoken-	| otherwise		= k_cdata-    enums			= words . xsdParam xsd_enumeration $ sc+        | sc == scNmtoken       = k_nmtoken+        | otherwise             = k_cdata+    enums                       = words . xsdParam xsd_enumeration $ sc -checkErr			:: Bool -> String -> XmlTrees-checkErr True s			= [XN.mkError c_err s]-checkErr _    _			= []+checkErr                        :: Bool -> String -> XmlTrees+checkErr True s                 = [XN.mkError c_err s]+checkErr _    _                 = [] -foundErr			:: String -> XmlTrees-foundErr			= checkErr True+foundErr                        :: String -> XmlTrees+foundErr                        = checkErr True  -- ------------------------------------------------------------  -- | convert a pickler schema into a DTD descr -dtdDescr	:: Schema -> DTDdescr+dtdDescr        :: Schema -> DTDdescr dtdDescr sc     = DTDdescr rt es1 as     where@@ -274,32 +274,32 @@     as  = filter (not. null . snd) . concatMap attrDec $ es     rt  = fromMaybe "" . elemName $ sc -elementDeclarations	:: Schema -> Schemas-elementDeclarations sc	= elemRefs . elementDecs [] $ [sc]+elementDeclarations     :: Schema -> Schemas+elementDeclarations sc  = elemRefs . elementDecs [] $ [sc] -elementDecs		:: Schemas -> Schemas -> Schemas+elementDecs             :: Schemas -> Schemas -> Schemas elementDecs es []     = es elementDecs es (s:ss)     = elementDecs (elemDecs s) ss     where-    elemDecs (Seq scs)		= elementDecs es scs-    elemDecs (Alt scs)		= elementDecs es scs-    elemDecs (Rep _ _ sc)	= elemDecs sc+    elemDecs (Seq scs)          = elementDecs es scs+    elemDecs (Alt scs)          = elementDecs es scs+    elemDecs (Rep _ _ sc)       = elemDecs sc     elemDecs e@(Element n sc)-	| n `elem` elemNames es	= es-	| otherwise             = elementDecs (e:es) [sc]-    elemDecs _			= es+        | n `elem` elemNames es = es+        | otherwise             = elementDecs (e:es) [sc]+    elemDecs _                  = es -elemNames		:: Schemas -> [Name]+elemNames               :: Schemas -> [Name] elemNames               = concatMap (maybeToList . elemName) -elemName		:: Schema -> Maybe Name+elemName                :: Schema -> Maybe Name elemName (Element n _)  = Just n elemName _              = Nothing -elemRefs	:: Schemas -> Schemas-elemRefs	= map elemRef+elemRefs        :: Schemas -> Schemas+elemRefs        = map elemRef     where     elemRef (Element n sc)   = Element n (pruneElem sc)     elemRef sc               = sc@@ -309,16 +309,16 @@     pruneElem (Rep l u sc)   = Rep l u (pruneElem sc)     pruneElem sc             = sc -attrDec			:: Schema -> [(Name, Schemas)]+attrDec                 :: Schema -> [(Name, Schemas)] attrDec (Element n sc)     = [(n, attrDecs sc)]       where-      attrDecs a@(Attribute _ _)	= [a]-      attrDecs (Seq scs)		= concatMap attrDecs scs-      attrDecs _			= []-attrDec _		= []+      attrDecs a@(Attribute _ _)        = [a]+      attrDecs (Seq scs)                = concatMap attrDecs scs+      attrDecs _                        = []+attrDec _               = [] -remAttrDec		:: Schema -> Schema+remAttrDec              :: Schema -> Schema remAttrDec (Element n sc)     = Element n (remA sc)       where