import qualified Control.Exception as E
import Control.Monad
import Data.Array.IO
import Data.Char
import Data.IORef
import qualified Data.Map as M
import Data.Word
import System.Environment
import Data.Maybe (fromJust)
import qualified Text.ParserCombinators.Parsec as P

data Exp = Back | Forward | Minus | Plus | In | Out | Loop [Exp]
data State = State (IORef Int) (IOArray Int Word8)

modifyArray :: (Ix i) => IOArray i e -> i -> (e -> e) -> IO ()
modifyArray array index f = do
  old <- readArray array index
  writeArray array index (f old)

eval :: Exp -> State -> IO ()

eval Back (State ptr _) = modifyIORef ptr (subtract 1)
eval Forward (State ptr _) = modifyIORef ptr (+1)

eval Minus (State ptr tape) = do
  curptr <- readIORef ptr
  modifyArray tape curptr (subtract 1)

eval Plus (State ptr tape) = do
  curptr <- readIORef ptr
  modifyArray tape curptr (+1)

eval In (State ptr tape) = do
  curptr <- readIORef ptr
  char <- getChar `E.catch` ((\_ -> return '\xFF') :: E.IOException -> IO Char)
  writeArray tape curptr $ fromIntegral $ ord char

eval Out (State ptr tape) = do
  curptr <- readIORef ptr
  char <- readArray tape curptr
  putChar $ chr $ fromIntegral char

eval exp@(Loop body) st@(State ptr tape) = do
  curptr <- readIORef ptr
  val <- readArray tape curptr
  when (val /= 0) $ do
    sequence $ map (flip eval st) body
    eval exp st

simpleOps = M.fromList [
  ('<', Back),
  ('>', Forward),
  ('-', Minus),
  ('+', Plus),
  (',', In),
  ('.', Out)]

parse :: String -> [Exp]
parse str = case P.parse (P.many statement) "" str of
                Right x -> x
                Left x -> error $ "b0rk: " ++ (show x)

statement :: P.Parser Exp
statement = P.try (do op <- P.oneOf "<>.,+-"
                      return (fromJust $ M.lookup op simpleOps))
            P.<|>
            do P.char '['
               res <- P.many statement
               P.char ']'
               return $ Loop res

main :: IO ()

main = do
  [pfile] <- getArgs
  code <- readFile pfile
  let exps = parse code
  ptr <- newIORef 0
  tape <- newArray (0, 4096) 0
  sequence_ $ map (flip eval (State ptr tape)) exps