Simple pure BF interpreter

gistfile1.hs

import Data.Char(ord, chr)

data Tape = Tape [Int] Int [Int]
  deriving Show

getTape :: [Int] -> Tape
getTape (x:xs) = Tape [] x xs
getTape []     = Tape [] 0 []

modify :: (Int -> Int) -> Tape -> Tape
modify f (Tape ls x rs) = Tape ls (f x) rs

moveRight :: Tape -> Tape
moveRight (Tape (l:ls) x rs) = Tape ls l (x:rs)
moveRight (Tape   []   x rs) = Tape [] 0 (x:rs)

moveLeft :: Tape -> Tape
moveLeft (Tape ls x (r:rs)) = Tape (x:ls) r rs
moveLeft (Tape ls x   []  ) = Tape (x:ls) 0 []

data Env = Env Tape String
  deriving Show

charOut :: Env -> Env
charOut (Env t@(Tape _ x _) out) = Env t (chr x : out)

inEnv :: (Tape -> Tape) -> (Env -> Env)
inEnv f (Env tape out) = Env (f tape) out

step :: Char -> (Env -> Env)
step '+' = inEnv $ modify (+ 1)
step '-' = inEnv $ modify (subtract 1)
step '<' = inEnv $ moveRight
step '>' = inEnv moveLeft
step '.' = charOut
step  _  = inEnv id

getLoop :: String -> String -> (String, String)
getLoop (']': tail) body = (reverse body, tail)
getLoop ( x : tail) body = getLoop tail (x:body)
getLoop _ _ = error "Disbalanced loop"

runLoop :: String -> Env -> Env
runLoop body env@(Env (Tape _ 0 _) _) = env
runLoop body env = runLoop body $ runBF body env

runBF :: String -> Env -> Env
runBF ('[': code) = runBF tail . runLoop body
              where (body, tail) = getLoop code []
runBF (op : code) = runBF code . step op
runBF [] = id

src = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."

main =
	let (Env _ out) = runBF src $ Env (getTape []) ""
	in putStrLn (reverse out)