{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}

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

{- |
   Module     : Text.XML.HXT.XPath.XPathFct
   Copyright  : Copyright (C) 2008 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   The module contains the core-functions of the XPath function library.
   All functions are implemented as XFct. Each XFct contains the evaluation context,
   the variable environment and the function arguments.

-}

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

module Text.XML.HXT.XPath.XPathFct
    ( XFct
    , evalFct
    , toXValue
    , xnumber
    , xboolean
    , xstring
    , getConvFct
    , stringValue
--    , remDups
    , isNotInNodeList
{-
    , createDocumentOrder
    , createDocumentOrderReverse
-}
    , 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

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

-- added by Tim Walkenhorst to fix Pos0 vs. Float 0.0 problems...

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 signature for all functions which can be used in the XPath module.

type XFct = (Context -> Env -> [XPathValue] -> XPathValue)

-- |
-- All functions are stored in a function table.

type FctTable = [(FctName, FctTableElem)]

-- |
-- Each table entry consists of the function and the expected function arguments.

type FctTableElem = (XFct, CheckArgCount)

-- |
-- Tests whether the number of current function arguments is correct

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


-- -----------------------------------------------------------------------------
-- |
-- The core-functions library

fctTable :: FctTable
fctTable :: FctTable
fctTable = [
            (String
"last", (XFct
xlast, CheckArgCount
zero)), -- nodeset functions
            (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 functions
            (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)), -- boolean functions
            (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)), -- number functions
            (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)),-- extension functions for xslt 1.0
            (String
"generate-id", (XFct
xgenerateId, CheckArgCount
zeroOrOne))

           ]

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

-- some helper functions

-- |
-- Returns the table of keys, needed by xslt, from the environment

getKeyTab :: Env -> KeyTab
getKeyTab :: Env -> KeyTab
getKeyTab (VarTab
_, KeyTab
keyTab) = KeyTab
keyTab


-- -----------------------------------------------------------------------------
-- |
-- Returns the table of variables from the environment

getVarTab :: Env -> VarTab
getVarTab :: Env -> VarTab
getVarTab (VarTab
varTab, KeyTab
_) = VarTab
varTab


-- -----------------------------------------------------------------------------
-- |
-- Returns the conversion function for the XPath results: string, boolean and number
-- A nodeset can not be converted.

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

-- -----------------------------------------------------------------------------
-- |
-- Check whether a node is not a part of a node list. Needed to implement matching & testing in xslt.

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'

-- -----------------------------------------------------------------------------
-- |
-- calculate an ID for a NODE
--
--    - returns : a list of numbers, one number for each level of the tree

-- Tim Walkenhorst:
--   - Attributes are identified by their QName (they do not have previous siblings)
--   - Elements are identified by their relative position (# of previous siblings)

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")

-- -----------------------------------------------------------------------------
-- |
-- Evaluates a function.
-- Calculation of the function value is done by looking up the function name in the function table,
-- check the number of arguments and calculate the funtion, if no
-- argument evaluation returns an error.
--
--    - returns : the function value as 'XPathValue'

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


-- |
-- Converts a list of different 'XPathValue' types in a list of one 'XPathValue' type.
--
--    * 1.parameter fct :  the conversion function
--

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]

-- -----------------------------------------------------------------------------
-- core-funktions library

-- nodeset functions

-- |
-- number last(): returns a number equal to the context size from the expression evaluation context

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


-- -----------------------------------------------------------------------------
-- |
-- number position(): returns a number equal to the context position from the expression evaluation context

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


-- -----------------------------------------------------------------------------
-- |
-- number count(node-set): returns the number of nodes in the argument node-set

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"


-- -----------------------------------------------------------------------------
-- |
-- node-set id(object): selects elements by their unique ID

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]



-- -----------------------------------------------------------------------------
-- |
-- returns all IDs from the variable environment as a list of strings.
-- the IDs are stored in the variable: idAttr

