module Parser where

import Base

import Data.String (fromString)
import Control.Applicative
import qualified Data.Text as T

data ASTNode = MoveRight
         | MoveLeft
         | Increment
         | Decrement
         | Replace
         | Print
         | Loop ASTNode

flattenAST :: [ASTNode] -> [BFAction]
flattenAST = concatMap f
  where
    f (Loop x) = [JumpLeft] ++ process x ++ [JumpRight]
    f x = [x]

data ParserError
  = EndOfInput
  | UnexpectedSymbol Char
  | Empty
  deriving (Eq, Show)

newtype Parser a = Parser
                 { runParser :: T.Text -> Either [ParserError] (a, T.Text)
                 }

instance Functor Parser where
  fmap f (Parser x) = Parser run
    where
      run input = case x input of
        Left err -> Left err
        Right (out, res) -> Right (f out, rest)

instance Applicative Parser where
  pure a = Parser $ \input -> Right (a, input)
  Parser x <*> Parser y = Parser run
    where
      run input = case x input of
        Left err -> Left err
        Right (x', rest) -> case y rest of
          Left err -> Left err
          Right (y', rest') -> Right (x' y', rest')

instance Monad Parser where
  return = pure
  Parser x >>= y = Parser run
    where
      run input = case x input of
        Left err -> Left err
        Right (out, rest) ->
          let Parser x' = y out in x' rest

instance Alternative Parser where
  empty = Parser $ \_ -> Left [Empty]
  Parser x <|> Parser y = Parser run
    where
      run input = case x input of
        Right (out, rest) -> Right (out, rest)
        Left err -> case y input of
          Right (out, rest) -> Right (out, rest)
          Left err' -> Left err <> err'

satisfy :: (Char -> Bool) -> Parser T.Text
satisfy p = Parser run
  where
    run "" = Left [EndOfInput]
    run (x : rest) = if p x then Right (x, rest) else Left [UnexpectedSymbol x]

char :: Char -> Parser T.Text
char c = satisfy (== c)

string :: T.Text -> Parser T.Text
string (x:xs) = do
  y <- char x
  ys <- string xs
  return $ T.append x ys