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

{- |
   Module     : Text.XML.HXT.XPath.XPathParser
   Copyright  : Copyright (C) 2006-2010 Uwe Schmidt, Torben Kuseler
   License    : MIT

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

   The XPath Parser

-}

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

module Text.XML.HXT.XPath.XPathParser
    ( parseNumber
    , parseXPath
    )
where

import Text.ParserCombinators.Parsec

import Text.XML.HXT.DOM.TypeDefs

import Text.XML.HXT.XPath.XPathKeywords
import Text.XML.HXT.XPath.XPathDataTypes

import Text.XML.HXT.Parser.XmlCharParser        ( XParser
                                                , XPState(..)
                                                , withNormNewline
                                                )
import Text.XML.HXT.Parser.XmlTokenParser       ( separator
                                                , systemLiteral
                                                , skipS0
                                                , ncName
                                                , qName
                                                )

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

lookupNs                                :: NsEnv -> XName -> Maybe XName
lookupNs :: NsEnv -> XName -> Maybe XName
lookupNs NsEnv
uris XName
prefix
    | NsEnv -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null NsEnv
uris                         = XName -> Maybe XName
forall a. a -> Maybe a
Just XName
nullXName                -- not namespace aware XPath
    | XName -> Bool
isNullXName XName
prefix                = Maybe XName -> (XName -> Maybe XName) -> Maybe XName -> Maybe XName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (XName -> Maybe XName
forall a. a -> Maybe a
Just XName
nullXName) XName -> Maybe XName
forall a. a -> Maybe a
Just (Maybe XName -> Maybe XName) -> Maybe XName -> Maybe XName
forall a b. (a -> b) -> a -> b
$ -- no default namespace given
                                          XName -> NsEnv -> Maybe XName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup XName
prefix NsEnv
uris
    | Bool
otherwise                         = XName -> NsEnv -> Maybe XName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup XName
prefix NsEnv
uris            -- namespace aware

enhanceAttrQName                        :: NsEnv -> QName -> Maybe QName
enhanceAttrQName :: NsEnv -> QName -> Maybe QName
enhanceAttrQName NsEnv
uris QName
qn
    | XName -> Bool
isNullXName (QName -> XName
namePrefix' QName
qn)      = QName -> Maybe QName
forall a. a -> Maybe a
Just QName
qn
    | Bool
otherwise                         = NsEnv -> QName -> Maybe QName
enhanceQName NsEnv
uris QName
qn

enhanceQName                            :: NsEnv -> QName -> Maybe QName
enhanceQName :: NsEnv -> QName -> Maybe QName
enhanceQName NsEnv
uris QName
qn                    = do
                                          nsu <- NsEnv -> XName -> Maybe XName
lookupNs NsEnv
uris (QName -> XName
namePrefix' QName
qn)
                                          return $ setNamespaceUri' nsu qn

enhanceQN                               ::  AxisSpec -> NsEnv -> QName -> Maybe QName
enhanceQN :: AxisSpec -> NsEnv -> QName -> Maybe QName
enhanceQN AxisSpec
Attribute                     = NsEnv -> QName -> Maybe QName
enhanceAttrQName
enhanceQN AxisSpec
_                             = NsEnv -> QName -> Maybe QName
enhanceQName

type XPathParser a                      = XParser NsEnv a

-- ------------------------------------------------------------
-- parse functions which are used in the XPathFct module

-- |
-- parsing a number, parseNumber is used in "XPathFct"
-- by the number function
--
--    - returns : the parsed number as 'XPNumber' float
--                or 'XPVNumber' 'NaN' in case of error
parseNumber :: String -> XPathValue
parseNumber :: [Char] -> XPathValue
parseNumber [Char]
s
    = case (GenParser Char (XPState NsEnv) [Char]
-> XPState NsEnv -> [Char] -> [Char] -> Either ParseError [Char]
forall tok st a.
GenParser tok st a -> st -> [Char] -> [tok] -> Either ParseError a
runParser GenParser Char (XPState NsEnv) [Char]
parseNumber' (NsEnv -> XPState NsEnv
forall a. a -> XPState a
withNormNewline []) {- Map.empty -} [Char]
"" [Char]
s) of
        Left ParseError
