-- ------------------------------------------------------------

{- |
   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 :: String -> XmlTree -> XmlTrees
getXPath                = Attributes -> String -> XmlTree -> XmlTrees
getXPathWithNsEnv []

-- -----------------------------------------------------------------------------
-- |
-- Select parts of a document by an already parsed XPath expression

getXPath'               :: Expr -> XmlTree -> XmlTrees
getXPath' :: Expr -> XmlTree -> XmlTrees
getXPath' Expr
e             = LA XmlTree XmlTree -> XmlTree -> XmlTrees
forall a b. LA a b -> a -> [b]
runLA (LA XmlTree XmlTree -> XmlTree -> XmlTrees)
-> LA XmlTree XmlTree -> XmlTree -> XmlTrees
forall a b. (a -> b) -> a -> b
$
                          LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
canonicalizeForXPath
                          LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                          (XmlTree -> XmlTrees) -> LA XmlTree XmlTree
forall b c. (b -> [c]) -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((XPathValue -> XmlTrees) -> Expr -> XmlTree -> XmlTrees
forall a. (XPathValue -> a) -> Expr -> XmlTree -> a
getXPathValues' XPathValue -> XmlTrees
xPValue2XmlTrees Expr
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 :: Attributes -> String -> XmlTree -> XmlTrees
getXPathWithNsEnv Attributes
env String
s = LA XmlTree XmlTree -> XmlTree -> XmlTrees
forall a b. LA a b -> a -> [b]
runLA ( LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowList a => a XmlTree XmlTree
canonicalizeForXPath
                                  LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                  (XmlTree -> XmlTrees) -> LA XmlTree XmlTree
forall b c. (b -> [c]) -> LA b c
forall (a :: * -> * -> *) b c. ArrowList a => (b -> [c]) -> a b c
arrL ((XPathValue -> XmlTrees)
-> (String -> XmlTrees)
-> Attributes
-> String
-> XmlTree
-> XmlTrees
forall a.
(XPathValue -> a)
-> (String -> a) -> Attributes -> String -> XmlTree -> a
getXPathValues XPathValue -> XmlTrees
xPValue2XmlTrees String -> XmlTrees
xPathErr Attributes
env String
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 :: String -> XmlTree -> XmlTrees
getXPathSubTrees                        = Attributes -> String -> XmlTree -> XmlTrees
getXPathSubTreesWithNsEnv []

-- -----------------------------------------------------------------------------
-- |
-- Select parts of an XML tree by an XPath expression.

getXPathSubTrees'                       :: Expr -> XmlTree -> XmlTrees
getXPathSubTrees' :: Expr -> XmlTree -> XmlTrees
getXPathSubTrees'                       = (XPathValue -> XmlTrees) -> Expr -> XmlTree -> XmlTrees
forall a. (XPathValue -> a) -> Expr -> XmlTree -> a
getXPathValues' XPathValue -> XmlTrees
xPValue2XmlTrees

-- -----------------------------------------------------------------------------
-- | Same as 'getXPathSubTrees' but with namespace aware XPath expression

getXPathSubTreesWithNsEnv               :: Attributes -> String -> XmlTree -> XmlTrees
getXPathSubTreesWithNsEnv :: Attributes -> String -> XmlTree -> XmlTrees
getXPathSubTreesWithNsEnv Attributes
nsEnv String
xpStr   = (XPathValue -> XmlTrees)
-> (String -> XmlTrees)
-> Attributes
-> String
-> XmlTree
-> XmlTrees
forall a.
(XPathValue -> a)
-> (String -> a) -> Attributes -> String -> XmlTree -> a
getXPathValues XPathValue -> XmlTrees
xPValue2XmlTrees String -> XmlTrees
xPathErr Attributes
nsEnv String
xpStr

-- -----------------------------------------------------------------------------
-- |
-- compute the node set of an XPath query

getXPathNodeSet'                        :: String -> XmlTree -> XmlNodeSet
getXPathNodeSet' :: String -> XmlTree -> XmlNodeSet
getXPathNodeSet'                        = Attributes -> String -> XmlTree -> XmlNodeSet
getXPathNodeSetWithNsEnv' []

-- -----------------------------------------------------------------------------
-- |
-- compute the node set of an XPath query for an already parsed XPath expr

getXPathNodeSet''                       :: Expr -> XmlTree -> XmlNodeSet
getXPathNodeSet'' :: Expr -> XmlTree -> XmlNodeSet
getXPathNodeSet''                       = (XPathValue -> XmlNodeSet) -> Expr -> XmlTree -> XmlNodeSet
forall a. (XPathValue -> a) -> Expr -> XmlTree -> a
getXPathValues' XPathValue -> XmlNodeSet
xPValue2XmlNodeSet

-- -----------------------------------------------------------------------------
-- | compute the node set of a namespace aware XPath query

getXPathNodeSetWithNsEnv'               :: Attributes -> String -> XmlTree -> XmlNodeSet
getXPathNodeSetWithNsEnv' :: Attributes -> String -> XmlTree -> XmlNodeSet
getXPathNodeSetWithNsEnv' Attributes
nsEnv String
xpStr   = (XPathValue -> XmlNodeSet)
-> (String -> XmlNodeSet)
-> Attributes
-> String
-> XmlTree
-> XmlNodeSet
forall a.
(XPathValue -> a)
-> (String -> a) -> Attributes -> String -> XmlTree -> a
getXPathValues XPathValue -> XmlNodeSet
xPValue2XmlNodeSet (XmlNodeSet -> String -> XmlNodeSet
forall a b. a -> b -> a
const XmlNodeSet
emptyXmlNodeSet) Attributes
nsEnv String
xpStr

-- -----------------------------------------------------------------------------

-- | parse xpath, evaluate xpath expr and prepare results

getXPathValues                          :: (XPathValue -> a) -> (String -> a) -> Attributes -> String -> XmlTree -> a
getXPathValues :: forall a.
(XPathValue -> a)
-> (String -> a) -> Attributes -> String -> XmlTree -> a
getXPathValues XPathValue -> a
cvRes String -> a
cvErr Attributes
nsEnv String
xpStr XmlTree
t
                                        = case Attributes -> String -> Either String Expr
parseXPathExprWithNsEnv Attributes
nsEnv String
xpStr of
                                          Left  String
parseError      -> String -> a
cvErr String
parseError
                                          Right Expr
xpExpr          -> (XPathValue -> a) -> Expr -> XmlTree -> a
forall a. (XPathValue -> a) -> Expr -> XmlTree -> a
getXPathValues' XPathValue -> a
cvRes Expr
xpExpr XmlTree
t

xPathErr                                :: String -> [XmlTree]
xPathErr :: String -> XmlTrees
xPathErr String
parseError                     = [ Int -> String -> XmlTree
forall a. XmlNode a => Int -> String -> a
XN.mkError Int
c_err String
parseError ]

-- -----------------------------------------------------------------------------

-- | parse xpath, evaluate xpath expr and prepare results

getXPathValues'                         :: (XPathValue -> a) -> Expr -> XmlTree -> a
getXPathValues' :: forall a. (XPathValue -> a) -> Expr -> XmlTree -> a
getXPathValues' XPathValue -> a
cvRes Expr
xpExpr XmlTree
t          = XPathValue -> a
cvRes XPathValue
xpRes
    where
    t' :: XmlTree
t'                                  = XmlTree -> XmlTree
addRoot' XmlTree
t                            -- we need a root node for starting xpath eval
    idAttr :: (VarName, XPathValue)
idAttr                              = ( (String
"", String
"idAttr")                      -- id attributes from DTD (if there)
                                          , XmlTrees -> XPathValue
idAttributesToXPathValue (XmlTrees -> XPathValue)
-> (XmlTree -> XmlTrees) -> XmlTree -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlTree -> XmlTrees
getIdAttributes (XmlTree -> XPathValue) -> XmlTree -> XPathValue
forall a b. (a -> b) -> a -> b
$ XmlTree
t'
                                          )
    navTD :: NavTree XNode
navTD                               = XmlTree -> NavTree XNode
forall a. NTree a -> NavTree a
ntree XmlTree
t'
    xpRes :: XPathValue
xpRes                               = Env -> Context -> Expr -> XPathFilter
evalExpr ((VarName, XPathValue)
idAttr(VarName, XPathValue)
-> [(VarName, XPathValue)] -> [(VarName, XPathValue)]
forall a. a -> [a] -> [a]
:(Env -> [(VarName, XPathValue)]
getVarTab Env
varEnv),[]) (Int
1, Int
1, NavTree XNode
navTD) Expr
xpExpr (NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> (NavTree XNode -> NodeSet) -> NavTree XNode -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree XNode -> NodeSet
singletonNodeSet (NavTree XNode -> XPathValue) -> NavTree XNode -> XPathValue
forall a b. (a -> b) -> a -> b
$ NavTree XNode
navTD)

addRoot'                                :: XmlTree -> XmlTree
addRoot' :: XmlTree -> XmlTree
addRoot' XmlTree
t
    | XmlTree -> Bool
forall a. XmlNode a => a -> Bool
XN.isRoot XmlTree
t                       = XmlTree
t
    | Bool
otherwise                         = XmlTrees -> XmlTrees -> XmlTree
XN.mkRoot [] [XmlTree
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 :: String -> Either String Expr
parseXPathExpr                          = Attributes -> String -> Either String Expr
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 :: Attributes -> String -> Either String Expr
parseXPathExprWithNsEnv Attributes
nsEnv String
xpStr     = (ParseError -> String)
-> Either ParseError Expr -> Either String Expr
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ParseError -> String
forall {a}. Show a => a -> String
fmtErr (Either ParseError Expr -> Either String Expr)
-> (String -> Either ParseError Expr)
-> String
-> Either String Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenParser Char (XPState NsEnv) Expr
-> XPState NsEnv -> String -> String -> Either ParseError Expr
forall tok st a.
GenParser tok st a -> st -> String -> [tok] -> Either ParseError a
runParser GenParser Char (XPState NsEnv) Expr
parseXPath (NsEnv -> XPState NsEnv
forall a. a -> XPState a
withNormNewline (Attributes -> NsEnv
toNsEnv Attributes
nsEnv)) String
"" (String -> Either String Expr) -> String -> Either String Expr
forall a b. (a -> b) -> a -> b
$ String
xpStr
    where
    fmtErr :: a -> String
fmtErr a
parseError                   = String
"Syntax error in XPath expression " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                          String -> String
forall {a}. Show a => a -> String
show String
xpStr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                                          a -> String
forall {a}. Show a => a -> String
show a
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 -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
cont (GenExpr Op
Or [Expr]
ex)       = Env -> Context -> Op -> [Expr] -> XPathFilter
boolEval  Env
env Context
cont Op
Or  [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
And [Expr]
ex)      = Env -> Context -> Op -> [Expr] -> XPathFilter
boolEval  Env
env Context
cont Op
And [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Eq [Expr]
ex)       = Env -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
Eq        ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
NEq [Expr]
ex)      = Env -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
NEq       ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Less [Expr]
ex)     = Env -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
Less      ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
LessEq [Expr]
ex)   = Env -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
LessEq    ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Greater [Expr]
ex)  = Env -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
Greater   ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
GreaterEq [Expr]
ex)
                                        = Env -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
