module Language.Parser.Ptera.Machine.PEG.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.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
    { Context start varDoc altDoc a -> EnumMap start VarNum
ctxInitials   :: EnumMap.EnumMap start PEG.VarNum
    , Context start varDoc altDoc a -> VarNum
ctxNextVarNum :: PEG.VarNum
    , Context start varDoc altDoc a -> AltNum
ctxNextAltNum :: PEG.AltNum
    , Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxVars       :: AlignableMap.T PEG.VarNum (PEG.Var varDoc)
    , Context start varDoc altDoc a -> T VarNum Rule
ctxRules      :: AlignableMap.T PEG.VarNum PEG.Rule
    , Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
ctxAlts       :: AlignableMap.T PEG.AltNum (PEG.Alt altDoc a)
    }
    deriving (Context start varDoc altDoc a
-> Context start varDoc altDoc a -> Bool
(Context start varDoc altDoc a
 -> Context start varDoc altDoc a -> Bool)
-> (Context start varDoc altDoc a
    -> Context start varDoc altDoc a -> Bool)
-> Eq (Context start varDoc altDoc a)
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
[Context start varDoc altDoc a] -> ShowS
Context start varDoc altDoc a -> String
(Int -> Context start varDoc altDoc a -> ShowS)
-> (Context start varDoc altDoc a -> String)
-> ([Context start varDoc altDoc a] -> ShowS)
-> Show (Context start varDoc altDoc a)
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, a -> Context start varDoc altDoc b -> Context start varDoc altDoc a
(a -> b)
-> Context start varDoc altDoc a -> Context start varDoc altDoc b
(forall a b.
 (a -> b)
 -> Context start varDoc altDoc a -> Context start varDoc altDoc b)
-> (forall a b.
    a
    -> Context start varDoc altDoc b -> Context start varDoc altDoc a)
-> Functor (Context start varDoc altDoc)
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
<$ :: 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 :: (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 (PEG.T start varDoc altDoc a)
build :: 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 <- BuilderT start varDoc altDoc a m ()
-> Context start varDoc altDoc a
-> m (Context start varDoc altDoc a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT BuilderT start varDoc altDoc a m ()
builder Context start varDoc altDoc a
forall start varDoc altDoc a. Context start varDoc altDoc a
initialCtx
    T start varDoc altDoc a -> m (T start varDoc altDoc a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure do
        PEG :: forall start varDoc altDoc a.
T VarNum (Var varDoc)
-> T VarNum Rule
-> T AltNum (Alt altDoc a)
-> EnumMap start VarNum
-> PEG start varDoc altDoc a
PEG.PEG
            { $sel:initials:PEG :: EnumMap start VarNum
initials = Context start varDoc altDoc a -> EnumMap start VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> EnumMap start VarNum
ctxInitials Context start varDoc altDoc a
finalCtx
            , $sel:rules:PEG :: T VarNum Rule
rules = VarNum -> T VarNum Rule -> T VarNum Rule
forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do Context start varDoc altDoc a -> VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> VarNum
ctxNextVarNum Context start varDoc altDoc a
finalCtx
                do Context start varDoc altDoc a -> T VarNum Rule
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum Rule
ctxRules Context start varDoc altDoc a
finalCtx
            , $sel:vars:PEG :: T VarNum (Var varDoc)
vars = VarNum -> T VarNum (Var varDoc) -> T VarNum (Var varDoc)
forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do Context start varDoc altDoc a -> VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> VarNum
ctxNextVarNum Context start varDoc altDoc a
finalCtx
                do Context start varDoc altDoc a -> T VarNum (Var varDoc)
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum (Var varDoc)
ctxVars Context start varDoc altDoc a
finalCtx
            , $sel:alts:PEG :: T AltNum (Alt altDoc a)
alts = AltNum -> T AltNum (Alt altDoc a) -> T AltNum (Alt altDoc a)
forall n a. T n => n -> T n a -> Array n a
AlignableArray.fromTotalMap
                do Context start varDoc altDoc a -> AltNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> AltNum
ctxNextAltNum Context start varDoc altDoc a
finalCtx
                do Context start varDoc altDoc a -> T AltNum (Alt altDoc a)
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 :: forall start varDoc altDoc a.
EnumMap start VarNum
-> VarNum
-> AltNum
-> T VarNum (Var varDoc)
-> T VarNum Rule
-> T AltNum (Alt altDoc a)
-> Context start varDoc altDoc a
Context
            { $sel:ctxInitials:Context :: EnumMap start VarNum
ctxInitials = EnumMap start VarNum
forall k a. EnumMap k a
EnumMap.empty
            , $sel:ctxNextVarNum:Context :: VarNum
ctxNextVarNum = VarNum
forall i. Alignable i => i
Alignable.initialAlign
            , $sel:ctxNextAltNum:Context :: AltNum
ctxNextAltNum = AltNum
forall i. Alignable i => i
Alignable.initialAlign
            , $sel:ctxRules:Context :: T VarNum Rule
ctxRules = T VarNum Rule
forall k (n :: k) a. Map n a
AlignableMap.empty
            , $sel:ctxVars:Context :: T VarNum (Var varDoc)
ctxVars = T VarNum (Var varDoc)
forall k (n :: k) a. Map n a
AlignableMap.empty
            , $sel:ctxAlts:Context :: T AltNum (Alt altDoc a)
ctxAlts = T AltNum (Alt altDoc a)
forall k (n :: k) a. Map n a
AlignableMap.empty
            }

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

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

addInitial :: Monad m => Enum start
    => start -> PEG.VarNum -> BuilderT start varDoc altDoc a m ()
addInitial :: start -> VarNum -> BuilderT start varDoc altDoc a m ()
addInitial start
i VarNum
v = (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> BuilderT start varDoc altDoc a m ()
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 = start -> VarNum -> EnumMap start VarNum -> EnumMap start VarNum
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EnumMap.insert start
i VarNum
v do Context start varDoc altDoc a -> EnumMap start VarNum
forall start varDoc altDoc a.
Context start varDoc altDoc a -> EnumMap start VarNum
ctxInitials Context start varDoc altDoc a
ctx
    }

addRule :: Monad m
    => PEG.VarNum -> PEG.Rule -> BuilderT start varDoc altDoc a m ()
addRule :: VarNum -> Rule -> BuilderT start varDoc altDoc a m ()
addRule VarNum
v Rule
e = (Context start varDoc altDoc a -> Context start varDoc altDoc a)
-> BuilderT start varDoc altDoc a m ()
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 = VarNum -> Rule -> T VarNum Rule -> T VarNum Rule
forall n a. T n => n -> a -> Map n a -> Map n a
AlignableMap.insert VarNum
v Rule
e
        do Context start varDoc altDoc a -> T VarNum Rule
forall start varDoc altDoc a.
Context start varDoc altDoc a -> T VarNum Rule
ctxRules Context start varDoc altDoc a
ctx
    }