module Language.Parser.Ptera.Syntax (
    T,

    SafeGrammar.HasRuleExprField (..),
    SafeGrammar.TokensTag,
    SafeGrammar.RulesTag,
    SafeGrammar.RuleExprType,

    GrammarM,
    SafeGrammar.MemberInitials (..),
    SafeGrammar.Rules (..),
    SafeGrammar.GrammarToken (..),
    RuleExprM,
    AltM,
    SafeGrammar.Expr,
    HFList.HFList (..),
    HFList.DictF (..),
    HList,
    pattern HNil,
    pattern (:*),
    SemActM (..),
    semActM,
    ActionTask (..),
    ActionTaskResult (..),
    getAction,
    modifyAction,
    failAction,

    Grammar,
    RuleExpr,
    Alt,
    SemAct,
    semAct,

    SafeGrammar.fixGrammar,
    SafeGrammar.ruleExpr,
    (SafeGrammar.<^>),
    SafeGrammar.eps,
    (<:>),
    (<::>),
    SafeGrammar.var,
    SafeGrammar.varA,
    SafeGrammar.tok,
    SafeGrammar.TokensMember (..),
    SafeGrammar.tokA,
) where

import           Language.Parser.Ptera.Prelude

import qualified Language.Parser.Ptera.Data.HFList        as HFList
import qualified Language.Parser.Ptera.Syntax.SafeGrammar as SafeGrammar


type T ctx = GrammarM ctx

type GrammarM ctx = SafeGrammar.Grammar (SemActM ctx)
type RuleExprM ctx = SafeGrammar.RuleExpr (SemActM ctx)
type AltM ctx = SafeGrammar.Alt (SemActM ctx)

type Grammar = GrammarM ()
type RuleExpr = RuleExprM ()
type Alt = AltM ()


(<:>)
    :: SafeGrammar.Expr rules tokens elem us -> (HList us -> a)
    -> AltM ctx rules tokens elem a
Expr rules tokens elem us
e <:> :: forall rules tokens elem (us :: [*]) a ctx.
Expr rules tokens elem us
-> (HList us -> a) -> AltM ctx rules tokens elem a
<:> HList us -> a
act = Expr rules tokens elem us
e forall rules tokens elem (us :: [*]) (action :: [*] -> * -> *) a.
Expr rules tokens elem us
-> action us a -> Alt action rules tokens elem a
SafeGrammar.<:> forall (us :: [*]) a ctx. (HList us -> a) -> SemActM ctx us a
semAct HList us -> a
act

infixl 4 <:>

(<::>)
    :: SafeGrammar.Expr rules tokens elem us -> (HList us -> ActionTask ctx a)
    -> AltM ctx rules tokens elem a
Expr rules tokens elem us
e <::> :: forall rules tokens elem (us :: [*]) ctx a.
Expr rules tokens elem us
-> (HList us -> ActionTask ctx a) -> AltM ctx rules tokens elem a
<::> HList us -> ActionTask ctx a
act = Expr rules tokens elem us
e forall rules tokens elem (us :: [*]) (action :: [*] -> * -> *) a.
Expr rules tokens elem us
-> action us a -> Alt action rules tokens elem a
SafeGrammar.<:> forall (us :: [*]) ctx a.
(HList us -> ActionTask ctx a) -> SemActM ctx us a
semActM HList us -> ActionTask ctx a
act

infixl 4 <::>


type HList = HFList.T Identity

pattern HNil :: HList '[]
pattern $bHNil :: HList '[]
$mHNil :: forall {r}. HList '[] -> ((# #) -> r) -> ((# #) -> r) -> r
HNil = HFList.HFNil

