-- | A parser for the Xtract command-language.  (The string input is
--   tokenised internally by the lexer 'lexXtract'.)
--   See <http://www.haskell.org/HaXml/Xtract.html> for the grammar that
--   is accepted.

--   Because the original Xtract grammar was left-recursive, we have
--   transformed it into a non-left-recursive form.
module Text.XML.HaXml.Xtract.Parse (parseXtract,xtract) where

import Text.ParserCombinators.Poly hiding (bracket)
import Text.XML.HaXml.Xtract.Lex
import Text.XML.HaXml.Xtract.Combinators as D
import Text.XML.HaXml.Combinators as C
import Text.XML.HaXml.Types (Content)
import Data.List(isPrefixOf)
import Text.XML.HaXml.Escape (xmlUnEscapeContent,stdXmlEscaper)

-- output transformer - to ensure that text/references are glued together
unescape :: [Content i] -> [Content i]
unescape :: [Content i] -> [Content i]
unescape = XmlEscaper -> [Content i] -> [Content i]
forall i. XmlEscaper -> [Content i] -> [Content i]
xmlUnEscapeContent XmlEscaper
stdXmlEscaper


-- | To convert an Xtract query into an ordinary HaXml combinator expression.
--   First arg is a tag-transformation function (e.g. map toLower) applied
---  before matching.  Second arg is the query string.
xtract :: (String->String) -> String -> CFilter i
xtract :: (String -> String) -> String -> CFilter i
xtract String -> String
f String
query
    | [Either String (Posn, TokenT)] -> Bool
forall a a. [Either a (a, TokenT)] -> Bool
interiorRef [Either String (Posn, TokenT)]
lexedQ = DFilter i -> CFilter i
forall i. DFilter i -> CFilter i
dfilter ([Either String (Posn, TokenT)] -> DFilter i
forall i. [Either String (Posn, TokenT)] -> DFilter i
parseXtract [Either String (Posn, TokenT)]
lexedQ)
    | Bool
otherwise          = DFilter i -> CFilter i
forall i. DFilter i -> CFilter i
cfilter ([Either String (Posn, TokenT)] -> DFilter i
forall i. [Either String (Posn, TokenT)] -> DFilter i
parseXtract [Either String (Posn, TokenT)]
lexedQ)
  where
    lexedQ :: [Either String (Posn, TokenT)]
lexedQ = (String -> String) -> String -> [Either String (Posn, TokenT)]
lexXtract String -> String
f String
query
    -- test whether query has interior reference to doc root
    interiorRef :: [Either a (a, TokenT)] -> Bool
interiorRef (Right (a
_,Symbol String
s): Right (a
_,Symbol String
"//"): [Either a (a, TokenT)]
_)
                                          | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
predicateIntro = Bool
True
    interiorRef (Right (a
_,Symbol String
s): Right (a
_,Symbol String
"/"): [Either a (a, TokenT)]
_)
                                          | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
predicateIntro = Bool
True
    interiorRef (Either a (a, TokenT)
_ : [Either a (a, TokenT)]
rest) = [Either a (a, TokenT)] -> Bool
interiorRef [Either a (a, TokenT)]
rest
    interiorRef [] = Bool
False
    predicateIntro :: [String]
predicateIntro = [ String
"[", String
"("
                     ,  String
"&",   String
"|",  String
"~"
                     ,  String
"=",  String
"!=",  String
"<",  String
"<=",  String
">",  String
">="
                     , String
".=.",String
".!=.",String
".<.",String
".<=.",String
".>.",String
".>=." ]

-- | The cool thing is that the Xtract command parser directly builds
--   a higher-order 'DFilter' (see "Text.XML.HaXml.Xtract.Combinators")
--   which can be applied to an XML document without further ado.
--   (@parseXtract@ halts the program if a parse error is found.)
parseXtract :: [Token] -> DFilter i
parseXtract :: [Either String (Posn, TokenT)] -> DFilter i
parseXtract = (String -> DFilter i)
-> (DFilter i -> DFilter i)
-> Either String (DFilter i)
-> DFilter i
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> DFilter i
forall a. HasCallStack => String -> a
error DFilter i -> DFilter i
forall a. a -> a
id (Either String (DFilter i) -> DFilter i)
-> ([Either String (Posn, TokenT)] -> Either String (DFilter i))
-> [Either String (Posn, TokenT)]
-> DFilter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String (Posn, TokenT)] -> Either String (DFilter i)
forall i.
[Either String (Posn, TokenT)] -> Either String (DFilter i)
parseXtract'