GreaterEq ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Plus [Expr]
ex)     = (Op -> XPathValue -> XPathFilter)
-> Op -> [XPathValue] -> XPathValue
numEval Op -> XPathValue -> XPathFilter
xPathAdd   Op
Plus  ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
cont Env
env ([XPathValue] -> [XPathValue])
-> (XPathValue -> [XPathValue]) -> XPathValue -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Minus [Expr]
ex)    = (Op -> XPathValue -> XPathFilter)
-> Op -> [XPathValue] -> XPathValue
numEval Op -> XPathValue -> XPathFilter
xPathAdd   Op
Minus ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
cont Env
env ([XPathValue] -> [XPathValue])
-> (XPathValue -> [XPathValue]) -> XPathValue -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Div [Expr]
ex)      = (Op -> XPathValue -> XPathFilter)
-> Op -> [XPathValue] -> XPathValue
numEval Op -> XPathValue -> XPathFilter
xPathDiv   Op
Div   ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
cont Env
env ([XPathValue] -> [XPathValue])
-> (XPathValue -> [XPathValue]) -> XPathValue -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Mod [Expr]
ex)      = (Op -> XPathValue -> XPathFilter)
-> Op -> [XPathValue] -> XPathValue
numEval Op -> XPathValue -> XPathFilter
xPathMod   Op
Mod   ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
cont Env
env ([XPathValue] -> [XPathValue])
-> (XPathValue -> [XPathValue]) -> XPathValue -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Mult [Expr]
ex)     = (Op -> XPathValue -> XPathFilter)
-> Op -> [XPathValue] -> XPathValue
numEval Op -> XPathValue -> XPathFilter
xPathMulti Op
Mult  ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
cont Env
env ([XPathValue] -> [XPathValue])
-> (XPathValue -> [XPathValue]) -> XPathValue -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Unary [Expr]
ex)    = XPathFilter
xPathUnary XPathFilter -> XPathFilter -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct
xnumber Context
cont Env
env ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (GenExpr Op
Union [Expr]
ex)    = [XPathValue] -> XPathValue
unionEval ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
cont (FctExpr String
name [Expr]
args)   = Env -> Context -> String -> [Expr] -> XPathFilter
fctEval Env
env Context
cont String
name [Expr]
args

evalExpr Env
env Context
_    (PathExpr Maybe Expr
Nothing   (Just LocationPath
lp))
                                        = Env -> LocationPath -> XPathFilter
locPathEval Env
env LocationPath
lp
evalExpr Env
env Context
cont (PathExpr (Just Expr
fe) (Just LocationPath
lp))
                                        = Env -> LocationPath -> XPathFilter
locPathEval Env
env LocationPath
lp XPathFilter -> XPathFilter -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
cont Expr
fe

evalExpr Env
env Context
cont (FilterExpr [Expr]
ex)       = Env -> Context -> [Expr] -> XPathFilter
filterEval Env
env Context
cont [Expr]
ex
evalExpr Env
env Context
_    Expr
ex                    = Env -> Expr -> XPathFilter
evalSpezExpr Env
env Expr
ex

-- -----------------------------------------------------------------------------

evalExprL                               :: Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL :: Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
ex XPathValue
ns                = (Expr -> XPathValue) -> [Expr] -> [XPathValue]
forall a b. (a -> b) -> [a] -> [b]
map (\Expr
e -> Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
cont Expr
e XPathValue
ns) [Expr]
ex

-- -----------------------------------------------------------------------------

evalSpezExpr                            :: Env -> Expr -> XPathFilter
evalSpezExpr :: Env -> Expr -> XPathFilter
evalSpezExpr Env
_ (NumberExpr (Float Float
0)) XPathValue
_ = XPNumber -> XPathValue
XPVNumber XPNumber
Pos0
evalSpezExpr Env
_ (NumberExpr (Float Float
f)) XPathValue
_ = XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float Float
f)
evalSpezExpr Env
_ (LiteralExpr String
s) XPathValue
_        = String -> XPathValue
XPVString String
s
evalSpezExpr Env
env (VarExpr VarName
name) XPathValue
v       = Env -> VarName -> XPathFilter
getVariable Env
env VarName
name XPathValue
v
evalSpezExpr Env
_ Expr
_ XPathValue
_                      = String -> XPathValue
XPVError String
"Call to evalExpr with a wrong argument"

