{-# LANGUAGE CPP #-}

module Language.Lexer.Tlex.Plugin.TH (
    TlexTH.TlexContext (..),
    TlexTH.TlexResult (..),
    TlexTH.Runner (..),
    TlexTH.runRunner,
    THScanner (..),
    THScannerBuilderContext,
    THScannerBuilder,
    buildTHScanner,
    buildTHScannerWithReify,
    liftTlexScannerBuilder,
    thLexRule,
    outputScanner,
) where

import           Language.Lexer.Tlex.Prelude

import qualified Language.Haskell.TH                      as TH
import qualified Language.Lexer.Tlex.Data.TypeableTH      as TypeableTH
import qualified Language.Lexer.Tlex.Machine.NFA          as NFA
import qualified Language.Lexer.Tlex.Output.TH            as TlexTH
import qualified Language.Lexer.Tlex.Pipeline.MinDfa      as TlexPipeline
import qualified Language.Lexer.Tlex.Pipeline.Nfa2Dfa     as TlexPipeline
import qualified Language.Lexer.Tlex.Pipeline.Scanner2Nfa as TlexPipeline
import qualified Language.Lexer.Tlex.Syntax               as Tlex

#ifdef DEBUG
import qualified Debug.Trace                              as Debug
#endif


data THScanner e = THScanner
    { forall e. THScanner e -> OutputContext
thScannerOutputCtx   :: TlexTH.OutputContext
    , forall e. THScanner e -> Scanner e (Q Exp)
thScannerTlexScanner :: Tlex.Scanner e (TH.Q TH.Exp)
    }

data THScannerBuilderContext s e a = THScannerBuilderContext
    { forall {k} {k} (s :: k) e (a :: k).
THScannerBuilderContext s e a -> OutputContext
thScannerBuilderCtxOutputCtx :: TlexTH.OutputContext
    , forall {k} {k} (s :: k) e (a :: k).
THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx :: Tlex.ScannerBuilderContext s e (TH.Q TH.Exp)
    }

type THScannerBuilder s e a = State (THScannerBuilderContext s e a)

buildTHScanner :: forall e s a. Enum e => Bounded e
    => TH.Type -> TH.Type -> TH.Type -> THScannerBuilder s e a ()
    -> THScanner e
buildTHScanner :: forall {k} {k} e (s :: k) (a :: k).
(Enum e, Bounded e) =>
Type -> Type -> Type -> THScannerBuilder s e a () -> THScanner e
buildTHScanner Type
codeUnitTy Type
startStateTy Type
actionTy THScannerBuilder s e a ()
builder =
    let outputCtx :: OutputContext
outputCtx = TlexTH.OutputContext
            { $sel:outputCtxStartStateTy:OutputContext :: Type
outputCtxStartStateTy = Type
startStateTy
            , $sel:outputCtxCodeUnitTy:OutputContext :: Type
outputCtxCodeUnitTy = Type
codeUnitTy
            , $sel:outputCtxCodeUnitBounds:OutputContext :: (Int, Int)
outputCtxCodeUnitBounds = (
                forall a. Enum a => a -> Int
fromEnum do forall a. Bounded a => a
minBound @e,
                forall a. Enum a => a -> Int
fromEnum do forall a. Bounded a => a
maxBound @e
            )
            , $sel:outputCtxSemanticActionTy:OutputContext :: Type
outputCtxSemanticActionTy = Type
actionTy
            }
        tlexScanner :: Scanner e (Q Exp)
tlexScanner = forall {k} e (s :: k) f.
Enum e =>
ScannerBuilder s e f () -> Scanner e f
Tlex.buildScanner do
            forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify' \ScannerBuilderContext s e (Q Exp)
ctx0 -> forall {k} {k} (s :: k) e (a :: k).
THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx
                do forall s a. State s a -> s -> s
execState THScannerBuilder s e a ()
builder do
                    THScannerBuilderContext
                        { $sel:thScannerBuilderCtxOutputCtx:THScannerBuilderContext :: OutputContext
thScannerBuilderCtxOutputCtx = OutputContext
outputCtx
                        , $sel:thScannerBuilderCtxTlexScannerBuilderCtx:THScannerBuilderContext :: ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx = ScannerBuilderContext s e (Q Exp)
ctx0
                        }
    in THScanner
        { $sel:thScannerOutputCtx:THScanner :: OutputContext
thScannerOutputCtx = OutputContext
outputCtx
        , $sel:thScannerTlexScanner:THScanner :: Scanner e (Q Exp)
thScannerTlexScanner = Scanner e (Q Exp)
tlexScanner
        }

buildTHScannerWithReify :: forall s a e.
    Enum e => Bounded e => Typeable e => Typeable s => Typeable a
    => THScannerBuilder s e a () -> TH.Q (THScanner e)
buildTHScannerWithReify :: forall {k} {k} (s :: k) (a :: k) e.
(Enum e, Bounded e, Typeable e, Typeable s, Typeable a) =>
THScannerBuilder s e a () -> Q (THScanner e)
buildTHScannerWithReify THScannerBuilder s e a ()
builder = do
    Type
startStateTy <- forall {k} (a :: k). Typeable a => Proxy a -> Q Type
TypeableTH.liftTypeFromTypeable do forall {k} (t :: k). Proxy t
Proxy @s
    Type
codeUnitTy <- forall {k} (a :: k). Typeable a => Proxy a -> Q Type
TypeableTH.liftTypeFromTypeable do forall {k} (t :: k). Proxy t
Proxy @e
    Type
actionTy <- forall {k} (a :: k). Typeable a => Proxy a -> Q Type
TypeableTH.liftTypeFromTypeable do forall {k} (t :: k). Proxy t
Proxy @a
    forall (f :: * -> *) a. Applicative f => a -> f a
pure do forall {k} {k} e (s :: k) (a :: k).
(Enum e, Bounded e) =>
Type -> Type -> Type -> THScannerBuilder s e a () -> THScanner e
buildTHScanner Type
codeUnitTy Type
startStateTy Type
actionTy THScannerBuilder s e a ()
builder

liftTlexScannerBuilder :: Enum e => Tlex.ScannerBuilder s e (TH.Q TH.Exp) a -> THScannerBuilder s e f a
liftTlexScannerBuilder :: forall {k} {k} e (s :: k) a (f :: k).
Enum e =>
ScannerBuilder s e (Q Exp) a -> THScannerBuilder s e f a
liftTlexScannerBuilder ScannerBuilder s e (Q Exp) a
builder = do
    THScannerBuilderContext s e f
ctx0 <- forall (m :: * -> *) s. Monad m => StateT s m s
get
    let (a
x, ScannerBuilderContext s e (Q Exp)
tlexCtx1) = forall s a. State s a -> s -> (a, s)
runState
            do ScannerBuilder s e (Q Exp) a
builder
            do forall {k} {k} (s :: k) e (a :: k).
THScannerBuilderContext s e a -> ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx THScannerBuilderContext s e f
ctx0
    forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put do THScannerBuilderContext s e f
ctx0
            { $sel:thScannerBuilderCtxTlexScannerBuilderCtx:THScannerBuilderContext :: ScannerBuilderContext s e (Q Exp)
thScannerBuilderCtxTlexScannerBuilderCtx = ScannerBuilderContext s e (Q Exp)
tlexCtx1
            }
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

thLexRule :: Enum e => Enum s => [s] -> Tlex.Pattern e -> TH.Code TH.Q a -> THScannerBuilder s e a ()
thLexRule :: forall e s a.
(Enum e, Enum s) =>
[s] -> Pattern e -> Code Q a -> THScannerBuilder s e a ()
thLexRule [s]
ss Pattern e
p Code Q a
act = forall {k} {k} e (s :: k) a (f :: k).
Enum e =>
ScannerBuilder s e (Q Exp) a -> THScannerBuilder s e f a
liftTlexScannerBuilder do forall s e f.
(Enum s, Enum e) =>
[s] -> Pattern e -> f -> ScannerBuilder s e f ()
Tlex.lexRule [s]
ss Pattern e
p do forall a (m :: * -> *). Quote m => Code m a -> m Exp
TH.unTypeCode Code Q a
act


outputScanner :: Enum e => THScanner e -> TH.Q [TH.Dec]
outputScanner :: forall e. Enum e => THScanner e -> Q [Dec]
outputScanner THScanner e
scanner =
    let outputCtx :: OutputContext
outputCtx = forall e. THScanner e -> OutputContext
thScannerOutputCtx THScanner e
scanner
        nfa :: NFA (Q Exp)
nfa =
#ifdef DEBUG
            Debug.trace "building NFA..." do
#endif
            forall m. NFABuilder m () -> NFA m
NFA.buildNFA do
                forall e m. Enum e => Scanner e m -> NFABuilder m ()
TlexPipeline.scanner2Nfa do forall e. THScanner e -> Scanner e (Q Exp)
thScannerTlexScanner THScanner e
scanner
        dfa :: DFA (Q Exp)
dfa =
#ifdef DEBUG
            Debug.trace "building DFA..." do
#endif
            forall a. NFA a -> DFA a
TlexPipeline.nfa2Dfa NFA (Q Exp)
nfa
        minDfa :: DFA (Q Exp)
minDfa =
#ifdef DEBUG
            Debug.trace "minizing DFA..." do
#endif
            forall a. DFA a -> DFA a
TlexPipeline.minDfa DFA (Q Exp)
dfa
    in
#ifdef DEBUG
        Debug.trace "outputing DFA..." do
#endif
        OutputContext -> DFA (Q Exp) -> Q [Dec]
TlexTH.outputDfa OutputContext
outputCtx DFA (Q Exp)
minDfa