Haskell implementation of Calculator

hs-calculator.hs

import Data.List (isPrefixOf, sortBy)
import Data.Ord (comparing)
import Data.Vector.Unboxed (Vector, empty, snoc, (!?))
import qualified Data.Vector.Unboxed as V (length)

type BinaryOperator = Double -> Double -> Double

data BinOp = BinOp { name :: String, f :: BinaryOperator, prec :: Int }

main :: IO ()
main = let ops = [BinOp "*" (*) 7, BinOp "+" (+) 6, BinOp "/" (/) 7, BinOp "-" (-) 6]
       in print $ calc ops "4 / (10 - (1 + 3) * 2)"

tokenizer :: [String] -> String -> [String]
tokenizer ops = filter (/= "") . splitter [] "" . deleteWhiteSpace
    where
        operators :: [String]
        operators = "(" : ")" : ops

        deleteWhiteSpace :: String -> String
        deleteWhiteSpace = concat . words

        splitter :: [String] -> String -> String -> [String]
        splitter storage tmp "" = reverse (tmp:storage)
        splitter storage tmp str@(c:cs) = 
            case filter (`isPrefixOf` str) operators of
                [] -> splitter storage (c:tmp) cs
                op:_ -> splitter (op : reverse tmp : storage) "" (drop (length op) str)

calc :: [BinOp] -> String -> Maybe Double
calc ops = parse empty . tokenizer (map name ops)
    where
        operators :: [BinOp]
        operators = sortBy (comparing prec) ops

        tokenToDouble :: Vector Double -> String -> Maybe Double
        tokenToDouble holder x = 
            case reads x :: [(Double, String)] of
                [(n, "")] -> Just n
                [(n, "{}")] -> holder !? round n
                _ -> Nothing

        findBracket :: [String] -> Maybe (Int, Int)
        findBracket = iter Nothing . flip zip [0..]
            where
                iter :: Maybe Int -> [(String, Int)] -> Maybe (Int, Int)
                iter prevBracket [] = prevBracket >>= error "Parentheses do not match."
                iter prevBracket ((x, index):xs)
                    | x == "("  = iter (Just index) xs
                    | x == ")"  = case prevBracket of Just n -> Just (n, index)
                                                      Nothing -> error "Parentheses do not match."
                    | otherwise = iter prevBracket xs

        parse :: Vector Double -> [String] -> Maybe Double
        parse holder tokens = case findBracket tokens of 
            Nothing -> parseMain holder tokens
            Just (start, end) -> let symbol = show (V.length holder) ++ "{}"
                                     (before, after) = splitAt start tokens
                                     (inBracket, afterBracket) = splitAt (end - start) after
                                     parseNew x = parse (snoc holder x) (before ++ (symbol : tail afterBracket))
                                 in parseMain holder (tail inBracket) >>= parseNew

        parseMain :: Vector Double -> [String] -> Maybe Double
        parseMain holder = iter operators
            where
                iter :: [BinOp] -> [String] -> Maybe Double
                iter [] _  = Nothing
                iter _ []  = Nothing
                iter _ [x] = tokenToDouble holder x
                iter (op:rest) unparsed =
                    case span (/= name op) unparsed of
                        (_, []) -> iter rest unparsed
                        (before, after) -> f op <$> iter operators before <*> iter operators (tail after)