## Don’t Eff It Up

I gave a talk at BayHac titled “Don’t Eff It Up: Freer Monads in Action”. As promised, I’ve posted the slides online here. A huge thanks to everyone who attended!

\[\definecolor{b}{RGB}{100,50,255} \definecolor{r}{RGB}{0,0,0} \color{b}\sum\]

**Sigma**: Denotes repeated addition of something. Sigma comes in two major varieties:

\[ \color{b} \sum_{i=1}^{4} 2\times i \color{r} = 2\times 1 + 2\times 2 + 2\times 3 + 2\times 4 \]

and

\[ \color{b} \sum_{m\in S} m \]

where \(S\) is any set.

**Pi**: Like `Sigma`

, but describes repeated multiplication rather than addition.

\[ \color{b} \prod_{i=1}^{4} i \color{r} = 1\times 2\times 3\times 4\]

Comes in the same flavors as `Sigma`

.

I have a sinful, guilty pleasure – I like a sports video-game: NBA Jam Tournament Edition. Regrettably, I don’t own a copy, and all of my attempts to acquire one have ended in remarkable misfortune.

Obviously my only recourse was to make a tribute game that I could play to my heart’s desire.

And so that’s what I set out to do, back in 2013. My jam-loving then-coworker and I drafted up the barest constituent of a design document, and with little more thought about the whole thing we dove right in.

We “decided” on Python as our language of choice, and off we went. There was no game engine, so we rolled everything by hand: drawing, collision, you name it. We got a little demo together, and while it was definitely basketball-like, it certainly wasn’t a game. Eventually my partner lost interest, and the code sits mostly forgotten in the back recesses of my Github repositories.

I say mostly forgotten because over the last three years, I’ve occasionally spent a sleepless night here or there working on it, slowly but surely turning midnight fuel into reality.

Three years is a long time to spend on a toy project, and it’s an even longer amount of time for a junior engineer’s sensibilities to stay constant. As I learned more and more computer science tools, I found myself waging a constant battle against Python. The details aren’t important, but it was consistently a headache in order to get the language to allow me to express the things I wanted to. It got to the point where I stopped work entirely on the project due to it no longer being fun.

But this basketball video-game of mine was too important to fail, and so I came up with a solution.

If you’re reading this blog, you probably already know what the solution to my problem was – I decided to port the game over to Haskell. Remarkable progress was made: within a few days I had the vast majority of it ported. At first my process looked a lot like this:

- Read a few lines of Python.
- Try to understand what they were doing.
- Copy them line-by-line into Haskell syntax.

and this worked well enough. If there were obvious improvements that could be made, I would do them, but for the most part, it was blind and mechanical. At time of writing I have a bunch of magical constants in my codebase that I dare not change.

However, when I got to the collision resolution code, I couldn’t in good conscience port the code. It was egregious, and would have been an abomination upon all that is good and holy if that imperative mess made it into my glorious new Haskell project.

The old algorithm was like so:

- Attempt to move the capsule
^{1}to the desired location. - If it doesn’t intersect with any other capsules, 👍.
- Otherwise, perform a sweep from the capsule’s original location to the desired location, and stop at the point just before it would intersect.
- Consider the remaining distance a “force” vector attempting to push the other capsule out of the way.
- Weight this force by the mass of the moving capsule relative to the total weight of the capsules being resolved.
- Finish moving the capsule by its share of weighted force vector.
- Recursively move all capsules it intersects with outwards by their shares of the remaining force.

I mean, it’s not the greatest algorithm, but it was fast, simple, and behaved well-enough that I wasn’t going to complain.

Something you will notice, however, is that this is definitively *not* a functional algorithm. It’s got some inherent state in the position of the capsules, but also involves directly moving other capsules out of your way.

Perhaps more worryingly is that in aggregate, the result of this algorithm isn’t necessarily deterministic – depending on the order in which the capsules are iterated we may or may not get different results. It’s not an apocalyptic bug, but you have to admit that it is semantically annoying.

I spent about a week mulling over how to do a better (and more functional) job of resolving these physics capsules. The key insight was that at the end of the day, the new positions of all the capsules depend on the new (and old) positions of all of the other capsules.

When phrased like that, it sounds a lot like we’re looking for a comonad, doesn’t it? I felt it in my bones, but I didn’t have enough comonadic kung-fu to figure out what this comonad must actually look like. I was stumped – nothing I tried would simultaneously solve my problem and satisfy the comonadic laws.

Big shout-outs to Rúnar Bjarnason for steering me into the right direction: what I was looking for was not in fact a comonad (a data-type with a `Comonad`

instance), but instead a *specific* Cokleisli arrow (a function of type `Comonad w => w a -> b`

).

Comonadic co-actions such as these can be thought of the process of answering some query `b`

about an `a`

in some context `w`

. And so, in my case, I was looking for the function `w Capsule -> Capsule`

, with some `w`

suitable to the cause. The `w Capsule`

obviously needed the semantics of “be capable of storing all of the relevant `Capsule`

s.” Implicitly in these semantics are that `w`

need also have a *specific* `Capsule`

under focus^{2}.

To relieve the unbearable tension you’re experience about what comonad `w`

is, it’s a `Store`

. If you’re unfamiliar with `Store`

:

`data Store s a = Store s (s -> a)`

which I kind of think of as a warehouse full of `a`

s, ordered by `s`

es, with a forklift that drives around but is currently ready to get a particular `a`

off the shelves.

With all of this machinery in place, we’re ready to implement the Cokleisli arrow, `stepCapsule`

, for resolving physics collisions. The algorithm looks like this:

- For each other object
`:: s`

, extract its capsule from the`Store`

. - Filter out any which are not intersecting with the current capsule.
- Model these intersecting capsules as a spring-mass system, and have each other object exert a displacement “force” exactly necessary to make the two objects no longer collide (weighted by their relative masses).
- Sum these displacement vectors, and add it to the current capsule’s position.

This algorithm is easy to think about: all it does is compute the new location of a particular capsule. Notice that it explicitly *doesn’t* attempt to push other capsules out of its way.

And here’s where the magic comes in. We can use the comonadic co-bind operator `extend :: (w a -> b) -> w a -> w b`

to lift our “local”-acting function `stepCapsule`

over all the capsules simultaneously.

There’s only one problem left. While `extend stepCapsule`

ensures that if any capsules were previously colliding no longer do, it doesn’t enforce that the newly moved capsules don’t collide with something new!

Observe of the algorithm that if no objects are colliding, no objects will be moved after running `extend stepCapsule`

over them. And this is in fact just the trick we need! If we can find a fix point of resolving the capsules, that fix point must have the no-collisions invariant we want.

However, notice that this is not the usual least-fixed point we’re used to dealing with in Haskell (`fix`

). What we are looking for is an iterated fixed point:

```
iterFix :: Eq a => (a -> a) -> a -> a
iterFix f = head . filter (==) . ap zip tail . iterate f
```

And voila, `iterFix (unpack . extend stepCapsule . pack)`

is our final, functional solution to resolving collisions. It’s surprisingly elegant, especially when compared to my original imperative solution. For bonus points, it feels *a lot* like the way I understand actual real-life physics to work: somehow running a local computation everywhere, simultaneously.

While time forms a monad, physics forms a comonad. At least in this context.

Last night something strange happened. For a brief moment, the internet somehow thought that my criticism of Elm was more important to discuss than the presidential election, because it was at the #1 spot on Hacker News. I’m not 100% sure how things end up at the #1 spot on Hacker News, but it sounds like a pretty desirable place to be.