_ -> XPNumber -> XPathValue
XPVNumber XPNumber
NaN
        Right [Char]
x  -> if ([Char] -> Float
forall a. Read a => [Char] -> a
read [Char]
x :: Float) Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
0
                      then (XPNumber -> XPathValue
XPVNumber XPNumber
Pos0)
                      else XPNumber -> XPathValue
XPVNumber (Float -> XPNumber
Float ([Char] -> Float
forall a. Read a => [Char] -> a
read [Char]
x))

parseNumber' :: XPathParser String
parseNumber' :: GenParser Char (XPState NsEnv) [Char]
parseNumber'
    = do
      XParser NsEnv ()
forall s. XParser s ()
skipS0
      m <- [Char]
-> GenParser Char (XPState NsEnv) [Char]
-> GenParser Char (XPState NsEnv) [Char]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [Char]
"" ([Char] -> GenParser Char (XPState NsEnv) [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"-")
      n <- number
      skipS0
      eof
      return (m ++ n)

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


-- |
-- the main entry point:
-- parsing a XPath expression

parseXPath :: XPathParser Expr
parseXPath :: XPathParser Expr
parseXPath
    = do
      XParser NsEnv ()
forall s. XParser s ()
skipS0
      xPathExpr <- XPathParser Expr
expr
      skipS0
      eof
      return xPathExpr


-- some useful token and symbol parser
lpar, rpar, lbra, rbra, slash, dslash   :: XPathParser ()

lpar :: XParser NsEnv ()
lpar   = GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"(")
rpar :: XParser NsEnv ()
rpar   = GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
")")
lbra :: XParser NsEnv ()
lbra   = GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"[")
rbra :: XParser NsEnv ()
rbra   = GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"]")
slash :: XParser NsEnv ()
slash  = GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"/")
dslash :: XParser NsEnv ()
dslash = GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"//")


tokenParser :: XPathParser String -> XPathParser ()
tokenParser :: GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser GenParser Char (XPState NsEnv) [Char]
p
    = XParser NsEnv () -> XParser NsEnv ()
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do
            XParser NsEnv ()
forall s. XParser s ()
skipS0
            _ <- GenParser Char (XPState NsEnv) [Char]
p
            skipS0
           )


symbolParser :: (String, a) -> XPathParser a
symbolParser :: forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
s,a
a)
    = do
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
s)
      a -> ParsecT [Char] (XPState NsEnv) Identity a
forall a. a -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a


symbol :: String -> XPathParser String
symbol :: [Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
s = GenParser Char (XPState NsEnv) [Char]
-> GenParser Char (XPState NsEnv) [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> GenParser Char (XPState NsEnv) [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
s)



--  operation parser
orOp, andOp, eqOp, relOp, addOp, multiOp, unionOp :: XPathParser Op

orOp :: XPathParser Op
orOp  = ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"or", Op
Or)
andOp :: XPathParser Op
andOp = ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"and", Op
And)

eqOp :: XPathParser Op
eqOp
    = ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"=", Op
Eq)
      XPathParser Op -> XPathParser Op -> XPathParser Op
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"!=", Op
NEq)

relOp :: XPathParser Op
relOp
    = [XPathParser Op] -> XPathParser Op
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"<=", Op
LessEq)
             , ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
">=", Op
GreaterEq)
             , ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"<", Op
Less)
             , ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
">", Op
Greater)
             ]

addOp :: XPathParser Op
addOp
    = ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"+", Op
Plus)
      XPathParser Op -> XPathParser Op -> XPathParser Op
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"-", Op
Minus)


multiOp :: XPathParser Op
multiOp
    = [XPathParser Op] -> XPathParser Op
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"*", Op
Mult)
             , ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"mod", Op
Mod)
             , ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"div", Op
Div)
             ]


unionOp :: XPathParser Op
unionOp = ([Char], Op) -> XPathParser Op
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
"|", Op
Union)

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

