Expression parser

gistfile1.hs

import Data.Maybe
import Text.Printf
import Data.Char
import Control.Applicative

data Expr = Term Int | Op Operator Expr Expr | Var String
  deriving (Show, Eq)

data Operator = Sum | Mult | Sub | Div
  deriving (Show, Eq)
  
sampleStr = "2 + a * 4 - b"

newtype Parser a = Parser {runParser :: String -> Maybe (a, String)}

predP :: (Char -> Bool) -> Parser Char
predP pred = Parser p
  where
    p (x : xs)
      | pred x = Just (x, xs)
    p _ = Nothing

anyCharP :: Parser Char
anyCharP = predP (const True)

charP :: Char -> Parser Char
charP c = predP (==c)

combP :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
combP f pa pb = f <$> pa <*> pb

instance Functor Parser where
  fmap f (Parser pa) = Parser $ \s -> case pa s of
                                       Nothing -> Nothing
                                       Just (a, s') -> Just (f a, s')

instance Applicative Parser where
  pure x = Parser $ \s -> Just (x, s)
  (Parser pf) <*> (Parser pa) = Parser $ \s -> case pf s of
                                                 Nothing -> Nothing
                                                 Just (f, s') -> case pa s' of
                                                   Nothing -> Nothing
                                                   Just (a, s'') -> Just (f a, s'')
instance Alternative Parser where
  empty = Parser $ \s -> Nothing
  (Parser pa) <|> (Parser pb) = Parser $ \s -> case pa s of
                                                 Just (a, s') -> Just (a, s')
                                                 Nothing -> pb s

digitP :: Parser Char
digitP = predP isDigit

symbolCharP :: Parser Char
symbolCharP = predP isAlphaNum

operatorP :: Parser Operator
operatorP = Mult <$ charP '*' <|>
            Div  <$ charP '/' <|>
            Sum  <$ charP '+' <|>
            Sub  <$ charP '-'
             
termP :: Parser Expr
termP = Term . read <$> some digitP

varP :: Parser Expr
varP = Var <$> some symbolCharP

opP :: Parser Expr
opP = charP '(' *> ((\a o b -> Op o a b) <$> exprP <*> operatorP <*> exprP) <* charP ')'

exprP :: Parser Expr
exprP = termP <|> varP <|> opP

parseExpr :: String -> Maybe Expr
parseExpr s = maybe Nothing (Just . fst) (runParser exprP (filter (/=' ') s))