Computer Science, Haskell, Programming

Haskell for Beginners: Creating a Calculator

By 05st

This is the first of a series of blog posts targeted toward people who may be new to Haskell. Some knowledge of programming in Haskell is assumed.

Writing a simple calculator app can be a great way to introduce yourself to a new programming language. In the case of Haskell, well, it's basically made to do stuff like that. After all, a calculator is essentially just a pure function: input a string, output a number. Along the way, we recursively build up an abstract syntax tree, perform transformations on it, and finally, we fold the abstract syntax tree into a single result.

Additionally, writing a calculator will be a good introduction to a few essential Haskell libraries such as Megaparsec, optparse-applicative, and more.

Make sure to have the following in your project dependencies:

- text
- megaparsec
- parser-combinators
- optparse-applicative
- mtl

The Abstract Syntax Tree

Before we can begin parsing our input, we must have some easy-to-use internal representation for it. Our representation is going to be in the form of a tree.

-- src/Expr.hs
module Expr (Expr, Oper) where

import Data.Text (Text)

data Oper
	= Add | Sub
	| Mul | Div
	| Pow | Fac
	deriving (Show)
	
data Expr
	= ELit Double
	| EVar Text
	| EBinOp Oper Expr Expr
	| EUnaOp Oper Expr
	deriving (Show)

(Note: it's usually recommended to use Data.Text instead of String in Haskell, as it's much more efficient.)

Our basic calculator will support 6 operations (+, -, *, /, ^, and !). As an example, (5 * 4)! + pi * 3^2 will be represented in our AST like this:

EBinOp Add
	EUnaOp Fac
		EBinOp Mul
			ELit 5.0
			ELit 4.0
	EBinOp Mul
		EVar "pi"
		EBinOp Pow
			ELit 3.0
			ELit 2.0

The Parser

We can now begin parsing the actual user input as we have our abstract syntax tree ready. For this, we will be using the Megaparsec library. Megaparsec is a monadic parser combinator library - check out this blog post to understand what parsing is, what parser combinators are, and how to write your own parser combinators.

To get started, we should first define our Parser type. Parsec is a type defined in Text.Megaparsec. The Void indicates we aren't supplying a custom error component, and Text is our input stream.

-- src/Parser.hs
module Parser where

import Data.Char
import Data.Text (Text, singleton)
import Data.Void (Void)

import qualified Text.Megaparsec as P
import qualified Text.Megaparsec.Char as P
import qualified Text.Megaparsec.Char.Lexer as L
import Control.Monad.Combinators.Expr

import Expr

type Parser = P.Parsec Void Text

Now we should define some helper functions. Since we are ignoring whitespace, we'll need something to take care of whitespace. Megaparsec also conveniently provides a lexeme combinator that takes in a whitespace parser, and that allows us to parse any future tokens without considering whitespace. We will also need to be able to parse specific arbitrary text/symbols with symbol, variables with identifier, and of course float literals with float. Another useful combinator we will add is parens, which will parse something enclosed in parentheses.

-- src/Parser.hs
...

-- The first argument to L.space is a single whitespace parser.
-- The last two are for comments, which our syntax doesn't support.
spaces :: Parser ()
spaces = L.space P.space1 P.void P.void

lexeme :: Parser a -> Parser a
lexeme = L.lexeme spaces

symbol :: Text -> Parser Text
symbol = L.symbol spaces

float :: Parser Double
float = lexeme L.float

-- To prevent ambiguity, identifiers must start with a letter - but can
-- contain any alphanumeric characters afterward.
-- Also, using combinators such as `takeWhileP` is much more efficient
-- than using something like `many` or `some`.
identifier :: Parser Text
identifier = lexeme $ mappend
	<$> (singleton <$> P.letterChar)
	<*> P.takeWhileP (Just "alphanumeric character") isAlphaNum

parens :: Parser a -> Parser a
parens = P.between (lexeme (P.char '(')) (lexeme (P.char ')'))

Finally, with these helper functions, we can begin to write the main parser. Essentially it's just going to be a few mutually recursive functions. Megaparsec (well, actually the parser-combinators library) will make all of it extremely easy with makeExprParser, which handles parsing operators of all precedences and fixities. All we need to do is pass in an operator table.

-- src/Parser.hs
...

parseExpression :: Parser Expr
parseExpression = makeExprParser parseTerm operTable <?> "expression"
	where
		operTable =
			[ [ postfix Fac ]
			, [ prefix Sub
				, prefix Add ]
			, [ binary InfixR Pow ]
			, [ binary InfixL Mul
				, binary InfixL Div ]
			, [ binary InfixL Add
				, binary InfixL Sub ] ]
		
		binary assoc oper = assoc (EBinOp oper <$ operParser oper)
		prefix oper = Prefix (EUnaOp oper <$ operParser oper)
		postfix oper = Postfix (EUnaOp oper <$ operParser oper)
	
		operParser = symbol . operSymbol
		operSymbol oper =
			case oper of
				Add -> "+"
				Sub -> "-"
				Mul -> "*"
				Div -> "/"
				Pow -> "^"
				Fac -> "!"
		-- Using the LambdaCase language extension
		-- can make that case expression look nicer

