{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module Text.XML.HXT.XPath.XPathFct
( XFct
, evalFct
, toXValue
, xnumber
, xboolean
, xstring
, getConvFct
, stringValue
, isNotInNodeList
, getVarTab
, getKeyTab
)
where
import Text.XML.HXT.XPath.XPathDataTypes
import Text.XML.HXT.XPath.XPathParser
( parseNumber
)
import Text.XML.HXT.XPath.XPathArithmetic
( xPathAdd
)
import Control.Arrow ( (>>>), (<+>) )
import Control.Arrow.ArrowList ( constA )
import Control.Arrow.ArrowIf ( ifA )
import Control.Arrow.ArrowTree ( deep )
import Control.Arrow.ListArrow ( LA, runLA )
import Text.XML.HXT.Arrow.XmlArrow
import Text.XML.HXT.Arrow.ReadDocument ( readDocument )
import Text.XML.HXT.Arrow.XmlState ( runX
, withValidate
, no
)
import Text.XML.HXT.DOM.Interface
import qualified Text.XML.HXT.DOM.XmlNode as XN
import System.IO.Unsafe ( unsafePerformIO
)
import Data.Char ( isAscii
, isUpper
, isLower
, isDigit
, ord
)
import Data.Maybe
int2XPNumber :: Int -> XPNumber
int2XPNumber :: Int -> XPNumber
int2XPNumber Int
0 = XPNumber
Pos0
int2XPNumber Int
i = Float -> XPNumber
Float (Float -> XPNumber) -> Float -> XPNumber
forall a b. (a -> b) -> a -> b
$ Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
type XFct = (Context -> Env -> [XPathValue] -> XPathValue)
type FctTable = [(FctName, FctTableElem)]
type FctTableElem = (XFct, CheckArgCount)
type CheckArgCount = ([XPathValue] -> Bool)
zero
, zeroOrOne
, one
, two
, twoOrM
, twoOrThree
, three :: CheckArgCount
zero :: CheckArgCount
zero [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
zeroOrOne :: CheckArgCount
zeroOrOne [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
one :: CheckArgCount
one [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
two :: CheckArgCount
two [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2
twoOrM :: CheckArgCount
twoOrM [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2
twoOrThree :: CheckArgCount
twoOrThree [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
|| [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
three :: CheckArgCount
three [XPathValue]
ex = [XPathValue] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [XPathValue]
ex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
fctTable :: FctTable
fctTable :: FctTable
fctTable = [
(String
"last", (XFct
xlast, CheckArgCount
zero)),
(String
"position",(XFct
xposition, CheckArgCount
zero)),
(String
"count",(XFct
xcount, CheckArgCount
one)),
(String
"id", (XFct
xid, CheckArgCount
one)),
(String
"local-name", (XFct
xlocalName, CheckArgCount
zeroOrOne)),
(String
"namespace-uri", (XFct
xnamespaceUri, CheckArgCount
zeroOrOne)),
(String
"name", (XFct
xname, CheckArgCount
zeroOrOne)),
(String
"string", (XFct
xstring, CheckArgCount
zeroOrOne)),
(String
"concat", (XFct
xconcat, CheckArgCount
twoOrM)),
(String
"starts-with",(XFct
xstartsWith, CheckArgCount
two)),
(String
"contains", (XFct
xcontains, CheckArgCount
two)),
(String
"substring-before", (XFct
xsubstringBefore, CheckArgCount
two)),
(String
"substring-after", (XFct
xsubstringAfter, CheckArgCount
two)),
(String
"substring", (XFct
xsubstring, CheckArgCount
twoOrThree)),
(String
"string-length", (XFct
xstringLength, CheckArgCount
zeroOrOne)),
(String
"normalize-space", (XFct
xnormalizeSpace, CheckArgCount
zeroOrOne)),
(String
"translate", (XFct
xtranslate, CheckArgCount
three)),
(String
"boolean", (XFct
xboolean, CheckArgCount
one)),
(String
"not", (XFct
xnot, CheckArgCount
one)),
(String
"true", (XFct
xtrue, CheckArgCount
zero)),
(String
"false",(XFct
xfalse, CheckArgCount
zero)),
(String
"lang", (XFct
xlang, CheckArgCount
one)),
(String
"number",(XFct
xnumber, CheckArgCount
zeroOrOne)),
(String
"sum",(XFct
xsum, CheckArgCount
one)),
(String
"floor",(XFct
xfloor, CheckArgCount
one)),
(String
"ceiling",(XFct
xceiling, CheckArgCount
one)),
(String
"round",(XFct
xround, CheckArgCount
one)),
(String
"key",(XFct
xkey, CheckArgCount
two)),
(String
"format-number",(XFct
xformatNumber, CheckArgCount
twoOrThree)),
(String
"document", (XFct
xdocument, CheckArgCount
one)),
(String
"generate-id", (XFct
xgenerateId, CheckArgCount
zeroOrOne))
]
getKeyTab :: Env -> KeyTab
getKeyTab :: Env -> KeyTab
getKeyTab (VarTab
_, KeyTab
keyTab) = KeyTab
keyTab
getVarTab :: Env -> VarTab
getVarTab :: Env -> VarTab
getVarTab (VarTab
varTab, KeyTab
_) = VarTab
varTab
getConvFct :: XPathValue -> Maybe XFct
getConvFct :: XPathValue -> Maybe XFct
getConvFct (XPVNumber XPNumber
_) = XFct -> Maybe XFct
forall a. a -> Maybe a
Just XFct
xnumber
getConvFct (XPVString String
_) = XFct -> Maybe XFct
forall a. a -> Maybe a
Just XFct
xstring
getConvFct (XPVBool Bool
_) = XFct -> Maybe XFct
forall a. a -> Maybe a
Just XFct
xboolean
getConvFct XPathValue
_ = Maybe XFct
forall a. Maybe a
Nothing
isNotInNodeList :: NavXmlTree -> [NavXmlTree] -> Bool
isNotInNodeList :: NavXmlTree -> [NavXmlTree] -> Bool
isNotInNodeList NavXmlTree
n [NavXmlTree]
xs' = NavXmlTree -> [IdPathStep]
nodeID' NavXmlTree
n [IdPathStep] -> [[IdPathStep]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (NavXmlTree -> [IdPathStep]) -> [NavXmlTree] -> [[IdPathStep]]
forall a b. (a -> b) -> [a] -> [b]
map NavXmlTree -> [IdPathStep]
nodeID' [NavXmlTree]
xs'
data IdPathStep = IdRoot String
| IdPos Int
| IdAttr QName
deriving (Int -> IdPathStep -> ShowS
[IdPathStep] -> ShowS
IdPathStep -> String
(Int -> IdPathStep -> ShowS)
-> (IdPathStep -> String)
-> ([IdPathStep] -> ShowS)
-> Show IdPathStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IdPathStep -> ShowS
showsPrec :: Int -> IdPathStep -> ShowS
$cshow :: IdPathStep -> String
show :: IdPathStep -> String
$cshowList :: [IdPathStep] -> ShowS
showList :: [IdPathStep] -> ShowS
Show, IdPathStep -> IdPathStep -> Bool
(IdPathStep -> IdPathStep -> Bool)
-> (IdPathStep -> IdPathStep -> Bool) -> Eq IdPathStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IdPathStep -> IdPathStep -> Bool
== :: IdPathStep -> IdPathStep -> Bool
$c/= :: IdPathStep -> IdPathStep -> Bool
/= :: IdPathStep -> IdPathStep -> Bool
Eq)
nodeID :: Maybe NavXmlTree -> [IdPathStep]
nodeID :: Maybe NavXmlTree -> [IdPathStep]
nodeID = [IdPathStep]
-> (NavXmlTree -> [IdPathStep]) -> Maybe NavXmlTree -> [IdPathStep]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] NavXmlTree -> [IdPathStep]
nodeID'
nodeID' :: NavXmlTree -> [IdPathStep]
nodeID' :: NavXmlTree -> [IdPathStep]
nodeID' t :: NavXmlTree
t@(NT (NTree (XAttr QName
qn) NTrees XNode
_) Int
_ix [NavXmlTree]
_ NTrees XNode
_ NTrees XNode
_)
= QName -> IdPathStep
IdAttr QName
qn IdPathStep -> [IdPathStep] -> [IdPathStep]
forall a. a -> [a] -> [a]
: Maybe NavXmlTree -> [IdPathStep]
nodeID (NavXmlTree -> Maybe NavXmlTree
forall a. NavTree a -> Maybe (NavTree a)
upNT NavXmlTree
t)
nodeID' t :: NavXmlTree
t@(NT NTree XNode
node Int
ix [NavXmlTree]
_ NTrees XNode
_ NTrees XNode
_)
| NTree XNode -> Bool
forall a. XmlNode a => a -> Bool
XN.isRoot NTree XNode
node = IdPathStep -> [IdPathStep]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (IdPathStep -> [IdPathStep]) -> IdPathStep -> [IdPathStep]
forall a b. (a -> b) -> a -> b
$ String -> IdPathStep
IdRoot (NTree XNode -> String
getRootId NTree XNode
node)
| Bool
otherwise = Int -> IdPathStep
IdPos Int
ix IdPathStep -> [IdPathStep] -> [IdPathStep]
forall a. a -> [a] -> [a]
: Maybe NavXmlTree -> [IdPathStep]
nodeID (NavXmlTree -> Maybe NavXmlTree
forall a. NavTree a -> Maybe (NavTree a)
upNT NavXmlTree
t)
where
getRootId :: NTree XNode -> String
getRootId = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (NTree XNode -> [String]) -> NTree XNode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA (NTree XNode) String -> NTree XNode -> [String]
forall a b. LA a b -> a -> [b]
runLA (String -> LA (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
"rootId")
evalFct :: FctName -> Env -> Context -> [XPathValue] -> XPathValue
evalFct :: String -> Env -> Context -> [XPathValue] -> XPathValue
evalFct String
name Env
env Context
cont [XPathValue]
args
= case (String -> FctTable -> Maybe FctTableElem
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name FctTable
fctTable) of
Maybe FctTableElem
Nothing -> String -> XPathValue
XPVError (String
"Call to undefined function "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name)
Just (XFct
fct, CheckArgCount
checkArgCount) ->
if Bool -> Bool
not (CheckArgCount
checkArgCount [XPathValue]
args)
then String -> XPathValue
XPVError (String
"Call to function "String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" with wrong arguments")
else case ([XPathValue] -> Maybe XPathValue
checkArgErrors [XPathValue]
args) of
Just XPathValue
e -> XPathValue
e
Maybe XPathValue
Nothing -> XFct
fct Context
cont Env
env [XPathValue]
args
where
checkArgErrors :: [XPathValue] -> Maybe XPathValue
checkArgErrors [] = Maybe XPathValue
forall a. Maybe a
Nothing
checkArgErrors ((XPVError String
r):[XPathValue]
_) = XPathValue -> Maybe XPathValue
forall a. a -> Maybe a
Just (String -> XPathValue
XPVError String
r)
checkArgErrors (XPathValue
_:[XPathValue]
xs) = [XPathValue] -> Maybe XPathValue
checkArgErrors [XPathValue]
xs
toXValue :: XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue :: XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
fct Context
c Env
env [XPathValue]
args = [XFct
fct Context
c Env
env [XPathValue
x] | XPathValue
x <- [XPathValue]
args]
xlast :: XFct
xlast :: XFct
xlast (Int
_, Int
len , NavXmlTree
_) Env
_ [XPathValue]
_ = XPNumber -> XPathValue
XPVNumber (XPNumber -> XPathValue) -> XPNumber -> XPathValue
forall a b. (a -> b) -> a -> b
$ Int -> XPNumber
int2XPNumber Int
len
xposition :: XFct
xposition :: XFct
xposition (Int
pos, Int
_ , NavXmlTree
_) Env
_ [XPathValue]
_ = XPNumber -> XPathValue
XPVNumber (XPNumber -> XPathValue) -> XPNumber -> XPathValue
forall a b. (a -> b) -> a -> b
$ Int -> XPNumber
int2XPNumber Int
pos
xcount :: XFct
xcount :: XFct
xcount Context
_ Env
_ [XPVNode NodeSet
ns] = XPNumber -> XPathValue
XPVNumber (XPNumber -> XPathValue)
-> (NodeSet -> XPNumber) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> XPNumber
int2XPNumber (Int -> XPNumber) -> (NodeSet -> Int) -> NodeSet -> XPNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> Int
cardNodeSet (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NodeSet
ns
xcount Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to function count with wrong arguments"
xid :: XFct
xid :: XFct
xid (Int
_, Int
_, NavXmlTree
cn) Env
env [XPVNode NodeSet
ns] = [String] -> [String] -> [NavXmlTree] -> XPathValue
isInId (Env -> [String]
getIds Env
env) (NodeSet -> [String]
strValues NodeSet
ns) [NavXmlTree
cn]
where
strValues :: NodeSet -> [String]
strValues = (NavXmlTree -> String) -> [NavXmlTree] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((\ (XPVString String
str) -> String
str) (XPathValue -> String)
-> (NavXmlTree -> XPathValue) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> XPathValue
stringValue) ([NavXmlTree] -> [String])
-> (NodeSet -> [NavXmlTree]) -> NodeSet -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> [NavXmlTree]
fromNodeSet
xid c :: Context
c@(Int
_, Int
_, NavXmlTree
cn) Env
env [XPathValue]
arg = [String] -> [String] -> [NavXmlTree] -> XPathValue
isInId (Env -> [String]
getIds Env
env) ( (\(XPVString String
s) -> String -> [String]
words String
s) (XFct
xstring Context
c Env
env [XPathValue]
arg)) [NavXmlTree
cn]
getIds :: Env -> [String]
getIds :: Env -> [String]
getIds Env
env = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
(\ (XPVString String
str) -> String
str) (XPathValue -> String)
-> (Maybe XPathValue -> XPathValue) -> Maybe XPathValue -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe XPathValue -> XPathValue
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe XPathValue -> String) -> Maybe XPathValue -> String
forall a b. (a -> b) -> a -> b
$ VarName -> VarTab -> Maybe XPathValue
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (String
"", String
"idAttr") (VarTab -> Maybe XPathValue) -> VarTab -> Maybe XPathValue
forall a b. (a -> b) -> a -> b
$
Env -> VarTab
getVarTab Env
env
isInId :: [String] -> [String] -> NavXmlTrees -> XPathValue
isInId :: [String] -> [String] -> [NavXmlTree] -> XPathValue
isInId [String]
ids [String]
str = NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> ([NavXmlTree] -> NodeSet) -> [NavXmlTree] -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NavXmlTree] -> NodeSet
toNodeSet ([NavXmlTree] -> NodeSet)
-> ([NavXmlTree] -> [NavXmlTree]) -> [NavXmlTree] -> NodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NavXmlTree -> [NavXmlTree]) -> [NavXmlTree] -> [NavXmlTree]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> [String] -> [NavXmlTree] -> [NavXmlTree]
filterNS [String]
ids [String]
str ([NavXmlTree] -> [NavXmlTree])
-> (NavXmlTree -> [NavXmlTree]) -> NavXmlTree -> [NavXmlTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> [NavXmlTree]
forall a. NavTree a -> [NavTree a]
descendantOrSelfAxis)
filterNS :: [String] -> [String] -> NavXmlTrees -> NavXmlTrees
filterNS :: [String] -> [String] -> [NavXmlTree] -> [NavXmlTree]
filterNS [String]
ids [String]
str [NavXmlTree]
ns = [ NavXmlTree
n | n :: NavXmlTree
n@(NT NTree XNode
a Int
_ [NavXmlTree]
_ NTrees XNode
_ NTrees XNode
_) <- [NavXmlTree]
ns
, [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map (NTree XNode -> [String] -> String -> Bool
idInIdList NTree XNode
a [String]
str) [String]
ids
]
where
idInIdList :: XmlTree -> [String] -> String -> Bool
idInIdList :: NTree XNode -> [String] -> String -> Bool
idInIdList NTree XNode
al [String]
str' String
b = (String -> NTree XNode -> String
getValue String
b NTree XNode
al) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
str'
xlocalName :: XFct
xlocalName :: XFct
xlocalName (Int
_, Int
_, NavXmlTree
cn) Env
_ [] = String -> XPathValue
XPVString (NTree XNode -> String
xpLocalPartOf (NTree XNode -> String)
-> (NavXmlTree -> NTree XNode) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
subtreeNT (NavXmlTree -> String) -> NavXmlTree -> String
forall a b. (a -> b) -> a -> b
$ NavXmlTree
cn)
xlocalName Context
_ Env
_ [XPVNode NodeSet
ns]
| NodeSet -> Bool
nullNodeSet NodeSet
ns = String -> XPathValue
XPVString String
""
| Bool
otherwise = String -> XPathValue
XPVString (NTree XNode -> String
xpLocalPartOf (NTree XNode -> String)
-> (NodeSet -> NTree XNode) -> NodeSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
subtreeNT (NavXmlTree -> NTree XNode)
-> (NodeSet -> NavXmlTree) -> NodeSet -> NTree XNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NavXmlTree
headNodeSet (NodeSet -> String) -> NodeSet -> String
forall a b. (a -> b) -> a -> b
$ NodeSet
ns)
xlocalName Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to function local-name with wrong arguments"
xnamespaceUri :: XFct
xnamespaceUri :: XFct
xnamespaceUri (Int
_, Int
_, NavXmlTree
cn) Env
_ [] = String -> XPathValue
XPVString (NTree XNode -> String
xpNamespaceOf (NTree XNode -> String)
-> (NavXmlTree -> NTree XNode) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
subtreeNT (NavXmlTree -> String) -> NavXmlTree -> String
forall a b. (a -> b) -> a -> b
$ NavXmlTree
cn)
xnamespaceUri Context
_ Env
_ [XPVNode NodeSet
ns]
| NodeSet -> Bool
nullNodeSet NodeSet
ns = String -> XPathValue
XPVString String
""
| Bool
otherwise = String -> XPathValue
XPVString (NTree XNode -> String
xpNamespaceOf (NTree XNode -> String)
-> (NodeSet -> NTree XNode) -> NodeSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
subtreeNT (NavXmlTree -> NTree XNode)
-> (NodeSet -> NavXmlTree) -> NodeSet -> NTree XNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NavXmlTree
headNodeSet (NodeSet -> String) -> NodeSet -> String
forall a b. (a -> b) -> a -> b
$ NodeSet
ns)
xnamespaceUri Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to function namespace-uri with wrong arguments"
xname :: XFct
xname :: XFct
xname (Int
_, Int
_, NavXmlTree
cn) Env
_ [] = String -> XPathValue
XPVString (NTree XNode -> String
xpNameOf (NTree XNode -> String)
-> (NavXmlTree -> NTree XNode) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
subtreeNT (NavXmlTree -> String) -> NavXmlTree -> String
forall a b. (a -> b) -> a -> b
$ NavXmlTree
cn)
xname Context
_ Env
_ [XPVNode NodeSet
ns]
| NodeSet -> Bool
nullNodeSet NodeSet
ns = String -> XPathValue
XPVString String
""
| Bool
otherwise = String -> XPathValue
XPVString (NTree XNode -> String
xpNameOf (NTree XNode -> String)
-> (NodeSet -> NTree XNode) -> NodeSet -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
subtreeNT (NavXmlTree -> NTree XNode)
-> (NodeSet -> NavXmlTree) -> NodeSet -> NTree XNode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NavXmlTree
headNodeSet (NodeSet -> String) -> NodeSet -> String
forall a b. (a -> b) -> a -> b
$ NodeSet
ns)
xname Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to function name with wrong arguments"
getFirstPos :: String -> String -> Int
getFirstPos :: String -> String -> Int
getFirstPos String
s String
sub = if (String -> String -> Int
getFirstPos' String
s String
sub) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s
then -Int
1
else String -> String -> Int
getFirstPos' String
s String
sub
getFirstPos' :: String -> String -> Int
getFirstPos' :: String -> String -> Int
getFirstPos' [] String
_ = Int
2
getFirstPos' (Char
x:String
xs) String
sub = if String -> String -> Bool
strStartsWith (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:String
xs) String
sub
then Int
0
else Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> String -> Int
getFirstPos' String
xs String
sub
strStartsWith :: String -> String -> Bool
strStartsWith :: String -> String -> Bool
strStartsWith String
a String
b = Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b) String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b
stringValue :: NavXmlTree -> XPathValue
stringValue :: NavXmlTree -> XPathValue
stringValue = String -> XPathValue
XPVString (String -> XPathValue)
-> (NavXmlTree -> String) -> NavXmlTree -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree XNode -> String
xpTextOf (NTree XNode -> String)
-> (NavXmlTree -> NTree XNode) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> NTree XNode
forall a. NavTree a -> NTree a
self
xstring :: XFct
xstring :: XFct
xstring Context
_ Env
_ [XPVNode NodeSet
ns]
| NodeSet -> Bool
nullNodeSet NodeSet
ns = String -> XPathValue
XPVString String
""
| Bool
otherwise = NavXmlTree -> XPathValue
stringValue (NavXmlTree -> XPathValue)
-> (NodeSet -> NavXmlTree) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NavXmlTree
headNodeSet (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NodeSet
ns
xstring (Int
_, Int
_, NavXmlTree
cn) Env
_ [] = NavXmlTree -> XPathValue
stringValue NavXmlTree
cn
xstring Context
_ Env
_ [XPVNumber (Float Float
a)]
| Float
a Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
a) = String -> XPathValue
XPVString (Integer -> String
forall a. Show a => a -> String
show ((Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
a)::Integer))
| Bool
otherwise = String -> XPathValue
XPVString (Float -> String
forall a. Show a => a -> String
show Float
a)
xstring Context
_ Env
_ [XPVNumber XPNumber
s] = String -> XPathValue
XPVString (XPNumber -> String
forall a. Show a => a -> String
show XPNumber
s)
xstring Context
_ Env
_ [XPVBool Bool
True] = String -> XPathValue
XPVString String
"true"
xstring Context
_ Env
_ [XPVBool Bool
False] = String -> XPathValue
XPVString String
"false"
xstring Context
_ Env
_ [XPVString String
s] = String -> XPathValue
XPVString String
s
xstring Context
_ Env
_ [XPVError String
e] = String -> XPathValue
XPVError String
e
xstring Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xstring with a wrong argument"
xconcat :: XFct
xconcat :: XFct
xconcat Context
c Env
env [XPathValue]
args = String -> XPathValue
XPVString ((XPathValue -> ShowS) -> String -> [XPathValue] -> String
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ (XPVString String
s) -> (String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++)) String
"" (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args))
xstartsWith :: XFct
xstartsWith :: XFct
xstartsWith Context
c Env
env [XPathValue]
args = Bool -> XPathValue
XPVBool (Bool -> XPathValue) -> Bool -> XPathValue
forall a b. (a -> b) -> a -> b
$
(\ ((XPVString String
a):[XPVString String
b]) -> String -> String -> Bool
strStartsWith String
a String
b) CheckArgCount -> CheckArgCount
forall a b. (a -> b) -> a -> b
$
XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args
xcontains :: XFct
xcontains :: XFct
xcontains Context
c Env
env [XPathValue]
args = Bool -> XPathValue
XPVBool (Bool -> XPathValue) -> Bool -> XPathValue
forall a b. (a -> b) -> a -> b
$
(\ ((XPVString String
s):[XPVString String
sub]) -> String -> String -> Int
getFirstPos String
s String
sub Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= -Int
1) CheckArgCount -> CheckArgCount
forall a b. (a -> b) -> a -> b
$
XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args
xsubstringBefore :: XFct
xsubstringBefore :: XFct
xsubstringBefore Context
c Env
env [XPathValue]
args = XFct
xsubstringBefore' Context
c Env
env (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args)
xsubstringBefore' :: XFct
xsubstringBefore' :: XFct
xsubstringBefore' Context
_ Env
_ ((XPVString String
_):[XPVString []]) = String -> XPathValue
XPVString String
""
xsubstringBefore' Context
_ Env
_ ((XPVString String
s):[XPVString String
sub]) = String -> XPathValue
XPVString (Int -> ShowS
forall a. Int -> [a] -> [a]
take (String -> String -> Int
getFirstPos String
s String
sub) String
s)
xsubstringBefore' Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xsubstringBefore' with a wrong argument"
xsubstringAfter :: XFct
xsubstringAfter :: XFct
xsubstringAfter Context
c Env
env [XPathValue]
args = XFct
xsubstringAfter' Context
c Env
env (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args)
xsubstringAfter' :: XFct
xsubstringAfter' :: XFct
xsubstringAfter' Context
_ Env
_ ((XPVString String
s):[XPVString []]) = String -> XPathValue
XPVString String
s
xsubstringAfter' Context
_ Env
_ ((XPVString String
s):[XPVString String
sub]) = if String -> String -> Int
getFirstPos String
s String
sub Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== -Int
1
then (String -> XPathValue
XPVString String
"")
else String -> XPathValue
XPVString (Int -> ShowS
forall a. Int -> [a] -> [a]
drop ((String -> String -> Int
getFirstPos String
s String
sub)Int -> Int -> Int
forall a. Num a => a -> a -> a
+String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
sub) String
s)
xsubstringAfter' Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xsubstringAfter' with a wrong argument"
xsubstring :: XFct
xsubstring :: XFct
xsubstring Context
c Env
env (XPathValue
x:[XPathValue]
xs) = XFct
xsubstring' Context
c Env
env ((XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue
x])[XPathValue] -> [XPathValue] -> [XPathValue]
forall a. [a] -> [a] -> [a]
++(XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
c Env
env [XPathValue]
xs))
xsubstring Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xsubstring with a wrong argument"
xsubstring' :: XFct
xsubstring' :: XFct
xsubstring' Context
c Env
env ((XPVString String
s):XPathValue
start:[])
= case XFct
xround Context
c Env
env [XPathValue
start] of
XPVNumber XPNumber
NaN -> String -> XPathValue
XPVString String
""
XPVNumber XPNumber
PosInf -> String -> XPathValue
XPVString String
""
XPVNumber (Float Float
f) -> String -> XPathValue
XPVString (Int -> ShowS
forall a. Int -> [a] -> [a]
drop ((Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
f)Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
s)
XPVNumber XPNumber
_ -> String -> XPathValue
XPVString String
s
XPathValue
_ -> String -> XPathValue
XPVError String
"Call to xsubstring' with a wrong argument"
xsubstring' Context
c Env
env ((XPVString String
s):XPathValue
start:[XPathValue
end])
= case Op -> XPathValue -> XPathFilter
xPathAdd Op
Plus (XFct
xround Context
c Env
env [XPathValue
start]) (XFct
xround Context
c Env
env [XPathValue
end]) of
XPVNumber (Float Float
f) -> XFct
xsubstring' Context
c Env
env ( (String -> XPathValue
XPVString (Int -> ShowS
forall a. Int -> [a] -> [a]
take ((Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Float
f) Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) String
s))XPathValue -> [XPathValue] -> [XPathValue]
forall a. a -> [a] -> [a]
:[XPathValue
start])
XPVNumber XPNumber
PosInf -> XFct
xsubstring' Context
c Env
env ( (String -> XPathValue
XPVString String
s)XPathValue -> [XPathValue] -> [XPathValue]
forall a. a -> [a] -> [a]
:[XPathValue
start])
XPVNumber XPNumber
_ -> String -> XPathValue
XPVString String
""
XPathValue
_ -> String -> XPathValue
XPVError String
"Call to xsubstring' with a wrong argument"
xsubstring' Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xsubstring' with a wrong argument"
xstringLength :: XFct
xstringLength :: XFct
xstringLength c :: Context
c@(Int
_, Int
_, NavXmlTree
cn) Env
env [] = XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float (Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Float) -> Int -> Float
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s))
where
XPVString String
s = XFct
xstring Context
c Env
env [NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NavXmlTree -> NodeSet
singletonNodeSet NavXmlTree
cn]
xstringLength Context
c Env
env [XPathValue]
args = XPNumber -> XPathValue
XPVNumber (XPNumber -> XPathValue) -> XPNumber -> XPathValue
forall a b. (a -> b) -> a -> b
$
(\[XPVString String
s] -> Int -> XPNumber
int2XPNumber (Int -> XPNumber) -> Int -> XPNumber
forall a b. (a -> b) -> a -> b
$ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) ([XPathValue] -> XPNumber) -> [XPathValue] -> XPNumber
forall a b. (a -> b) -> a -> b
$
XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args
xnormalizeSpace :: XFct
xnormalizeSpace :: XFct
xnormalizeSpace c :: Context
c@(Int
_, Int
_, NavXmlTree
cn) Env
env [] = (\ (XPVString String
s) -> String -> XPathValue
XPVString (String -> XPathValue) -> String -> XPathValue
forall a b. (a -> b) -> a -> b
$ ShowS
normStr String
s) XPathFilter -> XPathFilter
forall a b. (a -> b) -> a -> b
$
XFct
xstring Context
c Env
env [NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NavXmlTree -> NodeSet
singletonNodeSet NavXmlTree
cn]
xnormalizeSpace Context
c Env
env [XPathValue]
args = (\ [XPVString String
s] -> String -> XPathValue
XPVString (String -> XPathValue) -> String -> XPathValue
forall a b. (a -> b) -> a -> b
$ ShowS
normStr String
s) ([XPathValue] -> XPathValue) -> [XPathValue] -> XPathValue
forall a b. (a -> b) -> a -> b
$
XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args
normStr :: String -> String
normStr :: ShowS
normStr = [String] -> String
unwords ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
xtranslate :: XFct
xtranslate :: XFct
xtranslate Context
c Env
env [XPathValue]
args = XFct
xtranslate' Context
c Env
env (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue]
args)
xtranslate' :: XFct
xtranslate' :: XFct
xtranslate' Context
_ Env
_ ((XPVString String
a):(XPVString String
b):[XPVString String
c])
= String -> XPathValue
XPVString (String -> String -> ShowS
replace String
a String
b String
c)
xtranslate' Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xtranslate' with a wrong argument"
replace :: String -> String -> String -> String
replace :: String -> String -> ShowS
replace String
str [] String
_ = String
str
replace String
str (Char
x:String
xs) [] = String -> String -> ShowS
replace [ Char
s | Char
s <- String
str, Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
s] String
xs []
replace String
str (Char
x:String
xs) (Char
y:String
ys) = String -> String -> ShowS
replace (Char -> Char -> ShowS
rep Char
x Char
y String
str) String
xs String
ys
where
rep :: Char -> Char -> String -> String
rep :: Char -> Char -> ShowS
rep Char
a Char
b = (Char -> ShowS) -> String -> ShowS
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Char
c -> if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
a then (Char
bChar -> ShowS
forall a. a -> [a] -> [a]
:) else (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:)) String
""
xboolean :: XFct
xboolean :: XFct
xboolean Context
_ Env
_ [XPVNumber XPNumber
a] = Bool -> XPathValue
XPVBool (XPNumber
aXPNumber -> XPNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= XPNumber
NaN Bool -> Bool -> Bool
&& XPNumber
aXPNumber -> XPNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= XPNumber
Neg0 Bool -> Bool -> Bool
&& XPNumber
aXPNumber -> XPNumber -> Bool
forall a. Eq a => a -> a -> Bool
/= XPNumber
Pos0)
xboolean Context
_ Env
_ [XPVString String
s] = Bool -> XPathValue
XPVBool (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0)
xboolean Context
_ Env
_ [XPVBool Bool
b] = Bool -> XPathValue
XPVBool Bool
b
xboolean Context
_ Env
_ [XPVNode NodeSet
ns] = Bool -> XPathValue
XPVBool (Bool -> Bool
not (Bool -> Bool) -> (NodeSet -> Bool) -> NodeSet -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> Bool
nullNodeSet (NodeSet -> Bool) -> NodeSet -> Bool
forall a b. (a -> b) -> a -> b
$ NodeSet
ns)
xboolean Context
_ Env
_ [XPVError String
e] = String -> XPathValue
XPVError String
e
xboolean Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xboolean with a wrong argument"
xnot :: XFct
xnot :: XFct
xnot Context
c Env
env [XPathValue]
args = Bool -> XPathValue
XPVBool ( (\ (XPVBool Bool
b) -> Bool -> Bool
not Bool
b) (XFct
xboolean Context
c Env
env [XPathValue]
args) )
xtrue :: XFct
xtrue :: XFct
xtrue Context
_ Env
_ [XPathValue]
_ = Bool -> XPathValue
XPVBool Bool
True
xfalse :: XFct
xfalse :: XFct
xfalse Context
_ Env
_ [XPathValue]
_ = Bool -> XPathValue
XPVBool Bool
False
xlang :: XFct
xlang :: XFct
xlang Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"namespaces are not supported"
xnumber :: XFct
xnumber :: XFct
xnumber c :: Context
c@(Int
_, Int
_, NavXmlTree
cn) Env
env [] = (\ (XPVString String
s) -> String -> XPathValue
parseNumber String
s) (XFct
xstring Context
c Env
env [NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NavXmlTree -> NodeSet
singletonNodeSet NavXmlTree
cn])
xnumber Context
c Env
env [n :: XPathValue
n@(XPVNode NodeSet
_)] = (\ (XPVString String
s) -> String -> XPathValue
parseNumber String
s) (XFct
xstring Context
c Env
env [XPathValue
n])
xnumber Context
_ Env
_ [XPVBool Bool
b]
| Bool
b = XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float Float
1)
| Bool
otherwise = XPNumber -> XPathValue
XPVNumber XPNumber
Pos0
xnumber Context
_ Env
_ [XPVString String
s] = String -> XPathValue
parseNumber String
s
xnumber Context
_ Env
_ [XPVNumber XPNumber
a] = XPNumber -> XPathValue
XPVNumber XPNumber
a
xnumber Context
_ Env
_ [XPVError String
e] = String -> XPathValue
XPVError String
e
xnumber Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xnumber with a wrong argument"
xsum :: XFct
xsum :: XFct
xsum Context
c Env
env [XPVNode NodeSet
ns]
| NodeSet -> Bool
nullNodeSet NodeSet
ns = XPNumber -> XPathValue
XPVNumber XPNumber
NaN
| Bool
otherwise = (XPathValue -> XPathFilter) -> [XPathValue] -> XPathValue
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (\ XPathValue
a XPathValue
b -> (Op -> XPathValue -> XPathFilter
xPathAdd Op
Plus XPathValue
a XPathValue
b)) (NodeSet -> [XPathValue]
getValues NodeSet
ns)
where
getValues :: NodeSet -> [XPathValue]
getValues :: NodeSet -> [XPathValue]
getValues = (NavXmlTree -> [XPathValue] -> [XPathValue])
-> [XPathValue] -> [NavXmlTree] -> [XPathValue]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ NavXmlTree
n -> ([XFct
xnumber Context
c Env
env ([XPathValue] -> XPathValue) -> [XPathValue] -> XPathValue
forall a b. (a -> b) -> a -> b
$ [NavXmlTree -> XPathValue
stringValue NavXmlTree
n] ] [XPathValue] -> [XPathValue] -> [XPathValue]
forall a. [a] -> [a] -> [a]
++) ) [] ([NavXmlTree] -> [XPathValue])
-> (NodeSet -> [NavXmlTree]) -> NodeSet -> [XPathValue]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> [NavXmlTree]
fromNodeSet
xsum Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"The value of the function sum is not a nodeset"
xfloor :: XFct
xfloor :: XFct
xfloor Context
c Env
env [XPathValue]
args = [XPathValue] -> XPathValue
xfloor' (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
c Env
env [XPathValue]
args)
where
xfloor' :: [XPathValue] -> XPathValue
xfloor' [XPVNumber (Float Float
f)]
| Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
1 = XPNumber -> XPathValue
XPVNumber XPNumber
Pos0
| Bool
otherwise = XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
f))
xfloor' [XPVNumber XPNumber
a] = XPNumber -> XPathValue
XPVNumber XPNumber
a
xfloor' [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xfloor' without a number"
xceiling :: XFct
xceiling :: XFct
xceiling Context
c Env
env [XPathValue]
args = [XPathValue] -> XPathValue
xceiling' (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
c Env
env [XPathValue]
args)
where
xceiling' :: [XPathValue] -> XPathValue
xceiling' [XPVNumber (Float Float
f)]
| Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 Bool -> Bool -> Bool
&& Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> -Float
1 = XPNumber -> XPathValue
XPVNumber XPNumber
Pos0
| Bool
otherwise = XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Float
f))
xceiling' [XPVNumber XPNumber
a] = XPNumber -> XPathValue
XPVNumber XPNumber
a
xceiling' [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xceiling' without a number"
xround :: XFct
xround :: XFct
xround Context
c Env
env [XPathValue]
args = XFct
xround' Context
c Env
env (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
c Env
env [XPathValue]
args)
xround' :: XFct
xround' :: XFct
xround' Context
_ Env
_ [XPVNumber (Float Float
f)]
| Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 Bool -> Bool -> Bool
&& Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= -Float
0.5 = XPNumber -> XPathValue
XPVNumber XPNumber
Neg0
| Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0 Bool -> Bool -> Bool
&& Float
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.5 = XPNumber -> XPathValue
XPVNumber XPNumber
Pos0
| Bool
otherwise = XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float (Integer -> Float
forall a. Num a => Integer -> a
fromInteger (Integer -> Float) -> Integer -> Float
forall a b. (a -> b) -> a -> b
$ Float -> Integer
forall {a} {b}. (RealFrac a, Integral b) => a -> b
xPathRound Float
f))
where
xPathRound :: a -> b
xPathRound a
a = if a
a a -> a -> a
forall a. Num a => a -> a -> a
- (Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> Integer -> a
forall a b. (a -> b) -> a -> b
$ a -> Integer
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
a) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0.5
then a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor a
a
else a -> b
forall b. Integral b => a -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
1)
xround' Context
_ Env
_ [XPVNumber XPNumber
a] = XPNumber -> XPathValue
XPVNumber XPNumber
a
xround' Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xround' without a number"
xkey :: XFct
xkey :: XFct
xkey Context
_ Env
env ((XPVString String
s) : [XPVNode NodeSet
ns])
= KeyTab -> String -> [String] -> XPathValue
isInKey (Env -> KeyTab
getKeyTab Env
env) String
s ([NavXmlTree] -> [String]
strValues ([NavXmlTree] -> [String])
-> (NodeSet -> [NavXmlTree]) -> NodeSet -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> [NavXmlTree]
fromNodeSet (NodeSet -> [String]) -> NodeSet -> [String]
forall a b. (a -> b) -> a -> b
$ NodeSet
ns)
where
strValues :: [NavXmlTree] -> [String]
strValues = (NavXmlTree -> String) -> [NavXmlTree] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((\ (XPVString String
str) -> String
str) (XPathValue -> String)
-> (NavXmlTree -> XPathValue) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> XPathValue
stringValue)
xkey Context
c Env
env ((XPVString String
s) : [XPathValue]
arg)
= KeyTab -> String -> [String] -> XPathValue
isInKey (Env -> KeyTab
getKeyTab Env
env) String
s [String
str]
where
XPVString String
str = XFct
xstring Context
c Env
env [XPathValue]
arg
xkey Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xkey with a wrong argument"
isInKey :: KeyTab -> String -> [String] -> XPathValue
isInKey :: KeyTab -> String -> [String] -> XPathValue
isInKey KeyTab
kt String
kn [String]
kv = NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> ([NavXmlTree] -> NodeSet) -> [NavXmlTree] -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NavXmlTree] -> NodeSet
toNodeSet ([NavXmlTree] -> XPathValue) -> [NavXmlTree] -> XPathValue
forall a b. (a -> b) -> a -> b
$ [NavXmlTree]
ts
where
([QName]
_, [String]
_, [NavXmlTree]
ts) = KeyTab -> ([QName], [String], [NavXmlTree])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 (KeyTab -> ([QName], [String], [NavXmlTree]))
-> KeyTab -> ([QName], [String], [NavXmlTree])
forall a b. (a -> b) -> a -> b
$ [KeyTab] -> KeyTab
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([KeyTab] -> KeyTab) -> [KeyTab] -> KeyTab
forall a b. (a -> b) -> a -> b
$ (String -> KeyTab) -> [String] -> [KeyTab]
forall a b. (a -> b) -> [a] -> [b]
map (KeyTab -> String -> KeyTab
isKeyVal (KeyTab -> String -> KeyTab
isKeyName KeyTab
kt String
kn)) [String]
kv
isKeyName :: KeyTab -> String -> KeyTab
isKeyName :: KeyTab -> String -> KeyTab
isKeyName KeyTab
kt String
kn = ((QName, String, NavXmlTree) -> Bool) -> KeyTab -> KeyTab
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> (QName, String, NavXmlTree) -> Bool
isOfKeyName String
kn) KeyTab
kt
isKeyVal :: KeyTab -> String -> KeyTab
isKeyVal :: KeyTab -> String -> KeyTab
isKeyVal KeyTab
kt String
kv = ((QName, String, NavXmlTree) -> Bool) -> KeyTab -> KeyTab
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> (QName, String, NavXmlTree) -> Bool
isOfKeyValue String
kv) KeyTab
kt
isOfKeyName :: String -> (QName, String, NavXmlTree) -> Bool
isOfKeyName :: String -> (QName, String, NavXmlTree) -> Bool
isOfKeyName String
kn (QName
qn, String
_, NavXmlTree
_) = QName -> String
localPart QName
qn String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kn
isOfKeyValue :: String -> (QName, String, NavXmlTree) -> Bool
isOfKeyValue :: String -> (QName, String, NavXmlTree) -> Bool
isOfKeyValue String
kv (QName
_, String
v, NavXmlTree
_) = String
v String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
kv
xformatNumber :: XFct
xformatNumber :: XFct
xformatNumber Context
c Env
env (XPathValue
x:[XPathValue]
xs) = XFct
xsubstring' Context
c Env
env (XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xstring Context
c Env
env [XPathValue
x] [XPathValue] -> [XPathValue] -> [XPathValue]
forall a. [a] -> [a] -> [a]
++ XFct -> Context -> Env -> [XPathValue] -> [XPathValue]
toXValue XFct
xnumber Context
c Env
env [XPathValue]
xs)
xformatNumber Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
XPVError String
"Call to xformatNumber with a wrong argument"
xdocument :: XFct
xdocument :: XFct
xdocument Context
c Env
e [XPathValue]
val = NodeSet -> XPathValue
XPVNode (NodeSet -> XPathValue)
-> ([XPathValue] -> NodeSet) -> [XPathValue] -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NavXmlTree] -> NodeSet
toNodeSet ([NavXmlTree] -> NodeSet)
-> ([XPathValue] -> [NavXmlTree]) -> [XPathValue] -> NodeSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ (XPVString String
s) -> String -> [NavXmlTree]
xdocument' String
s) (XPathValue -> [NavXmlTree])
-> ([XPathValue] -> XPathValue) -> [XPathValue] -> [NavXmlTree]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XFct
xstring Context
c Env
e ([XPathValue] -> XPathValue) -> [XPathValue] -> XPathValue
forall a b. (a -> b) -> a -> b
$ [XPathValue]
val
xdocument' :: String -> [NavXmlTree]
xdocument' :: String -> [NavXmlTree]
xdocument' String
uri = (NTree XNode -> NavXmlTree) -> NTrees XNode -> [NavXmlTree]
forall a b. (a -> b) -> [a] -> [b]
map NTree XNode -> NavXmlTree
forall a. NTree a -> NavTree a
ntree (NTrees XNode -> [NavXmlTree]) -> NTrees XNode -> [NavXmlTree]
forall a b. (a -> b) -> a -> b
$
IO (NTrees XNode) -> NTrees XNode
forall a. IO a -> a
unsafePerformIO (IO (NTrees XNode) -> NTrees XNode)
-> IO (NTrees XNode) -> NTrees XNode
forall a b. (a -> b) -> a -> b
$
IOSArrow (NTree XNode) (NTree XNode) -> IO (NTrees XNode)
forall c. IOSArrow (NTree XNode) c -> IO [c]
runX ( SysConfigList -> String -> IOSArrow (NTree XNode) (NTree XNode)
forall s b.
SysConfigList -> String -> IOStateArrow s b (NTree XNode)
readDocument [Bool -> SysConfig
withValidate Bool
no] String
uri
IOSArrow (NTree XNode) (NTree XNode)
-> IOSArrow (NTree XNode) (NTree XNode)
-> IOSArrow (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>>
String -> String -> IOSArrow (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
String -> String -> a (NTree XNode) (NTree XNode)
addAttr String
"rootId" (String
"doc " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uri)
)
xgenerateId :: XFct
xgenerateId :: XFct
xgenerateId Context
_ Env
_ [XPVNode NodeSet
ns]
| Bool -> Bool
not (NodeSet -> Bool
nullNodeSet NodeSet
ns) = NavXmlTree -> XPathValue
xgenerateId' (NavXmlTree -> XPathValue)
-> (NodeSet -> NavXmlTree) -> NodeSet -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeSet -> NavXmlTree
headNodeSet (NodeSet -> XPathValue) -> NodeSet -> XPathValue
forall a b. (a -> b) -> a -> b
$ NodeSet
ns
xgenerateId (Int
_, Int
_, NavXmlTree
node) Env
_ [] = NavXmlTree -> XPathValue
xgenerateId' NavXmlTree
node
xgenerateId Context
_ Env
_ [XPathValue]
_ = String -> XPathValue
forall a. HasCallStack => String -> a
error String
"illegal arguments in xgenerateId"
xgenerateId' :: NavXmlTree -> XPathValue
xgenerateId' :: NavXmlTree -> XPathValue
xgenerateId' = String -> XPathValue
XPVString (String -> XPathValue)
-> (NavXmlTree -> String) -> NavXmlTree -> XPathValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"id_"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (NavXmlTree -> String) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
str2XmlId ShowS -> (NavXmlTree -> String) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IdPathStep] -> String
forall a. Show a => a -> String
show ([IdPathStep] -> String)
-> (NavXmlTree -> [IdPathStep]) -> NavXmlTree -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe NavXmlTree -> [IdPathStep]
nodeID (Maybe NavXmlTree -> [IdPathStep])
-> (NavXmlTree -> Maybe NavXmlTree) -> NavXmlTree -> [IdPathStep]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NavXmlTree -> Maybe NavXmlTree
forall a. a -> Maybe a
Just
str2XmlId :: String -> String
str2XmlId :: ShowS
str2XmlId = (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
convert
where
convert :: Char -> String
convert Char
c = if Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
|| Char -> Bool
isLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c)
then [Char
c]
else String
"_" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"
xpNamePart :: LA XmlTree String -> XmlTree -> String
xpNamePart :: LA (NTree XNode) String -> NTree XNode -> String
xpNamePart LA (NTree XNode) String
getNp
= [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
([String] -> String)
-> (NTree XNode -> [String]) -> NTree XNode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
LA (NTree XNode) String -> NTree XNode -> [String]
forall a b. LA a b -> a -> [b]
runLA ( LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) String
-> LA (NTree XNode) String
-> LA (NTree XNode) String
forall b c d. LA b c -> LA b d -> LA b d -> LA b d
forall (a :: * -> * -> *) b c d.
ArrowIf a =>
a b c -> a b d -> a b d -> a b d
ifA LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isRoot
(String -> LA (NTree XNode) String
forall c b. c -> LA b c
forall (a :: * -> * -> *) c b. ArrowList a => c -> a b c
constA String
"")
LA (NTree XNode) String
getNp
)
xpLocalPartOf :: XmlTree -> String
xpLocalPartOf :: NTree XNode -> String
xpLocalPartOf = LA (NTree XNode) String -> NTree XNode -> String
xpNamePart LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getLocalPart
xpNamespaceOf :: XmlTree -> String
xpNamespaceOf :: NTree XNode -> String
xpNamespaceOf = LA (NTree XNode) String -> NTree XNode -> String
xpNamePart LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getNamespaceUri
xpNameOf :: XmlTree -> String
xpNameOf :: NTree XNode -> String
xpNameOf = LA (NTree XNode) String -> NTree XNode -> String
xpNamePart LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getName
getValue :: String -> XmlTree -> String
getValue :: String -> NTree XNode -> String
getValue String
n = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (NTree XNode -> [String]) -> NTree XNode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA (NTree XNode) String -> NTree XNode -> [String]
forall a b. LA a b -> a -> [b]
runLA (String -> LA (NTree XNode) String
forall (a :: * -> * -> *).
ArrowXml a =>
String -> a (NTree XNode) String
getAttrValue String
n)
xpTextOf :: XmlTree -> String
xpTextOf :: NTree XNode -> String
xpTextOf = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> (NTree XNode -> [String]) -> NTree XNode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LA (NTree XNode) String -> NTree XNode -> [String]
forall a b. LA a b -> a -> [b]
runLA (LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) String
forall n. LA n (NTree XNode) -> LA n String
forall (a :: * -> * -> *) n.
ArrowXml a =>
a n (NTree XNode) -> a n String
xshow ((LA (NTree XNode) String
forall (a :: * -> * -> *). ArrowXml a => a (NTree XNode) String
getCmt LA (NTree XNode) String
-> LA String (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> LA String (NTree XNode)
forall (a :: * -> * -> *). ArrowXml a => a String (NTree XNode)
mkText) LA (NTree XNode) (NTree XNode)
-> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
forall b c. LA b c -> LA b c -> LA b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
<+> LA (NTree XNode) (NTree XNode) -> LA (NTree XNode) (NTree XNode)
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
deep LA (NTree XNode) (NTree XNode)
forall (a :: * -> * -> *).
ArrowXml a =>
a (NTree XNode) (NTree XNode)
isText))