If I was going to build a game, I knew I wanted it to be webbased – there was no doubt in mind about this:
There are of course some downsides to webbased games as well. For me, the main disavantage is that the dominant language is still JavaScript (which I am not a big fan of, to put it mildly).
Fortunately there are a good number of languages that compile down to JavaScript these days. The two big contendors were Haskell (through GHCJS) and PureScript (I would go as far as calling PureScript a Haskell dialect, since they are so similar).
The big advantage of using GHCJS is that you’re able to run Haskell on the backend and on the frontend, so you can share common code.
However, I wanted to write a simple game without any sort of backend (which, of course, makes it significantly easier to host as well). PureScript produces vastly smaller JavaScript files, and I wanted to learn the language a bit to see how it compares with Haskell, so I decided to give that a try.
I did not consider Elm because it’s a bit further removed from Haskell, and my main focus was still building a game; not learning a new language. I have heard a lot of good things about it though, so maybe that’s what I should try next.
One of the last games I played was the remake of the masterpiece Katamari Damacy on the Nintendo Switch.
Inspired by Katamari Damacy, I wanted to make a 2D version that had a similar feeling to it. I decided relatively quickly that the core mechanic of the game would be to put different kinds of objects together in bizarre ways, hopefully amusing people along the way.
With that in mind, I immediately focused on this core mechanic since I wanted to know whether it could actually be fun or not.
I started by doing a simple exhaustive search over all the ways you can overlay two sprites, minimizing the average colour distance. This worked remarkably well, and I didn’t end up finetuning the results much more after that.
It did lead to some performance issues for larger sprites, so I fixed that by mipmapping: for larger sprites, I first do an exhaustive search at a much lower resolution, then I use these results to do a local search in that neighbourhood at higher resolutions. This is not guaranteed to give the best results; but that doesn’t matter too much for this game: we just want a good enough result.
I wanted to also try an approach based on simulated annealing but didn’t get around to it. If someone wants to try this, you’re more than welcome to make a contribution!
At this point, I was getting amusing results, but I wasn’t sure how to make this into a game yet. I didn’t want to make it into action game, and felt like a puzzle game would fit better. Then, I realized the comedic effect would be even better if I combined the names of the different sprites as well.
This automatically adds a sort of puzzle mechanic to the game as well, since you can now only merge certain objects.
This brought me to the next obstacle – I knew I would need a large number of consistent sprites to use as art in the game. I browsed around opengameart.org for a bit, but did not really find anything promising. I also did not want to pay an artist, because I wanted to keep this a free game, without advertisements and the like.
Then it dawned to me that there already is a great collection of consistent sprites that even come with the names attached to them – emoji! I found the free EmojiOne set and started with that. But when I looked into it a bit, I found this weird snippet in their free licensing info:
3.4 What can’t you do with the JoyPixels/EmojiOne Properties under this agreement?
…
(I) Include properties in open source projects.
…
What nonsense is this? I am allowed to use it in my noncommercial project if I give attribution, but not if I want to have the option to open source my game?
This pissed me off and I started looking for alternatives. At that point, however, I already knew emoji were a good direction so it was easier. I ended up switching to Google’s Noto font. I liked the sprites a little bit less but at least the license made sense.
At this point I built a demo that simply allowed you to drag around a bunch of different objects and merge them. It was certainly amusing, but it did not really feel like a “game” to me yet. However, I shared this demo with a couple of people and they all really liked it. This was very encouraging.
The next weekend, I tried to turn this into a Tetris or 2048like puzzle game, but this ended up being very confusing and not that much fun. Ironically, the nongame was more fun!
So, I decided to go back to that and just add a very simple economy on top of it (buying and selling things) to make it a bit more interesting. After I added that, I was quite happy with the flow of the game.
The rules were still a bit unclear to people I showed it to (what things can you merge together?), so I added the hints at the top of the cards and an interactive tutorial.
In retrospect, I am happy with PureScript as a language and would recommend it if you’re looking into putting a simple nobackend webbased game together, and you already know Haskell.
There were a few issues I ran into with the language:
I still prefer lazy languages, and this bit me a few times. In particular, I wrote a few monadic recursive functions without being aware of the tailrec package. This caused stack overflows in my code, but I only saw these on my phone, which made it extremely hard to debug.
The error messages that the compiler emits are horrible at times. I feel like this is an area where I could contribute a bunch of code myself, but I’m not sure if I’ll ever have time for that.
There are also a lot of things I like:
Working with the FFI to call JavaScript is seamless and easy.
Halogen is an amazing framework that made building the UI trivial.
Once you figure out how to, the resulting JavaScript is actually very easy to debug using Firefox’s or Chromium’s developer tools.
The story of this library began with last year’s ICFP contest. For this contest, the goal was to build a program that orchestrates a number of nanobots to build a specific minecraftlike structure, as efficiently as possible. I was in Japan at the time, working remotely from the Tsuru Capital office, and a group of them decided to take part in this contest.
I had taken part in the 2017 ICFP contest with them, but this year I was not able to work on this at all since the ICFP contest took place in the same weekend as my girlfriends’ birthday. We went to Fujikawaguchiko instead – which I would recommend to anyone interested in visiting the Fuji region. I ended up liking it more than Hakone, where I was a year or two ago.
Anyway, after the contest we were discussing how it went and Alex thought a key missing piece for them was a specific algorithm called dynamic connectivity. Because this is not a trivial algorithm to put together, we ended up using a less optimal version which still contained some bugs. In the weeks after the contest ended Alex decided to continue looking into this problem and we ended up putting this library together.
The dynamic connectivity problem is very simply explained to anyone who is at least a little familiar with graphs. It comes down to building a datastructure that allows adding and removing edges to a graph, and being able to answer the question “are these two vertices (transitively) connected” at any point in time.
This might remind you of the unionfind problem. Unionfind, after all, is a good solution to incremental dynamic connectivity. In this context, incremental means that edges may only be added, not removed. A situation where edges may be added and removed is sometimes referred to as fully dynamic connectivity.
Like unionfind, there is unfortunately no known persistent version of this algorithm without sacrificing some performance. An attempt was made [to create a fast, persistent union find] but I don’t think we can consider this successful in the Haskell sense of purity since the structure proposed in that paper is inherently not threadsafe; which is one of the reasons to pursue persistence in the first place.
Anyway, this is why the library currently only provides a mutable interface. The library uses the PrimMonad
from the primitive library to ensure you can use our code both in IO
and ST
, where the latter lets us reclaim purity.
Let’s walk through a simple example of using the library in plain IO
.
import qualified Data.Graph.Dynamic.Levels as GD
import qualified Data.Tree as T
main :: IO ()
main = do
graph < GD.empty'
Let’s consider a fictional map of Hawaiian islands.
mapM_ (GD.insert_ graph)
["Akanu", "Kanoa", "Kekoa", "Kaiwi", "Onakea"]
GD.link_ graph "Akanu" "Kanoa"
GD.link_ graph "Akanu" "Kaiwi"
GD.link_ graph "Akanu" "Onakea"
GD.link_ graph "Kaiwi" "Onakea"
GD.link_ graph "Onakea" "Kanoa"
GD.link_ graph "Kanoa" "Kekoa"
The way the algorithm works is by keeping a spanning forest at all times. That way we can quickly answer connectivity questions: if two vertices belong to the same tree (i.e., they share the same root), they are connected.
For example, can we take ferries from Kaiwi to Kekoa? The following statement prints True
.
Such a question, however, could have been answered by a simpler algorithm such as union find which we mentioned before. Union find is more than appropriate if edges can only be added to a graph, but it cannot handle cases where we want to delete edges. Let’s do just so:
In a case such as the one above, where the deleted edge is not part of the spanning forest, not much interesting happens, and the overall connectivity is not affected in any way.
However, it gets interesting when we delete an edge that is part of the spanning tree. When that happens, we kick off a search to find a “replacement edge” in the graph that can restore the spanning tree.
In our example, we can replace the deleted Akanu  Onakea edge with the Kanoa  Onakea edge. Finding a replacement edge is unsurprisingly the hardest part of the problem, and a sufficiently effecient algorithm was only described in 1998 by Holm, de Lichtenberg and Thorup in this paper.
The algorithm is a little complex, but the paper is wellwritten, so I’ll just stick with a very informal and handwavey explanation here:
If an edge is cut from the spanning forest, then this turns one spanning tree in the forest into two components.
The algorithm must consider all edges in between these two components to find a replacement edge. This can be done be looking at the all the edges adjacent to the smaller of the two components.
Reasonable amortized complexity, O(log² n), is achieved by “punishing” edges that are considered but not taken, so we will consider them less frequently in subsequent calls.
Back to our example. When we go on to delete the Onakea  Kanoa edge, we cannot find a replacement edge, and we are left with a spanning forest with two components.
We can confirm this by asking the library for the spanningforest and then using the very handy drawForest
from Data.Tree
to visualize it:
This prints:
Kanoa

+ Akanu