My traffic yesterday was up three orders of magnitude from its average, so it seems like now’s as good a time as any to announce my new project:

I’m writing a book! It’s a gentle introduction to computer science, from first principles of electronics to category theory. If that sounds like the kind of thing you might be into, you can find it here.

To be honest with you, my approach to procedurally generating RPG stories has been stymied until very recently. Recall the command functor:

```
data StoryF a = Change Character ChangeType (ChangeResult -> a)
| forall x y. Interrupt (Free StoryF x) (Free StoryF y) (y -> a)
| -- whatever else
```

This recursively defined `Interrupt`

command has caused more than its fare share of grief. The idea is that it should represent one potential line of action being interrupted by another. The semantics are rather hazy, but this should result in grafting the `Free StoryF y`

monad somewhere inside of the `Free StoryF x`

monad. Once we’ve done whatever analysis on the original story, we can then forget that the `Interrupt`

bit was ever there in the first place.

In effect, we want this:

```
data StoryF' a = Change Character ChangeType (ChangeResult -> a)
| -- whatever else
runInterrupt :: StoryF a -> StoryF' a
runInterrupt = -- ???
```

where `runInterrupt`

’s job is to remove any instances of the `Interrupt`

command from our story – replacing them with the “canonical” version of what actually happened.

Of course, we could just remove all of the `Interrupt`

data constructors from our `Free StoryF a`

object, and rely on convention to keep track of that for us. However, if you’re like me, whenever the phrase “by convention” is used, big alarm bells should go off in your head. Convention isn’t enforced by the compiler, and so anything maintained “by convention” is highly suspect to bugs.

What would make our lives better is if we could define `StoryF`

and `StoryF'`

somehow in terms of one another, so that there’s no hassle to keep them in sync with one another. Even better, in the future, maybe we’ll want to remove or add other constructors as we interpret our story.

What we really want to be able to do is to mix and match individual constructors into one larger data structure, which we can then transform as we see fit.

Fortunately for us, the machinery for this has already been built. It’s Swierstra’s Data Types a la Carte (henceforth DTalC) – essentially a set of combinators capable of composing data types together, and tools for working with them in a manageable way.

Unfortunately for us, Data Types a la Carte isn’t as type-safe as we’d like it to be. ~~Additionally, it’s missing (though not ~~*fundamentally*) the primitives necessary to remove constructors.^{1}

This post presents a variation of DTalC which *is* type-safe, and contains the missing machinery.

But first, we’ll discuss DTalC as it is described in the original paper, in order to get a feeling for the approach and where the problems might lie. If you know how DTalC works already, consider skipping to the next heading.

Data Types a la Carte presents a novel strategy for building data types out of other data types with kind^{2} `* -> *`

. A code snippet is worth a thousand words, so let’s dive right in. Our `StoryF`

command functor as described above would instead be represented like this:

```
data ChangeF a = Change Character ChangeType (ChangeResult -> a)
data InterruptF a = forall x y.
Interrupt (Free StoryF x) (Free StoryF y) (y -> a)
type StoryF = ChangeF :+: InterruptF
```

Here, `(:+:)`

is the type operator which composes data types together into a sum type (there is a corresponding `(:*:)`

for products, but we’re less interested in it today.)

Because the kindedness of `(:+:)`

lines up with that of the data types it combines, we can nest `(:+:)`

arbitrarily deep:

`type Something = Maybe :+: Either Int :+: (,) Bool :+: []`

In this silly example, `Something a`

*might* be any of the following:

`Maybe a`

`Either Int a`

`(Bool, a)`

`[a]`

but we can’t be sure which. We will arbitrary decide that `(:+:)`

is right-associative – although it doesn’t matter in principle (sums are monoidal), part of our implementation will depend on this fact.

Given a moment, if you’re familiar with Haskell, you can probably figure out what the machinery must look like:

```
data (f :+: g) a = InL (f a)
| InR (g a)
deriving Functor
infixr 8 :+:
```

`(:+:)`

essentially builds a tree of data types, and then you use some combination of `InL`

and `InR`

to find the right part of the tree to use.

However, in practice, this becomes annoyingly painful and tedious; adding new data types can completely shuffle around your internal tree structure, and unless you’re careful, things that used to compile will no longer.

But fear not! Swierstra has got us covered!

```
class (Functor sub, Functor sup) => sub :<: sup where
inj :: sub a -> sup a
```

This class (and its instances) say that `f :<: fs`

means that the data type `f`

is nestled somewhere inside of the big sum type `fs`

. Furthermore, it gives us a witness to this fact, `inj`

, which lifts our small data type into our larger one. With some clever instances of this typeclass, `inj`

will expand to exactly the right combination of `InL`

and `InR`

s.

These instances are:

```
instance Functor f => f :<: f where
inj = id
instance (Functor f, Functor g) => f :<: (f :+: g) where
inj = InL
instance {-# OVERLAPPABLE #-}
(Functor f, Functor g, Functor h, f :<: g) => f :<: (h :+: g) where
inj = InR . inj
```

The first one states “if there’s nowhere left to go, we’re here!”. The second: “if our desired functor is on the left, use `InL`

”. The third is: “otherwise, slap a `InR`

down and keep looking”.

And so, we can now write our smart constructors in the style of:

```
change :: (ChangeF :<: fs) => Character -> ChangeType -> Free fs ChangeResult
change c ct = liftF . inj $ Change c ct id
```

which will create a `Change`

constructor in any data type which supports it (witnessed by `ChangeF :<: fs`

).

Astute readers will notice immediately that the structural induction carried out by `(:<:)`

won’t actually find the desired functor in any sum tree which isn’t right-associative, since it only ever recurses right. This unfortunate fact means that we must be *very careful* when defining DTalC in terms of type aliases.

In other words: **we must adhere to a strict convention in order to ensure our induction will work correctly.**

The problem, of course, is caused by the fact that DTalC can be constructed in ways that the structural induction can’t handle. Let’s fix that by constraining how DTalCs are constructed.

At the same time, we’ll add the missing inverse of `inj`

, namely `outj :: (f :<: fs) => fs a -> Maybe (f a)`

^{3}, which we’ll need later to remove constructors, but isn’t fundamentally restricted in Swiestra’s method.

On the surface, our structural induction problem seems to be that we can only find data types in right-associative trees. But since right-associative trees are isomorphic to lists, the real flaw is that we’re not just using lists in the first place.

With the help of `{-# LANGUAGE DataKinds #-}`

, we can lift lists (among other term-level things) to the type level. Additionally, using `{-# LANGUAGE TypeFamilies #-}`

, we’re able to write *type-level* functions – functions which operate on and return types!

We define a type class with an associated data family:

```
class Summable (fs :: [* -> *]) where
data Summed fs :: * -> *
```

Here `fs`

is a *type*, as is `Summed fs`

. Take notice, however, of the explicit kind annotations: `fs`

is a list of things that look like `Functor`

s, and `Summed fs`

looks like one itself.

Even with all of our fancy language extensions, a type class is still just a type class. We need to provide instances of it for it to become useful. The obvious case is if `fs`

is the empty list:

```
instance Summable '[] where
data Summed '[] a = SummedNil Void
deriving Functor
```

The funny apostrophe in `'[]`

indicates that what we’re talking about is an empty type-level list, rather than the type-constructor for lists. The distinction is at the kind level: `'[] :: [k]`

for all kinds `k`

