calculator 0.2.2.1 → 0.3.0.0
raw patch · 13 files changed
+210/−76 lines, 13 filesdep +gtkdep +plot-gtk-uidep +transformers
Dependencies added: gtk, plot-gtk-ui, transformers
Files
- calculator.cabal +13/−1
- src/Calculator/Evaluator/Base.hs +8/−24
- src/Calculator/Evaluator/Cmd.hs +74/−17
- src/Calculator/Evaluator/Expr.hs +2/−2
- src/Calculator/Evaluator/Func.hs +1/−1
- src/Calculator/Evaluator/Statement.hs +10/−7
- src/Calculator/Help.hs +13/−0
- src/Calculator/Parser/Cmd.hs +42/−2
- src/Calculator/Prim/Bindings.hs +4/−4
- src/Calculator/Prim/Cmd.hs +6/−1
- src/Calculator/Prim/Definitions.hs +1/−1
- src/Calculator/Prim/Function.hs +12/−13
- src/Main.hs +24/−3
calculator.cabal view
@@ -1,9 +1,12 @@ name: calculator-version: 0.2.2.1+version: 0.3.0.0 synopsis: A calculator repl. description: A calculator repl that processes mathematical expressions. Does basic arithmetic, and provides pre-defined basic mathematical functions.+ . Provides binding functionality for variables and functions.+ .+ Optionally provides plotting support. homepage: https://github.com/sumitsahrawat/calculator license: GPL-2 license-file: LICENSE@@ -15,6 +18,10 @@ -- extra-source-files: cabal-version: >=1.10 +flag plot-gtk-ui+ default: False+ description: Use plot-gtk-ui to provide plotting commands+ executable calculator main-is: Main.hs other-modules: Calculator.Evaluator.Base@@ -42,6 +49,11 @@ hs-source-dirs: src/ ghc-options: -Wall default-language: Haskell2010+ if flag(plot-gtk-ui)+ cpp-options: -DPLOT+ build-depends: plot-gtk-ui >=0.0.2.0+ , gtk >=0.13.0 && <0.14.0+ , transformers >= 0.4.2.0 test-suite model-test-arithmetic type: exitcode-stdio-1.0
src/Calculator/Evaluator/Base.hs view
@@ -5,41 +5,25 @@ import Calculator.Evaluator.Statement (evalStat) import Calculator.Parser.Statement (parseStat) import Calculator.Prim.Bindings (Bindings, mkBind)-import Calculator.Prim.Expr (Expr (..))+import Calculator.Prim.Result (Result (..)) -------------------------------------------------------------------------------- import Control.Applicative ((<*))-import Data.List (nub) import Text.ParserCombinators.Parsec (eof, parse, spaces) -------------------------------------------------------------------------------- -eval :: Bindings -> String -> Either Expr Bindings-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------------------------------------------------------------------------------------result :: Either Expr Bindings -> Either String Bindings-result e =- case e of- Left (Constant c) -> Left $ " == " ++ show c- Left (Message x) -> Left . init . unlines . map (" -!- " ++ ) . nub $ x- Right b -> Right b- Left _ -> Left " ~~ Erroneous Result ~~"------------------------------------------------------------------------------------evaluate :: Bindings -> String -> Either String Bindings-evaluate b s = result $ eval b s+evaluate :: Bindings -> String -> Result+evaluate b i = case parse (spaces >> parseStat <* spaces <* eof) "Statement" i of+ Left e -> Error . show $ e+ Right s -> evalStat b s -------------------------------------------------------------------------------- evalTest :: String -> String-evalTest s = case eval (mkBind [] []) s of- Left (Constant n) -> show n- _ -> ""+evalTest s = case evaluate (mkBind [] []) s of+ Value n -> show n+ _ -> "" --------------------------------------------------------------------------------
src/Calculator/Evaluator/Cmd.hs view
@@ -1,30 +1,87 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}+ module Calculator.Evaluator.Cmd (evalCmd) where -------------------------------------------------------------------------------- -import Calculator.Evaluator.Expr (evalExpr)-import Calculator.Evaluator.Func (execFunc)-import Calculator.Help (help)-import Calculator.Prim.Bindings (Bindings, addFun, addVar, display)-import Calculator.Prim.Cmd (Cmd (..))-import Calculator.Prim.Definitions (defBinds)-import Calculator.Prim.Expr (Expr (Message, Constant))-import Calculator.Prim.Function (testFunc)+import Calculator.Evaluator.Expr (evalExpr)+import Calculator.Evaluator.Func (execFunc)+import Calculator.Help (help)+import Calculator.Prim.Bindings (Bindings, addFun, addVar,+ display)+import Calculator.Prim.Cmd (Cmd (..))+import Calculator.Prim.Definitions (defBinds)+import Calculator.Prim.Expr (Expr (Message, Constant))+import Calculator.Prim.Function (testFunc)+import Calculator.Prim.Result (Result (..)) -------------------------------------------------------------------------------- -evalCmd :: Bindings -> Cmd -> Either [String] Bindings-evalCmd _ Help = Left help-evalCmd b Display = Left $ display b-evalCmd _ Reset = Right defBinds+#ifdef PLOT++import Calculator.Prim.Bindings (getFun)+import Calculator.Prim.Function (Function, apply, arity)++import Graphics.Rendering.Plot.Gtk.UI (plotWithArity)+import Graphics.UI.Gtk (initGUI, mainGUI)++import Data.List (foldl1')+import Data.Maybe++#endif++--------------------------------------------------------------------------------++evalCmd :: Bindings -> Cmd -> Result+evalCmd _ Help = Text . unlines $ help+evalCmd b Display = Text . unlines . display $ b+evalCmd _ Reset = NewBindings defBinds evalCmd b (Assign s e) = case evalExpr b e of- Message xxs -> Left xxs- Constant c -> Right $ addVar (s, c) b- _ -> Left [" ~~ Erroneous Result ~~ "]+ Message xxs -> Error . unlines $ xxs+ Constant c -> NewBindings . addVar (s, c) $ b+ _ -> Error " ~~ Erroneous Result ~~ " 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+ Nothing -> NewBindings . addFun (i, f) $ b+ Just ms -> Error . unlines $ ms++--------------------------------------------------------------------------------++#ifdef PLOT++evalCmd b (Plot s rs) =+ case getFun s b of+ Nothing -> Error $ "Unknown function: " ++ s+ Just f -> let pairMap fn (x, y) = (fn x, fn y)+ rangeExps = map (pairMap (evalExpr b)) rs+ rangeErrs = map (uncurry grabMessage) rangeExps+ allErrors = foldl1' grabMessage rangeErrs+ ranges = map (pairMap (\(Constant c) -> c)) rangeExps+ fromMsg = (\(Message ms) -> ms)+ in if null . fromMsg $ allErrors+ then plotFunction f ranges+ else Error . unlines . fromMsg $ allErrors++grabMessage :: Expr -> Expr -> Expr+grabMessage (Message m1) (Message m2) = Message (m1 ++ m2)+grabMessage m1@(Message _) _ = m1+grabMessage _ m2@(Message _) = m2+grabMessage _ _ = Message []++plotFunction :: Function -> [(Double, Double)] -> Result+plotFunction f ranges =+ if length ranges /= arity f+ then Error $ "Invalid parameters: " +++ "Required " ++ show (arity f) ++ " range(s). " +++ "Provided " ++ show (length ranges) ++ "."+ else Action $ do+ _ <- initGUI+ fromJust $ plotWithArity (arity f) ((\(Right x) -> x) . apply f) ranges+ mainGUI++#endif --------------------------------------------------------------------------------
src/Calculator/Evaluator/Expr.hs view
@@ -3,8 +3,8 @@ -------------------------------------------------------------------------------- import Calculator.Prim.Bindings (Bindings, getFun, getVar)-import Calculator.Prim.Expr (Expr (..), Operator (..),- joinMessage, isConst)+import Calculator.Prim.Expr (Expr (..), Operator (..), isConst,+ joinMessage) import Calculator.Prim.Function (Function (..)) --------------------------------------------------------------------------------
src/Calculator/Evaluator/Func.hs view
@@ -10,7 +10,7 @@ -------------------------------------------------------------------------------- -execFunc :: Bindings -> Cmd -> Function Double+execFunc :: Bindings -> Cmd -> Function execFunc b (Func _ args e) = mkFuncEither (length args) $ \xs -> case evalExpr (appendVars (zip args xs) b) e of
src/Calculator/Evaluator/Statement.hs view
@@ -5,16 +5,19 @@ import Calculator.Evaluator.Cmd (evalCmd) import Calculator.Evaluator.Expr (evalExpr) import Calculator.Prim.Bindings (Bindings)-import Calculator.Prim.Expr (Expr (Message))+import Calculator.Prim.Expr (Expr (Message, Constant))+import Calculator.Prim.Result (Result (..)) import Calculator.Prim.Statement (Statement (..)) -------------------------------------------------------------------------------- -evalStat :: Bindings -> Statement -> Either Expr Bindings-evalStat b stat = case stat of- Expression e -> Left $ evalExpr b e- Command c -> case evalCmd b c of- Left s -> Left . Message $ s- Right b' -> Right b'+evalStat :: Bindings -> Statement -> Result+evalStat b stat =+ case stat of+ Expression e -> case evalExpr b e of+ Constant c -> Value c+ Message t -> Error . unlines $ t+ _ -> Error "Internal error: evalStat"+ Command c -> evalCmd b c --------------------------------------------------------------------------------
src/Calculator/Help.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Calculator.Help (help) where --------------------------------------------------------------------------------@@ -18,6 +20,9 @@ , " :func f(x)=x+1 -- Binds f(x) to \"x + 1\"" , " :func f(x,y)=x+y -- Binds f(x) to \"x + y\"" , " :reset -- Reset variable and function bindings"+#ifdef PLOT+ , " :plot -- For plotting, detailed below"+#endif , " :show -- Display all variable bindings" , " :? or :help -- Display this help message" , bold "Unary Operators: " ++ intersperse ' ' (map fst unaryOps)@@ -29,6 +34,14 @@ , " :func f ( x ) = x + x + x -- works" , " but not everywhere, e.g in commands" , " : func ... -- doesn't work"+#ifdef PLOT+ , bold "Plotting: "+ , " :plot f (0, 1)"+ , " -- Plot a single argument function 'f' in range (0, 1)"+ , " :plot f (0, 1) (1, 2)"+ , " -- Plot a two argument function 'f' in range (0, 1)"+ , " -- where the second argument can be varied between 1 and 2"+#endif ] --------------------------------------------------------------------------------
src/Calculator/Parser/Cmd.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Calculator.Parser.Cmd ( parseCmd , parseAssignCmd@@ -12,6 +14,12 @@ import Calculator.Parser.Expr (parseExpr) import Calculator.Prim.Cmd (Cmd (..)) +#ifdef PLOT++import Calculator.Prim.Expr (Expr)++#endif+ -------------------------------------------------------------------------------- import Control.Applicative ((<*))@@ -24,7 +32,7 @@ parseCmd = char ':' >> parseCmd' ----------------------------------------------------------------------------------- cmd' -> show | help | reset | assign+-- cmd' -> show | help | reset | assign | plot parseCmd' :: Parser Cmd parseCmd' = parseShow@@ -32,6 +40,9 @@ <|> parseReset <|> parseAssignCmd <|> parseFuncCmd+#ifdef PLOT+ <|> parsePlotCmd+#endif -------------------------------------------------------------------------------- -- help -> "?" | "help"@@ -40,7 +51,7 @@ parseHelp = (string "?" <|> string "help") >> spaces >> return Help ----------------------------------------------------------------------------------- reset -> "reset"+-- show -> "show" parseShow :: Parser Cmd parseShow = string "show" >> spaces >> return Display@@ -50,6 +61,35 @@ parseReset :: Parser Cmd parseReset = string "reset" >> spaces >> return Reset++--------------------------------------------------------------------------------+-- plot -> "plot" id++#ifdef PLOT++parsePlotCmd :: Parser Cmd+parsePlotCmd = do+ _ <- string "plot"+ _ <- spaces+ f <- parseId+ _ <- spaces+ r <- pairDoubles `sepBy1` spaces+ return $ Plot f r++pairDoubles :: Parser (Expr, Expr)+pairDoubles = do+ _ <- char '('+ _ <- spaces+ l <- parseExpr+ _ <- spaces+ _ <- char ','+ _ <- spaces+ u <- parseExpr+ _ <- spaces+ _ <- char ')'+ return (l, u)++#endif -------------------------------------------------------------------------------- -- assignCmd -> "var" id "=" expr
src/Calculator/Prim/Bindings.hs view
@@ -22,13 +22,13 @@ -- | Represents variable and function bindings data Bindings = Bindings { varMap :: M.Map String Double- , funMap :: M.Map String (Function Double)+ , funMap :: M.Map String Function } -------------------------------------------------------------------------------- -- | Make a new binding from two alists-mkBind :: [(String, Double)] -> [(String, Function Double)] -> Bindings+mkBind :: [(String, Double)] -> [(String, Function)] -> Bindings mkBind vars funs = Bindings { varMap = M.fromList vars , funMap = M.fromList funs@@ -51,11 +51,11 @@ -------------------------------------------------------------------------------- -- | Add a @Function@ to @Bindings@-addFun :: (String, Function Double) -> Bindings -> Bindings+addFun :: (String, Function) -> Bindings -> Bindings addFun (s, f) b = b { funMap = M.insert s f (funMap b) } -- | Get a @Function@ from @Bindings@-getFun :: String -> Bindings -> Maybe (Function Double)+getFun :: String -> Bindings -> Maybe Function getFun s b = M.lookup s (funMap b) --------------------------------------------------------------------------------
src/Calculator/Prim/Cmd.hs view
@@ -1,5 +1,7 @@-module Calculator.Prim.Cmd ( Cmd (..) ) where+{-# LANGUAGE CPP #-} +module Calculator.Prim.Cmd (Cmd (..)) where+ -------------------------------------------------------------------------------- import Calculator.Prim.Expr (Expr)@@ -12,5 +14,8 @@ | Help | Reset | Display+#ifdef PLOT+ | Plot String [(Expr, Expr)]+#endif --------------------------------------------------------------------------------
src/Calculator/Prim/Definitions.hs view
@@ -35,7 +35,7 @@ -------------------------------------------------------------------------------- -- | List of pre-defined @Functions@-defFuns :: [(String, Function Double)]+defFuns :: [(String, Function)] defFuns = map (second oneArg) [ ("sin", sin) , ("cos", cos)
src/Calculator/Prim/Function.hs view
@@ -1,6 +1,5 @@ module Calculator.Prim.Function- ( Function- , apply+ ( Function (..) , mkFunc , mkFuncEither , oneArg@@ -11,33 +10,33 @@ -------------------------------------------------------------------------------- -- | Represents a function, where rank == No. of arguments-data Function a = Function {+data Function = Function { arity :: Int- , apply :: [a] -> Either [String] a+ , apply :: [Double] -> Either [String] Double } -------------------------------------------------------------------------------- -- | Make a @Function@ out of an arity and another function-mkFunc :: Int -> ([a] -> a) -> Function a+mkFunc :: Int -> ([Double] -> Double) -> Function mkFunc a f = mkFuncEither a (Right . f) -------------------------------------------------------------------------------- -- | Make a @Function@ with an arity using an error giving function-mkFuncEither :: Int -> ([a] -> Either [String] a) -> Function a+mkFuncEither :: Int -> ([Double] -> Either [String] Double) -> Function mkFuncEither a f = Function { arity = a , apply = g } where g xs = if length xs == a then f xs- else Left $ [ "Invalid no. of arguments"- , "Required: " ++ show a- , "Provided: " ++ show (length xs)- ]+ else Left [ "Invalid no. of arguments"+ , "Required: " ++ show a+ , "Provided: " ++ show (length xs)+ ] -------------------------------------------------------------------------------- -- | Make a @Function@ out of a single argument function-oneArg :: (a -> a) -> Function a+oneArg :: (Double -> Double) -> Function oneArg f = mkFunc 1 (\ [x] -> f x) --------------------------------------------------------------------------------@@ -45,7 +44,7 @@ -- | Partially apply a function, thus creating a one-argument function. -- To be used for parametrized functions, e.g getting g(x) = f(x,1,2) -- this retains the free-variable 'x'-partial :: Function a -> [a] -> a -> Maybe a+partial :: Function -> [Double] -> Double -> Maybe Double partial f xs x = case apply f (x:xs) of Left _ -> Nothing Right v -> Just v@@ -54,7 +53,7 @@ -- | 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 :: Function -> Double -> Maybe [String] testFunc f t = case apply f (replicate (arity f) t) of Left ms -> Just ms Right _ -> Nothing
src/Main.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ module Main where --------------------------------------------------------------------------------@@ -10,6 +12,7 @@ import Calculator.Evaluator.Base (evaluate) import Calculator.Prim.Bindings (Bindings) import Calculator.Prim.Definitions (defBinds)+import Calculator.Prim.Result (Result (..)) -------------------------------------------------------------------------------- @@ -18,6 +21,12 @@ -------------------------------------------------------------------------------- +#ifdef PLOT+import Control.Monad.IO.Class (liftIO)+#endif++--------------------------------------------------------------------------------+ type Repl a = InputT IO a --------------------------------------------------------------------------------@@ -27,9 +36,21 @@ input <- getInputLine $ color Red True "calc> " case input of Nothing -> return ()- Just inp -> case evaluate b inp of- Left s -> outputStrLn s >> repl b- Right b' -> repl b'+ Just inp -> process b inp++padOut :: Bindings -> String -> String -> Repl ()+padOut b s m = do outputStr . unlines . map (s ++) . lines $ m+ repl b++process :: Bindings -> String -> Repl ()+process b inp = case evaluate b inp of+ Value c -> padOut b " == " $ show c+ Text t -> padOut b " ~~ " t+ Error e -> padOut b " !! " e+ NewBindings b' -> repl b'+#ifdef PLOT+ Action io -> liftIO io >> repl b+#endif --------------------------------------------------------------------------------