Constructing a Comonad

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.

Cofree Comonads: You Coiter Love ’Em🔗

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.

Machinery in the Library is Worth Two in the Bush🔗

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!

Counting to Three🔗

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.