module Language.Parser.Ptera.Pipeline.Grammar2PEG where

import           Language.Parser.Ptera.Prelude

import qualified Data.EnumMap.Strict                       as EnumMap
import qualified Language.Parser.Ptera.Data.HFList         as HFList
import qualified Language.Parser.Ptera.Machine.PEG         as PEG
import qualified Language.Parser.Ptera.Machine.PEG.Builder as PEGBuilder
import qualified Language.Parser.Ptera.Syntax.Grammar      as Grammar


grammar2Peg :: Enum start => Enum nonTerminal => Enum terminal
    => Grammar.FixedGrammar start nonTerminal terminal elem varDoc altDoc action
    -> PEG.T start varDoc altDoc (Grammar.Action action)
grammar2Peg :: forall start nonTerminal terminal elem varDoc altDoc
       (action :: [*] -> * -> *).
(Enum start, Enum nonTerminal, Enum terminal) =>
FixedGrammar start nonTerminal terminal elem varDoc altDoc action
-> T start varDoc altDoc (Action action)
grammar2Peg FixedGrammar start nonTerminal terminal elem varDoc altDoc action
g = forall a. Identity a -> a
runIdentity do forall (m :: * -> *) start varDoc altDoc a.
Monad m =>
BuilderT start varDoc altDoc a m () -> m (T start varDoc altDoc a)
PEGBuilder.build StateT (Context start varDoc altDoc (Action action)) Identity ()
builder where
    builder :: StateT (Context start varDoc altDoc (Action action)) Identity ()
builder = do
        Context start varDoc altDoc (Action action)
initialBuilderCtx <- forall (m :: * -> *) s. Monad m => StateT s m s
get
        let initialCtx :: Context start nonTerminal varDoc altDoc action
initialCtx = Context
                { $sel:ctxBuilder:Context :: Context start varDoc altDoc (Action action)
ctxBuilder = Context start varDoc altDoc (Action action)
initialBuilderCtx
                , $sel:ctxVarMap:Context :: EnumMap nonTerminal VarNum
ctxVarMap = forall k a. EnumMap k a
EnumMap.empty
                , $sel:ctxDisplayNonTerminals:Context :: EnumMap nonTerminal varDoc
ctxDisplayNonTerminals = forall {k1} {k2} start nonTerminal terminal (elem :: k1) varDoc
       altDoc (action :: [k1] -> k2 -> *).
FixedGrammar start nonTerminal terminal elem varDoc altDoc action
-> EnumMap nonTerminal varDoc
Grammar.grammarDisplayNonTerminals FixedGrammar start nonTerminal terminal elem varDoc altDoc action
g
                }
        let finalCtx :: Context start nonTerminal varDoc altDoc action
finalCtx = forall s a. State s a -> s -> s
execState StateT (Context start nonTerminal varDoc altDoc action) Identity ()
pipeline Context start nonTerminal varDoc altDoc action
initialCtx
        forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> Context start varDoc altDoc (Action action)
ctxBuilder Context start nonTerminal varDoc altDoc action
finalCtx

    pipeline :: StateT (Context start nonTerminal varDoc altDoc action) Identity ()
pipeline = do
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ do forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do forall {k1} {k2} start nonTerminal terminal (elem :: k1) varDoc
       altDoc (action :: [k1] -> k2 -> *).
FixedGrammar start nonTerminal terminal elem varDoc altDoc action
-> EnumMap start nonTerminal
Grammar.grammarStarts FixedGrammar start nonTerminal terminal elem varDoc altDoc action
g
            do \(start
s, nonTerminal
v) -> forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
(Enum start, Enum nonTerminal) =>
start
-> nonTerminal
-> Pipeline start nonTerminal varDoc altDoc action ()
grammarStartPipeline start
s nonTerminal
v
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ do forall k a. Enum k => EnumMap k a -> [(k, a)]
EnumMap.assocs do forall {k1} {k2} start nonTerminal terminal (elem :: k1) varDoc
       altDoc (action :: [k1] -> k2 -> *).
FixedGrammar start nonTerminal terminal elem varDoc altDoc action
-> EnumMap
     nonTerminal (RuleExpr nonTerminal terminal elem altDoc action)
