{-# LANGUAGE UndecidableInstances #-}

module Language.Parser.Ptera.TH.Pipeline.Grammar2ParserDec where

import           Language.Parser.Ptera.Prelude

import qualified Language.Haskell.TH                             as TH
import qualified Language.Parser.Ptera.Pipeline.SafeGrammar2SRB  as SafeGrammar2SRB
import qualified Language.Parser.Ptera.TH.Pipeline.SRB2ParserDec as SRB2ParserDec
import qualified Language.Parser.Ptera.TH.Syntax                 as Syntax
import qualified Type.Membership                                 as Membership

grammar2ParserDec
    :: forall initials rules tokens ctx elem
    .  Syntax.GrammarToken tokens elem
    => Membership.Generate (Syntax.TokensTag tokens)
    => PipelineParam
    -> Syntax.GrammarM ctx rules tokens elem initials
    -> TH.Q [TH.Dec]
grammar2ParserDec :: forall (initials :: [Symbol]) rules tokens ctx elem.
(GrammarToken tokens elem, Generate (TokensTag tokens)) =>
PipelineParam -> GrammarM ctx rules tokens elem initials -> Q [Dec]
grammar2ParserDec PipelineParam
param GrammarM ctx rules tokens elem initials
g = do
    T Int String (Maybe ()) (Action (SemActM ctx))
srb <- case forall (action :: [*] -> * -> *) rules tokens elem
       (initials :: [Symbol]).
T action rules tokens elem initials
-> Either [String] (T Int String (Maybe ()) (Action action))
SafeGrammar2SRB.safeGrammar2Srb GrammarM ctx rules tokens elem initials
g of
        Right T Int String (Maybe ()) (Action (SemActM ctx))
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure T Int String (Maybe ()) (Action (SemActM ctx))
x
        Left [String]
vs -> do
            let errorMsg :: String
errorMsg = String
"Failed to generate parser.  "
                    forall a. Semigroup a => a -> a -> a
<> String
"Detect left recursions at " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [String]
vs forall a. Semigroup a => a -> a -> a
<> String
"."
            forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMsg
    forall altDoc ctx.
PipelineParam
-> T Int String (Maybe altDoc) (SemanticAction ctx) -> Q [Dec]
SRB2ParserDec.srb2QParser
        do SRB2ParserDec.PipelineParam
            {
                $sel:startsTy:PipelineParam :: Q Type
startsTy = PipelineParam -> Q Type
startsTy PipelineParam
param,
                $sel:rulesTy:PipelineParam :: Q Type
rulesTy = PipelineParam -> Q Type
rulesTy PipelineParam
param,
                $sel:tokensTy:PipelineParam :: Q Type
tokensTy = PipelineParam -> Q Type
tokensTy PipelineParam
param,
                $sel:tokenTy:PipelineParam :: Q Type
tokenTy = PipelineParam -> Q Type
tokenTy PipelineParam
param,
                $sel:customCtxTy:PipelineParam :: Q Type
customCtxTy = PipelineParam -> Q Type
customCtxTy PipelineParam
param,
                $sel:tokenBounds:PipelineParam :: (Int, Int)
tokenBounds =
                    ( Int
0
                    , forall k (xs :: [k]) (proxy :: [k] -> *).
Generate xs =>
proxy xs -> Int
Membership.hcount do forall {k} (t :: k). Proxy t
Proxy @(Syntax.TokensTag tokens)
                    )
            }
        do T Int String (Maybe ()) (Action (SemActM ctx))
srb

data PipelineParam = PipelineParam
    {
        PipelineParam -> Q Type
startsTy    :: TH.Q TH.Type,
        PipelineParam -> Q Type
rulesTy     :: TH.Q TH.Type,
        PipelineParam -> Q Type
tokensTy    :: TH.Q TH.Type,
        PipelineParam -> Q Type
tokenTy     :: TH.Q TH.Type,
        PipelineParam -> Q Type
customCtxTy :: TH.Q TH.Type
    }