{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Parser.Expression
-- Copyright   :  (c) Edward Kmett 2011-2012
--                (c) Paolo Martini 2007
--                (c) Daan Leijen 1999-2001,
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  ekmett@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable
--
-- A helper module to parse \"expressions\".
-- Builds a parser given a table of operators and associativities.
--
-----------------------------------------------------------------------------

module Text.Parser.Expression
    ( Assoc(..), Operator(..), OperatorTable
    , buildExpressionParser
    ) where

import Control.Applicative
import Text.Parser.Combinators
import Data.Data hiding (Infix, Prefix)
import Data.Ix

-----------------------------------------------------------
-- Assoc and OperatorTable
-----------------------------------------------------------

-- |  This data type specifies the associativity of operators: left, right
-- or none.

data Assoc
  = AssocNone
  | AssocLeft
  | AssocRight
  deriving (Assoc -> Assoc -> Bool
(Assoc -> Assoc -> Bool) -> (Assoc -> Assoc -> Bool) -> Eq Assoc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Assoc -> Assoc -> Bool
$c/= :: Assoc -> Assoc -> Bool
== :: Assoc -> Assoc -> Bool
$c== :: Assoc -> Assoc -> Bool
Eq,Eq Assoc
Eq Assoc
-> (Assoc -> Assoc -> Ordering)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Bool)
-> (Assoc -> Assoc -> Assoc)
-> (Assoc -> Assoc -> Assoc)
-> Ord Assoc
Assoc -> Assoc -> Bool
Assoc -> Assoc -> Ordering
Assoc -> Assoc -> Assoc
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Assoc -> Assoc -> Assoc
$cmin :: Assoc -> Assoc -> Assoc
max :: Assoc -> Assoc -> Assoc
$cmax :: Assoc -> Assoc -> Assoc
>= :: Assoc -> Assoc -> Bool
$c>= :: Assoc -> Assoc -> Bool
> :: Assoc -> Assoc -> Bool
$c> :: Assoc -> Assoc -> Bool
<= :: Assoc -> Assoc -> Bool
$c<= :: Assoc -> Assoc -> Bool
< :: Assoc -> Assoc -> Bool
$c< :: Assoc -> Assoc -> Bool
compare :: Assoc -> Assoc -> Ordering
$ccompare :: Assoc -> Assoc -> Ordering
$cp1Ord :: Eq Assoc
Ord,Int -> Assoc -> ShowS
[Assoc] -> ShowS
Assoc -> String
(Int -> Assoc -> ShowS)
-> (Assoc -> String) -> ([Assoc] -> ShowS) -> Show Assoc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Assoc] -> ShowS
$cshowList :: [Assoc] -> ShowS
show :: Assoc -> String
$cshow :: Assoc -> String
showsPrec :: Int -> Assoc -> ShowS
$cshowsPrec :: Int -> Assoc -> ShowS
Show,ReadPrec [Assoc]
ReadPrec Assoc
Int -> ReadS Assoc
ReadS [Assoc]
(Int -> ReadS Assoc)
-> ReadS [Assoc]
-> ReadPrec Assoc
-> ReadPrec [Assoc]
-> Read Assoc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Assoc]
$creadListPrec :: ReadPrec [Assoc]
readPrec :: ReadPrec Assoc
$creadPrec :: ReadPrec Assoc
readList :: ReadS [Assoc]
$creadList :: ReadS [Assoc]
readsPrec :: Int -> ReadS Assoc
$creadsPrec :: Int -> ReadS Assoc
Read,Ord Assoc
Ord Assoc
-> ((Assoc, Assoc) -> [Assoc])
-> ((Assoc, Assoc) -> Assoc -> Int)
-> ((Assoc, Assoc) -> Assoc -> Int)
-> ((Assoc, Assoc) -> Assoc -> Bool)
-> ((Assoc, Assoc) -> Int)
-> ((Assoc, Assoc) -> Int)
-> Ix Assoc
(Assoc, Assoc) -> Int
(Assoc, Assoc) -> [Assoc]
(Assoc, Assoc) -> Assoc -> Bool
(Assoc, Assoc) -> Assoc -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Assoc, Assoc) -> Int
$cunsafeRangeSize :: (Assoc, Assoc) -> Int
rangeSize :: (Assoc, Assoc) -> Int
$crangeSize :: (Assoc, Assoc) -> Int
inRange :: (Assoc, Assoc) -> Assoc -> Bool
$cinRange :: (Assoc, Assoc) -> Assoc -> Bool
unsafeIndex :: (Assoc, Assoc) -> Assoc -> Int
$cunsafeIndex :: (Assoc, Assoc) -> Assoc -> Int
index :: (Assoc, Assoc) -> Assoc -> Int
$cindex :: (Assoc, Assoc) -> Assoc -> Int
range :: (Assoc, Assoc) -> [Assoc]
$crange :: (Assoc, Assoc) -> [Assoc]
$cp1Ix :: Ord Assoc
Ix,Int -> Assoc
Assoc -> Int
Assoc -> [Assoc]
Assoc -> Assoc
Assoc -> Assoc -> [Assoc]
Assoc -> Assoc -> Assoc -> [Assoc]
(Assoc -> Assoc)
-> (Assoc -> Assoc)
-> (Int -> Assoc)
-> (Assoc -> Int)
-> (Assoc -> [Assoc])
-> (Assoc -> Assoc -> [Assoc])
-> (Assoc -> Assoc -> [Assoc])
-> (Assoc -> Assoc -> Assoc -> [Assoc])
-> Enum Assoc
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Assoc -> Assoc -> Assoc -> [Assoc]
$cenumFromThenTo :: Assoc -> Assoc -> Assoc -> [Assoc]
enumFromTo :: Assoc -> Assoc -> [Assoc]
$cenumFromTo :: Assoc -> Assoc -> [Assoc]
enumFromThen :: Assoc -> Assoc -> [Assoc]
$cenumFromThen :: Assoc -> Assoc -> [Assoc]
enumFrom :: Assoc -> [Assoc]
$cenumFrom :: Assoc -> [Assoc]
fromEnum :: Assoc -> Int
$cfromEnum :: Assoc -> Int
toEnum :: Int -> Assoc
$ctoEnum :: Int -> Assoc
pred :: Assoc -> Assoc
$cpred :: Assoc -> Assoc
succ :: Assoc -> Assoc
$csucc :: Assoc -> Assoc
Enum,Assoc
Assoc -> Assoc -> Bounded Assoc
forall a. a -> a -> Bounded a
maxBound :: Assoc
$cmaxBound :: Assoc
minBound :: Assoc
$cminBound :: Assoc
Bounded,Typeable Assoc
DataType
Constr
Typeable Assoc
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Assoc -> c Assoc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Assoc)
-> (Assoc -> Constr)
-> (Assoc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Assoc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc))
-> ((forall b. Data b => b -> b) -> Assoc -> Assoc)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r)
-> (forall u. (forall d. Data d => d -> u) -> Assoc -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Assoc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Assoc -> m Assoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assoc -> m Assoc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Assoc -> m Assoc)
-> Data Assoc
Assoc -> DataType
Assoc -> Constr
(forall b. Data b => b -> b) -> Assoc -> Assoc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Assoc -> u
forall u. (forall d. Data d => d -> u) -> Assoc -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Assoc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc)
$cAssocRight :: Constr
$cAssocLeft :: Constr
$cAssocNone :: Constr
$tAssoc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Assoc -> m Assoc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
gmapMp :: (forall d. Data d => d -> m d) -> Assoc -> m Assoc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
gmapM :: (forall d. Data d => d -> m d) -> Assoc -> m Assoc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Assoc -> m Assoc
gmapQi :: Int -> (forall d. Data d => d -> u) -> Assoc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Assoc -> u
gmapQ :: (forall d. Data d => d -> u) -> Assoc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Assoc -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Assoc -> r
gmapT :: (forall b. Data b => b -> b) -> Assoc -> Assoc
$cgmapT :: (forall b. Data b => b -> b) -> Assoc -> Assoc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Assoc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Assoc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Assoc)
dataTypeOf :: Assoc -> DataType
$cdataTypeOf :: Assoc -> DataType
toConstr :: Assoc -> Constr
$ctoConstr :: Assoc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Assoc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Assoc -> c Assoc
$cp1Data :: Typeable Assoc
Data,Typeable)

