{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module Parsers.Brainfuck.SymanticParser.Grammar where

import Data.Char (Char)
import Data.Function ((.))
import qualified Language.Haskell.TH.Syntax as TH
import qualified Prelude
import Data.Functor.Product (Product(..))

import Symantic.Typed.Trans
import qualified Symantic.Parser as SP

import Parsers.Utils
import Parsers.Brainfuck.Types

-- | Use with @$$(runParser @Text grammar)@,
-- but in another Haskell module to avoid
-- GHC stage restriction on such top-level splice.
grammar :: forall tok repr.
  CoerceEnum Char tok =>
  CoerceEnum tok Char =>
  SP.Grammarable tok repr =>
  repr [Instruction]
grammar = whitespace SP.*> bf
  where
  whitespace = SP.skipMany (SP.noneOf (coerceEnum @_ @tok Prelude.<$> "<>+-,.[]"))
  lexeme :: repr a -> repr a
  lexeme p = p SP.<* whitespace
  bf :: repr [Instruction]
  bf = SP.many (lexeme (SP.match (SP.look (SP.item @tok))
                               (SP.prod . coerceEnum Prelude.<$> "<>+-,.[")
                               op SP.empty))
  op :: SP.Production tok -> repr Instruction
  op prod = case coerceEnum (SP.runValue prod) of
    '<' -> SP.item @tok SP.$> SP.prod Backward
    '>' -> SP.item @tok SP.$> SP.prod Forward
    '+' -> SP.item @tok SP.$> SP.prod Increment
    '-' -> SP.item @tok SP.$> SP.prod Decrement
    ',' -> SP.item @tok SP.$> SP.prod Input
    '.' -> SP.item @tok SP.$> SP.prod Output
    '[' -> SP.between (lexeme (SP.item @tok))
                      (SP.token (coerceEnum @_ @tok ']'))
                      ($(SP.prodCon 'Loop) SP.<$> bf)
    _ -> Prelude.undefined

reproGrammar :: forall tok repr.
  CoerceEnum Char tok =>
  CoerceEnum tok Char =>
  SP.Grammarable tok repr =>
  repr [tok]
reproGrammar = SP.many (SP.item @tok)