-- | @parseXtract'@ returns error messages through the Either type.
parseXtract' :: [Token] -> Either String (DFilter i)
parseXtract' :: [Either String (Posn, TokenT)] -> Either String (DFilter i)
parseXtract' = (Either String (DFilter i), [Either String (Posn, TokenT)])
-> Either String (DFilter i)
forall a b. (a, b) -> a
fst ((Either String (DFilter i), [Either String (Posn, TokenT)])
 -> Either String (DFilter i))
-> ([Either String (Posn, TokenT)]
    -> (Either String (DFilter i), [Either String (Posn, TokenT)]))
-> [Either String (Posn, TokenT)]
-> Either String (DFilter i)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser (Either String (Posn, TokenT)) (DFilter i)
-> [Either String (Posn, TokenT)]
-> (Either String (DFilter i), [Either String (Posn, TokenT)])
forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser (((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> Parser (Either String (Posn, TokenT)) (DFilter i)
forall i.
((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
aquery (CFilter i -> CFilter i) -> DFilter i -> DFilter i
forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftLocal)

---- Auxiliary Parsing Functions ----
type XParser a = Parser (Either String (Posn,TokenT)) a

string :: XParser String
string :: XParser String
string = ([Either String (Posn, TokenT)]
 -> Result [Either String (Posn, TokenT)] String)
-> XParser String
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\[Either String (Posn, TokenT)]
inp -> case [Either String (Posn, TokenT)]
inp of
                (Left String
err: [Either String (Posn, TokenT)]
_) -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] String
forall z a. z -> String -> Result z a
Failure [Either String (Posn, TokenT)]
inp String
err
                (Right (Posn
_,TokString String
n):[Either String (Posn, TokenT)]
ts) -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] String
forall z a. z -> a -> Result z a
Success [Either String (Posn, TokenT)]
ts String
n
                [Either String (Posn, TokenT)]
ts -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] String
forall z a. z -> String -> Result z a
Failure [Either String (Posn, TokenT)]
ts String
"expected a string" )
number :: XParser Integer
number :: XParser Integer
number = ([Either String (Posn, TokenT)]
 -> Result [Either String (Posn, TokenT)] Integer)
-> XParser Integer
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\[Either String (Posn, TokenT)]
inp -> case [Either String (Posn, TokenT)]
inp of
                (Left String
err: [Either String (Posn, TokenT)]
_) -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] Integer
forall z a. z -> String -> Result z a
Failure [Either String (Posn, TokenT)]
inp String
err
                (Right (Posn
_,TokNum Integer
n):[Either String (Posn, TokenT)]
ts) -> [Either String (Posn, TokenT)]
-> Integer -> Result [Either String (Posn, TokenT)] Integer
forall z a. z -> a -> Result z a
Success [Either String (Posn, TokenT)]
ts Integer
n
                [Either String (Posn, TokenT)]
ts -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] Integer
forall z a. z -> String -> Result z a
Failure [Either String (Posn, TokenT)]
ts String
"expected a number" )
symbol :: String -> XParser ()
symbol :: String -> XParser ()
symbol String
s = ([Either String (Posn, TokenT)]
 -> Result [Either String (Posn, TokenT)] ())
-> XParser ()
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\[Either String (Posn, TokenT)]
inp -> case [Either String (Posn, TokenT)]
inp of
                (Left String
err: [Either String (Posn, TokenT)]
_) -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] ()
forall z a. z -> String -> Result z a
Failure [Either String (Posn, TokenT)]
inp String
err
                (Right (Posn
_, Symbol String
n):[Either String (Posn, TokenT)]
ts) | String
nString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
s -> [Either String (Posn, TokenT)]
-> () -> Result [Either String (Posn, TokenT)] ()
forall z a. z -> a -> Result z a
Success [Either String (Posn, TokenT)]
ts ()
                [Either String (Posn, TokenT)]
