-- ------------------------------------------------------------ {- | Module : Text.XML.HXT.XPath.XPathEval Copyright : Copyright (C) 2006-2011 Uwe Schmidt License : MIT Maintainer : Uwe Schmidt (uwe@fh-wedel.de) Stability : experimental Portability: portable The core functions for evaluating the different types of XPath expressions. Each 'Expr'-constructor is mapped to an evaluation function. -} -- ------------------------------------------------------------ module Text.XML.HXT.XPath.XPathEval ( getXPath , getXPathSubTrees , getXPathNodeSet' , getXPathWithNsEnv , getXPathSubTreesWithNsEnv , getXPathNodeSetWithNsEnv' , evalExpr , addRoot' , parseXPathExpr , parseXPathExprWithNsEnv , getXPath' , getXPathSubTrees' , getXPathNodeSet'' ) where import Data.List ( partition ) import Data.Maybe ( fromJust, fromMaybe ) import Text.XML.HXT.XPath.XPathFct import Text.XML.HXT.XPath.XPathDataTypes import Text.XML.HXT.XPath.XPathArithmetic ( xPathAdd , xPathDiv , xPathMod , xPathMulti , xPathUnary ) import Text.XML.HXT.XPath.XPathParser ( parseXPath ) import Text.XML.HXT.XPath.XPathToString ( xPValue2XmlTrees ) import Text.XML.HXT.XPath.XPathToNodeSet( xPValue2XmlNodeSet , emptyXmlNodeSet ) import Text.XML.HXT.Parser.XmlCharParser( withNormNewline ) import Text.ParserCombinators.Parsec ( runParser ) -- ---------------------------------------- -- the DOM functions import Text.XML.HXT.DOM.Interface import qualified Text.XML.HXT.DOM.XmlNode as XN -- ---------------------------------------- -- the list arrow functions import Control.Arrow ( (>>>), (>>^), left ) import Control.Arrow.ArrowList ( arrL, isA ) import Control.Arrow.ArrowIf ( filterA ) import Control.Arrow.ListArrow ( runLA ) import qualified Control.Arrow.ArrowTree as AT import Text.XML.HXT.Arrow.XmlArrow ( ArrowDTD, isDTD, getDTDAttrl ) import Text.XML.HXT.Arrow.Edit ( canonicalizeForXPath ) -- ----------------------------------------------------------------------------- -- | -- Select parts of a document by a string representing a XPath expression. -- -- The main filter for selecting parts of a document via XPath. -- The string argument must be a XPath expression with an absolute location path, -- the argument tree must be a complete document tree. -- Result is a possibly empty list of XmlTrees forming the set of selected XPath values. -- XPath values other than XmlTrees (numbers, attributes, tagnames, ...) -- are converted to text nodes. getXPath :: String -> XmlTree -> XmlTrees getXPath = getXPathWithNsEnv [] -- ----------------------------------------------------------------------------- -- | -- Select parts of a document by an already parsed XPath expression getXPath' :: Expr -> XmlTree -> XmlTrees getXPath' e = runLA $ canonicalizeForXPath >>> arrL (getXPathValues' xPValue2XmlTrees e) -- ----------------------------------------------------------------------------- -- | -- Select parts of a document by a namespace aware XPath expression. -- -- Works like 'getXPath' but the prefix:localpart names in the XPath expression -- are interpreted with respect to the given namespace environment getXPathWithNsEnv :: Attributes -> String -> XmlTree -> XmlTrees getXPathWithNsEnv env s = runLA ( canonicalizeForXPath >>> arrL (getXPathValues xPValue2XmlTrees xPathErr env s) ) -- ----------------------------------------------------------------------------- -- | -- Select parts of an XML tree by a string representing an XPath expression. -- -- The main filter for selecting parts of an arbitrary XML tree via XPath. -- The string argument must be a XPath expression with an absolute location path, -- There are no restrictions on the arument tree. -- -- No canonicalization is performed before evaluating the query -- -- Result is a possibly empty list of XmlTrees forming the set of selected XPath values. -- XPath values other than XmlTrees (numbers, attributes, tagnames, ...) -- are convertet to text nodes. getXPathSubTrees :: String -> XmlTree -> XmlTrees getXPathSubTrees = getXPathSubTreesWithNsEnv [] -- ----------------------------------------------------------------------------- -- | -- Select parts of an XML tree by an XPath expression. getXPathSubTrees' :: Expr -> XmlTree -> XmlTrees getXPathSubTrees' = getXPathValues' xPValue2XmlTrees -- ----------------------------------------------------------------------------- -- | Same as 'getXPathSubTrees' but with namespace aware XPath expression getXPathSubTreesWithNsEnv :: Attributes -> String -> XmlTree -> XmlTrees getXPathSubTreesWithNsEnv nsEnv xpStr = getXPathValues xPValue2XmlTrees xPathErr nsEnv xpStr -- ----------------------------------------------------------------------------- -- | -- compute the node set of an XPath query getXPathNodeSet' :: String -> XmlTree -> XmlNodeSet getXPathNodeSet' = getXPathNodeSetWithNsEnv' [] -- ----------------------------------------------------------------------------- -- | -- compute the node set of an XPath query for an already parsed XPath expr getXPathNodeSet'' :: Expr -> XmlTree -> XmlNodeSet getXPathNodeSet'' = getXPathValues' xPValue2XmlNodeSet -- ----------------------------------------------------------------------------- -- | compute the node set of a namespace aware XPath query getXPathNodeSetWithNsEnv' :: Attributes -> String -> XmlTree -> XmlNodeSet getXPathNodeSetWithNsEnv' nsEnv xpStr = getXPathValues xPValue2XmlNodeSet (const emptyXmlNodeSet) nsEnv xpStr -- ----------------------------------------------------------------------------- -- | parse xpath, evaluate xpath expr and prepare results getXPathValues :: (XPathValue -> a) -> (String -> a) -> Attributes -> String -> XmlTree -> a getXPathValues cvRes cvErr nsEnv xpStr t = case parseXPathExprWithNsEnv nsEnv xpStr of Left parseError -> cvErr parseError Right xpExpr -> getXPathValues' cvRes xpExpr t xPathErr :: String -> [XmlTree] xPathErr parseError = [ XN.mkError c_err parseError ] -- ----------------------------------------------------------------------------- -- | parse xpath, evaluate xpath expr and prepare results getXPathValues' :: (XPathValue -> a) -> Expr -> XmlTree -> a getXPathValues' cvRes xpExpr t = cvRes xpRes where t' = addRoot' t -- we need a root node for starting xpath eval idAttr = ( ("", "idAttr") -- id attributes from DTD (if there) , idAttributesToXPathValue . getIdAttributes $ t' ) navTD = ntree t' xpRes = evalExpr (idAttr:(getVarTab varEnv),[]) (1, 1, navTD) xpExpr (XPVNode . singletonNodeSet $ navTD) addRoot' :: XmlTree -> XmlTree addRoot' t | XN.isRoot t = t | otherwise = XN.mkRoot [] [t] -- ----------------------------------------------------------------------------- -- | parse an XPath expr string -- and return an expr tree or an error message. -- Namespaces are not taken into account. parseXPathExpr :: String -> Either String Expr parseXPathExpr = parseXPathExprWithNsEnv [] -- | parse an XPath expr string with a namespace environment for qualified names in the XPath expr -- and return an expr tree or an error message parseXPathExprWithNsEnv :: Attributes -> String -> Either String Expr parseXPathExprWithNsEnv nsEnv xpStr = left fmtErr . runParser parseXPath (withNormNewline (toNsEnv nsEnv)) "" $ xpStr where fmtErr parseError = "Syntax error in XPath expression " ++ show xpStr ++ ": " ++ show parseError -- ----------------------------------------------------------------------------- -- | -- The main evaluation entry point. -- Each XPath-'Expr' is mapped to an evaluation function. The 'Env'-parameter contains the set of global variables -- for the evaluator, the 'Context'-parameter the root of the tree in which the expression is evaluated. -- evalExpr :: Env -> Context -> Expr -> XPathFilter evalExpr env cont (GenExpr Or ex) = boolEval env cont Or ex evalExpr env cont (GenExpr And ex) = boolEval env cont And ex evalExpr env cont (GenExpr Eq ex) = relEqEval env cont Eq . evalExprL env cont ex evalExpr env cont (GenExpr NEq ex) = relEqEval env cont NEq . evalExprL env cont ex evalExpr env cont (GenExpr Less ex) = relEqEval env cont Less . evalExprL env cont ex evalExpr env cont (GenExpr LessEq ex) = relEqEval env cont LessEq . evalExprL env cont ex evalExpr env cont (GenExpr Greater ex) = relEqEval env cont Greater . evalExprL env cont ex evalExpr env cont (GenExpr GreaterEq ex) = relEqEval env cont GreaterEq . evalExprL env cont ex evalExpr env cont (GenExpr Plus ex) = numEval xPathAdd Plus . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Minus ex) = numEval xPathAdd Minus . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Div ex) = numEval xPathDiv Div . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Mod ex) = numEval xPathMod Mod . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Mult ex) = numEval xPathMulti Mult . toXValue xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Unary ex) = xPathUnary . xnumber cont env . evalExprL env cont ex evalExpr env cont (GenExpr Union ex) = unionEval . evalExprL env cont ex evalExpr env cont (FctExpr name args) = fctEval env cont name args evalExpr env _ (PathExpr Nothing (Just lp)) = locPathEval env lp evalExpr env cont (PathExpr (Just fe) (Just lp)) = locPathEval env lp . evalExpr env cont fe evalExpr env cont (FilterExpr ex) = filterEval env cont ex evalExpr env _ ex = evalSpezExpr env ex -- ----------------------------------------------------------------------------- evalExprL :: Env -> Context -> [Expr] -> XPathValue -> [XPathValue] evalExprL env cont ex ns = map (\e -> evalExpr env cont e ns) ex -- ----------------------------------------------------------------------------- evalSpezExpr :: Env -> Expr -> XPathFilter evalSpezExpr _ (NumberExpr (Float 0)) _ = XPVNumber Pos0 evalSpezExpr _ (NumberExpr (Float f)) _ = XPVNumber (Float f) evalSpezExpr _ (LiteralExpr s) _ = XPVString s evalSpezExpr env (VarExpr name) v = getVariable env name v evalSpezExpr _ _ _ = XPVError "Call to evalExpr with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- filter for evaluating a filter-expression filterEval :: Env -> Context -> [Expr] -> XPathFilter filterEval env cont (prim:predicates) ns = case evalExpr env cont prim ns of (XPVNode nns) -> nodeListResToXPathValue . evalPredL env predicates . Right . fromNodeSet $ nns _ -> XPVError "Return of a filterexpression is not a nodeset" filterEval _ _ _ _ = XPVError "Call to filterEval without an expression" -- ----------------------------------------------------------------------------- -- | -- returns the union of its arguments, the arguments have to be node-sets. unionEval :: [XPathValue] -> XPathValue unionEval vs | not (null evs) = case head evs of e@(XPVError _) -> e _ -> XPVError "A value of a union ( | ) is not a nodeset" | otherwise = XPVNode . unionsNodeSet . map theNode $ nvs where (nvs, evs) = partition isNode vs isNode (XPVNode _) = True isNode _ = False theNode (XPVNode ns) = ns theNode _ = error "illegal argument in unionEval" -- ----------------------------------------------------------------------------- -- | -- Equality or relational test for node-sets, numbers, boolean values or strings, -- each computation of two operands is done by relEqEv' relEqEval :: Env -> Context -> Op -> [XPathValue] -> XPathValue relEqEval env cont op = foldl1 (relEqEv' env cont op) relEqEv' :: Env -> Context -> Op -> XPathValue -> XPathFilter relEqEv' _ _ _ e@(XPVError _) _ = e relEqEv' _ _ _ _ e@(XPVError _) = e -- two node-sets relEqEv' env cont op a@(XPVNode _) b@(XPVNode _) = relEqTwoNodes env cont op a b -- one node-set relEqEv' env cont op a b@(XPVNode _) = relEqOneNode env cont (fromJust $ getOpFct op) a b relEqEv' env cont op a@(XPVNode _) b = relEqOneNode env cont (flip $ fromJust $ getOpFct op) b a -- test without a node-set and equality or not-equality operator relEqEv' env cont Eq a b = eqEv env cont (==) a b relEqEv' env cont NEq a b = eqEv env cont (/=) a b -- test without a node-set and less, less-equal, greater or greater-equal operator relEqEv' env cont op a b = XPVBool ((fromJust $ getOpFct op) (toXNumber a) (toXNumber b)) where toXNumber x = xnumber cont env [x] -- ----------------------------------------------------------------------------- -- | -- Equality or relational test for two node-sets. -- The comparison will be true if and only if there is a node in the first node-set -- and a node in the second node-set such that the result of performing the -- comparison on the string-values of the two nodes is true relEqTwoNodes :: Env -> Context -> Op -> XPathValue -> XPathFilter relEqTwoNodes _ _ op (XPVNode ns) (XPVNode ms) = XPVBool $ foldr (\n -> (any (fct op n) (getStrValues ms) ||)) False $ fromNodeSet ns where fct op' n' = (fromJust $ getOpFct op') (stringValue n') getStrValues = map stringValue . fromNodeSet relEqTwoNodes _ _ _ _ _ = XPVError "Call to relEqTwoNodes without a nodeset" -- ----------------------------------------------------------------------------- -- | -- Comparison between a node-set and different type. -- The node-set is converted in a boolean value if the second argument is of type boolean. -- If the argument is of type number, the node-set is converted in a number, otherwise it is converted -- in a string value. relEqOneNode :: Env -> Context -> (XPathValue -> XPathValue -> Bool) -> XPathValue -> XPathFilter relEqOneNode env cont fct arg = withXPVNode "Call to relEqOneNode without a nodeset" $ \ ns -> XPVBool (any (fct arg) (getStrValues arg ns)) where getStrValues arg' = map ((fromJust $ getConvFct arg') cont env . (:[])) . map stringValue . fromNodeSet -- ----------------------------------------------------------------------------- -- | -- No node-set is involved and the operator is equality or not-equality. -- The arguments are converted in a common type. If one argument is a boolean value -- then it is the boolean type. If a number is involved, the arguments have to converted in numbers, -- else the string type is the common type. eqEv :: Env -> Context -> (XPathValue -> XPathValue -> Bool) -> XPathValue -> XPathFilter eqEv env cont fct f@(XPVBool _) g = XPVBool (f `fct` xboolean cont env [g]) eqEv env cont fct f g@(XPVBool _) = XPVBool (xboolean cont env [f] `fct` g) eqEv env cont fct f@(XPVNumber _) g = XPVBool (f `fct` xnumber cont env [g]) eqEv env cont fct f g@(XPVNumber _) = XPVBool (xnumber cont env [f] `fct` g) eqEv env cont fct f g = XPVBool (xstring cont env [f] `fct` xstring cont env [g]) -- ----------------------------------------------------------------------------- getOpFct :: Op -> Maybe (XPathValue -> XPathValue -> Bool) getOpFct Eq = Just (==) getOpFct NEq = Just (/=) getOpFct Less = Just (<) getOpFct LessEq = Just (<=) getOpFct Greater = Just (>) getOpFct GreaterEq = Just (>=) getOpFct _ = Nothing -- ----------------------------------------------------------------------------- -- | -- Filter for accessing the root element of a document tree getRoot :: XPathFilter getRoot = withXPVNode "Call to getRoot without a nodeset" $ getRoot' where getRoot' ns | nullNodeSet ns = XPVError "Call to getRoot with empty nodeset" | otherwise = XPVNode . singletonNodeSet . getRoot'' . headNodeSet $ ns getRoot'' tree = case upNT tree of Nothing -> tree Just t -> getRoot'' t -- ----------------------------------------------------------------------------- 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 -> NodeSet -> [NodeListRes] getAxisNodes as = map (Right . (fromJust $ lookup as axisFctL)) . fromNodeSet -- | -- Axis-Function-Table. -- Each XPath axis-specifier is mapped to the corresponding axis-function axisFctL :: [(AxisSpec, (NavXmlTree -> NavXmlTrees))] axisFctL = [ (Ancestor , ancestorAxis) , (AncestorOrSelf , ancestorOrSelfAxis) , (Attribute , attributeAxis) , (Child , childAxis) , (Descendant , descendantAxis) , (DescendantOrSelf , descendantOrSelfAxis) , (Following , followingAxis) , (FollowingSibling , followingSiblingAxis) , (Parent , parentAxis) , (Preceding , precedingAxis) , (PrecedingSibling , precedingSiblingAxis) , (Self , selfAxis) ] -- ----------------------------------------------------------------------------- -- | -- evaluates a location path, -- evaluation of an absolute path starts at the document root, -- the relative path at the context node locPathEval :: Env -> LocationPath -> XPathFilter locPathEval env (LocPath Rel steps) = evalSteps env steps locPathEval env (LocPath Abs steps) = evalSteps env steps . getRoot -- ----------------------------------------------------------------------------- evalSteps :: Env -> [XStep] -> XPathFilter evalSteps env steps ns = foldl (flip $ evalStep env) ns steps -- | -- evaluate a single XPath step -- namespace-axis is not supported evalStep :: Env -> XStep -> XPathFilter evalStep _ (Step Namespace _ _ ) _ = XPVError "namespace-axis not supported" evalStep _ (Step Attribute nt _ ) ns = withXPVNode "Call to getAxis without a nodeset" evalAttr' ns where evalAttr' = nodeListResToXPathValue . sumNL . map (evalAttr nt) . getAxisNodes Attribute evalStep env (Step axisSpec nt pr) ns = withXPVNode "Call to getAxis without a nodeset" evalSingleStep ns where evalSingleStep = nodeListResToXPathValue . sumNL . map (evalStep' env pr nt) . getAxisNodes axisSpec -- ----------------------------------------------------------------------------- -- the goal: -- evalAttr :: NodeTest -> NavXmlTrees -> XPathValue evalAttr :: NodeTest -> NodeListRes -> NodeListRes evalAttr nt = mapNL (Right . evalAttrNodeTest nt) evalAttrNodeTest :: NodeTest -> NavXmlTree -> NavXmlTrees evalAttrNodeTest (NameTest qn) ns@(NT (NTree (XAttr qn1) _) _ix _ _ _) = if ( ( uri == uri1 && lp == lp1) || ((uri == "" || uri == uri1) && lp == "*") ) then [ns] else [] where uri = namespaceUri qn uri1 = namespaceUri qn1 lp = localPart qn lp1 = localPart qn1 evalAttrNodeTest (TypeTest XPNode) ns@(NT (NTree (XAttr _) _) _ix _ _ _) = [ns] evalAttrNodeTest _ _ = [] -- ----------------------------------------------------------------------------- evalStep' :: Env -> [Expr] -> NodeTest -> NodeListRes -> NodeListRes evalStep' env pr nt = evalPredL env pr . nodeTest nt 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] -- ----------------------------------------------------------------------------- -- | -- filter for selecting a special type of nodes from the current fragment tree -- -- the filter works with namespace activated and without namespaces. -- If namespaces occur in XPath names, the uris are used for matching, -- else the name prefix -- -- Bugfix : "*" (or any other name-test) must not match the root node nodeTest :: NodeTest -> NodeListRes -> NodeListRes nodeTest _ res@(Left _) = res nodeTest t (Right ns) = Right . nodeTest' t $ ns nodeTest' :: NodeTest -> NodeList -> NodeList nodeTest' (NameTest q) | isWildcardTest = filterNodes' (wildcardTest q) | otherwise = filterNodes' (nameTest q) where isWildcardTest = localPart q == "*" nodeTest' (PI n) = filterNodes' isPiNode where isPiNode = maybe False ((== n) . qualifiedName) . XN.getPiName 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 nameTest xpName (XTag elemName _) | namespaceAware = localPart xpName == localPart elemName && namespaceUri xpName == namespaceUri elemName | otherwise = qualifiedName xpName == qualifiedName elemName where namespaceAware = not . null . namespaceUri $ xpName nameTest _ _ = False -- ----------------------------------------------------------------------------- wildcardTest :: QName -> XNode -> Bool wildcardTest xpName (XTag elemName _) | namespaceAware = namespaceUri xpName == namespaceUri elemName | prefixMatch = namePrefix xpName == namePrefix elemName | otherwise = localPart elemName /= t_root -- all names except the root name "/" where namespaceAware = not . null . namespaceUri $ xpName prefixMatch = not . null . namePrefix $ xpName wildcardTest _ _ = False -- ----------------------------------------------------------------------------- -- | -- tests whether a node is of a special type -- typeTest :: XPathNode -> NodeList -> NodeList typeTest XPNode = id typeTest XPCommentNode = filterNodes' XN.isCmt typeTest XPPINode = filterNodes' XN.isPi typeTest XPTextNode = filterNodes' XN.isText -- ----------------------------------------------------------------------------- -- | -- evaluates a boolean expression, the evaluation is non-strict boolEval :: Env -> Context -> Op -> [Expr] -> XPathFilter boolEval _ _ op [] _ = XPVBool (op == And) boolEval env cont Or (x:xs) ns = case xboolean cont env [evalExpr env cont x ns] of e@(XPVError _) -> e XPVBool True -> XPVBool True _ -> boolEval env cont Or xs ns boolEval env cont And (x:xs) ns = case xboolean cont env [evalExpr env cont x ns] of e@(XPVError _) -> e XPVBool True -> boolEval env cont And xs ns _ -> XPVBool False boolEval _ _ _ _ _ = XPVError "Call to boolEval with a wrong argument" -- ----------------------------------------------------------------------------- -- | -- returns the value of a variable getVariable :: Env -> VarName -> XPathFilter getVariable env name _ = fromMaybe (XPVError ("Variable: " ++ show name ++ " not found")) $ lookup name (getVarTab env) -- ----------------------------------------------------------------------------- -- | -- evaluates a function, -- computation is done by 'XPathFct.evalFct' which is defined in "XPathFct". fctEval :: Env -> Context -> FctName -> [Expr] -> XPathFilter fctEval env cont name args = evalFct name env cont . evalExprL env cont args -- ----------------------------------------------------------------------------- -- | -- evaluates an arithmetic operation. -- -- 1.parameter f : arithmetic function from "XPathArithmetic" -- numEval :: (Op -> XPathValue -> XPathValue -> XPathValue) -> Op -> [XPathValue] -> XPathValue numEval f op = foldl1 (f op) -- ----------------------------------------------------------------------------- -- | -- Convert list of ID attributes from DTD into a space separated 'XPVString' -- idAttributesToXPathValue :: XmlTrees -> XPathValue idAttributesToXPathValue ts = XPVString (foldr (\ n -> ( (valueOfDTD a_value n ++ " ") ++)) [] ts) -- ----------------------------------------------------------------------------- -- | -- Extracts all ID-attributes from the document type definition (DTD). -- getIdAttributes :: XmlTree -> XmlTrees getIdAttributes = runLA $ AT.getChildren >>> isDTD >>> AT.deep (isIdAttrType) -- ---------------------------------------- isIdAttrType :: ArrowDTD a => a XmlTree XmlTree isIdAttrType = hasDTDAttrValue a_type (== k_id) valueOfDTD :: String -> XmlTree -> String valueOfDTD n = concat . runLA ( getDTDAttrl >>^ lookup1 n ) hasDTDAttrValue :: ArrowDTD a => String -> (String -> Bool) -> a XmlTree XmlTree hasDTDAttrValue an p = filterA $ getDTDAttrl >>> isA (p . lookup1 an) -- ------------------------------------------------------------