hxt-xslt 8.5.2 → 9.0.0

raw patch · 10 files changed

+460/−503 lines, 10 filesdep ~hxtdep ~hxt-xpathPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: hxt, hxt-xpath

API changes (from Hackage documentation)

Files

• LICENCE +0/−9
• LICENSE +9/−0
• examples/hparser/HXmlParser.hs +53/−70
• hxt-xslt.cabal +16/−15
• src/Text/XML/HXT/XSLT/Application.hs +98/−99
• src/Text/XML/HXT/XSLT/Common.hs +84/−84
• src/Text/XML/HXT/XSLT/Compilation.hs +42/−42
• src/Text/XML/HXT/XSLT/CompiledStylesheet.hs +28/−29
• src/Text/XML/HXT/XSLT/Names.hs +12/−13
• src/Text/XML/HXT/XSLT/XsltArrows.hs +118/−142

@@ -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.

@@ -2,7 +2,7 @@  {- |    Module     : HXmlParser-   Copyright  : Copyright (C) 2005 Uwe Schmidt+   Copyright  : Copyright (C) 2005-2010 Uwe Schmidt    License    : MIT     Maintainer : Uwe Schmidt@@ -27,16 +27,14 @@ module Main where -import Text.XML.HXT.Arrow+import Text.XML.HXT.Core import Text.XML.HXT.XSLT               ( xsltApplyStylesheetFromURI ) -import System.IO			-- import the IO and commandline option stuff+import System.IO                        -- import the IO and commandline option stuff import System.Environment import System.Console.GetOpt import System.Exit -import Data.Maybe- -- ------------------------------------------------------------  -- |@@ -45,16 +43,16 @@ main :: IO () main     = do-      argv <- getArgs					-- get the commandline arguments-      (al, src) <- cmdlineOpts argv			-- and evaluate them, return a key-value list-      [rc]  <- runX (parser al src)			-- run the parser arrow-      exitProg (rc >= c_err)				-- set return code and terminate+      argv <- getArgs                                   -- get the commandline arguments+      (al, src) <- cmdlineOpts argv                     -- and evaluate them, return a key-value list+      [rc]  <- runX (parser al src)                     -- run the parser arrow+      exitProg (rc >= c_err)                            -- set return code and terminate  -- ------------------------------------------------------------ -exitProg	:: Bool -> IO a-exitProg True	= exitWith (ExitFailure (-1))-exitProg False	= exitWith ExitSuccess+exitProg        :: Bool -> IO a+exitProg True   = exitWith (ExitFailure (-1))+exitProg False  = exitWith ExitSuccess  -- ------------------------------------------------------------ @@ -64,107 +62,92 @@ -- get wellformed document, validates document, propagates and check namespaces -- and controls output -parser	:: Attributes -> String -> IOSArrow b Int-parser al src-    = readDocument al src+parser  :: SysConfigList -> String -> IOSArrow b Int+parser config src+    = configSysVars config                              -- set all global config options, the output file and all+      >>>                                               -- other user options are stored as key-value pairs in the system state+                                                        -- and can be referenced with "getSysAttr"+      readDocument [] src                               -- no more special read options needed       >>>       ( ( traceMsg 1 "start processing document"-	  >>>-	  processDocument al-	  >>>-	  traceMsg 1 "document processing finished"-	)-	`when`-	documentStatusOk+          >>>+          ( processDocument $< getSysAttr "xslt" )      -- ask for the xslt schema to be applied+          >>>+          traceMsg 1 "document processing finished"+        )+        `when`+        documentStatusOk       )       >>>       traceSource       >>>       traceTree       >>>-      writeDocument al (fromMaybe "-" . lookup a_output_file $ al) `whenNot` hasAttr "no-output"+      ( writeDocument [] $< getSysAttr "output-file" )  -- ask for the output file stored in the system configuration       >>>       getErrStatus  -- simple example of a processing arrow -processDocument	:: Attributes -> IOSArrow XmlTree XmlTree-processDocument al-    | applyXSLT-	= traceMsg 1 ("applying XSLT stylesheet " ++ show xsltUri)-	  >>>-	  xsltApplyStylesheetFromURI xsltUri-    | extractText-	= traceMsg 1 "selecting plain text"-	  >>>-	  processChildren (deep isText)-    | otherwise-	= this-    where-    applyXSLT	= hasEntry "xslt"	  $ al-    extractText	= optionIsSet "show-text" $ al-    xsltUri     = lookup1 "xslt"          $ al+processDocument :: String -> IOSArrow XmlTree XmlTree+processDocument xsltUri+    = traceMsg 1 ("applying XSLT stylesheet " ++ show xsltUri)+      >>>+      xsltApplyStylesheetFromURI $< getSysAttr xsltUri  -- ------------------------------------------------------------ -- -- the options definition part -- see doc for System.Console.GetOpt -progName	:: String-progName	= "HXmlParser"+progName        :: String+progName        = "HXmlParser"     -options 	:: [OptDescr (String, String)]+options         :: [OptDescr SysConfig] options     = generalOptions       ++       inputOptions       ++-      relaxOptions-      ++       outputOptions       ++-      [ Option ""	["xslt"]		(ReqArg (att "xslt") "STYLESHEET")	"STYLESHEET is the uri of the XSLT stylesheet to be applied"-      , Option "q"	["no-output"]		(NoArg  ("no-output", "1"))		"no output of resulting document"-      , Option "x"	["show-text"]		(NoArg	("show-text", "1"))		"output only the raw text, remove all markup"+      [ Option "" ["xslt"] (ReqArg (withSysAttr "xslt") "STYLESHEET") "STYLESHEET is the uri of the XSLT stylesheet to be applied"       ]       ++       showOptions-    where-    att n v = (n, v) -usage		:: [String] -> IO a+usage           :: [String] -> IO a usage errl     | null errl-	= do-	  hPutStrLn stdout use-	  exitProg False+        = do+          hPutStrLn stdout use+          exitProg False     | otherwise-	= do-	  hPutStrLn stderr (concat errl ++ "\n" ++ use)-	  exitProg True+        = do+          hPutStrLn stderr (concat errl ++ "\n" ++ use)+          exitProg True     where-    header = "HXmlParser - Validating XML Parser of the Haskell XML Toolbox with Arrow Interface\n" ++-             "XML well-formed checker, DTD validator, Relax NG validator and XSLT transformer.\n\n" +++    header = "HXT XSLT Transformer\n\n" ++              "Usage: " ++ progName ++ " [OPTION...] [URI or FILE]"     use    = usageInfo header options -cmdlineOpts 	:: [String] -> IO (Attributes, String)+cmdlineOpts     :: [String] -> IO (SysConfigList, String) cmdlineOpts argv     = case (getOpt Permute options argv) of       (ol,n,[])-	  -> do-	     sa <- src n-	     help (lookup a_help ol) sa-	     return (ol, sa)+          -> do+             sa <- src n+             help (getConfigAttr a_help ol) sa+             return (ol, sa)       (_,_,errs)-	  -> usage errs+          -> usage errs     where-    src []	= return []-    src [uri]	= return uri-    src _	= usage ["only one input uri or file allowed\n"]+    src []      = return []+    src [uri]   = return uri+    src _       = usage ["only one input uri or file allowed\n"] -    help (Just _) _	= usage []-    help Nothing []	= usage ["no input uri or file given\n"]-    help Nothing _	= return ()+    help "1" _     = usage []+    help _  []     = usage ["no input uri or file given\n"]+    help _  _      = return ()  -- ------------------------------------------------------------

@@ -1,17 +1,18 @@ -- arch-tag: Haskell XML Toolbox XSLT Module-name: hxt-xslt-version: 8.5.2-license: OtherLicense-license-file: LICENCE-maintainer: Uwe Schmidt <uwe@fh-wedel.de>-stability: experimental-category: XML-synopsis: The XSLT modules for HXT.-description:  The Haskell XML Toolbox XSLT library. Since version 8.4 this library is packed in a separate package.-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-xslt+Version:        9.0.0+Synopsis:       The XSLT modules for HXT.+Description:    The Haskell XML Toolbox XSLT library.+License:        OtherLicense+License-file:   LICENSE+Author:         Tim Walkenhorst+Maintainer:     Uwe Schmidt <uwe@fh-wedel.de>+Stability:      Experimental+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/hparser/HXmlParser.hs@@ -86,6 +87,6 @@                 directory  >= 1   && < 2,                 filepath   >= 1   && < 2,                 parsec     >= 2.1 && < 4,-                hxt        >= 8.5 && < 9,-                hxt-xpath  >= 8.5 && < 9+                hxt        >= 9   && < 10,+                hxt-xpath  >= 9   && < 10 

@@ -8,7 +8,6 @@    Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)    Stability  : experimental    Portability: portable-   Version    : $Id: Application.hs,v 1.7 2007/05/02 06:41:05 hxml Exp $     The transformation functions for XSLT transformation of XML documents @@ -18,7 +17,7 @@  -- ------------------------------------------------------------ -module Text.XML.HXT.XSLT.Application +module Text.XML.HXT.XSLT.Application     ( applyStylesheet        -- CompiledStylesheet -> XmlTree -> [XmlTree]     , applyStylesheetWParams -- Map ExName Expr -> CompiledStylesheet -> XmlTree -> [XmlTree]     , XPathParams@@ -31,7 +30,7 @@ import           Data.Char import           Data.List import           Data.Map                     (Map)-import qualified Data.Map 	as Map hiding (Map)+import qualified Data.Map       as Map hiding (Map) import           Data.Maybe  -- just for debugging@@ -47,7 +46,7 @@ type ParamSet = VariableSet  data Context = Ctx NavXmlTree               -- current node-                   [NavXmlTree]             -- current node list +                   [NavXmlTree]             -- current node list                    Int                      -- pos. of curr-node 1..length                    Int                      -- length of node list                    VariableSet              -- glob. Var@@ -98,10 +97,10 @@ processContext CtxEmpty _f = [] processContext ctx@(Ctx _node nodeList pos len globVar locVar cs rl rd) f     | pos > len-	= []+        = []     | otherwise-	= f ctx ++ processContext (Ctx (nodeList!!pos) nodeList (pos+1) len globVar locVar cs rl rd) f-                 +        = f ctx ++ processContext (Ctx (nodeList!!pos) nodeList (pos+1) len globVar locVar cs rl rd) f+ incRecDepth :: Context -> Context incRecDepth CtxEmpty = CtxEmpty incRecDepth (Ctx n nl p l gl lc cs rl rd) = Ctx n nl p l gl lc cs rl (rd+1)@@ -109,13 +108,13 @@ recDepth :: Context -> Int recDepth (Ctx _ _ _ _ _ _ _ _ rd) = rd recDepth CtxEmpty = 0-                 + -- ----------------  evalXPathExpr :: Expr -> Context -> XPathValue evalXPathExpr expr (Ctx node _ pos len globVars locVars _ _ _)     = filterXPath $ evalExpr (vars,[]) (pos, len, node) expr (XPVNode . singletonNodeSet $ node)-    where +    where     filterXPath (XPVError err)    = error err     -- filterXPath (XPVNode nodes)   = XPVNode $ (\x -> fst x ++ snd x) $ partition (isAttr . subtreeNT) nodes     -- this has been moved to applySelect, that's the point where the node set is converted inot a list of trees@@ -137,8 +136,8 @@  -- ------------------------------------------------------------ -applySelect 				:: SelectExpr -> Context -> [NavXmlTree]-applySelect				= applySelect'+applySelect                             :: SelectExpr -> Context -> [NavXmlTree]+applySelect                             = applySelect'  {- just for debugging applySelect e@(SelectExpr expr) ctx = trace msg2 $ res@@ -151,16 +150,16 @@ -}  applySelect' :: SelectExpr -> Context -> [NavXmlTree]-applySelect' (SelectExpr expr) ctx = +applySelect' (SelectExpr expr) ctx =     extractNodes xpathResult-  where +  where     xpathResult                  = evalXPathExpr expr ctx      extractNodes (XPVNode nodes) = attributesFirst . fromNodeSet $ nodes-    extractNodes r               = error $ "XPATH-Expression in select or match attribute returned a value of the wrong type ("              +    extractNodes r               = error $ "XPATH-Expression in select or match attribute returned a value of the wrong type ("                                            ++ take 15 (show r)  ++ "...)" -    attributesFirst		 = uncurry (++) . partition (isAttr . subtreeNT)+    attributesFirst              = uncurry (++) . partition (isAttr . subtreeNT)  -- ------------------------------------------------------------ @@ -178,35 +177,35 @@     where     matchBySelect :: SelectExpr -> NavXmlTree -> Context -> Bool     matchBySelect _ _ CtxEmpty = False-    matchBySelect expr' matchNode ctx'  -	| matchNode `isNotInNodeList` applySelect expr' ctx'-	    = matchBySelect expr' matchNode $ ctxSetNodes (maybeToList $ upNT $ ctxGetNode ctx') ctx'+    matchBySelect expr' matchNode ctx'+        | matchNode `isNotInNodeList` applySelect expr' ctx'+            = matchBySelect expr' matchNode $ ctxSetNodes (maybeToList $ upNT $ ctxGetNode ctx') ctx'         | otherwise-	    = True   +            = True  -- ------------------------------------  applyComputedQName :: ComputedQName -> Context -> QName -applyComputedQName (LiteralQName qName) ctx = +applyComputedQName (LiteralQName qName) ctx =     lookupAlias (getAliases $ ctxGetStylesheet ctx) qName  applyComputedQName (CompQName uris nameATV nsATV) ctx =     if null nsuri && not (null pref)     then mkQName pref loc $ lookupPrefix uris pref     else mkQName pref loc nsuri-  where       -    nsuri         = applyStringExpr nsATV ctx   -    (pref, loc)   = if null loc' then ("", pref') +  where+    nsuri         = applyStringExpr nsATV ctx+    (pref, loc)   = if null loc' then ("", pref')                                  else (pref', tail loc')     (pref', loc') = span (/=':') $ applyStringExpr nameATV ctx  -- ------------------------------------- + applyComposite :: Template -> Context -> [XmlTree] applyComposite (TemplComposite templates) ctx     = concat $ reverse $ fst $ foldl applyElem ([], ctx) templates-    where +    where     applyElem :: ([[XmlTree]], Context) -> Template -> ([[XmlTree]], Context)     applyElem (nodes, ctx') (TemplVariable v) = (nodes, processLocalVariable v Map.empty ctx')     applyElem (nodes, ctx') t                 = (applyTemplate t ctx' : nodes, ctx')@@ -217,14 +216,14 @@ applyForEach :: Template -> Context -> [XmlTree] applyForEach (TemplForEach expr sorting template) ctx     = processContext sortedCtx $ applyTemplate template-    where +    where     sortedCtx = applySorting sorting ctxWOrule nodes     ctxWOrule = ctxSetRule Nothing $ ctx     nodes     = applySelect expr ctx  applyForEach _ _ = [] -         + applyChoose :: Template -> Context -> [XmlTree] applyChoose (TemplChoose whenList) ctx     = applyWhenList whenList ctx@@ -236,16 +235,16 @@ applyWhenList []  _ = [] applyWhenList ((WhenPart expr template):xs) ctx     | applyTest expr ctx-	= applyTemplate template ctx+        = applyTemplate template ctx     | otherwise-	= applyWhenList xs ctx+        = applyWhenList xs ctx  applyMessage :: Template -> Context -> [XmlTree] applyMessage (TemplMessage halt template) ctx     | halt-	= error $ "Message(fatal): " ++ msg+        = error $ "Message(fatal): " ++ msg     | otherwise-	= []	-- trace ("Message(trace): " ++ msg) []+        = []    -- trace ("Message(trace): " ++ msg) []     where     msg     = showTrees content     content = applyTemplate template ctx@@ -257,7 +256,7 @@ applyElement :: Template -> Context -> [XmlTree] applyElement (TemplElement compQName uris attribSets template) ctx =     return $ createElement name uris aliases fullcontent-  where +  where     aliases     = getAliases $ ctxGetStylesheet ctx     name        = applyComputedQName compQName ctx     fullcontent = applyAttribSets [] attribSets ctx ++ applyTemplate template ctx@@ -270,23 +269,23 @@ createElement :: QName -> UriMapping -> NSAliasing -> [XmlTree] -> XmlTree createElement name uris aliases fullcontent =     mkElement name (nsAttrs ++ distinctAttribs) content-  where +  where     nsAttrs            = uriMap2Attrs $ aliasUriMapping aliases uris-    distinctAttribs    = nubBy eqAttr $ reverse attribs +    distinctAttribs    = nubBy eqAttr $ reverse attribs     (attribs, content) = span (isAttr) fullcontent-    eqAttr node1 node2 = equivQName (fromJust $ getAttrName node1) (fromJust $ getAttrName node2)  +    eqAttr node1 node2 = equivQName (fromJust $ getAttrName node1) (fromJust $ getAttrName node2)   applyAttribute :: Template -> Context -> [XmlTree] applyAttribute (TemplAttribute compQName template) ctx =     return $ mkAttr qName content-  where +  where     qName   = applyComputedQName compQName ctx     content = applyTemplate template ctx  applyAttribute _ _ = [] -  + applyText :: Template -> Context -> [XmlTree] applyText (TemplText s) _     = [mkText s]@@ -302,7 +301,7 @@   applyComment :: Template -> Context -> [XmlTree]-applyComment (TemplComment content) ctx = +applyComment (TemplComment content) ctx =     return $ mkCmt $ format $ collectTextnodes $ applyTemplate content ctx   where     format ""           = ""               -- could probably move to hxt...?@@ -316,7 +315,7 @@ applyProcInstr (TemplProcInstr nameExpr template) ctx =     return $ mkPi (mkName name) [mkText . format . collectTextnodes . applyTemplate template $ ctx]   where-    name      = applyStringExpr nameExpr ctx      +    name      = applyStringExpr nameExpr ctx     format ""           = ""                       -- In a better Haskell: format = replaceAll "?>" "? >"     format ('?':'>':xs) = '?':' ':'>':format xs    -- could probably move to hxt...?     format (x:xs)       = x:format xs@@ -328,7 +327,7 @@ applyApplTempl :: Template -> Context -> [XmlTree] applyApplTempl (TemplApply expr mode args sorting) ctx =     applyMatchRulesToEntireContext params rules mode sortedCtx-  where +  where     params      = createParamSet args ctx     sortedCtx   = applySorting sorting ctx nodes     nodes       = maybe (getChildrenNT $ ctxGetNode ctx)@@ -340,7 +339,7 @@   applyImports :: Template -> Context -> [XmlTree]-applyImports (TemplApplyImports) ctx= +applyImports (TemplApplyImports) ctx=     applyMatchRules Map.empty rules mode ctx   where     rules    = getRuleImports currRule@@ -365,12 +364,12 @@  applyCopy :: Template -> Context -> [XmlTree] applyCopy (TemplCopy attrsets template) ctx-    | isRoot currNode			-- Case 1: Root node => just use the content template-	= applyTemplate template ctx-    | isElem currNode			-- Case 2: Any other element-node-	= return $ createElement name (getUriMap currNode) Map.empty fullcontent-    | otherwise				-- Just return the current node as result-	= return currNode        +    | isRoot currNode                   -- Case 1: Root node => just use the content template+        = applyTemplate template ctx+    | isElem currNode                   -- Case 2: Any other element-node+        = return $ createElement name (getUriMap currNode) Map.empty fullcontent+    | otherwise                         -- Just return the current node as result+        = return currNode   where     currNode    = subtreeNT $ ctxGetNode ctx     name        = fromJust $ getElemName currNode@@ -383,19 +382,19 @@     = concatMap expandRoot . xPValue2XmlTrees . evalXPathExpr expr     where     expandRoot node-	| isRoot node	= getChildren node-        | otherwise	= return node+        | isRoot node   = getChildren node+        | otherwise     = return node  applyCopyOf _ = const []  -- ------------------------------------------------------------  applyTemplate :: Template -> Context -> [XmlTree]-applyTemplate				= applyTemplate'+applyTemplate                           = applyTemplate'  {- just for debugging applyTemplate t ctx-					= trace msg2 $ res+                                        = trace msg2 $ res                                           where                                           res = applyTemplate' t $ trace msg1 ctx                                           msg1 = unlines [ "applyTemplate begin"@@ -424,13 +423,13 @@ applyTemplate' t@(TemplCall _ _)        = applyCallTempl t applyTemplate' t@(TemplCopy _ _)        = applyCopy t applyTemplate' t@(TemplCopyOf _)        = applyCopyOf t-applyTemplate'   (TemplVariable _)      = const []	-- trace ("Warning: Unreacheable variable: " ++ show (getVarName v)) const []+applyTemplate'   (TemplVariable _)      = const []      -- trace ("Warning: Unreacheable variable: " ++ show (getVarName v)) const []  -- ------------------------------------------------------------ -- "Main" :  applyStylesheetWParams :: XPathParams -> CompiledStylesheet -> XmlTree -> [XmlTree]-applyStylesheetWParams inputParams cs@(CompStylesheet matchRules _ vars _ strips _) rawDoc = +applyStylesheetWParams inputParams cs@(CompStylesheet matchRules _ vars _ strips _) rawDoc =     map fixupNS $ applyMatchRules Map.empty matchRules Nothing ctxRoot   where     ctxRoot   = Ctx docNode [docNode] 1 1 gloVars Map.empty cs Nothing 0@@ -445,7 +444,7 @@ -- calling named- and applying match-rules  applyMatchRulesToChildren :: ParamSet -> [MatchRule] -> (Maybe ExName) -> Context -> [XmlTree]-applyMatchRulesToChildren args rules mode ctx = +applyMatchRulesToChildren args rules mode ctx =     applyMatchRulesToEntireContext args rules mode childCtx   where     childCtx = ctxSetNodes (getChildrenNT $ ctxGetNode ctx) ctx@@ -455,8 +454,8 @@  applyMatchRules :: ParamSet -> [MatchRule] -> (Maybe ExName) -> Context -> [XmlTree] applyMatchRules _    []           mode ctx = matchDefaultRules mode ctx-applyMatchRules args (rule:rules) mode ctx = -    maybe (applyMatchRules args rules mode ctx) +applyMatchRules args (rule:rules) mode ctx =+    maybe (applyMatchRules args rules mode ctx)           id           (applyMatchRule args rule mode ctx) @@ -470,33 +469,33 @@ instantiateMatchRule :: ParamSet -> MatchRule -> Context -> [XmlTree] instantiateMatchRule args (MatRule _ _ _ _ params content) ctx =     applyTemplate content ctxNew-  where +  where     ctxNew = incRecDepth $ processParameters params args $ clearLocalVariables ctx  instantiateNamedRule :: ParamSet -> NamedRule -> Context -> [XmlTree] instantiateNamedRule args (NamRule _ params content) ctx =     applyTemplate content ctxNew-  where +  where     ctxNew = incRecDepth $ processParameters params args $ clearLocalVariables ctx  -- -------------------------------------    + matchDefaultRules :: (Maybe ExName) -> Context -> [XmlTree] matchDefaultRules mode ctx@(Ctx ctxNavNode _ _ _ _ _ stylesheet _ _)-    | isElem ctxNode				-- rules for match="*|/"-	= applyMatchRulesToChildren Map.empty rules mode ctx -    | isText ctxNode				-- rule for match="text()"-	= [ctxNode]-    | isAttr ctxNode				-- rule for match="@*"-	= [mkText $ collectTextnodes $ getChildren ctxNode]-    | otherwise					-- the glorious rest (PIs and comments):-	= []-    where +    | isElem ctxNode                            -- rules for match="*|/"+        = applyMatchRulesToChildren Map.empty rules mode ctx+    | isText ctxNode                            -- rule for match="text()"+        = [ctxNode]+    | isAttr ctxNode                            -- rule for match="@*"+        = [mkText $ collectTextnodes $ getChildren ctxNode]+    | otherwise                                 -- the glorious rest (PIs and comments):+        = []+    where     rules   = getMatchRules stylesheet     ctxNode = subtreeNT ctxNavNode  matchDefaultRules _ _ = []-  + -- ------------------------------------  -- Variables and Parameters@@ -505,7 +504,7 @@ -- created local variable to the context  processLocalVariable :: Variable -> ParamSet -> Context -> Context-processLocalVariable var@(MkVar _ name _) arguments ctx =    +processLocalVariable var@(MkVar _ name _) arguments ctx =     addVariableBinding name val ctx   where     val = evalVariableWParamSet arguments ctx var@@ -517,9 +516,9 @@ evalVariableWParamSet :: ParamSet -> Context -> Variable -> XPathValue evalVariableWParamSet ps ctx (MkVar isPar name exprOrRtf)     | isPar-	= maybe (resultFromVar exprOrRtf) id $ Map.lookup name ps +        = maybe (resultFromVar exprOrRtf) id $ Map.lookup name ps     | otherwise-	= resultFromVar exprOrRtf+        = resultFromVar exprOrRtf   where     resultFromVar (Left expr) = evalXPathExpr expr ctx     resultFromVar (Right rtf) = evalRtf rtf (show (recDepth ctx) ++ " " ++ show name) ctx@@ -540,25 +539,25 @@     if name `elem` callstack     then error $ "Attribute-Set " ++ show name ++ " is recursively used." ++                  concatMap (("\n  used in "++) . show) callstack-    +     else if isNothing attrset     then error $ "No attribute set with name: " ++ show name-    +     else concatMap (flip (applyAttribSet (name:callstack)) ctx) $ fromJust attrset    where     attrset = Map.lookup name $ getAttributeSets $ ctxGetStylesheet ctx  applyAttribSet :: [ExName] -> AttributeSet -> Context -> [XmlTree]-applyAttribSet callstack (AttribSet _ usedSets content) ctx = +applyAttribSet callstack (AttribSet _ usedSets content) ctx =     applyAttribSets callstack usedSets ctx ++ applyTemplate content ctx-    + -- ------------------------------------ -- Sorting  applySorting :: [SortKey] -> Context -> [NavXmlTree] -> Context applySorting [] ctx nodes = ctxSetNodes nodes ctx-applySorting sortKeys ctx nodes = +applySorting sortKeys ctx nodes =     ctxSetNodes resultOrder ctx   where     resultOrder          = snd $ unzip sortedKVs@@ -580,14 +579,14 @@ applySortKey (SortK expr typeATV orderATV) ctx     | typ /= "number"       &&-      typ /= "text" -	  = error $ "unsupported type in xsl:sort: " ++ typ+      typ /= "text"+          = error $ "unsupported type in xsl:sort: " ++ typ     | ordering /="ascending"       &&       ordering /="descending"-	  = error $ "order in xsl:sort element must be ascending or descending. Found: " ++ ordering+          = error $ "order in xsl:sort element must be ascending or descending. Found: " ++ ordering     | otherwise-	= (extractFct, cmpFct)+        = (extractFct, cmpFct)     where     isNum          = typ == "number"     isDesc         = ordering == "descending"@@ -595,27 +594,27 @@     typ            = applyStringExpr typeATV ctx      extractFct ctx'-	= let-	  val = applyStringExpr expr ctx'-	  in+        = let+          val = applyStringExpr expr ctx'+          in           if isNum           then Left $ readWDefault (-1.0 / 0.0) val           else Right val      cmpFct a-	= ( if isDesc then invertOrd else id ) +        = ( if isDesc then invertOrd else id )           .           ( if isNum then cmpNum a else cmpString a )      cmpNum (Left n1)  (Left n2)-	= compare n1 n2+        = compare n1 n2     cmpNum _ _-	= error "internal error in cmpNum in applySortKey"+        = error "internal error in cmpNum in applySortKey"      cmpString (Right s1) (Right s2)-	= compare (map toLower s1) (map toLower s2)      -- The text comparison still needs to be improved...+        = compare (map toLower s1) (map toLower s2)      -- The text comparison still needs to be improved...     cmpString _ _-	= error "internal error in cmpString in applySortKey"+        = error "internal error in cmpString in applySortKey"  invertOrd :: Ordering -> Ordering invertOrd EQ = EQ@@ -629,20 +628,20 @@ fixupNS = compressNS . disambigNS  compressNS :: XmlTree -> XmlTree-compressNS = +compressNS =     mapTreeCtx compressElem $ Map.fromAscList [("xml", xmlNamespace), ("xmlns", xmlnsNamespace)]-  + compressElem :: UriMapping -> XNode -> (UriMapping, XNode) compressElem uris node   | isElem node = (newUris, changeAttrl (filter $ isImportant) node)   | otherwise   = (uris, node)   where     newUris       = uris `Map.union` getUriMap node-    isImportant n = not (isNsAttr n) +    isImportant n = not (isNsAttr n)                          || not ((localPart $ fromJust $ getAttrName n) `Map.member` uris)  disambigNS :: XmlTree -> XmlTree-disambigNS = +disambigNS =     mapTreeCtx step $ Map.fromAscList [("xml", xmlNamespace), ("xmlns", xmlnsNamespace)]   where     step uris node@@ -652,8 +651,8 @@       | otherwise   = (uris, node)  disambigElem :: UriMapping -> XNode -> (UriMapping, XNode)-disambigElem nsMap element =    -    (newNsMap, XTag                  +disambigElem nsMap element =+    (newNsMap, XTag                  (remapNsName newNsMap $ fromJust $ getElemName element)                  $ map (changeName $ remapNsName newNsMap) $ fromJust $ getAttrl element )   where@@ -663,7 +662,7 @@                    (element : map getNode (fromJust $ getAttrl element))     newPrefs   = filter (`notElem` oldPrefs) ["ns" ++ show i | i <- [(1::Int)..]]     oldPrefs   = Map.keys nsMap-    oldUris    = Map.elems nsMap  +    oldUris    = Map.elems nsMap  remapNsName :: UriMapping -> QName -> QName remapNsName nsMap name@@ -672,8 +671,8 @@       ( isJust luUri         &&         fromJust luUri == nsUri-      )			= name-    | otherwise		= mkQName newPref (localPart name) nsUri+      )                 = name+    | otherwise         = mkQName newPref (localPart name) nsUri {-     if maybe (nsUri=="") (== nsUri) luUri     then name@@ -682,7 +681,7 @@ -}   where     luUri   = Map.lookup (namePrefix name) nsMap-    newPref = head $ (++ (error $ "int. error: No prefix for " ++ show name ++ " " ++ show nsMap ++ " " ++ show luUri ++ " " ++ show nsUri)) +    newPref = head $ (++ (error $ "int. error: No prefix for " ++ show name ++ " " ++ show nsMap ++ " " ++ show luUri ++ " " ++ show nsUri))                 $ Map.keys $ Map.filter (==namespaceUri name) nsMap     nsUri   = namespaceUri name 

@@ -51,8 +51,8 @@     -- Namespace functions     , ExName(ExName)             -- String (local) -> String (uri) -> ExName     , mkExName                   -- QName -> ExName-    , exLocal		         -- ExName -> String-    , exUri		         -- ExName -> String+    , exLocal                    -- ExName -> String+    , exUri                      -- ExName -> String     , parseExName                -- UriMapping -> String -> ExName     , UriMapping                 -- Map String String     , getUriMap                  -- XmlNode n => n -> UriMapping (extract an Ns-Uri Map from an Element node)@@ -85,59 +85,59 @@ import Control.Arrow.ListArrow import Control.Arrow.ArrowList -import Text.XML.HXT.Arrow.XmlArrow	( xshow-					)+import Text.XML.HXT.Arrow.XmlArrow      ( xshow+                                        ) import Text.XML.HXT.DOM.XmlKeywords-import Text.XML.HXT.DOM.XmlNode		( XmlNode (..)-					, mkElement-					, mkRoot-					, mkAttr-					, mergeAttrl-					)+import Text.XML.HXT.DOM.XmlNode         ( XmlNode (..)+                                        , mkElement+                                        , mkRoot+                                        , mkAttr+                                        , mergeAttrl+                                        ) -import Text.XML.HXT.DOM.TypeDefs	( XmlTree-					, XNode(XTag, XAttr)-					, QName-					, toNsEnv-					, namePrefix-					, localPart-					, namespaceUri-					, equivQName-					, mkName-					, mkQName-					)-import Text.XML.HXT.DOM.FormatXmlTree	( formatXmlTree-					)+import Text.XML.HXT.DOM.TypeDefs        ( XmlTree+                                        , XNode(XTag, XAttr)+                                        , QName+                                        , toNsEnv+                                        , namePrefix+                                        , localPart+                                        , namespaceUri+                                        , equivQName+                                        , mkName+                                        , mkQName+                                        )+import Text.XML.HXT.DOM.FormatXmlTree   ( formatXmlTree+                                        )  import Text.XML.HXT.XPath.XPathDataTypes( NavTree-					, ntree-					, subtreeNT-					, upNT-					, downNT-					, rightNT-					, leftNT-					, getChildrenNT+                                        , ntree+                                        , subtreeNT+                                        , upNT+                                        , downNT+                                        , rightNT+                                        , leftNT+                                        , getChildrenNT -                                        , Expr		( LiteralExpr-							, FctExpr-							, GenExpr-							, PathExpr-							)-					, Op		( Union )-					, LocationPath	( LocPath )-					, Path		( Rel )-					, XStep 	( Step )-					, NodeTest	( NameTest-							, PI-							, TypeTest-							)-                                        , NodeSet	(..)-					, NavXmlTree-					, XPathValue	( XPVNode-							, XPVBool-							, XPVString-							, XPVError-							)+                                        , Expr          ( LiteralExpr+                                                        , FctExpr+                                                        , GenExpr+                                                        , PathExpr+                                                        )+                                        , Op            ( Union )+                                        , LocationPath  ( LocPath )+                                        , Path          ( Rel )+                                        , XStep         ( Step )+                                        , NodeTest      ( NameTest+                                                        , PI+                                                        , TypeTest+                                                        )+                                        , NodeSet       (..)+                                        , NavXmlTree+                                        , XPathValue    ( XPVNode+                                                        , XPVBool+                                                        , XPVString+                                                        , XPVError+                                                        )                                         , emptyNodeSet                                         , singletonNodeSet                                         , nullNodeSet@@ -150,38 +150,38 @@                                         , toNodeSet                                         , headNodeSet                                         , withNodeSet-					)-import Text.XML.HXT.XPath.XPathParser	( parseXPath-					)-import Text.XML.HXT.XPath.XPathEval	( evalExpr-					)-import Text.XML.HXT.XPath.XPathFct	( isNotInNodeList-					)+                                        )+import Text.XML.HXT.XPath.XPathParser   ( parseXPath+                                        )+import Text.XML.HXT.XPath.XPathEval     ( evalExpr+                                        )+import Text.XML.HXT.XPath.XPathFct      ( isNotInNodeList+                                        ) import Text.XML.HXT.XPath.XPathToString ( xPValue2XmlTrees-					)+                                        )  import           Data.Map (Map) import qualified Data.Map as Map hiding (Map) -import Data.Tree.Class +import Data.Tree.Class  import Data.Maybe import Data.List import Data.Char ---------------------------- +--------------------------- -- Tree functions  -- mapTree :: Functor t => (a -> b) -> t a -> t b -- mapTree = fmap --- "map" on a tree with a context. +-- "map" on a tree with a context. -- Contextual information from the ancestors of the current node can be collected in the context  mapTreeCtx :: Tree t => (c -> a -> (c, b)) -> c -> t a -> t b-mapTreeCtx f c tree = +mapTreeCtx f c tree =     mkTree b $ map (mapTreeCtx f cN) $ getChildren tree-  where +  where     (cN, b) = f c $ getNode tree  filterTree :: Tree t => (a -> Bool) -> t a -> Maybe (t a)@@ -190,19 +190,19 @@                       else Nothing                     where node = getNode tree --- "filter" on a tree with a context. +-- "filter" on a tree with a context. -- Contextual information from the ancestors of the current node can be collected in the context filterTreeCtx :: Tree t => (c -> a -> (c, Bool)) -> c -> t a -> Maybe (t a) filterTreeCtx p c tree =-  if b +  if b     then Just $ mkTree node $ mapMaybe (filterTreeCtx p cN) $ getChildren tree     else Nothing-  where +  where     (cN, b) = p c node     node    = getNode tree  zipTreeWith   :: Tree t => (a -> b -> c) -> t a -> t b -> t c-zipTreeWith f a b = mkTree (f (getNode a) (getNode b)) +zipTreeWith f a b = mkTree (f (getNode a) (getNode b))                        $ zipWith (zipTreeWith f) (getChildren a) $ getChildren b  zipTree     :: Tree t => t a -> t b -> t (a,b)@@ -211,12 +211,12 @@ unzipTree  :: Functor t => t (a,b) -> (t a, t b) unzipTree   = fmap fst &&& fmap snd -showTrees	:: [XmlTree] -> String+showTrees       :: [XmlTree] -> String showTrees ts-    = concat +    = concat       (runLA (xshow (constL ts)) $ undefined) ---------------------------- +--------------------------- -- Xml Functions  collectTextnodes :: [XmlTree] -> String@@ -239,7 +239,7 @@ tryFetchAttribute node qn   | isElem node = -      if null candidates +      if null candidates       then Nothing        else if length candidates > 1@@ -247,8 +247,8 @@        else Just $ collectTextnodes $ getChildren $ head candidates -  | otherwise = Nothing    -  where +  | otherwise = Nothing+  where     candidates = filter (isAttrType qn) $ fromJust $ getAttrl node  fetchAttributeWDefault ::  XmlNode n => n -> QName -> String -> String@@ -264,14 +264,14 @@ setAttribute qn val node   | isElem node = setElemAttrl (newA : attrs) node   | otherwise   = error $ "setAttribute on none-element node"             -- how print an XmlNode...-  where +  where     attrs = filter (not . isAttrType qn) $ fromJust $ getAttrl node     newA  = mkTree (XAttr qn) [mkText val]  isWhitespaceNode :: (XmlNode n) => n -> Bool isWhitespaceNode = maybe False (all isSpace) . getText ---------------------------- +--------------------------- -- Namespace Functions  -- Expanded name, is unique can therefore be used as a key (unlike QName)@@ -288,11 +288,11 @@  parseExName :: UriMapping -> String -> ExName parseExName uris str-    | noPrefix	= ExName str ""-    | otherwise	= ExName loc $ lookupPrefix uris prefix+    | noPrefix  = ExName str ""+    | otherwise = ExName loc $ lookupPrefix uris prefix     where-    noPrefix       = null loc -    loc            = drop 1 loc'                +    noPrefix       = null loc+    loc            = drop 1 loc'     (prefix, loc') = span (/= ':') str  -- Mapping from namespace-Prefixes to namespace-URIs@@ -379,7 +379,7 @@ -- Intelligent splitting: Split an expression into subexpressions with equal priority -- for example: "a|c/d|e|f/g"  => [(0.0, "a|e"), (0.5, "c/d|f/g")] splitMatchByPrio :: Expr -> [(Float, Expr)]-splitMatchByPrio = +splitMatchByPrio =     map compress . groupBy eq . sortBy cmp . map (computePriority &&& id) . splitExpr   where     eq  x y  = fst x == fst y@@ -393,7 +393,7 @@ computeNTestPriority :: NodeTest -> Float computeNTestPriority (PI _)        =  0.0 computeNTestPriority (TypeTest _)  = -0.5-computeNTestPriority (NameTest nt) +computeNTestPriority (NameTest nt)   | namePrefix nt /= ""     && localPart nt == "*"        = -0.25   | localPart nt == "*"           = -0.5@@ -406,13 +406,13 @@ isMatchExpr (FctExpr "key" [LiteralExpr _, LiteralExpr _]) = True isMatchExpr _                                              = False ---------------------------- +--------------------------- -- Misc:  fromJustErr :: String -> Maybe a -> a-fromJustErr msg = maybe (error msg) id +fromJustErr msg = maybe (error msg) id  readWDefault :: Read a => a -> String -> a readWDefault a str = fst $ head $ reads str ++ [(a, "")] ---------------------------- +---------------------------

@@ -15,7 +15,7 @@  -- ------------------------------------------------------------ -module Text.XML.HXT.XSLT.Compilation +module Text.XML.HXT.XSLT.Compilation     ( prepareXSLTDocument        -- :: XmlTree -> XmlTree     , assembleStylesheet         -- :: XmlTree -> [CompiledStylesheet] -> CompiledStylesheet     )@@ -25,10 +25,10 @@  import           Data.Maybe import           Data.List-import qualified Data.Map 		as Map hiding 	( Map )-import           Data.Map				( Map )+import qualified Data.Map               as Map hiding   ( Map )+import           Data.Map                               ( Map ) -import           Text.ParserCombinators.Parsec.Prim	( runParser )+import           Text.ParserCombinators.Parsec.Prim     ( runParser )  import           Text.XML.HXT.XSLT.Common import           Text.XML.HXT.XSLT.Names@@ -38,7 +38,7 @@  infixl 9 >< -(><)	:: XmlNode n => (UriMapping -> a ) -> n -> a+(><)    :: XmlNode n => (UriMapping -> a ) -> n -> a f >< node     = f $ getUriMap node @@ -46,9 +46,9 @@  parseExpr :: UriMapping -> String -> Expr parseExpr uris selectStr-    = either (error.show) id parseResult                               +    = either (error.show) id parseResult     where-    parseResult = runParser parseXPath (toNsEnv . Map.toList $ uris) ("select-expr:"++selectStr) selectStr +    parseResult = runParser parseXPath (toNsEnv . Map.toList $ uris) ("select-expr:"++selectStr) selectStr  parseSelect :: UriMapping -> String -> SelectExpr parseSelect uris@@ -67,13 +67,13 @@     = if isMatchExpr expr       then MatchExpr expr       else error $ str ++ " is not a legal match-expression"-    where +    where     expr = parseExpr uris str  -- --------------------------  parseAVT :: UriMapping -> String -> StringExpr-parseAVT uris str = +parseAVT uris str =     StringExpr $ concatExpr $ splitAVT str ""   where @@ -88,7 +88,7 @@     splitAVT ('}':_)      _   = error $ "deserted '}' in AVT."     splitAVT (x:xs)       acc = splitAVT xs $ x:acc -    acc2lit :: String -> [Expr] +    acc2lit :: String -> [Expr]     acc2lit ""  = []     acc2lit acc = [mkLiteralExpr $ reverse acc] @@ -98,7 +98,7 @@ compileComputedQName :: XmlTree -> ComputedQName compileComputedQName node =     (CompQName><node) nameAVT nsAVT-  where +  where     nameAVT  = parseAVT><node $ fetchAttribute node xsltName     nsAVT    = parseAVT><node $ fetchAttributeWDefault node xsltNamespace "" @@ -147,35 +147,35 @@ parseExNames urm = map (parseExName urm) . words  compileElement :: XmlTree -> Template-compileElement node = +compileElement node =     TemplElement compQName Map.empty attribSets template-  where +  where     compQName   = compileComputedQName node     attribSets  = UsedAttribSets $ parseExNames><node                   $ fetchAttributeWDefault node xsltUseAttributeSets ""     template    = compileTemplate (getChildren node)  compileAttribute :: XmlTree -> Template-compileAttribute node = +compileAttribute node =     TemplAttribute (compileComputedQName node) $ compileTemplate (getChildren node)  -- compiles xsl:text compileText :: XmlTree -> Template compileText = TemplText . collectTextnodes . getChildren --- compiles textNode +-- compiles textNode compileTextnode :: XmlTree -> Template compileTextnode = TemplText . fromJust . getText  compileValueOf :: XmlTree -> Template-compileValueOf node = +compileValueOf node =     TemplValueOf $ parseStringExpr><node $ fetchAttribute node xsltSelect  compileComment :: XmlTree -> Template compileComment = TemplComment . compileTemplate . getChildren  compileProcInstr :: XmlTree -> Template-compileProcInstr node = +compileProcInstr node =    TemplProcInstr name content   where     name    = parseAVT><node  $ fetchAttribute node xsltName@@ -186,7 +186,7 @@ compileLiteralResultElement :: XmlTree -> Template compileLiteralResultElement node =     TemplElement compQName nsUris attribSets content-  where +  where     nsUris             = extractAddUris node     compQName          = LiteralQName   $ fromJust $ getElemName node     attribSets         = UsedAttribSets $ parseExNames><node $ attrSetsStr@@ -196,11 +196,11 @@     template           = compileTemplate (getChildren node)  compileLREAttribute :: UriMapping -> XmlTree -> Maybe Template-compileLREAttribute uris node = -    if isSpecial +compileLREAttribute uris node =+    if isSpecial       then Nothing-      else Just $ TemplAttribute (LiteralQName name) val  -  where +      else Just $ TemplAttribute (LiteralQName name) val+  where     isSpecial = namespaceUri name `elem` [xsltUri, xmlnsNamespace]     name      = fromJust $ getAttrName node     val       = TemplValueOf $ parseAVT uris $ collectTextnodes $ getChildren node@@ -245,12 +245,12 @@ -- -----------------------------------  compileTemplate :: [XmlTree] -> Template-compileTemplate [node]       = +compileTemplate [node]       =    if isElem node-   then let elemName = fromJust $ getElemName node in        +   then let elemName = fromJust $ getElemName node in         if      equivQName elemName xsltMessage        then compileMessage       node         else if equivQName elemName xsltForEach        then compileForEach       node-        else if equivQName elemName xsltChoose         then compileChoose        node   +        else if equivQName elemName xsltChoose         then compileChoose        node         else if equivQName elemName xsltIf             then compileIf            node         else if equivQName elemName xsltElement        then compileElement       node         else if equivQName elemName xsltAttribute      then compileAttribute     node@@ -285,9 +285,9 @@ assembleStylesheet :: XmlTree -> [CompiledStylesheet] -> CompiledStylesheet assembleStylesheet xslNode imports =     CompStylesheet matchRules namedRules variables attsets strips aliases-  where +  where     -- entire contents:-    (namedRules,    +    (namedRules,      matchRules)          = assembleRules ruleElems importedMatchRules importedNamedRules     variables             = assembleVariables varElems importedVariables     attsets               = assembleAttrSets attsetElems importedAttribSets@@ -315,8 +315,8 @@ assembleRules nodes importedMatches importedProcs =     (resProcs, resMatches)   where-  -  -- matches:  ++  -- matches:     resMatches       = localMatches ++ importedMatches     localMatches     = reverse $ sortBy cmp matches     cmp rulA rulB    = compare (getRulePrio rulA) (getRulePrio rulB)@@ -330,7 +330,7 @@   -- compile all xsl:template's:     (procs, matches) = catMaybes *** concat $ unzip $ map (compileRule importedMatches) nodes -assembleVariables :: [XmlTree] -> [(Map ExName Variable)] -> (Map ExName Variable)       +assembleVariables :: [XmlTree] -> [(Map ExName Variable)] -> (Map ExName Variable) assembleVariables varElems = Map.unions . (compileVariables varElems:)  assembleAttrSets :: [XmlTree] -> [Map ExName [AttributeSet]] -> Map ExName [AttributeSet]@@ -365,20 +365,20 @@ compileRule :: [MatchRule] -> XmlTree -> (Maybe NamedRule, [MatchRule]) compileRule imports node = -    if isNothing match && isNothing name +    if isNothing match && isNothing name     then error "Error: Bogus rule (xsl:template) with neither match nor name attribute is illegal" -    else if isJust mode && isNothing match +    else if isJust mode && isNothing match     then error "Error: Bogus mode attribute on none-match rule is illegal" -    else if isJust priority && isNothing match +    else if isJust priority && isNothing match     then error "Error: Bogus priority attribute on none-match rule is illegal" -    else +    else       (         liftM (\n -> NamRule n params template) name       , concat $ maybeToList $ liftM (assembleMatchRule priority mode imports params template) match-      ) +      )    where     match      = liftM (parseMatch><node)  $ tryFetchAttribute node xsltMatch@@ -395,7 +395,7 @@     if isJust pri     then return $ MatRule mtch (fromJust pri) m imp par tmpl     else map expand $ splitMatchByPrio expr-  where +  where     expand (pri', mtch') = MatRule (MatchExpr mtch') pri' m imp par tmpl  -- -----------------------------------@@ -411,7 +411,7 @@ compileVariable :: XmlTree -> Variable compileVariable node =     MkVar modus name exprOrRtf-  where +  where     modus     = isElemType xsltParam node     name      = parseExName><node $ fetchAttribute node xsltName     exprOrRtf = if hasAttribute node xsltSelect || null (getChildren node)@@ -450,14 +450,14 @@ -- -----------------------------------  compileAlias :: XmlTree -> (String, String)-compileAlias node = +compileAlias node =   (fetchAttribute node xsltStylesheetPrefix, fetchAttribute node xsltResultPrefix)  -- ----------------------------------- -- Document level preprocessing -prepareXSLTDocument	:: XmlTree -> XmlTree-prepareXSLTDocument	= expandExEx . expandNSDecls . stripStylesheet . removePiCmt+prepareXSLTDocument     :: XmlTree -> XmlTree+prepareXSLTDocument     = expandExEx . expandNSDecls . stripStylesheet . removePiCmt  removePiCmt :: XmlTree -> XmlTree removePiCmt = fromJustErr "XSLT: No root element" . filterTree (\n -> not (isPi n) && not (isCmt n))@@ -482,7 +482,7 @@                    then (xsltExlcudeResultPrefixes   , xsltExtensionElementPrefixes   )                    else (xsltExlcudeResultPrefixesLRE, xsltExtensionElementPrefixesLRE) --- parse a prefix list, create a list of uris: +-- parse a prefix list, create a list of uris: -- "pre1 pre2 pre3" -> ["pre1.uri","pre2.uri","pre3.uri"]  parsePreList :: UriMapping -> String -> [String]@@ -492,7 +492,7 @@ -- Extraction of contextual Information from an XML-Node  extractAddUris :: XmlTree -> UriMapping-extractAddUris node = +extractAddUris node =     (Map.filter (`notElem` exclUris))><node   where     exclUris = words $ fetchAttributeWDefault node xsltExlcudeResultPrefixesLRE ""

@@ -8,7 +8,6 @@    Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)    Stability  : experimental    Portability: portable-   Version    : $Id: CompiledStylesheet.hs,v 1.3 2007/05/02 06:41:05 hxml Exp $     Types for compiled stylesheets @@ -17,7 +16,7 @@ -- ------------------------------------------------------------  module Text.XML.HXT.XSLT.CompiledStylesheet-where  +where  import           Text.XML.HXT.XSLT.Common import           Text.XML.HXT.XSLT.Names@@ -31,14 +30,14 @@  -- compiled-Stylesheet: -data CompiledStylesheet = +data CompiledStylesheet =   CompStylesheet-    [MatchRule]                +    [MatchRule]     (Map ExName NamedRule)-    (Map ExName Variable)       -    (Map ExName [AttributeSet]) -    [Strips]                   -    NSAliasing                  +    (Map ExName Variable)+    (Map ExName [AttributeSet])+    [Strips]+    NSAliasing   deriving Show  getMatchRules :: CompiledStylesheet -> [MatchRule]@@ -62,7 +61,7 @@ -- ------------------- -- Match-Rules: -data MatchRule = +data MatchRule =   MatRule MatchExpr           Float           -- priority           (Maybe ExName)  -- mode@@ -73,8 +72,8 @@  instance Show MatchRule where     show (MatRule expr prio mode imprules params content)-	= "MkRule expr: " ++ show expr ++ "\n  prio: " ++ show prio ++ "\n  mode: "++ show mode -	  ++ "\n  no. imported rules: " ++ show (length imprules) ++ "\n  xsl-params: " ++ show params +        = "MkRule expr: " ++ show expr ++ "\n  prio: " ++ show prio ++ "\n  mode: "++ show mode+          ++ "\n  no. imported rules: " ++ show (length imprules) ++ "\n  xsl-params: " ++ show params           ++ "\n  content: " ++ show content ++"\n"  getRulePrio :: MatchRule -> Float@@ -96,13 +95,13 @@ getRuleName (NamRule name _ _)  = name  -- ---------------------- Variables +-- Variables -data Variable = MkVar +data Variable = MkVar                   Bool                   -- modus: False => xsl:variable, True => xsl:param                   ExName                 -- name                   (Either Expr Template) -- select-expression or result tree fragment-		deriving Show+                deriving Show  getVarName :: Variable -> ExName getVarName (MkVar _ name _) = name@@ -122,7 +121,7 @@ -- ------------------- -- Whitespace-stripping -type NTest = ExName +type NTest = ExName  parseNTest :: UriMapping -> String -> NTest parseNTest = parseExName@@ -139,7 +138,7 @@ -- Try to match a qualified name with a set of strip- and preserve-space attributes of the same import precedence:  lookupStrip1 :: ExName -> Strips -> Maybe Bool-lookupStrip1 name spec = +lookupStrip1 name spec =     if      isJust nameMatch then nameMatch     else if isJust prefMatch then prefMatch     else if isJust globMatch then globMatch@@ -150,7 +149,7 @@     globMatch = Map.lookup (ExName "*"  ""          ) spec  feedSpaces :: Bool -> [NTest] -> Strips -> Strips-feedSpaces strip tests = +feedSpaces strip tests =     Map.unionWithKey feedErr $ Map.fromListWithKey feedErr $ zip tests $ repeat strip   where     feedErr k = error $ "Ambiguous strip- or preserve-space rules for " ++ show k@@ -168,15 +167,15 @@     = stripSpaces isStrip True     where     isStrip strip' node-	= not (isElemType xsltText node)-	  &&-	  ( maybe strip' (=="default") $ tryFetchAttribute node xmlSpace )+        = not (isElemType xsltText node)+          &&+          ( maybe strip' (=="default") $ tryFetchAttribute node xmlSpace )  stripSpaces :: (Bool -> XNode -> Bool) -> Bool -> XmlTree -> XmlTree-stripSpaces f def = +stripSpaces f def =     fromJustErr "stripSpaces (internal error)" . filterTreeCtx step def   where-    step strip node +    step strip node      | isElem node           = (f strip node, True)      | isWhitespaceNode node = (strip       , not strip)      | otherwise             = (strip       , True)@@ -200,10 +199,10 @@  lookupAlias :: NSAliasing -> QName -> QName lookupAlias nsm qn-    = mkQName (namePrefix qn) (localPart qn) +    = mkQName (namePrefix qn) (localPart qn)       $ maybe (namespaceUri qn) id       $ Map.lookup (namespaceUri qn) nsm- + aliasUriMapping :: NSAliasing -> UriMapping -> UriMapping aliasUriMapping nsm = Map.map (\uri -> Map.findWithDefault uri uri nsm) @@ -211,14 +210,14 @@ -- Templates:  data Template-    = TemplComposite [Template]   +    = TemplComposite [Template]     | TemplForEach SelectExpr [SortKey] Template     | TemplChoose [When]    -- otherwise will be represented by <xsl:when test="true()"/> in the abstract Syntax     | TemplMessage Bool     -- halt?-                   Template -- content            +                   Template -- content     | TemplElement ComputedQName                    UriMapping              -- Namespaces which *must* be added-                   UsedAttribSets          -- +                   UsedAttribSets          --                    Template                -- content     | TemplAttribute ComputedQName                      Template              -- content@@ -227,7 +226,7 @@     | TemplComment Template     | TemplProcInstr StringExpr       -- name                      Template               -- content-    | TemplApply (Maybe SelectExpr) +    | TemplApply (Maybe SelectExpr)                  (Maybe ExName)  -- mode                  (Map ExName Variable) -- passed arguments                  [SortKey]@@ -247,7 +246,7 @@     deriving Show  data When-    = WhenPart TestExpr Template +    = WhenPart TestExpr Template     deriving Show  data ComputedQName

@@ -8,7 +8,6 @@    Maintainer : Uwe Schmidt (uwe@fh-wedel.de)    Stability  : experimental    Portability: portable-   Version    : $Id: Names.hs,v 1.2 2006/11/11 15:36:05 hxml Exp $     Names and constants for HXSLT @@ -21,11 +20,11 @@  import Text.XML.HXT.XSLT.Common -xsltPrefix	:: String-xsltPrefix	= "xsl"+xsltPrefix      :: String+xsltPrefix      = "xsl" -xsltUri		:: String-xsltUri		= "http://www.w3.org/1999/XSL/Transform"+xsltUri         :: String+xsltUri         = "http://www.w3.org/1999/XSL/Transform"  mkXsltName :: String -> QName mkXsltName name = mkQName xsltPrefix name xsltUri@@ -63,7 +62,7 @@   , xsltSort   , xsltStripSpace   , xsltPreserveSpace-  , xsltNamespaceAlias	:: QName+  , xsltNamespaceAlias  :: QName  xsltTransform                   = mkXsltName "transform" xsltStylesheet                  = mkXsltName "stylesheet"@@ -114,11 +113,11 @@   , xsltResultPrefix   , xsltVersion   , xsltExlcudeResultPrefixes-  , xsltExtensionElementPrefixes	:: QName+  , xsltExtensionElementPrefixes        :: QName -xsltTerminate                   = mkXsltAttribName "terminate" -xsltSelect                      = mkXsltAttribName "select" -xsltTest                        = mkXsltAttribName "test" +xsltTerminate                   = mkXsltAttribName "terminate"+xsltSelect                      = mkXsltAttribName "select"+xsltTest                        = mkXsltAttribName "test" xsltName                        = mkXsltAttribName "name" xsltNamespace                   = mkXsltAttribName "namespace" xsltUseAttributeSets            = mkXsltAttribName "use-attribute-sets"@@ -139,14 +138,14 @@ xsltUseAttributeSetsLRE   , xsltVersionLRE   , xsltExlcudeResultPrefixesLRE-  , xsltExtensionElementPrefixesLRE	:: QName+  , xsltExtensionElementPrefixesLRE     :: QName -xsltUseAttributeSetsLRE         = mkXsltName "use-attribute-sets" +xsltUseAttributeSetsLRE         = mkXsltName "use-attribute-sets" xsltVersionLRE                  = mkXsltName "version" xsltExlcudeResultPrefixesLRE    = mkXsltName "exclude-result-prefixes" xsltExtensionElementPrefixesLRE = mkXsltName "extension-element-prefixes"  -- xml:space attribute-name-xmlSpace	:: QName+xmlSpace        :: QName  xmlSpace                        = mkQName "xml" "space" xmlNamespace

@@ -8,7 +8,6 @@    Maintainer : Uwe Schmidt (uwe@fh-wedel.de)    Stability  : experimental    Portability: portable-   Version    : $Id: XsltArrows.hs,v 1.1 2006/11/11 15:36:05 hxml Exp $     The HXT arrow interface for the XSLT module @@ -30,19 +29,10 @@     ) where -import Prelude hiding ( catch )- import Control.Exception-    ( SomeException-    , catch-    , evaluate )--import Control.Arrow.ListArrows+    ( evaluate ) -import Text.XML.HXT.DOM.Interface-import Text.XML.HXT.Arrow.XmlIOStateArrow-import Text.XML.HXT.Arrow.XmlArrow-import Text.XML.HXT.Arrow.ReadDocument+import Text.XML.HXT.Core  import Text.XML.HXT.XSLT.Names @@ -61,50 +51,36 @@  -- | arrow for applying a pure partial function, catch the error case and issue the error -arrWithCatch	:: (a -> b) -> IOSArrow a b+arrWithCatch    :: (a -> b) -> IOSArrow a b arrWithCatch f-    = arrIO (applyf f)-      >>>-      ( (applyA (arr issueErr) >>> none)-	|||-	this-      )+    = arrIO (evaluate . f)+      `catchA`+      issueExc "arrWithCatch" -applyf	:: (a -> b) -> a -> IO (Either String b)-applyf f x-	= catch'  ( do-		    res <- evaluate ( f x )-		    return . Right $ res-		  )-	  (\ e -> return . Left . ("XSLT: " ++) . show $ e)-        where-        catch' :: IO a -> (SomeException -> IO a) -> IO a-	catch' = catch-	   -- ------------------------------------------------------------  -- | lift prepareXSLTDocument -prepareXSLTDoc	:: IOSArrow XmlTree XmlTree+prepareXSLTDoc  :: IOSArrow XmlTree XmlTree prepareXSLTDoc     = ( arrWithCatch prepareXSLTDocument-	>>>-	traceDoc "prepareXSLTDocument"+        >>>+        traceDoc "prepareXSLTDocument"       )       `when`       documentStatusOk  -- | read an XSLT stylesheet -readXSLTDoc	:: Attributes -> IOSArrow String XmlTree+readXSLTDoc     :: SysConfigList -> IOSArrow String XmlTree readXSLTDoc options     = readFromDocument (options ++ defaultOptions)     where     defaultOptions-	= [ (a_check_namespaces, v_1)-	  , (a_validate, v_0)-	  , (a_preserve_comment, v_0)-	  ]+        = [ withCheckNamespaces yes+          , withValidate        no+          , withPreserveComment no+          ]  -- | Normalize stylesheet, expand includes, select imports and assemble the rules @@ -112,156 +88,156 @@ compileSSTWithIncludeStack incStack     = traceMsg 2 "compile stylesheet"       >>>-      getChildren					-- remove document root+      getChildren                                       -- remove document root       >>>-      isElem						-- select XSLT root element+      isElem                                            -- select XSLT root element       >>>       choiceA-      [ isXsltLREstylesheet				-- simplified syntax-	:-> ( xsltlre2stylesheet-	      >>>-	      assStylesheet []-	    )-      , isXsltStylesheetElem				-- xsl:stylesheet or xsl:transform-	:-> ( expStylesheet-	      $< ( listA ( getChildren			-- take contents and expand includes-			   >>>-			   expandIncludes incStack-			 )-		   >>>-		   partitionA isXsltImport		-- separate imports from normal rules-		 )-	    )+      [ isXsltLREstylesheet                             -- simplified syntax+        :-> ( xsltlre2stylesheet+              >>>+              assStylesheet []+            )+      , isXsltStylesheetElem                            -- xsl:stylesheet or xsl:transform+        :-> ( expStylesheet+              $< ( listA ( getChildren                  -- take contents and expand includes+                           >>>+                           expandIncludes incStack+                         )+                   >>>+                   partitionA isXsltImport              -- separate imports from normal rules+                 )+            )       , this-	:-> ( issueErr "XSLT: Either xsl:stylesheet/xsl:transform or simplified syntax expected"-	      >>>-	      none-	    )+        :-> ( issueErr "XSLT: Either xsl:stylesheet/xsl:transform or simplified syntax expected"+              >>>+              none+            )       ]       >>>       traceValue 3 (("compiled stylesheet:\n" ++) . show)     where-    assStylesheet imports				-- do the assembly, the compilation-	= arrWithCatch (flip assembleStylesheet $ imports)+    assStylesheet imports                               -- do the assembly, the compilation+        = arrWithCatch (flip assembleStylesheet $ imports)      expStylesheet (imports, rest)-	= traceMsg 2 "expand stylesheet"-	  >>>-	  setChildren rest				-- remove import rules from stylesheet-	  >>>-	  assStylesheet $< listA ( constL imports	-- read the imports and assemble the stylesheet-				   >>>-				   getXsltAttrValue xsltHRef-				   >>>-				   compileSSTFromUriWithIncludeStack incStack-				 )+        = traceMsg 2 "expand stylesheet"+          >>>+          setChildren rest                              -- remove import rules from stylesheet+          >>>+          assStylesheet $< listA ( constL imports       -- read the imports and assemble the stylesheet+                                   >>>+                                   getXsltAttrValue xsltHRef+                                   >>>+                                   compileSSTFromUriWithIncludeStack incStack+                                 )  -- | read an include and check for recursive includes -readSSTWithIncludeStack	:: [String] -> IOSArrow String XmlTree+readSSTWithIncludeStack :: [String] -> IOSArrow String XmlTree readSSTWithIncludeStack incStack     = ifP (`elem` incStack)       ( (issueErr $< arr recursiveInclude) >>> none )       ( readXSLTDoc []-	>>>-	prepareXSLTDoc-      ) +        >>>+        prepareXSLTDoc+      )     where     recursiveInclude uri-	= "XSLT error: "-	  ++ show uri ++ " is recursively imported/included." +        = "XSLT error: "+          ++ show uri ++ " is recursively imported/included."           ++ concatMap (("\n  imported/included from: " ++) . show) incStack -compileSSTFromUriWithIncludeStack	:: [String] -> IOSArrow String CompiledStylesheet+compileSSTFromUriWithIncludeStack       :: [String] -> IOSArrow String CompiledStylesheet compileSSTFromUriWithIncludeStack incStack     = comp $< this     where     comp uri-	= readSSTWithIncludeStack incStack-	  >>>-	  compileSSTWithIncludeStack (uri:incStack)+        = readSSTWithIncludeStack incStack+          >>>+          compileSSTWithIncludeStack (uri:incStack) -expandIncludes	:: [String] -> IOSArrow XmlTree XmlTree+expandIncludes  :: [String] -> IOSArrow XmlTree XmlTree expandIncludes incStack     = isElem       >>>       ( ( expandInclude $< getXsltAttrValue xsltHRef )         `when`-	isXsltInclude+        isXsltInclude       )     where     expandInclude href-	= ( constA href-	    >>>-	    readSSTWithIncludeStack incStack-	    >>>-	    getChildren-	    >>>-	    isElem-	    >>>-	    choiceA-	    [ isXsltLREstylesheet-	      :-> xsltlre2template+        = ( constA href+            >>>+            readSSTWithIncludeStack incStack+            >>>+            getChildren+            >>>+            isElem+            >>>+            choiceA+            [ isXsltLREstylesheet+              :-> xsltlre2template -	    , isXsltStylesheetElem-	      :-> ( getChildren-		    >>>-		    expandIncludes (href:incStack)-		  )+            , isXsltStylesheetElem+              :-> ( getChildren+                    >>>+                    expandIncludes (href:incStack)+                  ) -	    , this+            , this               :-> issueFatal ("XSLT error: Included file " ++ show href ++ " is not a stylesheet")-	    ]-	  )+            ]+          ) -isXsltElem		:: ArrowXml a => QName -> a XmlTree XmlTree-isXsltElem qn		= isElem >>> hasNameWith (equivQName qn)+isXsltElem              :: ArrowXml a => QName -> a XmlTree XmlTree+isXsltElem qn           = isElem >>> hasNameWith (equivQName qn) -isXsltAttr		:: ArrowXml a => QName -> a XmlTree XmlTree-isXsltAttr qn		= isAttr >>> hasNameWith (equivQName qn)+isXsltAttr              :: ArrowXml a => QName -> a XmlTree XmlTree+isXsltAttr qn           = isAttr >>> hasNameWith (equivQName qn) -hasXsltAttr		:: ArrowXml a => QName -> a XmlTree XmlTree-hasXsltAttr qn		= ( getAttrl >>> isXsltAttr qn )-			  `guards`-			  this+hasXsltAttr             :: ArrowXml a => QName -> a XmlTree XmlTree+hasXsltAttr qn          = ( getAttrl >>> isXsltAttr qn )+                          `guards`+                          this -isXsltInclude		:: ArrowXml a => a XmlTree XmlTree-isXsltInclude		= isXsltElem xsltInclude+isXsltInclude           :: ArrowXml a => a XmlTree XmlTree+isXsltInclude           = isXsltElem xsltInclude -isXsltImport		:: ArrowXml a => a XmlTree XmlTree-isXsltImport		= isXsltElem xsltImport+isXsltImport            :: ArrowXml a => a XmlTree XmlTree+isXsltImport            = isXsltElem xsltImport -isXsltLREstylesheet	:: ArrowXml a => a XmlTree XmlTree-isXsltLREstylesheet	= hasXsltAttr xsltVersionLRE+isXsltLREstylesheet     :: ArrowXml a => a XmlTree XmlTree+isXsltLREstylesheet     = hasXsltAttr xsltVersionLRE -isXsltStylesheetElem	:: ArrowXml a => a XmlTree XmlTree-isXsltStylesheetElem	=  ( isXsltElem xsltTransform-			     <+>-			     isXsltElem xsltStylesheet-			   )+isXsltStylesheetElem    :: ArrowXml a => a XmlTree XmlTree+isXsltStylesheetElem    =  ( isXsltElem xsltTransform+                             <+>+                             isXsltElem xsltStylesheet+                           )                            >>>-			   hasXsltAttr xsltVersion+                           hasXsltAttr xsltVersion -getXsltAttrValue	:: ArrowXml a => QName -> a XmlTree String-getXsltAttrValue qn	= getAttrl >>> isXsltAttr qn >>> xshow getChildren+getXsltAttrValue        :: ArrowXml a => QName -> a XmlTree String+getXsltAttrValue qn     = getAttrl >>> isXsltAttr qn >>> xshow getChildren -xsltlre2template	:: ArrowXml a => a XmlTree XmlTree-xsltlre2template	= mkqelem xsltTemplate [sqattr xsltMatch "/"] [this]+xsltlre2template        :: ArrowXml a => a XmlTree XmlTree+xsltlre2template        = mkqelem xsltTemplate [sqattr xsltMatch "/"] [this] -xsltlre2stylesheet	:: ArrowXml a => a XmlTree XmlTree-xsltlre2stylesheet	= mkqelem xsltTransform [] [ this >>> xsltlre2template ]+xsltlre2stylesheet      :: ArrowXml a => a XmlTree XmlTree+xsltlre2stylesheet      = mkqelem xsltTransform [] [ this >>> xsltlre2template ]  -- -checkApplySST	::  IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree+checkApplySST   ::  IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree checkApplySST appl     = ( isRoot-	>>>-	replaceChildren appl-	>>>-	traceDoc "XSLT stylesheet applied"-	>>>-	setDocumentStatusFromSystemState "applying XSLT stylesheet"+        >>>+        replaceChildren appl+        >>>+        traceDoc "XSLT stylesheet applied"+        >>>+        setDocumentStatusFromSystemState "applying XSLT stylesheet"       )       `orElse`       issueErr "XSLT: complete document with root node required for stylesheet application"@@ -272,7 +248,7 @@ -- XSLT imports and includes are evaluated and the rules are normalized and prepared -- for easy application. -xsltCompileStylesheet		:: IOSArrow XmlTree CompiledStylesheet+xsltCompileStylesheet           :: IOSArrow XmlTree CompiledStylesheet xsltCompileStylesheet     = prepareXSLTDoc       >>>@@ -283,15 +259,15 @@ -- Reading an XSLT stylesheet is always done without validation but with -- namespace propagation. Comments are removed from the stylesheet. -xsltCompileStylesheetFromURI	:: IOSArrow String CompiledStylesheet-xsltCompileStylesheetFromURI	= compileSSTFromUriWithIncludeStack []+xsltCompileStylesheetFromURI    :: IOSArrow String CompiledStylesheet+xsltCompileStylesheetFromURI    = compileSSTFromUriWithIncludeStack []  -- | apply a compiled XSLT stylesheet to a whole document tree -- -- The compiled stylesheet must have been created with 'xsltCompileStylesheet' -- or 'xsltCompileStylesheetFromURI' -xsltApplyStylesheet		:: CompiledStylesheet -> IOSArrow XmlTree XmlTree+xsltApplyStylesheet             :: CompiledStylesheet -> IOSArrow XmlTree XmlTree xsltApplyStylesheet css     = checkApplySST (arrWithCatch (applyStylesheet css) >>. concat) @@ -302,11 +278,11 @@ -- all children of the root node are removed and -- the error status is set in the attribute list of the root node of the input document. -xsltApplyStylesheetFromURI	:: String -> IOSArrow XmlTree XmlTree+xsltApplyStylesheetFromURI      :: String -> IOSArrow XmlTree XmlTree xsltApplyStylesheetFromURI uri     = xsltApplyStylesheet $< (constA uri >>> xsltCompileStylesheetFromURI)  {--xsltApplyStylesheetWParams	:: Map ExName Expr -> CompiledStylesheet -> IOSArrow XmlTree XmlTree-xsltApplyStylesheetWParams wp css	= arrL (applyStylesheetWParams wp css)+xsltApplyStylesheetWParams      :: Map ExName Expr -> CompiledStylesheet -> IOSArrow XmlTree XmlTree+xsltApplyStylesheetWParams wp css       = arrL (applyStylesheetWParams wp css) -}