-- | This data type specifies operators that work on values of type @a@.
-- An operator is either binary infix or unary prefix or postfix. A
-- binary operator has also an associated associativity.

data Operator m a
  = Infix (m (a -> a -> a)) Assoc
  | Prefix (m (a -> a))
  | Postfix (m (a -> a))

-- | An @OperatorTable m a@ is a list of @Operator m a@
-- lists. The list is ordered in descending
-- precedence. All operators in one list have the same precedence (but
-- may have a different associativity).

type OperatorTable m a = [[Operator m a]]

-----------------------------------------------------------
-- Convert an OperatorTable and basic term parser into
-- a full fledged expression parser
-----------------------------------------------------------

-- | @buildExpressionParser table term@ builds an expression parser for
-- terms @term@ with operators from @table@, taking the associativity
-- and precedence specified in @table@ into account. Prefix and postfix
-- operators of the same precedence can only occur once (i.e. @--2@ is
-- not allowed if @-@ is prefix negate). Prefix and postfix operators
-- of the same precedence associate to the left (i.e. if @++@ is
-- postfix increment, than @-2++@ equals @-1@, not @-3@).
--
-- The @buildExpressionParser@ takes care of all the complexity
-- involved in building expression parser. Here is an example of an
-- expression parser that handles prefix signs, postfix increment and
-- basic arithmetic.
--
-- >  import Control.Applicative ((<|>))
-- >  import Text.Parser.Combinators ((<?>))
-- >  import Text.Parser.Expression
-- >  import Text.Parser.Token (TokenParsing, natural, parens, reserve)
-- >  import Text.Parser.Token.Style (emptyOps)
-- >
-- >  expr   :: (Monad m, TokenParsing m) => m Integer
-- >  expr    = buildExpressionParser table term
-- >          <?> "expression"
-- >
-- >  term   :: (Monad m, TokenParsing m) => m Integer
-- >  term    =  parens expr
-- >          <|> natural
-- >          <?> "simple expression"
-- >
-- >  table  :: (Monad m, TokenParsing m) => [[Operator m Integer]]
-- >  table   = [ [prefix "-" negate, prefix "+" id ]
-- >            , [postfix "++" (+1)]
-- >            , [binary "*" (*) AssocLeft, binary "/" (div) AssocLeft ]
-- >            , [binary "+" (+) AssocLeft, binary "-" (-)   AssocLeft ]
-- >            ]
-- >
-- >  binary  name fun assoc = Infix (fun <$ reservedOp name) assoc
-- >  prefix  name fun       = Prefix (fun <$ reservedOp name)
-- >  postfix name fun       = Postfix (fun <$ reservedOp name)
-- >
-- >  reservedOp name = reserve emptyOps name

