diff --git a/calculator.cabal b/calculator.cabal --- a/calculator.cabal +++ b/calculator.cabal @@ -1,5 +1,5 @@ name: calculator -version: 0.1.5.1 +version: 0.1.5.2 synopsis: A calculator repl. description: A calculator repl that processes mathematical expressions. Does basic arithmetic, and provides pre-defined basic mathematical functions. @@ -21,6 +21,7 @@ , Calculator.Evaluator.Cmd , Calculator.Evaluator.Expr , Calculator.Evaluator.Statement + , Calculator.Parser.Base , Calculator.Parser.Cmd , Calculator.Parser.Expr , Calculator.Parser.Statement diff --git a/src/Calculator/Evaluator/Base.hs b/src/Calculator/Evaluator/Base.hs --- a/src/Calculator/Evaluator/Base.hs +++ b/src/Calculator/Evaluator/Base.hs @@ -1,4 +1,4 @@ -module Calculator.Evaluator.Base (evaluate) where +module Calculator.Evaluator.Base (evaluate, evalTest) where -------------------------------------------------------------------------------- @@ -34,5 +34,12 @@ evaluate :: Bindings -> String -> Either String Bindings evaluate b s = result $ eval b s + +-------------------------------------------------------------------------------- + +evalTest :: String -> String +evalTest s = case eval ([], []) s of + Left (Constant n) -> show n + _ -> "" -------------------------------------------------------------------------------- diff --git a/src/Calculator/Parser/Base.hs b/src/Calculator/Parser/Base.hs new file mode 100644 --- /dev/null +++ b/src/Calculator/Parser/Base.hs @@ -0,0 +1,28 @@ +module Calculator.Parser.Base where + +-------------------------------------------------------------------------------- + +import Calculator.Prim.Base (Number) + +-------------------------------------------------------------------------------- + +import Control.Monad (liftM2) +import Control.Applicative ((<$>)) +import Text.ParserCombinators.Parsec + +-------------------------------------------------------------------------------- + +parseNumber :: Parser Number +parseNumber = read <$> do + dec <- many1 digit + flt <- option "" (liftM2 (:) (char '.') (many1 digit)) + return $ if null flt + then dec + else dec ++ flt + +-------------------------------------------------------------------------------- + +parseId :: Parser String +parseId = (liftM2 (:) letter (many (letter <|> digit))) + +-------------------------------------------------------------------------------- diff --git a/src/Calculator/Parser/Cmd.hs b/src/Calculator/Parser/Cmd.hs --- a/src/Calculator/Parser/Cmd.hs +++ b/src/Calculator/Parser/Cmd.hs @@ -2,8 +2,8 @@ -------------------------------------------------------------------------------- +import Calculator.Parser.Base (parseId) import Calculator.Parser.Expr (parseExpr) -import Calculator.Prim.Base (parseId) import Calculator.Prim.Cmd (Cmd (..)) -------------------------------------------------------------------------------- diff --git a/src/Calculator/Parser/Expr.hs b/src/Calculator/Parser/Expr.hs --- a/src/Calculator/Parser/Expr.hs +++ b/src/Calculator/Parser/Expr.hs @@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Base (parseId, parseNumber) +import Calculator.Parser.Base (parseId, parseNumber) import Calculator.Prim.Expr (Expr (..), Operator, binaryOps, constEq) diff --git a/src/Calculator/Prim/Base.hs b/src/Calculator/Prim/Base.hs --- a/src/Calculator/Prim/Base.hs +++ b/src/Calculator/Prim/Base.hs @@ -2,30 +2,6 @@ -------------------------------------------------------------------------------- -import Text.ParserCombinators.Parsec - --------------------------------------------------------------------------------- - -import Control.Applicative ((<$>)) -import Control.Monad (liftM2) - --------------------------------------------------------------------------------- - type Number = Double - --------------------------------------------------------------------------------- - -parseNumber :: Parser Number -parseNumber = read <$> do - dec <- many1 digit - flt <- option "" (liftM2 (:) (char '.') (many1 digit)) - if null flt - then return dec - else return $ dec ++ flt - --------------------------------------------------------------------------------- - -parseId :: Parser String -parseId = (liftM2 (:) letter (many (letter <|> digit))) -------------------------------------------------------------------------------- diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -35,7 +35,7 @@ main = do putStrLn $ "calculator, version " ++ showVersion version - ++ ". Use :? for help" + ++ ". Use :? for help." runInputT defaultSettings (repl defBinds) -------------------------------------------------------------------------------- diff --git a/src/Model/Arithmetic.hs b/src/Model/Arithmetic.hs --- a/src/Model/Arithmetic.hs +++ b/src/Model/Arithmetic.hs @@ -1,17 +1,30 @@ module Model.Arithmetic (modelEval) where -import Calculator.Primitives (Number) +-------------------------------------------------------------------------------- +import Calculator.Parser.Base (parseNumber) +import Calculator.Prim.Base (Number) + +-------------------------------------------------------------------------------- + import Control.Applicative ((<*)) import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Expr -modelEval :: String -> Either ParseError Number -modelEval = parse (expr <* eof) "expression" +-------------------------------------------------------------------------------- +modelEval :: String -> String +modelEval inp = case parse (expr <* eof) "Expression" inp of + Left _ -> "" + Right n -> show n + +-------------------------------------------------------------------------------- + expr :: Parser Number expr = buildExpressionParser table factor "Expression" +-------------------------------------------------------------------------------- + table :: [[ Operator Char st Number ]] table = [ [ op "^" (**) AssocRight ] , [ op "*" (*) AssocLeft, op "/" (/) AssocLeft ] @@ -19,6 +32,8 @@ ] where op s f = Infix (string s >> return f) +-------------------------------------------------------------------------------- + parseFactor :: Parser Number parseFactor = do _ <- char '(' @@ -26,16 +41,9 @@ _ <- char ')' return x +-------------------------------------------------------------------------------- + factor :: Parser Number -factor = parseFactor <|> number "Simple expression" +factor = parseFactor <|> parseNumber -number :: Parser Number -number = fmap read $ do - ch <- many1 digit - de <- option "" $ do - dot <- char '.' - flt <- many1 digit - return $ dot : flt - return $ if null de - then ch - else ch ++ de +-------------------------------------------------------------------------------- diff --git a/tests/Arithmetic.hs b/tests/Arithmetic.hs --- a/tests/Arithmetic.hs +++ b/tests/Arithmetic.hs @@ -1,15 +1,20 @@ module Main where -import Calculator.Evaluator (eval) -import Calculator.Primitives (Number) -import Model.Arithmetic +-------------------------------------------------------------------------------- -import Data.Function (on) -import Control.Monad -import Control.Applicative ((<$>)) -import System.Exit (exitSuccess, exitFailure) -import Test.QuickCheck +import Calculator.Evaluator.Base (evalTest) +import Calculator.Prim.Base (Number) +import Model.Arithmetic +-------------------------------------------------------------------------------- + +import Control.Applicative ((<$>)) +import Control.Monad +import System.Exit (exitFailure, exitSuccess) +import Test.QuickCheck + +-------------------------------------------------------------------------------- + newtype ExprString = ExprString { unwrapExprString :: String } instance Show ExprString where @@ -18,7 +23,9 @@ instance Arbitrary ExprString where arbitrary = ExprString <$> genExprString -operators :: [Char] +-------------------------------------------------------------------------------- + +operators :: String operators = "+-*/^" genOp :: Gen Char @@ -32,21 +39,21 @@ liftM2 (:) genArg . listOf $ liftM2 (:) genOp genArg --- Converts to string so that NaN == NaN evaluates to true -equal :: Either a Number -> Either a Number -> Bool -equal (Right x) (Right y) = on (==) show x y -equal (Left _) (Left _) = True -equal _ _ = False +-------------------------------------------------------------------------------- prop_model :: ExprString -> Bool -prop_model xs = (calcResult `equal` modelResult) - where expr = unwrapExprString xs - calcResult = eval expr +prop_model xs = calcResult == modelResult + where expr = unwrapExprString xs + calcResult = evalTest expr modelResult = modelEval expr +-------------------------------------------------------------------------------- + main :: IO () main = do status <- quickCheckWithResult stdArgs { maxSuccess = 2500 } prop_model case status of - (Success _ _ _) -> exitSuccess - _ -> exitFailure + Success{} -> exitSuccess + _ -> exitFailure + +--------------------------------------------------------------------------------