{-# LANGUAGE TemplateHaskell #-}
module Symantic.Parser
 ( module Symantic.Parser.Grammar
 --, module Symantic.Parser.Staging
 , module Symantic.Parser
 ) where
import Symantic.Parser.Grammar
import qualified Symantic.Parser.Staging as Hask

--import Prelude hiding (fmap, pure, (<*), (*>), (<*>), (<$>), (<$), pred, repeat)
import Data.Int (Int)
-- import Data.Char (Char)
import Prelude (undefined)
import Data.String (String)
import Text.Show (Show)
import Data.Eq (Eq)
-- import Control.Monad (liftM)
-- import Data.Char (isAlpha, isAlphaNum, isSpace, isUpper, isDigit, digitToInt, chr, ord)
-- import Data.Set (fromList, member)
-- import Data.Maybe (catMaybes)
-- import Text.Read (readMaybe)
import Language.Haskell.TH (TExpQ)

import qualified Prelude

{-
ee = pure id
e0 = e0 <* e0 <* e0
e1 = e1 <* e0
e2 = e2 <* e0
e3 = ee <* e1 <* e2
l0 = lets e0
l1 = lets e1
l2 = lets e2
l3 = lets e3
-}

data Expr = Var String | Num Int | Add Expr Expr deriving Show
data Asgn = Asgn String Expr deriving Show

data BrainFuckOp = RightPointer | LeftPointer | Increment | Decrement | Output | Input | Loop [BrainFuckOp] deriving (Show, Eq)

{-
cinput = m --try (string "aaa") <|> string "db" --(string "aab" <|> string "aac") --(char 'a' <|> char 'b') *> string "ab"
  where
    --m = match "ab" (lookAhead item) op empty
    --op 'a' = item $> runtime "aaaaa"
    --op 'b' = item $> runtime "bbbbb"
    m = bf <* item
    -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
    bf = match [char '>'] item op empty
    op (Hask.Runtime '>' _) = string ">"
-}

--defuncTest = runtime Just <$> (runtime (+) <$> (item $> runtime 1) <*> (item $> runtime 8))

-- manyTest = many (string "ab" $> (runtime 'c'))

--nfb = negLook (char 'a') <|> void (string "ab")

--skipManyInspect = skipMany (char 'a')

boom :: Applicable repr => repr ()
boom =
  let foo = (-- newRegister_ unit (\r0 ->
       let goo = (-- newRegister_ unit (\r1 ->
             let hoo = {-get r0 <~> get r1 *>-} goo *> hoo in hoo
            ) *> goo
       in goo) *> pure Hask.unit
  in foo *> foo

runtime :: a -> TExpQ a -> Hask.Runtime a
runtime e c = Hask.Runtime (Hask.Eval e) (Hask.Code c)

brainfuck ::
 forall repr.
 Applicable repr =>
 Charable repr =>
 Selectable repr =>
 Matchable repr =>
 Lookable repr =>
 Alternable repr =>
 Foldable repr =>
 repr [BrainFuckOp]
brainfuck = whitespace *> bf
  where
    whitespace = skipMany (noneOf "<>+-[],.$")
    lexeme :: repr a -> repr a
    lexeme p = p <* whitespace
    -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
    bf :: repr [BrainFuckOp]
    bf = many (lexeme (match ((\c -> runtime c [||c||]) Prelude.<$> "><+-.,[") (look item) op empty))
    -- op :: Pure repr Char -> repr BrainFuckOp
    op (Hask.Runtime (Hask.Eval c) _) = case c of
     '>' -> item $> runtime RightPointer [||RightPointer||]
     '<' -> item $> runtime LeftPointer  [||LeftPointer||]
     '+' -> item $> runtime Increment    [||Increment||]
     '-' -> item $> runtime Decrement    [||Decrement||]
     '.' -> item $> runtime Output       [||Output||]
     ',' -> item $> runtime Input        [||Input||]
     '[' -> between (lexeme item) (char ']') (runtime Loop [||Loop||] <$> bf)
     _ -> undefined