calculator 0.1.5.1 → 0.1.5.2
raw patch · 9 files changed
+89/−62 lines, 9 files
Files
- calculator.cabal +2/−1
- src/Calculator/Evaluator/Base.hs +8/−1
- src/Calculator/Parser/Base.hs +28/−0
- src/Calculator/Parser/Cmd.hs +1/−1
- src/Calculator/Parser/Expr.hs +1/−1
- src/Calculator/Prim/Base.hs +0/−24
- src/Main.hs +1/−1
- src/Model/Arithmetic.hs +22/−14
- tests/Arithmetic.hs +26/−19
calculator.cabal view
@@ -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
src/Calculator/Evaluator/Base.hs view
@@ -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+ _ -> "" --------------------------------------------------------------------------------
+ src/Calculator/Parser/Base.hs view
@@ -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)))++--------------------------------------------------------------------------------
src/Calculator/Parser/Cmd.hs view
@@ -2,8 +2,8 @@ -------------------------------------------------------------------------------- +import Calculator.Parser.Base (parseId) import Calculator.Parser.Expr (parseExpr)-import Calculator.Prim.Base (parseId) import Calculator.Prim.Cmd (Cmd (..)) --------------------------------------------------------------------------------
src/Calculator/Parser/Expr.hs view
@@ -2,7 +2,7 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Base (parseId, parseNumber)+import Calculator.Parser.Base (parseId, parseNumber) import Calculator.Prim.Expr (Expr (..), Operator, binaryOps, constEq)
src/Calculator/Prim/Base.hs view
@@ -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))) --------------------------------------------------------------------------------
src/Main.hs view
@@ -35,7 +35,7 @@ main = do putStrLn $ "calculator, version " ++ showVersion version- ++ ". Use :? for help"+ ++ ". Use :? for help." runInputT defaultSettings (repl defBinds) --------------------------------------------------------------------------------
src/Model/Arithmetic.hs view
@@ -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+--------------------------------------------------------------------------------
tests/Arithmetic.hs view
@@ -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++--------------------------------------------------------------------------------