mkExprNode :: Expr -> [(Op, Expr)] -> Expr
mkExprNode :: Expr -> [(Op, Expr)] -> Expr
mkExprNode Expr
e1 [] = Expr
e1
mkExprNode Expr
e1 l :: [(Op, Expr)]
l@((Op
op, Expr
_): [(Op, Expr)]
_) =
    if [(Op, Expr)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Op, Expr)]
rest
      then Op -> [Expr] -> Expr
GenExpr Op
op (Expr
e1Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:(((Op, Expr) -> Expr) -> [(Op, Expr)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Op, Expr) -> Expr
forall a b. (a, b) -> b
snd [(Op, Expr)]
l))
      else Op -> [Expr] -> Expr
GenExpr Op
op ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (Expr
e1Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
:(((Op, Expr) -> Expr) -> [(Op, Expr)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (Op, Expr) -> Expr
forall a b. (a, b) -> b
snd ([(Op, Expr)] -> [Expr]) -> [(Op, Expr)] -> [Expr]
forall a b. (a -> b) -> a -> b
$ [(Op, Expr)] -> [(Op, Expr)]
forall a. HasCallStack => [a] -> [a]
init [(Op, Expr)]
same)) [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr -> [(Op, Expr)] -> Expr
mkExprNode ((Op, Expr) -> Expr
forall a b. (a, b) -> b
snd ((Op, Expr) -> Expr) -> (Op, Expr) -> Expr
forall a b. (a -> b) -> a -> b
$ [(Op, Expr)] -> (Op, Expr)
forall a. HasCallStack => [a] -> a
last [(Op, Expr)]
same) [(Op, Expr)]
rest]
  where
    ([(Op, Expr)]
same, [(Op, Expr)]
rest) = ((Op, Expr) -> Bool)
-> [(Op, Expr)] -> ([(Op, Expr)], [(Op, Expr)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span ((Op -> Op -> Bool
forall a. Eq a => a -> a -> Bool
==Op
op) (Op -> Bool) -> ((Op, Expr) -> Op) -> (Op, Expr) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Op, Expr) -> Op
forall a b. (a, b) -> a
fst) [(Op, Expr)]
l

-- Tim Walkenhorst, original expr. below:
-- It seems mkExprNode is called only with operators of the same precedence, that should make it fixable
-- FIXED, see above!
--mkExprNode e1 l@((op, _): _) = GenExpr op (e1:(map snd l))  -- Less than ideal: 1+1-1 = 3 ???


--GenExpr op (e1:(map snd l))


exprRest :: XPathParser Op -> XPathParser Expr -> XPathParser (Op, Expr)
exprRest :: XPathParser Op -> XPathParser Expr -> XPathParser (Op, Expr)
exprRest XPathParser Op
parserOp XPathParser Expr
parserExpr
    = do
      op <- XPathParser Op
parserOp
      e2 <- parserExpr
      return (op, e2)


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

-- abbreviation of "//"
descOrSelfStep :: XStep
descOrSelfStep :: XStep
descOrSelfStep = (AxisSpec -> NodeTest -> [Expr] -> XStep
Step AxisSpec
DescendantOrSelf (XPathNode -> NodeTest
TypeTest XPathNode
XPNode) [])

-- ------------------------------------------------------------
-- Location Paths (2)


-- [1] LocationPath
locPath :: XPathParser LocationPath
locPath :: XPathParser LocationPath
locPath
    = XPathParser LocationPath
absLocPath
      XPathParser LocationPath
-> XPathParser LocationPath -> XPathParser LocationPath
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      XPathParser LocationPath
relLocPath'


-- [2] AbsoluteLocationPath
absLocPath :: XPathParser LocationPath
absLocPath :: XPathParser LocationPath
absLocPath
    = do -- [10]
      XParser NsEnv ()
dslash
      s <- XPathParser [XStep]
relLocPath
      return (LocPath Abs ([descOrSelfStep] ++ s))
      XPathParser LocationPath
-> XPathParser LocationPath -> XPathParser LocationPath
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      XParser NsEnv ()
slash
      s <- [XStep] -> XPathParser [XStep] -> XPathParser [XStep]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] XPathParser [XStep]
relLocPath
      return (LocPath Abs s)
      XPathParser LocationPath -> [Char] -> XPathParser LocationPath
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"absLocPath"


-- [3] RelativeLocationPath
relLocPath' :: XPathParser LocationPath
relLocPath' :: XPathParser LocationPath
relLocPath'
    = do
      rel <- XPathParser [XStep]
relLocPath
      return (LocPath Rel rel)

relLocPath :: XPathParser [XStep]
relLocPath :: XPathParser [XStep]
relLocPath
    = do
      s1 <- XPathParser XStep
step
      s2 <- many (step')
      return ([s1] ++ (concat s2))
      XPathParser [XStep] -> [Char] -> XPathParser [XStep]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"relLocPath"


-- Location Steps (2.1)
--
-- [4] Step
step' :: XPathParser [XStep]
step' :: XPathParser [XStep]
step'
    = do -- [11]
      XParser NsEnv ()
dslash
      s <- XPathParser XStep
step
      return [descOrSelfStep,s]
      XPathParser [XStep] -> XPathParser [XStep] -> XPathParser [XStep]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      XParser NsEnv ()
slash
      s <- XPathParser XStep
step
      return [s]
      XPathParser [XStep] -> [Char] -> XPathParser [XStep]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"step'"

step :: XPathParser XStep
step :: XPathParser XStep
step
    = XPathParser XStep
abbrStep
      XPathParser XStep -> XPathParser XStep -> XPathParser XStep
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      as <- XPathParser AxisSpec
axisSpecifier'
      nt <- nodeTest as
      pr <- many predicate
      return (Step as nt pr)
      XPathParser XStep -> [Char] -> XPathParser XStep
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"step"


-- [5] AxisSpecifier
axisSpecifier' :: XPathParser AxisSpec
axisSpecifier' :: XPathParser AxisSpec
axisSpecifier'
    = do  -- [13]
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"@")
      AxisSpec -> XPathParser AxisSpec
forall a. a -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return AxisSpec
Attribute
      XPathParser AxisSpec
-> XPathParser AxisSpec -> XPathParser AxisSpec
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      as <- AxisSpec -> XPathParser AxisSpec -> XPathParser AxisSpec
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option AxisSpec
Child ( XPathParser AxisSpec -> XPathParser AxisSpec
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do -- child-axis is default-axis
                                 a <- XPathParser AxisSpec
axisSpecifier
                                 tokenParser (symbol "::")
                                 return a
                               )
                          )
      return as
      XPathParser AxisSpec -> [Char] -> XPathParser AxisSpec
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"axisSpecifier'"


