{-# LANGUAGE Safe #-} {-# LANGUAGE GADTs #-} module Text.Gigaparsec.Expr (module Text.Gigaparsec.Expr) where import Text.Gigaparsec (Parsec) import Text.Gigaparsec.Combinator (choice) import Text.Gigaparsec.Expr.Infix (infixl1, infixr1, infixn1, prefix, postfix) import Text.Gigaparsec.Expr.Subtype (Subtype(upcast)) import Data.List (foldl') type Fixity :: * -> * -> * -> * data Fixity a b sig where InfixL :: Fixity a b (b -> a -> b) InfixR :: Fixity a b (a -> b -> b) InfixN :: Fixity a b (a -> a -> b) Prefix :: Fixity a b (b -> b) Postfix :: Fixity a b (b -> b) type Op :: * -> * -> * data Op a b = forall sig. Op (Fixity a b sig) (a -> b) (Parsec sig) type Prec :: * -> * data Prec a where Level :: Prec a -> Op a b -> Prec b Atom :: Parsec a -> Prec a infixl 5 >+ (>+) :: Prec a -> Op a b -> Prec b >+ :: forall a b. Prec a -> Op a b -> Prec b (>+) = Prec a -> Op a b -> Prec b forall a b. Prec a -> Op a b -> Prec b Level infixr 5 +< (+<) :: Op a b -> Prec a -> Prec b +< :: forall a b. Op a b -> Prec a -> Prec b (+<) = (Prec a -> Op a b -> Prec b) -> Op a b -> Prec a -> Prec b forall a b c. (a -> b -> c) -> b -> a -> c flip Prec a -> Op a b -> Prec b forall a b. Prec a -> Op a b -> Prec b (>+) precedence :: Prec a -> Parsec a precedence :: forall a. Prec a -> Parsec a precedence (Atom Parsec a atom) = Parsec a atom precedence (Level Prec a lvls Op a a lvl) = Parsec a -> Op a a -> Parsec a forall a b. Parsec a -> Op a b -> Parsec b con (Prec a -> Parsec a forall a. Prec a -> Parsec a precedence Prec a lvls) Op a a lvl where con :: Parsec a -> Op a b -> Parsec b con :: forall a b. Parsec a -> Op a b -> Parsec b con Parsec a p (Op Fixity a b sig InfixL a -> b wrap Parsec sig op) = (a -> b) -> Parsec a -> Parsec (b -> a -> b) -> Parsec b forall a b. (a -> b) -> Parsec a -> Parsec (b -> a -> b) -> Parsec b infixl1 a -> b wrap Parsec a p Parsec sig Parsec (b -> a -> b) op con Parsec a p (Op Fixity a b sig InfixR a -> b wrap Parsec sig op) = (a -> b) -> Parsec a -> Parsec (a -> b -> b) -> Parsec b forall a b. (a -> b) -> Parsec a -> Parsec (a -> b -> b) -> Parsec b infixr1 a -> b wrap Parsec a p Parsec sig Parsec (a -> b -> b) op con Parsec a p (Op Fixity a b sig InfixN a -> b wrap Parsec sig op) = (a -> b) -> Parsec a -> Parsec (a -> a -> b) -> Parsec b forall a b. (a -> b) -> Parsec a -> Parsec (a -> a -> b) -> Parsec b infixn1 a -> b wrap Parsec a p Parsec sig Parsec (a -> a -> b) op con Parsec a p (Op Fixity a b sig Prefix a -> b wrap Parsec sig op) = (a -> b) -> Parsec (b -> b) -> Parsec a -> Parsec b forall a b. (a -> b) -> Parsec (b -> b) -> Parsec a -> Parsec b prefix a -> b wrap Parsec sig Parsec (b -> b) op Parsec a p con Parsec a p (Op Fixity a b sig Postfix a -> b wrap Parsec sig op) = (a -> b) -> Parsec a -> Parsec (b -> b) -> Parsec b forall a b. (a -> b) -> Parsec a -> Parsec (b -> b) -> Parsec b postfix a -> b wrap Parsec a p Parsec sig Parsec (b -> b) op precedence' :: Parsec a -> [Op a a] -> Parsec a precedence' :: forall a. Parsec a -> [Op a a] -> Parsec a precedence' Parsec a atom = Prec a -> Parsec a forall a. Prec a -> Parsec a precedence (Prec a -> Parsec a) -> ([Op a a] -> Prec a) -> [Op a a] -> Parsec a forall b c a. (b -> c) -> (a -> b) -> a -> c . (Prec a -> Op a a -> Prec a) -> Prec a -> [Op a a] -> Prec a forall b a. (b -> a -> b) -> b -> [a] -> b forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' Prec a -> Op a a -> Prec a forall a b. Prec a -> Op a b -> Prec b (>+) (Parsec a -> Prec a forall a. Parsec a -> Prec a Atom Parsec a atom) gops :: Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b gops :: forall a b sig. Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b gops Fixity a b sig fixity a -> b wrap = Fixity a b sig -> (a -> b) -> Parsec sig -> Op a b forall a b sig. Fixity a b sig -> (a -> b) -> Parsec sig -> Op a b Op Fixity a b sig fixity a -> b wrap (Parsec sig -> Op a b) -> ([Parsec sig] -> Parsec sig) -> [Parsec sig] -> Op a b forall b c a. (b -> c) -> (a -> b) -> a -> c . [Parsec sig] -> Parsec sig forall a. [Parsec a] -> Parsec a choice ops :: Fixity a a sig -> [Parsec sig] -> Op a a ops :: forall a sig. Fixity a a sig -> [Parsec sig] -> Op a a ops Fixity a a sig fixity = Fixity a a sig -> (a -> a) -> [Parsec sig] -> Op a a forall a b sig. Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b gops Fixity a a sig fixity a -> a forall a. a -> a id sops :: Subtype a b => Fixity a b sig -> [Parsec sig] -> Op a b sops :: forall a b sig. Subtype a b => Fixity a b sig -> [Parsec sig] -> Op a b sops Fixity a b sig fixity = Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b forall a b sig. Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b gops Fixity a b sig fixity a -> b forall sub sup. Subtype sub sup => sub -> sup upcast