{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
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)
data Operator m a
= Infix (m (a -> a -> a)) Assoc
| Prefix (m (a -> a))
| Postfix (m (a -> a))
type OperatorTable m a = [[Operator m a]]
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)