-- Axes (2.2)
--
-- [6] AxisName
axisSpecifier :: XPathParser AxisSpec
axisSpecifier :: XPathParser AxisSpec
axisSpecifier
    = [XPathParser AxisSpec] -> XPathParser AxisSpec
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_ancestor_or_self, AxisSpec
AncestorOrSelf)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_ancestor, AxisSpec
Ancestor)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_attribute, AxisSpec
Attribute)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_child, AxisSpec
Child)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_descendant_or_self, AxisSpec
DescendantOrSelf)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_descendant, AxisSpec
Descendant)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_following_sibling, AxisSpec
FollowingSibling)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_following, AxisSpec
Following)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_namespace, AxisSpec
Namespace)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_parent, AxisSpec
Parent)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_preceding_sibling, AxisSpec
PrecedingSibling)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_preceding, AxisSpec
Preceding)
             , ([Char], AxisSpec) -> XPathParser AxisSpec
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
a_self, AxisSpec
Self)
             ]
      XPathParser AxisSpec -> [Char] -> XPathParser AxisSpec
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"axisSpecifier"


-- Node Tests (2.3)
--
-- [7] NodeTest
nodeTest :: AxisSpec -> XPathParser NodeTest
nodeTest :: AxisSpec -> XPathParser NodeTest
nodeTest AxisSpec
as
    = do
      nt <- GenParser Char (XPState NsEnv) XPathNode
