module Main where

import Data.Bifunctor (Bifunctor (first))
import Data.Char (chr, ord)
import qualified Data.Vector.Unboxed.Mutable as UM
import Data.Word (Word8)
import System.Environment (getArgs)
import System.IO (IOMode (ReadMode), hGetContents, openFile)

data Instruction
  = IncPointer
  | DecPointer
  | IncByte
  | DecByte
  | OutByte
  | AccByte
  | Loop [Instruction]
  deriving (Show)

parseBf' :: String -> ([Instruction], String)
parseBf' ('>' : rest) = first (IncPointer :) (parseBf' rest)
parseBf' ('<' : rest) = first (DecPointer :) (parseBf' rest)
parseBf' ('+' : rest) = first (IncByte :) (parseBf' rest)
parseBf' ('-' : rest) = first (DecByte :) (parseBf' rest)
parseBf' ('.' : rest) = first (OutByte :) (parseBf' rest)
parseBf' (',' : rest) = first (AccByte :) (parseBf' rest)
parseBf' ('[' : rest) =
  let (parsed, next) = parseBf' rest
   in first (Loop (parsed) :) (parseBf' next)
parseBf' (']' : rest) = ([], rest)
parseBf' (_ : rest) = parseBf' rest
parseBf' [] = ([], "")

parseBf :: String -> [Instruction]
parseBf = fst . parseBf'

interpret :: [Instruction] -> UM.IOVector Word8 -> Int -> IO Int
interpret [] _ pointer = return pointer
interpret (IncPointer : rest) tape pointer = interpret rest tape (pointer + 1)
interpret (DecPointer : rest) tape pointer = interpret rest tape (pointer - 1)
interpret (IncByte : rest) tape pointer = do
  UM.modify tape (+ 1) pointer
  interpret rest tape pointer
interpret (DecByte : rest) tape pointer = do
  UM.modify tape (subtract 1) pointer
  interpret rest tape pointer
interpret (OutByte : rest) tape pointer = do
  UM.read tape pointer >>= putChar . chr . fromIntegral
  interpret rest tape pointer
interpret (AccByte : rest) tape pointer = do
  getChar >>= (return . fromIntegral . ord) >>= UM.write tape pointer
  interpret rest tape pointer
interpret (Loop instructions : rest) tape pointer = do
  pointer' <- looper pointer
  interpret rest tape pointer'
  where
    looper :: Int -> IO Int
    looper pointer' = do
      currentByte <- UM.read tape pointer'
      case currentByte of
        0 -> return pointer'
        _ -> do
          pointer'' <- interpret instructions tape pointer'
          looper pointer''

run :: String -> IO ()
run input = do
  initialTape <- UM.replicate 30000 0
  _ <- interpret (parseBf input) initialTape 0
  return ()

main :: IO ()
main = do
  args <- getArgs

  let path = args !! 0

  openFile path ReadMode >>= hGetContents >>= run