, but `[] :: * -> *`

.

What should happen if we try to join zero data types together? This is obviously crazy, but since we need to define it to be *something* we make it wrap `Void`

. Since `Void`

doesn’t have any inhabitants at the term-level, it is unconstructible, and thus so too is `SummedNil`

.

But what use case could an unconstructible type possibly have? By itself, nothing, but notice that `Either a Void`

*must* be `Right a`

, since the `Left`

branch can never be constructed. Now consider that `Either a (Either b Void)`

is isomorphic to `Either a b`

, but has the nice property that its innermost data constructor is always `Left`

(finding the `a`

is `Left`

, and finding `b`

is `Right . Left`

).

Let’s move to the other case for our `Summable`

class – when `fs`

isn’t empty:

```
instance Summable (f ': fs) where
data Summed (f ': fs) a = Here (f a)
| Elsewhere (Summed fs a)
```

`Summed`

for a non-empty list is either `Here`

with the head of the list, or `Elsewhere`

with the tail of the list. For annoying reasons, we need to specify that `Summed (f ': fs)`

is a `Functor`

in a rather obtuse way:

```
instance Summable (f ': fs) where
data Summed (f ': fs) a = Functor f => Here (f a)
| Elsewhere (Summed fs a)
{-# LANGUAGE StandaloneDeriving #-}
deriving instance Functor (Summed fs) => Functor (Summed (f ': fs))
```

but this now gives us what we want. `Summed fs`

builds a nested sum-type from a type-level list of data types, and enforces (crucially, *not* by convention) that they form a right-associative list. We now turn our attention to building the `inj`

machinery *a la* Data Types a la Carte:

```
class Injectable (f :: * -> *) (fs :: [* -> *]) where
inj :: f a -> Summed fs a
```

We need to write instances for `Injectable`

. Note that there is no instance `Injectable '[] fs`

, since `Summable '[]`

is unconstructible.

```
instance Functor f => Injectable f (f ': fs) where
inj = Here
instance {-# OVERLAPPABLE #-} Injectable f fs => Injectable f (g ': fs) where
inj = Elsewhere . inj
```

These instances turn out to be *very inspired* by the original DTalC. This should come as no surprise, since the problem was with our construction of `(:+:)`

– which we have now fixed – rather than our induction on `(:<:)`

.

At this point, we could define an alias between `f :<: fs`

and `Injectable f fs`

, and call it a day with guaranteed correct-by-construction data types a la carte, but we’re not quite done yet.

Remember, the original reason we dived into all of this mumbo jumbo was in order to *remove* data constructors from our DTalCs. We can’t do that yet, so we’ll need to set out on our own.

We want a function `outj :: Summed fs a -> Maybe (f a)`

which acts as a prism into our a la carte sum types. If our `Summed fs a`

is constructed by a `f a`

, we should get back a `Just`

– otherwise `Nothing`

. We define the following type class:

```
class Outjectable (f :: * -> *) (fs :: [* -> *]) where
outj :: Summed fs a -> Maybe (f a)
```

with instances that again strongly resemble DTalC:

```
instance Outjectable f (f ': fs) where
outj (Here fa) = Just fa
outj (Elsewhere _) = Nothing
instance {-# OVERLAPPABLE #-} Outjectable f fs => Outjectable f (g ': fs) where
outj (Here _ ) = Nothing
outj (Elsewhere fa) = outj fa
```

The first instance says, “if what I’m looking for is the head of the list, return that.” The other says, “otherwise, recurse on an `Elsewhere`

, or stop on a `Here`

.”

And all that’s left is to package all of these typeclasses into something more easily pushed around:

```
class ( Summable fs
, Injectable f fs
, Outjectable f fs
, Functor (Summed fs)
) => (f :: * -> *) :<: (fs :: [* -> *])
instance ( Summable fs
, Injectable f fs
, Outjectable f fs
, Functor (Summed fs)
) => (f :<: fs)
```

This is a trick I learned from Edward Kmett’s great talk on Monad Homomorphisms, in which you build a class that has all of the right constraints, and then list the same constraints for an instance of it. Adding the new class as a constraint automatically brings all of its dependent constraints into scope; `f :<: fs`

thus implies `Summable fs`

, `Injectable f fs`

, `Outjectable f fs`

, and `Functor (Summed fs)`

in a much more terse manner.

As a good measure, I wrote a test that `outj`

is a left-inverse of `inj`

:

```
injOutj_prop :: forall fs f a. (f :<: fs) => Proxy fs -> f a -> Bool
injOutj_prop _ fa = isJust $ (outj (inj fa :: Summed fs a) :: Maybe (f a))
{-# LANGUAGE TypeApplications #-}
main = quickCheck (injOutj_prop (Proxy @'[ []
, Proxy
, Maybe
, (,) Int
]) :: Maybe Int -> Bool)
```

where we use the `Proxy fs`

to drive type checking for the otherwise hidden `fs`

from the type signature in our property.

And there you have it! Data types a la carte which are guaranteed correct-by-construction, which we can automatically get into and out of. In the next post we’ll look at how rewriting our command functor in terms of DTalC solves all of our `Interrupt`

-related headaches.

A working version of all this code together can be found on my GitHub repository.

EDIT 2016-09-14: After re-reading the paper, it turns out that it describes (though doesn’t implement) this functionality.↩

For the uninitiated, kinds are to types as types are to values – a kind is the “type” of a type. For example,

`Functor`

has kind`* -> *`

because it doesn’t become a real type until you apply a type to it (`Functor Int`

is a type, but`Functor`

isn’t).↩I couldn’t resist the fantastic naming opportunity.↩

We’re slowly making progress towards being able to procedurally generate stories. Last time around we built our first comonad, and could thus provide our first interpretation of a `Story`

. Success!

Unfortunately, not all is blissful in this glorious garden of abstraction we’ve cultivated for ourselves. Something rotten is afoot. Brace yourself for the horror: our semantics are bad.

Recall the definition of our command functor:

```
data StoryF a = Change Character ChangeType (ChangeResult -> a)
| Interrupt (Story ()) (Story ()) a
```

So what’s the problem? Well, if you think about how we’ll use `Interrupt`

, we’ve broken an important principle: everything is an expression. The semantics we had for `Interrupt`

was that the first `Story ()`

was interrupted at some point with the second `Story ()`

, and once that was finished, the `a`

would continue.

Given these semantics, the second `Story ()`

runs in the same “line of reality” as `a`

. However, the fact that our interrupting story returns `()`

means it can never pass any information along to the continued computation. We’ve accidentally implemented a black hole of knowledge in our story system.

How? Let’s see:

```
story :: Story ()
story = do
interrupt (leave charlie) $ do
deathOfCharlie <- die charlie
return () -- mandated by our `Story ()` type
```

This is a sad story, about how while attempting to leave, Charlie dies. However, nobody can ever learn about this, and it can never affect the rest of the story, since the value `deathOfCharlie`

can never escape the scope of the `interrupt`

block.

While it’s certainly *different* storytelling, it’s not very *good* storytelling. A story about random things happening which don’t affect the rest of the plot is kind of what we’d expect a procedurally generated story to look like, but I think we can do better. Sometimes this kind of storytelling can be successful, but it’s usually not.

So what’s the solution? Well, in the same way that the `Change`

constructor creates a `ChangeResult`

and passes it to the remainder of the computation, our `Interrupt`

should create a `y`

(the result of the interrupting story), and pass *it* on to the remainder of the computation.