Grammar.grammarRules FixedGrammar start nonTerminal terminal elem varDoc altDoc action
g
            do \(nonTerminal
v, RuleExpr nonTerminal terminal elem altDoc action
e) -> forall nonTerminal terminal elem altDoc (action :: [*] -> * -> *)
       start varDoc.
(Enum nonTerminal, Enum terminal) =>
nonTerminal
-> RuleExpr nonTerminal terminal elem altDoc action
-> Pipeline start nonTerminal varDoc altDoc action ()
grammarRulePipeline nonTerminal
v RuleExpr nonTerminal terminal elem altDoc action
e

type Pipeline start nonTerminal varDoc altDoc action =
    State (Context start nonTerminal varDoc altDoc action)

data Context start nonTerminal varDoc altDoc action = Context
    { forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> Context start varDoc altDoc (Action action)
ctxBuilder :: PEGBuilder.Context start varDoc altDoc (Grammar.Action action)
    , forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> EnumMap nonTerminal VarNum
ctxVarMap  :: EnumMap.EnumMap nonTerminal PEG.VarNum
    , forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> EnumMap nonTerminal varDoc
ctxDisplayNonTerminals :: EnumMap.EnumMap nonTerminal varDoc
    }

grammarStartPipeline :: Enum start => Enum nonTerminal
    => start -> nonTerminal -> Pipeline start nonTerminal varDoc altDoc action ()
grammarStartPipeline :: forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
(Enum start, Enum nonTerminal) =>
start
-> nonTerminal
-> Pipeline start nonTerminal varDoc altDoc action ()
grammarStartPipeline start
s nonTerminal
v = do
    VarNum
newV <- forall nonTerminal start varDoc altDoc (action :: [*] -> * -> *).
Enum nonTerminal =>
nonTerminal
-> Pipeline start nonTerminal varDoc altDoc action VarNum
getNewVar nonTerminal
v
    forall start varDoc altDoc (action :: [*] -> * -> *) r nonTerminal.
T start varDoc altDoc (Action action) Identity r
-> Pipeline start nonTerminal varDoc altDoc action r
liftBuilder do forall (m :: * -> *) start varDoc altDoc a.
(Monad m, Enum start) =>
start -> VarNum -> BuilderT start varDoc altDoc a m ()
PEGBuilder.addInitial start
s VarNum
newV

grammarRulePipeline :: Enum nonTerminal => Enum terminal
    => nonTerminal -> Grammar.RuleExpr nonTerminal terminal elem altDoc action
    -> Pipeline start nonTerminal varDoc altDoc action ()
grammarRulePipeline :: forall nonTerminal terminal elem altDoc (action :: [*] -> * -> *)
       start varDoc.
(Enum nonTerminal, Enum terminal) =>
nonTerminal
-> RuleExpr nonTerminal terminal elem altDoc action
-> Pipeline start nonTerminal varDoc altDoc action ()
grammarRulePipeline nonTerminal
v (Grammar.RuleExpr [Alt nonTerminal terminal elem altDoc action a]
alts) = do
    VarNum
newV <- forall nonTerminal start varDoc altDoc (action :: [*] -> * -> *).
Enum nonTerminal =>
nonTerminal
-> Pipeline start nonTerminal varDoc altDoc action VarNum
getNewVar nonTerminal
v
    [AltNum]
newAlts <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Alt nonTerminal terminal elem altDoc action a]
alts \Alt nonTerminal terminal elem altDoc action a
alt -> forall nonTerminal terminal elem altDoc (action :: [*] -> * -> *) r
       start varDoc.
(Enum nonTerminal, Enum terminal) =>
Alt nonTerminal terminal elem altDoc action r
-> Pipeline start nonTerminal varDoc altDoc action AltNum
grammarAltPipeline Alt nonTerminal terminal elem altDoc action a
alt
    let newRule :: Rule
newRule = [AltNum] -> Rule
PEG.Rule [AltNum]
newAlts
    forall start varDoc altDoc (action :: [*] -> * -> *) r nonTerminal.
T start varDoc altDoc (Action action) Identity r
-> Pipeline start nonTerminal varDoc altDoc action r
liftBuilder do forall (m :: * -> *) start varDoc altDoc a.
Monad m =>
VarNum -> Rule -> BuilderT start varDoc altDoc a m ()
PEGBuilder.addRule VarNum
newV Rule
newRule

