content: {-# LANGUAGE DeriveAnyClass, DeriveGeneric, TypeFamilies, QuasiQuotes
      , DataKinds, ScopedTypeVariables, OverloadedStrings, TypeSynonymInstances
      , FlexibleInstances, UndecidableInstances, DeriveDataTypeable
      , TemplateHaskell #-}
  {-|
    Module      : Language.ANTLR4.Parser
    Description : Core G4 quasiquoter (with parsers) for antlr-haskell
    Copyright   : (c) Karl Cronburg, 2019
    License     : BSD3
    Maintainer  : karl@cs.tufts.edu
    Stability   : experimental
    Portability : POSIX
  
  -}
  module Language.ANTLR4.Parser (g4) where
  
  import Control.Arrow ( (&&&) )
  import Data.Char (isUpper)
  
  import Text.ANTLR.Common
  import Text.ANTLR.Grammar
  import Text.ANTLR.Parser
  import qualified Text.ANTLR.LR as LR
  import Text.ANTLR.Lex.Tokenizer as T hiding (tokenize)
  import qualified Text.ANTLR.Set as S
  import Text.ANTLR.Set (Hashable(..), Generic(..))
  import Text.ANTLR.Pretty
  import Text.ANTLR.Lex.Regex (regex2dfa)
  import Data.Data (Data(..))
  import Language.Haskell.TH.Lift (Lift(..))
  
  import Language.Haskell.TH.Quote (QuasiQuoter(..))
  import qualified Language.Haskell.TH as TH
  import Language.ANTLR4.Boot.Quote (antlr4, g4_parsers)
  import Language.ANTLR4.Syntax
  import qualified Language.ANTLR4.Boot.Syntax  as G4S
  import qualified Language.ANTLR4.Boot.Quote   as G4Q
  import Language.ANTLR4.G4
  
  import Debug.Trace as D
  
  -- Splice the parsers for the grammar we defined in Language.ANTLR4.G4
  $(g4_parsers g4AST g4Grammar)
  
  {- isWhitespace (Just T_LineComment) = True
  isWhitespace (Just T_WS) = True
  isWhitespace Nothing = True
  isWhitespace _ = False -}
  
  isWhitespace T_LineComment = True
  isWhitespace T_WS = True
  isWhitespace _ = False
  
  g4_codeGen :: String -> TH.Q [TH.Dec]
  g4_codeGen input = do
    loc <- TH.location
    let fileName = TH.loc_filename loc
    let (line,column) = TH.loc_start loc
  
    {- case allstarParse (filter (not . isWhitespace . stripEOF . getSymbol) (tokenize input)) of
      Left err -> error err
      Right ast -> codeGen ast -}
    case glrParse isWhitespace input of
      (LR.ResultAccept ast) -> codeGen ast
      LR.ResultSet    s   ->
        if S.size s == 1
          then codeGen $ fromAccept (S.findMin s)
          else D.trace (pshow' s) $ codeGen $ fromAccept (S.findMin s)
      err -> error $ pshow' err
  
  fromAccept (LR.ResultAccept ast) = ast
  fromAccept err = error $ pshow' err
  
  codeGen ast = G4Q.g4_decls $ ast2decls ast
  
  -- | Entrypoint to the G4 quasiquoter. Currently only supports declaration-level
  --   Haskell generation of G4 grammars using a GLR parser. The output grammars
  --   need not use a GLR parser themselves.
  g4 :: QuasiQuoter
  g4 = QuasiQuoter
    (error "parse exp")
    (error "parse pattern")
    (error "parse type")
    g4_codeGen
  
  