-- -----------------------------------------------------------------------------

-- |
-- filter for evaluating a filter-expression

filterEval                              :: Env -> Context -> [Expr] -> XPathFilter
filterEval :: Env -> Context -> [Expr] -> XPathFilter
filterEval Env
env Context
cont (Expr
prim:[Expr]
predicates) XPathValue
ns
                                        = case Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
cont Expr
prim XPathValue
ns of
                                          (XPVNode NodeSet
nns) -> NodeListRes -> XPathValue
nodeListResToXPathValue (NodeListRes -> XPathValue)
-> (NodeSet -> NodeListRes) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> [Expr] -> NodeListRes -> NodeListRes
evalPredL Env
env [Expr]
predicates (NodeListRes -> NodeListRes)
-> (NodeSet -> NodeListRes) -> NodeSet -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeList -> NodeListRes
forall a b. b -> Either a b
Right (NodeList -> NodeListRes)
-> (NodeSet -> NodeList) -> NodeSet -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NodeList
fromNodeSet (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NodeSet
nns
                                          XPathValue
_             -> String -> XPathValue
XPVError String
"Return of a filterexpression is not a nodeset"
filterEval Env
_ Context
_ [Expr]
_ XPathValue
_                      = String -> XPathValue
XPVError String
"Call to filterEval without an expression"


-- -----------------------------------------------------------------------------
-- |
-- returns the union of its arguments, the arguments have to be node-sets.

unionEval                               :: [XPathValue] -> XPathValue
unionEval :: [XPathValue] -> XPathValue
unionEval [XPathValue]
vs
    | Bool -> Bool
not ([XPathValue] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XPathValue]
evs)                    = case [XPathValue] -> XPathValue
forall a. HasCallStack => [a] -> a
head [XPathValue]
evs of
                                          e :: XPathValue
e@(XPVError String
_)        -> XPathValue
e
                                          XPathValue
_                     -> String -> XPathValue
XPVError String
"A value of a union ( | ) is not a nodeset"
    | Bool
otherwise                         = NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> ([XPathValue] -> NodeSet) -> [XPathValue] -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeSet] -> NodeSet
unionsNodeSet ([NodeSet] -> NodeSet)
-> ([XPathValue] -> [NodeSet]) -> [XPathValue] -> NodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPathValue -> NodeSet) -> [XPathValue] -> [NodeSet]
forall a b. (a -> b) -> [a] -> [b]
map XPathValue -> NodeSet
theNode ([XPathValue] -> XPathValue) -> [XPathValue] -> XPathValue
forall a b. (a -> b) -> a -> b
$ [XPathValue]
nvs
    where
    ([XPathValue]
nvs, [XPathValue]
evs)                          = (XPathValue -> Bool)
-> [XPathValue] -> ([XPathValue], [XPathValue])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition XPathValue -> Bool
isNode [XPathValue]
vs

    isNode :: XPathValue -> Bool
isNode (XPVNode NodeSet
_)                  = Bool
True
    isNode XPathValue
_                            = Bool
False

    theNode :: XPathValue -> NodeSet
theNode (XPVNode NodeSet
ns)                = NodeSet
ns
    theNode XPathValue
_                           = String -> NodeSet
forall a. HasCallStack => String -> a
error String
"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 -> Context -> Op -> [XPathValue] -> XPathValue
relEqEval Env
env Context
cont Op
op                   = (XPathValue -> XPathFilter) -> [XPathValue] -> XPathValue
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (Env -> Context -> Op -> XPathValue -> XPathFilter
relEqEv' Env
env Context
cont Op
op)

relEqEv'                                :: Env -> Context -> Op -> XPathValue -> XPathFilter
relEqEv' :: Env -> Context -> Op -> XPathValue -> XPathFilter
relEqEv' Env
_ Context
_ Op
_ e :: XPathValue
e@(XPVError String
_) XPathValue
_         = XPathValue
e
relEqEv' Env
_ Context
_ Op
_ XPathValue
_ e :: XPathValue
e@(XPVError String
_)         = XPathValue
e

-- two node-sets

relEqEv' Env
env Context
cont Op
op a :: XPathValue
a@(XPVNode NodeSet
_)
                     b :: XPathValue
b@(XPVNode NodeSet
_)      = Env -> Context -> Op -> XPathValue -> XPathFilter
relEqTwoNodes Env
env Context
cont Op
op XPathValue
a XPathValue
b

-- one node-set

relEqEv' Env
env Context
cont Op
op XPathValue
a b :: XPathValue
b@(XPVNode NodeSet
_)    = Env
-> Context
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathFilter
relEqOneNode Env
env Context
cont (Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue -> XPathValue -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (XPathValue -> XPathValue -> Bool)
 -> XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathValue
-> Bool
forall a b. (a -> b) -> a -> b
$ Op -> Maybe (XPathValue -> XPathValue -> Bool)
getOpFct Op
op) XPathValue
a XPathValue
b
relEqEv' Env
env Context
cont Op
op a :: XPathValue
a@(XPVNode NodeSet
_) XPathValue
b    = Env
-> Context
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathFilter
relEqOneNode Env
env Context
cont ((XPathValue -> XPathValue -> Bool)
-> XPathValue -> XPathValue -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((XPathValue -> XPathValue -> Bool)
 -> XPathValue -> XPathValue -> Bool)
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathValue
-> Bool
forall a b. (a -> b) -> a -> b
$ Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue -> XPathValue -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (XPathValue -> XPathValue -> Bool)
 -> XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathValue
-> Bool
forall a b. (a -> b) -> a -> b
$ Op -> Maybe (XPathValue -> XPathValue -> Bool)
getOpFct Op
op) XPathValue
b XPathValue
a


--  test without a node-set and equality or not-equality operator

relEqEv' Env
env Context
cont Op
Eq XPathValue
a XPathValue
b                = Env
-> Context
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathFilter
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
forall a. Eq a => a -> a -> Bool
(==) XPathValue
a XPathValue
b
relEqEv' Env
env Context
cont Op
NEq XPathValue
a XPathValue
b               = Env
-> Context
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathFilter
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
forall a. Eq a => a -> a -> Bool
(/=) XPathValue
a XPathValue
b

-- test without a node-set and less, less-equal, greater or greater-equal operator

relEqEv' Env
env Context
cont Op
op XPathValue
a XPathValue
b                = Bool -> XPathValue
XPVBool ((Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue -> XPathValue -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (XPathValue -> XPathValue -> Bool)
 -> XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathValue
-> Bool
forall a b. (a -> b) -> a -> b
$ Op -> Maybe (XPathValue -> XPathValue -> Bool)
getOpFct Op
op) (XPathFilter
toXNumber XPathValue
a) (XPathFilter
toXNumber XPathValue
b))
    where
    toXNumber :: XPathFilter