-> GenParser Char (XPState NsEnv) XPathNode
forall tok st a. GenParser tok st a -> GenParser tok st a
try GenParser Char (XPState NsEnv) XPathNode
nodeType'
      return (TypeTest nt)
      XPathParser NodeTest
-> XPathParser NodeTest -> XPathParser NodeTest
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      processInst <- GenParser Char (XPState NsEnv) [Char]
pI
      return (PI processInst)
      XPathParser NodeTest
-> XPathParser NodeTest -> XPathParser NodeTest
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      nt <- AxisSpec -> XPathParser QName
nameTest AxisSpec
as
      return (NameTest nt)
      XPathParser NodeTest -> [Char] -> XPathParser NodeTest
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"nodeTest"

pI :: XPathParser String
pI :: GenParser Char (XPState NsEnv) [Char]
pI
    = do
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
n_processing_instruction)
      li <- XParser NsEnv ()
-> XParser NsEnv ()
-> GenParser Char (XPState NsEnv) [Char]
-> GenParser Char (XPState NsEnv) [Char]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between XParser NsEnv ()
lpar XParser NsEnv ()
rpar GenParser Char (XPState NsEnv) [Char]
literal
      return li
      GenParser Char (XPState NsEnv) [Char]
-> [Char] -> GenParser Char (XPState NsEnv) [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"Processing-Instruction"


-- Predicates (2.4)
--
-- [8] Predicate
-- [9] PredicateExpr
predicate :: XPathParser Expr
predicate :: XPathParser Expr
predicate
    = do
      ex <- XParser NsEnv ()
-> XParser NsEnv () -> XPathParser Expr -> XPathParser Expr
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between XParser NsEnv ()
lbra XParser NsEnv ()
rbra XPathParser Expr
expr
      return ex


-- Abbreviated Syntax (2.5)
--
-- [10] AbbreviatedAbsoluteLocationPath: q.v. [2]
-- [11] AbbreviatedRelativeLocationPath: q.v. [4]

-- [12] AbbreviatedStep
abbrStep :: XPathParser XStep
abbrStep :: XPathParser XStep
abbrStep
    = do
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"..")
      XStep -> XPathParser XStep
forall a. a -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AxisSpec -> NodeTest -> [Expr] -> XStep
Step AxisSpec
Parent (XPathNode -> NodeTest
TypeTest XPathNode
XPNode) [])
      XPathParser XStep -> XPathParser XStep -> XPathParser XStep
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
".")
      XStep -> XPathParser XStep
forall a. a -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AxisSpec -> NodeTest -> [Expr] -> XStep
Step AxisSpec
Self (XPathNode -> NodeTest
TypeTest XPathNode
XPNode) [])
      XPathParser XStep -> [Char] -> XPathParser XStep
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"abbrStep"

-- [13] AbbreviatedAxisSpecifier: q.v. [5]


-- ------------------------------------------------------------
-- Expressions (3)


-- Basics (3.1)
--
-- [14] Expr
expr :: XPathParser Expr
expr :: XPathParser Expr
expr = XPathParser Expr
orExpr


-- [15] PrimaryExpr
primaryExpr ::  XPathParser Expr
primaryExpr :: XPathParser Expr
primaryExpr
    = do
      vr <- XPathParser ([Char], [Char])
variableReference
      return (VarExpr vr)
      XPathParser Expr -> XPathParser Expr -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      ex <- XParser NsEnv ()
-> XParser NsEnv () -> XPathParser Expr -> XPathParser Expr
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between XParser NsEnv ()
lpar XParser NsEnv ()
rpar XPathParser Expr
expr
      return ex
      XPathParser Expr -> XPathParser Expr -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      li <- GenParser Char (XPState NsEnv) [Char]
literal
      return (LiteralExpr li)
      XPathParser Expr -> XPathParser Expr -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      num <- GenParser Char (XPState NsEnv) [Char]
