Skip to content

@petermarks /gist:702671
Created

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Expression parser
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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.