module Main where

import Data.Char
import Data.Sequence hiding (length, null, take, reverse, drop)
import System.Console.Haskeline
import System.Environment

name :: String
name = "brainfuck"

version :: String
version = "0.1.0"

prompt :: String
prompt = name ++ "> "

printUsage :: IO ()
printUsage = do printVersion
                putStrLn("\nUsage: " ++
                         "\n\twithout arguments  - runs REPL" ++
                         "\n\t-h/--help          - display this help message" ++
                         "\n\nMore information can be found on " ++
                         "https://github.com/hellerve/brainfuck")

printVersion :: IO ()
printVersion = putStrLn (name ++ " Version " ++ version)

printCommands :: IO ()
printCommands = putStrLn "Press Ctrl-C to exit interpreter"

program :: String -> String -> Seq Int -> Int -> IO ()
program _ "" _ _ = return ()
program i ('\n' : l) tape ptr = program i l tape ptr
program i (' ' : l) tape ptr = program i l tape ptr
program i ('>' : l) tape ptr = program i l tape (ptr+1)
program i ('<' : l) tape ptr = program i l tape (ptr-1)
program i ('+' : l) tape ptr = let newtape = update ptr ((index tape ptr) + 1) tape
                               in  program i l newtape ptr
program i ('-' : l) tape ptr = let newtape = update ptr ((index tape ptr) - 1) tape
                               in  program i l newtape ptr
program i ('.' : l) tape ptr = do putChar $ chr $ index tape ptr
                                  program i l tape ptr
program i (',' : l) tape ptr = do x <- getChar
                                  let newtape = update ptr (ord x) tape
                                  program i l newtape ptr
program i ('[' : l) tape ptr = if (index tape ptr) == 0
                                 then let x = findJump l 1
                                      in  program i x tape ptr
                                 else program i l tape ptr
    where findJump :: String -> Integer -> String
          findJump f 0         = f
          findJump ('[' : f) c = findJump f (c+1)
          findJump (']' : f) c = findJump f (c-1)
          findJump (_ : f) c   = findJump f c
          findJump "" _        = error "Loop brackets mismatched: too few closing"
program i (']' : l) tape ptr = if not ((index tape ptr) == 0)
                                 then let x = findJump (reverse (take (length i - length l - 1) i)) 1
                                      in  program i (drop (length x) i) tape ptr
                                 else program i l tape ptr
    where findJump :: String -> Integer -> String
          findJump f 0         = f
          findJump ('[' : f) c = findJump f (c-1)
          findJump (']' : f) c = findJump f (c+1)
          findJump (_ : f) c   = findJump f c
          findJump "" _        = error "Loop brackets mismatched: too many closing"
program _ (x : _) _ _ = putStrLn ("Unknown instruction: " ++ [x])

main :: IO ()
main = do
        args <- getArgs
        if null args
            then do printVersion
                    printCommands
                    putStrLn ""
                    repl
            else
                if(head args ==  "-h") || (head args == "--help")
                    then printUsage
                    else exec args

exec :: [String] -> IO ()
exec a = do x <- readFile (head a)
            let s = take (length x - 1) x
            program s s (zeroes 30000 empty) 0

getInput :: IO String
getInput = runInputT defaultSettings repl_
    where repl_ = do
          x <- getInputLine "> "
          case x of
            Nothing -> return ""
            Just i  -> return i

repl :: IO ()
repl = do input <- getInput
          case input of
            ""     -> repl
            "quit" -> putStrLn "Bye"
            x      -> do program x x (zeroes 30000 empty) 0
                         putStrLn ""
                         repl

zeroes :: Int -> Seq Int -> Seq Int
zeroes 0 l = l
zeroes n l = zeroes (n-1) (l |> 0)