Introduction, Haskell, and Type Classes
These notes serve as material for the Advanced Programming (AP) course at DIKU. They do not form a complete textbook and may not be comprehensible outside the context of the course. In particular, they assume that basic Haskell programming skills are acquired through other means, for example via textbooks such as Programming in Haskell. The notes serve to emphasize the course perspectives, as well as contain material that we could not find of sufficient quality and brevity elsewhere.
The text will contain many links to other resources online. Unless explicitly indicated, you can consider these to be supplementary, rather than required reading.
There is one chapter per week, containing material of relevance to that week's teaching activities and assignment.
Course Principles
Although the Course Description contains a rather dry list of learning goals, you may also benefit from keeping the following principles in mind when reading these notes. They reflect the philosophy behind the course, and our rationale for picking the material and constructing the assignments.
In AP, we study programming methodologies based on the following principles.
-
Precision. Code should clearly specify what it does and does not do; largely accomplished through the use of advanced type systems and type-directed design. This is why we use Haskell as our language in the course.
-
Separation of concerns. It is a fairly mainstream point of view that modular programs, separated into independent units with minimal functional overlap and interdependence, are easier to write and maintain. By making use of programming techniques that provide precision, we can ensure and verify that our programs are structured thus. Monadic programming is one particularly clear example of this principle, and the one that is our principal object of study, which separates the use of effects from the definitions of effects.
-
Principled design. By structuring programs along rigorously defined abstractions, such as monads or similar effect boundaries, we can develop principles for systems design that are both simple and effective, and elegantly support features such as resilience, that can often become quite messy.
We demonstrate these principles through code written in the Haskell programming language, but they are language-agnostic, and can be applied in any language (although often in more awkward forms, for languages that do not provide the requisite flexibility of expression).
While AP is a course focused on practical programming, the time constraints of a seven week course means that we cannot directly study the large programs where these techniques are the most valuable. Instead our examples, exercises, and assignments will be small "toy programs" that cut any unnecessary detail or functionality in order to focus on the essential principles. This does not mean that the techniques we teach in AP to not scale up to large programs; merely that we do not have time for you to observe it for yourselves. You will just have to use your imagination.
Why so many interpreters?
Many of the examples, exercises, and assignments in AP will be in the context of writing interpreters, type checkers, or parsers for programming languages. This is not solely because the teachers happen to enjoy this aspect of computer science, but rather because these domains contain the essence of problems that occur frequently in real-world programming.
-
Interpretation is about making operational decisions and changing state based on program input.
-
Type checking is input validation.
-
Parsing is recovering structured information from unstructured input.
For didactical reasons, AP mostly focuses on problems that exclusively contains these problems (and little "business logic"), but the ideas we study are applicable even outside the rather narrow niche of implementing programming languages.
Testing
In the assignments you will be required to write tests. You must use
the Haskell package Tasty
to write our tests. Tasty is a meta-framework that allows different
testing frameworks to be combined - in particular, hunit for unit
tests and QuickCheck for property-based testing. Although you will
initially only be writing unit tests, later in the course you will be
taught property-based testing. In order to avoid having to switch
testing framework halfway through the course, we use Tasty from the
start.
Generally the code handout will already contain dependencies on the
relevant packages. The ones we will use in the following are tasty
and tasty-hunit, which you can add to the build-depends field of
your .cabal file.
The Tasty documentation is fairly good and you are encouraged to read it. However, this section will list everything you need to know for the first week of AP.
Structuring tests
There are many ways of structuring test suites. Because the programs
you will write in AP are so small, we will use a particularly simple
scheme. For any Haskell module Foo, the tests will be in a
corresponding test module called Foo_Tests. Each test module
defines a test suite named test, which in Tasty is of type
TestTree. We will see below how to define these.
To run the tests for an entire project, we write a test runner, which
we will normally call runtests.hs. This test runner will import the
various TestTrees, combine them if necessary, and pass them to the
defaultMain function provided by Tasty. When the program is run,
Tasty will run the test suite and report any errors. If the test
runner is registered as a test suite in the .cabal file, we can use
the cabal test command to run the tests. This will be the case for
all code handouts that come with a .cabal file.
A test runner can look like this, where we assume the tests are
defined in a module Foo_Tests:
import qualified Foo_Tests
import Test.Tasty (defaultMain)
main :: IO ()
main = defaultMain Foo_Tests.tests
If we load this module into ghci, we can also simply execute main
to run the test suite. This makes interactive development easy.
Writing tests
To write a unit test, we import the module
Test.Tasty.HUnit.
This gives us access to a variety of functions that produce
TestTrees. For example, testCase:
testCase :: TestName -> Assertion -> TestTree
The TestName type is a synonym for String and is used to label
failures. The Assertion type is a synonym for IO (), but in
practice it is constructed using a variety of constructor functions.
One of the simplest is assertBool:
assertBool :: String -> Bool -> Assertion
We give it a String that is shown when the test fails, and then a
Bool that is True when the test succeeds. This is how we can write
a test that fails:
failingTest :: TestTree
failingTest = TestCase "should not work" $ assertBool "1 is not 2" $ 1==2
And here is one that succeeds:
successfulTest :: TestTree
successfulTest = TestCase "should work" $ assertBool "1 is 1" $ 1==1
We can combine multiple TestTrees with testGroup:
tests :: TestTree
tests =
testGroup
"unit test suite"
[ successfulTest,
failingTest
]
The first argument is a descriptive string, and the second is a list
of TestTrees. We can use this to define test suites with arbitrarily
complicated nesting (and support for running only parts of the entire
test suite), but this is not needed for the comparatively simple test
suites we write in AP.
The Test.Tasty.HUnit module also provides other handy operators for
certain common cases. For example, @?= can be used for testing
equality in a more concise way than using assertBool:
failingTest2 :: TestTree
failingTest2 = testCase "should not work 2" $ 1 @?= 2
When run, this will produce output such as the following:
unit test suite
should work: OK
should not work: FAIL
.../Week1/Tests.hs:10:
1 is not 2
Use -p '/should not work/' to rerun this test only.
should not work 2: FAIL
.../Week1/Tests.hs:13:
expected: 2
but got: 1
Use -p '$0=="unit test suite.should not work 2"' to rerun this test only.
Timeouts
Tasty does not know how long a test is supposed to run for, but
sometimes we do. We can ask Tasty to fail tests after a specified
period via the mkTimeout and localOption functions, which are
imported from Test.Tasty. For example, if we want to apply a one
second timeout to all tests contained in a given testTree, we could
write:
tests :: TestTree
tests =
localOption (mkTimeout 1000000) $ testGroup
"unit test suite"
[ successfulTest,
failingTest
]
The timeout applies to each individual test in the tree passed to
localOption, not to the entire test suite.
Useful types
This section discusses various useful Haskell types that are available in the base library, as well as common functions on those types. We will make use of some of these types in the later chapters.
Maybe
The Maybe type is available in the Prelude (the module that is
implicitly imported in every Haskell program), but has the following
definition:
data Maybe a = Nothing
| Just a
A value of type Maybe a is either Nothing, representing the
absence of a value, or Just x for some value x of type a. It is
often called the option type, and serves roughly the same role as
the null value in poorly designed languages, but in contrast to
null is visible in the type system.
It is often used to represent an operation that can fail. For example, we can imagine a function of type
integerFromString :: String -> Maybe Int
that tries to turn a String into an Integer, and either returns
Nothing, indicating that the String is malformed, or Just x,
where x is the corresponding integer. We will return to this in
Week 3.
One useful function for operating on Maybe values is the maybe
function:
maybe :: b -> (a -> b) -> Maybe a -> b
It accepts a value that is returned in the Nothing case, and
otherwise a function that is applied to the value in the Just case.
It is equivalent to pattern matching, but is more concise.
Another function, which we must import from the
Data.Maybe
module, is fromMaybe:
fromMaybe :: a -> Maybe a -> a
It turns a Maybe a into an a by providing a default value:
> fromMaybe 0 Nothing
0
> fromMaybe 0 (Just 1)
1
Again this is nothing we could not write ourselves using case, but
using these functions can result in neater code.
Either
The Either type is available in the Prelude and has this definition:
data Either a b = Left a
| Right b
It is used to represent two different possibilities, with different
types. In practice, it is often used to represent functions that can
fail, with the Left constructor used to represent information about
the failure, and the Right constructor used to represent success.
A useful function for manipulating Either values is either:
either :: (a -> c) -> (b -> c) -> Either a b -> c
Void
The Void type must be imported from Data.Void and has the
following definition:
data Void
This odd-looking type has no constructors, meaning there are no
values of type Void. This is admittedly somewhat exotic, but it has
some uses. For example, if we have a function of type Int -> Void,
we know that this function cannot possibly return, as no value of type
Void can be constructed. This is not really useful for a pure
function, but if we have an impure function with side-effects, such as
the infinite loops that are used in servers for reading incoming
requests (later in the course), then it may be sensible to use a
Void return type to clarify that the function will never terminate.
Another use of Void is to eliminate cases in polymorphic types. For
example, if we have a type Either Void a, then we know that the
Left case can never occur. This means we do not need to handle it
when pattern matching the Either type.
This is strictly not true. Haskell is a lazy language, so every value is inhabited by the special value ⊥ ("bottom"), which represents a diverging computation. Example:
> Left undefined :: Either Void Integer
Left *** Exception: Prelude.undefined
We will return to laziness later in the course, but it is standard to reason about the type-level guarantees of Haskell code as if it were eager.
Type classes
Type classes are Haskell's main way of specifying abstract interfaces
that can be implemented by concrete types. For example, the predefined
Eq type class is the interface for any type a that support
equality:
class Eq a where
(==) :: a -> a -> Bool
(/=) :: a -> a -> Bool
This interface defines two methods, (==) and (/=), of the
specified type, which all type classes must implement. The enclosing
parentheses denote that these are actually the infix operators ==
and /=.
We can write polymorhic functions that require that the polymorphic types implement a type class. This is done by adding a type class constraint to the type of the function. For example:
contains :: (Eq a) => a -> [a] -> Bool
contains _ [] = False
contains x (y : ys) = x == y || contains x ys
In the definition of contains, we are able to use the == method on
values of type a. If we removed the (Eq a) constraint from the
type signature, we would get a type error.
Implementing an instance
When implementing an instance for a type class, we must implement all the methods described in the interface.
Despite the similarity in nomenclature (class, instance, method), type classes are completely unrelated to classes in object oriented programming, except that both concepts are related to specifying interfaces.
For example, if we define our own type for representing a collection of programming languages:
data PL
= Haskell
| FSharp
| Futhark
| SML
| OCaml
Then we can define an Eq instance for PL as follows:
instance Eq PL where
Haskell == Haskell = True
FSharp == FSharp = True
Futhark == Futhark = True
SML == SML = True
OCaml == OCaml = True
_ == _ = False
x /= y = not $ x == y
In fact, the Eq class has a default method for /= expressed in
terms of ==, so we can elide the definition of /= in our instance.
Haskell has a handful of built-in type classes. For us, the most
important of these are Eq (equality), Ord (ordering), and Show
(converting to text). The Haskell compiler is able to automatically
derive instances for these when defining a datatype:
data PL
= Haskell
| FSharp
| Futhark
| SML
| OCaml
deriving (Eq, Ord, Show)
This is very convenient, as the definitions of such instances are
usually very formulaic. You should add deriving (Eq, Ord, Show) to
all datatypes you define.
Type class laws
Type classes are often associated with a set of laws that must hold
for any instance of the type class. For example, instances of Eq
must follow the usual laws we would expect for an equality relation:
- Reflexivity:
x == x=True - Symmetry:
x == y=y == x - Transitivity: if
x == y && y == z=True, thenx == z=True - Extensionality: if
x == y=Trueandfis a function whose return type is an instance ofEq, thenf x == f y=True - Negation:
x /= y=not (x == y).
Unfortunately, these laws are not checked by the type system, so we must be careful verify that our instances behave correctly. An instance that follows the proscribed laws is called lawful. The instances that are automatically derived by the compiler will always be lawful (unless they depend on hand-written instances that are not lawful).
Functor
One of the important standard type classes is Functor, which
abstracts the notion of a "container of values", where we can apply a
function to transform the contained values. We should not carry this
metaphor too far, however: some of the types that are instances of
Functor are only "containers" in the loosest of senses. The somewhat
exotic name Functor is inspired by a branch of mathematics called
category theory (as are many other Haskell terms), but we do not
need to understand category theory in order to understand the
Functor type class:
class Functor f where
fmap :: (a -> b) -> f a -> f b
The fmap method specified by Functor is essentially a
generalisation of the map we are used to for lists. One interesting
detail is that Functor instances are not defined for types, but
for type constructors. See how the fmap method turns an f a into
an f b, intuitively changing the a values to b values. That
means f by itself is not a type - it must be applied to a type,
and hence is a type constructor.
This is perhaps a bit easier to understand if we first define our own type of linked lists.
data List a
= Nil
| Cons a (List a)
deriving (Eq, Ord, Show)
Our List type is equivalent to Haskell's built-in list type (which
is already an instance of Functor), but without the syntactic sugar.
We can define a Functor instance for List as follows:
instance Functor List where
fmap _ Nil = Nil
fmap f (Cons x xs) = Cons (f x) (fmap f xs)
Functor laws
Any Functor instance must obey these laws:
-
Identity:
fmap id == id. -
Composition:
fmap (f . g) == fmap f . fmap g.
Intuitively, they say that fmap is not allowed to do anything beyond
applying the provided function. For example, we cannot store a count
of how many times fmap has been applied, or otherwise tweak the
observable structure of the container that is being fmaped (e.g. by
reversing the list or some such).
Foldable
Type classes allow us to write functions that are generic and reusable
in varied contexts. An example of this is the standard class
Foldable,
which allows us to iterate across all elements of a "container". Its
true definition looks more complicated than it really is, due to a
large number of optional methods. The following is an abbreviated (but
still correct) description of Foldable:
class Foldable t where
foldr :: (a -> b -> b) -> b -> t a -> b
That is, we must provide a method foldr for iterating across the
elements of type a, while updating an accumulator of type b, which
yields a final accumulator b. An instance of Foldable for out
List type looks like this:
instance Foldable List where
foldr _ acc Nil = acc
foldr f acc (Cons x xs) = f x (foldr f acc xs)
Once a type is an instance of Foldable, we can define a remarkable
number of interesting functions in termss of foldr (all of which are
already defined for you in the Prelude).
For example, we can turn any Foldable into a list:
toList :: (Foldable f) => f a -> [a]
toList = foldr op []
where
op x acc = x : acc
> toList (Cons 1 (Cons 2 (Cons 3 Nil)))
[1,2,3]
Or we can see whether a given element is contained in the collection:
elem :: (Eq a, Foldable f) => a -> f a -> Bool
elem needle = foldr op False
where
op x acc =
acc || x == needle
> elem 1 (Cons 1 (Cons 2 (Cons 3 Nil)))
True
> elem 4 (Cons 1 (Cons 2 (Cons 3 Nil)))
False
Phantom Types
In this section we will briefly look at a programming technique that uses types to associate extra information with values and expressions, without any run-time overhead. As our example, we will consider writing a function that implements the kinetic energy formula:
\[ E = \frac{1}{2} m v^2 \]
Here m is the mass of the object, v is its velocity, and E is the resulting kinetic energy. We can represent this easily as a Haskell function:
energy :: Double -> Double -> Double
energy m v = 0.5 * m * (v ** 2)
However, it is quite easy to mix up which of the two arguments is the
mass and which is the velocity, given that they have the same types
(Double). To clarify matters, we can define some type synonyms:
type Mass = Double
type Velocity = Double
type Energy = Double
energy :: Mass -> Velocity -> Energy
energy m v = 0.5 * m * (v ** 2)
However, type synonyms are just that: synonyms. We can use a Mass
whenever a Velocity is expected (or an Energy for that matter), so
while the above makes the type of the energy function easier to read
for a human, the type checker will not catch mistakes for us.
Instead, let us try to define actual types for representing the physical quantities of interest.
data Mass = Mass Double
deriving (Show)
data Velocity = Velocity Double
deriving (Show)
data Energy = Energy Double
deriving (Show)
energy :: Mass -> Velocity -> Energy
energy (Mass m) (Velocity v) = Energy (0.5 * m * (v ** 2))
Now we are certainly prevented from screwing up.
> energy (Mass 1) (Velocity 2)
Energy 2.0
> energy (Velocity 2) (Mass 1)
<interactive>:54:9-18: error: [GHC-83865]
• Couldn't match expected type ‘Mass’ with actual type ‘Velocity’
• In the first argument of ‘energy’, namely ‘(Velocity 2)’
In the expression: energy (Velocity 2) (Mass 1)
In an equation for ‘it’: it = energy (Velocity 2) (Mass 1)
<interactive>:54:22-27: error: [GHC-83865]
• Couldn't match expected type ‘Velocity’ with actual type ‘Mass’
• In the second argument of ‘energy’, namely ‘(Mass 1)’
In the expression: energy (Velocity 2) (Mass 1)
In an equation for ‘it’: it = energy (Velocity 2) (Mass 1)
However, this solution is somewhat heavyweight if we want to also
support operations on the Mass, Velocity, and Energy types.
After all, from a mathematical (or physical) standpoint, these are all
numbers with units, and we may want to support number-like
operations on them. Unfortunately, we end up having to implement
duplicate functions for every type:
doubleMass :: Mass -> Mass
doubleMass (Mass x) = Mass (2 * x)
doubleVelocity :: Velocity -> Velocity
doubleVelocity (Velocity x) = Velocity (2 * x)
doubleEnergy :: Energy -> Energy
doubleEnergy (Energy x) = Energy (2 * x)
This is not great, and becomes quite messy once we have many functions and types. Instead, let us take a step back and consider how physicists work with their formulae. Each number is associated with a unit (joules, kilograms, etc), and the units are tracked across calculations to ensure that the operations make sense (you cannot add joules and kilograms). This is very much like a type system, but they don't do it by inventing new kinds of numbers (well, they do that sometimes), but rather by adding a kind of unit tag to the numbers.
Haskell allows us to do a very similar thing. First, we define some types that do not have constructors:
data Joule
data Kilogram
data MetrePerSecond
Similar to Void, we cannot ever have a value of type Kilogram, but
we can use it at the type level. Specifically, we now define a type
constructor Q for representing a quantity of some unit:
data Q unit = Q Double
deriving (Eq, Ord, Show)
Note that we do not actually use the type parameter unit in the
right hand side of the definition. It is a phantom type, that exists
only at compile-time, in order to constrain how Qs can be used. When
constructing a value of type Q, we can instantiate that unit with
anything we want. For example:
weightOfUnladenSwallow :: Q Kilogram
weightOfUnladenSwallow = Q 0.020
We can still make mistakes when we create these values from scratch, by providing a nonsense unit:
speedOfUnladenSwallow :: Q Joule
speedOfUnladenSwallow = Q 9
But at least we are prevented from mixing unrelated quantities:
> speedOfUnladenSwallow == weightOfUnladenSwallow
<interactive>:69:26-47: error: [GHC-83865]
• Couldn't match type ‘Kilogram’ with ‘Joule’
Expected: Q Joule
Actual: Q Kilogram
Now we can define a safe energy function:
energy :: Q Kilogram -> Q MetrePerSecond -> Q Joule
energy (Q m) (Q v) = Q (0.5 * m * (v ** 2))
And in contrast to before, we can define unit-preserving utility
functions that apply to any Q:
double :: Q unit -> Q unit
double (Q x) = Q (2 * x)
Phantom types is a convenient technique that requires only a small amount of boilerplate, and can be used to prevent incorrect use of APIs. The type errors are usually fairly simple as well. While phantom types do not guarantee the absence of errors - that requires techniques outside the scope of our course - they are a very practical programming technique, and one of our first examples of fancy use of types. We will return to these ideas later in the course.
A full expression of the SI system of measures in a type system, including a proper handling of compound units such as m/s, requires type-level programming beyond simply using phantom types, and are beyond the scope of this course.
Using newtype
Instead of using data, it is best practice to define Q with
newtype:
newtype Q unit = Q Double
We can use newtype whenever we define a datatype with a single
constructor that has a single-value - intuitively, whenever we simply
"wrap" an underlying type. The difference between data and newtype
are semantically almost nil (and the edge case does not matter for
this course), but newtype is slightly more efficient, as the
constructor does not exist when the program executes, meaning our use
of newtype carries no performance overhead whatsoever. In contrast,
a type declared with data must store the constructor.
Monads
Monads are a way to describe effectful computation in a functional setting. In Haskell, they are unavoidable as they are used to support true side effects (writing to files etc) with the built-in IO monad. However, monads can also be used as a powerful program structuring technique, even for programs that do not directly interact with the outside world.
Applicative Functors
To motivate the value of monads (and some of the supporting
machinery), consider if we have a value x :: Maybe Int. We can see
such a value as a computation that is either an Int or Nothing,
with the latter case representing some kind of failure. We can
interpret failure as a kind of effect, that is separate from the
functional value (Int), although of course they are all just normal
Haskell types.
We are often in a situation where we want to perform a computation on the result (if it exists), or otherwise propagate the failure. We can do this with explicit pattern matching:
case x of
Nothing -> Nothing
Just x' -> Just (x'+1)
To make this more concise, we can use the Functor instance for
Maybe that we saw last week:
fmap (+1) x
The above works because we are applying a pure function of type Int -> Int to the value in the Maybe. But what if the function is also
produced from some potentially failing computation, e.g. what if f :: Maybe (Int -> Int)? Then fmap f x will be ill-typed, because f is
not a function - it is a function contained in an effectful
computation (or less abstractly, stored in a Maybe container).
We can write it using pattern matching, of course:
case f of
Just f' ->
case x of
Just x' -> Just (f' x')
Nothing -> Nothing
Nothing -> Nothing
But all this checking for Failure becomes quite verbose. Our
salvation comes in the form of another typeclass, Applicative, which
describes applicative functors. Any applicative functor must also be
an ordinary functor, which we can add as a superclass constraint:
class Functor f => Applicative f where
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
The pure method injects a pure value into an effectful computation.
The (<*>) method applies a function stored in an applicative functor
to a value stored in an applicative functor, yielding an applicative
functor. Essentially, it is an extension of the notion of Functor to
also allow the function to be in a "container".
This sounds (and is) abstract, and is perhaps best understood by looking at an example instance:
instance Applicative Maybe where
pure x = Just x
f <*> x = case f of
Just f' ->
case x of
Just x' -> Just (f' x')
Nothing -> Nothing
Nothing -> Nothing
Or equivalently:
instance Applicative Maybe where
pure x = Just x
Just f <*> Just x = Just (f x)
_ <*> _ = Nothing
Now we can write f <*> x rather than writing out the case by hand.
Even better, this will work not just when f and x make use of
Maybe specifically, but any type that is an applicative functor -
and as we shall see, any monad is also an applicative functor.
Monads
Consider now the case where we have a value x :: Maybe Int and a function
f :: Int -> Maybe Int. That is, the function now also has an effect - in
this case, it can fail.
If we use fmap f x, we get something that is well-typed, but the
result has type Maybe (Maybe Int), which is unlikely to be what we
desire. What we need is this function:
maybeBind :: Maybe a -> (a -> Maybe b) -> Maybe b
maybeBind Nothing _ = Nothing
maybeBind (Just x) f = f x
The maybeBind function passes a value of type a to a provided
function that operates on a, but returns a potentially failing
computation (Maybe b). If the original value is Nothing, then the
final result is Nothing. We can now write our application as
maybeBind x f
or using backticks to make the operator infix:
x `maybeBind` f
The intuition here is "first execute x, then apply the pure result
(if any) to f".
It turns out that functions with the same "shape" as maybeBind are
pretty common. For example, we can define a similar one for Either,
where in the type we simply replace Maybe a with Either e a:
eitherBind :: Either e a -> (a -> Either e b) -> Either e b
eitherBind (Left e) _ = (Left e)
eitherBind (Right x) f = f x
Note that we operate only on the Right part of the Either value -
the Left part, which usually represents some kind of error case, is
undisturbed.
We can even define such a function for linked lists:
listBind :: [a] -> (a -> [b]) -> [b]
listBind [] _ = []
listBind (x : xs) f = f x ++ listBind xs f
The type looks a bit different than maybeBind and eitherBind, but
that is just because of the syntactic sugar that lets us write [a]
instead of List a.
It seems that when we have things that behave a bit like "containers"
(in a general sense), we can define these "bind" functions that all
have some similar behaviour. When we observe such similarities, we can
put them into a typeclass. In this case, the typeclass is Monad, and
the "bind" function is named the much more intuitive and
easy-to-pronounce >>=:
class Applicative m => Monad m where
(>>=) :: m a -> (a -> m b) -> m b
Haskell already provides a Monad instance for Maybe, but if it did
not, we would define it as follows:
instance Monad Maybe where
Nothing >>= _ = Nothing
Just x >>= f = f x
Note that this definition is equivalent to the maybeBind above.
Indeed, we could also write this definition like so:
instance Monad Maybe where
(>>=) = maybeBind
An instance definition also exists for Either, equivalent to
eitherBind above. The Maybe and Either monads are heavily used
for tracking errors in Haskell code, similar to how we would use
exceptions in other languages.
Intuition, nomenclature, and slang
Monads when viewed as an abstract interface can be quite tricky to get a grasp of. They are so abstract and general that it can be difficult to understand what the general concept means.
One good approach to learning is to essentially disregard the general
concept, and focus only on specific monads. It is not so difficult to
understand operationally what the Monad instances for Maybe and
Either do, and in this we will mostly be working with specific
monads.
Another approach is to focus on their form in Haskell. A monad is
something that implements the Monad type class, which just means a
we have access to >>= and pure, and can do anything these
functions allow.
From a pedantic viewpoint, a function f of type a -> m b, where
m is some monad (such as Maybe), returns a monadic value of
type m b. We also sometimes say that it returns a command in the
monad m which can produce a value of type b when "executed" (this
term will make a bit more sense for the monads discussed below). We
often also say that f is a monadic function. This is technically
an abuse of nomenclature, but functions that "run within a specific
monad" are such a common concept in Haskell that terse nomenclature is
useful.
Deriving fmap and <*>
It turns out that when some type is an instance of Monad, the fmap
and <*> methods from Functor and Applicative can be expressed in
terms of >>= and pure. This means that when we implement this
trifecta of instances, we only really have to think about >>= and
pure. Specifically, we can define a function liftM that behaves
like fmap for any monad:
liftM :: Monad m => (a -> b) -> m a -> m b
liftM f x = x >>= \x' -> pure (f x')
And similarly a function ap that behaves like <*>:
ap :: Monad m => m (a -> b) -> m a -> m b
ap f x = f >>= \f' ->
x >>= \x' ->
pure (f' x')
It can be shown that these are actually the only law-abiding
definitions for these functions. Further, these functions are
available from the builtin Control.Monad module. This means that
when defining the instances for Maybe, we can take the following
shortcuts:
import Control.Monad (liftM, ap)
instance Applicative Maybe where
(<*>) = ap
instance Functor Maybe where
fmap = liftM
do-notation
Monads are particularly ergonomic to use in Haskell, and the main
reason for this is a bit of syntactic sugar called do-notation,
which allows us to imitate imperative programming.
Roughly speaking, the keyword do begins a block wherein every line
corresponds to a monadic action, with the actions combined with >>=,
and each statement after the first beginning a lambda. As an example,
do x <- foo
y <- bar
baz x y
is syntactic sugar for
foo >>=
(\x -> bar >>=
(\y -> baz x y))
We can break a single statement over multiple lines if we are careful about how we indent them: the continuation lines must be indented more deeply than the first:
do x <- foo one_argument
more arguments...
y <- x
...
Examples of defining and using monads
In the following we will look at examples of how to define and use our own monads. Most of these correspond to monads that are available and commonly used in standard Haskell libraries.
The Reader Monad
The Reader monad is a commonly used pattern for implicitly passing an extra argument to functions. It is often used to maintain configuration data or similar context that would be annoyingly verbose to handle manually, perhaps because it is not used in all cases of a function. We will call this implicit value an environment.
Operationally, a Reader monad with environment env and producing a
value of type a is represented as a function accepting an env and
returning a.
newtype Reader env a = Reader (env -> a)
Coming up with a definition of the Reader type itself requires actual
creativity. On the other hand, the Functor/Applicative/Monad
instances can almost be derived mechanically. I recommend starting
with the the following template code:
instance Functor (Reader env) where
fmap = liftM
instance Applicative (Reader env) where
(<*>) = ap
pure x = undefined
instance Monad (Reader env) where
m >>= f = undefined
The fmap and (<*>) definitions are done, as discussed above. All
we have to do is fill out the definitions of pure and >>=. I
usually start with pure, because it is simpler. We start with this:
pure x = undefined
The Applicative class requires that the pure instance for Reader env has type a -> Reader env a. This means we know two things:
x :: a.- The right-hand side (currently
undefined) must have typeReader env a.
Looking at the type definition of Reader above, we see that any
value of type Reader takes the form of a Reader constructor
followed by a payload. So we write this:
pure x = Reader undefined
Looking at the definition of Reader again, we see that this
undefined must have type env -> a.
Instead of using undefined, we can also use _. This is a so-called
hole, and will cause the compiler to emit an error message
containing the type of the expression that is supposed to be located at the hole.
How do we construct a value of type env -> a? Well, we have a
variable of type a (namely x), so we can simply write an anonymous
function that ignores its argument (of type env) and returns x:
pure x = Reader $ \_env -> x
This concludes the definition of pure. We now turn our attention to
>>=. The line of thinking is the same, where we systematically
consider the types values we have available to us, and the types of
values we are supposed to construct. This is our starting point:
m >>= f = undefined
We know:
m :: Reader env af :: a -> Reader env bundefined :: Reader env b
We don't have anything of type a, so we cannot apply the function
f. One we can do is deconstruct the value m, since we know this is
a single-constructor datatype:
Reader x >>= f = undefined
Now we have the following information:
x :: env -> af :: a -> Reader env bundefined :: Reader env b
The values x and f are functions for which we do not have values
of the required argument type, so we cannot do anything to. But we can
still start adding a constructor to the right-hand side, just as we
did above for pure:
Reader x >>= f = Reader undefined
And again, we know that the undefined here must be a function taking
an env as argument:
Reader x >>= f = Reader $ \env -> undefined
So far we have not used any creativity. We have simply done the only things possible given the structure of the types we have available. We now have this:
x :: env -> af :: a -> Reader env benv :: envundefined :: b
Since we now have a variable of type env, we can apply the function
x. We do so:
Reader x >>= f = Reader $ \env ->
let x' = x env
in undefined
Now we have x' :: a, which allows us to apply the function f:
Reader x >>= f = Reader $ \env ->
let x' = x env
f' = f x'
in undefined
We have f' :: Reader env b, so we can pattern match on f' to
extract the payload. When a type has only a single constructor, we can
do this directly in let, without using case:
Reader x >>= f = Reader $ \env ->
let x' = x env
Reader f' = f x'
in undefined
Now we have f' :: env -> b, which is exactly what we need to finish the
definition:
Reader x >>= f = Reader $ \env ->
let x' = x env
Reader f' = f x'
in f' env
This finishes the Monad instance for Reader. However, we still
need to define the programming interface for the monad. Some monads
(such as Maybe, Either, or lists) directly expose their type
definition. But for more effect-oriented monads like Reader, we
usually want to hide their definition and instead provide an abstract
interface. This usually takes the form of a function for executing a
monadic computation, as well as various functions for constructing
monadic computations. For Reader, we will implement the following
interface:
runReader :: env -> Reader env a -> a
ask :: Reader env env
local :: (env -> env) -> Reader env a -> Reader env a
The runReader function is used to execute a Reader computation,
given an initial environment. It has the following definition:
runReader env (Reader f) = f env
The ask command is used to retrieve the environment. It has the
following definition:
ask = Reader $ \env -> env
The local function executes a given Reader command in a modified
environment. This does not allow stateful mutation, as the environment
is only modified while executing the provided command, not any
subsequent ones:
local f (Reader g) = Reader $ \env -> g (f env)
When using the Reader monad, we will exclusively make use of
runReader, ask, and local (and functions defined in terms of
these), and never directly construct Reader values.
Using the Reader Monad
The Reader monad is mostly useful when writing functions with many
cases, where only some need to make use of the environment. This means
compelling examples are relatively verbose. You will see such examples
in the course exercises, but for now, we will use a somewhat contrived
example of modifying a binary tree of integers, such that every node
is incremented with its distance from the root.
First we define the datatype.
data Tree
= Leaf Int
| Inner Tree Tree
deriving (Show)
> (Leaf 0 `Inner` Leaf 0) `Inner` Leaf 0
Inner (Inner (Leaf 0) (Leaf 0)) (Leaf 0)
Then we can define a monadic recursive function over Tree:
incLeaves :: Tree -> Reader Int Tree
incLeaves (Leaf x) = do
depth <- ask
pure $ Leaf $ x + depth
incLeaves (Inner l r) = do
l' <- local (+ 1) $ incLeaves l
r' <- local (+ 1) $ incLeaves r
pure $ Inner l' r'
And then we can run our contrived function on some provided tree:
> runReader 0 $ incLeaves $ (Leaf 0 `Inner` Leaf 0) `Inner` Leaf 0
Inner (Inner (Leaf 2) (Leaf 2)) (Leaf 1)
The State Monad
The State monad is similar to the Reader monad, except now we allow
subsequent commands to modify the state. We represent a stateful
computation as a function that accepts a state (of some abstract type
s) and returns a new state, along with a value.
newtype State s a = State (s -> (a, s))
The definitions of the type class instances follow similarly to the ones for Reader, and can be derived largely through the same technique of considering the types of values we have available to us.
instance Monad (State s) where
State m >>= f = State $ \state ->
let (x, state') = m state
State f' = f x
in f' state'
Note that the have the opportunity to make a mistake here, by using
the original state instead of the modified state' produced by m.
instance Functor (State s) where
fmap = liftM
instance Applicative (State s) where
pure x = State $ \state -> (x, state)
(<*>) = ap
We also provide the following API for executing and interacting with stateful computations. First, computation requires that we provide an initial state and returns the final state:
runState :: s -> State s a -> (a, s)
runState s (State f) = f s
The put and get functions are for reading and writing the state.
get :: State s s
get = State $ \s -> (s, s)
put :: s -> State s ()
put s = State $ \_ -> ((), s)
If we want to store more than a single value as state, we simply store a tuple, record, or some other compound structure.
Typically we also define a utility function modify for modifying the
state with a function. This does not need to access the innards of the
state monad, but can be defined in terms of get and put:
modify :: (s -> s) -> State s ()
modify f = do x <- get
put $ f x
Using the State monad
We will use the State monad to implement a function that renumbers the leaves of a tree with their left-to-right traversal ordering.
numberLeaves :: Tree -> State Int Tree
numberLeaves (Leaf _) = do
i <- get
put (i + i)
pure $ Leaf $ i + 1
numberLeaves (Inner l r) = do
l' <- numberLeaves l
r' <- numberLeaves r
pure $ Inner l' r'
We may now use it as follows:
> runState 0 $ numberLeaves $ (Leaf 0 `Inner` Leaf 0) `Inner` Leaf 0
(Inner (Inner (Leaf 0) (Leaf 1)) (Leaf 2),3)
Combining Reader and State
One limitation of monads - in particular the simple form we study in
AP - is that they do not compose well. We cannot in general take two
monads, such as Reader and State, and combine them into a single
monad that supports both of their functionalities. There are
techniques that allow for this, such as monad transformers, but they
are somewhat complex and outside the scope of AP. Instead, if we wish
to have a monad that supports both a read-only environment (such as
with Reader) and a mutable store (such as with State), then we
must write a monad from scratch, such as the following RS monad.
newtype RS env s a = RS (env -> s -> (a, s))
See how the function we use to represent the monad takes two
arguments, env and s, corresponding to the environment and store
respectively, but returns only a new store.
The Monad instance itself is a little intricate, but it just
combines the dataflow that we also saw for the Reader and State
monads above:
instance Monad (RS env s) where
RS m >>= f = RS $ \env state ->
let (x, state') = m env state
RS f' = f x
in f' env state'
The Functor and Applicative instances are then just the usual
boilerplate.
instance Functor (RS env s) where
fmap = liftM
instance Applicative (RS env s) where
pure x = RS $ \_env state -> (x, state)
(<*>) = ap
We can then define the following API for RS, providing both State
and Reader-like operations:
runRS :: env -> s -> RS env s a -> (a, s)
runRS env state (RS f) = f env state
rsGet :: RS env s s
rsGet = RS $ \_env state -> (state, state)
rsPut :: s -> RS env s ()
rsPut state = RS $ \_env _ -> ((), state)
rsAsk :: RS env s env
rsAsk = RS $ \env state -> (env, state)
rsLocal :: (env -> env) -> RS env s env -> RS env s env
rsLocal f (RS g) = RS $ \env state -> g (f env) state
Monadic and Applicative Parsing
It is sometimes the case that we have to operate on data that is not already in the form of a richly typed Haskell value, but is instead stored in a file or transmitted across the network in some serialised format - usually in the form of a sequence of bytes or characters. Although such situations are always regrettable, in this chapter we shall see a flexible technique for making sense out of unstructured data: parser combinators.
Parsing Integers Robustly
To start with, consider turning a String of digit characters into
the corresponding Integer. That is, we wish to construct the
following function:
readInteger :: String -> Integer
The function ord :: Char -> Int from Data.Char can convert a
character into its corresponding numeric code. Exploiting the fact
that the integers have consecutive codes, we can write a function for
converting a digit character into its corresponding Integer. Note
that we have to convert the Int produced by ord into an Integer:
import Data.Char (ord)
charInteger :: Char -> Integer
charInteger c = toInteger $ ord c - ord '0'
Exploiting the property that the numeric characters are consecutively
encoded, we can implement readInt with a straightforward recursive
loop over the characters of the string, from right to left:
readInteger :: String -> Integer
readInteger s = loop 1 $ reverse s
where
loop _ [] = 0
loop w (c : cs) = charInteger c * w + loop (w * 10) cs
Example use:
> readInteger "123"
123
However, see what happens if we pass in invalid input:
λ> readInteger "xyz"
8004
Silently producing garbage on invalid input is usually considered poor
engineering. Instead, our function should return a Maybe type,
indicating invalid input by returning Nothing. This can be done by
using isDigit from Data.Char to check whether each character is a
proper digit:
readIntegerMaybe :: String -> Maybe Integer
readIntegerMaybe s = loop 1 $ reverse s
where
loop _ [] = Just 0
loop w (c : cs)
| isDigit c = do
x <- loop (w * 10) cs
pure $ charInteger c * w + x
| otherwise =
Nothing
Note how we are using the fact that Maybe is a monad to avoid
explicitly checking whether the recursive call to loop fails.
We now obtain the results we would expect:
> readIntegerMaybe "123"
Just 123
> readIntegerMaybe "xyz"
Nothing
Composing Parsers
Now suppose we extend the problem: we must now parse an integer,
followed by a space, followed by another integer. We can of course
write a function that does this from scratch, but it would be better
if we could reuse our function that parses a single integer.
Unfortunately, this is not possible with readIntegerMaybe, as it
requires that the input string consists solely of digits. We could
split the string by spaces in advance, but this is rather ad-hoc.
Instead, let us construct a function that reads a leading integer
from a string, and then returns a remainder string.
readLeadingInteger :: String -> Maybe (Integer, String)
readLeadingInteger s =
case span isDigit s of
("", _) -> Nothing
(digits, s') -> Just (loop 1 $ reverse digits, s')
where
loop _ [] = 0
loop w (c : cs) =
charInteger c * w + loop (w * 10) cs
The span function breaks a string into two parts: the prefix of
characters that satisfy the predicate (here isDigit), and a
remainder string with the prefix removed. If the first part is
empty, we return Nothing, as an integer requires at least a single
digit. Otherwise we convert the digits into an Integer and return it
along with the remaining string.
> readLeadingInteger "123"
Just (123,"")
> readLeadingInteger "123 456"
Just (123," 456")
Let us also write two more helper functions: one that reads a single leading space from a string (and returns the remainder), and one that asserts that the string is empty.
readSpace :: String -> Maybe (Char, String)
readSpace (' ' : s) = Just (' ', s)
readSpace _ = Nothing
readEOF :: String -> Maybe ((), String)
readEOF "" = Just ((), "")
readEOF _ = Nothing
Note readLeadingInteger, readSpace, and readEOF all have types
of the same form: String -> Maybe (a, String) for some a. This
strongly suggests that there is some kind of commonality that we can
exploit to construct ways of composing them. But first, let us try to
compose them manually, to solve the problem of reading two
space-separated integers:
readTwoIntegers :: String -> Maybe ((Integer, Integer), String)
readTwoIntegers s =
case readLeadingInteger s of
Nothing -> Nothing
Just (x, s') -> case readSpace s' of
Nothing -> Nothing
Just (_, s'') ->
case readLeadingInteger s'' of
Nothing -> Nothing
Just (y, s''') -> pure ((x, y), s''')
> readTwoIntegers "123 456"
Just ((123,456),"")
While it works, it is quite verbose with all that explicit
pattern-matching of Nothing/Just. We can exploit the fact that
Maybe is a monad to write it a bit more concisely:
readTwoIntegers2 :: String -> Maybe ((Integer, Integer), String)
readTwoIntegers2 s = do
(x, s') <- readLeadingInteger s
(_, s'') <- readSpace s'
(y, s''') <- readLeadingInteger s''
Just ((x, y), s''')
However, it is still quite annoying that we manually have to thread
the String around. It also means we can screw up, and use the wrong
one, since they all have the same type. It would be better if this
kind of book-keeping was done automatically behind the scenes. And
indeed that is possible, by creating a parser monad, whose structure
is essentially the same as the functions above, and which hides away
the book-keeping behind the monadic interface.
A simple parser monad
As stated above, all our parser functions are of the form String -> Maybe (a, String). We will make that the definition of our parser
type:
newtype Parser a = Parser {runParser :: String -> Maybe (a, String)}
Now runParser :: Parser a -> String -> Maybe (a, String) is the
function for running a parser on some input.
This type can be made a monad. Its definition looks like this:
instance Monad Parser where
f >>= g = Parser $ \s ->
case runParser f s of
Nothing -> Nothing
Just (x, s') -> runParser (g x) s'
The idea is the following. We have f :: Parser a and g :: a -> Parser b. We can run the parser f to get either a parse error or a
value x :: a and a remainder string s'. We can then pass x to
g in order to obtain a Parser b, which we can then run on s'. It
is quite similar to a state monad combined the Maybe monad.
We also need to define Applicative and Functor instances. As
always, the only case that is not purely mechanical is pure, which
is used for a "parser" that consumes no input and always succeeds.
import Control.Monad (ap)
instance Functor Parser where
fmap f x = do
x' <- x
pure $ f x'
instance Applicative Parser where
(<*>) = ap
pure x = Parser $ \s -> Just (x, s)
Now that we have defined the fundamental machinery, we can define some very simple primitive parsers. We start with one that parses a single character that satisfies some predicate:
satisfy :: (Char -> Bool) -> Parser Char
satisfy p = Parser $ \s -> case s of
c : cs ->
if p c
then Just (c, cs)
else Nothing
_ -> Nothing
> runParser (satisfy isDigit) "123"
Just ('1',"23")
And a parser that succeeds only if there is no more input left:
eof :: Parser ()
eof = Parser $ \s ->
case s of
"" -> Just ((), "")
_ -> Nothing
While eof may seem a bit odd, we often use it as the very last step
of parsing a complete file or data format, as usually we do not want
to allow trailing garbage.
A parser combinator is a function on parsers. As our first parser combinator, we will construct one that accepts a list of parsers, and tries them all in turn. This is useful in the very common case where multiple inputs can be valid.
choice :: [Parser a] -> Parser a
choice [] = Parser $ \_ -> Nothing
choice (p : ps) = Parser $ \s ->
case runParser p s of
Nothing -> runParser (choice ps) s
Just (x, s') -> Just (x, s')
The parsers and combinators above directly manipulate the parser state
and use the Parser constructor. We say they are primitive parsers.
However, the vast majority of parsers we will write will not be
primitive, but will instead be built in terms of the primitives, using
the monadic interface. For example, we can define a derived parser
that parses an expected string and returns it:
import Control.Monad (void)
chunk :: String -> Parser String
chunk [] = pure ""
chunk (c : cs) = do
void $ satisfy (== c)
void $ chunk cs
pure $ c : cs
> runParser (choice [chunk "foo", chunk "bar"]) "foo"
Just ("foo","")
Using Parser Combinators
Let us try to rewrite our integer parser using the Parser type.
First, we define a function for parsing a single digit, including
decoding.
parseDigit :: Parser Integer
parseDigit = do
c <- satisfy isDigit
pure $ toInteger $ ord c - ord '0'
Here is how we would use it to write a function that parses two digits:
parseTwoDigits :: Parser (Integer, Integer)
parseTwoDigits = do
x <- parseDigit
y <- parseDigit
pure (x, y)
We also construct a combinator that repeatedly applies a given parser until it fails:
many :: Parser a -> Parser [a]
many p =
choice
[ do
x <- p
xs <- many p
pure $ x : xs,
pure []
]
> runParser (many parseDigit) "123"
Just ([1,2,3],"")
(Ponder what happens if we flipped the elements in the list we pass to
choice in the definition of many.)
We have to be careful when using many: if it is given a parser that
can succeed without consuming any input (such as eof), it will loop
forever.
Also, many is not quite what we need, as it will succeed even if the
given parser succeeds zero times. The variant some requires that the
given parser succeeds at least once:
some :: Parser a -> Parser [a]
some p = do
x <- p
xs <- many p
pure $ x : xs
Now we can write our function for parsing integers:
parseInteger = do
digits <- some parseDigit
pure $ loop 1 $ reverse digits
where
loop _ [] = 0
loop w (d : ds) =
d * w + loop (w * 10) ds
Or more concisely:
parseInteger :: Parser Integer
parseInteger = loop 1 . reverse <$> some parseDigit
where
loop _ [] = 0
loop w (d : ds) =
d * w + loop (w * 10) ds
And finally we can use it to build a parser for two space-separated integers:
parseTwoIntegers :: Parser (Integer, Integer)
parseTwoIntegers = do
x <- parseInteger
_ <- satisfy (== ' ')
y <- parseInteger
pure (x, y)
See how easy it is to understand what input it parses (once you
understand parser combinators, mind you), compared to the original
readTwoIntegers function, which was littered with book-keeping.
> runParser parseTwoIntegers "123 456"
Just ((123,456),"")
We would likely also want to use the eof parser to assert that no
garbage follows the second integer.
Tokenisation
Syntaxes for programming languages and data formats are usually structured in the form of rules for how to combine tokens (sometimes also called lexemes), along with rules for how the tokens are formed.
Following the example above, we could consider integers (in the form of a nonzero number of decimal digits) to be a token. In many languages, tokens can be separated by any number of whitespace characters. In the traditional view of parsing, the syntactic analysis is preceded by a lexical analysis that splits the input into tokens, using for example regular expressions. With parser combinators, lexical and syntactic analysis is done simultaneously. Yet to correctly handle the lexical rules of a language, we must exercise significant discipline.
Not all languages have straightforward lexical rules. Some (such as Python or Haskell) use indentation to structure their syntactical rules, others have context-sensitive tokenisation, and others allow extensible or user-defined syntaxes. Parser combinators can cope with all of these, but for simplicity we stick to more well-behaved syntaxes in these notes.
Whitespace
One core concern is how to handle whitespace. The most common convention is that each parser must consume any trailing whitespace, but can assume that there is no leading whitespace. If we systematically follow this rule, then we can ensure that we never fail to handle whitespace. The exception is the top parser, where we cannot assume that the initial input does not have leading whitespace. Still, systematically doing anything without mistakes is difficult for humans. In the following, we define some simple (but rigid) rules that are easy to follow in our code.
First we write a parser that skips any number of whitespace characters.
import Data.Char (isSpace)
space :: Parser ()
space = do
_ <- many $ satisfy isSpace
pure ()
Then we write a parser combinator that takes any parser and consumes subsequent whitespace:
lexeme :: Parser a -> Parser a
lexeme p = do x <- p
space
pure x
Now we institute a rule: whenever we write a parser that operates at the lexical level, it must be of the form
lFoo = lexeme $ ...
and no other parser than those of this form is allowed to use
lexeme or space directly. The l prefix is a mnemonic for
lexical - similarly we will begin prefixing our syntax-level parsers
with p.
For example, this would now be a parser for decimal integers that consumes trailing whitespace:
lDecimal :: Parser Integer
lDecimal = lexeme $ loop 1 . reverse <$> some parseDigit
where
loop _ [] = 0
loop w (d : ds) =
d * w + loop (w * 10) ds
Note that we will use parseDigit (which does not handle whitespace)
as a low level building block. We must only use these from within
l-prefixed functions.
Now we can easily a function that parses any number of whitespace-separated decimal numbers:
pDecimals :: Parser [Integer]
pDecimals = many lDecimal
> runParser pDecimals "123 456 789 "
Just ([123,456,789],"")
However, we will fail to parse a string with leading whitespace:
> runParser pDecimals " 123"
Just ([]," 123")
The solution is to explicitly skip leading whitespace:
> runParser (space >> pDecimals) " 123"
Just ([123],"")
We do this only in the top level parser - usually in the one that is
passed immediately to the function that executed the Parser monad
itself.
Longest match
When lexing the string "123", we see it as a single token 123
rather than three tokens 1, 2, 3? The reason for this is that
most grammars follow the longest match (or maximum munch) rule:
each tokens extend as far as possible. This principle has actually
been baked into the definition of the many combinator above, as it
tries the recursive case before the terminal case. If we instead
defined many like this:
many :: Parser a -> Parser [a]
many p =
choice
[ pure [],
do
x <- p
xs <- many p
pure $ x : xs
]
Then we would observe the following behaviour (because lDecimal uses
some, which uses many):
> runParser lDecimal "123"
Just (1,"23")
Thus, simply by defining many the way we originally did, we obtain
conventional behaviour.
A larger example
Let us study a larger example of parsing, including proper tokenisation, handling of keywords, and transforming a given grammar to make it amenable to parsing.
Consider parsing a language of Boolean expressions, represented by the following Haskell datatype.
data BExp
= Lit Bool
| Var String
| Not BExp
| And BExp BExp
| Or BExp BExp
deriving (Eq, Show)
The concrete syntax will be strings such as "x", "not x", "x and true", "true and y or z". We write down a grammar in
EBNF:
var ::= ? one or more alphabetic characters ? ;
BExp ::= "true"
| "false"
| "not" BExp
| BExp "and" BExp
| BExp "or" BExp ;
The words enclosed in double quotes are terminals (tokens). The
lowercase var is also a token, but is defined informally using an
EBNF comment. We adopt the convention that tokens can be separated by
whitespace, and that we follow the longest match rule. This is
strictly speaking an abuse of convention, as the handling of
whitespace ought also be explicit in the grammar, but it is common to
leave it out for simplicity.
Note that the grammar does not exactly match the Haskell abstract
syntax tree (AST) definition - in particular, the "true" and
"false" cases are combined into a single Lit constructor. This is
quite common, and we will see many cases where superfluous details of
the form of the concrete syntax are simplified away in the AST.
Our first attempt at parsing Boolean expressions looks like this:
import Data.Char (isAlpha)
lVar :: Parser String
lVar = lexeme $ some $ satisfy isAlpha
lTrue :: Parser ()
lTrue = lexeme $ void $ chunk "true"
lFalse :: Parser ()
lFalse = lexeme $ void $ chunk "false"
lAnd :: Parser ()
lAnd = lexeme $ void $ chunk "and"
lOr :: Parser ()
lOr = lexeme $ void $ chunk "or"
pBool :: Parser Bool
pBool =
choice
[ do
chunk "true"
pure True,
do
chunk "false"
pure False,
do
chunk "not"
e <- pBExp
pure $ Not e
]
pBExp :: Parser BExp
pBExp =
choice
[ Lit <$> pBool,
Var <$> lVar,
do
x <- pBExp
lAnd
y <- pBExp
pure $ And x y,
do
x <- pBExp
lOr
y <- pBExp
pure $ Or x y
]
Note now the structure of the code fairly closely matches the structure of the grammar. This is is always something we seek to aspire to.
Keywords
Unfortunately, despite looking pretty, it fails to work properly for any but trivial cases:
> runParser pBExp "x"
Just (Var "x","")
> runParser pBExp "true"
Just (Lit True,"")
> runParser pBExp "not x"
Just (Var "not","x")
The third case doesn't work. How can that be? The reason it goes wrong can be seen by trying to parse a variable name:
> runParser lVar "not"
Just ("not","")
Words such as not, and, or, true, and false are also valid
variable names according to our parser. While we forgot to state it
explicitly in the grammar, our intention is for these words to be
keywords (or reserved words), which are not valid as variables. So
now we add another side condition to the grammar: a var must not be
one of not, and, or, true, and false. How do we implement
this in the parser? After all, in lVar we cannot know whether we
will end up reading a keyword until after we are done. We actually
need to add a new primitive operation to our parser: explicit
failure. We do this by implementing the MonadFail type class, which
requires a single method, fail :: String -> Parser a:
instance MonadFail Parser where
fail _ = Parser $ \_ -> Nothing
The argument to fail is for an error message, which is not supported
by our parser definition, so we just throw it away. The result of
fail is a parser that always fails. We can use this to fix our
definition of lVar to explicitly not allow keywords:
keywords :: [String]
keywords = ["not", "true", "false", "and", "or"]
lVar :: Parser String
lVar = lexeme $ do
v <- some $ satisfy isAlpha
if v `elem` keywords
then fail "keyword"
else pure v
This shows some of the strength (and danger) of monadic parsing: we can intermingle arbitrary Haskell-level decision making with the purely syntactical analysis. This allows parser combinators to support heinously context-sensitive grammars when necessary, but as mentioned above, we will stick to more well-behaved ones in this course.
Now we get the desired behaviour:
> runParser pBExp "not x"
Just (Not (Var "x"),"")
But another case still behaves oddly:
> runParser pBExp "truexx"
Just (Lit True,"xx")
We don't really want to parse "truexx" as the Boolean literal true
followed by some garbage - this is in violation of the longest match
rule. We can fix this by requiring that a keyword is not followed by
an alphabetic character. This does require us to add a new primitive
parser to our parsing library (but this is the last one):
notFollowedBy :: Parser a -> Parser ()
notFollowedBy (Parser f) = Parser $ \s ->
case f s of
Nothing -> Just ((), s)
_ -> Nothing
The notFollowedBy combinator succeeds only if the provided parser
fails (and if so, consumes no input). We can then use this to define a
combinator for parsing keywords:
lKeyword :: String -> Parser ()
lKeyword s = lexeme $ do
void $ chunk s
notFollowedBy $ satisfy isAlpha
Using lKeyword, there is no need for dedicated functions for parsing
the individual keywords, although you can still use them if you like.
I prefer using lKeyword directly:
lKeyword :: String -> Parser ()
lKeyword s = lexeme $ do
void $ chunk s
notFollowedBy $ satisfy isAlpha
pBool :: Parser Bool
pBool =
choice
[ lKeyword "true" >> pure True,
lKeyword "false" >> pure False
]
pBExp :: Parser BExp
pBExp =
choice
[ Lit <$> pBool,
Var <$> lVar,
do
lKeyword "not"
Not <$> pBExp,
do
x <- pBExp
lKeyword "and"
y <- pBExp
pure $ And x y,
do
x <- pBExp
lKeyword "or"
y <- pBExp
pure $ Or x y
]
> runParser pBExp "truexx"
Just (Var "truexx","")
Left recursion
We have now implemented tokenisation properly. Unfortunately, our parser still does not work:
> runParser pBExp "x and y"
Just (Var "x","and y")
The reason is the choice in pBExp. Our definition of choice
takes the first parser that succeeds, which is the one that produces
Var, and so it never proceeds to the one for And.
There are ways of implementing parser combinators
such that the ordering does not matter, which is largely by using a
list instead of a Maybe in the definition of Parser. However, this
will not solve the nontermination problem discussed below.
We can try to fix our parser by changing the order of parsers provided
to choice:
pBExp :: Parser BExp
pBExp =
choice
[ do
x <- pBExp
lKeyword "and"
y <- pBExp
pure $ And x y,
do
x <- pBExp
lKeyword "or"
y <- pBExp
pure $ Or x y,
Lit <$> pBool,
Var <$> lVar,
do
lKeyword "not"
Not <$> pBExp
]
Unfortunately, now the parser goes into an infinite loop:
> runParser pBExp "x"
... waiting for a long time ...
The operational reason is that underneath all the monadic syntax
sugar, our parsers are just recursive Haskell functions. Looking at
pBExp, we see that the very first thing it does is recursively
invoke pBExp. If we look at the EBNF grammar for Boolean
expressions, we also see that some of the production rules for BExp
start with BExp. In the nomenclature of parser theory, this is
called left recursion. The style of Parser combinator library we are
studying here is equivalent to so-called recursive descent parsers
with arbitrary lookahead, which are known to not support left
recursion. The solution to this problem is to rewrite the grammar to
eliminate left-recursion. If you need a refresher on how to do this,
see Grammars and parsing with Haskell using parser
combinators,
but the idea is to split the non-recursive cases into a separate
nonterminal (often called Atom) Transforming the grammar (note that
we do not modify the Haskell AST definition) provides us with the
following:
var ::= ? one or more alphabetic characters ? ;
Atom ::= "true"
| "false"
| var
| "not" BExp ;
BExp' ::= "and" Atom BExp'
| "or" Atom BExp'
| ;
BExp ::= Atom BExp' ;
Note that we have decided that the and operator is
left-associative - meaning that "x and y and z" is parsed as "(x and y) and x" (or would be if our syntax supported parentheses).
A grammar without left-recursion can be implemented fairly
straightforwardly. The idea is that parsing a BExp consists of
initially parsing a BExp2, followed by a chain of zero or more
and/or clauses.
pAtom :: Parser BExp
pAtom =
choice
[ Lit <$> pBool,
Var <$> lVar,
do
lKeyword "not"
Not <$> pBExp
]
pBExp :: Parser BExp
pBExp = do
x <- pAtom
chain x
where
chain x =
choice
[ do
lKeyword "and"
y <- pBExp
chain $ And x y,
do
lKeyword "or"
y <- pBExp
chain $ Or x y,
pure x
]
> runParser pBExp "x and y"
Just (And (Var "x") (Var "y"),"")
> runParser pBExp "x and y and z"
Just (And (And (Var "x") (Var "y")) (Var "z"),"")
Usually when constructing a parser, we do not expose the raw parser
functions (such as pBExp), but instead define a convenient wrapper
function, such as the following:
parseBExp :: String -> Maybe BExp
parseBExp s = fst <$> runParser p s
where
p = do
space
x <- pBExp
eof
pure x
Note how this "top level parser" also takes care to skip leading whitespace (in contrast to lexer functions that skip trailing whitespace as their principle), and asserts that no input must remain unconsumed.
Operator precedence
We still have a final problem we must address. Consider parsing the
input "x or y and z":
> parseBExp "x or y and z"
Just (And (Or (Var "x") (Var "y")) (Var "z"))
Whether this is correct or not of course depends on how the grammar is
specified, but the usual convention in logical formulae is that
conjunction (and) binds tighter than disjunction (or). This is
similar to how mathematical notation assigns higher priority to
multiplication than addition. Generally, a grammar specification will
come with a set of side conditions specifyint an operator priority
(and associativity). The way to handle operator priority in a parser
build with combinators is to perform yet another a grammar
transformation. The idea is to split the grammar rules into multiple
levels, with one level per priority. For our Boolean expressions,
the transformed grammar looks like this:
var ::= ? one or more alphabetic characters ? ;
Atom ::= "true"
| "false"
| var
| "not" BExp ;
BExp1' ::= "and" Atom BExp1'
| ;
BExp1 ::= Atom BExp1' ;
BExp0' ::= "or" BExp1 BExp0'
| ;
BExp0 ::= BExp1 BExp0' ;
BExp ::= BExp0 ;
And performing the corresponding transformation on our parser (or simply rewriting it from scratch, given this new grammar) produces this:
pBExp1 :: Parser BExp
pBExp1 = do
x <- pAtom
chain x
where
chain x =
choice
[ do
lKeyword "and"
y <- pAtom
chain $ And x y,
pure x
]
pBExp0 :: Parser BExp
pBExp0 = do
x <- pBExp1
chain x
where
chain x =
choice
[ do
lKeyword "or"
y <- pBExp1
chain $ Or x y,
pure x
]
pBExp :: Parser BExp
pBExp = pBExp0
And now we observe the parser result that we desire:
> parseBExp "x or y and z"
Just (Or (Var "x") (And (Var "y") (Var "z")))
Megaparsec
While the parser library implemented above is fully operational, it has serious flaws that leave it unsuitable for production use:
-
It is rather inefficient. This is partially because of the use of
Stringas the fundamental type, but mostly because of howchoiceis implemented, which has to keep track of the original input essentially forever, even if backtracking will never become relevant. -
It produces no error messages, instead simply returning
Nothing.
While point 1 does not matter much for AP, point 2 makes it very difficult to debug your parsers - which is certainly going to have an impact. For the exercises and assignments, you will therefore be using a state-of-the-art industrial-strength parser combinator library: Megaparsec.
The downside of using an industrial parser library such as Megaparsec is that is is complicated. It has a rich programming interface and more complicated types than what we need in AP. However, a subset of Megaparsec's interface is identical to the interface presented above (this is not a coincidence), and this is what we will be using in AP.
The facilities we will need are from the
Text.Megaparsec
module. Megaparsec is quite well documented, so it may be worth your
time to skim the documentation, although the information provided here
is intended to be sufficient for our needs. In Megaparsec, parsers are
monadic functions in the Parsec e s monad, which is itself a
specialisation of the ParsecT monad transformer - a concept that
lies outside of the AP curriculum. The point of this flexibilty is to
be generic in the underlying stream type (e.g. the kind of "string"
we are parsing), the form that errors can take, and so on. We do not
need such flexibility, and the first thing we need to do when using
Megaparsec is to define the following type synonym:
import Data.Void (Void)
type Parser = Parsec Void String
This states that our Parsers will have no special error component,
and the input will be a String.
To run such a Parser, we make use of the runParser function, which
in simplified form has this type:
runParser :: Parser a
-> String
-> String
-> Either (ParseErrorBundle String Void) a
The first String is the filename of the input, which is used for
error messages. The second String is the actual input. The result is
either a special error value, or the result of parsing. Note that in
contrast to our runParser, no remainder string is returned. The
error value can be turned into a human-readable string with the
function errorBundlePretty.
For example, this is how we would define parseBExp using Megaparsec.
The rest of the parser code is (for now) completely unchanged:
parseBExp :: FilePath -> String -> Either String BExp
parseBExp fname s = case runParser p fname s of
Left err -> Left $ errorBundlePretty err
Right x -> Right x
where
p = do
space
x <- pBExp
eof
pure x
We are using the FilePath = String type synonym in the function type
to make it clearer which is the filename and which is the input
string.
It mostly works just as before:
> parseBExp "input" "x and y and z"
Right (And (And (Var "x") (Var "y")) (Var "z"))
But it can now also produce quite nice error messages:
> either putStrLn print $ parseBExp "input" "x and y and"
input:1:12:
|
1 | x and y and
| ^
unexpected end of input
expecting "false", "not", or "true"
> either putStrLn print $ parseBExp "input" "x true"
input:1:3:
|
1 | x true
| ^
unexpected 't'
expecting "and", "or", or end of input
However, some inputs now produce a rather unexpected error:
> either putStrLn print $ parseBExp "input" "truex"
input:1:5:
|
1 | truex
| ^
unexpected 'x'
The reason for this is that Megaparsec, for efficiency reasons, does
not automatically backtrack when a parser fails. Due to the way we
have ordered our choice in pAtom, we will initially try to parse
the literal true with lKeyword in pBool, which will read the
input true, and then fail due to notFollowedBy. However, the
input remains read, which means Megaparsec's implementation of
choice won't even try to the other possibilities in choice. The
way to fix this is to use the try combinator, which has this type
(specialising to our Parser monad):
try :: Parser a -> Parser a
A parser try p behaves like p, but ensures the the parser state is
unmodified if p fails. We must use it whenever a parser can fail
after successfully consuming input. In this case, we must use it in
lVar and lKeyword:
lVar :: Parser String
lVar = lexeme $ try $ do
v <- some $ satisfy isAlpha
if False && v `elem` keywords
then fail "keyword"
else pure v
lKeyword :: String -> Parser ()
lKeyword s = lexeme $ try $ do
void $ chunk s
notFollowedBy $ satisfy isAlpha
When to use try is certainly rather un-intuitive at first, and
remains fairly subtle for ever. One possibility is to always use it
in the cases we pass to choice - this will work, but is inefficient,
as it makes every choice a potential backtracking point. Most
grammars are designed such that backtracking is only needed for the
lexical functions.
Applicative parsing
As you may remember, all Monads are also Applicatives. For
parsing, we can exploit this to write our parsers in a particularly
concise form called applicative style. The technique inolves to use
the <$> operator (from Functor) and the <*> operator (from
Applicative) to directly intermix the constructors, that put
together data, with the parsers that produce it. For example, recall
our definition of many:
many :: Parser a -> Parser [a]
many p =
choice
[ do
x <- p
xs <- many p
pure $ x : xs,
pure []
]
In the first choice case, we are are essentially running the
computation p, then many p, then combining their results with the
list constructor. Using applicative style and the prefix form of the
list instructor (:), we can instead write many as:
many :: Parser a -> Parser [a]
many p =
choice
[ (:) <$> p <*> many ps,
pure []
]
Another example is parseTwoDigits, which we can rewrite as follows:
parseTwoDigits :: Parser (Integer, Integer)
parseTwoDigits = (,) <$> parseDigit <*> parseDigit
In fact, we can write many monadic computations in applicative style,
but parsing benefits significantly. Two other useful applicative
operators are (<*) and (*>):
(<*) :: Applicative f => f a -> f b -> f a
(*>) :: Applicative f => f a -> f b -> f b
They accept two applicative (or monadic) computations as arguments,
and then return the value of respectively the first or the second
operand, discarding the other. This is quite useful for handling
grammars where syntactical constructs are surrounded by keywords,
which must be parsed, but do not produce any interesting values. For
example, recall our definition of pBool:
pBool :: Parser Bool
pBool =
choice
[ do
lKeyword "true"
pure True,
do
lKeyword "false"
pure False
]
Using applicative style we might write this as:
pBool :: Parser Bool
pBool =
choice
[ lKeyword "true" *> pure True,
lKeyword "false" *> pure False
]
As another example, we might add support for parenthetical grouping like so:
parens :: Parser a -> Parser a
parens p = lexeme (chunk "(") *> p <* lexeme (chunk ")")
pAtom :: Parser BExp
pAtom =
choice
[ Lit <$> pBool,
Var <$> lVar,
do
lKeyword "not"
Not <$> pBExp,
parens pBExp
]
Applicative style goes beyond merely notational convenience. It is
possible to construct parser combinator libraries that are solely
applicative, and not monadic, which allows the parser to be inspected
and transformed in a deeper way, because there is no impenetrable
>>= operator. Applicative parsers are however fundamentally less
powerful than monadic ones - specifically, they can handle only
context-free languages.
Parsing Comments
Most grammars allow some form of comment notation that is ignored when
parsing, but hopefully provides useful information to human readers.
In this section we will extend the parser described above to support
classic Unix-style line comments, where the character # begins a
comment that continues to the next linebreak. For example, we want the
following string to parse:
x # here goes a comment
and # and
y # another
# one
It turns out that comments are quite easy to support in a
combinator-based parser. Specifically, we simply treat comments as a
kind of whitespace and implement them in our space combinator.
Recall that it currently looks like this:
space :: Parser ()
space = do
_ <- many $ satisfy isSpace
pure ()
First we write a parser that parses a line comment.
comment :: Parser ()
comment = void $ do
void $ chunk "#"
many $ satisfy (/= '\n')
> parseTest comment "#foo"
()
> parseTest comment "#foo\n"
()
> parseTest comment "foo"
1:1:
|
1 | foo
| ^
unexpected 'f'
expecting '#'
As desired, it succeeds only when we parse a comment. Now we modify
the space parser to parse whitespace, followed by a comment, and
if we parse a comment, then we recursively invoke space. This
ensures space will onsume arbitrary combinations of spaces and
comments.
> parseTest (space *> eof) "\n#foo\n#bar\n"
()
Because of the principled design of our parser, that is actually all we need to in order to support comments:
> putStrLn "x # comment\nand y"
x # comment
and y
λ> parseBExp "" "x # comment\nand y"
Right (And (Var "x") (Var "y"))
More Monads
Free Monads
This section explains free monads. A free monad is a construction that lets us construct a Monad from any Functor. Although this seems obscure at first, it allows a style of programming design that clearly distinguishes the use of effects from the interpretation of effects.
Motivation
As an example, imagine writing a function that needs to perform HTTP
requests to do its work. For usage, these network requests really must
be done, which requires the function to be in the IO monad, which
allows it to do anything, not just issue network requests. Further,
when unit testing, we may want to "mock" these network requests and
return synthetic data instead. It would be better if the function
could precisely describe that it depends upon being able to perform
HTTP requests (and no other IO operations), but let whoever executes
the function decide how exactly such requests are implemented:
either by actually performing physical network communication, or by
returning synthetic data (for testing and debugging).
In other languages, this problem is solved using ideas such as dependency injection, mocking, and object capabilities. As we shall see, free monads provide a rather simple (although sophisticated!) solution to these problems, and it is an approach that sees fairly wide use among functional programmers.
The actual definition of the general concept of a free monad is rather abstract, and may be skimmed on a first reading. The use of a free monad is somewhat more concrete, and is more important for the course.
Defining Free
We will be defining a monad Free e a that represents a computation
that produces a value of type a (like in IO a), and e describes
the possible effects. The definition is as follows1:
data Free e a
= Pure a
| Free (e (Free e a))
This looks quite cryptic, but it is possible to understand based on
what we already know. The Pure constructor is straightforward: it
represents a computation that has finished with a value of type a.
The Free constructor is more interesting - it represents an
effectful computation. Note how e is applied as a type
constructor to a type Free e a (which is also the type we are
defining). Intuitively, this constructor encodes the idea of "first do
the effect e, then continue executing a Free e a". The meaning of
"do the effect" will be specified by the interpretation function we
define for the monad (we'll return to this below), and importantly we
can define multiple different interpretation functions for the same
monad. This is what allows separation of concerns.
The e (Free e a) part merits elaboration, as this is the first time
we have seen a datatype that applies one of its type parameters to
another type. This is an instance of "higher-order polymorphism", where
we abstract not over types, but type constructors. While this is
the first time we have seen this in a data type definition, it is not
the first time we see higher-order polymorphism at all. Recall the
Functor type class:
class Functor f where
fmap :: (a -> b) -> f a -> f b
Intuitively, if a data type is a Functor, that means it is a kind of
"container" with "elements", and we can apply an arbitrary function on
these elements. But importantly, f by itself is not a
type2, but a type constructor that must be applied to
an argument (such as in f a and f b) to form a type. Our use of
e in the definition of Free works exactly the same way.
This is not the only possible way to define free monads in Haskell, but it is the simplest one. More efficient definitions exist (such as Control.Monad.Free.Church), but they are more complicated, and unnecessary for our purposes.
Just like how values can be classified with types, so
can types be classified with "types of types", which in Haskell are
called kinds. A normal type such as Int has kind Type (Type is
often written * for historical reasons), while a type constructor
such as Maybe has kind Type -> Type, meaning it is essentially a
function at the type level. The type constructor Free then has kind
(Type -> Type) -> Type -> Type. Actual type-level programming is a
fascinating topic, but beyond the scope of AP.
Implementing Reader in terms of Free
We will have to construct a bit more machinery before Free will work
as a monad, but to skip ahead a bit, here is an idea of how we will
use it to to implement a Reader monad. The Reader monad supports a
single effect: we can ask for the value of an environment (called
ask in the standard Reader monad). We can define a datatype
ReadOp r a that encodes the notion of asking for a value of type
r, then producing a value of type a:
data ReadOp r a = ReadOp (r -> a)
The r -> a value is called a continuation. It is a function that
is called to resume evaluation once the requested value is ready.
Further, ReadOp can be made a Functor. We will see later that this
is necessary in order to make it usable with Free.
instance Functor (ReadOp r) where
fmap f (ReadOp g) = ReadOp $ \x -> f (g x)
We can use this to construct a Reader monad using Free:
type Reader r a = Free (ReadOp r) a
Once we have defined Monad instances and such for Free, we will be
able to write monadic code that makes use of it. But we also have to
define an interpretation function that actually runs the monad and
gives meaning to its effects? We want a function of the following
type:
runReader :: r -> Reader r a -> a
That is, given an initial value of type r and a computation of type
Reader r a, run that computation and produce a value of type a.
Since we don't know anything about r, our only option is to pattern
match on the Reader r a value itself. The Pure case is trivial, as
it represents a computation without any effects:
runReader _ (Pure x) = x
For the second case, we are considering a value Free (ReadOp g),
where g is of type r -> Reader r a. To see this, recall that the
Free data constructor takes something of type e (Free e a) as a
payload; setting e = ReadOp r, this type becomes ReadOp r (Free (ReadOp r) a), which is the same as ReadOp r (Reader r a). Referring back to the definition of ReadOp, we conclude that
g must have type r -> Reader r a.
We can now apply g to the environment to obtain a Reader r a, which we
can then execute with a recursive application of runReader:
runReader r (Free (ReadOp g)) = runReader r (g r)
We can also define Haskell functions that hide the specific encoding
of Reader behind a more familiar interface:
ask :: Reader r r
ask = Free $ ReadOp $ \x -> Pure x
While it is perhaps not terribly interesting to define other
interpretations of the Reader monad, it is possible to do so; for
example by storing the environment in a global variable or in a
database, and defining an interpretation function that runs in IO
and fetches the environment from there. The important thing is that we
have decoupled the notion of an effect from its interpretation.
Making Free a Monad
The above skipped ahead quite a bit, as we have yet to show that
Free is actually a Monad. Any Monad must also be a Functor and
an Applicative, so let us start with Functor. For a value of type
Free e a, the Functor instance will be about transforming the a
part.
instance (Functor e) => Functor (Free e) where
fmap f (Pure x) = Pure $ f x
fmap f (Free g) = Free $ fmap (fmap f) g
The Pure case is straightforward. For the Free case, we have a
value g of type e (Free e a), and we need to somehow transform
that a inside of it. The only way we can possibly operate inside of
that e is if e itself is also a Functor, so we add that as a
premise of the instance definition. This is the reason why the effect
representation we use with Free must always be a Functor (such as
with ReadOp above). Usually these Functor instances are quite
mechanical. Note that the two fmaps we use are on different types:
the outermost one uses the Functor instance for e, and the
innermost one uses the Functor instance for Free e (recursively).
We then move on to definition an Applicative instance for Free.
The pure method is simple -- it is simply the Pure constructor.
Because we know that we will also be making Free a Monad, we can
define the <*> method as ap from Control.Monad.
import Control.Monad (ap)
instance (Functor e) => Applicative (Free e) where
pure = Pure
(<*>) = ap
Finally we can define the Monad instance and the >>= method
itself.
instance (Functor e) => Monad (Free e) where
Pure x >>= f = f x
Free g >>= f = Free $ h <$> g
where
h x = x >>= f
This definition can also be constructed largely by following the
structure of the types. In the Pure case we have the following:
x :: a
f :: a -> Free e b
and we must produce a result of type Free e b. This is clearly done
simply by applying f to x.
In the Free case we have the following:
g :: e (Free e a)
f :: a -> Free e b
We ultimately want to apply f to something of type a, but we don't
have an a. All we have is a Free e a hidden behind an effect e.
However, since we require e to be a Functor, it is possible for us
to apply a function to the Free e a that is inside the e, meaning
that if we have a function h :: Free e a -> Free e b, we can say
fmap h e to obtain an e c. And it turns out that such an h is
defined as a recursive invocation of the >>= method for Free a.
Implementing State in Terms of Free
Similarly to Reader, it is also straightforward to define a State
monad using Free. A state monad supports two effects: reading the
state and writing the state:
data StateOp s a
= StatePut s a
| StateGet (s -> a)
Defining a Functor instance for StateOp is similar to ReadOp,
and can be done in the usual style by looking at which variables of
which types we have available, and which must be constructed:
instance Functor (StateOp s) where
fmap f (StatePut s x) = StatePut s $ f x
fmap f (StateGet g) = StateGet $ \s -> f (g s)
Now we can define the monad State simply as Free applied to the
state effects:
type State s a = Free (StateOp s) a
Evaluation of a State computation is also very similar to the case
for Reader, and takes the form of a recursive function that
interprets the StateOp effcts. When we encounter a StatePut, we
discard the current state and use the provided one.
runState :: s -> State s a -> a
runState _ (Pure x) = x
runState s (Free (StateGet f)) = runState s (f s)
runState _ (Free (StatePut s x)) = runState s x
Finally, we can define the usual put/get accessor functions.
put :: s -> State s ()
put s = Free $ StatePut s $ Pure ()
get :: State s s
get = Free $ StateGet $ \s -> Pure s
On top of these, we can define the usual helper functions, such as
modify, in the way discussed in chapter 2.
Implementing an Error Monad
As another example, consider a free monad with error handling, very
similar to that provided by Either. Here we support two effects:
throwing an error and catching an error:
data ErrorOp e a
= ErrorThrow e
| ErrorCatch a (e -> a)
instance Functor (ErrorOp e) where
fmap _ (ErrorThrow e) = ErrorThrow e
fmap f (ErrorCatch a c) = ErrorCatch (f a) $ \e -> f (c e)
type Error e a = Free (ErrorOp e) a
The interpretation function runError is a little more sophisticated
than the ones we saw before, as some control flow is now required to
handle the error cases. However, it is fundamentally very similar to
the bind method we have seen previously for the Either monad.
runError :: Error e a -> Either e a
runError (Pure x) = Right x
runError (Free (ErrorThrow e)) = Left e
runError (Free (ErrorCatch x c)) =
case runError x of
Left e -> runError $ c e
Right x' -> Right x'
Finally, we can define the usual boilerplate accessor functions for using the effects:
throw :: e -> Error e a
throw e = Free $ ErrorThrow e
catch :: Error e a -> (e -> Error e a) -> Error e a
catch x c = Free $ ErrorCatch x c
The IO Monad
As we have seen in previous chapters, monads are not a special
language construct in Haskell. While the Monad typeclass is part of
the standard library, we could have defined it ourselves if not, and
indeed that is how it was originally done. The only special affordance
that Haskell provides is syntactic sugar in the form of do notation,
and while it is certainly very convenient, it does not let us do
anything we could not otherwise do. Ultimately, the monads you have
seen have merely been convenient and abstract ways of doing things
that could also be done in non-monadic Haskell, and they are indeed
all ultimately expressed in terms non-monadic code.
There is one exception, however: the IO monad is truly built into
the language, and cannot be expressed using normal Haskell. It is the
ultimate mechanism by which Haskell programs interact with the
surrounding world. This is evident in the type of main; the
canonical entry point for Haskell programs:
main :: IO ()
We can imagine that the Haskell runtime system has some kind of
interpreter for IO, the same way we write interpreters for other
monads, but there is no way to express this interpretation in pure
Haskell.
In the assignments and exercises you have worked with, the main
function is in the runtests.hs file, and serves as the entry point
to the unit tests. We can also simply type in IO actions at the
ghci prompt, after which ghci will execute them.
There are various metaphors for how to understand IO. One is that it
is a kind of state monad that passes around the entire state of the
universe, with functions like putStr and readFile modifying the
state, the same way put and get modify the state of the State
monad. This interpretation is useful to an extent, but break downs
when considering concurrency, which we will look at later in the
course. Ultimately, it is most useful to simply consider >>= for the
IO monad as straight up impure and executing side effects.
Programming with IO
Programming with the IO monad in Haskell is very similar to
programming in a conventional imperative language, and the same as
with programming with any other monad. However, the fact that it so
similar to other languages means that our intuition can sometimes
betray us. For example, consider the function putStrLn, which prints
a given string to stdout, and has the following type:
putStrLn :: String -> IO ()
Simply putting putStrLn somewhere in our program will not cause
anything to be printed, even when it is evaluated. For example,
evaluating this expression will produce no output:
let x = putStrLn "hello world"
in ()
There is nothing here you haven't seen before. All this does is create
a binding x of type IO (), which is not used for anything, and
then returns the unit value. In fact, this expression just has type
() - it is not monadic at all. In order to actually execute an
effect, we must pass it to >>= somehow, putting together an even
larger IO operation, which must ultimately be the definition of the
program main function:
main :: IO ()
main = putStrLn "hello world" >>= \_ -> pure ()
-- or equivalently
main :: IO ()
main = do putStrLn "hello world"
pure ()
The fact that IO operations are normal Haskell values, that just happen to be executable, means we can manipulate them in various ways. As a particularly trivial example:
main :: IO ()
main = do let x = putStrLn "hello world"
x
x
This will print twice, because we are executing the action twice.
Exceptions and IO
We have previously seen how to use monads to encode and propagate
errors, such as with Maybe and Either. The advantage of this
approach is that the potential errors are directly visible in the
types of functions. However, not all errors are represented, or can
be represented, in this way. For example, the div function has the
following type:
div :: Integral a => a -> a -> a
Yet if we try to divide by zero, we will get an error:
> div 1 0
*** Exception: divide by zero
This is an exception. Despite Haskell being a pure language, it is
indeed the case that some ostensibly pure functions, such as div,
can raise exceptions. One common cause of exceptions is the function
error, which we often use to indicate program bugs, or undefined,
which we often use during development. Many prelude functions such as
head or tail are also partial, meaning they are not defined on
their entire domain. Taking the head of an empty list will also
raise an exception:
> head []
*** Exception: Prelude.head: empty list
Exceptions raised by pure code are often called imprecise exceptions, because they are not evident in the type.
Today, partial functions are largely considered a bad idea by most
Haskell programmers, because they make the types unreliable. Instead
head should perhaps return a Maybe value. Yet even adherents of
this approach may hesitate to make functions such as div return
Maybe, due to the sheer amount of boilerplate this would require
(even when using monads to propagate the error situaton).
Further, other exceptions are harder to avoid: they are also raised for out-of-memory situations or various asynchronous signals. Most functions that perform IO, such as opening or writing to a file, will also use exceptions to report errors. As a result, we need a way to handle exceptions.
Exception is an overloaded term. In this section we discuss solely
the kinds of exceptions that are thrown by functions like error. It is
common to use the word "exception" to refer to the kind of error handling
done with Either or similar monads.
Handling Exceptions
Exceptions are undeniably an effect, and while they can be thrown in
pure code, it would be a violation of referential transparency to also
handle them in pure code. As a result, exceptions can only be caught
in the IO monad. The facilities for working with exceptions are found
in
Control.Exception.
This is a rather rich and complicated module, and we will not need
much of what it provides. The main things we will need is the catch
function:
catch :: Exception e => IO a -> (e -> IO a) -> IO a
The Haskell exception handling machinery is fairly similar to that
which you might be familiar with from other languages. The catch
function takes two arguments. It tries to run the provided IO
action, and if an exception is thrown during that action, it calls the
provided handler function with the exception. The wrinkle is that
catch is polymorphic, while an exception is any value that
implements the Exception typeclass, any use of catch must somehow
specify exactly which type of exception is caught by this specific
catch. This may sound unclear, so here is an example where we try to
handle a division by zero:
handleDivByZero :: IO ()
handleDivByZero =
print (div 1 0) `catch` (\e -> putStrLn "I am a handler")
This will give us a rather long (here abbreviated) error message:
• Ambiguous type variable ‘e0’ arising from a use of ‘catch’
prevents the constraint ‘(Exception e0)’ from being solved.
Probable fix: use a type annotation to specify what ‘e0’ should be.
The problem is that catch can handle any exception, so how is
Haskell to know which one we know? We need to put in a type annotation
to specify the one we are interested in. For AP we will mainly use the
type SomeException, which acts as a "root type" for all other kinds
of exceptions. In general, in AP we will not discriminate between
different types of exceptions, although Haskell provides facilities
for doing so. The easiest way to indicate that this is the exception
we want to catch is to make the handler a local function with an
explicit type ascription:
handleDivByZero :: IO ()
handleDivByZero = do
let handler :: SomeException -> IO ()
handler e = putStrLn "I am a handler"
print (div 1 0) `catch` handler
> handleDivByZero
I am a handler
We can turn a SomeException into a (hopefully) human-readable string
by using its Show instance:
handleDivByZero :: IO ()
handleDivByZero = do
let handler :: SomeException -> IO ()
handler e = putStrLn $ "It went wrong: " ++ show e
print (div 1 0) `catch` handler
Example: Safely Reading Files
The Haskell prelude provides the function readFile. Given a
FilePath (a synonym for String), it returns the contents of a
file:
readFile :: FilePath -> IO String
If the file cannot be read, it is reported with an exception:
> readFile "doesnotexist"
*** Exception: doesnotexist: openFile: does not exist (No such file or directory)
Since the exception handling machinery in Haskell is somewhat
cumbersome, we may want to write a wrapper for readFile that returns
a proper sum type with error conditions instead. Reading a file can go
wrong in many ways (perhaps someone cuts a disk cable at an
inopportune time), but there are often some common errors we want to
handle specially, such as the file not existing. We define a sum type
that captures the result of attempting to read a file:
data FileContents
= FileNotFound
| CouldNotRead String
| FileContents String
deriving (Show)
The CouldNotRead constructor is used as a catch-all for all errors
except for file-not-found, and FileContents represents success.
When readFile fails, it throws an exception of type IOError. Using
the function isDoesNotExistError from System.IO.Error, we can
detect whether such an IOError corresponds to the case where a file
of the given name does not exist. We can put all this together into a
function for reading a file safely (in this case, "safely" means "does
not throw exceptions"):
import System.IO.Error (isDoesNotExistError)
readFileSafely :: FilePath -> IO FileContents
readFileSafely f = (FileContents <$> readFile f) `catch` onException
where
onException :: IOError -> IO FileContents
onException e =
if isDoesNotExistError e
then pure FileNotFound
else pure $ CouldNotRead $ show e
And observe how well it works:
> readFileSafely "doesnotexist"
FileNotFound
> readFileSafely "/root/secrets"
CouldNotRead "/root/secrets: openFile: permission denied (Permission denied)"
> readFileSafely "ap-exam-solution.hs"
FileContents "module Solution where[...]"
Laziness and Exceptions
Haskell's laziness can sometimes make it difficult to handle exceptions in pure code. The reason is that exceptions are not thrown until the associated computation is forced, which may not be when you expect. For example, we may write code like this, with the intent of replacing a division-by-zero error with an appropriate dummy value:
doesNotWork :: IO Int
doesNotWork = do
let handler :: SomeException -> IO Int
handler e = do
putStrLn $ "It went wrong: " ++ show e
pure 42
pure (div 1 0) `catch` handler
But we receive an unpleasant surprise:
> doesNotWork
*** Exception: divide by zero
The reason is that the expression div 1 0 is not actually fully
evaluated inside the computation protected by catch - instead it is
simply returned un-evaluated, and not until ghci tries to print the
result of the computation (after catch is done) will be division
actually be attempted and the exception thrown.
One solution is to use the evaluate function, also from
Control.Exception, which has this signature:
evaluate :: a -> IO a
An expression evaluate x is much like pure x, but evaluates its
argument to weak head normal form (WHNF) before injecting it into
the monad. Intuitively, it will evaluate the provided expression up to
the first constructor, hopefully uncovering any exceptions
immediately. For Int, that will be the entire value, but for a
lists, it will only be up to the first cons cell. However, this is
enough to make this simple example work:
doesWork :: IO Int
doesWork = do
let handler :: SomeException -> IO Int
handler e = do
putStrLn $ "It went wrong: " ++ show e
pure 42
evaluate (div 1 0) `catch` handler
> doesWork
It went wrong: divide by zero
42
IO References
One of the basic facilities provided by the IO monad is a form of
mutable references, called IORefs, which can be found in the module
Data.IORef.
The type IORef a denotes a mutable reference to a value of type a.
We can create an IORef using the function newIORef:
newIORef :: a -> IO (IORef a)
When creating an IORef, we must provide an initial value. Reading
and writing is done through the following functions:
readIORef :: IORef a -> IO a
writeIORef :: IORef a -> a -> IO ()
While other utility functions exist, this interface is all we need in order to interact with IORefs.
> r <- newIORef True
> readIORef r
True
> writeIORef r False
> readIORef r
False
IORefs are not thread safe. When we discuss concurrent programming
later in the course we must be careful not to access them in
unstructured ways from multiple concurrent threads. Programming with
IORefs in Haskell is vulnerable to all the usual tragedies of concurrent
programming with mutable state.
Free Monads with IO
The example of free monads we saw above are perhaps a bit contrived,
as they merely involved replicating existing monads. In practice, we
often use free monads to abstract over complicated effects, typically
those in IO. Let us look at some use cases. By the constraints of
these notes, they will still be somewhat contrived (we can't fit an
actual production system here), but they will be more interesting than
spelling State in a new way.
An Uncontrived Real World Example
To start out with, let us consider one of the most interesting and useful functions, the recursive Fibonacci function:
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n = fib (n - 1) + (n - 2)
One common requirement when writing software is logging, yet we do
not wish every function to depend on some specific implementation of a
logging system. In particular, logging typically requires IO, and we
don't want every single function to live in the IO monad. Free
monads are a handy way to abstract out the notion of logging. Let us
define a type FibOp that encapsulates the effects that we need in
our fib function; currently restricted to merely logging.
data FibOp a = FibLog String a
instance Functor FibOp where
fmap f (FibLog s x) = FibLog s $ f x
Now we can define a FibM monad that supports FibOp effects, with
an accessor function fibLog:
type FibM a = Free FibOp a
fibLog :: String -> FibM ()
fibLog s = Free $ FibLog s $ pure ()
And finally we can use it in our definition of fib:
fib :: Int -> FibM Int
fib 0 = pure 1
fib 1 = pure 1
fib n = do
fibLog $ "fib(" ++ show n ++ ")"
x <- fib (n - 1)
y <- fib (n - 2)
pure $ x + y
One of the interesting parts of the FibM monad is that there are
many legitimate and interesting ways to interpret it (in contrast to
Reader or State, which have only a single sensible
interpretation). One obvious one is to interpret it in the IO monad,
where the logging messages are printed as lines:
ioFibM :: FibM a -> IO a
ioFibM (Pure x) = pure x
ioFibM (Free (FibLog s x)) = do
putStrLn s
ioFibM x
Example use:
> ioFibM $ fib 5
fib(5)
fib(4)
fib(3)
fib(2)
fib(2)
fib(3)
fib(2)
8
In a real application, we might log to the file system or some
dedicated logging daemon (and probably, we would be computing
something more interesting than Fibonacci numbers), but this is
decoupled from the users of the fibLog effect.
But another useful interpretation function is one that just discards the logging messages - and is pure:
pureFibM :: FibM a -> a
pureFibM (Pure x) = x
pureFibM (Free (FibLog _ c)) = pureFibM c
> pureFibM $ fib 5
8
And yet another useful interpretation is a pure one that accumulates the log messages in a list.
logFibM :: FibM a -> (a, [String])
logFibM (Pure x) = (x, [])
logFibM (Free (FibLog s c)) =
let (x', msgs) = logFibM c
in (x', msgs ++ [s])
> logFibM $ fib 5
(8,["fib(2)","fib(3)","fib(2)","fib(2)","fib(3)","fib(4)","fib(5)"])
It is easy to imagine how this could be useful for testing the pure logic for logging, without actually interacting with a complicated logging infrastructure.
Adding Another Effect
Above we saw how we could interpret the same effectful function
(fib) in three different ways, without modifying fib at all. Let
us now add another effect. One problem with the recursive Fibonacci
function is that it is very slow, as it redundantly recomputes the
same recursive invocations over and over again. If you execute
pureFibM $ fib 25 at the ghci prompt, you will likely wait several
seconds before you get a response.
One way to improve the performance of recursive computations with many shared subresults is memoisation, where we maintain a cache mapping function arguments to results. Then, whenever we encounter an argument we have seen before, we merely retrieve the result that was computed last time again.
Memoisation is notoriously inconvenient to implement in pure languages, because of the need to maintain a state. The idea behind memoisation is that the effect of the cache is not observable, but merely speeds up the computation, but Haskell does not know that. Instead, we have to manually manage the cache of previous results, which raises additional questions, such as when to expire cache entries in order to avoid space leaks. It's a rather complicated space, and intermingling memoisation logic with algorithmic logic is likely to result in a mess.
Instead, let us augment the FibM monad to handle memoisation. First,
we add a new kind of effect to FibOp, namely FibMemo:
data FibOp a
= FibLog String a
| FibMemo Int (FibM Int) (Int -> a)
The FibMemo constructor has three components:
-
An integer
ndenoting that this effect refers to the result of computingfib(n). -
A
FibM Intcomputation that computesfib(n)if executed. -
A continuation
Int -> athat should be invoked with the result of the computation stored in theFibM Int- or a memoised version if available.
The instance definition and the accessor functions are fairly straightforward; strongly resembling those we have seen before.
instance Functor FibOp where
fmap f (FibLog s x) = FibLog s $ f x
fmap f (FibMemo n m c) = FibMemo n m $ \y -> f (c y)
fibMemo :: Int -> FibM Int -> FibM Int
fibMemo n m = Free $ FibMemo n m pure
The idea behind fibMemo is that we use it to wrap a computation, for
example like so:
fib :: Int -> FibM Int
fib 0 = pure 1
fib 1 = pure 1
fib n = fibMemo n $ do
fibLog $ "fib(" ++ show n ++ ")"
x <- fib (n - 1)
y <- fib (n - 2)
pure $ x + y
The operational idea is that whenever the fib n case is reached, we
want to look if an existing result for n has already been computed.
If so, we return it. If not, we compute the result using the provided
computation. Of course, whether that is actually what happens
depends on how we write our interpreter function for FibM. For
example, we can add support for FibMemo to pureFibM in a way that
does not actually perform any memoisation:
pureFibM :: FibM a -> a
pureFibM (Pure x) = x
pureFibM (Free (FibMemo _ x c)) = pureFibM $ c $ pureFibM x
pureFibM (Free (FibLog _ c)) = pureFibM c
But of course, that rather defeats the purpose of FibMemo. Instead,
we can write an interpretation function memoFibM that carries around
a cache of type [(Int,Int)], in which memoisation results are
stored. We implement this by using a local helper function that
accepts and returns the state, and then we discard the final state at
the end.
memoFibM :: FibM a -> a
memoFibM m = fst $ memo [] m
where
memo :: [(Int, Int)] -> FibM a -> (a, [(Int, Int)])
memo cache (Pure x) = (x, cache)
memo cache (Free (FibMemo n fn c)) =
case lookup n cache of
Just res -> memo cache $ c res
Nothing ->
let (fn', cache') = memo cache fn
in memo ((n, fn') : cache') (c fn')
memo cache (Free (FibLog _ x)) =
memo cache x
In the FibMemo case, we check whether a result for n is already
known, and if so, we return it. Otherwise we compute it by executing
fn. Note that memo could also be implemented using the State
monad, as the way we handle the cache is identical to how State
handles state.
Now even large applications of fib finish almost instantaneously, as
memoisation transforms the exponential complexity to linear:
> memoFibM $ fib 1000
9079565065540428013
Although memoFibM is a rather simplistic way of handling
memoisation, in that the cache is not persistent across multiple
invocations, it is not difficult to conceive of a variant that uses
IO to store memoisation results in a database or on the file system,
perhaps with limitations on the maximum size of stored results, or
some expiry policy that removes entries after a time. All of these
changes can be made without modifying fib itself.
Another useful change would be to allow memoisation of arguments and
results that are not exclusively of type Int (or some other fixed
type). This is not particularly difficult, although somewhat more
verbose, and so we have left it out of the exposition here.
Asynchronous Programming with Free Monads
Asynchronous programming styles have become common in languages targeted towards network programming, often support by language features such as async/await facilities. The purpose of such language features is to hide the somewhat contorted control flow otherwise required by asynchronous programming. For example, a program often needs to wait for an event to happen. Operationally, this happens by suspending the current computation, recording its state in a data structure somewhere. Whenever an event comes in, it is checked whether any suspended computations depend on it, and if so, they are resumed until the next time they need to be suspended. However, exposing all this complexity leads to a very awkward programming experience. Instead, we would like to simply have a seemingly normal function that blocks until the requested event arrives - but of course without suspending the entire system. We shall now see how this can be accomplished using a design based on free monads.
We start by defining a very simple model of events. An event is a name paired with a value, and the value is always an integer.
type EventName = String
type EventValue = Int
type Event = (EventName, EventValue)
Events come from the outside world, in unpredictable order and with uncertain timing, and are in practice often the result of communication with other programs. For testing purposes, we can model sequences of events as Haskell lists, but baking such an assumption into our systems would make them useless in practice. At any given time, many computations may be suspended waiting for events to happen; some of them perhaps waiting for the same events.
To support his style of programming, we define an effect type for our asynchronous programming model, with support for two effects:
-
Waiting for an event of a given name.
-
Logging a message. This is solely so we can observe execution of our asynchronous programs through their side effects (printing to the console), and is in principle unrelated to events.
The definition, along with its Functor instance, is as follows:
data EventOp a
= WaitFor EventName (EventValue -> a)
| Log String a
instance Functor EventOp where
fmap f (WaitFor s c) = WaitFor s $ \x -> f (c x)
fmap f (Log s c) = Log s $ f c
type EventM a = Free EventOp a
And it is all packed together under the name EventM with two
accessor functions waitFor and logMsg:
waitFor :: String -> EventM EventValue
waitFor s = Free (WaitFor s pure)
logMsg :: String -> EventM ()
logMsg s = Free $ LogMsg s $ pure ()
Here are three examples of how to use the monad. All of these
functions listen for events and do something (fairly trivial) with the
result. The purpose of the divider example is solely to illustrate
that control flow and looping is possible.
adder :: EventM ()
adder = do
logMsg "starting adder"
x <- waitFor "add"
y <- waitFor "add"
logMsg $ unwords [show x, "+", show y, "=", show $ x + y]
multiplier :: EventM ()
multiplier = do
logMsg "starting multiplier"
x <- waitFor "mul"
y <- waitFor "mul"
logMsg $ unwords [show x, "*", show y, "=", show $ x * y]
divider :: EventM ()
divider = do
logMsg "starting divider"
x <- waitFor "div"
y <- waitForDivisor
logMsg $ unwords [show x, "/", show y, "=", show $ x `div` y]
where
waitForDivisor = do
y <- waitFor "div"
if y == 0
then do
logMsg $ "Cannot divide by zero"
waitForDivisor
else pure y
Once you have finished with this section, and you have seen how the sausage is made, I suggest returning to these definitions and normal how normal they look. The complexity of how they are actually executed is completely hidden by the monad abstraction.
A definition such as adder represents a process. It runs for as
far as possible until the value of an event is needed, at which point
it is suspended. We can write an interpretation function that does
just that; evaluating as many of the effects as possible until
reaching a WaitFor:
stepUntilWait :: EventM a -> IO (EventM a)
stepUntilWait (Pure x) = pure $ Pure x
stepUntilWait (Free (LogMsg s c)) = do
putStrLn $ s
stepUntilWait c
stepUntilWait (Free (WaitFor s c)) =
pure $ Free $ WaitFor s c
It is possible to use stepUntilWait directly in ghci, but the
result is not terribly interesting:
> a <- stepUntilWait adder
starting adder
Now we have a name a representing a suspended execution.
:t a
a :: EventM ()
Unfortunately we cannot inspect its structure, because EventOp is
not an instance of Show, but we can be pretty sure it is currently
stuck on a WaitFor effect.
At some point, an event may arrive. We can then check whether the event name matches what the suspended execution is waiting for, and if so, call the continuation with the value. If the event name does not match, we do nothing. We can encapsulate this in a function:
stepSingleEvent :: EventM () -> Event -> IO (EventM ())
stepSingleEvent (Free (WaitFor waiting_for c)) (event_name, event_val) =
if waiting_for == event_name
then stepUntilWait $ c event_val
else pure $ Free $ WaitFor waiting_for c
stepSingleEvent p _ = pure p
After invoking the continuation, we use stepUntilWait to evaluate
any subsequent non-WaitFor events, but we do not recursively call
stepSingleEvent. This is because events are distinguishable: we want
the adder process to process two distinct events, not have the
same event with name "add" to provide values for both waitFors.
Here is how we can use stepSingleEvent, continuing execution of the
a above:
> b <- stepSingleEvent a ("add", 1)
> c <- stepSingleEvent b ("add", 2)
1 + 2 = 3
Note how execution returns to our control after every invocation to
stepSingleEvent. This allows us to use arbitrary logic to retrieve
events (such as reading them from the network or a file), without the
process definitions (adder, multiplier, divider) having to care
about the details.
This is often called an event pump, by analogy to old-fashioned
water pumps. We continue cranking the handle (calling
stepSingleEvent), which lets the process continue through its
execution. The interesting thing is that the suspended computations,
the a, b, and c values above, are ordinary Haskell values, that
we can manipulate like any other Haskell value. One slightly dubious
thing we can do is to keep reusing the same suspended computation
multiple times:
> stepSingleEvent b ("add", 2)
1 + 2 = 3
> stepSingleEvent b ("add", 2)
1 + 2 = 3
> stepSingleEvent b ("add", 2)
1 + 2 = 3
Another more useful thing we can do is to keep multiple suspended
processes in a list. Whenever an event arrives, we crank the pump once
on each of them. If a process is truly finished, represented by the
Pure constructor, we remove it from the list. This can be expressed
as a fairly simple recursive function:
stepEventM :: [EventM ()] -> Event -> IO [EventM ()]
stepEventM [] _ = pure []
stepEventM (p : ps) event = do
p' <- stepUntilWait p
case p' of
Pure () -> stepEventM ps event
_ -> do
p'' <- stepSingleEvent p' event
ps' <- stepEventM ps event
pure $ p'' : ps'
And finally, we can write another straightforward function that simply
calls stepEventM once for every event in a list of events:
runEventM :: [EventM ()] -> [Event] -> IO [EventM ()]
runEventM ps [] = do
pure ps
runEventM ps (e : es) = do
ps' <- stepEventM ps e
runEventM ps' es
This lets us have interleaved execution of asynchronous operations - a programming technique that in most languages is either hopelessly complicated, or requires direct runtime support.
> runEventM [adder, multiplier, divider]
[("add", 1),
("mul", 2),
("div", 3),
("add", 4),
("div", 0),
("mul", 5),
("div", 6)]
starting adder
starting multiplier
starting divider
1 + 4 = 5
Cannot divide by zero
2 * 5 = 10
3 / 6 = 0
As an example that truly demonstrates how decoupled the processes are
from how events are read, the following function reads events
interactively from the console, through the the readLn function
which reads a value in Haskell syntax.
interactivelyRunEventM :: [EventM ()] -> IO ()
interactivelyRunEventM [] = pure ()
interactivelyRunEventM ps = do
ps' <- mapM stepUntilWait ps
event <- readLn
ps'' <- stepEventM ps' event
interactivelyRunEventM ps''
Here is an example of using it, where the output from the processes is intermixed with my typed input:
> interactivelyRunEventM [adder, multiplier, divider]
starting adder
starting multiplier
starting divider
("add", 1)
("add", 2)
1 + 2 = 3
("div", 3)
("mul", 2)
("mul", 4)
2 * 4 = 8
("div", -1)
3 / -1 = -3
Property-Based Testing
Properties
When dealing with type classes we discussed the concept of laws, which are
properties that should hold for instances of a given type class. For instance,
if a type T is an instance of Eq we expect x == x to evaluate to True
for every possible value x :: T.
Properties are not, however, intrinsically linked to type classes. An example
of a property not related to any type class is the interaction between length
and (++). This holds in general, but for concreteness consider lists of
integers. For any two lists xs :: [Integer] and ys :: [Integer] we have
length (xs ++ ys) = length xs + length ys
Another way of stating the same thing is that the function
prop_lengthAppend :: [Integer] -> [Integer] -> Bool
prop_lengthAppend xs ys = length (xs ++ ys) == length xs + length ys
returns True for all possible arguments. We could come up with a number of test cases, e.g.
tediousTestCases :: [([Integer], [Integer])]
tediousTestCases = [([], []), ([0], [1, 2]), ([3, 4, 5], [])] -- etc.
and test with something like all (\(xs, ys) -> prop_lengthAppend xs ys) tediousTestCases, but this is quite tedious. QuickCheck automates this tedium
away by generating (somewhat) random inputs. The workhorse is quickCheck
which accepts something Testable (explained later) runs it with a number of
different inputs. Simply running quickCheck prop_lengthAppend covers more
cases than any unit test suite we would realistically have the patience to
maintain. The default is 100 tests, but if we want more we can run e.g.
quickCheck $ withMaxSuccess 10000 prop_lengthAppend
Of course, no amount of test cases is enough to argue total correctness, but tuning the amount of tests allows us to trade time for certainty.
Counterexamples
Consider another property, stating that (++) is commutative:
prop_appendCommutative :: [Integer] -> [Integer] -> Bool
prop_appendCommutative xs ys = xs ++ ys == ys ++ xs
Running quickCheck prop_appendCommutative quickly falsifies this theory and
prints out a counterexample such [0] and [1]. QuickCheck is very useful
when we are genuinely unsure whether a property holds, since in practice false
properties often have easy-to-find counterexamples.
The Value of Properties
Why do we care whether a property like prop_lengthAppend holds? It does,
after all, not directly say anything about the correctness of length, (+)
or (++). For instance, given the obviously wrong definitions
_ + _ = 0
_ ++ _ = []
the property would still hold. The crucial observation is that in practice code is seldom wrong in ways that happen to not violate any properties. Therefore observing that a number of non-trivial properties involving some function are true is a good proxy for correctness of the function.
But if properties are merely good proxies for correctness, why is that better
than just testing correctness directly? The reason is that many properties are
like the ones we have seen so far: they can be expressed as some boolean
condition with variables that should hold for all choices of those variables.
This is easy to test using QuickCheck or similar systems. Direct testing is
harder to automate. That would require producing many test cases like [] ++ [] == [] and [1, 2] ++ [3, 4] == [1, 2, 3, 4] and so on, which is manual (and
error-prone) work.
The Testable Type Class
The quickCheck function in fact works on any type which is an instance of
Testable. The primary instances and their semantics for testing are worth
going over:
()is testable and succeeds if it returns()(the only possible value of the type()) and fails if an exception occurs.Boolis testable whereTruemeans success andFalseor an exception means failure.Maybe ais testable ifais.Nothingmeans that the test should be discarded and counted neither as a success nor as a failure.Just resulthas the meaning ofresult.a -> bis testable ifaisArbitrary(meaning that we have a way of generating values of that type; see the next section) andbisTestable. The semantics is thatf :: a -> bsucceeds iff x :: bsucceeds for allx :: a. In practice this is tested by generating random values ofa. Note that this instance applies recursively so e.g.Integer -> Integer -> BoolisTestablebecauseInteger -> BoolisTestable; andInteger -> BoolisTestablebecauseBoolisTestable.
This works great. We can write down properties using familiar Haskell types
without even depending on the QuickCheck library. However, what if we want to
collect all our properties into a list for test organisation purposes? If we
have p :: Integer -> Bool and q :: String -> Bool then [p, q] is not
well-typed. The Testable type class has a method property :: a -> Property
which converts any Testable value into a Property. Think of Property as a
Testable value of unknown type. A list of properties should be of type
[Property] and constructed like [property p, property q].
Arbitrary
So far we have relied on QuickCheck automatically coming up with values for
our properties. The mechanism behind this is the Arbitrary type class alluded
to above, which defines a method arbitrary :: Gen a that is supposed to
define the "canonical" generator for the type. Hence, we first need to
understand generators.
Generator Basics
As a first approximation the type Gen a represents a probability distribution
over elements of a. It can also be thought of as a computation that can
depend on random choices. Generators are defined using a combination of
primitives and monad operations.
The simplest generator is pure x which produces the value x with
probability 1. Given a list of generators gs :: [Gen a] the generator oneof gs chooses one of the generators with equal probability. For instance oneof [pure "heads", pure "tails"] produces "heads" and "tails" with equal
probability, but oneof [pure "heads", pure "tails", pure "tails"] is biased
in favour of "tails".
It is also possible to explicitly control the bias using frequency, which is
like oneof but allows specifying the weight of each option. The biased
example using oneof would written more idiomatically as frequency [(1, pure "heads"), (2, pure "tails")].
QuickCheck has a function called sample which takes a generator and prints 10
example values. This is quite useful to get a rough sense of what a generator
produces and is often sufficient to spot simple biases like in the previous
example.
Recursive Generators
QuickCheck has a combinator called listOf which generates [a] given a
generator for a. Let us generate a list of integers using the standard
integer generator given by its Arbitrary instance. An example output is:
> sample $ listOf (arbitrary :: Gen Integer)
[]
[-1]
[2,1]
[-6,1,-6,-1]
[6]
[7,-10,8,2,-7,0,-7]
[-5,-4,-6,-5,-3,-2,-5,6,-7,-5,-6]
[]
[-11,2,7,-16,-11,11,-14,5,-12,13,12]
[18,-13,17,-9,-16]
[20,8,-12,-4,16,8,7,4,-20,-1,-6,8,6,16,14,-8,14,-6,-1]
Note that there is a decent spread both in the length of the list and the
individual integer values. How would we go about implementing a combinator like
listOf? A first attempt might be:
list1 :: Gen a -> Gen [a]
list1 g = oneof [pure [], (:) <$> g <*> list1 g]
This is a choice between an empty list and a list consisting of an element
generated by g followed by a recursively generated list. Each choice has
equal chance, so 50% of lists will be empty, another 25% will have just a
single element and so on.
Alas, the distribution leaves something to be desired:
> sample $ list1 (arbitrary :: Gen Integer)
[]
[]
[0,1]
[4]
[-7,-4]
[]
[5,-8]
[1]
[]
[]
[8]
Every other sample is an empty list and long lists are exceedingly unlikely,
which makes this generator inefficient for exploring the search space. A second
attempt might be to use frequency to introduce a bias towards longer lists:
list2 :: Gen a -> Gen [a]
list2 g = frequency [(1, pure []), (9, (:) <$> g <*> list1 g)]
The resulting distribution is better, but still heavily favours short lists with an occasional longer list.
> sample $ list2 (arbitrary :: Gen Integer)
[0]
[2,0]
[-2]
[1,5,4]
[0,6,-4]
[5,-2,-6,-3,-5]
[-4]
[-2]
[-11]
[-11]
[16]
We could try adjusting the bias, but no matter what value we use the length of the list will follow an exponential distribution, which is not really what we want.
For our third attempt, we exploit the fact that Gen is a monad. First
generate a non-negative integer n, and then generate a list of length n:
list3 :: Gen a -> Gen [a]
list3 g = abs <$> (arbitrary :: Gen Int) >>= go
where
go 0 = pure []
go n = (:) <$> g <*> go (n - 1)
Now the distribution is similar to QuickCheck's listOf.
> sample $ list3 (arbitrary :: Gen Integer)
[]
[-2,-1]
[]
[-5,0,6,-2]
[-8,-1,-6,5,5,8,4,8]
[2,1,-8,-2,7,-6,-7,-5,-8,-10]
[2,4,2,4,5,-12,5,-5,12,-4,-2,-1]
[2,11,-10,6,-3,3,-8,11,9,9,7]
[6,13,9,6,3,3,6,13,-10,-4,2,-16,-9,-16,0]
[6,-10,12,-5,-12,14]
[-14,0]
Size Dependent Generators
When testing a property it is often a good idea to start with small values and
then gradually increase the complexity of the test cases. QuickCheck uses this
approach by giving generators access to a size parameter (similar to a
Reader monad) which under default settings starts at 0 and increases by 1
every test up to a maximum of 99.
The size can be accessed directly using getSize :: Gen Int but usually a
neater approach is to use the combinator sized :: (Int -> Gen a) -> Gen which
turns a size-dependent generator into an ordinary one. A good generator
respects the size parameter, so our list generator is more idiomatically
written as:
list4 :: Gen a -> Gen [a]
list4 g = sized $ \n -> chooseInt (0, n) >>= go
where
go 0 = pure []
go n = (:) <$> g <*> go (n - 1)
This is essentially the definition of listOf in QuickCheck (where go is
known as vectorOf).
Shrinking
Suppose we define our own type of pairs with an instance of Arbitrary:
data Pair a b = Pair a b
deriving Show
instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
arbitrary = Pair <$> arbitrary <*> arbitrary
We can now define a version of commutativity for (++) that takes the input as
a Pair:
prop_appendCommutative' :: Pair [Integer] [Integer] -> Bool
prop_appendCommutative' (Pair xs ys) = xs ++ ys == ys ++ xs
QuickCheck still finds a counterexample. A possible output is:
> quickCheck prop_appendCommutative'
*** Failed! Falsified (after 5 tests):
Pair [-2,1,3,-2] [-4,4,-1,2]
However, the counterexample is not as simple as the counterexample to our
original property. Running quickCheck multiple times will reveal that
prop_appendCommutative consistently produces small counterexamples while
prop_appendCommutative' produces counterexamples of various sizes.
The secret ingredient is shrinking. The Arbitrary type class also defines a
member shrink :: a -> [a] which takes a value and produces a list of
shrinks, i.e. "slightly smaller" values. The idea is that if x is a
counterexample to some property then any of the elements in the list shrink x
could also be counterexamples.
When QuickCheck finds a counterexample x it tests the property for each
shrink of x. If that result in another, by definition simpler, counterexample
the process repeats recursively until the (locally) simplest counterexample is
reached.
For a value Pair x y a natural notion of "slighty smaller" is a pair which is
slightly smaller in either the first component or the second component. The
complete Arbitrary instance is thus:
instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
arbitrary = Pair <$> arbitrary <*> arbitrary
shrink (Pair x y) = [Pair x' y | x' <- shrink x] ++ [Pair x y' | y' <- shrink y]
Why not shrink both components simultaneously? Well, suppose x' is slighty
smaller than x and y' is slightly smaller than y. Then Pair x' y' is
slightly smaller than Pair x y' (or Pair x' y) which in turn is slightly
smaller than Pair x y so assuming that either Pair x y' or Pair x' y is
also a counterexample the process would reach Pair x' y' in two steps. In
general, there is a trade-off between efficiency (i.e. not producing too many
shrinks) and likelihood of finding the very simplest counterexample.
Tasty QuickCheck
The Tasty testing framework has support for QuickCheck via the package
tasty-quickcheck. For example, testProperties "properties" props is a
simple test tree, given props :: [(String, Property)].
This test tree exposes options for Tasty on the command line. For example, to control the number of tests we can run
$ cabal test --test-option --quickcheck-tests=10000
Concurrent Programming
Haskell offers a wide range of facilities to support for different styles of concurrent and parallel programming. In this chapter we focus on a limited set of primitives for concurrent programming which can often be found in similar form in other modern programming languages. We use:
-
Lightweight independent threads of control.
Lightweight means we can create many threads without worrying about overhead (up to a couple of hundred thousand is usually fine).
-
Channels for communicating between threads.
The approach we take to concurrent programming in AP is based on the paradigm of message passing, and is heavily inspired by languages such as Erlang. The idea is to structure concurrent programs as independent servers (a.k.a. concurrent objects or actors in other languages and frameworks) that communicate with each other by sending asynchronous messages. Each server maintains its own private state, and servers cannot directly modify the state of other servers, except by sending messages.
Although the concurrent systems we will construct in AP will run only on a single machine (and within a single Haskell process), the approach is perfectly suitable for distributed systems, as seen in for example Cloud Haskell, or languages such as Erlang and Elixir.
Concurrency is closely related to (but not the same as) parallelism. While multi-threading in Haskell is indeed one way to take advantage of parallel multi-core computers, this is not an explicit aspect of our study of concurrency. Instead, we focus on concurrency as a programming model which happens to be convenient for expressing certain forms of event-driven systems.
Concurrent programming in Haskell is done in the IO monad because
threads are executed for their effects. Threads do not have a "return
value" as such, so the only way they can influence a computation is
through their side effects. Effects from multiple threads are
interleaved nondeterministically at runtime.
Concurrent programming allows programs that interact with multiple external agents to be modular:
- The interaction with each agent is programmed separately
- Allows programs to be structured as a collection of interacting agents, sometimes called actors or (mini) servers.
This chapter is about a principled and systematic way of constructing concurrent programs as a collection of interacting servers.
Concurrency Primitives
We use the Haskell modules
Control.Concurrent
and
Control.Concurrent.Chan.
The latter is implicitly re-exported by the former. As always, we will
use only a fairly small subset of the facilities provided by the
Haskell standard library. You are welcome (and encouraged) to peruse
the documentation to enlighten yourself, but in this particular case
you should be careful not to be tempted by functions that subvert the
notion of message-passing. In this section we will use the following
facilities from Control.Concurrent:
import Control.Concurrent
( Chan,
ThreadId,
forkIO,
newChan,
readChan,
writeChan,
)
To create a new thread in Haskell, we use the forkIO function. The
forkIO function has the following type:
forkIO :: IO () -> IO ThreadId
In other words, to create a thread we pass forkIO an action of type
IO (), meaning a monadic computation in the IO monad. Typically,
this will be some kind of potentially infinite loop that receives and
handles messages, as we will see in a moment. The thread will continue
to run until this action terminates.
The forkIO function returns a ThreadId that can be used for
interacting with the thread in low level ways, although we will not
make much use of that in AP. Instead, we will communicate using
channel-based messaging.
runThread :: IO ()
runThread = do
t <- forkIO $ putStrLn "Hello there."
print t
> runThread
HellToh rtehaedrIed.
47
Note how the output of the new thread and the original computation is interleaved.
Channels and Messages
In Haskell, communication is done via channels. A channel is created
using the newChan action:
newChan :: IO (Chan a)
The newChan action produces a channel that can be used for sending
and receiving messages of type a. The precise type of a will be
inferred by the compiler.
Messages can be both read and written to a channel, corresponding to receiving and sending messages, using the following two functions:
writeChan :: Chan a -> a -> IO ()
readChan :: Chan a -> IO a
Conceptually, a channel is an unbounded queue of messages. Writing to a channel is an asynchronous operation - it immediately and always succeeds. Reading from a channel retrieves the oldest message in the channel. If the channel is empty, reading blocks until a message is available.
channelExample :: IO ()
channelExample = do
c <- newChan
_ <- forkIO $ do
r <- readChan c
putStrLn $ "Received message: " <> r
writeChan c "Hello there."
> channelExample
Receive message: Hello there.
Whenever we create a thread, we will also create a channel through which we can communicate with the thread. Typically the thread will run a loop that repeatedly reads from the channel and responds to message.
channelLoopExample :: IO ()
channelLoopExample = do
c <- newChan
let threadLoop = do
r <- readChan c
putStrLn $ "Received message: " <> r
threadLoop
_ <- forkIO threadLoop
writeChan c "The first"
writeChan c "The second"
writeChan c "The third"
> channelLoopExample
Received message: The first
Received message: The second
Received message: The third
When two different threads have a reference to the same channel (c
in the example above), they can communicate. However, completely
arbitrary use of a shared channel will quickly lead to chaos, so we
step in to restore order.
Single-reader principle: we adopt the rule that a channel may have
only a single reader, meaning only a single thread is allowed to
call readChan on any given channel. This is typically the thread
that we created the channel for. This is not enforced by the Haskell
type system, and there are indeed forms of concurrent programming
that are more flexible, but they are outside the scope of AP.
It is perfectly acceptable (and often necessary) for a channel to have multiple writers.
If we call readChan on a channel where we hold the only reference
(meaning we would in principle wait forever), the Haskell runtime
system will raise an exception that will cause the thread to be
terminated. This is a natural and safe way to shut down a thread that
is no longer necessary, assuming the thread does not hold resources
(e.g., open files) that must be manually closed. Handling such cases is
outside the scope of this note.
Remote procedure calls (RPC)
The Haskell message passing facility is asynchronous, but quite often we wish to send a message to a server and then wait for it to respond with some kind of result, corresponding to a procedure call. To implement synchronous remote procedure calls (RPC), we need to invent a bit of machinery on top of the basic message passing machinery. The way we make it work is by creating a new channel that is used for transmitting the result. This channel is then sent along as part of the message.
The starting point (and always good practice) is to define an explicit type for the messages we would like to send.
data Msg = MsgInc Int (Chan Int)
We then define our thread loop as follows:
threadLoop :: Chan Msg -> IO ()
threadLoop c = do
msg <- readChan c
case msg of
MsgInc x from ->
writeChan from (x + 1)
threadLoop c
Given a handle to a channel of type Chan Msg, we can then send a
message, and wait for a response, as follows:
performRPC :: Chan Msg -> Int -> IO Int
performRPC c x = do
from <- newChan
writeChan c $ MsgInc x from
readChan from
And tying it all together:
ex2 :: IO ()
ex2 = do
c <- newChan
_ <- forkIO $ threadLoop c
print =<< performRPC c 0
print =<< performRPC c 1
Implementation of the GenServer module
Using the concurrency primitives directly is somewhat error-prone,
particularly for the constrained form of concurrency we study in AP.
Therefore, we wrap these primitive in a module GenServer that
defines a canonical way of using the techniques discussed above, and
in the rest of this note we use the GenServer module to write our
servers. There may still be cases where we have to break out of the
GenServer abstraction, but we will largely try to work within it.
We will make use of the following imports:
import Control.Concurrent
( Chan,
ThreadId,
forkIO,
killThread,
newChan,
readChan,
threadDelay,
writeChan,
)
Servers
The forkIO procedure provides a low-level way to create a new
thread. However, we want a canonical way to communicate with our
servers. Thus, we introduce the Server abstract type. We represent a
server as a pair: a ThreadId and an input channel:
data Server msg = Server ThreadId (Chan msg)
Here we use the type variable message to denote the type of messages
that a server can receive, which can be different for each kind of
server.
spawn :: (Chan a -> IO ()) -> IO (Server a)
spawn serverLoop = do
input <- newChan
tid <- forkIO $ serverLoop input
return $ Server tid input
Note that Server will be an abstract type - users cannot directly
access its components, except through the interface we define below.
Channels
In the GenServer abstraction, channels are unchanged from their
primitive form, except that we define some more concise function
names.
send :: Chan a -> a -> IO ()
send = writeChan
receive :: Chan a -> IO a
receive = readChan
However, to users of a server the channel is hidden away in the
Server type, and so we provide a dedicated sendTo function for
sending a message to the server.
sendTo :: Server a -> a -> IO ()
sendTo (Server _tid input) msg =
send input msg
Request-Reply Pattern
We saw above how to implement RPC on top of asynchronous messages. To
cut down on the boilerplate and avoid incorrect usage, GenServer
provides a structured facility for performing RPCs.
First, we define an abstract type that encapsulates a the reply channel. Under the hood, this is just a normal channel, but the wrapper type denotes that its purpose is to reply to an RPC.
newtype ReplyChan a = ReplyChan (Chan a)
The idea is that only one message is ever sent to this channel. This
is not something we can express within Haskell's type system (at least
not without extensions that go beyond what we discuss in AP). We
provide a function reply for sending a reply on a ReplyChan:
reply :: ReplyChan a -> a -> IO ()
reply (ReplyChan chan) x = send chan x
Finally, we provide a function requestReply that encapsulates the
notion of creating a reply channel, providing it to a message
constructor, and reading the response from the reply channel.
requestReply :: Server a -> (ReplyChan b -> a) -> IO b
requestReply serv con = do
reply_chan <- newChan
sendTo serv $ con $ ReplyChan reply_chan
receive reply_chan
If we avoid exporting the definition of ReplyChan from GenServer
(meaning it is an abstract type), then requestReply is the only
place one can read from the reply channel, which is exactly what we
want.
Method
The following is a five step method to systematically designing and implementing a server. The steps are presented as sequential phases, but in practise there will be a bit of going back and forward between steps.
-
Determine what data (the internal state) the server should keep track of, declare a type for this.
If you lack imagination for a name for this type you can always go with
InternalData. -
Determine the interface for the server. That is, a set of functions where each function takes the server as the first argument and possibly other arguments as well. Furthermore, for each function we should determine if the function is blocking or non-blocking.
In general a function is blocking if we need to wait for a result depending on the state of the server.
The blocking behaviour can sometimes be refined into limited blocking if there is some upper limit on how long a function can be blocked. We might not know what exactly the upper limit is (as it might depend on various system specific constants and dynamic behaviours). Or unlimited blocking if the function might block forever.
These functions is the external interface for the server.
-
Declare an internal type for the kind of messages (both external and internal messages) a server can receive.
We use the pattern where we make a constructor for each kind of message and the argument(s) to be send with that kind of message. If there is an expected reply to the given kind of message, we use the convention that the last argument for that constructor is a channel for sending back the response. This convention is to make sure that we can use the
requestReplyfunction without too much bother. -
Implement a server-loop function.
We use the convention that a server-loop function should take the input channel for the server as the first argument. This convention makes it convenient to use the
spawnfunction.The server loop will usually start by receiving a message on the input channel and then use a
case-expression to pattern match on each kind of message and determine what action to do. Each action will usually compute a (potentially unchanged) internal state, and potentially send some messages, for instance replies to requests. -
Implement API functions.
When we have declared the type for messages and implemented the server loop, the last step is to implement the API functions. Where we use
requestReplyfor each blocking function andsendTofor each non-blocking function.
It is usually best practise to declare each server in a separate module. Thus when we talk about internal types and functions, it is types and functions not exported from the module. However, there are cases where a server may define its own internal servers for utility purposes, that would be awkward to define in a separate module.
Worked Example: Counter Server
In this example we want to make a server that keeps track of a count,
a counter server. It should be possible to get the value of the
counter, to increment the counter by one, or to decrement the
counter by positive amount n. We will maintain the invariant that
the counter is always non-negative. While this is perhaps not a
terribly useful server, it does demonstrate facilities that most
servers will need; namely keeping some kind of state, responding to
requests for changes to that state, and maintaining invariants for
that state.
Step 1: Internal state
The server should keep track of an integer as the internal state:
type InternalData = Int
Step 2: API functions
The API for the counter server is:
-
newCounter initialfor creating a new counter server with the initial valueinitial. It is an error ifinitialis negative. -
getVale cntfor getting the value of the counter server,cnt. This is a blocking function, because we need to wait for a result. -
incr cntfor incrementing the value of the counter server,cnt, by one. This is a non-blocking function, because it cannot fail and we don't need to wait for a result. -
decr cnt nfor decrementing the value of the counter server,cnt, byn. This is a blocking function, because it can fail ifnis larger than the current value of the counter server. Thus, we need to wait for a result that tells us if the function succeeded.Note, this is the interesting function of the example. Because it isn't clear what it should mean to decrement a counter with too large an amount. We have two options:
-
The function blocks for a short amount of time, and reports if the decrement was successful or not (our choice for now). We call this limited blocking.
-
The function blocks until it is possible to decrement the counter with the given amount. This means that the function might block forever (in principle). We call this unlimited blocking.
-
Step 3: A type for messages
This step is to make an internal type for the messages that will be send to the server.
For the counter server we have a message for each of the interface functions and don't have any internal messages:
data Msg = GetValue (ReplyChan Int)
| Incr
| Decr Int (ReplyChan Bool)
Note how the messages for the blocking functions getValue and decr
have a channel as the last argument.
Step 4: Implement the server-loop function
The server-loop function for a counter server is:
counterLoop :: InternalData -> Chan Msg -> IO ()
counterLoop state input = do
msg <- receive input
case msg of
GetValue from -> do
let (newState, res) = (state, state)
reply from res
counterLoop newState input
Incr -> do
let newState = state + 1
counterLoop newState input
Decr n from -> do
let (newState, res) =
case state of
value | value > n -> (value - n, True)
_ -> (state, False)
reply from res
counterLoop newState input
Step 5: Implement API functions
The API functions for a counter server can now be implemented straight
forward by using the spawn, sendTo and requestReply functions
from the GenServer module:
type CounterServer = Server Msg
newCounter :: Int -> IO CounterServer
newCounter initial | initial >= 0 = spawn $ counterLoop initial
newCounter _ = error "Initial value should be non-negative"
getValue :: CounterServer -> IO Int
getValue cnt = requestReply cnt GetValue
incr :: CounterServer -> IO ()
incr cnt = sendTo cnt Incr
decr :: CounterServer -> Int -> IO Bool
decr cnt n | n >= 0 = requestReply cnt $ Decr n
decr _ _ = error "Cannot decrement with negative amount"
Example use of a counter server
main = do
c <- newCounter 0
incr c
replicateM_ 5 $ incr c
_ <- decr c 1
v <- getValue c
putStrLn $ "The counter should now be 5, and it is " ++ show v
Extending Genserver with support for timeouts
The server abstraction does not directly support timeouts for blocking calls. However, we can build our own support for timeouts. The technique we employ is based on three ingredients:
- we have a channel where we allow the reply to be either the intended value or a special timeout value.
- we start a worker thread, which will evaluate an action, and send the result back to us.
- we also launch an extra thread that sleeps for some period of time, then sends the timeout value to us.
If the non-timeout response is the first to arrive, then the timeout value is ignored and harmless.
Then we define a type Timeout with a single value Timeout.
data Timeout = Timeout
We can use this to build a function for performing an action with a timeout:
actionWithTimeout :: Int -> IO a -> IO (Either Timeout a)
That is, actionWithTimeout s act will perform the action act
within a time limit of s seconds; it returns an action of type
IO(Either Timeout a) where the special value Timeout is returned
if act did not complete within the time limit:
actionWithTimeout :: Int -> IO a -> IO (Either Timeout a)
actionWithTimeout seconds action = do
chan <- newChan
_ <- forkIO $ do
-- worker thread
x <- action
send chan $ Right x
_ <- forkIO $ do
-- timeout thread
threadDelay (seconds * 1000000)
send chan $ Left Timeout
receive chan
You will note that this is not a server in the Genserver sense, as it does
not loop: it is simply a utility function that launches two threads. Note also
that threadDelay accepts an argument in microseconds, so wehave to multiply
the provided timeout by one million.
One downside of this function is that the worker thread (the one that
runs action, and might take too long) is not terminated after the
timeout. This is a problem if action is, for example, stuck in an infinite
loop that consumes ever more memory. To fix this, we can have the
timeout thread explicitly kill the worker thread:
actionWithTimeoutKill :: Int -> IO a -> IO (Either Timeout a)
actionWithTimeoutKill seconds action = do
chan <- newChan
worker_tid <- forkIO $ do
-- worker thread
x <- action
send chan $ Right x
_ <- forkIO $ do
-- timeout thread
threadDelay (seconds * 1000000)
killThread worker_tid
send chan $ Left Timeout
receive chan
Note that killing a thread is a dangerous operation in general. It may be the case that the worker thread is stuck in some loop or waiting for a network request, in which case it is harmless, but killing it may also leave some shared state in an unspecified state. We will (hopefully) not encounter such cases in AP, but it is something to be aware of in the future.
A Larger Example: A Module for Asynchronous Computation
In this section we will look at the design of a GenServer-based module for executing pure Haskell functions in an asynchronous manner. It demonstrates several important programming techniques, including the use of sub-threads to ensure reponsivity and robustness. We are concerned here only with pure functions. The API of the system we will implement is as follows:
data Async a
type Seconds = Int
async :: Seconds -> (a -> b) -> a -> IO (Async b)
data Result a
= Timeout
| Exception String
| Value a
deriving (Eq, Ord, Show)
poll :: Async a -> IO (Maybe (Result a))
wait :: Async a -> IO (Result a)
A value of type Async a represents an asynchronous computation that
produce a value of type a. They are created using the function
async, which takes as argument a maximum allowed runtime, a function
a -> b, and an argument value a, returning an Async b. The
async function itself must return immediately.
The status of an Async a value can be inspected using the functions
poll and wait. The poll function immediately returns the state
of the asynchronous computation, returning Nothing if the
computation is still ongoing, and otherwise a result of type Result a:
-
Timeoutis returned if the execution of the function exceeded the runtime specified by the originalasyncinvocation. -
Exception, along with the exception error message, is returned if the computation resulted in an exception being thrown. -
Valueis returned if the computation finished without exceptions and within the allotted runtime.
The wait function is similar to poll, except that it blocks
until the computation finishes.
We will use the following definition of fib in our examples:
fib :: Int -> Int
fib 0 = 1
fib 1 = 1
fib n =
if n < 0
then error "negative n"
else fib (n - 1) + fib (n - 2)
Because it returns Int, it is easy to use the evaluate function
from Control.Exception to ensure that the result is fully evaluated.
simpleDemo :: IO ()
simpleDemo = do
putStrLn "a"
a <- async 1 fib 10
print =<< poll a
print =<< wait a
Initial Design
Our server thread can be seen as a state machine with two main states:
-
Before we know the result of the computation. At this point we must also maintain a list of those clients that have called
waitand must be informed when the computation finishes. -
After the result of the computation is known, which requires storing the result.
Further, when we transition from stage 1 to 2, we must inform all of the waiting clients of the result.
For simplicity, we will initially not worry about timeouts and exceptions. It will turn out to be quite simple to add support for these features.
Our design will be to launch a separate worker thread that computes
the value. This allows the main server thread to immediately answer
poll requests even through the worker thread is engaged in a
long-running computation. Once the worker thread has computed the
desired value, it will be sent to the server thread in a message.
Further, we need messages for the poll and wait functions. Our
resulting message type is the following:
data Msg a
= MsgPutVal a
| MsgPoll (ReplyChan (Maybe (Result a)))
| MsgWait (ReplyChan (Result a))
And the poll and wait functions are merely wrappers around sending
the corresponding messages:
poll :: Async a -> IO (Maybe (Result a))
poll (Async s) =
requestReply s MsgPoll
wait :: Async a -> IO (Result a)
wait (Async s) =
requestReply s MsgWait
To represent the two main states of the server, we use two recursive functions:
noValueLoop :: Chan (Msg a) -> [ReplyChan (Result a)] -> IO ()
noValueLoop c waiters = do
msg <- receive c
case msg of
MsgPutVal v' -> do
forM_ waiters $ \from ->
reply from $ Value v'
valueLoop c (Value v')
MsgPoll from -> do
reply from Nothing
noValueLoop c waiters
MsgWait from ->
noValueLoop c (from : waiters)
valueLoop :: Chan (Msg a) -> Result a -> IO ()
valueLoop c v = do
msg <- receive c
case msg of
MsgPutVal _ ->
valueLoop c v
MsgPoll from -> do
reply from $ Just v
valueLoop c v
MsgWait from -> do
reply from v
valueLoop c v
Note how the MsgWait case in noValueLoop simply adds the
ReplyChan to a list. Then, once we receive a MsgPutVal, we reply
to all of these pending calls. In contrast, when we receive a
MsgWait in valueLoop, we immediately respond with the result. If
we are in valueLoop and receive another MsgPutVal message, we
simply ignore it. In practice this will never occur (at least not
until we add timeouts and exceptions).
Instead of using two function to represent two states, we could also have used a single function and stored the server state as a sum type with two constructors. I prefer using mutually recursive functions to represent the high level states of a server (if such a distinction makes sense), but this is ultimately a matter of personal taste.
An Async a is now just a type that wraps a Server (Msg a):
data Async a = Async (Server (Msg a))
The async function uses spawn to create a server. Before entering
the server loop, we use forkIO to create the worker thread, which
has a reference to a channel (c) from which the server reads
messages:
async :: Seconds -> (a -> b) -> a -> IO (Async b)
async timeout f x = do
s <- spawn $ \c -> do
void $ forkIO $ do
x' <- evaluate $ f x
send c $ MsgPutVal x'
noValueLoop c []
pure $ Async s
Initially the noValueLoop has no waiters.
This completes the basic functionality of the Async server.
Handling Timeouts
Timeouts are (almost) always handled by creating a thread that waits for some period of time, then sends a message or takes some other action. Here, we will add a new message that indicates that the timeout has passed:
data Msg a
= ...
| MsgTimeout
We modify async such that after creating the worker thread, we also
create a thread that sends this message after the timeout has passed.
Remember that threadDelay expects its argument in microseconds, therefore we
multiply the provided timeout by one million.
async :: Seconds -> (a -> b) -> a -> IO (Async b)
async timeout f x = do
s <- spawn $ \c -> do
void $ forkIO $ do
x' <- evaluate $ f x
send c $ MsgPutVal x'
void $ forkIO $ do
threadDelay $ timeout * 1000000
send c MsgTimeout
noValueLoop c []
pure $ Async s
Finally, we modify noValueLoop and valueLoop to handle the new
MsgTimeout. In the former, reception of such a message denotes a
timeout, and so we switch to the valueLoop state, with Timeout as
our value:
noValueLoop :: Chan (Msg a) -> [ReplyChan (Result a)] -> IO ()
noValueLoop c waiters = do
msg <- receive c
case msg of
...
MsgTimeout -> do
forM_ waiters $ \from ->
reply from Timeout
valueLoop c Timeout
In valueLoop, MsgTimeout is simply ignored, as all it indicates is
that the original timeout has expired - which is unimportant once the
value has been received.
valueLoop :: Chan (Msg a) -> Result a -> IO ()
valueLoop c v = do
msg <- receive c
case msg of
...
MsgTimeout ->
valueLoop c v
timeoutDemo :: IO ()
timeoutDemo = do
a <- async 1 fib 100
print =<< poll a
print =<< wait a
> timeoutDemo
Nothing
Timeout
Arguably, if the timeout is reached, we should use killThread to
liquidate the worker thread, in case it is stuck in an infinite loop.
This would require us to augment the state with a reference to the
ThreadId of the worker thread.
Handling Exceptions
At the protocol level, the handling of exceptions is very similar to the handling of values. We add a new message type:
data Msg a
= ...
| MsgPutException String
The handling of MsgPutException is then essentially identical to the
handling of MsgPutVal:
noValueLoop :: Chan (Msg a) -> [ReplyChan (Result a)] -> IO ()
noValueLoop c waiters = do
msg <- receive c
case msg of
...
MsgPutException err -> do
forM_ waiters $ \from ->
reply from $ Exception err
valueLoop c (Exception err)
valueLoop :: Chan (Msg a) -> Result a -> IO ()
valueLoop c v = do
msg <- receive c
case msg of
...
MsgPutException _ ->
valueLoop c v
Exceptions are caught in the worker thread, using the technique discussed in Chapter 4 of these notes:
async :: Seconds -> (a -> b) -> a -> IO (Async b)
async timeout f x = do
s <- spawn $ \c -> do
void $ forkIO $ do
let computeValue = do
x' <- evaluate $ f x
send c $ MsgPutVal x'
onException :: SomeException -> IO ()
onException e = do
send c $ MsgPutException $ show e
catch computeValue onException
void $ forkIO $ do
threadDelay $ timeout * 1000000
send c MsgTimeout
noValueLoop c []
pure $ Async s
exceptionDemo :: IO ()
exceptionDemo = do
a <- async 1 fib (-1)
print =<< poll a
print =<< wait a
> exceptionDemo
Nothing
Exception "negative n"
Structured Concurrent Programming
Concurrency with Free Monads
In Chapter 4 we saw an example of Asynchronous Programming with Free Monads. The principles underlying asynchronous programming are quite similar to those of concurrent programming. We can actually express a concurrent system using a free monad, and then interpret the system using either true IO-based concurrency, or simulation. This raises the potential of using the simulation to systematically (or probabilistically) explore the potential execution paths possible in the system, in order to discover race conditions.
In the following we will design a concurrency abstraction that is
rather similar to the one described in Chapter 5, based on threads,
channels, and messages. One concession we will make for simplicity is
that our channels will be monomorphic, and capable of sending only a
single type of messages, for which we pick String:
type Msg = String
This restriction can be lifted, but requires a significant amount of Haskell type-level trickery, which is not the point of this chapter.
An Initial Attempt
Let us now define a data type CCOp for representing concurrency
effects. We allow four effects: forking a thread, creating a channel,
sending a message on a channel, and receiving a message from a
channel. We also instantiate the Free monad with the CCOp effect
to produce CC, a monadic representation of concurrency:
data CCOp a
= CCFork (CC ()) a
| CCNewChan (Chan Msg -> a)
| CCSend (Chan Msg) Msg a
| CCReceive (Chan Msg) (Msg -> a)
type CC a = Free CCOp a
Note that we are using the Control.Concurrent.Chan type as our
channel representation - we will change that later. We must of course
also define the usual Functor instance for CCOp:
instance Functor CCOp where
fmap f (CCFork m c) = CCFork m (f c)
fmap f (CCNewChan c) = CCNewChan $ f . c
fmap f (CCSend chan msg c) = CCSend chan msg $ f c
fmap f (CCReceive chan c) = CCReceive chan $ f . c
And finally we define accessor functions for constructing monadic operations with these effects:
ccNewChan :: CC (Chan Msg)
ccNewChan = Free $ CCNewChan pure
ccFork :: CC () -> CC ()
ccFork m = Free $ CCFork m $ pure ()
ccSend :: Chan Msg -> Msg -> CC ()
ccSend chan msg = Free $ CCSend chan msg $ pure ()
ccReceive :: Chan Msg -> CC Msg
ccReceive chan = Free $ CCReceive chan pure
Interpreting CC computations in IO is quite straightforward, due
to how closely our effects match the interface provided by
Control.Concurrency:
interpCCIO :: CC a -> IO a
interpCCIO (Pure x) =
pure x
interpCCIO (Free (CCFork m c)) = do
_ <- forkIO $ interpCCIO m
interpCCIO c
interpCCIO (Free (CCNewChan c)) = do
chan <- newChan
interpCCIO $ c chan
interpCCIO (Free (CCSend chan msg c)) = do
writeChan chan msg
interpCCIO c
interpCCIO (Free (CCReceive chan c)) = do
msg <- readChan chan
interpCCIO $ c msg
And now we can write a contrived little program that passes a message through a chain of threads, each adding a token to the message and passing it to the next thread:
pipeline :: CC String
pipeline = do
chan_0 <- ccNewChan
chan_1 <- ccNewChan
chan_2 <- ccNewChan
chan_3 <- ccNewChan
chan_4 <- ccNewChan
let passOn tok from to = do
x <- ccReceive from
ccSend to $ x ++ tok
ccFork $ passOn "a" chan_0 chan_1
ccFork $ passOn "b" chan_1 chan_2
ccFork $ passOn "c" chan_2 chan_3
ccFork $ passOn "d" chan_3 chan_4
ccSend chan_0 ""
ccReceive chan_4
Running it yields the expected results:
> interpCCIO pipeline
"abcd"
Abstract Channels
Unfortunately, the definition of concurrent effects given above is not
suitable for simulation. The reason is that the we specified that a
channel is always of type Chan Msg, meaning it is intrinsically tied
to the interface provided by Control.Concurrent. In order to allow
multiple interpretations of concurrency, we need to make CCOp
polymorphic in its representation of channel. To this end, we add a
type parameter chan, which we use instead of Chan Msg:
data CCOp chan a
= CCFork (CC chan ()) a
| CCNewChan (chan -> a)
| CCSend chan Msg a
| CCReceive chan (Msg -> a)
instance Functor (CCOp chan) where
fmap f (CCFork m c) = CCFork m (f c)
fmap f (CCNewChan c) = CCNewChan $ f . c
fmap f (CCSend chan msg c) = CCSend chan msg $ f c
fmap f (CCReceive chan c) = CCReceive chan $ f . c
In our definition of the CC type alias, we also add chan as a type
parameter:
type CC chan a = Free (CCOp chan) a
Now a value of type CC chan a represents a concurrent execution that
produces a value of type a, and uses a channel representation
chan. When we actually write computations in CC, we will leave
chan polymorphic - only the interpretation functions will impose
constraints on it. This sounds a bit abstract (because it is), but
will become clear later. First, however, we have to redefine the
accessor functions, which will also have to use a chan type
parameter:
ccNewChan :: CC chan chan
ccNewChan = Free $ CCNewChan pure
ccFork :: CC chan () -> CC chan ()
ccFork m = Free $ CCFork m $ pure ()
ccSend :: chan -> Msg -> CC chan ()
ccSend chan msg = Free $ CCSend chan msg $ pure ()
ccReceive :: chan -> CC chan Msg
ccReceive chan = Free $ CCReceive chan pure
Now we can make the pipeline example work with our new definition.
This is quite straightforward - in fact, we only have to change the
type, and the definition can be unchanged:
pipeline :: CC chan String
pipeline = ...
A similar situation arises for the interpretation function
interpCCIO. Here we simply require that the channel representation
is Chan Msg, but otherwise the implementation is the same:
interpCCIO :: CC (Chan Msg) a -> IO a
interpCCIO = ...
Now consider what happens when we run the example:
> interpCCIO pipeline
"abcd"
This type checks because pipeline has the polymorphic type CC chan String where chan can be instantiated with any type, and in
particular it can be instantiate with Chan Msg - which is what
interpCCIO requires. In this way we can write generic code that
delays the concrete choice of channel representation. Let us now
exploit this to actually write a pure interpreter for CC.
A Pure Interpreter
The pure interpreter will more complicated than interpCCIO, because
we cannot piggyback on the existing Haskell runtime system for
concurrency. Our approach will essentially be that of a state monad,
where we maintain the following main bits of state:
-
A collection of all channels and the messages they currently contain.
-
A collection of all threads that can be executed further.
Since channels have a notion of identity, we need a way to uniquely
identify them, which we will do with the ChanId type:
type ChanId = Int
Each channel will be associated with a unique integer. This means we also need to have a source of fresh integers, which we will accomplish by maintaining a counter in our state.
Now we are ready to define a Haskell type encapsulating our concurrency simulator state:
data CCState = CCState
{ ccCounter :: ChanId,
ccChans :: [(ChanId, [Msg])],
ccThreads :: [CC ChanId ()]
}
The ccChans field stores all existing channels, keyed by a ChanId,
with each channel storing a list of messages with the oldest first.
The ccThreads stores suspended threads, which are represented as
monadic computations of type CC ChanId ().
The actual monad we will use is the State monad from Chapter
2 with CCState as the state. When programming with
state monads it is usually a good idea to define higher-level utility
functions rather than using get/put directly. First we define a
function getChan that retrieves the messages associated with a
specific channel:
getChan :: ChanId -> State CCState [Msg]
getChan chan_id = do
state <- get
pure $
fromMaybe (error "unknown channel") $
lookup chan_id $
ccChans state
And its counterpart, setChan, that sets the messages associated with
a channel.
setChan :: ChanId -> [Msg] -> State CCState ()
setChan chan_id msgs = do
state <- get
put $
state
{ ccChans =
(chan_id, msgs)
: filter ((/= chan_id) . fst) (ccChans state)
}
It is not difficult to imagine how we will implement reading from a
channel: use getChan to fetch the inbox, remove the first message,
and use setChan to put back the remainder. The tricky part is how to
handle the situation when no messages are available, but we will come
back to that.
We also need to be able to add threads to the state, which is done by
addThread.
addThread :: CC ChanId () -> State CCState ()
addThread m = do
state <- get
put $ state {ccThreads = m : ccThreads state}
And finally, incCounter increments the counter in the state and
returns the old value. It serves as our mechanism for obtaining fresh
ChanIds.
incCounter :: State CCState ChanId
incCounter = do
state <- get
put $ state {ccCounter = ccCounter state + 1}
pure $ ccCounter state
We can now define a function step that evaluates a CC Int ()
computation as far as possible, meaning until it blocks or
terminates. Remember that the only way a thread can block in our
system is by trying to read from an empty channel. The step function
is not a full interpretation function, but we will use it to build
one.
The step function has the following type:
step :: CC Int a -> State CCState (CC ChanId a)
Note that it returns a CC ChanId a because there is no guarantee that
it is able to run the computation to completion (which would produce
an a). The simplest case is the one for Pure, which represents a
finished computation for which there is nothing further to do:
step (Pure x) = pure $ Pure x
Now we need to handle the various effects. Creating a channel is done
by retrieving an unused ChanId, then adding a channel with an
initially empty message queue:
step (Free (CCNewChan c)) = do
chan_id <- incCounter
setChan chan_id []
step $ c chan_id
Forking a thread simply adds the computation to the state with
addThread:
step (Free (CCFork m c)) = do
addThread m
step c
The CCSend effect is executed by appending the given message to the
specified channel, then executing the continuation:
step (Free (CCSend chan_id msg c)) = do
msgs <- getChan chan_id
setChan chan_id $ msgs ++ [msg]
step c
Finally, the most interesting effect is CCReceive, because it can
block when the channel is empty. This is represented by simply
returning the monadic computation unchanged:
step (Free (CCReceive chan_id c)) = do
msgs <- getChan chan_id
case msgs of
[] -> pure $ Free $ CCReceive chan_id c
msg : msgs' -> do
setChan chan_id msgs'
step $ c msg
We now have a step function for running as much of a single
computation (i.e., thread!) as possible. But if step is stuck on a
CCReceive, then no amount of re-running step is going to make
progress - rather, some other thread must be given a chance to run,
which may end up putting a message in the queue of some channel that
the original thread was stuck on. To accomplish this, the function
stepThreads invokes step on every thread in the system. First we
write an incorrect implementation:
-- BEWARE: WRONG!
stepThreads :: State CCState ()
stepThreads = do
state <- get
threads <- mapM step $ ccThreads state
put $ state {ccThreads = threads}
At first glance, this may look right: fetch all the threads, advance
them a step, then put them back in the state. But that final put is
a problem, because it effectively reverts any state modifications done
inside step. We can attempt a fix:
-- BEWARE: STILL WRONG!
stepThreads :: State CCState ()
stepThreads = do
state <- get
threads <- mapM step $ ccThreads state
new_state <- get
put $ new_state {ccThreads = threads}
This is still wrong. While we now maintain some state modifications
done in step, we completely overwrite the list of threads. This
means that if step creates any new threads, they are thrown away.
Let us try again:
-- BEWARE: STILL WRONG!
stepThreads :: State CCState ()
stepThreads = do
state <- get
threads <- mapM step $ ccThreads state
new_state <- get
put $ new_state {ccThreads = threads ++ ccThreads new_state}
Instead of overwriting the list of threads, we not simply prepend to
it. But now we end up duplicating the threads, since the original
threads from state (the ones we pass to step) are still present in
new_state. A correct solution requires is to remove the threads
from the state before we step them:
stepThreads :: State CCState ()
stepThreads = do
state <- get
put $ state {ccThreads = []}
threads <- mapM step $ ccThreads state
new_state <- get
put $ new_state {ccThreads = threads ++ ccThreads new_state}
The point of this progression through incorrect implementations of
stepThreads was not to demonstrate how to write incorrect code, but
as an illustration of the subtleties of working with mutable state.
Now we can write a function that evaluates a "main thread" (the one
producing the ultimate execution result), but first uses stepThreads
to advance all "background threads".
interp :: CC ChanId a -> State CCState a
interp (Pure x) = pure x
interp (Free op) = do
stepThreads
op' <- step $ Free op
interp op'
As soon as the "main thread" reaches the Pure constructor, the
system is considered terminated. This is different from
Control.Concurrency, which has no notion of a "main thread", and
where forked threads can continue to do arbitrary side effects
forever.
The final bit of machinery we need is is a bit of boilerplate for running our state monad with an initial state, and projecting out the result we care about:
interpCCPure :: CC ChanId a -> a
interpCCPure orig =
fst $ runState initial_state $ interp orig
where
initial_state =
CCState
{ ccCounter = 0,
ccChans = [],
ccThreads = []
}
And we can see that things work:
> interpCCPure pipeline
"abcd"
One limitation of this approach, which is not present in interpCCIO,
is that we cannot handle infinite loops in pure code. We are only
able to switch between threads when step encounters an effect.
Remaining Issues
Although the interpreter developed above works in some cases, it has undesirable behaviour for others. Consider a program that creates a channel and thread that runs an infinite loop that continuously writes to the channel. The main thread reads twice from the channel, concatenates the messages, and returns:
infiniteWrite :: CC chan String
infiniteWrite = do
chan <- ccNewChan
ccFork $ forever $ ccSend chan "x"
a <- ccReceive chan
b <- ccReceive chan
pure $ a ++ b
Using the IO-based interpreter, we observe the following result, as expected:
> interpCCIO infiniteWrite
"xx"
Since the main thread terminates in finite time, it doesn't matter
that some secondary thread is still running (although it's not great
that it continues to run and causes the channel to grow infinitely -
it would be better if interpCCIO kept track of launched threads and
killed them at the end).
Now let us try running the program using the pure interpreter:
> interpCCPure infiniteWrite
You will find that this goes into an infinite loop. This occurs due to
stepThreads, which will evaluate every thread with step until the
next time it blocks on a channel. But since the thread we have forked
will never read from a channel, step will continue recursively
evaluating it forever - preventing any other thread from being
executed. To fix this, we modify the CCSend case in step such that
we do not evaluate the continuation, but merely return it:
step (Free (CCSend chan_id msg c)) = do
msgs <- getChan chan_id
setChan chan_id $ msgs ++ [msg]
pure c -- This line was prevously 'step c'.
This does not prevent the computation from progressing, since we still
do some work whenever step is invoked, and step is anyway
invoked repeatedly in a loop.
Now computation terminates as expected:
> interpCCPure infiniteWrite
"xx"
But consider now this program:
infiniteLoop :: CC chan String
infiniteLoop = do
chan <- ccNewChan
ccFork $ forever $ pure ()
ccFork $ ccSend chan "x"
ccReceive chan
Here we fork two threads: one goes into an infinite loop that does
nothing, while the other thread sends a message on a channel. The main
thread receives a message from a channel, which is returned. Execution
with interpCCIO works fine, but interpCCPure goes into an infinite
loop. In this case, however, the loop is in pure code, rather than
being an infinite list of effects. This means that we have no way of
interrupting it. Operationally, step is stuck on evaluating the
(never terminating) thread to figure out which kind of effect it
evaluates to.
There is a deep lesson here: when interpreting a free monad, the only
time we can "interrupt" computation and get back control is when an
effect occurs, so there is no way we can avoid this problem in
interpCCPure. The IO-based concurrency from Control.Concurrency
uses machine-level interrupts to suspend even pure computation, and
therefore does not have this problem. If we could somehow force
computations to issue an effect from time to time, this would not be a
problem. In fact, one could easily imagine that Haskell itself could
have implemented concurrency by injecting "suspension effects" into
the generated code. However, Haskell does not allow us to inject
effects into otherwise pure code. If we have control over how the
computations using the free monad are constructed, we can of course
ensure that effects occur regularly - we could even imagine a "step"
effect that serves no purpose except to interrupt computation.