toXNumber XPathValue
x                         = XFct
xnumber Context
cont Env
env [XPathValue
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 :: Env -> Context -> Op -> XPathValue -> XPathFilter
relEqTwoNodes Env
_ Context
_ Op
op (XPVNode NodeSet
ns)
                     (XPVNode NodeSet
ms)       = Bool -> XPathValue
XPVBool (Bool -> XPathValue) -> Bool -> XPathValue
forall a b. (a -> b) -> a -> b
$
                                          (NavTree XNode -> Bool -> Bool) -> Bool -> NodeList -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr  (\NavTree XNode
n -> ((XPathValue -> Bool) -> [XPathValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Op -> NavTree XNode -> XPathValue -> Bool
fct Op
op NavTree XNode
n) (NodeSet -> [XPathValue]
getStrValues NodeSet
ms) Bool -> Bool -> Bool
||)) Bool
False (NodeList -> Bool) -> NodeList -> Bool
forall a b. (a -> b) -> a -> b
$
                                          NodeSet -> NodeList
fromNodeSet NodeSet
ns
                                          where
                                          fct :: Op -> NavTree XNode -> XPathValue -> Bool
fct Op
op' NavTree XNode
n'   = (Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue -> XPathValue -> Bool
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (XPathValue -> XPathValue -> Bool)
 -> XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathValue
-> Bool
forall a b. (a -> b) -> a -> b
$ Op -> Maybe (XPathValue -> XPathValue -> Bool)
getOpFct Op
op') (NavTree XNode -> XPathValue
stringValue NavTree XNode
n')
                                          getStrValues :: NodeSet -> [XPathValue]
getStrValues = (NavTree XNode -> XPathValue) -> NodeList -> [XPathValue]
forall a b. (a -> b) -> [a] -> [b]
map NavTree XNode -> XPathValue
stringValue (NodeList -> [XPathValue])
-> (NodeSet -> NodeList) -> NodeSet -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NodeList
fromNodeSet
relEqTwoNodes Env
_ Context
_ Op
_ XPathValue
_ XPathValue
_                 = String -> XPathValue
XPVError String
"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
-> Context
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathFilter
relEqOneNode Env
env Context
cont XPathValue -> XPathValue -> Bool
fct XPathValue
arg           = String -> (NodeSet -> XPathValue) -> XPathFilter
withXPVNode String
"Call to relEqOneNode without a nodeset" ((NodeSet -> XPathValue) -> XPathFilter)
-> (NodeSet -> XPathValue) -> XPathFilter
forall a b. (a -> b) -> a -> b
$
                                          \ NodeSet
ns -> Bool -> XPathValue
XPVBool ((XPathValue -> Bool) -> [XPathValue] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any  (XPathValue -> XPathValue -> Bool
fct XPathValue
arg) (XPathValue -> NodeSet -> [XPathValue]
getStrValues XPathValue
arg NodeSet
ns))
    where
    getStrValues :: XPathValue -> NodeSet -> [XPathValue]
getStrValues XPathValue
arg'                   = XPathFilter -> [XPathValue] -> [XPathValue]
forall a b. (a -> b) -> [a] -> [b]
map ((Maybe XFct -> XFct
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe XFct -> XFct) -> Maybe XFct -> XFct
forall a b. (a -> b) -> a -> b
$ XPathValue -> Maybe XFct
getConvFct XPathValue
arg') Context
cont Env
env ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XPathValue -> [XPathValue] -> [XPathValue]
forall a. a -> [a] -> [a]
:[])) ([XPathValue] -> [XPathValue])
-> (NodeSet -> [XPathValue]) -> NodeSet -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          (NavTree XNode -> XPathValue) -> NodeList -> [XPathValue]
forall a b. (a -> b) -> [a] -> [b]
map NavTree XNode -> XPathValue
stringValue (NodeList -> [XPathValue])
-> (NodeSet -> NodeList) -> NodeSet -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                                          NodeSet -> NodeList
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
-> Context
-> (XPathValue -> XPathValue -> Bool)
-> XPathValue
-> XPathFilter
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
fct f :: XPathValue
f@(XPVBool Bool
_) XPathValue
g       = Bool -> XPathValue
XPVBool (XPathValue
f XPathValue -> XPathValue -> Bool
`fct` XFct
xboolean Context
cont Env
env [XPathValue
g])
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
fct XPathValue
f g :: XPathValue
g@(XPVBool Bool
_)       = Bool -> XPathValue
XPVBool (XFct
xboolean Context
cont Env
env [XPathValue
f] XPathValue -> XPathValue -> Bool
`fct` XPathValue
g)
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
fct f :: XPathValue
f@(XPVNumber XPNumber
_) XPathValue
g     = Bool -> XPathValue
XPVBool (XPathValue
f XPathValue -> XPathValue -> Bool
`fct` XFct
xnumber Context
cont Env
env [XPathValue
g])
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
fct XPathValue
f g :: XPathValue
g@(XPVNumber XPNumber
_)     = Bool -> XPathValue
XPVBool (XFct
xnumber Context
cont Env
env [XPathValue
f] XPathValue -> XPathValue -> Bool
`fct` XPathValue
g)
eqEv Env
env Context
cont XPathValue -> XPathValue -> Bool
fct XPathValue
f XPathValue
g                   = Bool -> XPathValue
XPVBool (XFct
xstring Context
cont Env
env [XPathValue
f] XPathValue -> XPathValue -> Bool
`fct` XFct
xstring Context
cont Env
env [XPathValue
g])

-- -----------------------------------------------------------------------------