grammarAltPipeline :: Enum nonTerminal => Enum terminal
    => Grammar.Alt nonTerminal terminal elem altDoc action r
    -> Pipeline start nonTerminal varDoc altDoc action PEG.AltNum
grammarAltPipeline :: forall nonTerminal terminal elem altDoc (action :: [*] -> * -> *) r
       start varDoc.
(Enum nonTerminal, Enum terminal) =>
Alt nonTerminal terminal elem altDoc action r
-> Pipeline start nonTerminal varDoc altDoc action AltNum
grammarAltPipeline (Grammar.Alt Expr nonTerminal terminal elem us
e altDoc
d action us r
act) = do
    [Unit]
newUs <- forall {k} start nonTerminal terminal (elem :: k) varDoc altDoc
       (action :: [*] -> * -> *) (us :: [k]).
(Enum nonTerminal, Enum terminal) =>
Expr nonTerminal terminal elem us
-> Pipeline start nonTerminal varDoc altDoc action [Unit]
grammarExprPipeline Expr nonTerminal terminal elem us
e
    let newAct :: Action action
newAct = forall (action :: [*] -> * -> *) (us :: [*]) a.
action us a -> Action action
Grammar.Action action us r
act
    let newAlt :: Alt altDoc (Action action)
newAlt = PEG.Alt
            { $sel:altKind:Alt :: AltKind
altKind = AltKind
PEG.AltSeq
            , $sel:altUnitSeq:Alt :: [Unit]
altUnitSeq = [Unit]
newUs
            , $sel:altAction:Alt :: Action action
altAction = Action action
newAct
            , $sel:altHelp:Alt :: altDoc
altHelp = altDoc
d
            }
    forall start varDoc altDoc (action :: [*] -> * -> *) r nonTerminal.
T start varDoc altDoc (Action action) Identity r
-> Pipeline start nonTerminal varDoc altDoc action r
liftBuilder do forall (m :: * -> *) altDoc a start varDoc.
Monad m =>
Alt altDoc a -> BuilderT start varDoc altDoc a m AltNum
PEGBuilder.genNewAlt Alt altDoc (Action action)
newAlt

grammarExprPipeline :: forall start nonTerminal terminal elem varDoc altDoc action us
    .  Enum nonTerminal => Enum terminal
    => Grammar.Expr nonTerminal terminal elem us
    -> Pipeline start nonTerminal varDoc altDoc action [PEG.Unit]
grammarExprPipeline :: forall {k} start nonTerminal terminal (elem :: k) varDoc altDoc
       (action :: [*] -> * -> *) (us :: [k]).
(Enum nonTerminal, Enum terminal) =>
Expr nonTerminal terminal elem us
-> Pipeline start nonTerminal varDoc altDoc action [Unit]
grammarExprPipeline Expr nonTerminal terminal elem us
e = do
    [Unit]
revUs <- forall {k} (m :: * -> *) r (f :: k -> *) (xs :: [k]).
Monad m =>
r
-> (forall (x :: k). r -> Membership xs x -> f x -> m r)
-> HFList f xs
-> m r
HFList.hfoldMWithIndex []
        do \[Unit]
acc Membership us x
_ Unit nonTerminal terminal elem x
u -> do
            Unit
newU <- forall {k} nonTerminal terminal (elem :: k) (u :: k) start varDoc
       altDoc (action :: [*] -> * -> *).
(Enum nonTerminal, Enum terminal) =>
Unit nonTerminal terminal elem u
-> Pipeline start nonTerminal varDoc altDoc action Unit
grammarUnitPipeline Unit nonTerminal terminal elem x
u
            forall (f :: * -> *) a. Applicative f => a -> f a
pure do Unit
newUforall a. a -> [a] -> [a]
:[Unit]
acc
        do Expr nonTerminal terminal elem us
e
    forall (f :: * -> *) a. Applicative f => a -> f a
pure do forall a. [a] -> [a]
reverse [Unit]
revUs

grammarUnitPipeline :: Enum nonTerminal => Enum terminal
    => Grammar.Unit nonTerminal terminal elem u
    -> Pipeline start nonTerminal varDoc altDoc action PEG.Unit
grammarUnitPipeline :: forall {k} nonTerminal terminal (elem :: k) (u :: k) start varDoc
       altDoc (action :: [*] -> * -> *).
