diff --git a/examples/hunit/HUnitExample.hs b/examples/hunit/HUnitExample.hs --- a/examples/hunit/HUnitExample.hs +++ b/examples/hunit/HUnitExample.hs @@ -8,7 +8,7 @@ import System import Test.HUnit -import Text.XML.HXT.Arrow +import Text.XML.HXT.Core import Text.XML.HXT.XPath diff --git a/examples/hxpath/.ghci b/examples/hxpath/.ghci deleted file mode 100644 --- a/examples/hxpath/.ghci +++ /dev/null @@ -1,4 +0,0 @@ -:set -package-conf ../../../lib/hxt/package.conf -:set -package hxt -:set -Wall -:load HXPath diff --git a/examples/hxpath/.gitignore b/examples/hxpath/.gitignore deleted file mode 100644 --- a/examples/hxpath/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -HXPath -XPathShell diff --git a/examples/hxpath/XPathShell.hs b/examples/hxpath/XPathShell.hs --- a/examples/hxpath/XPathShell.hs +++ b/examples/hxpath/XPathShell.hs @@ -27,6 +27,8 @@ import Text.XML.HXT.XPath import Text.XML.HXT.Curl +import Text.XML.HXT.Parser.XmlCharParser( withNormNewline ) + import System.Console.Editline.Readline import System.Environment @@ -105,7 +107,7 @@ ] where pathS = show $ path - pathEx = runParser parseXPath (toNsEnv env) "" $ path + pathEx = runParser parseXPath (withNormNewline (toNsEnv env)) "" $ path pathString = either show show $ pathEx pathTree = either show formatXPathTree $ pathEx xr = runLA ( xshow $ getXPathTreesWithNsEnv env path) doc diff --git a/hxt-xpath.cabal b/hxt-xpath.cabal --- a/hxt-xpath.cabal +++ b/hxt-xpath.cabal @@ -1,6 +1,6 @@ -- arch-tag: Haskell XML Toolbox XPath Package Name: hxt-xpath -Version: 9.1.0 +Version: 9.1.1 Synopsis: The XPath modules for HXT. Description: The Haskell XML Toolbox XPath library. Since version 8.5 this library is packed in a separate package. @@ -21,8 +21,6 @@ examples/hunit/mini1.xml examples/hunit/mini2.xml examples/hxpath/example1.xml - examples/hxpath/.ghci - examples/hxpath/.gitignore examples/hxpath/HXPath.hs examples/hxpath/Makefile examples/hxpath/W3CTestData.hs diff --git a/src/Text/XML/HXT/XPath/XPathEval.hs b/src/Text/XML/HXT/XPath/XPathEval.hs --- a/src/Text/XML/HXT/XPath/XPathEval.hs +++ b/src/Text/XML/HXT/XPath/XPathEval.hs @@ -2,7 +2,7 @@ {- | Module : Text.XML.HXT.XPath.XPathEval - Copyright : Copyright (C) 2006-2010 Uwe Schmidt + Copyright : Copyright (C) 2006-2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) @@ -275,8 +275,8 @@ filterEval :: Env -> Context -> [Expr] -> XPathFilter filterEval env cont (prim:predicates) ns = case evalExpr env cont prim ns of - new_ns@(XPVNode _) -> evalPredL env predicates new_ns - _ -> XPVError "Return of a filterexpression is not a nodeset" + (XPVNode nns) -> evalStep'' env predicates . Right . fromNodeSet $ nns -- old: evalPredL env predicates new_ns + _ -> XPVError "Return of a filterexpression is not a nodeset" filterEval _ _ _ _ = XPVError "Call to filterEval without an expression" @@ -412,17 +412,43 @@ -- ----------------------------------------------------------------------------- +type NodeList = NavXmlTrees + +type NodeListRes = Either XPathValue NodeList + +nodeListResToXPathValue :: NodeListRes -> XPathValue +nodeListResToXPathValue = either id (XPVNode . toNodeSet) + +nullNL :: NodeListRes +nullNL = Right [] + +plusNL :: NodeListRes -> NodeListRes -> NodeListRes +plusNL res@(Left _) _ = res +plusNL _ res@(Left _) = res +plusNL (Right ns1) (Right ns2) = Right $ ns1 ++ ns2 + +sumNL :: [NodeListRes] -> NodeListRes +sumNL = foldr plusNL nullNL + +mapNL :: (NavXmlTree -> NodeListRes) -> NodeListRes -> NodeListRes +mapNL _ res@(Left _) = res +mapNL f (Right ns) = sumNL . map f $ ns + +mapNL' :: (Int -> NavXmlTree -> NodeListRes) -> NodeListRes -> NodeListRes +mapNL' _ res@(Left _) = res +mapNL' f (Right ns) = sumNL . zipWith f [1..] $ ns + +-- ------------------------------------------------------------ + -- | -- Filter for accessing all nodes of a XPath-axis -- -- * 1.parameter as : axis specifier -- -getAxisNodes :: AxisSpec -> XPathFilter -getAxisNodes as = withXPVNode "Call to getAxis without a nodeset" evalAxis - where - evalAxis = XPVNode . - withNodeSet (concatMap (fromJust $ lookup as axisFctL)) +getAxisNodes :: AxisSpec -> NodeSet -> NodeListRes +getAxisNodes as = Right . (concatMap (fromJust $ lookup as axisFctL)) . fromNodeSet + -- | -- Axis-Function-Table. -- Each XPath axis-specifier is mapped to the corresponding axis-function @@ -456,27 +482,30 @@ -- ----------------------------------------------------------------------------- evalSteps :: Env -> [XStep] -> XPathFilter -evalSteps env steps ns = foldl (evalStep env) ns steps +evalSteps env steps ns = foldl (flip $ evalStep env) ns steps -- | -- evaluate a single XPath step -- namespace-axis is not supported -evalStep :: Env -> XPathValue -> XStep -> XPathValue +evalStep :: Env -> XStep -> XPathFilter -evalStep _ _ (Step Namespace _ _) = XPVError "namespace-axis not supported" -evalStep _ ns (Step Attribute nt _) = evalAttr nt (getAxisNodes Attribute ns) -evalStep env ns (Step axisSpec nt pr) = evalStep' env pr nt (getAxisNodes axisSpec ns) +evalStep _ (Step Namespace _ _ ) _ = XPVError "namespace-axis not supported" +evalStep _ (Step Attribute nt _ ) ns = withXPVNode "Call to getAxis without a nodeset" + ( evalAttr nt . getAxisNodes Attribute ) + ns +evalStep env (Step axisSpec nt pr) ns = withXPVNode "Call to getAxis without a nodeset" + ( evalStep' env pr nt . getAxisNodes axisSpec ) + ns -- ----------------------------------------------------------------------------- -evalAttr :: NodeTest -> XPathFilter -evalAttr nt = withXPVNode "Call to evalAttr without a nodeset" $ - evalTest - where - evalTest = XPVNode . - withNodeSet (concatMap . evalAttrNodeTest $ nt) +-- the goal: +-- evalAttr :: NodeTest -> NavXmlTrees -> XPathValue +evalAttr :: NodeTest -> NodeListRes -> XPathValue +evalAttr nt = nodeListResToXPathValue . mapNL (Right . evalAttrNodeTest nt) + evalAttrNodeTest :: NodeTest -> NavXmlTree -> NavXmlTrees evalAttrNodeTest (NameTest qn) ns@(NT (NTree (XAttr qn1) _) _ix _ _ _) @@ -497,36 +526,34 @@ = [ns] evalAttrNodeTest _ _ = [] -evalStep' :: Env -> [Expr] -> NodeTest -> XPathFilter -evalStep' env pr nt = evalPredL env pr . nodeTest nt - -- ----------------------------------------------------------------------------- -evalPredL :: Env -> [Expr] -> XPathFilter -evalPredL env pr n = withXPVNode "Call to evalPredL without a nodeset" evalPl n - where - evalPl ns = foldl (evalPred env 1 (cardNodeSet ns)) n pr +evalStep' :: Env -> [Expr] -> NodeTest -> NodeListRes -> XPathValue +evalStep' env pr nt = evalStep'' env pr . nodeTest nt -evalPred :: Env -> Int -> Int -> XPathValue -> Expr -> XPathValue -evalPred env pos len nv@(XPVNode ns) ex - | nullNodeSet ns = nv - | otherwise = case testPredicate env (pos, len, x) ex (XPVNode . singletonNodeSet $ x) of - e@(XPVError _) -> e - XPVBool True -> XPVNode $ insertNodeSet x n - XPVBool False -> nextNode - _ -> XPVError "Value of testPredicate is not a boolean" - where - (xp, x) = head . elemsNodeSet $ ns - xs = deleteNodeSet xp ns - nextNode@(XPVNode n) = evalPred env (pos + 1) len (XPVNode xs) ex -evalPred _ _ _ _ _ = XPVError "Call to evalPred without a nodeset" +evalStep'' :: Env -> [Expr] -> NodeListRes -> XPathValue +evalStep'' env pr = nodeListResToXPathValue . evalPredL env pr +evalPredL :: Env -> [Expr] -> NodeListRes -> NodeListRes +evalPredL env pr ns = foldl (flip $ evalPred env) ns pr +evalPred :: Env -> Expr -> NodeListRes -> NodeListRes +evalPred _ _ res@(Left _) = res +evalPred env ex arg@(Right ns) = mapNL' (evalPred' env ex (length ns)) arg + +evalPred' :: Env -> Expr -> Int -> Int -> NavXmlTree -> NodeListRes +evalPred' env ex len pos x = case testPredicate env (pos, len, x) ex (XPVNode . singletonNodeSet $ x) of + e@(XPVError _) -> Left e + XPVBool True -> Right [x] + XPVBool False -> Right [] + _ -> Left $ XPVError "Value of testPredicate is not a boolean" + testPredicate :: Env -> Context -> Expr -> XPathFilter -testPredicate env context@(pos, _, _) ex ns = case evalExpr env context ex ns of - XPVNumber (Float f) -> XPVBool (f == fromIntegral pos) - XPVNumber _ -> XPVBool False - _ -> xboolean context env [evalExpr env context ex ns] +testPredicate env context@(pos, _, _) ex ns + = case evalExpr env context ex ns of + XPVNumber (Float f) -> XPVBool (f == fromIntegral pos) + XPVNumber _ -> XPVBool False + _ -> xboolean context env [evalExpr env context ex ns] -- ----------------------------------------------------------------------------- -- | @@ -538,23 +565,32 @@ -- -- Bugfix : "*" (or any other name-test) must not match the root node -nodeTest :: NodeTest -> XPathFilter - --- nodeTest (NameTest (QN "" "*" "")) = filterNodes (\n -> isXTagNode n && not (isRootNode n)) --- nodeTest (NameTest (QN _ "*" uri)) = filterNodes (filterd uri) +nodeTest :: NodeTest -> NodeListRes -> NodeListRes +nodeTest _ res@(Left _) = res +nodeTest t (Right ns) = Right . nodeTest' t $ ns -nodeTest (NameTest q) - | isWildcardTest = filterNodes (wildcardTest q) - | otherwise = filterNodes (nameTest q) -- old: (isOfTagNode1 q) +nodeTest' :: NodeTest -> NodeList -> NodeList +nodeTest' (NameTest q) + | isWildcardTest = filterNodes' (wildcardTest q) + | otherwise = filterNodes' (nameTest q) where isWildcardTest = localPart q == "*" -nodeTest (PI n) = filterNodes isPiNode +nodeTest' (PI n) = filterNodes' isPiNode where isPiNode = maybe False ((== n) . qualifiedName) . XN.getPiName -nodeTest (TypeTest t) = typeTest t +nodeTest' (TypeTest t) = typeTest t +-- | +-- the filter selects the NTree part of a navigable tree and +-- tests whether the node is of the necessary type +-- +-- * 1.parameter fct : filter function from the XmlTreeFilter module which tests the type of a node + +filterNodes' :: (XNode -> Bool) -> NodeList -> NodeList +filterNodes' fct = filter (fct . dataNT) + -- ----------------------------------------------------------------------------- nameTest :: QName -> XNode -> Bool @@ -585,13 +621,15 @@ -- | -- tests whether a node is of a special type -- -typeTest :: XPathNode -> XPathFilter +typeTest :: XPathNode -> NodeList -> NodeList typeTest XPNode = id -typeTest XPCommentNode = filterNodes XN.isCmt -typeTest XPPINode = filterNodes XN.isPi -typeTest XPTextNode = filterNodes XN.isText +typeTest XPCommentNode = filterNodes' XN.isCmt +typeTest XPPINode = filterNodes' XN.isPi +typeTest XPTextNode = filterNodes' XN.isText -- ----------------------------------------------------------------------------- +{- old stuff + -- | -- the filter selects the NTree part of a navigable tree and -- tests whether the node is of the necessary type @@ -601,6 +639,7 @@ filterNodes :: (XNode -> Bool) -> XPathFilter filterNodes fct = withXPVNode "Call to filterNodes without a nodeset" $ (XPVNode . withNodeSet (filter (fct . dataNT))) +end old stuff -} -- ----------------------------------------------------------------------------- -- |