Skip to content

Instantly share code, notes, and snippets.

@rylev
Created February 24, 2014 11:53
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save rylev/9187017 to your computer and use it in GitHub Desktop.
Save rylev/9187017 to your computer and use it in GitHub Desktop.
Simple and Incredibly Naive Calculator
module Main where
import System.Environment
import Text.ParserCombinators.Parsec
import Control.Monad
import Data.Char
main :: IO ()
main = do putStrLn "What would you like to calculate:"
input <- getLine
putStrLn $ readExpr input
readExpr :: String -> String
readExpr input = case parse parseExpr "calc" input of
Left err -> "Whoops, looks like you made a syntax error: " ++ show err
Right answer -> show $ reduceExpr answer
reduceExpr :: Expr -> Integer
reduceExpr expression = case expression of
Addition left right -> (reduceExpr left) + (reduceExpr right)
Subtraction left right -> (reduceExpr left) - (reduceExpr right)
Multiplication left right -> (reduceExpr left) * (reduceExpr right)
Division left right -> (reduceExpr left) `div` (reduceExpr right)
Value v -> v
data Expr = Value Integer
| Addition Expr Expr
| Subtraction Expr Expr
| Multiplication Expr Expr
| Division Expr Expr
deriving (Show)
parseExpr :: Parser Expr
parseExpr = (try parseAddition)
<|> (try parseSubtraction)
<|> (try parseMultiplication)
<|> (try parseDivision)
<|> parseValue
parseBinaryExpr :: Char -> (Expr -> Expr -> Expr) -> Parser Expr
parseBinaryExpr operator constructor = do spaces
left <- many1 digit
spaces
char operator
spaces
right <- many1 digit
return $ constructor ((Value . read) left) ((Value . read) right)
parseAddition :: Parser Expr
parseAddition = parseBinaryExpr '+' Addition
parseSubtraction :: Parser Expr
parseSubtraction = parseBinaryExpr '-' Subtraction
parseMultiplication :: Parser Expr
parseMultiplication = parseBinaryExpr '*' Multiplication
parseDivision :: Parser Expr
parseDivision = parseBinaryExpr '/' Division
parseValue :: Parser Expr
parseValue = do val <- many1 digit
return $ Value . read $ val
@sol
Copy link

sol commented Feb 24, 2014

Pretty cool. Still, it can be further simplified:

  • Use applicative style
  • Function application has highest precedence, so all those parentheses are redundant
  • Using x and y instead of left and right is more idiomatic Haskell
  • Having an IsString instance for Parser allows for further simplifications (this should actually be provided by parsec...)
{-# LANGUAGE OverloadedStrings, FlexibleInstances, GADTs #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where
import Control.Applicative
import Text.ParserCombinators.Parsec hiding ((<|>))
import Data.String

instance (a ~ String) => IsString (Parser a) where
  fromString = string

main :: IO ()
main = do
  putStrLn "What would you like to calculate:"
  parseAndEval <$> getLine >>= putStrLn

parseAndEval :: String -> String
parseAndEval = either err (show . eval) . parse expr ""
  where
    err e = "Whoops, looks like you made a syntax error: " ++ show e

eval :: Expr -> Integer
eval e = case e of
  Addition x y -> eval x + eval y
  Subtraction x y -> eval x - eval y
  Multiplication x y -> eval x * eval y
  Division x y -> eval x `div` eval y
  Value x -> x

data Expr = Value Integer
          | Addition Expr Expr
          | Subtraction Expr Expr
          | Multiplication Expr Expr
          | Division Expr Expr
          deriving (Show)

expr :: Parser Expr
expr =  try addition
    <|> try subtraction
    <|> try multiplication
    <|> try division
    <|> value

addition :: Parser Expr
addition = Addition <$> value <*> ("+" *> value)

subtraction :: Parser Expr
subtraction = Subtraction <$> value <*> ("-" *> value)

multiplication :: Parser Expr
multiplication = Multiplication <$> value <*> ("+" *> value)

division :: Parser Expr
division = Division <$> value <*> ("-" *> value)

value :: Parser Expr
value = Value . read <$> (spaces *> many1 digit <* spaces)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment