{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE Safe #-}
module Text.Parsec.Expr
    ( Assoc(..), Operator(..), OperatorTable
    , buildExpressionParser
    ) where
import Data.Typeable ( Typeable )
import Text.Parsec.Prim
import Text.Parsec.Combinator
data Assoc                = AssocNone
                          | AssocLeft
                          | AssocRight
   deriving ( Typeable )
data Operator s u m a   = Infix (ParsecT s u m (a -> a -> a)) Assoc
                        | Prefix (ParsecT s u m (a -> a))
                        | Postfix (ParsecT s u m (a -> a))
#if MIN_VERSION_base(4,7,0)
    deriving ( Typeable )
#endif
type OperatorTable s u m a = [[Operator s u m a]]
buildExpressionParser :: (Stream s m t)
                      => OperatorTable s u m a
                      -> ParsecT s u m a
                      -> ParsecT s u m a
{-# INLINABLE buildExpressionParser #-}
buildExpressionParser :: forall s (m :: * -> *) t u a.
Stream s m t =>
OperatorTable s u m a -> ParsecT s u m a -> ParsecT s u m a
buildExpressionParser OperatorTable s u m a
operators ParsecT s u m a
simpleExpr
    = (ParsecT s u m a -> [Operator s u m a] -> ParsecT s u m a)
-> ParsecT s u m a -> OperatorTable s u m a -> ParsecT s u m a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (ParsecT s u m a -> [Operator s u m a] -> ParsecT s u m a
forall {t :: * -> *} {s} {m :: * -> *} {t} {u} {b}.
(Foldable t, Stream s m t) =>
ParsecT s u m b -> t (Operator s u m b) -> ParsecT s u m b
makeParser) ParsecT s u m a
simpleExpr OperatorTable s u m a
operators
    where
      makeParser :: ParsecT s u m b -> t (Operator s u m b) -> ParsecT s u m b
makeParser ParsecT s u m b
term t (Operator s u m b)
ops
        = let ([ParsecT s u m (b -> b -> b)]
rassoc,[ParsecT s u m (b -> b -> b)]
lassoc,[ParsecT s u m (b -> b -> b)]
nassoc
               ,[ParsecT s u m (b -> b)]
prefix,[ParsecT s u m (b -> b)]
postfix)      = (Operator s u m b
 -> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
     [ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
     [ParsecT s u m (b -> b)])
 -> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
     [ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
     [ParsecT s u m (b -> b)]))
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
    [ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
    [ParsecT s u m (b -> b)])
-> t (Operator s u m b)
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
    [ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
    [ParsecT s u m (b -> b)])
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Operator s u m b
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
    [ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
    [ParsecT s u m (b -> b)])
-> ([ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b -> b)],
    [ParsecT s u m (b -> b -> b)], [ParsecT s u m (b -> b)],
    [ParsecT s u m (b -> b)])
forall {s} {u} {m :: * -> *} {a}.
Operator s u m a
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
    [ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
    [ParsecT s u m (a -> a)])
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
    [ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
    [ParsecT s u m (a -> a)])
splitOp ([],[],[],[],[]) t (Operator s u m b)
ops
              rassocOp :: ParsecT s u m (b -> b -> b)
rassocOp   = [ParsecT s u m (b -> b -> b)] -> ParsecT s u m (b -> b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b -> b)]
rassoc
              lassocOp :: ParsecT s u m (b -> b -> b)
lassocOp   = [ParsecT s u m (b -> b -> b)] -> ParsecT s u m (b -> b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b -> b)]
lassoc
              nassocOp :: ParsecT s u m (b -> b -> b)
nassocOp   = [ParsecT s u m (b -> b -> b)] -> ParsecT s u m (b -> b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b -> b)]
nassoc
              prefixOp :: ParsecT s u m (b -> b)
prefixOp   = [ParsecT s u m (b -> b)] -> ParsecT s u m (b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b)]
prefix  ParsecT s u m (b -> b) -> String -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
""
              postfixOp :: ParsecT s u m (b -> b)
postfixOp  = [ParsecT s u m (b -> b)] -> ParsecT s u m (b -> b)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m (b -> b)]
postfix ParsecT s u m (b -> b) -> String -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
""
              ambiguous :: String -> ParsecT s u m a -> ParsecT s u m a
ambiguous String
assoc ParsecT s u m a
op= ParsecT s u m a -> ParsecT s u m a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$
                                  do{ a
_ <- ParsecT s u m a
op; String -> ParsecT s u m a
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"ambiguous use of a " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
assoc
                                                     String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" associative operator")
                                    }
              ambiguousRight :: ParsecT s u m a
ambiguousRight    = String -> ParsecT s u m (b -> b -> b) -> ParsecT s u m a
forall {s} {u} {m :: * -> *} {a} {a}.
String -> ParsecT s u m a -> ParsecT s u m a
ambiguous String
"right" ParsecT s u m (b -> b -> b)
rassocOp
              ambiguousLeft :: ParsecT s u m a
ambiguousLeft     = String -> ParsecT s u m (b -> b -> b) -> ParsecT s u m a
forall {s} {u} {m :: * -> *} {a} {a}.
String -> ParsecT s u m a -> ParsecT s u m a
ambiguous String
"left" ParsecT s u m (b -> b -> b)
lassocOp
              ambiguousNon :: ParsecT s u m a