number
      return (NumberExpr (Float $ read num))
      XPathParser Expr -> XPathParser Expr -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      fc <- XPathParser Expr
functionCall
      return (fc)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"primaryExpr"


-- Function Calls (3.2)
--
-- [16] FunctionCall
-- [17] Argument
functionCall :: XPathParser Expr
functionCall :: XPathParser Expr
functionCall
    = do
      fn <- GenParser Char (XPState NsEnv) [Char]
functionName
      arg <- between lpar rpar ( sepBy expr (separator ',') )
      return (FctExpr fn arg)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"functionCall"


-- Node-sets (3.3)
--
-- [18] UnionExpr
unionExpr :: XPathParser Expr
unionExpr :: XPathParser Expr
unionExpr
    = do
      e1 <- XPathParser Expr
pathExpr
      eRest <- many (exprRest unionOp pathExpr)
      return (mkExprNode e1 eRest)


-- [19] PathExpr
pathExpr :: XPathParser Expr
pathExpr :: XPathParser Expr
pathExpr
    = do
      fe <- XPathParser Expr -> XPathParser Expr
forall tok st a. GenParser tok st a -> GenParser tok st a
try XPathParser Expr
filterExpr
      path <- do
              dslash
              LocPath t1 t2 <- relLocPath'
              return (PathExpr (Just fe) (Just (LocPath t1 ([descOrSelfStep] ++ t2))))
              <|>
              do
              slash
              relPath <- relLocPath'
              return (PathExpr (Just fe) (Just relPath))
              <|>
              return fe
      return path
      XPathParser Expr -> XPathParser Expr -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      lp <- XPathParser LocationPath
locPath
      return (PathExpr Nothing (Just lp))
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"pathExpr"


-- [20] FilterExpr
filterExpr :: XPathParser Expr
filterExpr :: XPathParser Expr
filterExpr
    = do
      prim <- XPathParser Expr
primaryExpr
      predicates <- many predicate
      if length predicates > 0
        then return (FilterExpr (prim : predicates))
        else return prim
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"filterExpr"


-- Booleans (3.4)
--
-- [21] OrExpr
orExpr :: XPathParser Expr
orExpr :: XPathParser Expr
orExpr
    = do
      e1 <- XPathParser Expr
andExpr
      eRest <- many (exprRest orOp andExpr)
      return (mkExprNode e1 eRest)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"orExpr"


-- [22] AndExpr
andExpr :: XPathParser Expr
andExpr :: XPathParser Expr
andExpr
    = do
      e1 <- XPathParser Expr
equalityExpr
      eRest <- many (exprRest andOp equalityExpr)
      return (mkExprNode e1 eRest)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"andExpr"


-- [23] EqualityExpr
equalityExpr :: XPathParser Expr
equalityExpr :: XPathParser Expr
equalityExpr
    = do
      e1 <- XPathParser Expr
relationalExpr
      eRest <- many (exprRest eqOp relationalExpr)
      return (mkExprNode e1 eRest)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"equalityExpr"


-- [24] RelationalExpr
relationalExpr :: XPathParser Expr
relationalExpr :: XPathParser Expr
relationalExpr
    = do
      e1 <- XPathParser Expr
additiveExpr
      eRest <- many (exprRest relOp additiveExpr)
      return (mkExprNode e1 eRest)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"relationalExpr"


-- Numbers (3.5)
--
-- [25] AdditiveExpr
additiveExpr :: XPathParser Expr
additiveExpr :: XPathParser Expr
additiveExpr
    = do
      e1 <- XPathParser Expr
multiplicativeExpr
      eRest <- many (exprRest addOp multiplicativeExpr)
      return (mkExprNode e1 eRest)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"additiveExpr"


-- [26] MultiplicativeExpr
multiplicativeExpr :: XPathParser Expr
multiplicativeExpr :: XPathParser Expr
multiplicativeExpr
    = do
      e1 <- XPathParser Expr
unaryExpr
      eRest <- many (exprRest multiOp unaryExpr)
      return (mkExprNode e1 eRest)
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"multiplicativeExpr"


