{-# 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