pattern (:*) :: u -> HList us -> HList (u ': us)
pattern x $b:* :: forall u (us :: [*]). u -> HList us -> HList (u : us)
$m:* :: forall {r} {u} {us :: [*]}.
HList (u : us) -> (u -> HList us -> r) -> ((# #) -> r) -> r
:* xs = HFList.HFCons (Identity x) xs

infixr 6 :*


newtype SemActM ctx us a = SemActM
    { forall ctx (us :: [*]) a.
SemActM ctx us a -> HList us -> ActionTask ctx a
semanticAction :: HList us -> ActionTask ctx a
    }
    deriving forall ctx (us :: [*]) a b.
a -> SemActM ctx us b -> SemActM ctx us a
forall ctx (us :: [*]) a b.
(a -> b) -> SemActM ctx us a -> SemActM ctx us b
forall a b. a -> SemActM ctx us b -> SemActM ctx us a
forall a b. (a -> b) -> SemActM ctx us a -> SemActM ctx us b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> SemActM ctx us b -> SemActM ctx us a
$c<$ :: forall ctx (us :: [*]) a b.
a -> SemActM ctx us b -> SemActM ctx us a
fmap :: forall a b. (a -> b) -> SemActM ctx us a -> SemActM ctx us b
$cfmap :: forall ctx (us :: [*]) a b.
(a -> b) -> SemActM ctx us a -> SemActM ctx us b
Functor

type SemAct = SemActM ()

semActM :: (HList us -> ActionTask ctx a) -> SemActM ctx us a
semActM :: forall (us :: [*]) ctx a.
(HList us -> ActionTask ctx a) -> SemActM ctx us a
semActM = forall ctx (us :: [*]) a.
(HList us -> ActionTask ctx a) -> SemActM ctx us a
SemActM

semAct :: (HList us -> a) -> SemActM ctx us a
semAct :: forall (us :: [*]) a ctx. (HList us -> a) -> SemActM ctx us a
semAct HList us -> a
f = forall ctx (us :: [*]) a.
(HList us -> ActionTask ctx a) -> SemActM ctx us a
SemActM \HList us
l -> forall (f :: * -> *) a. Applicative f => a -> f a
pure do HList us -> a
f HList us
l


newtype ActionTask ctx a = ActionTask
    { forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a
runActionTask :: ctx -> ActionTaskResult ctx a
    }
    deriving forall a b. a -> ActionTask ctx b -> ActionTask ctx a
forall a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b
forall ctx a b. a -> ActionTask ctx b -> ActionTask ctx a
forall ctx a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ActionTask ctx b -> ActionTask ctx a
$c<$ :: forall ctx a b. a -> ActionTask ctx b -> ActionTask ctx a
fmap :: forall a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b
$cfmap :: forall ctx a b. (a -> b) -> ActionTask ctx a -> ActionTask ctx b
Functor

data ActionTaskResult ctx a
    = ActionTaskFail
    | ActionTaskResult a
    | ActionTaskModifyResult ctx a
    deriving (ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ctx a.
(Eq a, Eq ctx) =>
ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool
/= :: ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool
$c/= :: forall ctx a.
(Eq a, Eq ctx) =>
ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool
== :: ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool
$c== :: forall ctx a.
(Eq a, Eq ctx) =>
ActionTaskResult ctx a -> ActionTaskResult ctx a -> Bool
Eq, Int -> ActionTaskResult ctx a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ctx a.
(Show a, Show ctx) =>
Int -> ActionTaskResult ctx a -> ShowS
forall ctx a.
(Show a, Show ctx) =>
[ActionTaskResult ctx a] -> ShowS
forall ctx a.
(Show a, Show ctx) =>
ActionTaskResult ctx a -> String
showList :: [ActionTaskResult ctx a] -> ShowS
$cshowList :: forall ctx a.
(Show a, Show ctx) =>
[ActionTaskResult ctx a] -> ShowS
show :: ActionTaskResult ctx a -> String
$cshow :: forall ctx a.
(Show a, Show ctx) =>
ActionTaskResult ctx a -> String
showsPrec :: Int -> ActionTaskResult ctx a -> ShowS
$cshowsPrec :: forall ctx a.
(Show a, Show ctx) =>
Int -> ActionTaskResult ctx a -> ShowS
Show, forall a b. a -> ActionTaskResult ctx b -> ActionTaskResult ctx a
forall a b.
(a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b
forall ctx a b.
a -> ActionTaskResult ctx b -> ActionTaskResult ctx a
forall ctx a b.
(a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ActionTaskResult ctx b -> ActionTaskResult ctx a
$c<$ :: forall ctx a b.
a -> ActionTaskResult ctx b -> ActionTaskResult ctx a
fmap :: forall a b.
(a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b
$cfmap :: forall ctx a b.
(a -> b) -> ActionTaskResult ctx a -> ActionTaskResult ctx b
Functor)

getAction :: ActionTask ctx ctx
getAction :: forall ctx. ActionTask ctx ctx
getAction = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a
ActionTask \ctx
ctx0 -> forall ctx a. a -> ActionTaskResult ctx a
ActionTaskResult ctx
ctx0

modifyAction :: (ctx -> ctx) -> ActionTask ctx ()
modifyAction :: forall ctx. (ctx -> ctx) -> ActionTask ctx ()
modifyAction ctx -> ctx
f = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a
ActionTask \ctx
ctx0 -> forall ctx a. ctx -> a -> ActionTaskResult ctx a
ActionTaskModifyResult (ctx -> ctx
f ctx
ctx0) ()

failAction :: ActionTask ctx a
failAction :: forall ctx a. ActionTask ctx a
failAction = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a
ActionTask \ctx
_ -> forall ctx a. ActionTaskResult ctx a
ActionTaskFail

instance Applicative (ActionTask ctx) where
    pure :: forall a. a -> ActionTask ctx a
pure a
x = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a
ActionTask \ctx
_ -> forall ctx a. a -> ActionTaskResult ctx a
ActionTaskResult a
x
    ActionTask ctx -> ActionTaskResult ctx (a -> b)
mf <*> :: forall a b.
ActionTask ctx (a -> b) -> ActionTask ctx a -> ActionTask ctx b
<*> ActionTask ctx -> ActionTaskResult ctx a
mx = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a
ActionTask \ctx
ctx0 -> case ctx -> ActionTaskResult ctx (a -> b)
mf ctx
ctx0 of
        ActionTaskResult ctx (a -> b)
ActionTaskFail ->
            forall ctx a. ActionTaskResult ctx a
ActionTaskFail
        ActionTaskResult a -> b
f -> case ctx -> ActionTaskResult ctx a
mx ctx
ctx0 of
            ActionTaskResult ctx a
ActionTaskFail ->
                forall ctx a. ActionTaskResult ctx a
ActionTaskFail
            ActionTaskResult a
x ->
                forall ctx a. a -> ActionTaskResult ctx a
ActionTaskResult do a -> b
f a
x
            ActionTaskModifyResult ctx
ctx1 a
x ->
                forall ctx a. ctx -> a -> ActionTaskResult ctx a
ActionTaskModifyResult ctx
ctx1 do a -> b
f a
x
        ActionTaskModifyResult ctx
ctx1 a -> b
f -> case ctx -> ActionTaskResult ctx a
mx ctx
ctx1 of
            ActionTaskResult ctx a
ActionTaskFail ->
                forall ctx a. ActionTaskResult ctx a
ActionTaskFail
            ActionTaskResult a
x ->
                forall ctx a. ctx -> a -> ActionTaskResult ctx a
ActionTaskModifyResult ctx
ctx1 do a -> b
f a
x
            ActionTaskModifyResult ctx
ctx2 a
x ->
                forall ctx a. ctx -> a -> ActionTaskResult ctx a
ActionTaskModifyResult ctx
ctx2 do a -> b
f a
x

instance Monad (ActionTask ctx) where
    ActionTask ctx -> ActionTaskResult ctx a
mx >>= :: forall a b.
ActionTask ctx a -> (a -> ActionTask ctx b) -> ActionTask ctx b
>>= a -> ActionTask ctx b
f = forall ctx a. (ctx -> ActionTaskResult ctx a) -> ActionTask ctx a
ActionTask \ctx
ctx0 -> case ctx -> ActionTaskResult ctx a
mx ctx
ctx0 of
        ActionTaskResult ctx a
ActionTaskFail ->
            forall ctx a. ActionTaskResult ctx a
ActionTaskFail
        ActionTaskResult a
x ->
            forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a
runActionTask (a -> ActionTask ctx b
f a
x) ctx
ctx0
        ActionTaskModifyResult ctx
ctx1 a
x ->
            forall ctx a. ActionTask ctx a -> ctx -> ActionTaskResult ctx a
runActionTask (a -> ActionTask ctx b
f a
x) ctx
ctx1