buildExpressionParser :: forall m a. (Parsing m, Applicative m)
                      => OperatorTable m a
                      -> m a
                      -> m a
buildExpressionParser :: OperatorTable m a -> m a -> m a
buildExpressionParser OperatorTable m a
operators m a
simpleExpr
    = (m a -> [Operator m a] -> m a) -> m a -> OperatorTable m a -> m a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl m a -> [Operator m a] -> m a
forall (t :: * -> *). Foldable t => m a -> t (Operator m a) -> m a
makeParser m a
simpleExpr OperatorTable m a
operators
    where
      makeParser :: m a -> t (Operator m a) -> m a
makeParser m a
term t (Operator m a)
ops
        = let rassoc, lassoc, nassoc :: [m (a -> a -> a)]
              prefix, postfix :: [m (a -> a)]
              ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix) = (Operator m a
 -> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
     [m (a -> a)], [m (a -> a)])
 -> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
     [m (a -> a)], [m (a -> a)]))
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
-> t (Operator m a)
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Operator m a
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
forall (m :: * -> *) a.
Operator m a
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
splitOp ([],[],[],[],[]) t (Operator m a)
ops

              rassocOp, lassocOp, nassocOp :: m (a -> a -> a)
              rassocOp :: m (a -> a -> a)
rassocOp   = [m (a -> a -> a)] -> m (a -> a -> a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m (a -> a -> a)]
rassoc
              lassocOp :: m (a -> a -> a)
