module Language.Parser.Ptera.Machine.LAPEG.Builder where

import           Language.Parser.Ptera.Prelude

import qualified Data.EnumMap.Strict                        as EnumMap
import qualified Language.Parser.Ptera.Data.Alignable       as Alignable
import qualified Language.Parser.Ptera.Data.Alignable.Array as AlignableArray
import qualified Language.Parser.Ptera.Data.Alignable.Map   as AlignableMap
import qualified Language.Parser.Ptera.Machine.LAPEG        as LAPEG
import qualified Language.Parser.Ptera.Machine.PEG          as PEG


type T start varDoc altDoc a = BuilderT start varDoc altDoc a

type BuilderT start varDoc altDoc a = StateT (Context start varDoc altDoc a)

data Context start varDoc altDoc a = Context
    { forall start varDoc altDoc a.
Context start varDoc altDoc a -> EnumMap start VarNum
ctxInitials   :: EnumMap.EnumMap start LAPEG.VarNum
    , forall start varDoc altDoc a.
Context start varDoc altDoc a -> VarNum
ctxNextVarNum :: LAPEG.VarNum
    , forall start varDoc altDoc a.
Context start varDoc altDoc a -> AltNum
ctxNextAltNum :: LAPEG.AltNum
    , forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxVars       :: AlignableMap.T LAPEG.VarNum (PEG.Var varDoc)
    , forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum Rule
ctxRules      :: AlignableMap.T LAPEG.VarNum LAPEG.Rule
    , forall start varDoc altDoc a.
Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
ctxAlts       :: AlignableMap.T LAPEG.AltNum (LAPEG.Alt altDoc a)
    }
    deriving (Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall start varDoc altDoc a.
(Eq varDoc, Eq a, Eq altDoc) =>
Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
/= :: Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
$c/= :: forall start varDoc altDoc a.
(Eq varDoc, Eq a, Eq altDoc) =>
Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
== :: Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
$c== :: forall start varDoc altDoc a.
(Eq varDoc, Eq a, Eq altDoc) =>
Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
Eq, Int -> Context start varDoc altDoc a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall start varDoc altDoc a.
(Enum start, Show start, Show varDoc, Show a, Show altDoc) =>
Int -> Context start varDoc altDoc a -> ShowS
forall start varDoc altDoc a.
(Enum start, Show start, Show varDoc, Show a, Show altDoc) =>
[Context start varDoc altDoc a] -> ShowS
forall start varDoc altDoc a.
(Enum start, Show start, Show varDoc, Show a, Show altDoc) =>
Context start varDoc altDoc a -> String
showList :: [Context start varDoc altDoc a] -> ShowS
$cshowList :: forall start varDoc altDoc a.
(Enum start, Show start, Show varDoc, Show a, Show altDoc) =>
[Context start varDoc altDoc a] -> ShowS
show :: Context start varDoc altDoc a -> String
$cshow :: forall start varDoc altDoc a.
(Enum start, Show start, Show varDoc, Show a, Show altDoc) =>
Context start varDoc altDoc a -> String
showsPrec :: Int -> Context start varDoc altDoc a -> ShowS
$cshowsPrec :: forall start varDoc altDoc a.
(Enum start, Show start, Show varDoc, Show a, Show altDoc) =>
Int -> Context start varDoc altDoc a -> ShowS
Show, forall a b.
a -> Context start varDoc altDoc b -> Context start varDoc altDoc a
forall a b.
(a -> b)
-> Context start varDoc altDoc a -> Context start varDoc altDoc b
forall start varDoc altDoc a b.
a -> Context start varDoc altDoc b -> Context start varDoc altDoc a
forall start varDoc altDoc a b.
(a -> b)
-> Context start varDoc altDoc a -> Context start varDoc altDoc 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 -> Context start varDoc altDoc b -> Context start varDoc altDoc a
$c<$ :: forall start varDoc altDoc a b.
a -> Context start varDoc altDoc b -> Context start varDoc altDoc a
fmap :: forall a b.
(a -> b)
-> Context start varDoc altDoc a -> Context start varDoc altDoc b
$cfmap :: forall start varDoc altDoc a b.
(a -> b)
-> Context start varDoc altDoc a -> Context start varDoc altDoc b
Functor)

build :: Monad m
    => BuilderT start varDoc altDoc a m () -> m (LAPEG.T start varDoc altDoc a)
build :: forall (m :: * -> *) start varDoc altDoc a.
Monad m =>
BuilderT start varDoc altDoc a m () -> m (T start varDoc altDoc a)
build BuilderT start varDoc altDoc a m ()
builder = do
    Context start varDoc altDoc a