getIds                          :: Env -> [String]
getIds :: Env -> [String]
getIds Env
env                      = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$                       -- hier muss noch auf prefix getestet werden
                                  (\ (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'


-- -----------------------------------------------------------------------------
-- |
-- string local-name(node-set?):
-- returns the local part of the expanded-name of the node in the argument node-set
-- that is first in document order.
-- If the argument node-set is empty or the first node has no expanded-name, an empty string is returned.
-- If the argument is omitted, it defaults to a node-set with the context node as its only member

--   Bugfix: name(\/) is "" not "\/"!

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"

-- -----------------------------------------------------------------------------
-- |
-- string namespace-uri(node-set?):
-- returns the namespace URI of the expanded-name of the node in the argument node-set
-- that is first in document order.
-- If the argument node-set is empty, the first node has no expanded-name,
-- or the namespace URI of the expanded-name
-- is null, an empty string is returned. If the argument is omitted,
-- it defaults to a node-set with the context node as its only member

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"


-- -----------------------------------------------------------------------------
-- |
-- string name(node-set?):
-- returns a string containing a QName representing the expanded-name of the node
-- in the argument node-set
-- that is first in document order. If the argument node-set is empty or the first
-- node has no expanded-name,
-- an empty string is returned. If the argument it omitted, it defaults to a node-set
-- with the context node as its only member.
-- Tim Walkenhorst:

--   Bugfix: name(\/) is "" not "\/"!

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"

-- ------------------------------------------------------------
-- string functions

-- |
-- some helper functions
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

-- -----------------------------------------------------------------------------
-- |
-- Returns the string-value of a node,
-- the value of a namespace node is not supported

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

{-
      textFilter
        = getXCmt `orElse`
--        getXNamespace `orElse`
          multi isXText

--        = (isXTag `guards` multi isXText) `orElse`
--          (isXPi `guards` multi isXText) `orElse`
--          (isXAttr `guards` multi isXText) `orElse`
--          (isXText `guards` multi isXText) `orElse`
--          getXCmt
-}


-- -----------------------------------------------------------------------------
-- |
-- string string(object?): converts an object to a string

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"

-- -----------------------------------------------------------------------------
-- |
-- string concat(string, string, string*): returns the concatenation of its arguments

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))

-- -----------------------------------------------------------------------------
-- |
-- boolean starts-with(string, string):
-- returns true if the first argument string starts
-- with the second argument string, and otherwise returns false

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

-- -----------------------------------------------------------------------------
-- |
-- boolean contains(string, string):
-- returns true if the first argument string contains the second argument string,
-- and otherwise returns false

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


-- -----------------------------------------------------------------------------
-- |
-- string substring-before(string, string):
-- returns the substring of the first argument string that precedes the first occurrence of
-- the second argument string
-- in the first argument string, or the empty string if the first argument string does not
-- contain the second argument string

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"

-- -----------------------------------------------------------------------------
-- |
-- string substring-after(string, string):
-- returns the substring of the first argument string that follows the first occurrence of
-- the second argument string
-- in the first argument string, or the empty string if the first argument string does not
-- contain the second argument string

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"


-- -----------------------------------------------------------------------------
-- |
-- string substring(string, number, number?):
-- returns the substring of the first argument starting at the position specified
-- in the second argument
-- with length specified in the third argument. If the third argument is not specified,
-- it returns the substring
-- starting at the position specified in the second argument and continuing to the end of the string.

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"


-- -----------------------------------------------------------------------------
-- |
-- number string-length(string?):
-- returns the number of characters in the string. If the argument is omitted,
-- it defaults to the context node
-- converted to a string, in other words the string-value of the context node.

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


