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