-- | 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 f :: String -> String
f query :: 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 (_,Symbol s :: String
s): Right (_,Symbol "//"): _)
                                          | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
predicateIntro = Bool
True
    interiorRef (Right (_,Symbol s :: String
s): Right (_,Symbol "/"): _)
                                          | String
s String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
predicateIntro = Bool
True
    interiorRef (_ : rest :: [Either a (a, TokenT)]
rest) = [Either a (a, TokenT)] -> Bool
interiorRef [Either a (a, TokenT)]
rest
    interiorRef [] = Bool
False
    predicateIntro :: [String]
predicateIntro = [ "[", "("
                     ,  "&",   "|",  "~"
                     ,  "=",  "!=",  "<",  "<=",  ">",  ">="
                     , ".=.",".!=.",".<.",".<=.",".>.",".>=." ]

-- | 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 (\inp :: [Either String (Posn, TokenT)]
inp -> case [Either String (Posn, TokenT)]
inp of
                (Left err :: String
err: _) -> [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 (_,TokString n :: String
n):ts :: [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
                ts :: [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 "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 (\inp :: [Either String (Posn, TokenT)]
inp -> case [Either String (Posn, TokenT)]
inp of
                (Left err :: String
err: _) -> [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 (_,TokNum n :: Integer
n):ts :: [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
                ts :: [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 "expected a number" )
symbol :: String -> XParser ()
symbol :: String -> XParser ()
symbol s :: String
s = ([Either String (Posn, TokenT)]
 -> Result [Either String (Posn, TokenT)] ())
-> XParser ()
forall t a. ([t] -> Result [t] a) -> Parser t a
P (\inp :: [Either String (Posn, TokenT)]
inp -> case [Either String (Posn, TokenT)]
inp of
                (Left err :: String
err: _) -> [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 (_, Symbol n :: String
n):ts :: [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 ()
                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 ("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 -> XParser ()
symbol "\"" ]

pam :: [a->b] -> a -> [b]
pam :: [a -> b] -> a -> [b]
pam fs :: [a -> b]
fs x :: 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 p :: XParser a
p =
  do String -> XParser ()
symbol "("
     a
x <- XParser a
p
     String -> XParser ()
symbol ")"
     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 lift :: (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 "//"
         [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 "/"
         [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 "./"
         [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 (qf :: DFilter i -> DFilter i
qf:cxt :: [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 "-"
         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 "*"
         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`)))
    , do 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 -> CFilter i
forall i. String -> CFilter i
C.tag String
s))
    , do String -> XParser ()
symbol "*"
         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 "*"
         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 cxt :: [DFilter i -> DFilter i]
cxt q1 :: DFilter i
q1 = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol "/"
         ( do String -> XParser ()
symbol "@"
              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 (\s :: String
s->CFilter i -> DFilter i
forall i. CFilter i -> DFilter i
local (String -> CFilter i
forall i. String -> CFilter i
C.literal String
s)) 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 "//"
         [DFilter i -> DFilter i] -> XParser (DFilter i)
forall i. [DFilter i -> DFilter i] -> XParser (DFilter i)
tquery ((\q2 :: 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 "+"
         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 "["
         [[Content i] -> [Content i]]
is <- XParser [[Content i] -> [Content i]]
forall a. XParser [[a] -> [a]]
iindex	-- now extended to multiple indexes
         String -> XParser ()
symbol "]"
         [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 (\xml :: 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 "["
         DFilter i
p <- XParser (DFilter i)
forall i. XParser (DFilter i)
tpredicate
         String -> XParser ()
symbol "]"
         [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 "&"
         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 "|"
         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 "~"
         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
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 q :: DFilter i
q = [XParser (DFilter i)] -> XParser (DFilter i)
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol "/"
         String -> XParser ()
symbol "@"
         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 (q :: DFilter i
q,a :: DFilter i
a,iffn :: (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 (\s1 :: 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
       (q2 :: DFilter i
q2,iffn2 :: (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 (\s1 :: String
s1-> (String -> DFilter i) -> DFilter i -> DFilter i
iffn2 (\s2 :: 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 (\s :: 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
       (q2 :: DFilter i
q2,iffn2 :: (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 (\s1 :: String
s1-> (String -> DFilter i) -> DFilter i -> DFilter i
iffn2 (\s2 :: 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
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 -> XParser ()
symbol "@"
         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
         [a] -> [a]
r <- Integer -> XParser ([a] -> [a])
forall a. Integer -> XParser ([a] -> [a])
rrange Integer
n
         ([a] -> [a]) -> XParser ([a] -> [a])
forall (m :: * -> *) a. Monad m => a -> m a
return [a] -> [a]
r
    , do String -> XParser ()
symbol "$"
         ([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 n1 :: Integer
n1 = [XParser ([a] -> [a])] -> XParser ([a] -> [a])
forall (p :: * -> *) a. PolyParse p => [p a] -> p a
oneOf
    [ do String -> XParser ()
symbol "-"
         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 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 n1 :: 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 (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 "$"
         ([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 ","
         [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 -> 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 -> 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 -> 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 -> 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 -> 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 -> 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 ".=.";  (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 ".!=."; (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 ".<.";  (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 ".<=."; (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 ".>.";  (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 ".>=."; (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
(>=)
    ]