getOpFct                                :: Op -> Maybe (XPathValue -> XPathValue -> Bool)
getOpFct :: Op -> Maybe (XPathValue -> XPathValue -> Bool)
getOpFct Op
Eq                             = (XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
forall a. a -> Maybe a
Just XPathValue -> XPathValue -> Bool
forall a. Eq a => a -> a -> Bool
(==)
getOpFct Op
NEq                            = (XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
forall a. a -> Maybe a
Just XPathValue -> XPathValue -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
getOpFct Op
Less                           = (XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
forall a. a -> Maybe a
Just XPathValue -> XPathValue -> Bool
forall a. Ord a => a -> a -> Bool
(<)
getOpFct Op
LessEq                         = (XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
forall a. a -> Maybe a
Just XPathValue -> XPathValue -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
getOpFct Op
Greater                        = (XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
forall a. a -> Maybe a
Just XPathValue -> XPathValue -> Bool
forall a. Ord a => a -> a -> Bool
(>)
getOpFct Op
GreaterEq                      = (XPathValue -> XPathValue -> Bool)
-> Maybe (XPathValue -> XPathValue -> Bool)
forall a. a -> Maybe a
Just XPathValue -> XPathValue -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
getOpFct Op
_                              = Maybe (XPathValue -> XPathValue -> Bool)
forall a. Maybe a
Nothing

-- -----------------------------------------------------------------------------

-- |
-- Filter for accessing the root element of a document tree

getRoot                                 :: XPathFilter
getRoot :: XPathFilter
getRoot                                 = String -> (NodeSet -> XPathValue) -> XPathFilter
withXPVNode String
"Call to getRoot without a nodeset" ((NodeSet -> XPathValue) -> XPathFilter)
-> (NodeSet -> XPathValue) -> XPathFilter
forall a b. (a -> b) -> a -> b
$ NodeSet -> XPathValue
getRoot'
    where
    getRoot' :: NodeSet -> XPathValue
getRoot' NodeSet
ns
        | NodeSet -> Bool
nullNodeSet NodeSet
ns                = String -> XPathValue
XPVError String
"Call to getRoot with empty nodeset"
        | Bool
otherwise                     = NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> (NodeSet -> NodeSet) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree XNode -> NodeSet
singletonNodeSet (NavTree XNode -> NodeSet)
-> (NodeSet -> NavTree XNode) -> NodeSet -> NodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree XNode -> NavTree XNode
forall {a}. NavTree a -> NavTree a
getRoot'' (NavTree XNode -> NavTree XNode)
-> (NodeSet -> NavTree XNode) -> NodeSet -> NavTree XNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NavTree XNode
headNodeSet (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NodeSet
ns

    getRoot'' :: NavTree a -> NavTree a
getRoot'' NavTree a
tree                      = case NavTree a -> Maybe (NavTree a)
forall a. NavTree a -> Maybe (NavTree a)
upNT NavTree a
tree of
                                          Maybe (NavTree a)
Nothing       -> NavTree a
tree
                                          Just NavTree a
t        -> NavTree a -> NavTree a
getRoot'' NavTree a
t

-- -----------------------------------------------------------------------------

type NodeList = NavXmlTrees

type NodeListRes = Either XPathValue NodeList

nodeListResToXPathValue :: NodeListRes -> XPathValue
nodeListResToXPathValue :: NodeListRes -> XPathValue
nodeListResToXPathValue = XPathFilter
-> (NodeList -> XPathValue) -> NodeListRes -> XPathValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either XPathFilter
forall a. a -> a
id (NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> (NodeList -> NodeSet) -> NodeList -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeList -> NodeSet
toNodeSet)

nullNL  :: NodeListRes
nullNL :: NodeListRes
nullNL  = NodeList -> NodeListRes
forall a b. b -> Either a b
Right []

plusNL  :: NodeListRes -> NodeListRes -> NodeListRes
plusNL :: NodeListRes -> NodeListRes -> NodeListRes
plusNL res :: NodeListRes
res@(Left XPathValue
_) NodeListRes
_                   = NodeListRes
res
plusNL NodeListRes
_            res :: NodeListRes
res@(Left XPathValue
_)        = NodeListRes
res
plusNL (Right NodeList
ns1)  (Right NodeList
ns2)         = NodeList -> NodeListRes
forall a b. b -> Either a b
Right (NodeList -> NodeListRes) -> NodeList -> NodeListRes
forall a b. (a -> b) -> a -> b
$ NodeList
ns1 NodeList -> NodeList -> NodeList
forall a. [a] -> [a] -> [a]
++ NodeList
ns2

sumNL   :: [NodeListRes] -> NodeListRes
sumNL :: [NodeListRes] -> NodeListRes
sumNL   = (NodeListRes -> NodeListRes -> NodeListRes)
-> NodeListRes -> [NodeListRes] -> NodeListRes
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NodeListRes -> NodeListRes -> NodeListRes
plusNL NodeListRes
nullNL

mapNL   :: (NavXmlTree -> NodeListRes) -> NodeListRes -> NodeListRes
mapNL :: (NavTree XNode -> NodeListRes) -> NodeListRes -> NodeListRes
mapNL NavTree XNode -> NodeListRes
_ res :: NodeListRes
res@(Left XPathValue
_)    = NodeListRes
res
mapNL NavTree XNode -> NodeListRes
f (Right NodeList
ns)      = [NodeListRes] -> NodeListRes
sumNL ([NodeListRes] -> NodeListRes)
-> (NodeList -> [NodeListRes]) -> NodeList -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NavTree XNode -> NodeListRes) -> NodeList -> [NodeListRes]
forall a b. (a -> b) -> [a] -> [b]
map NavTree XNode -> NodeListRes
f (NodeList -> NodeListRes) -> NodeList -> NodeListRes
forall a b. (a -> b) -> a -> b
$ NodeList
ns

mapNL'  :: (Int -> NavXmlTree -> NodeListRes) -> NodeListRes -> NodeListRes
mapNL' :: (Int -> NavTree XNode -> NodeListRes) -> NodeListRes -> NodeListRes
mapNL' Int -> NavTree XNode -> NodeListRes
_ res :: NodeListRes
res@(Left XPathValue
_)   = NodeListRes
res
mapNL' Int -> NavTree XNode -> NodeListRes
f (Right NodeList
ns)     = [NodeListRes] -> NodeListRes
sumNL ([NodeListRes] -> NodeListRes)
-> (NodeList -> [NodeListRes]) -> NodeList -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> NavTree XNode -> NodeListRes)
-> [Int] -> NodeList -> [NodeListRes]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> NavTree XNode -> NodeListRes
f [Int
1..] (NodeList -> NodeListRes) -> NodeList -> NodeListRes
forall a b. (a -> b) -> a -> b
$ NodeList
ns

-- ------------------------------------------------------------

-- |
-- Filter for accessing all nodes of a XPath-axis
--
--    * 1.parameter as :  axis specifier
--

getAxisNodes                            :: AxisSpec ->  NodeSet -> [NodeListRes]
getAxisNodes :: AxisSpec -> NodeSet -> [NodeListRes]
getAxisNodes AxisSpec
as                         =  (NavTree XNode -> NodeListRes) -> NodeList -> [NodeListRes]
forall a b. (a -> b) -> [a] -> [b]
map (NodeList -> NodeListRes
forall a b. b -> Either a b
Right (NodeList -> NodeListRes)
-> (NavTree XNode -> NodeList) -> NavTree XNode -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (NavTree XNode -> NodeList) -> NavTree XNode -> NodeList
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (NavTree XNode -> NodeList) -> NavTree XNode -> NodeList)
-> Maybe (NavTree XNode -> NodeList) -> NavTree XNode -> NodeList
forall a b. (a -> b) -> a -> b
$ AxisSpec
-> [(AxisSpec, NavTree XNode -> NodeList)]
-> Maybe (NavTree XNode -> NodeList)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup AxisSpec
as [(AxisSpec, NavTree XNode -> NodeList)]
axisFctL)) (NodeList -> [NodeListRes])
-> (NodeSet -> NodeList) -> NodeSet -> [NodeListRes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NodeList
fromNodeSet

-- |
-- Axis-Function-Table.
-- Each XPath axis-specifier is mapped to the corresponding axis-function

axisFctL                                :: [(AxisSpec, (NavXmlTree -> NavXmlTrees))]
axisFctL :: [(AxisSpec, NavTree XNode -> NodeList)]
axisFctL                                = [ (AxisSpec
Ancestor           , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
ancestorAxis)
                                          , (AxisSpec
AncestorOrSelf     , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
ancestorOrSelfAxis)
                                          , (AxisSpec
Attribute          , NavTree XNode -> NodeList
attributeAxis)
                                          , (AxisSpec
Child              , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
childAxis)
                                          , (AxisSpec
Descendant         , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
descendantAxis)
                                          , (AxisSpec
DescendantOrSelf   , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
descendantOrSelfAxis)
                                          , (AxisSpec
Following          , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
followingAxis)
                                          , (AxisSpec
FollowingSibling   , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
followingSiblingAxis)
                                          , (AxisSpec
Parent             , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
parentAxis)
                                          , (AxisSpec
Preceding          , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
precedingAxis)
                                          , (AxisSpec
PrecedingSibling   , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
precedingSiblingAxis)
                                          , (AxisSpec
Self               , NavTree XNode -> NodeList
forall a. NavTree a -> [NavTree a]
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 -> LocationPath -> XPathFilter
locPathEval Env
env (LocPath Path
Rel [XStep]
steps)     = Env -> [XStep] -> XPathFilter
evalSteps Env
env [XStep]
steps
locPathEval Env
env (LocPath Path
Abs [XStep]
steps)     = Env -> [XStep] -> XPathFilter
evalSteps Env
env [XStep]
steps XPathFilter -> XPathFilter -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPathFilter
getRoot


-- -----------------------------------------------------------------------------

evalSteps                               :: Env -> [XStep] -> XPathFilter
evalSteps :: Env -> [XStep] -> XPathFilter
evalSteps Env
env [XStep]
steps XPathValue
ns                  = (XPathValue -> XStep -> XPathValue)
-> XPathValue -> [XStep] -> XPathValue
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((XStep -> XPathFilter) -> XPathValue -> XStep -> XPathValue
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((XStep -> XPathFilter) -> XPathValue -> XStep -> XPathValue)
-> (XStep -> XPathFilter) -> XPathValue -> XStep -> XPathValue
forall a b. (a -> b) -> a -> b
$ Env -> XStep -> XPathFilter
evalStep Env
env) XPathValue
ns [XStep]
steps

-- |
-- evaluate a single XPath step
-- namespace-axis is not supported

evalStep                                :: Env -> XStep -> XPathFilter

evalStep :: Env -> XStep -> XPathFilter
evalStep Env
_   (Step AxisSpec
Namespace NodeTest
_  [Expr]
_ ) XPathValue
_   = String -> XPathValue
XPVError String
"namespace-axis not supported"
evalStep Env
_   (Step AxisSpec
Attribute NodeTest
nt [Expr]
_ ) XPathValue
ns  = String -> (NodeSet -> XPathValue) -> XPathFilter
withXPVNode String
"Call to getAxis without a nodeset"
                                          NodeSet -> XPathValue
evalAttr'
                                          XPathValue
ns
    where
      evalAttr' :: NodeSet -> XPathValue
evalAttr' = NodeListRes -> XPathValue
nodeListResToXPathValue (NodeListRes -> XPathValue)
-> (NodeSet -> NodeListRes) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeListRes] -> NodeListRes
sumNL ([NodeListRes] -> NodeListRes)
-> (NodeSet -> [NodeListRes]) -> NodeSet -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeListRes -> NodeListRes) -> [NodeListRes] -> [NodeListRes]
forall a b. (a -> b) -> [a] -> [b]
map (NodeTest -> NodeListRes -> NodeListRes
evalAttr NodeTest
nt) ([NodeListRes] -> [NodeListRes])
-> (NodeSet -> [NodeListRes]) -> NodeSet -> [NodeListRes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AxisSpec -> NodeSet -> [NodeListRes]
getAxisNodes AxisSpec
Attribute

evalStep Env
env (Step AxisSpec
axisSpec  NodeTest
nt [Expr]
pr) XPathValue
ns  = String -> (NodeSet -> XPathValue) -> XPathFilter
withXPVNode String
"Call to getAxis without a nodeset"
                                          NodeSet -> XPathValue
evalSingleStep
                                          XPathValue
ns
    where
      evalSingleStep :: NodeSet -> XPathValue
evalSingleStep = NodeListRes -> XPathValue
nodeListResToXPathValue (NodeListRes -> XPathValue)
-> (NodeSet -> NodeListRes) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NodeListRes] -> NodeListRes
sumNL ([NodeListRes] -> NodeListRes)
-> (NodeSet -> [NodeListRes]) -> NodeSet -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NodeListRes -> NodeListRes) -> [NodeListRes] -> [NodeListRes]
forall a b. (a -> b) -> [a] -> [b]
map (Env -> [Expr] -> NodeTest -> NodeListRes -> NodeListRes
evalStep' Env
env [Expr]
pr NodeTest
nt) ([NodeListRes] -> [NodeListRes])
-> (NodeSet -> [NodeListRes]) -> NodeSet -> [NodeListRes]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AxisSpec -> NodeSet -> [NodeListRes]
getAxisNodes AxisSpec
axisSpec

-- -----------------------------------------------------------------------------

-- the goal:
-- evalAttr                                :: NodeTest -> NavXmlTrees -> XPathValue

evalAttr                                :: NodeTest -> NodeListRes -> NodeListRes
evalAttr :: NodeTest -> NodeListRes -> NodeListRes
evalAttr NodeTest
nt                             =  (NavTree XNode -> NodeListRes) -> NodeListRes -> NodeListRes
mapNL (NodeList -> NodeListRes
forall a b. b -> Either a b
Right (NodeList -> NodeListRes)
-> (NavTree XNode -> NodeList) -> NavTree XNode -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeTest -> NavTree XNode -> NodeList
evalAttrNodeTest NodeTest
nt)

evalAttrNodeTest                        :: NodeTest -> NavXmlTree -> NavXmlTrees
evalAttrNodeTest :: NodeTest -> NavTree XNode -> NodeList
evalAttrNodeTest (NameTest QName
qn)
                 ns :: NavTree XNode
ns@(NT (NTree (XAttr QName
qn1) XmlTrees
_) Int
_ix NodeList
_ XmlTrees
_ XmlTrees
_)
                                        = if ( ( String
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
uri1               Bool -> Bool -> Bool
&& String
lp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
lp1)
                                               Bool -> Bool -> Bool
||
                                               ((String
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" Bool -> Bool -> Bool
|| String
uri String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
uri1) Bool -> Bool -> Bool
&& String
lp String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"*")
                                             )
                                          then [NavTree XNode
ns]
                                          else []
    where
    uri :: String
uri                                 = QName -> String
namespaceUri QName
qn
    uri1 :: String
uri1                                = QName -> String
namespaceUri QName
qn1
    lp :: String
lp                                  = QName -> String
localPart    QName
qn
    lp1 :: String
lp1                                 = QName -> String
localPart    QName
qn1

evalAttrNodeTest (TypeTest XPathNode
XPNode)
                 ns :: NavTree XNode
ns@(NT (NTree (XAttr QName
_) XmlTrees
_) Int
_ix NodeList
_ XmlTrees
_ XmlTrees
_)
                                        = [NavTree XNode
ns]
evalAttrNodeTest NodeTest
_ NavTree XNode
_                    = []

-- -----------------------------------------------------------------------------

evalStep'                               :: Env -> [Expr] -> NodeTest -> NodeListRes -> NodeListRes
evalStep' :: Env -> [Expr] -> NodeTest -> NodeListRes -> NodeListRes
evalStep' Env
env [Expr]
pr NodeTest
nt                     = Env -> [Expr] -> NodeListRes -> NodeListRes
evalPredL Env
env [Expr]
pr (NodeListRes -> NodeListRes)
-> (NodeListRes -> NodeListRes) -> NodeListRes -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeTest -> NodeListRes -> NodeListRes
nodeTest NodeTest
nt

evalPredL                               :: Env -> [Expr] -> NodeListRes -> NodeListRes
evalPredL :: Env -> [Expr] -> NodeListRes -> NodeListRes
evalPredL Env
env [Expr]
pr NodeListRes
ns                     = (NodeListRes -> Expr -> NodeListRes)
-> NodeListRes -> [Expr] -> NodeListRes
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Expr -> NodeListRes -> NodeListRes)
-> NodeListRes -> Expr -> NodeListRes
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Expr -> NodeListRes -> NodeListRes)
 -> NodeListRes -> Expr -> NodeListRes)
