{-# 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 (>+) = 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 (+<) = forall a b c. (a -> b -> c) -> b -> a -> c flip 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) = forall a b. Parsec a -> Op a b -> Parsec b con (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) = forall a b. (a -> b) -> Parsec a -> Parsec (b -> a -> b) -> Parsec b infixl1 a -> b wrap Parsec a p Parsec sig op con Parsec a p (Op Fixity a b sig InfixR a -> b wrap Parsec sig op) = forall a b. (a -> b) -> Parsec a -> Parsec (a -> b -> b) -> Parsec b infixr1 a -> b wrap Parsec a p Parsec sig op con Parsec a p (Op Fixity a b sig InfixN a -> b wrap Parsec sig op) = forall a b. (a -> b) -> Parsec a -> Parsec (a -> a -> b) -> Parsec b infixn1 a -> b wrap Parsec a p Parsec sig op con Parsec a p (Op Fixity a b sig Prefix a -> b wrap Parsec sig op) = forall a b. (a -> b) -> Parsec (b -> b) -> Parsec a -> Parsec b prefix a -> b wrap Parsec sig op Parsec a p con Parsec a p (Op Fixity a b sig Postfix a -> b wrap Parsec sig op) = forall a b. (a -> b) -> Parsec a -> Parsec (b -> b) -> Parsec b postfix a -> b wrap Parsec a p Parsec sig op precedence' :: Parsec a -> [Op a a] -> Parsec a precedence' :: forall a. Parsec a -> [Op a a] -> Parsec a precedence' Parsec a atom = forall a. Prec a -> Parsec a precedence forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' forall a b. Prec a -> Op a b -> Prec b (>+) (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 = forall a b sig. Fixity a b sig -> (a -> b) -> Parsec sig -> Op a b Op Fixity a b sig fixity a -> b wrap forall b c a. (b -> c) -> (a -> b) -> a -> c . 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 = forall a b sig. Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b gops Fixity a a sig fixity 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 = forall a b sig. Fixity a b sig -> (a -> b) -> [Parsec sig] -> Op a b gops Fixity a b sig fixity forall sub sup. Subtype sub sup => sub -> sup upcast