But `x`

can vary! And `StoryF`

is recursive! But `x`

can vary between layers of `StoryF`

s. Clearly^{1} `x`

is unreasonably polymorphic for us to be able to pin down as a type parameter to `StoryF`

. So what ever can we do?

Existential quantification to the rescue! If you’re unfamiliar with this, it’s essentially having an instance of an interface in more traditional OOP languages. We have some type `x`

, but we don’t know anything about it, and the only thing we can do with it is shuffle it around, desperately hoping someone down the line has a function that works over *any* type.

Let’s make it happen:

```
{-# LANGUAGE ExistentialQuantification #-}
data StoryF a = Change Character ChangeType (ChangeResult -> a)
| forall x y. Interrupt (Story x) (Story y) (y -> a)
```

The `forall x y`

syntax introduces two type variables `x`

and `y`

which are existential – they’re in scope but we can never know what they are. Our two stories can now vary over any types, and the continuation of our program takes the result of the latter story.

This gives us our desired semantics; all that’s left is to make it typecheck. There’s a fair amount of plumbing to do, but slow and steady wins the race.

We update our `CoStoryF`

to also handle existentials:

```
data CoStoryF b = CoStoryF
{ changeH :: Character -> ChangeType -> (ChangeResult, b)
, interruptH :: forall x y. Story x -> Story y -> (y, b)
}
```

And we need to pin an additional `fmap`

into our iniquitous mess of `CoStoryF`

’s `Functor`

instance:

```
instance Functor CoStoryF where
fmap f (CoStoryF c i) = CoStoryF
((fmap . fmap . fmap) f c)
((fmap . fmap . fmap) f i)
```

along with the `Zap`

instance to `zap`

the our resulting `y`

into our `StoryF`

’s `y -> a`

:

```
instance Zap StoryF CoStoryF where
zap f (Change c ct k) (CoStoryF h _) = zap f k (h c ct)
zap f (Interrupt x y k) (CoStoryF _ h) = zap f k (h x y)
```

Success! Everything compiles! So it must work, right? This suspicious rhetorical question turns out to actually be misleading – everything actually *does* work. This is Haskell, after all.

However, it’s now significantly harder to construct `CoStory b`

s. Before, our interrupted stories couldn’t actually ever change anything, so we didn’t need to interpret them. That approach no longer holds water, so we need to find a way of letting a `CoStory`

be implemented in terms of itself.

Recall that we previously constructed our `CoStory b`

out of a few values:

`start :: b`

`handleChange :: b -> Character -> ChangeType -> (ChangeResult, b)`

`handleInterrupt :: b -> Story () -> Story () -> b`

That `handleInterrupt`

is no longer going to fly. Let’s update it to our new semantics and try again:

`handleInterrupt :: b -> Story x -> Story y -> (y, b)`

Good! But we have no means of interpreting `Story y`

in order to get the `y`

of our resulting pair. Fortunately, we do have a means of interpreting `Story`

s: `interpret :: Story a -> CoStory b -> (a, b)`

. We’ll want to fix the `CoStory b`

to be the one we’re currently defining, so that you can’t accidentally change your interpretation strategy half way through.

```
{-# LANGUAGE RankNTypes #-}
handleInterrupt :: (forall a. Story a -> (a, b))
-> b
-> Story x
-> Story y
-> (y, b)
```

What’s this `forall a.`

stuff? Well, without it, our type variable `a`

will get bound the first time we interpreted a story, which would be to either `x`

or to `y`

. Once this is the case, we’d be unable to interpret the *other* story. Annotating our interpretation function parameter here forces Haskell to hold off binding that type variable: instead of working *on some* type `a`

, it must work `forall a`

. Get it?

With all the pieces in place, we’re ready to write our helper function. Prepare yourself for the most horrifying type signature I’ve ever written:

```
mkCoStory :: b
-> (b -> Character -> ChangeType -> (ChangeResult, b))
-> (forall x y . (forall a. Story a -> (a, b))
-> b
-> Story x
-> Story y
-> (y, b))
-> CoStory b
```

Don’t panic! In a second, you’ll recognize this is just the combination of `start`

, `handleChange`

and `handleInterrupt`

mashed into a single function. You’ll notice we also had to mark our `x`

and `y`

type variables as being `forall`

, since our `handleInterrupt`

function mustn’t be bound to the first `x`

and `y`

s it finds.

The implementation is worth working your way through to see how it works:

```
mkCoStory start changeH interruptH =
fix $ \self -> coiter (next (flip interpret self)) start
where
next run b =
CoStoryF
(changeH b)
(interruptH (unsafeCoerce run) b)
```

It’s not as lovely as I’d like. In particular, there’s that `unsafeCoerce`

in there which tricks the compiler into forgetting that our “never can be known” type `y`

is exiting the `forall y`

scope that defines it. This is safe because we’re only forgetting that it’s existential for a second – immediately after we feed it back into an existential of the same type (we’ve just moved between the `Story y`

and the `y -> a`

in `forall x y. Interrupt (Story x) (Story y) (y -> a)`

). That’s all true, but it still makes me nervous.

I’d love to know if you can come up with a better solution, but in the meantime, this works well enough.

With the help of `mkCoStory`

, we’re now able to write a `CoStory`

which computes all of the characters referenced in a `Story`

– even if they’re only hypothetical:

```
getCharacters :: CoStory (Set Character)
getCharacters = mkCoStory S.empty changeH interruptH
where
changeH b c ct = (ChangeResult c ct, S.insert c b)
interruptH
(run :: forall a. Story a -> (a, Set Character))
b x y = ( fst (run y)
, mconcat [b, snd (run x), snd (run y)]
)
```

`getCharacters`

collects referenced characters by keeping track of who changes, and recursing into interrupted branches.

The explicit type signature of `run`

is unfortunate but necessary – `RankNTypes`

breaks Hindley-Milner type inference, so we need to tell Haskell what we’re doing.

So we’ve successfully cleaned up our semantics, and enforced that our interpretation of a `Story`

is internally consistent. However, there’s still room for error – we haven’t enforced that all interpretations of a `Story`

produce the same `ChangeResult`

tokens. Since subsequent code can branch on their contents, this is a problem just waiting to happen, and we’ll fix it next time.

To be honest, I’m not certain of this, but I’ve spent some time thinking about it and haven’t yet come up with a way of doing it.↩

We’re so close! (to our first milestone.) We’ve built all of the machinery necessary for our first attempt at constructing the tools we’ll used to procedurally generate stories.

First we built a command functor and derived free monads. Then we dualized the whole contraption and realized we’d need to connect them with cofree comonads. In the last post, we derived an interpretation function out of the `Zap`

machinery, and used it to find an adjunction to our command functor.

All that’s left now is to provide a *particular* cofree comonad over our costory functor, and we can use the rest of our machinery to use it as interpreter for our story DSL.

As a simple example, let’s write an interpreter which counts how many character state changes occur in the main flow of a story. We’ll ignore any interrupted storylines for now, because they pose an interesting challenge we’ll attack in the next post.

A challenge for us right now is this: if a cofree comonad is an infinite (co-)data structure, how can we ever hope to construct one? Our first attempt might be to use a `fix :: (a -> a) -> a`

point:

```
naiveCofree :: Cofree StoryF a
naiveCofree a = fix $ \self -> Cofree a self -- doesn't compile :(
```

Observe that this is almost what we want; unfortunately `Cofree f a`

is constructed via `Cofree a (f (Cofree a))`