Whew. That was quite a bit of code for a single function. Let's dissect it. makeExprParser requires two arguments. The first is going to be a parser for terms (essentially the operands). The second argument is a table of operators. Specifically, a 2-dimensional list. Each inner list specifies a level of operator precedence. For example, the Fac operator has the highest precedence. Each element of the inner list must be an operator definition: InfixL, InfixR, Prefix, and Postfix. We defined some helper functions to prevent lots of repeated code. As for what each of those operator definitions are, I highly recommend reading the docs.

Moving on, we need to define parseTerm now. Terms are just going to be either a nested expression in parentheses, a variable, or a float literal. We can use the <|> operator from Megaparsec to allow choice.

-- src/Parser.hs
...

parseTerm :: Parser Expr
parseTerm = parens parseExpression
		 <|> (EVar <$> identifier)
		 <|> (ELit <$> float)

Should be mostly straightforward.

To finish up the Parser module, we should add a function to allow us to run our parser for some input. Since the parser may fail, it should evaluate into an Either String Expr. Errors are just going to be simple String messages.

-- src/Parser.hs
module Parser (parse) where

import Data.Bifunctor (first)

...

parse :: Text -> Either String Expr
parse = first P.errorBundlePretty . P.parse parseExpression "input"

The P.parse function from Megaparsec takes in a string for the name of the input file for error reporting purposes. Since we don't care about input files, we can just put in some arbitrary string. first from Data.Bifunctor maps over Left (P.parse returns a ParseErrorBundle in Left, but we want a String, so we use errorBundlePretty which is also provided by Megaparsec).

Our parser is completed! We've done quite a lot already in such few lines of code.

The Evaluator

All that's left for us to do is implement the actual evaluator. It's going to recursively traverse through the parsed abstract syntax tree, and end up returning a single Double - the answer.

Since our evaluator may need to report errors, we should use something like the Except monad (from the mtl library). For convenience, we should also define a type synonym.

-- src/Eval.hs
module Eval where

import Control.Monad.Except
import Expr

type Eval = Except String

Now we need to write our actual recursive expression evaluator function. It will take in an Expr and return an Eval Double.

-- src/Eval.hs
...

evaluateExpr :: Expr -> Eval Double
evaluateExpr (ELit num) = pure num
evaluateExpr (EVar var) =
	case var of
		"pi" -> pure pi
		"e" -> pure (exp 1)
		_ -> throwError ("Unknown variable " ++ show var)
evaluateExpr (EBinOp op a b) = do
	a' <- evaluateExpr a
	b' <- evaluateExpr b
	case op of
		Add -> pure (a' + b')
		Sub -> pure (a' - b')
		Mul -> pure (a' * b')
		Div -> pure (a' / b')
		Pow -> pure (a' ** b')
		_ -> throwError ("Invalid binary operator " ++ show op)
evaluateExpr (EUnaOp op a) = do
	a' <- evaluateExpr a
	case op of
		Sub -> pure (negate a')
		Add -> pure a'
		Fac -> return (fromInteger (product [1 .. (floor a')]))
		_ -> throwError ("Invalid unary operator " ++ show op)

Now of course we need to define a function evaluate to allow us to run the evaluator.

-- src/Eval.hs
module Eval (evaluate) where
...

evaluate :: Expr -> Either String Double
evaluate = runExcept . evaluateExpr

The Command Line Interface

We're so close! We still have to add one last - but essential - thing: the command line interface. We will use optparse-applicative to do this.

-- app/Main.hs
module Main where

import Data.Text (Text, pack)
import Options.Applicative

import Parser
import Eval

-- Note: `Parser` is from optparse-applicative, not our `Parser` module
parseInput :: Parser String
parseInput = argument (pack <$> str) (metavar "INPUT")

main :: IO ()
main = runCalculator =<< execParser (parseInput `withInfo` "Calculator")
	where
		withInfo opts desc = info (helper <*> opts) (progDesc desc)

runCalculator :: Text -> IO ()
runCalculator inp =
	case parse inp >>= evaluate of
		Left err -> putStrLn err
		Right res -> print res

To understand the code above, I can only really recommend reading the optparse-applicative docs. There's not much pure Haskell code to get into there.

Testing

We're finished! In only around 115 lines of Haskell code, we have a working calculator. Let's test it.

stack run -- "1+2"
	3.0
stack run -- "-(16^0.5)"
	-4.0
stack run -- "(3 * 2)! + pi * 3^2"
	748.27433388230813914616379044952

Looks like it's working as expected!

What now?

Great question. There are tons of ways you could improve this simple calculator app. Here are some ideas:

  • Add support for mathematical functions (sqrt, exp, log, ...)
  • Allow defining variables (let x = <expr> in <expr>)
    • Why not also allow defining functions?
  • Support symbolic calculations
  • Turn it into a full-fledged programming language!

If you have any questions, please contact me or ask in the comments.

Comments