-- -----------------------------------------------------------------------------
-- |
-- string normalize-space(string?):
-- returns the argument string with whitespace normalized by stripping leading
-- and trailing whitespace and replacing sequences
-- of whitespace characters by a single space. If the argument is omitted,
-- it defaults to the context node converted to a string,
-- in other words the string-value of the context node.
-- The string is parsed by a function parseStr from XPathParser module. <-- No longer! Tim Walkenhorst

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

-- Tim Walkenhorst normStr replaces the use of parseStr...
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

-- -----------------------------------------------------------------------------
-- |
-- string translate(string, string, string):
-- returns the first argument string with occurrences of characters in the second argument string replaced by the character at
-- the corresponding position in the third argument string

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

-- remove all characters, if there is no corresponding character in the third argument
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 -- replace all characters in the first argument
                                          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
""

-- ------------------------------------------------------------
-- boolean functions

-- |
-- boolean boolean(object): converts its argument to a boolean value

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"


-- -----------------------------------------------------------------------------
-- |
-- boolean not(boolean): returns true if its argument is false, and false otherwise
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) )

-- -----------------------------------------------------------------------------
-- |
-- boolean true(): returns true
xtrue                                   :: XFct
xtrue :: XFct
xtrue Context
_ Env
_ [XPathValue]
_                             = Bool -> XPathValue
XPVBool Bool
True

-- -----------------------------------------------------------------------------
-- |
-- boolean false(): returns false
xfalse                                  :: XFct
xfalse :: XFct
xfalse Context
_ Env
_ [XPathValue]
_                            = Bool -> XPathValue
XPVBool Bool
False

-- -----------------------------------------------------------------------------
-- |
-- boolean lang(string):
-- returns true or false depending on whether the language of the context node as specified by xml:lang attributes
-- is the same as or is a sublanguage of the language specified by the argument string

-- -----------------------------------------------------------------------------
--
-- function needs namespaces which are not supported by the toolbox (???)

xlang                                   :: XFct
xlang :: XFct
xlang Context
_ Env
_ [XPathValue]
_                             = String -> XPathValue
XPVError String
"namespaces are not supported"

-- xlang c env args
--    = (\ (_, _, cn) [XPVString s] -> ...) c (toXValue xstring c env args)

-- ------------------------------------------------------------
-- number functions

-- |
-- number number(object?): converts its argument to a number
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"

-- -----------------------------------------------------------------------------
-- |
-- number sum(node-set):
-- returns the sum, for each node in the argument node-set, of the result of
-- converting the string-values of the node to a number

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"

-- -----------------------------------------------------------------------------
-- |
-- number floor(number): returns the largest (closest to positive infinity) number that is not greater
-- than the argument and that is an integer

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"

-- -----------------------------------------------------------------------------
-- |
-- number ceiling(number): returns the smallest (closest to negative infinity) number that is not less
-- than the argument and that is an integer

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"

-- -----------------------------------------------------------------------------
-- |
-- number round(number):
-- returns the number that is closest to the argument and that is an integer.
-- If there are two such numbers, then the one that is closest to positive infinity is returned.

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"

-- -----------------------------------------------------------------------------
-- |
-- node-set key(string, object):
-- does for keys what the id function does for IDs
-- The first argument specifies the name of the key.
-- When the second argument is of type node-set, then the result is the
-- union of the result of applying the key function to the string value
-- of each of the nodes in the argument node-set.
-- When the second argument is of any other type, the argument is
-- converted to a string
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)        -- = isInKey (getKeyTab env) s  ( (\(XPVString s) -> words s) (xstring c env 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


-- -----------------------------------------------------------------------------
-- |
-- string format-number(number, string, string?):
-- converts its first argument to a string using the format pattern string
-- specified by the second argument and the decimal-format named by the
-- third argument, or the default decimal-format, if there is no third argument

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"


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

-- Poor man's document(...) function. Opens exactly one document.
-- Does not support "fragment identifiers". "Base-URI" is always current directory.
-- Should still be good enough for home use.

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)
                                               )

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

-- generate-id, should be fully compliant with XSLT specification.

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))

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