hxt-xslt 8.4.0 → 8.5.0
raw patch · 7 files changed
+100/−112 lines, 7 filesdep +hxt-xpathdep ~hxtPVP ok
version bump matches the API change (PVP)
Dependencies added: hxt-xpath
Dependency ranges changed: hxt
API changes (from Hackage documentation)
Files
- examples/Makefile +0/−6
- examples/hparser/xslt/Makefile +1/−0
- examples/hparser/xslt/Makefile~ +0/−65
- hxt-xslt.cabal +4/−4
- src/Text/XML/HXT/XSLT/Application.hs +68/−24
- src/Text/XML/HXT/XSLT/Common.hs +23/−11
- src/Text/XML/HXT/XSLT/XsltArrows.hs +4/−2
examples/Makefile view
@@ -1,14 +1,8 @@-# $Id: Makefile,v 1.15 2006/11/12 14:52:59 hxml Exp $-# # Example Applications # -HXT_HOME = ..- EXAMPLES = hparser MORE_SAMPLES = -DIST = ../$(DIST_NAME)-DIST_DIR = $(DIST)/examples all : $(foreach i,$(EXAMPLES),$(MAKE) -C $i all ;)
examples/hparser/xslt/Makefile view
@@ -29,6 +29,7 @@ 'comment_pi.xsl example_document.xml' \ 'attset.xsl example_document.xml' \ 'copy_copy_of.xsl example_document.xml' \+ 'copy_rec.xsl example0.xml' \ 'sorting.xsl example_document.xml' \ 'strip_space.xsl exdoc2.xml' \ 'testEX.xsl empty.xml' \
− examples/hparser/xslt/Makefile~
@@ -1,65 +0,0 @@-# $Id: Makefile,v 1.1 2006/11/11 15:36:03 hxml Exp $--HXT_HOME = ../../../..-PKGFLAGS = -GHCFLAGS = -Wall -O2-GHC = ghc $(GHCFLAGS) $(PKGFLAGS)--DIST = $(HXT_HOME)/dist/examples/arrows/hparser-DIST_DIR = $(DIST)/xslt--prog = ../HXmlParser-xslt = $(prog) --do-not-validate--all :- $(MAKE) -C .. all--test :- @echo "===> run a few simple xslt test cases with $(prog)"- $(MAKE) test1-----testcases = \- 'strip_example.xsl strip_example.xml' \- 'elems_and_attrs.xsl example_document.xml' \- 'lre.xsl example_document.xml' \- 'for_each_when_if.xsl example_document.xml' \- 'prio.xsl example_document.xml' \- 'default_rules.xsl example_document.xml' \- 'vars_and_params.xsl example_document.xml' \- 'lre_stylesheet.xsl example_document.xml' \- 'imp_lre.xsl example_document.xml' \- 'inc_lre.xsl example_document.xml' \- 'comment_pi.xsl example_document.xml' \- 'attset.xsl example_document.xml' \- 'copy_copy_of.xsl example_document.xml' \- 'sorting.xsl example_document.xml' \- 'strip_space.xsl exdoc2.xml' \- 'testEX.xsl empty.xml' \- 'testNS.xsl testNS.xml' \- 'default_prio.xsl example_document2.xml'--test1 :- for tc in $(testcases) ; \- do \- stylesheet=$$(echo $$tc | cut -d ' ' -f 1) ; \- input=$$(echo $$tc | cut -d ' ' -f 2) ; \- $(xslt) --xslt=$$stylesheet --output-file=$$stylesheet.out $$input ; \- echo "Contents of $$stylesheet.out" ; \- echo "============================" ; \- cat $$stylesheet.out ; \- echo ; \- done--stylesheets = $(wildcard *.xsl)-inputs = $(wildcard *.xml)--dist :- [ -d $(DIST_DIR) ] || mkdir -p $(DIST_DIR)- cp $(EX) Makefile $(stylesheets) $(inputs) $(DIST_DIR)--clean :- rm -f *.xsl.out-
hxt-xslt.cabal view
@@ -1,10 +1,10 @@ -- arch-tag: Haskell XML Toolbox XSLT Module name: hxt-xslt-version: 8.4.0+version: 8.5.0 license: OtherLicense license-file: LICENCE maintainer: Uwe Schmidt <uwe@fh-wedel.de>-stability: stable+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.@@ -42,7 +42,6 @@ examples/hparser/xslt/lre_stylesheet.xsl examples/hparser/xslt/lre.xsl examples/hparser/xslt/Makefile- examples/hparser/xslt/Makefile~ examples/hparser/xslt/match_by_for_each.xsl examples/hparser/xslt/nspropXSLT.xsl examples/hparser/xslt/nspropXSLTyyy.xsl@@ -87,5 +86,6 @@ directory >= 1 && < 2, filepath >= 1 && < 2, parsec >= 2.1 && < 4,- hxt >= 8.4 && < 9+ hxt >= 8.5 && < 9,+ hxt-xpath >= 8.5 && < 9
src/Text/XML/HXT/XSLT/Application.hs view
@@ -34,6 +34,10 @@ import qualified Data.Map as Map hiding (Map) import Data.Maybe +-- just for debugging+-- import Debug.Trace(trace)+-- import Text.XML.HXT.XPath.NavTree (subtreeNT)+ -- ------------------------------------------------------------ type XPathParams = Map ExName Expr@@ -110,10 +114,12 @@ evalXPathExpr :: Expr -> Context -> XPathValue evalXPathExpr expr (Ctx node _ pos len globVars locVars _ _ _)- = filterXPath $ evalExpr (vars,[]) (pos, len, node) expr (XPVNode [node])+ = filterXPath $ evalExpr (vars,[]) (pos, len, node) expr (XPVNode . singletonNodeSet $ node) where filterXPath (XPVError err) = error err- filterXPath (XPVNode nodes) = XPVNode $ (\x -> fst x ++ snd x) $ partition (isAttr.subtreeNT) nodes+ -- 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+ -- line above: complicated issue: consider: <lre><xsl:copy-of select="a/@*|a/*|b/@*"/></lre> -- assume a is in document order before b. Shall b's attributes be added to lre or be ignored?! filterXPath xpv = xpv@@ -124,20 +130,40 @@ = error "internal error in evalXPathExpr in XSLT module" evalRtf :: Template -> String -> Context -> XPathValue-evalRtf template rtfId ctx = XPVNode [ntree rtfRoot]+evalRtf template rtfId ctx = XPVNode $ singletonNodeSet (ntree rtfRoot) where rtfRoot = setAttribute rootIdName ("rtf " ++ rtfId) $ mkRoot [] $ applyTemplate template ctx rootIdName = mkQName "" "rootId" "" -applySelect :: SelectExpr -> Context -> [NavXmlTree]-applySelect (SelectExpr expr) ctx = +-- ------------------------------------------------------------++applySelect :: SelectExpr -> Context -> [NavXmlTree]+applySelect = applySelect'++{- just for debugging+applySelect e@(SelectExpr expr) ctx = trace msg2 $ res+ where+ res = applySelect' e $ trace msg1 ctx+ msg1 = unlines $ [ "applySelect: " ++ show expr+ , formatXmlTree . subtreeNT . ctxGetNode $ ctx+ ]+ msg2 = unlines $ "result trees" : map (formatXmlTree . subtreeNT) res+-}++applySelect' :: SelectExpr -> Context -> [NavXmlTree]+applySelect' (SelectExpr expr) ctx = extractNodes xpathResult where xpathResult = evalXPathExpr expr ctx- extractNodes (XPVNode nodes) = nodes++ extractNodes (XPVNode nodes) = attributesFirst . fromNodeSet $ nodes 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)++-- ------------------------------------------------------------+ applyTest :: TestExpr -> Context -> Bool applyTest (TestExpr expr) ctx = bool where (XPVBool bool) = evalXPathExpr expr ctx@@ -362,27 +388,45 @@ applyCopyOf _ = const [] --- ------------------------------------+-- ------------------------------------------------------------ applyTemplate :: Template -> Context -> [XmlTree]-applyTemplate t@(TemplComposite _) = applyComposite t-applyTemplate t@(TemplMessage _ _) = applyMessage t-applyTemplate t@(TemplForEach _ _ _) = applyForEach t-applyTemplate t@(TemplChoose _) = applyChoose t-applyTemplate t@(TemplElement _ _ _ _) = applyElement t-applyTemplate t@(TemplAttribute _ _) = applyAttribute t-applyTemplate t@(TemplText _) = applyText t-applyTemplate t@(TemplValueOf _) = applyValueOf t-applyTemplate t@(TemplComment _) = applyComment t-applyTemplate t@(TemplProcInstr _ _) = applyProcInstr t-applyTemplate t@(TemplApply _ _ _ _) = applyApplTempl t-applyTemplate t@(TemplApplyImports) = applyImports t-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 = applyTemplate' --- ------------------------------------+{- just for debugging+applyTemplate t ctx+ = trace msg2 $ res+ where+ res = applyTemplate' t $ trace msg1 ctx+ msg1 = unlines [ "applyTemplate begin"+ , "template: " ++ show t+ , "context tree: "+ , formatXmlTree . subtreeNT . ctxGetNode $ ctx+ ]+ msg2 = unlines $ [ "applyTemplate end"+ , "result trees:"+ ] ++ map formatXmlTree res+-}++applyTemplate' :: Template -> Context -> [XmlTree]+applyTemplate' t@(TemplComposite _) = applyComposite t+applyTemplate' t@(TemplMessage _ _) = applyMessage t+applyTemplate' t@(TemplForEach _ _ _) = applyForEach t+applyTemplate' t@(TemplChoose _) = applyChoose t+applyTemplate' t@(TemplElement _ _ _ _) = applyElement t+applyTemplate' t@(TemplAttribute _ _) = applyAttribute t+applyTemplate' t@(TemplText _) = applyText t+applyTemplate' t@(TemplValueOf _) = applyValueOf t+applyTemplate' t@(TemplComment _) = applyComment t+applyTemplate' t@(TemplProcInstr _ _) = applyProcInstr t+applyTemplate' t@(TemplApply _ _ _ _) = applyApplTempl t+applyTemplate' t@(TemplApplyImports) = applyImports t+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 []++-- ------------------------------------------------------------ -- "Main" : applyStylesheetWParams :: XPathParams -> CompiledStylesheet -> XmlTree -> [XmlTree]
src/Text/XML/HXT/XSLT/Common.hs view
@@ -26,7 +26,6 @@ , module Text.XML.HXT.XPath.XPathEval , module Text.XML.HXT.XPath.XPathFct , module Text.XML.HXT.XPath.XPathToString- , module Data.NavTree , module Data.Tree.Class -- Tree Functions@@ -110,7 +109,16 @@ import Text.XML.HXT.DOM.FormatXmlTree ( formatXmlTree ) -import Text.XML.HXT.XPath.XPathDataTypes( Expr ( LiteralExpr+import Text.XML.HXT.XPath.XPathDataTypes( NavTree+ , ntree+ , subtreeNT+ , upNT+ , downNT+ , rightNT+ , leftNT+ , getChildrenNT++ , Expr ( LiteralExpr , FctExpr , GenExpr , PathExpr@@ -123,12 +131,25 @@ , PI , TypeTest )+ , NodeSet (..) , NavXmlTree , XPathValue ( XPVNode , XPVBool , XPVString , XPVError )+ , emptyNodeSet+ , singletonNodeSet+ , nullNodeSet+ , cardNodeSet+ , deleteNodeSet+ , insertNodeSet+ , unionNodeSet+ , elemsNodeSet+ , fromNodeSet+ , toNodeSet+ , headNodeSet+ , withNodeSet ) import Text.XML.HXT.XPath.XPathParser ( parseXPath )@@ -144,15 +165,6 @@ import Data.Tree.Class -import Data.NavTree ( NavTree- , ntree- , subtreeNT- , upNT- , downNT- , rightNT- , leftNT- , getChildrenNT- ) import Data.Maybe import Data.List import Data.Char
src/Text/XML/HXT/XSLT/XsltArrows.hs view
@@ -138,12 +138,14 @@ none ) ]+ >>>+ traceValue 3 (("compiled stylesheet:\n" ++) . show) where assStylesheet imports -- do the assembly, the compilation = arrWithCatch (flip assembleStylesheet $ imports) expStylesheet (imports, rest)- = traceMsg 2 "expandStylesheet"+ = traceMsg 2 "expand stylesheet" >>> setChildren rest -- remove import rules from stylesheet >>>@@ -259,7 +261,7 @@ >>> traceDoc "XSLT stylesheet applied" >>>- setDocumentStatusFromSystemState "applying XSLT styleshhet"+ setDocumentStatusFromSystemState "applying XSLT stylesheet" ) `orElse` issueErr "XSLT: complete document with root node required for stylesheet application"