{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TemplateHaskell #-}
module Golden.Grammar where

import Control.Monad (Monad(..))
import Data.Either (Either(..))
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Int (Int)
import Data.Semigroup (Semigroup(..))
import Data.String (String)
import Data.String (String, IsString(..))
import Language.Haskell.TH (TExpQ)
import Prelude (undefined)
import System.IO (IO, FilePath)
import Test.Tasty
import Test.Tasty.Golden
import Text.Show (Show)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import qualified Prelude

import Symantic.Parser
import qualified Symantic.Parser.Staging as Hask

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 $> haskell "aaaaa"
    --op 'b' = item $> haskell "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.ValueCode '>' _) = string ">"
-}

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

-- manyTest = many (string "ab" $> (haskell '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

haskell :: a -> TExpQ a -> Hask.Haskell a
haskell e c = Hask.Haskell (Hask.ValueCode (Hask.Value e) (Hask.Code c))

brainfuck :: Grammar repr => repr [BrainFuckOp]
brainfuck = whitespace *> bf
  where
    whitespace = skipMany (noneOf "<>+-[],.$")
    lexeme p = p <* whitespace
    -- match :: Eq a => [Pure repr a] -> repr a -> (Pure repr a -> repr b) -> repr b -> repr b
    bf = many (lexeme (match ((\c -> haskell c [||c||]) Prelude.<$> "><+-.,[") (look item) op empty))
    -- op :: Pure repr Char -> repr BrainFuckOp
    op (Hask.Haskell (Hask.ValueCode (Hask.Value c) _)) = case c of
     '>' -> item $> haskell RightPointer [||RightPointer||]
     '<' -> item $> haskell LeftPointer  [||LeftPointer||]
     '+' -> item $> haskell Increment    [||Increment||]
     '-' -> item $> haskell Decrement    [||Decrement||]
     '.' -> item $> haskell Output       [||Output||]
     ',' -> item $> haskell Input        [||Input||]
     '[' -> between (lexeme item) (char ']') (haskell Loop [||Loop||] <$> bf)
     _ -> undefined
    op _ = undefined