(Enum nonTerminal, Enum terminal) =>
Unit nonTerminal terminal elem u
-> Pipeline start nonTerminal varDoc altDoc action Unit
grammarUnitPipeline = \case
    Grammar.UnitToken terminal
t ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure do Terminal -> Unit
PEG.UnitTerminal do forall a. Enum a => a -> Terminal
fromEnum terminal
t
    Grammar.UnitVar nonTerminal
v -> do
        VarNum
newV <- forall nonTerminal start varDoc altDoc (action :: [*] -> * -> *).
Enum nonTerminal =>
nonTerminal
-> Pipeline start nonTerminal varDoc altDoc action VarNum
getNewVar nonTerminal
v
        forall (f :: * -> *) a. Applicative f => a -> f a
pure do VarNum -> Unit
PEG.UnitNonTerminal VarNum
newV

getNewVar :: Enum nonTerminal
    => nonTerminal -> Pipeline start nonTerminal varDoc altDoc action PEG.VarNum
getNewVar :: forall nonTerminal start varDoc altDoc (action :: [*] -> * -> *).
Enum nonTerminal =>
nonTerminal
-> Pipeline start nonTerminal varDoc altDoc action VarNum
getNewVar nonTerminal
v = do
    EnumMap nonTerminal VarNum
vmap <- forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> EnumMap nonTerminal VarNum
ctxVarMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => StateT s m s
get
    case forall k a. Enum k => k -> EnumMap k a -> Maybe a
EnumMap.lookup nonTerminal
v EnumMap nonTerminal VarNum
vmap of
        Just VarNum
newV ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
newV
        Maybe VarNum
Nothing -> do
            EnumMap nonTerminal varDoc
displayNonTerminals <- forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> EnumMap nonTerminal varDoc
ctxDisplayNonTerminals forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => StateT s m s
get
            let d :: varDoc
d = case forall k a. Enum k => k -> EnumMap k a -> Maybe a
EnumMap.lookup nonTerminal
v EnumMap nonTerminal varDoc
displayNonTerminals of
                    Just varDoc
x  -> varDoc
x
                    Maybe varDoc
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"Not found any rules for a non-terminal."
            VarNum
newV <- forall start varDoc altDoc (action :: [*] -> * -> *) r nonTerminal.
T start varDoc altDoc (Action action) Identity r
-> Pipeline start nonTerminal varDoc altDoc action r
liftBuilder
                do forall (m :: * -> *) varDoc start altDoc a.
Monad m =>
Var varDoc -> BuilderT start varDoc altDoc a m VarNum
PEGBuilder.genNewVar
                    do PEG.Var
                        { $sel:varHelp:Var :: varDoc
varHelp = varDoc
d
                        }
            forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start nonTerminal varDoc altDoc action
ctx -> Context start nonTerminal varDoc altDoc action
ctx
                { $sel:ctxVarMap:Context :: EnumMap nonTerminal VarNum
ctxVarMap = forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert nonTerminal
v VarNum
newV
                    do forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> EnumMap nonTerminal VarNum
ctxVarMap Context start nonTerminal varDoc altDoc action
ctx
                }
            forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
newV

liftBuilder
    :: PEGBuilder.T start varDoc altDoc (Grammar.Action action) Identity r
    -> Pipeline start nonTerminal varDoc altDoc action r
liftBuilder :: forall start varDoc altDoc (action :: [*] -> * -> *) r nonTerminal.
T start varDoc altDoc (Action action) Identity r
-> Pipeline start nonTerminal varDoc altDoc action r
liftBuilder T start varDoc altDoc (Action action) Identity r
builder = do
    Context start nonTerminal varDoc altDoc action
ctx <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (r
x, Context start varDoc altDoc (Action action)
builderCtx) = forall s a. State s a -> s -> (a, s)
runState T start varDoc altDoc (Action action) Identity r
builder do forall start nonTerminal varDoc altDoc (action :: [*] -> * -> *).
Context start nonTerminal varDoc altDoc action
-> Context start varDoc altDoc (Action action)
ctxBuilder Context start nonTerminal varDoc altDoc action
ctx
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do Context start nonTerminal varDoc altDoc action
ctx { $sel:ctxBuilder:Context :: Context start varDoc altDoc (Action action)
ctxBuilder = Context start varDoc altDoc (Action action)
builderCtx }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure r
x