-> (Expr -> NodeListRes -> NodeListRes)
-> NodeListRes
-> Expr
-> NodeListRes
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> NodeListRes -> NodeListRes
evalPred Env
env) NodeListRes
ns [Expr]
pr

evalPred                                :: Env -> Expr -> NodeListRes -> NodeListRes
evalPred :: Env -> Expr -> NodeListRes -> NodeListRes
evalPred Env
_   Expr
_  res :: NodeListRes
res@(Left XPathValue
_)            = NodeListRes
res
evalPred Env
env Expr
ex arg :: NodeListRes
arg@(Right NodeList
ns)          = (Int -> NavTree XNode -> NodeListRes) -> NodeListRes -> NodeListRes
mapNL' (Env -> Expr -> Int -> Int -> NavTree XNode -> NodeListRes
evalPred' Env
env Expr
ex (NodeList -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length NodeList
ns)) NodeListRes
arg 

evalPred'                               :: Env -> Expr -> Int -> Int -> NavXmlTree -> NodeListRes
evalPred' :: Env -> Expr -> Int -> Int -> NavTree XNode -> NodeListRes
evalPred' Env
env Expr
ex Int
len Int
pos NavTree XNode
x              = case Env -> Context -> Expr -> XPathFilter
testPredicate Env
env (Int
pos, Int
len, NavTree XNode
x) Expr
ex (NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> (NavTree XNode -> NodeSet) -> NavTree XNode -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree XNode -> NodeSet
singletonNodeSet (NavTree XNode -> XPathValue) -> NavTree XNode -> XPathValue
forall a b. (a -> b) -> a -> b
$ NavTree XNode
x) of
                                          e :: XPathValue