finalCtx <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT BuilderT start varDoc altDoc a m ()
builder forall {start} {varDoc} {altDoc} {a}. Context start varDoc altDoc a
initialCtx
    forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        LAPEG.LAPEG
            { $sel:initials:LAPEG :: EnumMap start VarNum
initials = forall start varDoc altDoc a.
Context start varDoc altDoc a -> EnumMap start VarNum
ctxInitials Context start varDoc altDoc a
finalCtx
            , $sel:rules:LAPEG :: T VarNum Rule
rules = forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do forall start varDoc altDoc a.
Context start varDoc altDoc a -> VarNum
ctxNextVarNum Context start varDoc altDoc a
finalCtx
                do forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum Rule
ctxRules Context start varDoc altDoc a
finalCtx
            , $sel:vars:LAPEG :: T VarNum (Var varDoc)
vars = forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do forall start varDoc altDoc a.
Context start varDoc altDoc a -> VarNum
ctxNextVarNum Context start varDoc altDoc a
finalCtx
                do forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxVars Context start varDoc altDoc a
finalCtx
            , $sel:alts:LAPEG :: T AltNum (Alt altDoc a)
alts = forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do forall start varDoc altDoc a.
Context start varDoc altDoc a -> AltNum
ctxNextAltNum Context start varDoc altDoc a
finalCtx
                do forall start varDoc altDoc a.
Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
ctxAlts Context start varDoc altDoc a
finalCtx
            }
    where
        initialCtx :: Context start varDoc altDoc a
initialCtx = Context
            { $sel:ctxInitials:Context :: EnumMap start VarNum
ctxInitials = forall k a. EnumMap k a
EnumMap.empty
            , $sel:ctxNextVarNum:Context :: VarNum
ctxNextVarNum = forall i. Alignable i => i
Alignable.initialAlign
            , $sel:ctxNextAltNum:Context :: AltNum
ctxNextAltNum = forall i. Alignable i => i
Alignable.initialAlign
            , $sel:ctxRules:Context :: T VarNum Rule
ctxRules = forall {k} (n :: k) a. Map n a
AlignableMap.empty
            , $sel:ctxVars:Context :: T VarNum (Var varDoc)
ctxVars = forall {k} (n :: k) a. Map n a
AlignableMap.empty
            , $sel:ctxAlts:Context :: T AltNum (Alt altDoc a)
ctxAlts = forall {k} (n :: k) a. Map n a
AlignableMap.empty
            }

genNewVar :: Monad m
    => PEG.Var varDoc -> BuilderT start varDoc altDoc a m LAPEG.VarNum
genNewVar :: forall (m :: * -> *) varDoc start altDoc a.
Monad m =>
Var varDoc -> BuilderT start varDoc altDoc a m VarNum
genNewVar Var varDoc
v = do
    VarNum
vn <- forall start varDoc altDoc a.
Context start varDoc altDoc a -> VarNum
ctxNextVarNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
        { $sel:ctxNextVarNum:Context :: VarNum
ctxNextVarNum = forall i. Alignable i => i -> i
Alignable.nextAlign VarNum
vn
        , $sel:ctxVars:Context :: T VarNum (Var varDoc)
ctxVars = forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
vn Var varDoc
v
            do forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxVars Context start varDoc altDoc a
ctx
        }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure VarNum
vn

genNewAlt :: Monad m
    => LAPEG.Alt altDoc a -> BuilderT start varDoc altDoc a m LAPEG.AltNum
genNewAlt :: forall (m :: * -> *) altDoc a start varDoc.
Monad m =>
Alt altDoc a -> BuilderT start varDoc altDoc a m AltNum
genNewAlt Alt altDoc a
alt = do
    AltNum
altn <- forall start varDoc altDoc a.
Context start varDoc altDoc a -> AltNum
ctxNextAltNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s. Monad m => StateT s m s
get
    forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
        { $sel:ctxNextAltNum:Context :: AltNum
ctxNextAltNum = forall i. Alignable i => i -> i
Alignable.nextAlign AltNum
altn
        , $sel:ctxAlts:Context :: T AltNum (Alt altDoc a)
ctxAlts = forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert AltNum
altn Alt altDoc a
alt
            do forall start varDoc altDoc a.
Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
ctxAlts Context start varDoc altDoc a
ctx
        }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure AltNum
altn

addInitial :: Monad m => Enum start
    => start -> LAPEG.VarNum -> BuilderT start varDoc altDoc a m ()
addInitial :: forall (m :: * -> *) start varDoc altDoc a.
(Monad m, Enum start) =>
start -> VarNum -> BuilderT start varDoc altDoc a m ()
addInitial start
i VarNum
v = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
    { $sel:ctxInitials:Context :: EnumMap start VarNum
ctxInitials = forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert start
i VarNum
v do forall start varDoc altDoc a.
Context start varDoc altDoc a -> EnumMap start VarNum
ctxInitials Context start varDoc altDoc a
ctx
    }

addRule :: Monad m
    => LAPEG.VarNum -> LAPEG.Rule -> BuilderT start varDoc altDoc a m ()
addRule :: forall (m :: * -> *) start varDoc altDoc a.
Monad m =>
VarNum -> Rule -> BuilderT start varDoc altDoc a m ()
addRule VarNum
v Rule
e = forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \Context start varDoc altDoc a
ctx -> Context start varDoc altDoc a
ctx
    { $sel:ctxRules:Context :: T VarNum Rule
ctxRules = forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
v Rule
e
        do forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum Rule
ctxRules Context start varDoc altDoc a
ctx
    }