ts -> [Either String (Posn, TokenT)]
-> String -> Result [Either String (Posn, TokenT)] ()
forall z a. z -> String -> Result z a
Failure [Either String (Posn, TokenT)]
ts (String
"expected symbol "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
s) )

quote :: XParser ()
quote :: XParser ()
quote = [XParser ()] -> XParser ()
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf [ String -> XParser ()
symbol String
"'",  String -> XParser ()
symbol String
"\"" ]

pam :: [a->b] -> a -> [b]
pam :: [a -> b] -> a -> [b]
pam [a -> b]
fs a
x = [ a -> b
f a
x | a -> b
f <- [a -> b]
fs ]


{--- original Xtract grammar ----
      query     = string                        tagname
                | string *                      tagname prefix
                | * string                      tagname suffix
                | *                             any element
                | -                             chardata
                | ( query )
                | query / query                 parent/child relationship
                | query // query                deep inside
                | query + query                 union of queries
                | query [predicate]
                | query [positions]

      predicate = quattr                        has attribute
                | quattr op ' string '          attribute has value
                | quattr op " string "          attribute has value
                | quattr op  quattr             attribute value comparison (lexical)
                | quattr nop integer            attribute has value (numerical)
                | quattr nop quattr             attribute value comparison (numerical)
                | ( predicate )                 bracketting
                | predicate & predicate         logical and
                | predicate | predicate         logical or
                | ~ predicate                   logical not

      attribute = @ string                      has attribute
                | query / @ string              child has attribute
                | -                             has textual content
                | query / -                     child has textual content

      quattr    = query
                | attribute

      op        =  =                            equal to
                |  !=                           not equal to
                |  <                            less than
                |  <=                           less than or equal to
                |  >                            greater than
                |  >=                           greater than or equal to

      nop       =  .=.                          equal to
                |  .!=.                         not equal to
                |  .<.                          less than
                |  .<=.                         less than or equal to
                |  .>.                          greater than
                |  .>=.                         greater than or equal to

      positions = position {, positions}        multiple positions
                | position - position           ranges

      position  = integer                       numbering is from 0 upwards
                | $                             last


---- transformed grammar (removing left recursion)
      aquery = ./ tquery        -- current context
             | tquery           -- also current context
             | / tquery         -- root context
             | // tquery        -- deep context from root

      tquery = ( tquery ) xquery
             | tag xquery
             | -                -- fixes original grammar ("-/*" is incorrect)

      tag    = string *
             | string
             | * string
             | *

      xquery = / tquery
             | // tquery
             | / @ string       -- new: print attribute value
             | + tquery
             | [ tpredicate ] xquery
             | [ positions ] xquery
             | lambda

      tpredicate = vpredicate upredicate
      upredicate = & tpredicate
                 | | tpredicate
                 | lambda
      vpredicate = ( tpredicate )
                 | ~ tpredicate
                 | tattribute

      tattribute = aquery uattribute
                 | @ string vattribute
      uattribute = / @ string vattribute
                 | vattribute
      vattribute = op wattribute
                 | op ' string '
                 | nop wattribute
                 | nop integer
                 | lambda
      wattribute = @ string
                 | aquery / @ string
                 | aquery

      positions  = simplepos commapos
      simplepos  = integer range
                 | $
      range      = - integer
                 | - $
                 | lambda
      commapos   = , simplepos commapos
                 | lambda

      op         =  =
                 |  !=
                 |  <
                 |  <=
                 |  >
                 |  >=

      nop        =  .=.
                 |  .!=.
                 |  .<.
                 |  .<=.
                 |  .>.
                 |  .>=.
-}

bracket :: XParser a -> XParser a
bracket :: XParser a -> XParser a
bracket XParser a
p =
  do String -> XParser ()
symbol String
"("
     a
x <- XParser a
p
     String -> XParser ()
symbol String
")"
     a -> XParser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x


---- Xtract parsers ----

