parser.hs

{-# LANGUAGE ViewPatterns #-}

module MathParserCompact where

import Data.Char (isDigit, isSpace)

data Token = N Double | Plus | Minus | Mul | Div | LP | RP deriving (Show, Eq)

lex :: String -> [Token]
lex [] = []
lex (c:cs)
  | isSpace c = lex cs
  | c == '+'  = Plus : lex cs
  | c == '-'  = Minus : lex cs  
  | c == '*'  = Mul : lex cs
  | c == '/'  = Div : lex cs
  | c == '('  = LP : lex cs
  | c == ')'  = RP : lex cs
  | isDigit c || c == '.' = 
      let (num, rest) = span (\x -> isDigit x || x == '.') (c:cs)
      in N (read num) : lex rest
  | otherwise = error $ "Invalid char: " ++ [c]

eval :: String -> Double
eval = fst . expr . lex
  where
    expr = term
    term ts = let (a, ts') = factor ts in term' a ts'
    term' a (Mul:ts) = let (b, ts') = factor ts in term' (a * b) ts'
    term' a (Div:ts) = let (b, ts') = factor ts in term' (a / b) ts'
    term' a ts = (a, ts)
    factor (N n:ts) = (n, ts)
    factor (LP:ts) = let (a, RP:ts') = expr ts in (a, ts')
    factor ts = error "Syntax error"

main = mapM_ (putStrLn . (\e -> e ++ " = " ++ show (eval e))) [
    "2 * (2 * 2 + 2)", "3 + 4 * 2", "(3 + 4) * 2"
  ]