-- pop is a head that defaults to zero
pop :: (Integral a) => [a] -> a
pop [] = 0
pop (x:_) = x
-- rest is a tail for pop
rest :: (Integral a) => [a] -> [a]
rest [] = []
rest (_:x) = x
-- topadd adds an Integer to the top of a [Integer]
topadd :: [Integer] -> Integer -> [Integer]
topadd [] x = [x]
topadd (a:[]) x = [a+x]
topadd (a:b) x = (a+x):b
-- ir is a helper function of interior
ir :: [Char]String -> Integer -> [Char]String
ir x 0 = ""
ir ('{':x) y = "{" ++ (ir x (y+1))
ir ('}':x) y = "}" ++ (ir x (y-1))
ir (a:x) y = [a] ++ (ir x y )
-- interior finds the inside of a loop {x}... -> x
interior :: [Char]String -> [Char]String
interior x = init (ir x 1)
-- ex is a helper function for exterior
ex :: [Char]String -> Integer -> [Char]String
ex x 0 = x
ex ('{':x) y = ex x (y+1)
ex ('}':x) y = ex x (y-1)
ex (a:x) y = ex x y
-- exterior finds all the code after a loop {...}x -> x
exterior :: [Char]String -> [Char]String
exterior x = ex x 1
-- bf is the implementation of brain-flak
bf :: [Char]String -> ([Integer],[Integer],[Integer]) -> ([Integer],[Integer],[Integer])
bf [] (x,y,z)= (x,y,z)
bf ('(':')':a) (x,y,z)= bf a (x,y,((pop z+1):rest z))
bf ('<':'>':a) (x,y,z)= bf a (y,x,z)
bf ('{':'}':a) (x,y,z)= bf a ((rest x),y,(topadd z (pop x)))
bf ('[':']':a) (x,y,z)= bf a (x,y,(topadd z (toInteger (length x))))
bf ('(':a) (x,y,z)= bf a (x,y,(0:z))
bf ('<':a) (x,y,z)= bf a (x,y,(0:z))
bf ('[':a) (x,y,z)= bf a (x,y,(0:z))
bf (')':a) (x,y,(h:z))= bf a ((h:x),y,(topadd z h))
bf (']':a) (x,y,(h:z))= bf a (x,y,(topadd z (-h)))
bf ('>':a) (x,y,(_:z))= bf a (x,y,z)
bf ('{':a) t = bf (exterior a) (loop (interior a) t)
bf (_:a) t = bf a t
-- loop runs the same code until the TOS is zero
loop :: [Char]String -> ([Integer],[Integer],[Integer]) -> ([Integer],[Integer],[Integer])
loop s ([],y,z) = ([],y,z)
loop s (0:x,y,z) = (0:x,y,z)
loop s x = loop s (bf s x)
-- first finds the first element of a 3 tuple
first :: (a,b,c) -> a
first (a,_,_) = a
-- bl is an helper function of balance
bl :: [Char]String -> [Char]String -> Bool
bl [] [] = True
bl [] _ = False
bl ('(':x) y = bl x (')':y)
bl ('[':x) y = bl x (']':y)
bl ('<':x) y = bl x ('>':y)
bl ('{':x) y = bl x ('}':y)
bl _ [] = False
bl (a:x) (b:y) = (a == b) && (bl x y)
-- balanced checks if a particular String is balanced
balanced :: [Char]String -> Bool
balanced x = bl x []
-- Implements Brain-Flak
brainflak :: [Char]String -> [Integer] -> [Integer]
brainflak s x
| balanced source = first(\(a,_,_) -> a) (bf source (x,[],[]))
| otherwise = error "Unbalanced braces."
where source = [a|a <- s, elem a "()[]<>{}"]