– we can’t use `self`

because it’s not wrapped in an `f`

, and without an `Applicative`

constraint, we’ve got no way of getting it into one. So what do we do?

Well, we cheat, of course, and we write a version of `fix`

that does what we want. We’ll call it `coiter`

(pronounced “co-iter”) for reasons that will become evident in a moment:

`coiter :: Functor f => (b -> f b) -> b -> Cofree f b`

It would be a good exercise to derive `coiter`

for yourself to get into the habit of playing type-tetris. If you can’t be bothered, however, here’s what I came up with:

```
coiter :: Functor f => (b -> f b) -> b -> Cofree f b
coiter step start = Cofree start (coiter step <$> step start)
```

This is where it all clicked for me: this `Cofree CoStoryF b`

is an infinite list with state `b`

. The head of this list is `start`

, and each successive cons is the result on that state after handling one `StoryF a`

action. The reason this works as an interpreter is that because it’s infinite we can always reduce our program further. But since our *program* is always finite, we have a guaranteed termination condition.

So, getting back to our “count the state changes in characters” interpreter, it seems reasonable to fix our state `b`

as `Int`

, and because it’s addition, `start`

should be \(0\).

So all we need is a meaningful function of type `Int -> CoStoryF Int`

. `CoStoryF`

itself is a product type, so we’ll write two functions–one for either side.

Recall `CoStoryF`

is defined as:

```
data CoStoryF b = CoStoryF
{ changeH :: Character -> ChangeType -> (ChangeResult, b)
, interruptH :: Story () -> Story () -> b
}
```

The `Interrupt`

handler is easy (since by design we want it to do nothing), so we’ll start there:

```
-- We ignore changes that happen in interrupted branches, so return the incoming
-- number of changes.
handleInterrupt :: Int -> Story () -> Story () -> Int
handleInterrupt b _ _ = b
```

Our `Change`

handler is a little more involved, since we need to provide a return value back to our DSL.

```
-- Every change increases our number of changes by one.
handleChange :: Int -> Character -> ChangeType -> (ChangeResult, Int)
handleChange b c ct = (ChangeResult c ct, b + 1)
```

Remember, the return type here is a specialized version of `(ChangeResult, b)`

where the `ChangeResult`

will be fed back into the third parameter of `StoryF`

:

```
-- GADT form of the `Change` constructor for `StoryF`
Change :: Character -> ChangeType -> (ChangeResult -> a) -> StoryF a
```

and, even more cool, our `Zap StoryF CoStoryF`

instance was designed specifically to do this plumbing for us and feed the `fst`

of the result of `handleChange`

into the `(ChangeResult -> a)`

of `Change`

, while using the `snd`

as the ongoing state.

This. This right here is what all of our hard work has been in service of. You’ll notice that neither `handleChange`

nor `handleInterrupt`

is recursive – all of the reduction is handled by what we can now consider to be “library code.” Our programs are defined in terms of individual actions, our interpreters in terms of basic reductions of those individual actions. And the library code takes care of the rest!

Let’s tie it all together now:

```
changeCounter :: CoStory Int
changeCounter = coiter next start
where
next b = CoStoryF (handleChange b) (handleInterrupt b)
start = 0
```

And we’re done! Let’s prove that it works. Given our old `Story`

:

```
myStory :: Story String
myStory = do
let mandalf = Character "Mandalf the Wizard"
orcLord = Character "Orclord Lord of the Orcs"
orcBaby = Character "Orclord's Child"
-- changes inside of `interrupt` blocks don't count, so no changes here
interrupt (return ()) $ do
change mandalf Leave
return ()
sadness <- kill mandalf orcLord -- 2 changes (orcLord dies & mandalf did it)
change orcBaby $ Learn sadness -- a third change
return "Feel good story of the year"
```

we can run it:

`interpret myStory changeCounter -- result: ("Feel good story of the year", 3)`

Wow! It works! That’s oddly satisfying: we’ve managed to count to three, and it only took four blog posts and one hundred lines of code! We’ve now successfully build machinery for creating DSLs and interpreters over them, but we’ve still got a long way to go. In particular, some of our command functor’s semantics are wrong, and we’ll need to clean that up before we go much further.

But that’s a story for another time.

Last time around, we discussed duality and cofree comonads towards our quest in generating rich stories. I promised that comonads were the abstraction and machinery behind interpreters, but I have yet to prove that. Let’s do it today.

Two posts ago, we created a “command functor” whose job it was to specify the specific commands possible in our DSL:

```
data StoryF a = Change Character ChangeType (ChangeResult -> a)
| Interrupt (Story ()) (Story ()) a
type Story a = Free StoryF a
```

Recall, this should be understood as “a story is built out of primitives where characters can change, or where one story interrupted by another.” The polymorphic `a`

is “the type of the next piece of the computation,” and so the conspicuous `(ChangeResult -> a)`

argument to the `Change`

data constructor is “the remainder of the computation will be given a `ChangeResult`

” or perhaps more naturally, “the `Change`

command returns a `ChangeResult`

.”

So that’s one half of the puzzle. We can create programs in our DSL, but we can’t yet interpret them. We’ve derived `Cofree`

from first principles, and I’ve promised you that once we have an appropriate cofree comonad, we can use it as an interpreter for our DSL. In the same way that we created `StoryF`

to exist as a `Functor`

over which `Free`

would give us a `Monad`

, we’re going to need to find a meaningful `CoStoryF`

to act as a carrier over `Cofree`

to give us a `Comonad`

.

It’s tempting to dive right in and try our same old tried-and-true approach: dualize everything and go from there. Unfortunately, that doesn’t work (I tried it), so instead of leading ourselves down a path of madness, let’s slow down and think about what we’re actually trying to accomplish.

The function we’re actually trying to write is this:

`interpret :: Story a -> CoStory b -> (a, b)`

which is to say, a function that runs `Story a`

programs through an interpreter with internal state `b`

. While the program itself computes an `a`

, in the case of our interpreter, it’s this internal state `b`

that we’re actually interested in. When we get closer to actually using this machinery to generate stories, this `b`

is going to be instantiated as necessary locations, interesting character quirks, and other things we’re trying to compute *about* our story.

While `a`

carries information between program segments (on the DSL side of things), `b`

carries information *about* program segments (on the interpretation side).

Due to free theorems from parametricity, it’s often easier to find implementations of general functions than it is for more specific ones. In light of this, we can view this desired `interpret`

function as the special case of a more general one:

`zap :: (a -> b -> c) -> f a -> g b -> c`

Here, `zap`

is understood to be a function where somehow the functors `f`

and `g`

“annihilate” one another, and allow us to run pure functions over top of them. Obviously this depends on our choice of `f`

and `g`

, so we will make a typeclass:

```
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
class Zap f g | f -> g, g -> f where
zap :: (a -> b -> c) -> f a -> g b -> c
```

It’s safe to ignore the `LANGUAGE`

pragmas and the `| f -> g, g -> f`

syntax if you don’t know what’s going on with them; they’re just there to convince Haskell that the gnarly things we’re doing with the type are kosher. Things won’t compile without them, but the type signature of `zap`

is really what we care about here.

If you’ve forgotten what we’re trying to do by this point, we’re still looking for a meaningful `CoStoryF`

functor. Once we get that, we can make a `Cofree CoStoryF`

, which will necessarily form a `Comonad`

and we’ll *finally* be able to evaluate our programs. Carrying on.

As is usually the case with typeclasses, we can probably derive `Zap f g`