lassocOp   = [m (a -> a -> a)] -> m (a -> a -> a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m (a -> a -> a)]
lassoc
              nassocOp :: m (a -> a -> a)
nassocOp   = [m (a -> a -> a)] -> m (a -> a -> a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m (a -> a -> a)]
nassoc

              prefixOp, postfixOp :: m (a -> a)
              prefixOp :: m (a -> a)
prefixOp   = [m (a -> a)] -> m (a -> a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m (a -> a)]
prefix  m (a -> a) -> String -> m (a -> a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
""
              postfixOp :: m (a -> a)
postfixOp  = [m (a -> a)] -> m (a -> a)
forall (m :: * -> *) a. Alternative m => [m a] -> m a
choice [m (a -> a)]
postfix m (a -> a) -> String -> m (a -> a)
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
""

              ambiguous :: String -> m x -> m y
              ambiguous :: String -> m x -> m y
ambiguous String
assoc m x
op = m y -> m y
forall (m :: * -> *) a. Parsing m => m a -> m a
try (m y -> m y) -> m y -> m y
forall a b. (a -> b) -> a -> b
$ m x
op m x -> m y -> m y
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m y
forall (f :: * -> *) a. Alternative f => f a
empty m y -> String -> m y
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> (String
"ambiguous use of a " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
assoc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-associative operator")

              ambiguousRight, ambiguousLeft, ambiguousNon :: m y
              ambiguousRight :: m y
ambiguousRight    = String -> m (a -> a -> a) -> m y
forall x y. String -> m x -> m y
ambiguous String
"right" m (a -> a -> a)
rassocOp
              ambiguousLeft :: m y
ambiguousLeft     = String -> m (a -> a -> a) -> m y
forall x y. String -> m x -> m y
ambiguous String
"left" m (a -> a -> a)
lassocOp
              ambiguousNon :: m y
ambiguousNon      = String -> m (a -> a -> a) -> m y
forall x y. String -> m x -> m y
ambiguous String
"non" m (a -> a -> a)
nassocOp

              termP      :: m a
              termP :: m a
termP      = (m (a -> a)
prefixP m (a -> a) -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
term) m a -> m (a -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> m (a -> a)
postfixP

              postfixP   :: m (a -> a)
              postfixP :: m (a -> a)
postfixP   = m (a -> a)
postfixOp m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id

              prefixP    :: m (a -> a)
              prefixP :: m (a -> a)
prefixP    = m (a -> a)
prefixOp m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id

              rassocP, rassocP1, lassocP, lassocP1, nassocP :: m (a -> a)

              rassocP :: m (a -> a)
rassocP  = ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> a -> a)
-> m (a -> a -> a) -> m (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> a -> a)
rassocOp m (a -> a -> a) -> m a -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (m a
termP m a -> m (a -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> m (a -> a)
rassocP1)
                          m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (a -> a)
forall y. m y
ambiguousLeft
                          m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (a -> a)
forall y. m y
ambiguousNon)

              rassocP1 :: m (a -> a)
rassocP1 = m (a -> a)
rassocP m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id

              lassocP :: m (a -> a)
lassocP  = (((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> a -> a)
-> m (a -> a -> a) -> m (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> a -> a)
lassocOp m (a -> a -> a) -> m a -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
termP) m (a -> a) -> m ((a -> a) -> a -> a) -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> ((a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ((a -> a) -> (a -> a) -> a -> a)
-> m (a -> a) -> m ((a -> a) -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> a)
lassocP1)
                          m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (a -> a)
forall y. m y
ambiguousRight
                          m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (a -> a)
forall y. m y
ambiguousNon)

              lassocP1 :: m (a -> a)
lassocP1 = m (a -> a)
lassocP m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id

              nassocP :: m (a -> a)
nassocP = ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((a -> a -> a) -> a -> a -> a)
-> m (a -> a -> a) -> m (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (a -> a -> a)
nassocOp m (a -> a -> a) -> m a -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m a
termP)
                        m (a -> a) -> m ((a -> a) -> a -> a) -> m (a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (m ((a -> a) -> a -> a)
forall y. m y
ambiguousRight
                              m ((a -> a) -> a -> a)
-> m ((a -> a) -> a -> a) -> m ((a -> a) -> a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ((a -> a) -> a -> a)
forall y. m y
ambiguousLeft
                              m ((a -> a) -> a -> a)
-> m ((a -> a) -> a -> a) -> m ((a -> a) -> a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ((a -> a) -> a -> a)
forall y. m y
ambiguousNon
                              m ((a -> a) -> a -> a)
-> m ((a -> a) -> a -> a) -> m ((a -> a) -> a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ((a -> a) -> a -> a) -> m ((a -> a) -> a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> a) -> a -> a
forall a. a -> a
id)
           in m a
termP m a -> m (a -> a) -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> (m (a -> a)
rassocP m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (a -> a)
lassocP m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m (a -> a)
nassocP m (a -> a) -> m (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> a) -> m (a -> a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> a
forall a. a -> a
id) m a -> String -> m a
forall (m :: * -> *) a. Parsing m => m a -> String -> m a
<?> String
"operator"


      splitOp :: Operator m a
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
-> ([m (a -> a -> a)], [m (a -> a -> a)], [m (a -> a -> a)],
    [m (a -> a)], [m (a -> a)])
splitOp (Infix m (a -> a -> a)
op Assoc
assoc) ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix)
        = case Assoc
assoc of
            Assoc
AssocNone  -> ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,m (a -> a -> a)
opm (a -> a -> a) -> [m (a -> a -> a)] -> [m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix)
            Assoc
AssocLeft  -> ([m (a -> a -> a)]
rassoc,m (a -> a -> a)
opm (a -> a -> a) -> [m (a -> a -> a)] -> [m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix)
            Assoc
AssocRight -> (m (a -> a -> a)
opm (a -> a -> a) -> [m (a -> a -> a)] -> [m (a -> a -> a)]
forall a. a -> [a] -> [a]
:[m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix)

      splitOp (Prefix m (a -> a)
op) ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix)
        = ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,m (a -> a)
opm (a -> a) -> [m (a -> a)] -> [m (a -> a)]
forall a. a -> [a] -> [a]
:[m (a -> a)]
prefix,[m (a -> a)]
postfix)

      splitOp (Postfix m (a -> a)
op) ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,[m (a -> a)]
postfix)
        = ([m (a -> a -> a)]
rassoc,[m (a -> a -> a)]
lassoc,[m (a -> a -> a)]
nassoc,[m (a -> a)]
prefix,m (a -> a)
opm (a -> a) -> [m (a -> a)] -> [m (a -> a)]
forall a. a -> [a] -> [a]
:[m (a -> a)]
postfix)