ambiguousNon      = String -> ParsecT s u m (b -> b -> b) -> ParsecT s u m a
forall {s} {u} {m :: * -> *} {a} {a}.
String -> ParsecT s u m a -> ParsecT s u m a
ambiguous String
"non" ParsecT s u m (b -> b -> b)
nassocOp
              termP :: ParsecT s u m b
termP      = do{ b -> b
pre  <- ParsecT s u m (b -> b)
prefixP
                             ; b
x    <- ParsecT s u m b
term
                             ; b -> b
post <- ParsecT s u m (b -> b)
postfixP
                             ; b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b
post (b -> b
pre b
x))
                             }
              postfixP :: ParsecT s u m (b -> b)
postfixP   = ParsecT s u m (b -> b)
postfixOp ParsecT s u m (b -> b)
-> ParsecT s u m (b -> b) -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (b -> b) -> ParsecT s u m (b -> b)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return b -> b
forall a. a -> a
id
              prefixP :: ParsecT s u m (b -> b)
prefixP    = ParsecT s u m (b -> b)
prefixOp ParsecT s u m (b -> b)
-> ParsecT s u m (b -> b) -> ParsecT s u m (b -> b)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (b -> b) -> ParsecT s u m (b -> b)
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return b -> b
forall a. a -> a
id
              rassocP :: b -> ParsecT s u m b
rassocP b
x  = do{ b -> b -> b
f <- ParsecT s u m (b -> b -> b)
rassocOp
                             ; b
y  <- do{ b
z <- ParsecT s u m b
termP; b -> ParsecT s u m b
rassocP1 b
z }
                             ; b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b -> b
f b
x b
y)
                             }
                           ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousLeft
                           ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousNon
                           
              rassocP1 :: b -> ParsecT s u m b
rassocP1 b
x = b -> ParsecT s u m b
rassocP b
x  ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
              lassocP :: b -> ParsecT s u m b
lassocP b
x  = do{ b -> b -> b
f <- ParsecT s u m (b -> b -> b)
lassocOp
                             ; b
y <- ParsecT s u m b
termP
                             ; b -> ParsecT s u m b
lassocP1 (b -> b -> b
f b
x b
y)
                             }
                           ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousRight
                           ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousNon
                           
              lassocP1 :: b -> ParsecT s u m b
lassocP1 b
x = b -> ParsecT s u m b
lassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
              nassocP :: b -> ParsecT s u m b
nassocP b
x  = do{ b -> b -> b
f <- ParsecT s u m (b -> b -> b)
nassocOp
                             ; b
y <- ParsecT s u m b
termP
                             ;    ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousRight
                              ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousLeft
                              ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m b
forall {a}. ParsecT s u m a
ambiguousNon
                              ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> b -> b
f b
x b
y)
                             }
                           
           in  do{ b
x <- ParsecT s u m b
termP
                 ; b -> ParsecT s u m b
rassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
lassocP  b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
nassocP b
x ParsecT s u m b -> ParsecT s u m b -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> b -> ParsecT s u m b
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
x
                   ParsecT s u m b -> String -> ParsecT s u m b
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"operator"
                 }
      splitOp :: Operator s u m a
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
    [ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
    [ParsecT s u m (a -> a)])
-> ([ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a -> a)],
    [ParsecT s u m (a -> a -> a)], [ParsecT s u m (a -> a)],
    [ParsecT s u m (a -> a)])
splitOp (Infix ParsecT s u m (a -> a -> a)
op Assoc
assoc) ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
        = case Assoc
assoc of
            Assoc
AssocNone  -> ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,ParsecT s u m (a -> a -> a)
opParsecT s u m (a -> a -> a)
-> [ParsecT s u m (a -> a -> a)] -> [ParsecT s u m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
            Assoc
AssocLeft  -> ([ParsecT s u m (a -> a -> a)]
rassoc,ParsecT s u m (a -> a -> a)
opParsecT s u m (a -> a -> a)
-> [ParsecT s u m (a -> a -> a)] -> [ParsecT s u m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
            Assoc
AssocRight -> (ParsecT s u m (a -> a -> a)
opParsecT s u m (a -> a -> a)
-> [ParsecT s u m (a -> a -> a)] -> [ParsecT s u m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
      splitOp (Prefix ParsecT s u m (a -> a)
op) ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
        = ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,ParsecT s u m (a -> a)
opParsecT s u m (a -> a)
-> [ParsecT s u m (a -> a)] -> [ParsecT s u m (a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
      splitOp (Postfix ParsecT s u m (a -> a)
op) ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,[ParsecT s u m (a -> a)]
postfix)
        = ([ParsecT s u m (a -> a -> a)]
rassoc,[ParsecT s u m (a -> a -> a)]
lassoc,[ParsecT s u m (a -> a -> a)]
nassoc,[ParsecT s u m (a -> a)]
prefix,ParsecT s u m (a -> a)
opParsecT s u m (a -> a)
-> [ParsecT s u m (a -> a)] -> [ParsecT s u m (a -> a)]
forall a. a -> [a] -> [a]
:[ParsecT s u m (a -> a)]
postfix)