inductively, by which I mean this: if we have a `Zap StoryF CoStoryF`

, we can likely use it to derive `Zap (Free StoryF) (Cofree CoStoryF)`

. Following this line of reasoning, we’ll try to work backwards to see what `CoStoryF`

might look like.

But where do we start? Well, in the same line of reasoning, we can probably get a `Zap StoryF CoStoryF`

from a `Zap`

over the constituent functors of `StoryF`

. Recall its definition:

```
data StoryF a = Change Character ChangeType (ChangeResult -> a)
| Interrupt (Story ()) (Story ()) a
```

The constituent functors here are kind of hidden, but if you stare at it, you’ll see we have a sum (between `Change`

and `Interrupt`

), a product (the parameters in each branch), and a function.

In functor form, we know these as `Either x`

, `(,) x`

and `(->) x`

. This suggests we should start looking for instances of `Zap`

between these functors. Since pairs make up most of `StoryF`

, we’ll start there. With the wisdom of having done it already, I’ll suggest we look for a `Zap ((,) x) ((->) x)`

instance^{1}.

If we expand this out, it means we’re looking for a function of type `(a -> b -> c) -> (x, a) -> (x -> b) -> c`

. Given the signature, it’s actually pretty easy to work out:

```
instance Zap ((,) x) ((->) x) where
-- zap :: (a -> b -> c) -> (x, a) -> (x -> b) -> c
zap f (x, a) xtob = f a (xtob x)
```

It’s worth noticing that `Zap f g`

is symmetric about `f`

and `g`

. We had to pick one to go first, but there is no semantic distinction between the positions. We can exploit this fact to derive `Zap g f`

automatically: we can just `flip`

our incoming function:

```
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
instance {-# OVERLAPPABLE #-} Zap f g => Zap g f where
zap f a b = zap (flip f) b a
```

Again, more magic syntax to convince Haskell that this is kosher. `UndecidableInstances`

certainly sounds scary, but I promise that this is an OK use of it.

The construction of this `Zap`

instance between pairs and functions is promising. If you’re curious about what sorcery is actually going on here, this magic comes directly from the adjunction between curry and uncurry. Since every term in our sum-type `StoryF`

is made up of nothing but pairs and functions, and functions and pairs can annihilate one another, this suggests our `CoStoryF`

should be a product-type where we swap all of our products with functions and vice-versa:

```
data CoStoryF b = CoStoryF
{ changeH :: Character -> ChangeType -> (ChangeResult, b)
, interruptH :: Story () -> Story () -> b
}
type CoStory b = Cofree CoStoryF b
```

This actually makes a great deal of sense if you look at it for a minute or two. If a `StoryF`

is one of any possible commands, a `CoStoryF`

should be a collection of functions to handle any action that a `StoryF`

is capable of throwing at it. A `StoryF`

is a sum of arguments, while a `CoStoryF`

is a product of functions taking those arguments.

Convinced that we’ve found the right data structure, we’ll write a `Functor`

instance for it:

```
instance Functor CoStoryF where
fmap f (CoStoryF c i) = CoStoryF
(fmap (fmap (fmap f)) c)
(fmap (fmap f) i)
```

Your first thought might be “what a disgusting mess of `fmap`

”. And you’d be right. You can convince yourself that it’s right by remembering that each application of `fmap`

moves you inside a function, or into the second piece of a pair. Alternatively, you can try compiling it, see that it type-checks, and move on with your life thinking no more about it.

Armed with the right data structure and a `Functor`

instance it, we’ll go on to build our `Zap StoryF CoStoryF`

. Remember that the pieces of our `CoStoryF`

product are “handlers” of particular actions from our `StoryF`

, and thus we’ll call these pieces `h`

in the following snippet:

```
instance Zap StoryF CoStoryF where
zap f (Change c ct k) (CoStoryF h _) =
let (cr, b) = h c ct
a = k cr
in f a b
zap f (Interrupt x x' a) (CoStoryF _ h) = f a (h x x')
```

Gross and ugly, I know. What are we writing here, C? Instead, we can exploit our `Zap`

instance from earlier to perform the computation in that `let`

block for us:

```
-- much nicer version of our previous snippet
instance Zap StoryF CoStoryF where
zap f (Change c ct k) (CoStoryF h _) = zap f k (h c ct)
zap f (Interrupt x x' k) (CoStoryF _ h) = f k (h x x')
```

Much better.

I claim that this does what we want. But why does this work? Well we’re using the sum constructor from our `StoryF`

type as an *index* into the related handler from the product of our `CoStoryF`

.

To interpret a `Change`

, for example, we compute a `ChangeResult`

from our handler given the arguments from `Change`

. We then take this resulting `ChangeResult`

and pass it into the continuation `(ChangeResult -> a)`

returned by `Change`

. In effect, this instance of `Zap`

has performed a single stage of reduction between our DSL and our interpreter.

Maybe you’re starting to see now why this `Zap`

machinery is useful for running our program: it automatically interleaves the results from our interpretation into the bound values in our DSL. What we’ve built so far automatically connects a single step of the program with a single step of the interpretation; as you might expect, the `Zap`

over `Free`

and `Cofree`

will take care of running the individual reductions sequentially until we’ve fully evaluated our program.

And so we need to find a derivation of `Zap (Free f) (Cofree g)`

. If you followed the last derivation, this one should be a piece of cake. If not, it’s worth staring at for a little while – grokking it definitely helped solidify in my mind how `Free`

and `Cofree`

are related.

```
instance Zap f g => Zap (Cofree f) (Free g) where
zap f (Pure a) (Cofree b _ ) = f a b
zap f (Bind as) (Cofree _ bs) = zap (zap f) as bs
```

Notice that we’re doing the same trick here: using the sum constructor of our `Free`

type to pick a particular piece out of the product of our `Cofree`

type.

All that’s left now is to construct a particular `interpreter : CoStory b`

, which we can `zap`

against any `story : Story a`

. That will be our focus for the next post, but in the meantime, we’ll convince ourselves that we’ve done something worthwhile here by implementing our desired `interpret`

function from earlier:

```
interpret :: Story a -> CoStory b -> (a, b)
interpret = zap (,)
```

Oh. That was easy. Definitely a sign that we’re onto something here.

Until next time.

Deriving the other two instances is informative for how this machinery actually works, and is left as an exercise to the reader.↩

In the last post in this series, we talked about the rough sketch of an idea on how we might be able to make procedurally generated RPG stories. The general approach is this: make a super simple core set of story primitives, and then build more interesting abstractions on top of them.

Simplicity of our underlying language is desirable for a few reasons. The smaller our set of primitives, the easier a time we’re going to have proving things about what we can do with them. One thing we can do with them, particularly relevant to today’s discussion, is to provide an interpretation.

If you haven’t read the previous post in this series, now would probably be a good time.

Remember, the reason we wanted to build a DSL behind our story generation was so that we could use it to separate the *structure* of our story from its *interpretation*.

Last time, we used free monads over our command functor to generate our DSL. I promised today we’d use cofree comonads to interpret our language, but there is a lot of intermediate motivating material I want to get through before we discuss that. So without further ado, let’s talk about duality.

At first blush, duality can be understood as the mathematical version of bizarro world.

As a good rule of thumb, if I have some interesting mathematical object \(X\), then its dual, co-\(X\), is the *opposite* mathematical object, and is also interesting.

But what does opposite mean, here?