-- aquery chooses to search from the root, or only in local context
aquery ::  ((CFilter i->CFilter i) -> (DFilter i->DFilter i))
           -> XParser (DFilter i)
aquery :: ((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
aquery (CFilter i -> CFilter i) -> DFilter i -> DFilter i
lift = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"//"
         [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [(CFilter i -> CFilter i) -> DFilter i -> DFilter i
lift CFilter i -> CFilter i
forall i. CFilter i -> CFilter i
C.multi]
    , do String -> XParser ()
symbol String
"/"
         [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [(CFilter i -> CFilter i) -> DFilter i -> DFilter i
lift CFilter i -> CFilter i
forall a. a -> a
id]
    , do String -> XParser ()
symbol String
"./"
         [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [(CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall a. a -> [a]
C.keep DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
D./>)]
    , do [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [(CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall a. a -> [a]
C.keep DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
D./>)]
    ]

tquery :: [DFilter i->DFilter i] -> XParser (DFilter i)
tquery :: [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [] = [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [DFilter i -> DFilter i
forall a. a -> a
id]
tquery (DFilter i -> DFilter i
qf:[DFilter i -> DFilter i]
cxt) = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do DFilter i
q <- XParser (DFilter i) -> XParser (DFilter i)
forall a. XParser a -> XParser a
bracket ([DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery (DFilter i -> DFilter i
qf(DFilter i -> DFilter i)
-> [DFilter i -> DFilter i] -> [DFilter i -> DFilter i]
forall a. a -> [a] -> [a]
:DFilter i -> DFilter i
qf(DFilter i -> DFilter i)
-> [DFilter i -> DFilter i] -> [DFilter i -> DFilter i]
forall a. a -> [a] -> [a]
:[DFilter i -> DFilter i]
cxt))
         [DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
forall i.
[DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
xquery [DFilter i -> DFilter i]
cxt DFilter i
q
    , do DFilter i
q <- XParser (DFilter i)
forall i. XParser (DFilter i)
xtag
         [DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
forall i.
[DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
xquery [DFilter i -> DFilter i]
cxt (DFilter i -> DFilter i
qf (([Content i] -> [Content i]
forall i. [Content i] -> [Content i]
unescape ([Content i] -> [Content i])
-> (Content i -> [Content i]) -> Content i -> [Content i]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)((Content i -> [Content i]) -> Content i -> [Content i])
-> DFilter i -> DFilter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
.DFilter i
q))       -- glue inners texts together
    , do String -> XParser ()
symbol String
"-"
         DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i -> DFilter i
qf ((Content i -> [Content i]) -> DFilter i
forall i. CFilter i -> DFilter i
local Content i -> [Content i]
forall i. CFilter i
C.txt))
    ]

xtag :: XParser (DFilter i)
xtag :: XParser (DFilter i)
xtag = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String
s <- XParser String
string
         String -> XParser ()
symbol String
"*"
         DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local ((String -> Bool) -> CFilter i
forall i. (String -> Bool) -> CFilter i
C.tagWith (String
s String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)))
    , CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local (CFilter i -> DFilter i)
-> (String -> CFilter i) -> String -> DFilter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CFilter i
forall i. String -> CFilter i
C.tag (String -> DFilter i) -> XParser String -> XParser (DFilter i)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> XParser String
string
    , do String -> XParser ()
symbol String
"*"
         String
s <- XParser String
string
         DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local ((String -> Bool) -> CFilter i
forall i. (String -> Bool) -> CFilter i
C.tagWith ((String -> String
forall a. [a] -> [a]
reverse String
s String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse)))
    , do String -> XParser ()
symbol String
"*"
         DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall i. CFilter i
C.elm)
    ]


xquery :: [DFilter i->DFilter i] -> DFilter i -> XParser (DFilter i)
xquery :: [DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
xquery [DFilter i -> DFilter i]
cxt DFilter i
q1 = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"/"
         do String -> XParser ()
symbol String
"@"
            String
attr <- XParser String
string
            DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> (String -> DFilter i) -> DFilter i -> DFilter i
forall i. String -> (String -> DFilter i) -> DFilter i -> DFilter i
D.iffind String
attr (CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local (CFilter i -> DFilter i)
-> (String -> CFilter i) -> String -> DFilter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CFilter i
forall i. String -> CFilter i
C.literal) DFilter i
forall i. DFilter i
D.none DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q1)
         XParser (DFilter i) -> XParser (DFilter i) -> XParser (DFilter i)
forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
         [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery ((DFilter i
q1 DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
D./>)(DFilter i -> DFilter i)
-> [DFilter i -> DFilter i] -> [DFilter i -> DFilter i]
forall a. a -> [a] -> [a]
:[DFilter i -> DFilter i]
cxt)
    , do String -> XParser ()
symbol String
"//"
         [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery ((\DFilter i
q2-> (CFilter i -> CFilter i) -> DFilter i -> DFilter i
forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftLocal CFilter i -> CFilter i
forall i. CFilter i -> CFilter i
C.multi DFilter i
q2
                            DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall i. CFilter i
C.children DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q1)(DFilter i -> DFilter i)
-> [DFilter i -> DFilter i] -> [DFilter i -> DFilter i]
forall a. a -> [a] -> [a]
:[DFilter i -> DFilter i]
cxt)
    , do String -> XParser ()
symbol String
"+"
         DFilter i
q2 <- [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery [DFilter i -> DFilter i]
cxt
         DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return ([DFilter i] -> DFilter i
forall a b c. [a -> b -> [c]] -> a -> b -> [c]
D.cat [DFilter i
q1,DFilter i
q2])
    , do String -> XParser ()
symbol String
"["
         [[Content i] -> [Content i]]
is <- XParser [[Content i] -> [Content i]]
forall a. XParser [[a] -> [a]]
iindex   -- now extended to multiple indexes
         String -> XParser ()
symbol String
"]"
         [DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
forall i.
[DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
xquery [DFilter i -> DFilter i]
cxt (\Content i
xml-> [[Content i]] -> [Content i]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Content i]] -> [Content i])
-> (Content i -> [[Content i]]) -> CFilter i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Content i] -> [Content i]] -> [Content i] -> [[Content i]]
forall a b. [a -> b] -> a -> [b]
pam [[Content i] -> [Content i]]
is ([Content i] -> [[Content i]])
-> CFilter i -> Content i -> [[Content i]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DFilter i
q1 Content i
xml)
    , do String -> XParser ()
symbol String
"["
         DFilter i
p <- XParser (DFilter i)
forall i. XParser (DFilter i)
tpredicate
         String -> XParser ()
symbol String
"]"
         [DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
forall i.
[DFilter i -> DFilter i] -> DFilter i -> XParser (DFilter i)
xquery [DFilter i -> DFilter i]
cxt (DFilter i
q1 DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.with` DFilter i
p)
    , DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return DFilter i
q1
    ]

tpredicate :: XParser (DFilter i)
tpredicate :: XParser (DFilter i)
tpredicate =
  do DFilter i
p <- XParser (DFilter i)
forall i. XParser (DFilter i)
vpredicate
     DFilter i -> DFilter i
f <- XParser (DFilter i -> DFilter i)
forall i. XParser (DFilter i -> DFilter i)
upredicate
     DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i -> DFilter i
f DFilter i
p)

upredicate :: XParser (DFilter i->DFilter i)
upredicate :: XParser (DFilter i -> DFilter i)
upredicate = [XParser (DFilter i -> DFilter i)]
-> XParser (DFilter i -> DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"&"
         DFilter i
p2 <- XParser (DFilter i)
forall i. XParser (DFilter i)
tpredicate
         (DFilter i -> DFilter i) -> XParser (DFilter i -> DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
p2)
    , do String -> XParser ()
symbol String
"|"
         DFilter i
p2 <- XParser (DFilter i)
forall i. XParser (DFilter i)
tpredicate
         (DFilter i -> DFilter i) -> XParser (DFilter i -> DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i -> DFilter i -> DFilter i
forall a b c. (a -> b -> [c]) -> (a -> b -> [c]) -> a -> b -> [c]
D.|>| DFilter i
p2)
    , (DFilter i -> DFilter i) -> XParser (DFilter i -> DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return DFilter i -> DFilter i
forall a. a -> a
id
    ]

vpredicate :: XParser (DFilter i)
vpredicate :: XParser (DFilter i)
vpredicate = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do XParser (DFilter i) -> XParser (DFilter i)
forall a. XParser a -> XParser a
bracket XParser (DFilter i)
forall i. XParser (DFilter i)
tpredicate
    , do String -> XParser ()
symbol String
"~"
         DFilter i
p <- XParser (DFilter i)
forall i. XParser (DFilter i)
tpredicate
         DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall a. a -> [a]
C.keep DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.without` DFilter i
p)
    , do XParser (DFilter i)
forall i. XParser (DFilter i)
tattribute
    ]

tattribute :: XParser (DFilter i)
tattribute :: XParser (DFilter i)
tattribute = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do DFilter i
q <- ((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
forall i.
((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
aquery (CFilter i -> CFilter i) -> DFilter i -> DFilter i
forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftGlobal
         DFilter i -> XParser (DFilter i)
forall i. DFilter i -> XParser (DFilter i)
uattribute DFilter i
q
    , do String -> XParser ()
symbol String
"@"
         String
s <- XParser String
string
         (DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
forall i.
(DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
vattribute (CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall a. a -> [a]
C.keep, CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local (String -> CFilter i
forall i. String -> CFilter i
C.attr String
s), String -> (String -> DFilter i) -> DFilter i -> DFilter i
forall i. String -> (String -> DFilter i) -> DFilter i -> DFilter i
D.iffind String
s)
    ]

uattribute :: DFilter i -> XParser (DFilter i)
uattribute :: DFilter i -> XParser (DFilter i)
uattribute DFilter i
q = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"/"
         String -> XParser ()
symbol String
"@"
         String
s <- XParser String
string
         (DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
forall i.
(DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
vattribute (DFilter i
q, CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local (String -> CFilter i
forall i. String -> CFilter i
C.attr String
s), String -> (String -> DFilter i) -> DFilter i -> DFilter i
forall i. String -> (String -> DFilter i) -> DFilter i -> DFilter i
D.iffind String
s)
    , do (DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
forall i.
(DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
vattribute (DFilter i
q, CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local CFilter i
forall a. a -> [a]
C.keep,     (String -> DFilter i) -> DFilter i -> DFilter i
forall i. (String -> DFilter i) -> DFilter i -> DFilter i
D.ifTxt)
    ]

vattribute :: (DFilter i, DFilter i, (String->DFilter i)->DFilter i->DFilter i)
              -> XParser (DFilter i)
vattribute :: (DFilter i, DFilter i,
 (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
vattribute (DFilter i
q,DFilter i
a,(String -> DFilter i) -> DFilter i -> DFilter i
iffn) = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
  [ do String -> String -> Bool
cmp <- XParser (String -> String -> Bool)
op
       XParser ()
quote
       String
s2 <- XParser String
string
       XParser ()
quote
       DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> DFilter i) -> DFilter i -> DFilter i
iffn (\String
s1->if String -> String -> Bool
cmp String
s1 String
s2 then DFilter i
forall i. DFilter i
D.keep else DFilter i
forall i. DFilter i
D.none) DFilter i
forall i. DFilter i
D.none
               DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q)
  , do String -> String -> Bool
cmp <- XParser (String -> String -> Bool)
op
       (DFilter i
q2,(String -> DFilter i) -> DFilter i -> DFilter i
iffn2) <- XParser
  (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
forall i.
XParser
  (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
wattribute -- q2 unused?  is this a mistake?
       DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> DFilter i) -> DFilter i -> DFilter i
iffn (\String
s1-> (String -> DFilter i) -> DFilter i -> DFilter i
iffn2 (\String
s2-> if String -> String -> Bool
cmp String
s1 String
s2 then DFilter i
forall i. DFilter i
D.keep else DFilter i
forall i. DFilter i
D.none)
                                  DFilter i
forall i. DFilter i
D.none)
                     DFilter i
forall i. DFilter i
D.none DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q)
  , do Integer -> Integer -> Bool
cmp <- XParser (Integer -> Integer -> Bool)
nop
       Integer
n <- XParser Integer
number
       DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> DFilter i) -> DFilter i -> DFilter i
iffn (\String
s->if Integer -> Integer -> Bool
cmp (String -> Integer
forall a. Read a => String -> a
read String
s) Integer
n then DFilter i
forall i. DFilter i
D.keep else DFilter i
forall i. DFilter i
D.none) DFilter i
forall i. DFilter i
D.none
               DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q)
  , do Integer -> Integer -> Bool
cmp <- XParser (Integer -> Integer -> Bool)
nop
       (DFilter i
q2,(String -> DFilter i) -> DFilter i -> DFilter i
iffn2) <- XParser
  (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
forall i.
XParser
  (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
wattribute -- q2 unused?  is this a mistake?
       DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String -> DFilter i) -> DFilter i -> DFilter i
iffn (\String
s1-> (String -> DFilter i) -> DFilter i -> DFilter i
iffn2 (\String
s2-> if Integer -> Integer -> Bool
cmp (String -> Integer
forall a. Read a => String -> a
read String
s1) (String -> Integer
forall a. Read a => String -> a
read String
s2) then DFilter i
forall i. DFilter i
D.keep
                                                                    else DFilter i
forall i. DFilter i
D.none)
                                  DFilter i
forall i. DFilter i
D.none)
                     DFilter i
forall i. DFilter i
D.none DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q)
  , do DFilter i -> XParser (DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i
a DFilter i -> DFilter i -> DFilter i
forall i. DFilter i -> DFilter i -> DFilter i
`D.o` DFilter i
q)
  ]

wattribute :: XParser (DFilter i, (String->DFilter i)->DFilter i->DFilter i)
wattribute :: XParser
  (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
wattribute = [XParser
   (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)]
-> XParser
     (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"@"
         String
s <- XParser String
string
         (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser
     (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i
forall i. DFilter i
D.keep, String -> (String -> DFilter i) -> DFilter i -> DFilter i
forall i. String -> (String -> DFilter i) -> DFilter i -> DFilter i
D.iffind String
s)
    , do DFilter i
q <- ((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
forall i.
((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
aquery (CFilter i -> CFilter i) -> DFilter i -> DFilter i
forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftGlobal
         String -> XParser ()
symbol String
"/"
         String -> XParser ()
symbol String
"@"
         String
s <- XParser String
string
         (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser
     (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i
q, String -> (String -> DFilter i) -> DFilter i -> DFilter i
forall i. String -> (String -> DFilter i) -> DFilter i -> DFilter i
D.iffind String
s)
    , do DFilter i
q <- ((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
forall i.
((CFilter i -> CFilter i) -> DFilter i -> DFilter i)
-> XParser (DFilter i)
aquery (CFilter i -> CFilter i) -> DFilter i -> DFilter i
forall i. (CFilter i -> CFilter i) -> DFilter i -> DFilter i
liftGlobal
         (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
-> XParser
     (DFilter i, (String -> DFilter i) -> DFilter i -> DFilter i)
forall (m :: * -> *) a. Monad m => a -> m a
return (DFilter i
q, (String -> DFilter i) -> DFilter i -> DFilter i
forall i. (String -> DFilter i) -> DFilter i -> DFilter i
D.ifTxt)
    ]


iindex :: XParser [[a]->[a]]
iindex :: XParser [[a] -> [a]]
iindex =
    do [a] -> [a]
i <- XParser ([a] -> [a])
forall a. XParser ([a] -> [a])
simpleindex
       [[a] -> [a]]
is <- XParser [[a] -> [a]]
forall a. XParser [[a] -> [a]]
idxcomma
       [[a] -> [a]] -> XParser [[a] -> [a]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
i([a] -> [a]) -> [[a] -> [a]] -> [[a] -> [a]]
forall a. a -> [a] -> [a]
:[[a] -> [a]]
is)

simpleindex :: XParser ([a]->[a])
simpleindex :: XParser ([a] -> [a])
simpleindex = [XParser ([a] -> [a])] -> XParser ([a] -> [a])
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do Integer
n <- XParser Integer
number
         Integer -> XParser ([a] -> [a])
forall a. Integer -> XParser ([a] -> [a])
rrange Integer
n
    , do String -> XParser ()
symbol String
"$"
         ([a] -> [a]) -> XParser ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> [a]
forall a. a -> [a]
C.keep (a -> [a]) -> ([a] -> a) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> a
forall a. [a] -> a
last)
    ]

rrange, numberdollar :: Integer -> XParser ([a]->[a])
rrange :: Integer -> XParser ([a] -> [a])
rrange Integer
n1 = [XParser ([a] -> [a])] -> XParser ([a] -> [a])
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"-"
         Integer -> XParser ([a] -> [a])
forall a. Integer -> XParser ([a] -> [a])
numberdollar Integer
n1
    , ([a] -> [a]) -> XParser ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
1 ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n1))
    ]

numberdollar :: Integer -> XParser ([a] -> [a])
numberdollar Integer
n1 = [XParser ([a] -> [a])] -> XParser ([a] -> [a])
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do Integer
n2 <- XParser Integer
number
         ([a] -> [a]) -> XParser ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer
1Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
n2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n1)) ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n1))
    , do String -> XParser ()
symbol String
"$"
         ([a] -> [a]) -> XParser ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n1))
    ]

idxcomma :: XParser [[a]->[a]]
idxcomma :: XParser [[a] -> [a]]
idxcomma = [XParser [[a] -> [a]]] -> XParser [[a] -> [a]]
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
","
         [a] -> [a]
r <- XParser ([a] -> [a])
forall a. XParser ([a] -> [a])
simpleindex
         [[a] -> [a]]
rs <- XParser [[a] -> [a]]
forall a. XParser [[a] -> [a]]
idxcomma
         [[a] -> [a]] -> XParser [[a] -> [a]]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> [a]
r([a] -> [a]) -> [[a] -> [a]] -> [[a] -> [a]]
forall a. a -> [a] -> [a]
:[[a] -> [a]]
rs)
    , [[a] -> [a]] -> XParser [[a] -> [a]]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    ]


op :: XParser (String->String->Bool)
op :: XParser (String -> String -> Bool)
op = [XParser (String -> String -> Bool)]
-> XParser (String -> String -> Bool)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
"=";  (String -> String -> Bool) -> XParser (String -> String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    , do String -> XParser ()
symbol String
"!="; (String -> String -> Bool) -> XParser (String -> String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
    , do String -> XParser ()
symbol String
"<";  (String -> String -> Bool) -> XParser (String -> String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    , do String -> XParser ()
symbol String
"<="; (String -> String -> Bool) -> XParser (String -> String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
    , do String -> XParser ()
symbol String
">";  (String -> String -> Bool) -> XParser (String -> String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    , do String -> XParser ()
symbol String
">="; (String -> String -> Bool) -> XParser (String -> String -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return String -> String -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
    ]

nop :: XParser (Integer->Integer->Bool)
nop :: XParser (Integer -> Integer -> Bool)
nop = [XParser (Integer -> Integer -> Bool)]
-> XParser (Integer -> Integer -> Bool)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol String
".=.";  (Integer -> Integer -> Bool)
-> XParser (Integer -> Integer -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==)
    , do String -> XParser ()
symbol String
".!=."; (Integer -> Integer -> Bool)
-> XParser (Integer -> Integer -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(/=)
    , do String -> XParser ()
symbol String
".<.";  (Integer -> Integer -> Bool)
-> XParser (Integer -> Integer -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<)
    , do String -> XParser ()
symbol String
".<=."; (Integer -> Integer -> Bool)
-> XParser (Integer -> Integer -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(<=)
    , do String -> XParser ()
symbol String
".>.";  (Integer -> Integer -> Bool)
-> XParser (Integer -> Integer -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>)
    , do String -> XParser ()
symbol String
".>=."; (Integer -> Integer -> Bool)
-> XParser (Integer -> Integer -> Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
(>=)
    ]