summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-01 23:16:47 +0000
committerDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-01 23:16:47 +0000
commitdd661f4e446e50119da5bca95e62fcd529254e39 (patch)
tree8050accc8a6d3774f659d190d867e535d19fc9e8
parent84b0a3bffdb3e7b0c27beedb356edd3433e2bef2 (diff)
downloadcalculator-dd661f4e446e50119da5bca95e62fcd529254e39.tar.bz2
Augment parser to support expressions.
This calculator can now do basic sums with + - * / and %. It supports operator precedence, parenthesised expressions and whitespace all up the wazoo.
-rw-r--r--calculator.hs55
1 files changed, 38 insertions, 17 deletions
diff --git a/calculator.hs b/calculator.hs
index 23aab5e..faf3b26 100644
--- a/calculator.hs
+++ b/calculator.hs
@@ -1,30 +1,51 @@
import Text.Parsec
import Text.Parsec.String
+import Text.Parsec.Token
+import Text.Parsec.Language
+import Text.Parsec.Expr
-parseNumber :: Parser Int
+lexer :: TokenParser ()
+lexer = makeTokenParser (javaStyle { opStart = oneOf "+-*/%"
+ , opLetter = oneOf "+-*/%" })
+
+parseNumber :: Parser Double
parseNumber = do
- neg <- (char '-' >> return "-") <|> (return "")
- n' <- many1 $ oneOf "0123456789"
- return (read (neg ++ n'))
-
-parseAddition :: Parser Int
-parseAddition = do
- n1 <- parseNumber
- char '+'
- n2 <- parseNumber
- return (n1 + n2)
-
-calculation :: Parser Int
-calculation = do
- try parseAddition <|> parseNumber
-
+ val <- naturalOrFloat lexer
+ case val of
+ Left i -> return $ fromIntegral i
+ Right n -> return $ n
+
+doubleMod :: Double -> Double -> Double
+doubleMod top bottom = fromInteger $ (floor top) `mod` (floor bottom)
+
+parseExpression :: Parser Double
+parseExpression = (flip buildExpressionParser) parseTerm $ [
+ [ Prefix (reservedOp lexer "-" >> return negate)
+ , Prefix (reservedOp lexer "+" >> return id) ]
+ , [ Infix (reservedOp lexer "*" >> return (*)) AssocLeft
+ , Infix (reservedOp lexer "/" >> return (/)) AssocLeft
+ , Infix (reservedOp lexer "%" >> return doubleMod) AssocLeft ]
+ , [ Infix (reservedOp lexer "+" >> return (+)) AssocLeft
+ , Infix (reservedOp lexer "-" >> return (-)) AssocLeft ]
+ ]
+
+parseTerm :: Parser Double
+parseTerm = parens lexer parseExpression <|> parseNumber
+
+parseInput :: Parser Double
+parseInput = do
+ whiteSpace lexer
+ n <- parseExpression
+ eof
+ return n
+
calculate :: String -> String
calculate s =
case ret of
Left e -> "error: " ++ (show e)
Right n -> "answer: " ++ (show n)
where
- ret = parse calculation "" s
+ ret = parse parseInput "" s
main :: IO ()
main = interact (unlines . (map calculate) . lines)