I’m by no means a mathematician (yet!), but, to a (very) rough approximation, a dual is constructed by flipping all of your arrows backwards. What arrows, you might ask? Well, that’s a good question. Let’s look at an example. It’ll involve drawing pretty pictures, so make sure you have your copy book ready.

Okay, so given \(a \in A\) and \(b \in B\), we have \((a, b)\in A \times B\), and we call this \((a, b)\) a (cartesian) product. Intuitively, a product is pair of two things, wrapped up together in a nice little package. The words “product” and “pair” are interchangeable, so go wild with it!

More formally, we can encode the idea of a product thusly:

```
prod :: (a -> b) -> (a -> c) -> a -> (b, c)
prod f g a = (f a, g a)
```

Which is to say, given two functions, `a -> b`

and `a -> c`

, we can create a new function which maps `a -> (b, c)`

. The fact that `prod`

is polymorphic in all `a`

, `b`

, `c`

should be telling that we’re onto something here.

Let’s dive in a little further, and investigate this notion as a commutative diagram, because the idea of duality is a little easier to investigate in that context. Our `prod`

function above can also be encoded equivalently by this diagram:

\[ \begin{xy} \xymatrix { A \ar@/_/[ddr]_f \ar@{.>}[dr]|{prod} \ar@/^/[drr]^g \\ & B \times C \ar[d]^{fst} \ar[r]_{snd} & C \\ & B } \end{xy} \]

If you view the capital letters as types and the arrows as functions, this corresponds perfectly with our `product`

function as written above. The solid arrows are ones we know that exist, and the dashed line is our proposition: “if everything else in this picture holds, this arrow exists.”

So: the million dollar question. What happens when we flip all of our arrows around? We get this diagram:

\[ \begin{xy} \xymatrix { & C \ar@/^/[ddr]^g \ar[d] \\ B \ar[r] \ar@/_/[drr]_f & ? \ar@{.>}[dr]|{coprod} \\ & & A } \end{xy} \]

Which of course corresponds with this in Haskell:

`coprod :: (b -> a) -> (c -> a) -> Coproduct b c -> a`

You probably know what this is, but let’s pretend like we don’t, and see if Hoogle can answer this for us. Spoilers, it can. That’s right! It’s our old friend `either`

!

`either :: (b -> a) -> (c -> a) -> Either b c -> a`

Cool! So a coproduct is a sum type, and is the dual to the product type. For the sake of completeness, let’s fill in all of the missing labels on our diagram.

\[ \begin{xy} \xymatrix { & C \ar@/^/[ddr]^g \ar[d]_{Right} \\ B \ar[r]^{Left} \ar@/_/[drr]_f & B+C \ar@{.>}[dr]|{either} \\ & & A } \end{xy} \]

Notice that our interesting product type had an interesting dual. This is theme we will continuously take advantage of.

It is left as an exercise to the reader to prove that the dual of the coproduct is the product (this is not a very hard proof since arrows only have two ends).

Lovely. Armed with our new superpower of duality, we’re now ready to take on comonads. Judging from the name, we should expect them to be dual to monads. Recall that a monad `m`

is defined by two functions:

`return :: a -> m a`

`(>>=) :: m a -> (a -> m b) -> m b`

Let’s flip the arrows around, and since we’re flipping everything else, we’ll refer to our comonad as `w`

, which is defined by two functions dual to the monad’s:

`extract :: w a -> a`

`extend :: w b -> (w b -> a) -> w a`

The full intuition behind comonads is left as an exercise to the reader (my monad tutorial didn’t go too well), but a good starting point is this: while monads are for building up a computation *in* a context, comonads compute values *from* a context.

The canonical example of a comonad is Conway’s game of life (a cell is alive or dead based on how lively its neighborhood is.) Another particularly amazing example is spreadsheets (the value of a cell depends on the value of other cells it references.)

Recall the definition of the free monad:

```
data Free f a = Pure a
| Bind (f (Free f a))
```

Now that I’ve primed you, it should be pretty clear that this is a sum type – `Free f a`

is *either* a `Pure a`

*or* a `Bind (f (Free f a))`

. There are no function arrows to flip around, so we can dualize this trivially now that we know products and coproducts are duals of one another:

`data Cofree f a = Cofree a (f (Cofree f a))`

Again, it’s hard to get a sense of what this might mean just by looking at it. Let’s throw some concrete functors at it:

`data Cofree Maybe a = Cofree a (Maybe (Cofree Maybe a))`

Whoa! Look at that! `Cofree Maybe a`

is at least one `a`

, followed by maybe more. That’s just a non-null list in disguise! Veeeery interesting, no? I wonder what happens if we slap in the list functor instead:

`data Cofree [] a = Cofree a [Cofree [] a]`

Hey, this one is equivalent to a rose tree – an `n-ary`

tree with data *at every branch*.

We must be onto something here – those are pretty different data structures, and we got them just by changing the functor underlying our `Cofree`

.

As you might expect, `Cofree`

is thusly named because it generates trivial comonads for free (as in time) given a functor `f`

:

```
instance Functor f => Comonad (Cofree f) where
extract (Cofree a _ ) = a
extend wb@(Cofree _ bc) f = Cofree (f wb) (fmap (`extend` f) bc)
```

It’s probably the dumbest comonad instance imaginable – there is no context to extract values from, we just pull out the `a`

we have. But again, it’s good that our instance is stupid. That’s what we want – that’s why we made it.

Unfortunately it’s a little harder for us to bask in the glory of having a cofree comonad – comonads don’t give rise to unique syntax in Haskell, so we’ll just have to be content with the fact that our instance compiles.

This feels like a natural place to end off, so we will. Next time around we’ll take a look at adjunctions, how they give rise to pairings between functors, and how we can use that machinery to automatically pair our cofree comonads with our free monads into one mega DSL-implementing wonder device.

Until then!

Strongly inspired by Dave Laing’s fantastic series Cofun with cofree comonads. This post and the next are mostly rehashes of (superior) blog posts of his, but there is novel material to be covered soon.

I am eternally torn between a dichotomy I like to call “finish shit vs. solve cool problems.” Finishing shit requires a lot of polish around the boring corners of a project, after all the cool stuff has been solved – and there’s always another cool problem waiting to be solved.

In particular, this dichotomy has recently manifested itself as “I should make an RPG vs. I already know how to make RPGs, it’d be fun creatively but gee that sounds like a lot of tedium and wouldn’t teach me much in the end, except for maybe the value of hard work.”

Then I realized making an RPG doesn’t need to be tedious and boring. I’ll just teach a computer how to generate an RPG. Goldmine genius idea. I don’t know how to make a procedurally generated RPG, but really, how hard could it be?

This post is the first of many on just how hard it can be.

People have been making roguelikes for decades. While roguelikes are spectacularly cool, they’re not really RPGs in the more common sense of the word. There’s no narrative to a roguelike, you just adventure around and kill shit.

The RPG that inspired me to make an RPG was Earthbound, which is known for its quirky atmosphere and for managing to pull of some sort of weird-humorous-plot-mixed-with-lovecraftian-horror juxtaposition. Earthbound *feels* like it might have been made on drugs, but somehow manages to still be a fantastic experience.

*This* is the kind of thing I want to generate. Lots of games have tried to generate interesting worlds and plots, but, at least when I was in the games industry, the state of the art was prefabricating modules and stitching them together. Sure, it’s hard to generate solid plots, but I don’t think its intractable.

I think the problem might have been this: this problem is fundamentally functional; any imperative approach is going to be a Bad time.