` Kekoa
Onakea

` Kaiwi
Let’s restore connectivity to leave things in proper working order for the residents of our fictional island group, before closing the blogpost.
For finishing words, what are some future directions for this library? One of the authors of the original paper, M. Thorup, wrote a followup that improves the theoretical space and time complexity a little. This seems to punish us with bad constant factors in terms of time performance – but it is probably still worth finishing because it uses significantly less memory. Contributions, as always, are welcome. :)
]]>Update: I gave a talk about this blogpost at the Haskell eXchange 2018 on the 11th of October 2018. You can watch the video here. Note that you will need to create an account in on the skillsmatter website in order to watch the recording.
This post makes a bit of a departure from the “practical Haskell” I usually try to write about, although – believe it or not – this blogpost actually originated from a very practical origin ^{1}.
This blogpost is a literate Haskell file, which means you can just download it here and load it into GHCi to play around with it. In this case, you can also verify the properties we will be talking about (yes, GHC as a proof checker). Since we are dipping our toes into dependent types territory here, we will need to enable some extensions that are definitely a bit more on the advanced side.
{# LANGUAGE DataKinds #}
{# LANGUAGE GADTs #}
{# LANGUAGE KindSignatures #}
{# LANGUAGE PolyKinds #}
{# LANGUAGE ScopedTypeVariables #}
{# LANGUAGE TypeFamilies #}
{# LANGUAGE TypeOperators #}
{# LANGUAGE UndecidableInstances #}
Since the goal of this blogpost is mainly educational, we will only use a few standard modules and generally define things ourselves. This also helps us to show that there is no magic going on behind the scenes: all termlevel functions in this file are total and compile fine with Wall
.
import Data.List (intercalate, minimumBy)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import Data.Ord (comparing)
I assume most readers will be at least somewhat familiar with the standard lengthindexed list:
data Nat = Zero  Succ Nat deriving (Show)
data Vec (n :: Nat) a where
VNull :: Vec 'Zero a
VCons :: a > Vec n a > Vec ('Succ n) a
These vectors carry their length in their types. In GHCi:
*Main> :t VCons "Hello" (VCons "World" VNull)
Vec ('Succ ('Succ 'Zero)) [Char]
This blogpost defines a similar way to deal with binomial heaps. Binomial heaps are one of my favorite data structures because of their simple elegance and the fascinating way their structure corresponds to binary numbers.
We will combine the idea of Peano numberindexed lists with the idea that binomial heaps correspond to binary numbers to lift binary numbers to the type level. This is great because we get O(log(n)) size and time in places where we would see O(n) for the Peano numbers defined above (in addition to being insanely cool). In GHCi:
*Main> :t pushHeap 'a' $ pushHeap 'b' $ pushHeap 'c' $
pushHeap 'd' $ pushHeap 'e' emptyHeap
Heap ('B1 ('B0 ('B1 'BEnd))) Char
Where 101 ^{2} is, of course, the binary representation of the number 5.
Conveniently, 101 also represents the basics of a subject. So the title of this blogpost works on two levels, and we present an introductorylevel explanation of a nontrivial (and again, insanely cool) example of dependent Haskell programming.
If I perform an appropriate amount of handwaving and squinting, I feel like there are two ways to work with these strongerthanusual types in Haskell. We can either make sure things are correct by construction, or we can come up with a proof that they are in fact correct.
The former is the simpler approach we saw in the Vec
snippet: by using the constructors provided by the GADT, our constraints are always satisfied. The latter builds on the singletons approach introduced by Richard Eisenberg and Stephanie Weirich.
We need both approaches for this blogpost. We assume that the reader is somewhat familiar with the first one and in this section we will give a brief introduction to the second one. It is in no way intended to be a full tutorial, we just want to give enough context to understand the code in the blogpost.
If we consider a closed type family for addition of natural numbers (we are using an N
prefix since we will later use B
for addition of binary numbers):
type family NAdd (x :: Nat) (y :: Nat) :: Nat where
NAdd ('Succ x) y = 'Succ (NAdd x y)
NAdd 'Zero y = y
We can trivially define the following function:
NAdd 'Zero x
is easily reduced to x
by GHC since it is simply a clause of the type family, so it accepts the definition id
. However, if we try to write
We run into trouble, and GHC will tell us:
Couldn't match type ‘x’ with ‘NAdd x 'Zero’
We will need to prove to GHC that these two types are equal – commutativity doesn’t come for free! This can be done by providing evidence for the equality by way of a GADT constructor ^{3}.
data EqualityProof (a :: k) (b :: k) where
QED :: EqualityProof a a
type a :~: b = EqualityProof a b
Take a minute to think about the implications this GADT has – if we can construct a QED
value, we are actually providing evidence that the two types are equal. We assume that the two types (a
and b
) have the same kind k
^{4}.
The QED
constructor lives on the termlevel though, not on the typelevel. We must synthesize this constructor using a termlevel computation. This means we need a termlevel representation of our natural numbers as well. This is the idea behind singletons and again, a much better explanation is available in said paper and some talks, but I wanted to at least provide some intuition here.
The singleton for Nat
is called SNat
and it’s easy to see that each Nat
has a unique SNat
and the other way around:
We can use such a SNat
to define a proof for what we are trying to accomplish. Since this proof can be passed any n
in the form of an SNat
, it must be correct for all n
.
GHC can figure out the base case on its own by reducing NAdd 'Zero 'Zero
to 'Zero
:
And we can use induction to complete the proof. The important trick here is that in the body of the pattern match on EqualityProof a b
, GHC knows that a
is equal to b
.
This can be used to write cast02
:
cast02
takes an extra parameter and there are several ways to synthesize this value. The common one is a typeclass that can give us an SNat x
from a Proxy x
. In this blogpost however, we keep things simple and make sure we always have the right singletons on hand by passing them around in a few places. In other words: don’t worry about this for now.
A binomial heap consists of zero or more binomial trees. I will quote the text from the Wikipedia article here since I think it is quite striking how straightforward the definition translates to GADTs that enforce the structure:
data Children (k :: Nat) a where
CZero :: Children 'Zero a
CCons :: Tree k a > Children k a > Children ('Succ k) a
Some illustrations to make this a bit more clear:
This is definitely a very good example of the correctness by construction approach I talked about earlier: it is simply impossible to create a tree that does not have the right shape.
Empty trees do not exist according to this definition. A singleton tree is easy to create:
We only need to define one operation on trees, namely merging two trees.
A tree of order k
has 2ᵏ
elements, so it makes sense that merging two trees of order k
creates a tree of order k+1
. We can see this in the type signature as well:
Concretely, we construct the new tree by taking either the left or the right tree and attaching it as new child to the other tree. Since we are building a heap to use as a priority queue, we want to keep the smallest element in the root of the new tree.
mergeTree l@(Tree lroot lchildren) r@(Tree rroot rchildren)
 lroot <= rroot = Tree lroot (CCons r lchildren)
 otherwise = Tree rroot (CCons l rchildren)
With these trees defined, we can move on to binomial heaps.
While binomial trees are interesting on their own, they can really only represent collections that have a number of elements that are exactly a power of two.
Binomial heaps solve this in a surprisingly simple way. A binomial heap is a collection of binomial trees where we may only have at most one tree for every order.
This is where the correspondence with binary numbers originates. If we have a binomial heap with 5 elements, the only way to do this is to have binomial trees of orders 2 and 0 (2² + 2⁰ = 5).
We start out by defining a simple datatype that will be lifted to the kindlevel, just as we did with Nat
:
It’s important to note that we will represent binary numbers in a righttoleft order since this turns out to match up more naturally with the way we will be defining heaps.
For example, the type:
'B0 ('B1 ('B1 'BEnd))
represents the number 6 (conventionally written 110).
I think it is fairly common in Haskell for a developer to play around with different ways of representing a certain thing until you converge on an elegant representation. This is many, many times more important when we are dealing with dependentlytyped Haskell.
Inelegant and awkward data representations can make termlevel programming clunky. Inelegant and awkward type representations can make typelevel programming downright infeasible due to the sheer amount of lemmas that need to be proven.
Consider the relative elegance of defining a type family for incrementing a binary number that is read from the right to the left:
type family BInc (binary :: Binary) :: Binary where
BInc 'BEnd = 'B1 'BEnd
BInc ('B0 binary) = 'B1 binary
BInc ('B1 binary) = 'B0 (BInc binary)
Appendix 3 contains an (unused) implementation of incrementing lefttoright binary numbers. Getting things like this to work is not too much of a stretch these days (even though GHC’s error messages can be very cryptic). However, due to the large amount of type families involved, proving things about it presumably requires ritually sacrificing an inappropriate amount of Agda programmers while chanting Richard Eisenberg’s writings.
To that end, it is almost always worth spending time finding alternate representations that work out more elegantly. This can lead to some arbitrary looking choices – we will see this in full effect when trying to define CutTree further below.
Addition is not too hard to define:
type family BAdd (x :: Binary) (y :: Binary) :: Binary where
BAdd 'BEnd y = y
BAdd x 'BEnd = x
BAdd ('B0 x) ('B0 y) = 'B0 (BAdd x y)
BAdd ('B1 x) ('B0 y) = 'B1 (BAdd x y)
BAdd ('B0 x) ('B1 y) = 'B1 (BAdd x y)
BAdd ('B1 x) ('B1 y) = 'B0 (BInc (BAdd x y))
Let’s quickly define a number of examples
type BZero = 'B0 'BEnd
type BOne = BInc BZero
type BTwo = BInc BOne
type BThree = BInc BTwo
type BFour = BInc BThree
type BFive = BInc BFour
This allows us to play around with it in GHCi:
*Main> :set XDataKinds
*Main> :kind! BAdd BFour BFive
BAdd BFour BFive :: Binary
= 'B1 ('B0 ('B0 ('B1 'BEnd)))
Finally, we define a corresponding singleton to use later on:
data SBin (b :: Binary) where
SBEnd :: SBin 'BEnd
SB0 :: SBin b > SBin ('B0 b)
SB1 :: SBin b > SBin ('B1 b)
Our heap will be a relatively simple wrapper around a recursive type called Forest
. This datastructure follows the definition of the binary numbers fairly closely, which makes the code in this section surprisingly easy and we end up requiring no lemmas or proofs whatsoever.
A Forest k b
refers to a number of trees starting with (possibly) a tree of order k
. The b
is the binary number that indicates the shape of the forest – i.e., whether we have a tree of a given order or not.
Using a handwavy but convenient notation, this means that Forest 3 101 refers to binomial trees of order 3 and 5 (and no tree of order 4).
data Forest (k :: Nat) (b :: Binary) a where
FEnd :: Forest k 'BEnd a
F0 :: Forest ('Succ k) b a > Forest k ('B0 b) a
F1 :: Tree k a > Forest ('Succ k) b a > Forest k ('B1 b) a
Note that we list the trees in increasing order here, which contrasts to Children
, where we listed them in decreasing order. You can see this in the way we are removing layers of 'Succ
as we add more constructors. This is the opposite of what happens in Children
.
The empty forest is easily defined:
insertTree
inserts a new tree into the forest. This might require merging two trees together – roughly corresponding to carrying in the binary increment operation.
insertTree
:: Ord a
=> Tree k a > Forest k b a
> Forest k (BInc b) a
insertTree s FEnd = F1 s FEnd
insertTree s (F0 f) = F1 s f
insertTree s (F1 t f) = F0 (insertTree (mergeTree s t) f)
Similarly, merging two forests together corresponds to adding two binary numbers together:
mergeForests
:: Ord a
=> Forest k lb a > Forest k rb a
> Forest k (BAdd lb rb) a
mergeForests FEnd rf = rf
mergeForests lf FEnd = lf
mergeForests (F0 lf) (F0 rf) = F0 (mergeForests lf rf)
mergeForests (F1 l lf) (F0 rf) = F1 l (mergeForests lf rf)
mergeForests (F0 lf) (F1 r rf) = F1 r (mergeForests lf rf)
mergeForests (F1 l lf) (F1 r rf) =
F0 (insertTree (mergeTree l r) (mergeForests lf rf))
It’s worth seeing how the different branches in insertTree
and mergeForests
match up almost 1:1 with the different clauses in the definition of the type families BInc
and BAdd
. If we overlay them visually:
That is the intuitive explanation as to why no additional proofs or typelevel trickery are required here.
Here is an informal illustration of what happens when we don’t need to merge any trees. The singleton Forest
on the left is simply put in the empty F0
spot on the right.
When there is already a tree there, we merge the trees using mergeTree
and carry that, in a very similar way to how carrying works in the addition of binary numbers:
The Forest
structure is the main workhorse and Heap
is just a simple wrapper on top of that, where we start out with a tree of order 0:
The operations on Heap
are also simple wrappers around the previously defined functions:
pushHeap :: Ord a => a > Heap b a > Heap (BInc b) a
pushHeap x (Heap forest) = Heap (insertTree (singletonTree x) forest)
mergeHeap :: Ord a => Heap lb a > Heap rb a > Heap (BAdd lb rb) a
mergeHeap (Heap lf) (Heap rf) = Heap (mergeForests lf rf)
We are now ready to show this off in GHCi again:
*Main> :t pushHeap 'a' $ pushHeap 'b' $ pushHeap 'c' $
pushHeap 'd' $ pushHeap 'e' emptyHeap
Heap ('B1 ('B0 ('B1 'BEnd))) Char
We can also take a look at the internals of the datastructure using a custom show instance provided in the appendix 2:
*Main> pushHeap 'a' $ pushHeap 'b' $ pushHeap 'c' $
pushHeap 'd' $ pushHeap 'e' emptyHeap
(tree of order 0)
'a'
(no tree of order 1)
(tree of order 2)
'b'
'd'
'e'
'c'
Neat!
I think it’s interesting that we have implemented an appendonly heap without even requiring any lemmas so far. It is perhaps a good illustration of how appendonly datastructures are conceptually much simpler.
Things get significantly more complicated when we try to implement popping the smallest element from the queue. For reference, I implemented the current heap in a couple of hours, whereas I worked on the rest of the code on and off for about a week.
Let’s look at a quick illustration of how popping works.
We first select the tree with the smallest root and remove it from the heap:
We break up the tree we selected into its root (which will be the element that is “popped”) and its children, which we turn into a new heap.
We merge the remainder heap from step 1 together with the new heap we made out of the children of the removed tree:
The above merge requires carrying twice.
We will start by implementing step 2 of the algorithm above since it is a bit easier. In this step, we are taking all children from a tree and turning that into a new heap.
We need to keep all our invariants intact, and in this case this means tracking them in the type system. A tree of k
has 2ᵏ
elements. If we remove the root, we have k
children trees with 2ᵏ  1
elements in total. Every child becomes a tree in the new heap. This means that the heap contains k
full trees, and its shape will be written as k
“1”s. This matches our math: if you write k
“1”s, you get the binary notation of 2ᵏ  1
.
Visually:
We introduce a type family for computing n
“1”s:
We will use a helper function childrenToForest_go
to maintain some invariants. The wrapper childrenToForest
is trivially defined but its type tells us a whole deal:
childrenToForest
:: Children n a
> Forest 'Zero (Ones n) a
childrenToForest children =
childrenToForest_go SZero (childrenSingleton children) FEnd children
We use childrenSingleton
to obtain a singleton for n
.
childrenSingleton :: Children n a > SNat n
childrenSingleton CZero = SZero
childrenSingleton (CCons _ c) = SSucc (childrenSingleton c)
The tricky bit is that the list of trees in Children
has them in descending order, and we want them in ascending order in Forest
. This means we will have to reverse the list.
We can reverse a list easily using an accumulator in Haskell. In order to maintain the type invariants at every step, we will increase the size of the accumulator as we decrease the size of the children. This can be captured by requiring that their sum remains equal (m ~ NAdd x n
).
childrenToForest_go
:: m ~ NAdd x n
=> SNat x
> SNat n
> Forest n (Ones x) a
> Children n a
> Forest 'Zero (Ones m) a
I will not always go into detail on how the lemmas apply but let’s do it here nonetheless.
For the base case, we simply want to return our accumulator. However, our accumulator has the type Forest n (Ones x)
and we expect something of the type Forest n (Ones m)
. Furthermore, we know that:
n ~ 'Zero, m ~ NAdd x n
⊢ m ~ NAdd x 'Zero
We need to prove that x ~ m
in order to do the cast from Forest n (Ones x)
to Forest n (Ones m)
.
We can do so by applying lemma1
to x
(the latter represented here by xnat
). This gives us lemma1 xnat :: NAdd x 'Zero :~: n
. Combining this with what we already knew:
m ~ NAdd x 'Zero, NAdd x 'Zero ~ n
⊢ m ~ x
…which is what we needed to know.
The inductive case is a bit harder and requires us to prove that:
m ~ NAdd x n, m ~ NAdd x n, n ~ 'Succ k
⊢ Ones m ~ 'B1 (Ones (NAdd x k))
GHC does a great job and ends up with something like:
Ones (NAdd x (Succ k)) ~ 'B1 (Ones (NAdd x k))
Which only requires us to prove commutativity on NAdd
. You can see that proof in lemma2
a bit further below. This case also illustrates well how we carry around the singletons as inputs for our lemmas and call on them when required.
childrenToForest_go xnat (SSucc nnat) acc (CCons tree children) =
case lemma2 xnat nnat of
QED > childrenToForest_go
(SSucc xnat)
nnat
(F1 tree acc)
children
Proving lemma2
is trivial… once you figure out what you need to prove and how all of this works.
It took me a good amount of time to put the different pieces together in my head. It is not only a matter of proving the lemma: restructuring the code in childrenToForest_go
leads to different lemmas you can attempt to prove, and figuring out which ones are feasible is a big part of writing code like this.
lemma2 :: SNat n > SNat m > NAdd n ('Succ m) :~: 'Succ (NAdd n m)
lemma2 SZero _ = QED
lemma2 (SSucc n) m = case lemma2 n m of QED > QED
These are some minor auxiliary functions we need to implement on Vec
. We mention them here because we’ll also need two type classes dealing with nonzeroness.
First, we need some sort of map
, and we can do this by implementing the Functor
typeclass.
Secondly, we need a very simple function to convert a Vec
to a list. Note that this erases the information we have about the size of the list.
Using vecToList
, we can build a function to convert a nonempty Vec
to a NonEmpty
list. This uses an additional NNonZero
typeclass.
vecToNonEmpty :: NNonZero n ~ 'True => Vec n a > NonEmpty a
vecToNonEmpty (VCons x v) = x : vecToList v
Nonzeroness can be defined on binary numbers as well:
type family BNonZero (b :: Binary) :: Bool where
BNonZero 'BEnd = 'False
BNonZero ('B1 b) = 'True
BNonZero ('B0 b) = BNonZero b
You might be asking why we cannot use a simpler type, such as:
It we use this, we run into trouble when trying to prove that a Vec
is not empty later on. We would have to construct a singleton for n
, and we only have something that looks a bit like ∃n. 'Succ n
. Trying to get the n
out of that requires some form of nonzeroness constraint… which would be exactly what we are trying to avoid by using the simpler type. ^{5}
The minimal element will always be the root of one of our trees. That means we have as many choices for our minimal element as there are trees in our heap. We need some way to write down this number as a type.
Since we have a tree for every 1 in our binary number, we can define the number of trees as the popcount of the binary number.
In a weird twist of fate, you can also pretend this stands for “the count of trees which we can pop”, which is exactly what we will be using it for.
type family Popcount (b :: Binary) :: Nat where
Popcount 'BEnd = 'Zero
Popcount ('B1 b) = 'Succ (Popcount b)
Popcount ('B0 b) = Popcount b
Popcount
can be used to relate the nonzeroness of a natural number, and the nonzeroness of a binary number.
lemma3
:: BNonZero b ~ 'True
=> SBin b
> NNonZero (Popcount b) :~: 'True
lemma3 (SB1 _) = QED
lemma3 (SB0 b) = case lemma3 b of QED > QED
In addition to caring about the popcount
of a binary number, we are sometimes interested in its width
(number of bits). This is also easily captured in a type family:
type family Width (binary :: Binary) :: Nat where
Width 'BEnd = 'Zero
Width ('B0 binary) = 'Succ (Width binary)
Width ('B1 binary) = 'Succ (Width binary)
That is a fair amount of type families so far. To make things a bit more clear, here is an informal visual overview of all the type families we have defined, including BDec
(binary decrement, defined further below).
Now, popping the smallest element from the heap first involves cutting a single tree from the forest inside the heap. We take the root of that tree and merge the children of the tree back together with the original heap.
However, just selecting (and removing) a single tree turns out to be quite an endeavour on its own. We define an auxiliary GADT which holds the tree, the remainder of the heap, and most importantly, a lot of invariants.
Feel free to scroll down to the datatype from here if you are willing to assume the specific constraint and types are there for a reason.
The two first fields are simply evidence singletons that we carry about. k
stands for the same concept as in Forest
; it means we are starting with an order of k
. x
stands for the index of the tree that was selected.
This means the tree that was selected has an order of NAdd k x
, as we can see in the third field. If the remainder of the heap is Forest k b a
, its shape is denoted by b
and we can reason about the shape of the original heap.
The children of tree (Tree (NAdd k x) a
) that was selected will convert to a heap of shape Ones x
. We work backwards from that to try and write down the type for the original heap. The tree (Tree (NAdd k x) a
) would form a singleton heap of shape BInc (Ones x)
. The remainder (i.e., the forest with this tree removed) had shape b
, so we can deduce that the original shape of the forest must have been BAdd b (BInc (Ones x))
.
Finally, we restructure the type in that result to BInc (BAdd b (Ones x))
. The restructuring is trivially allowed by GHC since it just requires applying the necessary type families. The restructured type turns out to be more easily usable in the places where we caseanalyse CutTree
further down in this blogpost.
We also carry a constraint here that seems very arbitrary and relates the widths of two binary numbers. It is easier to understand from an intuitive point of view: the new (merged) heap has the same width as the original heap. Why is it here?
Well, it turns out we will need this fact further down in a function definition. If we can conclude it here by construction in the GADT, we avoid having to prove it further down.
Of course, I know that I will need this further down because I already have the code compiling. When writing this, there is often a very, very painful dialogue in between different functions and datatypes, where you try to mediate by making the requested and expected types match by bringing them closer together step by step. In the end, you get a monstrosity like:
data CutTree (k :: Nat) (b :: Binary) a where
CutTree
:: Width (BAdd b (Ones x)) ~ Width (BInc (BAdd b (Ones x)))
=> SNat x
> SNat k
> Tree (NAdd k x) a
> Forest k b a
> CutTree k (BInc (BAdd b (Ones x))) a
Fortunately, this type is internal only and doesn’t need to be exported.
lumberjack_go
is the worker function that takes all possible trees out of a heap. For every 1 in the shape of the heap, we have a tree: therefore it should not be a surprise that the length of the resulting vector is Popcount b
.
The definition is recursive and a good example of how recursion corresponds with inductive proofs (we’re using lemma1
and lemma2
here). We don’t go into much detail with our explanation here – this code is often hard to write, but surprisingly easy to read.
lumberjack_go _ FEnd = VNull
lumberjack_go nnat0 (F0 forest0) = fmap
(\cutTree > case cutTree of
CutTree xnat (SSucc nnat) t1 forest1 > CutTree
(SSucc xnat)
nnat
(case lemma2 nnat xnat of QED > t1)
(F0 forest1))
(lumberjack_go (SSucc nnat0) forest0)
lumberjack_go nnat0 (F1 tree0 forest0) = VCons
(CutTree
SZero
nnat0
(case lemma1 nnat0 of QED > tree0)
(F0 forest0))
(fmap
(\cutTree > case cutTree of
CutTree xnat (SSucc nnat) t1 forest1 > CutTree
(SSucc xnat)
nnat
(case lemma2 nnat xnat of QED > t1)
(F1 tree0 forest1))
(lumberjack_go (SSucc nnat0) forest0))
Now that we can select Popcount b
trees, it’s time to convert this to something more convenient to work with. We will use a NonEmpty
to represent our list of candidates to select from.
lumberjack
:: forall b a. BNonZero b ~ 'True
=> Forest 'Zero b a
> NonEmpty.NonEmpty (CutTree 'Zero b a)
First, we select the Popcount b
trees:
lumberjack trees =
let cutTrees :: Vec (Popcount b) (CutTree 'Zero b a)
cutTrees = lumberjack_go SZero trees in
Then we convert it to a NonEmpty
. This requires us to call lemma3
(the proof that relates nonzeroness of a binary number with nonzeroness of a natural number through popcount). We need an appropriate SBin
to call lemma3
and the auxiliary function forestSingleton
defined just below does that for us.
This function is similar to childrenSingleton
– it constructs an appropriate singleton we can use in proofs.
forestSingleton :: Forest k b a > SBin b
forestSingleton FEnd = SBEnd
forestSingleton (F0 t) = SB0 (forestSingleton t)
forestSingleton (F1 _ t) = SB1 (forestSingleton t)
We can now find all trees in the heap that may be cut. They are returned in a CutTree
datatype. If we assume that we are taking a specific CutTree
, we can take the root from the tree inside this datatype, and we can construct a new heap from its children using childrenToForest
. Then, we merge it back together with the original heap.
The new heap has one less element – hence we use BDec
(binary decrement, defined just a bit below).
We deconstruct the CutTree
to get the root (x
) of the selected tree, the children of the selected trees (children
), and the remaining trees in the heap (forest
).
We construct a new forest from the children.
We merge it with the remainder of the heap:
The illustration from above applies here:
Now, we cast it to the result using a new lemma4
with a singleton that we construct from the trees:
evidence :: SBin (BAdd l (Ones r))
evidence = forestSingleton merged in
(x, case lemma4 evidence of QED > merged)
This is the type family for binary decrement. It is partial, as expected – you cannot decrement zero. This is a bit unfortunate but necessary. Having the BNonZero
type family and using it as a constraint will solve that though.
type family BDec (binary :: Binary) :: Binary where
BDec ('B1 b) = 'B0 b
BDec ('B0 b) = 'B1 (BDec b)
The weirdly specific lemma4
helps us prove that we can take a number, increment it and then decrement it, and then get the same number back provided incrementing doesn’t change its width. This ends up matching perfectly with the width constraint generated by the CutTree
, where the number that we increment is a number of “1”s smaller than the shape of the total heap (intuitively).
Using another constraint in CutTree
with another proof here should also be possible. I found it hard to reason about why this constraint is necessary, but once I understood that it wasn’t too abnormal. The proof is easy though.
lemma4
:: (Width x ~ Width (BInc x))
=> SBin x
> BDec (BInc x) :~: x
lemma4 (SB0 _) = QED
lemma4 (SB1 b) = case lemma4 b of QED > QED
We don’t need to define a clause for SBEnd
since Width SBEnd ~ Width (BInc SBEnd)
does not hold.
Tying all of this together makes for a relatively easy readable popHeap
:
Out of the different candidates, select the one with the minimal root (minimumBy
is total on NonEmpty
):
Pop that tree using popForest
:
Helper to compare candidates by root:
In GHCi:
*Main> let heap = pushHeap 'a' $ pushHeap 'b' $ pushHeap 'c' $
pushHeap 'd' $ pushHeap 'e' emptyHeap
*Main> :t heap
heap :: Heap ('B1 ('B0 ('B1 'BEnd))) Char
*Main> :t popHeap heap
popHeap heap :: (Char, Heap ('B0 ('B0 ('B1 'BEnd))) Char)
*Main> fst $ popHeap heap
'a'
*Main> snd $ popHeap heap
(no tree of order 0)
(no tree of order 1)
(tree of order 2)
'b'
'd'
'e'
'c'
Beautiful! Our final interface to deal with the heap looks like this:
emptyHeap
:: Heap ('B0 'BEnd) a
pushHeap
:: Ord a
=> a > Heap b a > Heap (BInc b) a
mergeHeap
:: Ord a
=> Heap lb a > Heap rb a > Heap (BAdd lb rb) a
popHeap
:: (BNonZero b ~ 'True, Ord a)
=> Heap b a > (a, Heap (BDec b) a)
I would like to thank Alex Lang for many discussions about this and for proofreading, Akio Takano and Fumiaki Kinoshita for some whiteboarding, and Titouan Vervack and Becki Lee for many additional corrections.
I am by no means an expert in dependent types so while GHC can guarantee that my logic is sound, I cannot guarantee that my code is the most elegant or that my explanations are waterproof. In particular, I am a bit worried about the fact that binary numbers do not have unique representations – even though it does seem to make the code a bit simpler. If you have any ideas for improvements, however, feel free to reach out!
Update: Lars Brünjes contacted me and showed me a similar implementation he did for leftist heaps. You can see it in this repository. He uses a similar but unique representation of binary numbers, along the lines of:
I think this is actually more elegant than the representation I used. The only disadvantage is that is a bit less concise (which is somewhat relevant for a blogpost), requiring two functions and two datatypes for most cases (e.g. a Forest k Binary
and a PForest k Positive
, with mergeForests
and mergePForests
, and so on). But if you wanted to use this idea in a real implementation, I encourage you to check that out.
Since we represent the proofs at runtime, we incur an overhead in two ways:
QED
constructor.It should be possible to remove these at runtime once the code has been typechecked, possibly using some sort of GHC core or source plugin (or CPP in a darker universe).
Another existing issue is that the tree of the spine is never “cleaned up”. We never remove trailing F0
constructors. This means that if you fill a heap of eight elements and remove all of them again, you will end up with a heap with zero elements that has the shape 'B0 ('B0 ('B0 ('B0 'BEnd)))
rather than B0 'BEnd
. However, this sufficed for my use case. It should be possible to add and prove a cleanup step, but it’s a bit outside the scope of this blogpost.
instance forall a b. Show a => Show (Heap b a) where
show = intercalate "\n" . goTrees 0 . unHeap
where
goTrees :: forall m c. Show a => Int > Forest m c a > [String]
goTrees _ FEnd = []
goTrees order (F0 trees) =
("(no tree of order " ++ show order ++ ")") :
goTrees (order + 1) trees
goTrees order (F1 tree trees) =
("(tree of order " ++ show order ++ ")") :
goTree " " tree ++
goTrees (order + 1) trees
goTree :: forall m. String > Tree m a > [String]
goTree indentation (Tree x children) =
(indentation ++ show x) :
goChildren (' ' : indentation) children
goChildren :: forall m. String > Children m a > [String]
goChildren _ CZero = []
goChildren indentation (CCons x xs) =
goTree indentation x ++ goChildren indentation xs
Increment gets tricky mainly because we need some way to communicate the carry back in a righttoleft direction. We can do this with a typelevel Either
and some utility functions. It’s not too far from what we would write on a termlevel, but again, a bit more clunky. We avoid this kind of clunkiness since having significantly more code obviously requires significantly more proving.
type family Carry (b :: Binary) :: Either Binary Binary where
Carry ('B1 'BEnd) = 'Left ('B0 'BEnd)
Carry ('B0 'BEnd) = 'Right ('B1 'BEnd)
Carry ('B0 b) = 'Right (UnEither 'B1 'B0 (Carry b))
Carry ('B1 b) = MapEither 'B0 'B1 (Carry b)
type family MapEither
(f :: a > c) (g :: b > d) (e :: Either a b) :: Either c d where
MapEither f _ ('Left x) = 'Left (f x)
MapEither _ g ('Right y) = 'Right (g y)
type family UnEither
(f :: a > c) (g :: b > c) (e :: Either a b) :: c where
UnEither f _ ('Left x) = f x
UnEither _ g ('Right y) = g y
type family FromRight (f :: a > b) (e :: Either a b) :: b where
FromRight f ('Left x) = f x
FromRight _ ('Right y) = y
For work, I recently put together an interpreter for a lambda calculus that was way faster than I expected it to be – around 30 times as fast. I suspected this meant that something was broken, so in order to convince myself of its correctness, I wrote a welltyped version of it in the style of Francesco’s welltyped suspension calculus blogpost. It used a standard lengthindexed list which had the unfortunate side effect of pushing me into O(n) territory for random access. I started looking for an asymptotically faster way to do this, which is how I ended up looking at heaps. In this blogpost, I am using the binomial heap as a priority queue rather than a bastardized random access skip list since that is what readers are presumably more familiar with.↩
For reasons that will become clear later on, the binary numbers that pop up on the type level should be read righttoleft. A palindrome was chosen as example here to avoid having to explain that at this point.↩
This type and related utilities are found in Data.Type.Equality, but redefined here for educational purposes.↩
The datatype in Data.Type.Equality
allows equality between heterogeneous kinds as well, but we don’t need that here. This saves us from having to toggle on the “scary” {# LANGUAGE TypeInType #}
.↩
I’m not sure if it is actually impossible to use this simpler type, but I did not succeed in finding a proof that uses this simpler type.↩
I’d like to talk about a design pattern in Haskell that I’ve been calling the Handle pattern. This is far from novel – I’ve mentioned this before and the idea is definitely not mine. As far as I know, in fact, it has been around since basically forever^{1}. Since it is ridiculously close to what we’d call common sense^{2}, it’s often used without giving it any explicit thought.
I first started more consciously using this pattern when I was working together with Simon Meier at Better (aka erudify). Simon did a writeup about this pattern as well. But as I was explaining this idea again at last week’s HaskellerZ meetup, I figured it was time to do an update of that article.
The Handle pattern allows you write stateful applications that interact with external services in Haskell. It complements pure code (e.g. your business logic) well, and it is somewhat the result of iteratively applying the question:
The result is a powerful and simple pattern that does not even require Monads^{3} or Monad transformers to be useful. This makes it extremely suitable for beginners trying to build their first mediumsized Haskell application. And that does not mean it is beginnersonly: this technique has been applied successfully at several Haskell companies as well.
In Haskell, we try to capture ideas in beautiful, pure and mathematically sound patterns, for example Monoids. But at other times, we can’t do that. We might be dealing with some inherently mutable state, or we are simply dealing with external code which doesn’t behave nicely.
In those cases, we need another approach. What we’re going to describe feels suspiciously similar to Object Oriented Programming:
As you can see, it is not exactly the same as Alan Kay’s original definition of OOP^{4}, but it is far from the horrible incidents that permeate our field such as UML, abstract factory factories and broken subtyping.
Before we dig in to the actual code, let’s talk about some disclaimers.
Pretty much any sort of Haskell code can be written in this particular way, but that doesn’t mean that you should. This method relies heavily on IO
. Whenever you can write things in a pure way, you should attempt to do that and avoid IO
. This pattern is only useful when IO
is required.
Secondly, there are many alternatives to this approach: complex monad transformer stacks, interpreters over free monads, uniqueness types, effect systems… I don’t want to claim that this method is better than the others. All of these have advantages and disadvantages, so one must always make a careful tradeoff.
For this pattern, we’ve got a very welldefined module layout. I believe this helps with recognition which I think is also one of the reasons we use typeclasses like Monoid.
When I’m looking at the documentation of libraries I haven’t used yet, the types will sometimes look a bit bewildering. But then I see that there’s an instance Monoid
. That’s an “Aha!” moment for me. I know what a Monoid is. I know how they behave. This allows me to get up to speed with this library much faster!
Using a consistent module layout in a project (and even across projects) provides, I think, very similar benefits to that. It allows new people on the team to learn parts of the codebase they are yet unfamiliar with much faster.
Anyway, let’s look at the concrete module layout we are proposing with this pattern. As an example, let’s consider a database. The type in which we are encapsulating the state is always called Handle
. That is because we design for qualified import.
We might have something like:
module MyApp.Database
data Handle = Handle
{ hPool :: Pool Postgres.Connection
, hCache :: IORef (PSQueue Int Text User)
, hLogger :: Logger.Handle  Another handle!
, …
}
The internals of the Handle
typically consist of static fields and other handles, MVar
s, IORef
s, TVar
s, Chan
s… With our Handle
defined, we are able to define functions using it. These are usually straightforward imperative pieces of code and I’ll omit them for brevity^{5}:
module MyApp.Database where
data Handle = …
createUser :: Handle > Text > IO User
createUser = …
getUserMail :: Handle > User > IO [Mail]
getUserMail = …
Some thoughts on this design:
We call our functions createUser
rather than databaseCreateUser
. Again, we’re working with qualified imports so there’s no need for “Cstyle” names.
All functions take the Handle
as the first argument. This is very important for consistency, but also for polymorphism and code style.
With code style, I mean that the Handle
is often a syntactically simpler expression (e.g. a name) than the argument (which is often a composed expression). Consider:
Versus:
Other Handle
s (e.g. Logger.Handle
) are stored in a field of our Database.Handle
. You could also remove it there and instead have it as an argument wherever it is needed, for example:
I usually prefer to put it inside the Handle
since that reduces the amount of arguments required for functions such as createUser
. However, if the lifetime of a Logger.Handle
is very short^{6}, or if you want to reduce the amount of dependencies for new
, then you could consider doing the above.
The datatypes such as Mail
may be defined in this module may even be specific to this function. I’ve written about adhoc datatypes before.
I mentioned before that an important advantage of using these patterns is that programmers become “familiar” with it. That is also the goal we have in mind when designing our API for the creation of Handle
s.
In addition to always having a type called Handle
, we’ll require the module to always have a type called Config
. This is where we encode our static configuration parameters – and by static I mean that we shouldn’t have any IORef
s or the like here: this Config
should be easy to create from pure code.
We can also offer some way to create a Config
. This really depends on your application. If you use the configurator library, you might have something like:
On the other hand, if you use aeson or yaml, you could write:
You could even use a Monoid to support loading configurations from multiple places. But I digress – the important part is that there is a type called Config
.
Next is a similar pattern: in addition to always having a Config
, we’ll also always provide a function called new
. The parameters follow a similarly strict pattern:
new :: Config  1. Config
> Logger.Handle  2. Dependencies
> …  (usually other handles)
> IO Handle  3. Result
Inside the new
function, we can create some more IORef
s, file handles, caches… if required and then store them in the Handle
.
We’ve talked about creation of a Handle
, and we mentioned the normal functions operating on a Handle
(e.g. createUser
) before. So now let’s consider the final stage in the lifetime of Handle
.
Haskell is a garbage collected language and we can let the runtime system take care of destroying things for us – but that’s not always a great idea. Many resources (file handles in particular come to mind as an example) are scarce.
There is quite a strong correlation between scarce resources and things you would naturally use a Handle
for. That’s why I recommend always providing a close
as well, even if does nothing. This is a form of forward compatibility in our API: if we later decide to add some sort of log files (which needs a close
), we can do so without individually mailing all our module users that they now need to add a close
to their code.
When you’re given a new
and close
, it’s often tempting to add an auxiliary function like:
withHandle
:: Config  1. Config
> Logger.Handle  2. Dependencies
> …  (usually other handles)
> (Handle > IO a)  3. Function to apply
> IO a  4. Result, handle is closed automatically
I think this is a great idea. In fact, it’s sometimes useful to only provide the withHandle
function, and hide new
and close
in an internal module.
The only caveat is that the naive implementation of this function:
withHandle config dep1 dep2 … depN f = do
h < new config dep1 dep2 … depN
x < f h
close h
return x
Is wrong! In any sort of withXyz
function, you should always use bracket
to guard against exceptions. This means the correct implementation is:
Well, it’s even shorter! In case you want more information on why bracket
is necessary, this blogpost gives a good indepth overview. My summary of it as it relates to this article would be:
bracket
to match new
and close
throwIO
and killThread
safelyIt’s important to note that withXyz
functions do not provide complete safety against things like useafterclose our doubleclose. There are many interesting approaches to fix these issues but they are way beyond the scope of this tutorial – things like Monadic Regions and The Linearity Monad come to mind. For now, we’ll rely on bracket
to catch common issues and on code reviews to catch team members who are not using bracket
.
If we quickly summarise the module layout, we now have:
module MyApp.Database
( Config (..)  Internals exported
, parseConfig  Or some other way to load a config
, Handle  Internals usually not exported
, new
, close
, withHandle
, createUser  Actual functions on the handle
, …
) where
This is a wellstructured, straightforward and easy to learn organisation. Most of the Handle
s in any application should probably look this way. In the next section, we’ll see how we can build on top of this to create dynamic, customizable Handle
s.
It’s often important to split between the interface and implementation of a service. There are countless ways to do this in programming languages. For Haskell, there is:
The list is endless. And because Haskell on one hand makes it so easy to abstract over things, and on the other hand makes it possible to abstract over pretty much anything, I’ll start this section with a disclaimer.
Premature abstraction is a real concern in Haskell (and many other highlevel programming languages). It’s easy to quickly whiteboard an abstraction or interface and unintentionally end up with completely the wrong thing.
It usually goes like this:
What you end up with is a leaky abstraction that is the product of all concrete implementations – where what you really wanted is the greatest common divisor.
There’s no magic bullet to avoid broken abstractions so my advice is usually to first painstakingly do all the different implementations (or at least a few of them). After you have something working and you have emerged victorous from horrible battles with the guts of these implementations, then you could start looking at what the different implementations have in common. At this point, you’ll also be a bit wiser about where they differ – and you’ll be able to take these important details into account, at which point you retire from just being an idiot drawing squares and arrows on a whiteboard.
This is why I recommend sticking with simple Handle
s until you really need it. But naturally, sometimes we really need the extra power.
So let’s do the simplest thing that can possibly work. Consider the following definition of the Handle
we discussed before:
module MyApp.Database
( Handle (..)  We now need to export this
) where
data Handle = Handle
{ createUser :: Text > IO User
, …
}
What’s the type of createUser
now?
It’s exactly the same as before! This is pretty much a requirement: it means we can move our Handle
s to this approach when we need it, not when we envision that we will need it at some point in the future.
We can now create a concrete implementation for this abstract Handle
type. We’ll do this in a module like MyApp.Database.Postgres
.
module MyApp.Database.Postgres where
import MyApp.Database
data Config = …
new :: Config > Logger.Handle > … > IO Handle
The Config
datatype and the new
function have now moved to the implementation module, rather than the interface module.
Since we can have any number of implementation modules, it is worth mentioning that we will have multiple Config
types and new
functions (exactly one of each per implementation). Configurations are always specific to the concrete implementation. For example, an sqlite database may just have a FilePath
in the configuration, but our Postgres
implementation will have other details such as port, database, username and password.
In the implementation of new
, we simply initialize a Handle
:
new config dep1 dep2 … depN = do
 Intialization of things inside the handle
…
 Construct record
return Handle
{ createUser = \name > do
…
, …
}
Of course, we can manually float out the body of createUser
since constructing these large records gets kind of ugly.
We’ve presented an approach to modularize the effectful layer of medium to largescaled Haskell applications. There are many other approaches to tackling this, so any comparison I come up with would probably be inexhaustive.
Perhaps the most important advantage of using Handle
s is that they are first class values that we can freely mix and match. This often does not come for free when using more exotic strategies.
Consider the following type signature from a Hackage package – and I do not mean to discredit the author, the package works fine but simply uses a different approach than my personal preference:
  Create JSONRPC session around conduits from transport layer.
 When context exits session disappears.
runJsonRpcT
:: (MonadLoggerIO m, MonadBaseControl IO m)
=> Ver  ^ JSONRPC version
> Bool  ^ Ignore incoming requests/notifs
> Sink ByteString m ()  ^ Sink to send messages
> Source m ByteString  ^ Source to receive messages from
> JsonRpcT m a  ^ JSONRPC action
> m a  ^ Output of action
I’m a fairly experienced Haskeller and it still takes me a bit of eyesquinting to see how this will fit into my application, especially if I want to use this package with other libraries that do not use the Sink
/Source
or MonadBaseControl
abstractions.
It is somewhat obvious that one running call to runJsonRpcT
corresponds to being connected to one JSONRPC endpoint, since it takes a single sink and source. But what if we want our application to be connected to multiple endpoints at the same time?
What if we need to have hundreds of thousands of these, and we want to store them in some priority queue and only consider the most recent ones in the general case. How would you go about that?
You could consider running a lightweight thread for every runJsonRpcT
, but that means you now need to worry about thread overhead, communicating exceptions between threads and killing the threads after you remove them. Whereas with firstclass handles, we would just have a HashPSQ Text Int JsonRpc.Handle
, which is much easier to reason about.
So, I guess one of the oldest and most widely used approaches is MTLstyle monad transformers. This uses a hierarchy of typeclasses to represent access to various subsystems.
I love working with MTLstyle transformers in the case of pure code, since they often allow us to express complex ideas concisely. For effectful code, on the other hand, they do not seem to offer many advantages and often make it harder to reason about code.
My personal preference for writing complex effectful code is to reify the effectful operations as a datatype and then write pure code manipulating these effectful operations. An interpreter can then simply use the Handle
s to perform the effects. For simpler effectful code, we can just use Handle
s directly.
I have implemented a number of these patterns in the (ever unfinished) example web application fugacious, in case you want to see them in action or if you want a more elaborate example than the short snippets in this blogpost. Finally, I would like to thank Alex Lang and Nicolas Mattia for proofreading, and Titouan Vervack for many corrections and typos.
Well, System.IO.Handle
has definitely been around for a while.↩
If you’re reading this article and you’re thinking: “What does this guy keep going on about? This is all so obvious!” – Well, that’s the point!↩
It does require IO
, but we don’t require thinking about IO
as a Monad
. If this sounds weird – think of lists. We work with lists all the time but we just consider them lists of things, we don’t constantly call them “List Monad” or “The Free Monoid” for that matter.↩
And indeed, we will touch on a common way of encoding OOP in Haskell – creating explicit records of functions – but we’ll also explain why this isn’t always necessary.↩
If you want to see a full example, you can refer to this repository that I have been using to teach practical Haskell.↩
With a short lifetime I mean you would create a new Logger.Handle
for every call to createUser
. But even in that case you could consider turning Logger.Handle
into something like a resource pool, from which you could request a new concrete logging interface to log things. It really depends on your use case in the end…↩
The slides can be found here.
It’s a talk aimed towards beginners. If you are writing a mediumsized Haskell application for the very first time, you will typically end up with three modules: Types.hs
, Utils.hs
and Main.hs
. While this is a very clear split, it typically doesn’t scale very well as applications become larger.
I try to answer some questions like:
Thanks again to Skills Matter for putting together this excellent conference.
]]>This is a small writeup of a fun Haskell project that Andras Slemmer, Francesco Mazzoli and I worked on during ZuriHac 2017.
I work with Haskell professionally, and it can be hard to motivate myself to work on similar stuff during Hackathons. This year I also had a large part in organising the Hackathon, so there was little room to take on a serious project.
This is why I joined in the fun of of creating a deliberately silly thing during this Hackathon (aside from still trying to help people out as much as possible).
This year, we decided to implement something in the style of Twitch Plays Pokémon. Rather than picking a slow, turnbased game such as Pokémon, however, we wanted to try the same thing for a fast game, such as a platformer.
For the impatient, here is a quick preview:
Here is the video I actually meant to upload but twitter cropped. #zuriHac plays Mario pic.twitter.com/Ku76aH0OpN
— cocharles (@acid2) June 12, 2017
The core design question of the project is how to handle keypresses and aggregate them when you have many concurrent users. Twitch Plays Pokémon solved this problem in two distinct modes:
Anarchy mode (the default): any user keypress is sent directly to the game.
Democracy mode: there is a voting window, after which the most popular user keypress is selected and sent to the game.
With a majority vote, players could switch between the modes.
There are a bunch of reasons why this does not work great for faster games:
Action games typically need you to hold a key for a certain amount of time, rather than just pressing and then releasing the key (e.g. Mario jumps higher if you hold jump
for longer).
There’s little time to switch between modes in a fastpaced game.
Many games require you to press more than one key at the same time (e.g. jump
and right
in Mario).
…
We solved this by putting a key voting algorithm in place to aggregate the key events from the users. We think our algorithm should work well with most games, if the parameters are tweaked a bit.
First, imagine that we are looking at every key independently. For a given key, we might receive the following input from users, where a block means that the key is pressed:
We divide the time in sample intervals. The length of the sample interval can be tweaked per game. Let’s imagine it is 10ms for our example.
Every key press is expanded to match the sample interval first. This gives us something like:
We can aggregate them according to a treshold. This is another parameter that can be tweaked per game. In our example, we can set this treshold to 0.5. This means that 50% of users must be pressing a key before we consider it pressed. Concretely, for our 3 users, that means that at least two people must be pressing the key. This gives us the following aggregates:
After we’ve aggregated the key presses, we can send the result to the game. It’s important to note that this happens one sample interval after the actual user keypresses, since you are not easily able to make any conclusions before the interval has ended. This adds some latency but we didn’t find this a problem in practice for the games we tried.
Apart from that, we added to more complications to make the experience smoother:
We look at all keys independently using the algorithm above, but before we decide on the final output, we take key groups into account.
In Super Mario World, if you press left
and right
at the same time, Mario does not move. That is a problem: if the treshold i set to 0.2, 30% of people are pressing left
, and 40% of people are pressing right
, we would expect Mario to move right. However, using our naive algorithm, nothing happens.
This is why we added key groups. A key group is a set of keys out of which at most one can be pressed. For example, {left, right}
forms such a key group for Mario. We select the most popular key if there are multiple candidates within a group (right
in the example).
There is a timeout timer for activity per user. If the user does not press a key in a while, he is considered inactive, and this user is not counted towards the total amount of users. This prevents people from loading the page up but not participating from influencing the game too much.
That takes care of the key logic component, so now let’s look at the stack.
It’s all pretty selfexplanatory:
Users open an HTML page which contains a JavaScript keylogger. We send the KeyPress
and KeyRelease
events to the server. On mobile, people can use a touchscreen interface which sends the same events.
The server runs the key voting algorithm we discussed before and sends the aggregated KeyPress
and KeyRelease
events to any connected sinks.
The main sink we implemented just executes the events using the XTestFakeInput
call from xtest. In our case, the sink ran on the same machine as the server (my laptop).
We played Super Mario World with around 60 people on local WiFi. We required 40% of people to press a key for the voting, in 10ms sampling windows. The system performed very smoothly, although the same cannot be said about the collaboration between users.
Thanks for joining in the fun! The code for our project can be found here.
]]>Collaborative Mario at @ZuriHac #zurihac2017 fun! :) pic.twitter.com/6h3ulZRoZH
— Simon Thompson (@thompson_si) June 11, 2017
Haskell is very commonly used to implement DSLs. When you implement one of these DSLs, the focus is usually performance or correctness. Something that’s not mentioned often is the “quality” of error messages.
In this talk I talked through some techniques to improve various kinds (parser, renamer, modules, interpreter, typechecker) of error messages and discuss how that impacts user experience.
The recording can be watched on their website. Unfortunately I cannot embed it here, but at least you can watch it without creating an account.
The slides can be found here.
]]>Today, I released version 0.11 of the Haskell websockets library. Minor changes include:
But most importantly, this release adds support for the permessagedeflate
extension as described in RFC 7692. A big thanks go out to Marcin Tolysz who first submitted patches for an implementation. Unfortunately, merging these patches turned out to be a rocky road.
After merging all these changes and improving upon them, I’m very happy that the library now passes the Autobahn Testsuite. This languageagnostic testsuite is very extensive and contains test cases covering most of the protocol surface.
When I started running this testsuite against the websockets library, it was very encouraging to learn that – apart from a few corner cases – it was already passing most of this testsuite without any additional work.
The majority of failing tests were caused by the problem that the Haskell websockets library was too lenient: it would accept invalid UTF8 characters when reading the messages as a ByteString
. The RFC, however, dictates that a server should immediately close the connection if the client sends invalid UTF8.
This has now been rectified, but as an optin, in order not to break any existing applications using this library. For example, in order to enable the new compression and UTF8 validation, you can use something like:
main :: IO ()
main = WS.runServerWith "0.0.0.0" 9001 options application
where
options = WS.defaultConnectionOptions
{ WS.connectionCompressionOptions =
WS.PermessageDeflateCompression WS.defaultPermessageDeflate
, WS.connectionStrictUnicode = True
}
Note that if you are already decoding the incoming messages to Text
values through the WebSocketsData
interface, enabling connectionStrictUnicode
should not add any additional overhead. On the other hand, if your application is a proxy which just takes the ByteString
s and sends them through, enabling UTF8 validation will of course come at a price.
In a future release, permessagedeflate
will be enabled by default.
I realise that this blog has been a little quiet lately. This is because (aside from work being busy) I’ve been involved in some other things:
I have been coorganising Summer of Haskell 2017. If you are a student, and you would like to make some money while contributing to the Haskell ecosystem this summer, please think about applying. If you are a (Haskell) project maintainer and you would like to mentor a student, please consider adding an idea for a proposal.
I am also coorganising ZuriHac 2017. It looks like this event will be the largest Haskell Hackathon ever, with over 250 participants. Unfortunately, the event is now full, but if you’re interested you can still register – we will add you to the waiting list. We’ve seen about 10% cancellations each year, so there is still a good chance of getting into the event.
Lastly, I have been playing the new Zelda game, which has of course been a blast.
This post is about Haskell, and lazy I/O in particular. It is a bit longer than usual, so I will start with a highlevel overview of what you can expect:
We talk about how we can represent graphs in a “shallow embedding”. This means we will not use a dedicated Graph
type and rather represent edges by directly referencing other Haskell values.
This is a fairly good match when we want to encode infinite ^{1} graphs. When dealing with infinite graphs, there is no need to “reify” the graph and enumerate all the nodes and egdes – this would be futile anyway.
We discuss a Haskell implementation of shortest path search in a weighted graph that works on these infinite graphs and that has good performance characteristics.
We show how we can implement lazy I/O to model infinite graphs as pure values in Haskell, in a way that only the “necessary” parts of the graph are loaded from a database. This is done using the unsafeInterleaveIO
primitive.
Finally, we discuss the disadvantages of this approach as well, and we review some of common problems associated with lazy I/O.
Let’s get to it!
As usual, this is a literate Haskell file, which means that you can just load this blogpost into GHCi and play with it. You can find the raw .lhs
file here.
import Control.Concurrent.MVar (MVar, modifyMVar, newMVar)
import Control.Monad (forM_, unless)
import Control.Monad.State (State, gets, modify, runState)
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HMS
import qualified Data.HashPSQ as HashPSQ
import Data.Monoid ((<>))
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Database.SQLite.Simple as SQLite
import qualified System.IO.Unsafe as IO
As an example problem, we will look at finding the shortest path between cities in Westeros, the fictional location where the A Song of Ice and Fire novels (and HBO’s Game of Thrones) take place.
We model the different cities in a straightforward way. In addition to a unique ID used to identify them, they also have a name, a position (X,Y coordinates) and a list of reachable cities, with an associated time (in days) it takes to travel there. This travel time, also referred to as the cost, is not necessarily deducable from the sets of X,Y coordinates: some roads are faster than others.
data City = City
{ cityId :: CityId
, cityName :: T.Text
, cityPos :: (Double, Double)
, cityNeighbours :: [(Double, City)]
}
Having direct access to the neighbouring cities, instead of having to go through CityId
s both has advantages and disadvantages.
On one hand, updating these values becomes cumbersome at best, and impossible at worst. If we wanted to change a city’s name, we would have to traverse all other cities to update possible references to the changed city.
On the other hand, it makes access more convenient (and faster!). Since we want a readonly view on the data, it works well in this case.
We will be using data extracted from got.show, conveniently licensed under a Creative Commons license. You can find the complete SQL dump here. The schema of the database should not be too surprising:
CREATE TABLE cities (
id text PRIMARY KEY NOT NULL,
name text NOT NULL,
x float NOT NULL,
y float NOT NULL
);
CREATE TABLE roads (
origin text NOT NULL,
destination text NOT NULL,
cost float NOT NULL,
PRIMARY KEY (origin, destination)
);
CREATE INDEX roads_origin ON roads (origin);
The road costs have been generated by multiplying the actual distances with a random number uniformly chosen between 0.6
and 1.4
. Cities have been (bidirectionally) connected to at least four closest neighbours. This ensures that every city is reachable.
We will use sqlite in our example because there is almost no setup involved. You can load this database by issueing:
But instead of considering the whole database (which we’ll get to later), let’s construct a simple example in Haskell so we can demonstrate the interface a bit. We can use a let
to create bindings that refer to one another easily.
test01 :: IO ()
test01 = do
let winterfell = City "wtf" "Winterfell" (105, 78)
[(13, moatCailin), (12, whiteHarbor)]
whiteHarbor = City "wih" "White Harbor" (96, 74)
[(15, braavos), (12, winterfell)]
moatCailin = City "mtc" "Moat Cailin" (104, 72)
[(20, crossroads), (13, winterfell)]
braavos = City "brv" "Braavos" (43, 67)
[(17, kingsLanding), (15, whiteHarbor)]
crossroads = City "crs" "Crossroads Inn" (94, 58)
[(7, kingsLanding), (20, crossroads)]
kingsLanding = City "kgl" "King's Landing" (84, 45)
[(7, crossroads), (17, kingsLanding)]
printSolution $
shortestPath cityId cityNeighbours winterfell kingsLanding
printSolution
is defined as:
printSolution :: Maybe (Double, [City]) > IO ()
printSolution Nothing = T.putStrLn "No solution found"
printSolution (Just (cost, path)) = T.putStrLn $
"cost: " <> T.pack (show cost) <>
", path: " <> T.intercalate " > " (map cityName path)
We get exactly what we expect in GHCi
:
*Main> test01
cost: 40.0, path: Winterfell > Moat Cailin >
Crossroads Inn > King's Landing
So far so good! Now let’s dig in to how shortestPath
works.
The following algorithm is known as Uniform Cost Search. It is a variant of Dijkstra’s graph search algorithm that is able to work with infinite graphs (or graphs that do not fit in memory anyway). It returns the shortest path between a known start and goal in a weighted directed graph.
Because this algorithm attempts to solve the problem the right way, including keeping back references, it is not simple. Therefore, if you are only interested in the part about lazy I/O, feel free to skip to this section and return to the algorithm later.
We have two auxiliary datatypes.
BackRef
is a wrapper around a node and the previous node on the shortest path to the former node. Keeping these references around is necessary to iterate a list describing the entire path at the end.
We will be using a State
monad to implement the shortest path algorithm. This is our state:
data SearchState node key cost = SearchState
{ ssQueue :: HashPSQ.HashPSQ key cost (BackRef node)
, ssBackRefs :: HMS.HashMap key node
}
In our state, we have:
A priority queue of nodes we will visit next in ssQueue
, including back references. Using a priority queue will let us grab the next node with the lowest associated cost in a trivial way.
Secondly, we have the ssBackRefs
map. That one serves two purposes: to keep track of which nodes we have already explored (the keys in the map), and to keep the back references of those locations (the values in the map).
These two datatypes are only used internally in the shortestPath
function. Ideally, we would be able to put them in the where
clause, but that is not possible in Haskell.
Instead of declaring a Node
typeclass (possibly with associated types for the key and cost types), I decided to go with simple higherorder functions. We only need two of those function arguments after all: a function to give you a node’s key (nodeKey
) and a function to get the node’s neighbours and associated costs (nodeNeighbours
).
shortestPath
:: forall node key cost.
(Ord key, Hashable key, Ord cost, Num cost)
=> (node > key)
> (node > [(cost, node)])
> node
> node
> Maybe (cost, [node])
shortestPath nodeKey nodeNeighbours start goal =
We start by creating an initial SearchState
for our algorithm. Our initial queue holds one item (implying that we need explore the start
) and our initial back references map is empty (we haven’t explored anything yet).
let startbr = BackRef start start
queue0 = HashPSQ.singleton (nodeKey start) 0 startbr
backRefs0 = HMS.empty
searchState0 = SearchState queue0 backRefs0
walk
is the main body of the shortest path search. We call that and if we found a shortest path, we return its cost together with the path which we can reconstruct from the back references (followBackRefs
).
(mbCost, searchState1) = runState walk searchState0 in
case mbCost of
Nothing > Nothing
Just cost > Just
(cost, followBackRefs (ssBackRefs searchState1))
where
Now, we have a bunch of functions that are used within the algorithm. The first one, walk
, is the main body. We start by exploring the next node in the queue. By construction, this is always a node we haven’t explored before. If this node is the goal, we’re done. Otherwise, we check the node’s neighbours and update the queue with those neighbours. Then, we recursively call walk
.
walk :: State (SearchState node key cost) (Maybe cost)
walk = do
mbNode < exploreNextNode
case mbNode of
Nothing > return Nothing
Just (cost, curr)
 nodeKey curr == nodeKey goal >
return (Just cost)
 otherwise > do
forM_ (nodeNeighbours curr) $ \(c, next) >
updateQueue (cost + c) (BackRef next curr)
walk
Exploring the next node is fairly easy to implement using a priority queue: we simply need to pop the element with the minimal priority (cost) using minView
. We also need indicate that we reached this node and save the back reference by inserting that info into ssBackRefs
.
exploreNextNode
:: State (SearchState node key cost) (Maybe (cost, node))
exploreNextNode = do
queue0 < gets ssQueue
case HashPSQ.minView queue0 of
Nothing > return Nothing
Just (_, cost, BackRef curr prev, queue1) > do
modify $ \ss > ss
{ ssQueue = queue1
, ssBackRefs =
HMS.insert (nodeKey curr) prev (ssBackRefs ss)
}
return $ Just (cost, curr)
updateQueue
is called as new neighbours are discovered. We are careful about adding new nodes to the queue:
ssBackRefs
.insertIfLowerPrio
, which is defined below. updateQueue
:: cost > BackRef node > State (SearchState node key cost) ()
updateQueue cost backRef = do
let node = brNode backRef
explored < gets ssBackRefs
unless (nodeKey node `HMS.member` explored) $ modify $ \ss > ss
{ ssQueue = insertIfLowerPrio
(nodeKey node) cost backRef (ssQueue ss)
}
If the algorithm finishes, we have found the lowest cost from the start to the goal, but we don’t have the path ready. We need to reconstruct this by following the back references we saved earlier. followBackRefs
does that for us. It recursively looks up nodes in the map, constructing the path in the accumulator acc
on the way, until we reach the start.
followBackRefs :: HMS.HashMap key node > [node]
followBackRefs paths = go [goal] goal
where
go acc node0 = case HMS.lookup (nodeKey node0) paths of
Nothing > acc
Just node1 >
if nodeKey node1 == nodeKey start
then start : acc
else go (node1 : acc) node1
That’s it! The only utility left is the insertIfLowerPrio
function. Fortunately, we can easily define this using the alter
function from the psqueues package. That function allows us to change a key’s associated value and priority. It also allows to return an additional result, but we don’t need that, so we just use ()
there.
insertIfLowerPrio
:: (Hashable k, Ord p, Ord k)
=> k > p > v > HashPSQ.HashPSQ k p v > HashPSQ.HashPSQ k p v
insertIfLowerPrio key prio val = snd . HashPSQ.alter
(\mbOldVal > case mbOldVal of
Just (oldPrio, _)
 prio < oldPrio > ((), Just (prio, val))
 otherwise > ((), mbOldVal)
Nothing > ((), Just (prio, val)))
key
Lazy I/O will guarantee that we only load the nodes in the graph when necessary.
However, since we know that the nodes in the graph do not change over time, we can build an additional cache around it. That way, we can also guarantee that we only load every node once.
Implementing such a cache is very simple in Haskell. We can simply use an MVar
, that will even take care of blocking ^{2} when we have concurrent access to the cache (assuming that is what we want).
cached :: (Hashable k, Ord k) => Cache k v > k > IO v > IO v
cached mvar k iov = modifyMVar mvar $ \cache > do
case HMS.lookup k cache of
Just v > return (cache, v)
Nothing > do
v < iov
return (HMS.insert k v cache, v)
Note that we don’t really delete things from the cache. In order to keep things simple, we can assume that we will use a new cache for every shortest path we want to find, and that we throw away that cache afterwards.
Now, we get to the main focus of the blogpost: how to use lazy I/O primitives to ensure resources are only loaded when they are needed. Since we are only concerned about one datatype (City
) our loading code is fairly easy.
The most important loading function takes the SQLite connection, the cache we wrote up previously, and a city ID. We immediately use the cached
combinator in the implementation, to make sure we load every CityId
only once.
getCityById
:: SQLite.Connection > Cache CityId City > CityId
> IO City
getCityById conn cache id' = cached cache id' $ do
Now, we get some information from the database. We play it a bit loose here and assume a singleton list will be returned from the query.
The neighbours are stored in a different table because we have a properly normalised database. We can write a simple query to obtain all roads starting from the current city:
roads < SQLite.query conn
"SELECT cost, destination FROM roads WHERE origin = ?"
[id'] :: IO [(Double, CityId)]
This leads us to the crux of the matter. The roads
variable contains something of the type [(Double, CityId)]
, and what we really want is [(Double, City)]
. We need to recursively call getCityById
to load what we want. However, doing this “the normal way” would cause problems:
IO
monad is strict, we would end up in an infinite loop if there is a cycle in the graph (which is almost always the case for roads and cities).MVar
in the Cache
. We block access to the Cache
while we are in the cached
combinator, so calling getCityById
again would cause a deadlock.This is where Lazy I/O shines. We can implement lazy I/O by using the unsafeInterleaveIO primitive. Its type is very simple and doesn’t look as threatening as unsafePerformIO
.
unsafeInterleaveIO :: IO a > IO a
It takes an IO
action and defers it. This means that the IO
action is not executed right now, but only when the value is demanded. That is exactly what we want!
We can simply wrap the recursive calls to getCityById
using unsafeInterleaveIO
:
And then return the City
we constructed:
Lastly, we will add a quickanddirty wrapper around getCityById
so that we are also able to load cities by name. Its implementation is trivial:
getCityByName
:: SQLite.Connection > Cache CityId City > T.Text
> IO City
getCityByName conn cache name = do
[[id']] < SQLite.query conn
"SELECT id FROM cities WHERE name = ?" [name]
getCityById conn cache id'
Now we can neatly wrap things up in our main
function:
main :: IO ()
main = do
cache < newCache
conn < SQLite.open "got.db"
winterfell < getCityByName conn cache "Winterfell"
kings < getCityByName conn cache "King's Landing"
printSolution $
shortestPath cityId cityNeighbours winterfell kings
This works as expected:
*Main> :main
cost: 40.23610549037591, path: Winterfell > Moat Cailin >
Greywater Watch > Inn of the Kneeling Man > Fairmarket >
Brotherhood Without Banners Hideout > Crossroads Inn >
Darry > Saltpans > QuietIsle > Antlers > Sow's Horn >
Brindlewood > Hayford > King's Landing
Lazy I/O also has many disadvantages, which have been widely discussed. Among those are:
Code becomes harder to reason about. In a setting without lazy I/O, you can casually reason about an Int
as either an integer that’s already computed, or as something that will do some (pure) computation and then yield an Int
.
When lazy I/O enters the picture, things become more complicated. That Int
you wanted to print? Yeah, it fired a bunch of missiles and returned the bodycount.
This is why I would not seriously consider using lazy I/O when working with a team or on a large project – it can be easy to forget what is lazily loaded and what is not, and there’s no easy way to tell.
Scarce resources can easily become a problem if you are not careful. If we keep a reference to a City
in our heap, that means we also keep a reference to the cache and the SQLite connection.
We must ensure that we fully evaluate the solution to something that doesn’t refer to these resources (to e.g. a printed string) so that the references can be garbage collected and the connections can be closed.
Closing the connections is a problem in itself – if we cannot guarantee that e.g. streams will be fully read, we need to rely on finalizers, which are pretty unreliable…
If we go a step further and add concurrency to our application, it becomes even tricker. Deadlocks are not easy to reason about – so how about reasoning about deadlocks when you’re not sure when the IO
is going to be executed at all?
Despite all these shortcomings, I believe lazy I/O is a powerful and elegant tool that belongs in every Haskeller’s toolbox. Like pretty much anything, you need to be aware of what you are doing and understand the advantages as well as the disadvantages.
For example, the above downsides do not really apply if lazy I/O is only used within a module. For this blogpost, that means we could safely export the following interface:
shortestPathBetweenCities
:: FilePath  ^ Database name
> CityId  ^ Start city ID
> CityId  ^ Goal city ID
> IO (Maybe (Double, [CityId]))  ^ Cost and path
shortestPathBetweenCities dbFilePath startId goalId = do
cache < newCache
conn < SQLite.open dbFilePath
start < getCityById conn cache startId
goal < getCityById conn cache goalId
case shortestPath cityId cityNeighbours start goal of
Nothing > return Nothing
Just (cost, path) >
let ids = map cityId path in
cost `seq` foldr seq () ids `seq`
return (Just (cost, ids))
Thanks for reading – and I hope I was able to offer you a nuanced view on lazy I/O. Special thanks to Jared Tobin for proofreading.
In this blogpost, I frequently talk about “infinite graphs”. Of course most of these examples are not truly infinite, but we can consider examples that do not fit in memory completely, and in that way we can regard them as “infinite for practical purposes”.↩
While blocking is good in this case, it might hurt performance when running in a concurrent environment. A good solution to that would be to stripe the MVar
s based on the keys, but that is beyond the scope of this blogpost. If you are interested in the subject, I talk about it a bit here.↩
Parsec makes it really easy to prototype parsers for certain classes of grammars. Lots of grammars in use today, however, are whitespacesensitive. There are different approaches for dealing with that. One of the most commonly used approaches is to add explicit INDENT
and DEDENT
tokens. But that usually requires you to add a separate lexing phase – not a bad idea by itself, but a bit annoying if you are just writing a quick prototype.
That is why I like the indents package – it sits in a sweet spot because it is a straightforward package that allows you turn any Parsec parser into an indentationbased one without having to change too many types.
It offers a bunch of semicryptic operators like <+/>
and <*/>
which I would personally avoid in favor of their named variants, but other than that I would consider it a fairly “easy” package.
Unfortunately, I found a few bugs an inconveniences in the old package. One interesting bug would allow failing branches of the parse to still affect the indentation’s internal state, which is very bad ^{1}. Additionally, the package fixed the underlying monad, which prevented you from using transformers.
Because I didn’t want to confuse people by creating yet another package, I took over the package which is a very smooth process nowadays. I can definitely recommend this to anyone who discovers issues like these in unmaintained packages. The hackage trustees are doing great and valuable work there.
I have now uploaded a new version which fixes these issues. To celebrate that, let’s create a toy parser for indentationsensitive taxonomies such as the big tea taxonomy ^{2}:
tea
green
korean
puchocha
chungcha
vietnamese
snowgreentea
japanese
roasted
...
black
georgian
traditional
caravanblend
african
kenyan
tanzanian
...
We need some imports to get rolling. After all, this blogpost is a literate haskell file which can be loaded in GHCi
.
import Control.Applicative ((*>), (<*), (<>))
import qualified Text.Parsec as Parsec
import qualified Text.Parsec.Indent as Indent
We just store a single term in the category as a String
.
A taxonomy is then recursively defined as a Term
and its children taxonomies.
A parser for a term is easy. We just parse an identifier and then skip the spaces following that.
pTerm :: Indent.IndentParser String () String
pTerm =
Parsec.many1 allowedChar <* Parsec.spaces
where
allowedChar = Parsec.alphaNum <> Parsec.oneOf "."
In the parser for a Taxonomy
, we use the indents
library. withPos
is used to “remember” the indentation position. After doing that, we can use combinators such as indented
to check if we are indented past that point.
pTaxonomy :: Indent.IndentParser String () Taxonomy
pTaxonomy = Indent.withPos $ do
term < pTerm
subs < Parsec.many $ Indent.indented *> pTaxonomy
return $ Taxonomy term subs
Now we have a simple main to function to put it all together;
readTaxonomy :: FilePath > IO Taxonomy
readTaxonomy filePath = do
txt < readFile filePath
let errOrTax = Indent.runIndentParser parser () filePath txt
case errOrTax of
Left err > fail (show err)
Right tax > return tax
where
parser = pTaxonomy <* Parsec.eof
And we can verify that this works in GHCi:
*Main> readTaxonomy "taxonomy.txt"
Taxonomy "tea" [Taxonomy "green" [Taxonomy "korean" [...
*Main>
Special thanks to Sam Anklesaria for writing the original package.
The interesting tea taxonomy can be found in this blogpost: https://jameskennedymonash.wordpress.com/mindmaps/amazingteataxonomy/.↩