e@(XPVError String
_) -> XPathValue -> NodeListRes
forall a b. a -> Either a b
Left XPathValue
e
                                          XPVBool Bool
True   -> NodeList -> NodeListRes
forall a b. b -> Either a b
Right [NavTree XNode
x]
                                          XPVBool Bool
False  -> NodeList -> NodeListRes
forall a b. b -> Either a b
Right []
                                          XPathValue
_              -> XPathValue -> NodeListRes
forall a b. a -> Either a b
Left (XPathValue -> NodeListRes) -> XPathValue -> NodeListRes
forall a b. (a -> b) -> a -> b
$ String -> XPathValue
XPVError String
"Value of testPredicate is not a boolean"

testPredicate                                   :: Env -> Context -> Expr -> XPathFilter
testPredicate :: Env -> Context -> Expr -> XPathFilter
testPredicate Env
env context :: Context
context@(Int
pos, Int
_, NavTree XNode
_) Expr
ex XPathValue
ns
                                        = case Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
context Expr
ex XPathValue
ns of
                                          XPVNumber (Float Float
f) -> Bool -> XPathValue
XPVBool (Float
f Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos)
                                          XPVNumber XPNumber
_         -> Bool -> XPathValue
XPVBool Bool
False
                                          XPathValue
_                   -> XFct
xboolean Context
context Env
env [Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
context Expr
ex XPathValue
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 :: NodeTest -> NodeListRes -> NodeListRes
nodeTest NodeTest
_ res :: NodeListRes
res@(Left XPathValue
_)                 = NodeListRes
res
nodeTest NodeTest
t (Right NodeList
ns)                   = NodeList -> NodeListRes
forall a b. b -> Either a b
Right (NodeList -> NodeListRes)
-> (NodeList -> NodeList) -> NodeList -> NodeListRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeTest -> NodeList -> NodeList
nodeTest' NodeTest
t (NodeList -> NodeListRes) -> NodeList -> NodeListRes
forall a b. (a -> b) -> a -> b
$ NodeList
ns

nodeTest'                               :: NodeTest -> NodeList -> NodeList
nodeTest' :: NodeTest -> NodeList -> NodeList
nodeTest' (NameTest QName
q)
    | Bool
isWildcardTest                    = (XNode -> Bool) -> NodeList -> NodeList
filterNodes' (QName -> XNode -> Bool
wildcardTest QName
q)
    | Bool
otherwise                         = (XNode -> Bool) -> NodeList -> NodeList
filterNodes' (QName -> XNode -> Bool
nameTest     QName
q)
      where
      isWildcardTest :: Bool
isWildcardTest                    = QName -> String
localPart QName
q String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"*"

nodeTest' (PI String
n)                        = (XNode -> Bool) -> NodeList -> NodeList
filterNodes' XNode -> Bool
isPiNode
                                          where
                                          isPiNode :: XNode -> Bool
isPiNode = Bool -> (QName -> Bool) -> Maybe QName -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
n) (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
qualifiedName) (Maybe QName -> Bool) -> (XNode -> Maybe QName) -> XNode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XNode -> Maybe QName
forall a. XmlNode a => a -> Maybe QName
XN.getPiName

nodeTest' (TypeTest XPathNode
t)                  = XPathNode -> NodeList -> NodeList
typeTest XPathNode
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' :: (XNode -> Bool) -> NodeList -> NodeList
filterNodes' XNode -> Bool
fct                        = (NavTree XNode -> Bool) -> NodeList -> NodeList
forall a. (a -> Bool) -> [a] -> [a]
filter (XNode -> Bool
fct (XNode -> Bool)
-> (NavTree XNode -> XNode) -> NavTree XNode -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavTree XNode -> XNode
forall a. NavTree a -> a
dataNT)

-- -----------------------------------------------------------------------------

nameTest                                :: QName -> XNode -> Bool
nameTest :: QName -> XNode -> Bool
nameTest QName
xpName (XTag QName
elemName XmlTrees
_)
    | Bool
namespaceAware                    = QName -> String
localPart QName
xpName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== QName -> String
localPart QName
elemName
                                          Bool -> Bool -> Bool
&&
                                          QName -> String
namespaceUri  QName
xpName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== QName -> String
namespaceUri  QName
elemName
    | Bool
otherwise                         = QName -> String
qualifiedName QName
xpName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== QName -> String
qualifiedName QName
elemName
    where
    namespaceAware :: Bool
namespaceAware                      = Bool -> Bool
not (Bool -> Bool) -> (QName -> Bool) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
namespaceUri (QName -> Bool) -> QName -> Bool
forall a b. (a -> b) -> a -> b
$ QName
xpName

nameTest QName
_ XNode
_                            = Bool
False

-- -----------------------------------------------------------------------------

wildcardTest                            :: QName -> XNode -> Bool
wildcardTest :: QName -> XNode -> Bool
wildcardTest QName
xpName (XTag QName
elemName XmlTrees
_)
    | Bool
namespaceAware                    = QName -> String
namespaceUri QName
xpName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== QName -> String
namespaceUri QName
elemName
    | Bool
prefixMatch                       = QName -> String
namePrefix   QName
xpName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== QName -> String
namePrefix   QName
elemName
    | Bool
otherwise                         = QName -> String
localPart  QName
elemName String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
t_root                 -- all names except the root name "/"
    where
    namespaceAware :: Bool
namespaceAware                      = Bool -> Bool
not (Bool -> Bool) -> (QName -> Bool) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
namespaceUri (QName -> Bool) -> QName -> Bool
forall a b. (a -> b) -> a -> b
$ QName
xpName
    prefixMatch :: Bool
prefixMatch                         = Bool -> Bool
not (Bool -> Bool) -> (QName -> Bool) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (String -> Bool) -> (QName -> String) -> QName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QName -> String
namePrefix   (QName -> Bool) -> QName -> Bool
forall a b. (a -> b) -> a -> b
$ QName
xpName

wildcardTest QName
_ XNode
_                        = Bool
False

-- -----------------------------------------------------------------------------
-- |
-- tests whether a node is of a special type
--
typeTest                                :: XPathNode -> NodeList -> NodeList
typeTest :: XPathNode -> NodeList -> NodeList
typeTest XPathNode
XPNode                         = NodeList -> NodeList
forall a. a -> a
id
typeTest XPathNode
XPCommentNode                  = (XNode -> Bool) -> NodeList -> NodeList
filterNodes' XNode -> Bool
forall a. XmlNode a => a -> Bool
XN.isCmt
typeTest XPathNode
XPPINode                       = (XNode -> Bool) -> NodeList -> NodeList
filterNodes' XNode -> Bool
forall a. XmlNode a => a -> Bool
XN.isPi
typeTest XPathNode
XPTextNode                     = (XNode -> Bool) -> NodeList -> NodeList
filterNodes' XNode -> Bool
forall a. XmlNode a => a -> Bool
XN.isText

-- -----------------------------------------------------------------------------
-- |
-- evaluates a boolean expression, the evaluation is non-strict

boolEval                                :: Env -> Context -> Op -> [Expr] -> XPathFilter
boolEval :: Env -> Context -> Op -> [Expr] -> XPathFilter
boolEval Env
_ Context
_ Op
op [] XPathValue
_                    = Bool -> XPathValue
XPVBool (Op
op Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
== Op
And)
boolEval Env
env Context
cont Op
Or (Expr
x:[Expr]
xs) XPathValue
ns          = case XFct
xboolean Context
cont Env
env [Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
cont Expr
x XPathValue
ns] of
                                          e :: XPathValue