Maybe. Lots of this is vaporware still, but it *feels* right, and I have a plausible path to actually executing on it.

Enough run-around. Are you ready to hear my revolutionary idea to generate procedural RPGs with coherent and interesting stories?

- Build a datastructure representing a story.
- Turn this datastructure into a game.

Amazing, right?

Okay, not that amazing, but here’s the rub. Instead of building this datastructure by hand, we’ll write a domain specific language (DSL) which will generate the datastructure for us. And then if we then embed this language into Haskell, we’ll lift all of the expressiveness of Haskell into our DSL. If we limit the DSL to a few number of primitive operations, and implement all of the interesting pieces as combinators on top, it will be easy to abstract over, and more importantly, to interpret.

This interpretation step is, unsurprisingly, where the “magic” happens.

Separating the *structure* of what we want to do (which is what the DSL provides us) from *how* we do it means we can do different things with the same data. For example, given a basic plot skeleton, we can run over it, and with the help of a random number generator, determine a theme. Then, given the theme and the plot skeleton, build necessary locations to help advance the plot from one scene to the next. Then, with all of this, we can build intermediate landscapes to stitch the locations together. And so on and so forth.

There are lots of potential failure modes here, but the approach seems feasible.

So I went through a bunch of games whose stories I adore, and I attempted to deconstruct them into their primitive operations. A simplified datastructure of what I came up with is provided here:

```
type Story = [StoryPrim]
data StoryPrim = Change Character ChangeType
| Interrupt Story Story
data ChangeType = Introduce
| Die
| Leave
| Arrive Location
| Kill Character
| Learn ChangeResult
data ChangeResult = ChangeResult Character ChangeType
```

which is to say, a `Story`

is a list of `StoryPrim`

s, which is either a change in character state, or one `Story`

being interrupted by another (eg. if someone’s murder attempt is foiled by an unexpected arrival.)

This isn’t comprehensive enough to generate entire stories, but it’s definitely good enough to motivate the remainder of this post.

Let’s take a little break and talk some math.

Free monads are one of the neatest things I’ve learned about recently. The definition (in Haskell) of a free monad over a functor `f`

is this:

```
data Free f a = Pure a
| Bind (f (Free f a))
```

Which can be thought of a recursive datastructure which bottoms out with a `Pure`

or recurses with an `Bind`

. The definition was hard for me to work my head around, so let’s give it a concrete functor and see what pops out:

```
data Free [] a = Pure a
| Bind [Free [] a]
```

If we squint, this is actually just a tree where `Bind`

is a \(n\)-ary branch, and `Pure`

is a value at a leaf. So a tree is just a special case of the free monad. That’s kinda hot, if you’re as into this stuff as much as I am.

But what’s more hot is that given any `instance Functor f`

, `Free f`

forms a monad:

```
instance Functor f => Monad (Free f) where
return a = Pure a
Pure a >>= f = f a
Bind m >>= f = Bind (fmap (>>= f) m)
```

It’s probably the dumbest `Monad`

instance imaginable, but hey, it adheres to the monad laws, and that’s really all we ask for. The laws are satisfied only in a very trivial sense, in that all we’ve done here is encode the rules of `return`

and `(>>=)`

into our datastructure which is to say, we haven’t done any processing yet. We’ll return to this in a moment.

It’s called “free” for exactly this reason of trivially satisfying the laws – given any functor `f`

we can get an (admittedly stupid) monad over `f`

for free.

Because our free monad is just a datastructure in the exact shape of a computation we *would* want to carry out over its contents, it’s easy to write an interpreter for it. Or several.

See where I’m going with this?

Here’s the kicker: **Free monads turn out to be the abstraction behind DSLs because they encode the structure of a computation, without imposing an interpretation over it.**

But remember, getting a free monad requires having a functor. If we can find a means of encoding our `Story`

grammar above as a functor, we can lift it into a DSL via `Free`

.

So we need a means of getting a `Functor`

instance for our `Story`

type described above. But how?

Let’s start playing madlibs with what we know.

```
type Story a = Free StoryF a
data StoryF a = -- ???
```

Looking at the definition of `Free`

specialized over our functor `StoryF`

once again hints us in the right direction:

```
data Story a = Pure a
| Bind (StoryF (Story a))
```

The polymorphic variable of our `StoryF`

functor is only ever going to be a `Story a`

, which is to say a pure `a`

or a bind computing more of the final value.

So our polymorphic type variable is the type of the continuing computation. Because `Pure`

from `Free`

takes care of how computations terminate, our functor should always have a continuing computation. Voila:

```
data StoryF a = Change Character ChangeType (ChangeResult -> a)
| Interrupt (Story ()) (Story ()) a
```

contrasting this against our old `StoryPrim`

, we’ve just added a new product involving `a`

to all each of our sum terms. Again, `a`

should be considered to be the type of the continuing computation.

But what’s this funny `ChangeResult -> a`

thing? Well, recall that we wanted a `Change`

to return a `ChangeResult`

indicating what changed, which is to say this result should be a *parameter* to the rest of the computation – thus our function type^{1}.

`StoryF`

is what’s known as our command functor, because as we will see, its constructors will eventually act as commands in our DSL.

But wait! Not so fast. We haven’t yet provided a `Functor`

instance for `StoryF`

. It’s trivial, but we present it here for completeness:

```
instance Functor StoryF where
fmap f (Change c ct k) = Change c ct (f . k)
fmap f (Interrupt s s' k) = Interrupt s s' (f k)
```

And so `StoryF`

is now a `Functor`

, which means that `Free StoryF`

is a `Monad`

, which means that we can use `do`

notation inside of it! We’re most of the way to our DSL!

All that’s left is to lift our `StoryF`

data constructors into `Story`

constructors. The details of this are a little messy, but luckily `liftF`

from the `free`

package does most of the manual labor for us.

```
change :: Character -> ChangeType -> Story ChangeResult
change c ct = liftF $ Change c ct id
interrupt :: Story () -> Story () -> Story ()
interrupt s s' = liftF $ Interrupt s s' ()
```

and that’s it! Short of some helpful combinators, we’re done! We can now write basic stories in Haskell using `do`

notation!

```
myStory :: Story Int
myStory = do
let mandalf = Character "Mandalf the Wizard"
orcLord = Character "Orclord Lord of the Orcs"
orcBaby = Character "Orclord's Child"
sadness <- kill mandalf orcLord
change orcBaby $ Learn sadness
return 5
die :: Character -> Story ChangeResult
die who = change who Die
kill :: Character -> Character -> Story ChangeResult
kill who whom = change who (Kill whom) <* die whom
```

As far as stories go, one about a child learning of its father’s death is probably not going to win any feel-good-novella-of-the-year, but the example serves to showcase several things:

- We can build abstractions with standard Haskell combinators (eg. killing someone implies that they die.)
- The fact that this typechecks shows that our language is expressive enough for characters to learn of the arbitrary actions of one another (including learning that they’ve learned something.) Furthermore, knowledge is first-class and can be passed around the story however we see fit.
- Like all monads, our DSL can describe things that happen
*while*returning potentially unrelated data. The \(5\) above is meaningless, but allows us to interleave story descriptions with arbitrary computations.

This seems like a good place to stop for today – we’ve covered a lot of ground. Next time we’ll discuss how we can use cofree comonads (I am *not* kidding here) to build an interpreter for our DSL.

If this isn’t immediately evident to you, make sure you understand how

`do`

desugaring works.↩