{-# LANGUAGE AllowAmbiguousTypes,
MultiParamTypeClasses #-}
module Parsley.Precedence (module Parsley.Precedence) where
import Prelude hiding ((<$>))
import Parsley.Alternative (choice)
import Parsley.Applicative ((<$>))
import Parsley.Defunctionalized (Defunc(BLACK, ID))
import Parsley.Fold (chainPre, chainPost, chainl1', chainr1')
import Parsley.Internal (WQ, Parser)
precedence :: Prec a b -> Parser a -> Parser b
precedence :: Prec a b -> Parser a -> Parser b
precedence Prec a b
NoLevel Parser a
atom = Parser a
Parser b
atom
precedence (Level Level a b
lvl Prec b b
lvls) Parser a
atom = Prec b b -> Parser b -> Parser b
forall a b. Prec a b -> Parser a -> Parser b
precedence Prec b b
lvls (Level a b -> Parser a -> Parser b
forall a a. Level a a -> Parser a -> Parser a
level Level a b
lvl Parser a
atom)
where
level :: Level a a -> Parser a -> Parser a
level (InfixL [Parser (a -> a -> a)]
ops Defunc (a -> a)
wrap) Parser a
atom = Defunc (a -> a) -> Parser a -> Parser (a -> a -> a) -> Parser a
forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser (b -> a -> b) -> Parser b
chainl1' Defunc (a -> a)
wrap Parser a
atom ([Parser (a -> a -> a)] -> Parser (a -> a -> a)
forall a. [Parser a] -> Parser a
choice [Parser (a -> a -> a)]
ops)
level (InfixR [Parser (a -> a -> a)]
ops Defunc (a -> a)
wrap) Parser a
atom = Defunc (a -> a) -> Parser a -> Parser (a -> a -> a) -> Parser a
forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser (a -> b -> b) -> Parser b
chainr1' Defunc (a -> a)
wrap Parser a
atom ([Parser (a -> a -> a)] -> Parser (a -> a -> a)
forall a. [Parser a] -> Parser a
choice [Parser (a -> a -> a)]
ops)
level (Prefix [Parser (a -> a)]
ops Defunc (a -> a)
wrap) Parser a
atom = Parser (a -> a) -> Parser a -> Parser a
forall a. Parser (a -> a) -> Parser a -> Parser a
chainPre ([Parser (a -> a)] -> Parser (a -> a)
forall a. [Parser a] -> Parser a
choice [Parser (a -> a)]
ops) (Defunc (a -> a)
wrap Defunc (a -> a) -> Parser a -> Parser a
forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser a
atom)
level (Postfix [Parser (a -> a)]
ops Defunc (a -> a)
wrap) Parser a
atom = Parser a -> Parser (a -> a) -> Parser a
forall a. Parser a -> Parser (a -> a) -> Parser a
chainPost (Defunc (a -> a)
wrap Defunc (a -> a) -> Parser a -> Parser a
forall (rep :: Type -> Type) a b.
ParserOps rep =>
rep (a -> b) -> Parser a -> Parser b
<$> Parser a
atom) ([Parser (a -> a)] -> Parser (a -> a)
forall a. [Parser a] -> Parser a
choice [Parser (a -> a)]
ops)
monolith :: [Level a a] -> Prec a a
monolith :: [Level a a] -> Prec a a
monolith = (Level a a -> Prec a a -> Prec a a)
-> Prec a a -> [Level a a] -> Prec a a
forall (t :: Type -> Type) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Level a a -> Prec a a -> Prec a a
forall a b c. Level a b -> Prec b c -> Prec a c
Level Prec a a
forall a. Prec a a
NoLevel
data Prec a b where
NoLevel :: Prec a a
Level :: Level a b -> Prec b c -> Prec a c
data Level a b = InfixL [Parser (b -> a -> b)] (Defunc (a -> b))
| InfixR [Parser (a -> b -> b)] (Defunc (a -> b))
| Prefix [Parser (b -> b)] (Defunc (a -> b))
| Postfix [Parser (b -> b)] (Defunc (a -> b))
class Monolith a b c where
infixL :: [Parser (b -> a -> b)] -> c
infixR :: [Parser (a -> b -> b)] -> c
prefix :: [Parser (b -> b)] -> c
postfix :: [Parser (b -> b)] -> c
instance x ~ a => Monolith x a (Level a a) where
infixL :: [Parser (a -> x -> a)] -> Level a a
infixL = ([Parser (a -> a -> a)] -> Defunc (a -> a) -> Level a a)
-> Defunc (a -> a) -> [Parser (a -> a -> a)] -> Level a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Parser (a -> a -> a)] -> Defunc (a -> a) -> Level a a
forall a b. [Parser (b -> a -> b)] -> Defunc (a -> b) -> Level a b
InfixL Defunc (a -> a)
forall a1. Defunc (a1 -> a1)
ID
infixR :: [Parser (x -> a -> a)] -> Level a a
infixR = ([Parser (a -> a -> a)] -> Defunc (a -> a) -> Level a a)
-> Defunc (a -> a) -> [Parser (a -> a -> a)] -> Level a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Parser (a -> a -> a)] -> Defunc (a -> a) -> Level a a
forall a b. [Parser (a -> b -> b)] -> Defunc (a -> b) -> Level a b
InfixR Defunc (a -> a)
forall a1. Defunc (a1 -> a1)
ID
prefix :: [Parser (a -> a)] -> Level a a
prefix = ([Parser (a -> a)] -> Defunc (a -> a) -> Level a a)
-> Defunc (a -> a) -> [Parser (a -> a)] -> Level a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Parser (a -> a)] -> Defunc (a -> a) -> Level a a
forall a b. [Parser (b -> b)] -> Defunc (a -> b) -> Level a b
Prefix Defunc (a -> a)
forall a1. Defunc (a1 -> a1)
ID
postfix :: [Parser (a -> a)] -> Level a a
postfix = ([Parser (a -> a)] -> Defunc (a -> a) -> Level a a)
-> Defunc (a -> a) -> [Parser (a -> a)] -> Level a a
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Parser (a -> a)] -> Defunc (a -> a) -> Level a a
forall a b. [Parser (b -> b)] -> Defunc (a -> b) -> Level a b
Postfix Defunc (a -> a)
forall a1. Defunc (a1 -> a1)
ID
instance {-# INCOHERENT #-} x ~ (WQ (a -> b) -> Level a b) => Monolith a b x where
infixL :: [Parser (b -> a -> b)] -> x
infixL [Parser (b -> a -> b)]
ops = [Parser (b -> a -> b)] -> Defunc (a -> b) -> Level a b
forall a b. [Parser (b -> a -> b)] -> Defunc (a -> b) -> Level a b
InfixL [Parser (b -> a -> b)]
ops (Defunc (a -> b) -> Level a b)
-> (WQ (a -> b) -> Defunc (a -> b)) -> WQ (a -> b) -> Level a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WQ (a -> b) -> Defunc (a -> b)
forall a. WQ a -> Defunc a
BLACK
infixR :: [Parser (a -> b -> b)] -> x
infixR [Parser (a -> b -> b)]
ops = [Parser (a -> b -> b)] -> Defunc (a -> b) -> Level a b
forall a b. [Parser (a -> b -> b)] -> Defunc (a -> b) -> Level a b
InfixR [Parser (a -> b -> b)]
ops (Defunc (a -> b) -> Level a b)
-> (WQ (a -> b) -> Defunc (a -> b)) -> WQ (a -> b) -> Level a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WQ (a -> b) -> Defunc (a -> b)
forall a. WQ a -> Defunc a
BLACK
prefix :: [Parser (b -> b)] -> x
prefix [Parser (b -> b)]
ops = [Parser (b -> b)] -> Defunc (a -> b) -> Level a b
forall a b. [Parser (b -> b)] -> Defunc (a -> b) -> Level a b
Prefix [Parser (b -> b)]
ops (Defunc (a -> b) -> Level a b)
-> (WQ (a -> b) -> Defunc (a -> b)) -> WQ (a -> b) -> Level a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WQ (a -> b) -> Defunc (a -> b)
forall a. WQ a -> Defunc a
BLACK
postfix :: [Parser (b -> b)] -> x
postfix [Parser (b -> b)]
ops = [Parser (b -> b)] -> Defunc (a -> b) -> Level a b
forall a b. [Parser (b -> b)] -> Defunc (a -> b) -> Level a b
Postfix [Parser (b -> b)]
ops (Defunc (a -> b) -> Level a b)
-> (WQ (a -> b) -> Defunc (a -> b)) -> WQ (a -> b) -> Level a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WQ (a -> b) -> Defunc (a -> b)
forall a. WQ a -> Defunc a
BLACK