-- [27] UnaryExpr
unaryExpr :: XPathParser Expr
unaryExpr :: XPathParser Expr
unaryExpr
    = do
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"-")
      u <- XPathParser Expr
unaryExpr
      return (GenExpr Unary [u])
      XPathParser Expr -> XPathParser Expr -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      u <- XPathParser Expr
unionExpr
      return u
      XPathParser Expr -> [Char] -> XPathParser Expr
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"unaryExpr"


-- Lexical Structure (3.7)
--
-- [29] Literal
-- systemLiteral from XmlParser is used
literal :: XPathParser String
literal :: GenParser Char (XPState NsEnv) [Char]
literal = GenParser Char (XPState NsEnv) [Char]
forall s. XParser s [Char]
systemLiteral


-- [30] Number
number :: XPathParser String
number :: GenParser Char (XPState NsEnv) [Char]
number
    = do
      GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
".")
      d <- ParsecT [Char] (XPState NsEnv) Identity Char
-> GenParser Char (XPState NsEnv) [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] (XPState NsEnv) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      return ("0." ++ d)
      GenParser Char (XPState NsEnv) [Char]
-> GenParser Char (XPState NsEnv) [Char]
-> GenParser Char (XPState NsEnv) [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do
      d <- ParsecT [Char] (XPState NsEnv) Identity Char
-> GenParser Char (XPState NsEnv) [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] (XPState NsEnv) Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit
      d1 <- option "" ( do
                        tokenParser (symbol ".")
                        d2 <- option "0" (many1 digit)
                        return ("." ++ d2)
                      )
      return (d ++ d1)
      GenParser Char (XPState NsEnv) [Char]
-> [Char] -> GenParser Char (XPState NsEnv) [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"number"


-- [35] FunctionName
-- no nodetype name is allowed as a function name
-- Tim Walkenhorst:
--   Change in String encoding for function name
--
--         previoulsy:      new:
--
--         name             name
--         pref:name        {http://uri-for-pref}name

functionName :: XPathParser String
functionName :: GenParser Char (XPState NsEnv) [Char]
functionName
    = do (p, n) <- XPathParser ([Char], [Char]) -> XPathParser ([Char], [Char])
forall tok st a. GenParser tok st a -> GenParser tok st a
try XPathParser ([Char], [Char])
forall s. XParser s ([Char], [Char])
qName
         fn     <- enhanceName Attribute $ mkPrefixLocalPart p n
         if null p
            then if n `elem` ["processing-instruction", "comment", "text", "node"]
                 then fail   $ "function name: " ++ n ++ "not allowed"
                 else return n
            else return $ "{" ++ namespaceUri fn ++ "}" ++ n
      GenParser Char (XPState NsEnv) [Char]
-> [Char] -> GenParser Char (XPState NsEnv) [Char]
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"functionName"


-- [36] VariableReference
variableReference :: XPathParser (String, String)
variableReference :: XPathParser ([Char], [Char])
variableReference
    = do GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"$")
         (p, n) <- XPathParser ([Char], [Char])
forall s. XParser s ([Char], [Char])
qName
         vn     <- enhanceName Attribute $ mkPrefixLocalPart p n
         return (namespaceUri vn, n)
      XPathParser ([Char], [Char])
-> [Char] -> XPathParser ([Char], [Char])
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"variableReference"


-- [37] NameTest
nameTest :: AxisSpec -> XPathParser QName
nameTest :: AxisSpec -> XPathParser QName
nameTest AxisSpec
axs
    = do GenParser Char (XPState NsEnv) [Char] -> XParser NsEnv ()
tokenParser ([Char] -> GenParser Char (XPState NsEnv) [Char]
symbol [Char]
"*")
         AxisSpec -> QName -> XPathParser QName
enhanceName AxisSpec
axs (QName -> XPathParser QName) -> QName -> XPathParser QName
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> QName
mkPrefixLocalPart [Char]
"" [Char]
"*"
      XPathParser QName -> XPathParser QName -> XPathParser QName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do pre <- GenParser Char (XPState NsEnv) [Char]
-> GenParser Char (XPState NsEnv) [Char]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ( do pre' <- GenParser Char (XPState NsEnv) [Char]
forall s. XParser s [Char]
ncName
                         _    <- symbol ":*"
                         return pre'
                    )
         enhanceName axs $ mkPrefixLocalPart pre "*"
      XPathParser QName -> XPathParser QName -> XPathParser QName
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
      do (pre,local) <- XPathParser ([Char], [Char])
forall s. XParser s ([Char], [Char])
qName
         enhanceName axs $ mkPrefixLocalPart pre local
      XPathParser QName -> [Char] -> XPathParser QName
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"nameTest"

enhanceName     :: AxisSpec -> QName -> XPathParser QName
enhanceName :: AxisSpec -> QName -> XPathParser QName
enhanceName AxisSpec
axs QName
qn
    = do uris <- ParsecT [Char] (XPState NsEnv) Identity (XPState NsEnv)
forall (m :: * -> *) s u. Monad m => ParsecT s u m u
getState ParsecT [Char] (XPState NsEnv) Identity (XPState NsEnv)
-> (XPState NsEnv -> ParsecT [Char] (XPState NsEnv) Identity NsEnv)
-> ParsecT [Char] (XPState NsEnv) Identity NsEnv
forall a b.
ParsecT [Char] (XPState NsEnv) Identity a
-> (a -> ParsecT [Char] (XPState NsEnv) Identity b)
-> ParsecT [Char] (XPState NsEnv) Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NsEnv -> ParsecT [Char] (XPState NsEnv) Identity NsEnv
forall a. a -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (NsEnv -> ParsecT [Char] (XPState NsEnv) Identity NsEnv)
-> (XPState NsEnv -> NsEnv)
-> XPState NsEnv
-> ParsecT [Char] (XPState NsEnv) Identity NsEnv
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XPState NsEnv -> NsEnv
forall s. XPState s -> s
xps_userState
         case enhanceQN axs uris qn of
           Maybe QName
Nothing  -> [Char] -> XPathParser QName
forall a. [Char] -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> XPathParser QName) -> [Char] -> XPathParser QName
forall a b. (a -> b) -> a -> b
$ [Char]
"no namespace uri given for prefix " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show (QName -> [Char]
namePrefix QName
qn)
           Just QName
qn' -> QName -> XPathParser QName
forall a. a -> ParsecT [Char] (XPState NsEnv) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return QName
qn'
      XPathParser QName -> [Char] -> XPathParser QName
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"qualified name with defined namespace uri"

-- [38] NodeType
nodeType' :: XPathParser XPathNode
nodeType' :: GenParser Char (XPState NsEnv) XPathNode
nodeType'
    = do
      nt <- GenParser Char (XPState NsEnv) XPathNode
nodeType
      lpar
      rpar
      return nt
      GenParser Char (XPState NsEnv) XPathNode
-> [Char] -> GenParser Char (XPState NsEnv) XPathNode
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"nodeType'"

nodeType :: XPathParser XPathNode
nodeType :: GenParser Char (XPState NsEnv) XPathNode
nodeType
    = [GenParser Char (XPState NsEnv) XPathNode]
-> GenParser Char (XPState NsEnv) XPathNode
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ([Char], XPathNode) -> GenParser Char (XPState NsEnv) XPathNode
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
n_comment, XPathNode
XPCommentNode)
             , ([Char], XPathNode) -> GenParser Char (XPState NsEnv) XPathNode
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
n_text, XPathNode
XPTextNode)
             , ([Char], XPathNode) -> GenParser Char (XPState NsEnv) XPathNode
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
n_processing_instruction, XPathNode
XPPINode)
             , ([Char], XPathNode) -> GenParser Char (XPState NsEnv) XPathNode
forall a. ([Char], a) -> XPathParser a
symbolParser ([Char]
n_node, XPathNode
XPNode)
             ]
      GenParser Char (XPState NsEnv) XPathNode
-> [Char] -> GenParser Char (XPState NsEnv) XPathNode
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"nodeType"

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