calculator 0.2.0.3 → 0.2.2.0
raw patch · 10 files changed
+80/−63 lines, 10 files
Files
- calculator.cabal +1/−2
- src/Calculator/Color.hs +0/−26
- src/Calculator/Evaluator/Base.hs +4/−4
- src/Calculator/Evaluator/Cmd.hs +5/−1
- src/Calculator/Help.hs +8/−2
- src/Calculator/Parser/Cmd.hs +27/−16
- src/Calculator/Parser/Expr.hs +16/−7
- src/Calculator/Prim/Function.hs +10/−0
- src/Model/Arithmetic.hs +5/−4
- tests/Arithmetic.hs +4/−1
calculator.cabal view
@@ -1,5 +1,5 @@ name: calculator-version: 0.2.0.3+version: 0.2.2.0 synopsis: A calculator repl. description: A calculator repl that processes mathematical expressions. Does basic arithmetic, and provides pre-defined basic mathematical functions.@@ -23,7 +23,6 @@ , Calculator.Evaluator.Func , Calculator.Evaluator.Statement , Calculator.Help- , Calculator.Color , Calculator.Parser.Base , Calculator.Parser.Cmd , Calculator.Parser.Expr
− src/Calculator/Color.hs
@@ -1,26 +0,0 @@-module Calculator.Color- ( Color (..)- , color- , bold- ) where------------------------------------------------------------------------------------data Color = Black | Red | Green | Yellow- | Blue | Magenta | Cyan | White- | Reset- deriving Enum------------------------------------------------------------------------------------color :: Color -> Bool -> String -> String-color c b s = let col = show (fromEnum c)- bol = if b then "1" else "22"- in "\ESC[" ++ bol ++ ";3" ++ col ++ "m" ++ s ++ "\ESC[0;m"------------------------------------------------------------------------------------bold :: String -> String-bold = color Reset True----------------------------------------------------------------------------------
src/Calculator/Evaluator/Base.hs view
@@ -11,14 +11,14 @@ import Control.Applicative ((<*)) import Data.List (nub)-import Text.ParserCombinators.Parsec (eof, parse)+import Text.ParserCombinators.Parsec (eof, parse, spaces) -------------------------------------------------------------------------------- eval :: Bindings -> String -> Either Expr Bindings-eval b inp = case parse (parseStat <* eof) "Statement" inp of- Left e -> Left . Message . tail . lines $ show e- Right s -> evalStat b s+eval b i = case parse (spaces >> parseStat <* spaces <* eof) "Statement" i of+ Left e -> Left . Message . tail . lines . show $ e+ Right s -> evalStat b s --------------------------------------------------------------------------------
src/Calculator/Evaluator/Cmd.hs view
@@ -9,6 +9,7 @@ import Calculator.Prim.Cmd (Cmd (..)) import Calculator.Prim.Definitions (defBinds) import Calculator.Prim.Expr (Expr (Message, Constant))+import Calculator.Prim.Function (testFunc) -------------------------------------------------------------------------------- @@ -21,6 +22,9 @@ Message xxs -> Left xxs Constant c -> Right $ addVar (s, c) b _ -> Left [" ~~ Erroneous Result ~~ "]-evalCmd b f@(Func i _ _) = Right $ addFun (i, execFunc b f) b+evalCmd b fun@(Func i _ _) = let f = execFunc b fun+ in case testFunc f 0 of+ Nothing -> Right $ addFun (i, f) b+ Just ms -> Left ms --------------------------------------------------------------------------------
src/Calculator/Help.hs view
@@ -3,7 +3,8 @@ -------------------------------------------------------------------------------- import Calculator.Color (bold)-import Calculator.Prim.Definitions (binaryOps, defFuns, defVars)+import Calculator.Prim.Definitions (binaryOps, defFuns, defVars,+ unaryOps) -------------------------------------------------------------------------------- @@ -19,10 +20,15 @@ , " :reset -- Reset variable and function bindings" , " :show -- Display all variable bindings" , " :? or :help -- Display this help message"- , bold "Supported Operations: " ++ intersperse ' ' (map fst binaryOps)+ , bold "Unary Operators: " ++ intersperse ' ' (map fst unaryOps)+ , bold "Binary Operators: " ++ intersperse ' ' (map fst binaryOps) , bold "Pre-defined variables: " ++ intercalate ", " (map fst defVars) , bold "Provided Functions: " , " " ++ intercalate ", " (map fst defFuns)+ , bold "Spaces are ignored in most places"+ , " :func f ( x ) = x + x + x -- works"+ , " but not everywhere, e.g in commands"+ , " : func ... -- doesn't work" ] --------------------------------------------------------------------------------
src/Calculator/Parser/Cmd.hs view
@@ -1,4 +1,10 @@-module Calculator.Parser.Cmd (parseCmd) where+module Calculator.Parser.Cmd+ ( parseCmd+ , parseAssign+ , parseAssign'+ , parseFunc+ , parseFunc'+ ) where -------------------------------------------------------------------------------- @@ -8,6 +14,7 @@ -------------------------------------------------------------------------------- +import Control.Applicative ((<*)) import Text.ParserCombinators.Parsec --------------------------------------------------------------------------------@@ -30,43 +37,47 @@ -- help -> "?" | "help" parseHelp :: Parser Cmd-parseHelp = (string "?" <|> string "help") >> return Help+parseHelp = (string "?" <|> string "help") >> spaces >> return Help -------------------------------------------------------------------------------- -- reset -> "reset" parseShow :: Parser Cmd-parseShow = string "show" >> return Display+parseShow = string "show" >> spaces >> return Display -------------------------------------------------------------------------------- -- reset -> "reset" parseReset :: Parser Cmd-parseReset = string "reset" >> return Reset+parseReset = string "reset" >> spaces >> return Reset -------------------------------------------------------------------------------- -- assign -> "var" id "=" expr parseAssign :: Parser Cmd-parseAssign = do- _ <- string "var "+parseAssign = string "var" >> space >> spaces >> parseAssign'++parseAssign' :: Parser Cmd+parseAssign' = do str <- parseId+ _ <- spaces _ <- char '='+ _ <- spaces ex <- parseExpr return $ Assign str ex ----------------------------------------------------------------------------------- func -> "func" id arg "=" expr+-- func -> "func" id (args) "=" expr parseFunc :: Parser Cmd-parseFunc = do- _ <- string "func "- str <- parseId- _ <- char '('- args <- sepBy parseId (char ',')- _ <- char ')'- _ <- char '='- ex <- parseExpr- return $ Func str args ex+parseFunc = string "func" >> space >> spaces >> parseFunc'++parseFunc' :: Parser Cmd+parseFunc' = do+ ident <- try (parseId <* (spaces >> char '(' >> spaces))+ args <- (parseId <* spaces) `sepBy` (char ',' <* spaces) <* char ')'+ _ <- spaces >> char '=' <* spaces+ expr <- parseExpr+ return $ Func ident args expr --------------------------------------------------------------------------------
src/Calculator/Parser/Expr.hs view
@@ -3,12 +3,13 @@ -------------------------------------------------------------------------------- import Calculator.Parser.Base (parseId, parseNumber)-import Calculator.Prim.Definitions (unaryOps, binaryOps)+import Calculator.Prim.Definitions (binaryOps, unaryOps) import Calculator.Prim.Expr (Expr (..), Operator, constEq) -------------------------------------------------------------------------------- import Control.Applicative ((<$>), (<*))+import Data.Maybe (isNothing) import Text.ParserCombinators.Parsec --------------------------------------------------------------------------------@@ -17,6 +18,7 @@ parseExpr :: Parser Expr parseExpr = do term <- parseTerm+ _ <- spaces rest <- parseRestExpr return $ if null rest then term@@ -25,8 +27,10 @@ parseRestExpr :: Parser [(Operator, Expr)] parseRestExpr = many $ do oper <- oneOf "+-"+ _ <- spaces let (Just op) = lookup oper binaryOps expr <- parseTerm+ _ <- spaces return (op, expr) --------------------------------------------------------------------------------@@ -35,6 +39,7 @@ parseTerm :: Parser Expr parseTerm = do fact <- parseFact+ _ <- spaces rest <- parseRestTerm return $ if null rest then fact@@ -43,6 +48,7 @@ parseRestTerm :: Parser [(Operator, Expr)] parseRestTerm = many $ do oper <- oneOf "*/"+ _ <- spaces let (Just op) = lookup oper binaryOps expr <- parseFact return (op, expr)@@ -54,6 +60,7 @@ parseFact :: Parser Expr parseFact = do val <- parseVal+ _ <- spaces pow <- parsePower return $ if constEq (Constant 1) (snd pow) then val@@ -63,6 +70,7 @@ parsePower = let (Just op) = lookup '^' binaryOps in option (op, Constant 1) $ do _ <- char '^'+ _ <- spaces fact <- parseFact return (op, fact) @@ -72,9 +80,9 @@ parseVal :: Parser Expr parseVal = do- ch <- optionMaybe $ oneOf (map fst unaryOps)+ ch <- optionMaybe $ oneOf (map fst unaryOps) <* spaces v <- parseVal'- return $ if ch == Nothing+ return $ if isNothing ch then v else let Just c = ch Just op = lookup c unaryOps@@ -82,14 +90,15 @@ -------------------------------------------------------------------------------- -- val' -> ( expr ) | func ( expr ) | var | number- + parseVal' :: Parser Expr parseVal' = parseBrackets <|> parseCall <|> parseVariable <|> parseConstant parseBrackets :: Parser Expr parseBrackets = do- _ <- try (char '(')+ _ <- try (spaces >> char '(') e <- parseExpr+ _ <- spaces _ <- char ')' return e @@ -101,8 +110,8 @@ parseCall :: Parser Expr parseCall = do- ident <- try (parseId <* char '(')- args <- parseExpr `sepBy` char ',' <* char ')'+ ident <- try (parseId <* (spaces >> char '(' >> spaces))+ args <- parseExpr `sepBy` (char ',' <* spaces) <* (spaces >> char ')') return $ Call ident args --------------------------------------------------------------------------------
src/Calculator/Prim/Function.hs view
@@ -5,6 +5,7 @@ , mkFuncEither , oneArg , partial+ , testFunc ) where --------------------------------------------------------------------------------@@ -48,5 +49,14 @@ partial f xs x = case apply f (x:xs) of Left _ -> Nothing Right v -> Just v++--------------------------------------------------------------------------------++-- | Test a @Function@ with some value t, useful for sanity checking+-- while adding a @Function@ to a @Bindings@+testFunc :: Function a -> a -> Maybe [String]+testFunc f t = case apply f (replicate (arity f) t) of+ Left ms -> Just ms+ Right _ -> Nothing --------------------------------------------------------------------------------
src/Model/Arithmetic.hs view
@@ -13,9 +13,10 @@ -------------------------------------------------------------------------------- modelEval :: String -> String-modelEval inp = case parse (expr <* eof) "Expression" inp of- Left _ -> ""- Right n -> show n+modelEval inp =+ case parse (spaces >> expr <* spaces <* eof) "Expression" inp of+ Left _ -> ""+ Right n -> show n -------------------------------------------------------------------------------- @@ -29,7 +30,7 @@ , [ op "*" (*) AssocLeft, op "/" (/) AssocLeft ] , [ op "+" (+) AssocLeft, op "-" (-) AssocLeft ] ]- where op s f = Infix (string s >> return f)+ where op s f = Infix (try (spaces >> string s >> spaces) >> return f) --------------------------------------------------------------------------------
tests/Arithmetic.hs view
@@ -35,8 +35,11 @@ genExprString :: Gen String genExprString = liftM concat .+ liftM2 (:) (listOf (elements " ")) . liftM2 (:) genArg .- listOf $ liftM2 (:) genOp genArg+ liftM2 (:) (listOf (elements " ")) .+ listOf . liftM2 (:) genOp+ . liftM2 (++) (listOf (elements " ")) $ genArg --------------------------------------------------------------------------------