e@(XPVError String
_) -> XPathValue
e
                                          XPVBool Bool
True   -> Bool -> XPathValue
XPVBool Bool
True
                                          XPathValue
_              -> Env -> Context -> Op -> [Expr] -> XPathFilter
boolEval Env
env Context
cont Op
Or [Expr]
xs XPathValue
ns

boolEval Env
env Context
cont Op
And (Expr
x:[Expr]
xs) XPathValue
ns         = case XFct
xboolean Context
cont Env
env [Env -> Context -> Expr -> XPathFilter
evalExpr Env
env Context
cont Expr
x XPathValue
ns] of
                                          e :: XPathValue
e@(XPVError String
_) -> XPathValue
e
                                          XPVBool Bool
True   -> Env -> Context -> Op -> [Expr] -> XPathFilter
boolEval Env
env Context
cont Op
And [Expr]
xs XPathValue
ns
                                          XPathValue
_              -> Bool -> XPathValue
XPVBool Bool
False
boolEval Env
_ Context
_ Op
_ [Expr]
_ XPathValue
_                      = String -> XPathValue
XPVError String
"Call to boolEval with a wrong argument"


-- -----------------------------------------------------------------------------
-- |
-- returns the value of a variable
getVariable                             :: Env -> VarName -> XPathFilter
getVariable :: Env -> VarName -> XPathFilter
getVariable Env
env VarName
name XPathValue
_                  = XPathValue -> Maybe XPathValue -> XPathValue
forall a. a -> Maybe a -> a
fromMaybe (String -> XPathValue
XPVError (String
"Variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
forall {a}. Show a => a -> String
show VarName
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found")) (Maybe XPathValue -> XPathValue) -> Maybe XPathValue -> XPathValue
forall a b. (a -> b) -> a -> b
$
                                          VarName -> [(VarName, XPathValue)] -> Maybe XPathValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup VarName
name (Env -> [(VarName, XPathValue)]
getVarTab Env
env)


-- -----------------------------------------------------------------------------
-- |
-- evaluates a function,
-- computation is done by 'XPathFct.evalFct' which is defined in "XPathFct".

fctEval                                 :: Env -> Context -> FctName -> [Expr] -> XPathFilter
fctEval :: Env -> Context -> String -> [Expr] -> XPathFilter
fctEval Env
env Context
cont String
name [Expr]
args              = String -> Env -> Context -> [XPathValue] -> XPathValue
evalFct String
name Env
env Context
cont ([XPathValue] -> XPathValue)
-> (XPathValue -> [XPathValue]) -> XPathFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env -> Context -> [Expr] -> XPathValue -> [XPathValue]
evalExprL Env
env Context
cont [Expr]
args

-- -----------------------------------------------------------------------------
-- |
-- evaluates an arithmetic operation.
--
--   1.parameter f :  arithmetic function from "XPathArithmetic"
--
numEval                                 :: (Op -> XPathValue -> XPathValue -> XPathValue) ->
                                           Op -> [XPathValue] -> XPathValue
numEval :: (Op -> XPathValue -> XPathFilter)
-> Op -> [XPathValue] -> XPathValue
numEval Op -> XPathValue -> XPathFilter
f Op
op                            = (XPathValue -> XPathFilter) -> [XPathValue] -> XPathValue
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (Op -> XPathValue -> XPathFilter
f Op
op)

-- -----------------------------------------------------------------------------
-- |
-- Convert list of ID attributes from DTD into a space separated 'XPVString'
--

idAttributesToXPathValue                :: XmlTrees -> XPathValue
idAttributesToXPathValue :: XmlTrees -> XPathValue
idAttributesToXPathValue XmlTrees
ts             = String -> XPathValue
XPVString ((XmlTree -> String -> String) -> String -> XmlTrees -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ XmlTree
n -> ( (String -> XmlTree -> String
valueOfDTD String
a_value XmlTree
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ") String -> String -> String
forall a. [a] -> [a] -> [a]
++)) [] XmlTrees
ts)

-- -----------------------------------------------------------------------------
-- |
-- Extracts all ID-attributes from the document type definition (DTD).
--

getIdAttributes                         :: XmlTree -> XmlTrees
getIdAttributes :: XmlTree -> XmlTrees
getIdAttributes                         = LA XmlTree XmlTree -> XmlTree -> XmlTrees
forall a b. LA a b -> a -> [b]
runLA (LA XmlTree XmlTree -> XmlTree -> XmlTrees)
-> LA XmlTree XmlTree -> XmlTree -> XmlTrees
forall a b. (a -> b) -> a -> b
$
                                          LA XmlTree XmlTree
forall (t :: * -> *) b. Tree t => LA (t b) (t b)
forall (a :: * -> * -> *) (t :: * -> *) b.
(ArrowTree a, Tree t) =>
a (t b) (t b)
AT.getChildren
                                          LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowXml a => a XmlTree XmlTree
isDTD
                                          LA XmlTree XmlTree -> LA XmlTree XmlTree -> LA XmlTree XmlTree
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
                                          LA XmlTree XmlTree -> LA XmlTree XmlTree
forall (t :: * -> *) b c. Tree t => LA (t b) c -> LA (t b) c
forall (a :: * -> * -> *) (t :: * -> *) b c.
(ArrowTree a, Tree t) =>
a (t b) c -> a (t b) c
AT.deep (LA XmlTree XmlTree
forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isIdAttrType)

-- ----------------------------------------

isIdAttrType                            :: ArrowDTD a => a XmlTree XmlTree
isIdAttrType :: forall (a :: * -> * -> *). ArrowDTD a => a XmlTree XmlTree
isIdAttrType                            = String -> (String -> Bool) -> a XmlTree XmlTree
forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
a_type (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
k_id)

valueOfDTD                              :: String -> XmlTree -> String
valueOfDTD :: String -> XmlTree -> String
valueOfDTD String
n                            = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String) -> (XmlTree -> [String]) -> XmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA XmlTree String -> XmlTree -> [String]
forall a b. LA a b -> a -> [b]
runLA ( LA XmlTree Attributes
forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
getDTDAttrl LA XmlTree Attributes
-> (Attributes -> String) -> LA XmlTree String
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> (c -> d) -> a b d
>>^ String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
n )

hasDTDAttrValue                         :: ArrowDTD a => String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue :: forall (a :: * -> * -> *).
ArrowDTD a =>
String -> (String -> Bool) -> a XmlTree XmlTree
hasDTDAttrValue String
an String -> Bool
p                    = a XmlTree Attributes -> a XmlTree XmlTree
forall b c. a b c -> a b b
forall (a :: * -> * -> *) b c. ArrowIf a => a b c -> a b b
filterA (a XmlTree Attributes -> a XmlTree XmlTree)
-> a XmlTree Attributes -> a XmlTree XmlTree
forall a b. (a -> b) -> a -> b
$
                                          a XmlTree Attributes
forall (a :: * -> * -> *). ArrowXml a => a XmlTree Attributes
getDTDAttrl a XmlTree Attributes
-> a Attributes Attributes -> a XmlTree Attributes
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Attributes -> Bool) -> a Attributes Attributes
forall b. (b -> Bool) -> a b b
forall (a :: * -> * -> *) b. ArrowList a => (b -> Bool) -> a b b
isA (String -> Bool
p (String -> Bool) -> (Attributes -> String) -> Attributes -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Attributes -> String
forall k e. Eq k => k -> AssocList k [e] -> [e]
lookup1 String
an)

-- ------------------------------------------------------------