Sunday, December 30, 2012

The Continuation Monad

The continuation monad is one of the least appreciated monads and in this post I hope to motivate when to use it. This post will first motivate continuations in general and then motivate them in their specific capacity as monads.


Continuations


A Haskell continuation has the following type:
newtype Cont r a = Cont { runCont :: (a -> r) -> r }
A continuation takes a function of type (a -> r) and generates an r, where r can sometimes be a fixed value like Int or IO ().

For example, I might write a long-running process that spawns an action every time the user enters a line of input:
onInput :: (String -> IO ()) -> IO ()
        -- i.e. Cont (IO ()) String
onInput f = forever $ do
    str <- getLine
    f str
You will recognize this idiom if you've ever used frameworks with callbacks. We supply the framework with a function (i.e. a continuation) and the framework uses that function to do its job.


"Complete me Later"


You generally use continuations when you are programming something, but you want somebody else to complete it. Common reasons include:
  • You are programming a framework with callbacks that users supply
  • You are defining a custom map engine for game players to program
  • You are lazy
I'll use the following hypothetical code segment as an example:
unitAttack :: Target -> IO ()
unitAttack target = do
    swingAxeBack 60
    valid <- isTargetValid target
    if valid
    then ??? target
    else sayUhOh
Let's imagine you have to package up and compile this code for somebody else (say, a fellow colleague) to use later, but it won't compile yet because you still have the unspecified ??? function. What do you do?

Like all good programming, the best solution is the laziest one. We punt and take the incomplete behavior as a parameter so that whoever finishes the function later on can complete the function by passing the specified behavior in:
unitAttack :: Target -> (Target -> IO ()) -> IO ()
unitAttack target todo = do
    swingAxeBack 60
    valid <- isTargetValid target
    if valid
    then todo target
    else sayUhOh
Problem solved! Notice how the right hand side of the type signature resembles the shape of our Cont type. If we just add a newtype, we can wrap it in Cont ourselves:
unitAttack :: Target -> Cont (IO ()) Target
unitAttack target = Cont $ \todo -> do
    swingAxeBack 60
    valid <- isTargetValid target
    if valid
    then todo target
    else sayUhOh
... or, even better, we can use ContT instead. The benefit of ContT is that it is also a monad transformer, which comes in handy. ContT has the exact same Monad instance as Cont, so they are otherwise interchangeable:
newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

unitAttack :: Target -> ContT () IO Target
unitAttack target = ContT $ \todo -> do
    swingAxeBack 60
    valid <- isTargetValid target
    if valid
    then todo target
    else sayUhOh
This is great because now somebody else can "continue" where we left off (thus the name: continuations). They would just define the missing function:
damageTarget :: Target -> IO ()
... and then supply it to our continuation to complete it:
runContT (unitAttack target) damageTarget :: IO ()

Variable Arguments


Our strategy works well if we have exactly one hole in our function, but what if we have two holes in our function, each of which takes a different argument?
unitAttack :: Target -> IO ()
unitAttack target = do
    ???_1 60
    valid <- isTargetValid target
    if valid
    then ???_2 target
    else sayUhOh
Well, we might try to accept two continuations:
unitAttack
 :: Target -> (Int -> IO ()) -> (Target -> IO ()) -> IO ()
unitAttack target todo1 todo2 = do
    todo1 60
    valid <- isTargetValid target
    if valid
    then todo2 target
    else sayUhOh
... but that no longer cleanly fits into our Cont type, which expects exactly one continuation.

Fortunately, there is a clean and general solution. Just define a data type that wraps both possible arguments in a sum type, and just define a single continuation that accepts this sum type:
data Hole = Swing Int | Attack Target

unitAttack :: Target -> ContT () IO Hole
unitAttack target = ContT $ \k -> do
    k (Swing 60)
    valid <- isTargetValid target
    if valid
    then k (Attack target)
    else sayUhOh
Each constructor acts as a place-holder that signals to the continuation which hole it is currently filling. Then somebody else can continue where we left off and just write:
damage    :: Target -> IO ()
swingBack :: Int -> IO ()

continue :: Hole -> IO ()
continue (Swing  n) = swingBack n
continue (Attack t) = damage t

runContT (unitAttack target) continue :: IO ()
This trick generalizes to n holes with variable arguments per hole. Just define a type with n constructors, one for each hole, where each constructor stores whatever arguments that particular continuation will need:
data Hole = Hole1 Arg1 Arg2 | Hole2 | Hole3 Arg3 | Hole4

Algebraic Data Types


I want to digress for a moment to talk about algebraic data types. If you are not interested, skip to the next section.

It turns out we can elegantly derive the above trick for multiple holes. Type algebra says that if we squint then we can translate the following type constructors to algebraic operators and derive equivalent types from simple algebraic manipulations:
Either a b  <=>  a + b
(a, b)      <=>  a * b
a -> b      <=>  b ^ a
That means that if we have a function with two continuations:
(a1 -> r) -> ((a2 -> r) -> r)
... we just translate it to the equivalent algebraic expression:
(r ^ (r ^ a2)) ^ (r ^ a1)
... and then we can derive equivalent representations just by using the rules of algebra:
  (r ^ (r ^ a2)) ^ (r ^ a1)
= r ^ ((r ^ a2) * (r ^ a1))
= r ^ (r ^ (a2 + a1))
... then if we translate that back to the equivalent type, we get:
(Either a2 a1 -> r) -> r
... which is exactly the trick described in the previous section.

Similarly, if we have more than one argument to a continuation:
(a -> b -> r) -> r
... we can find an equivalent single-argument form using type algebra:
  r ^ ((r ^ a) ^ b)
= r ^ (r ^ (a * b))
... which transforms back to:
((a, b) -> r) -> r
So type algebra tells us the obvious: uncurry the continuation if it needs a single argument.


The Continuation Monad


So far that explains what continuations are useful for, but it does not explain what the continuation Monad is useful for.

I firmly believe that the way to a Monads heart is through its Kleisli arrows, and if you want to study a Monads "purpose" or "motivation" you study what its Kleisli arrows do.

So rather than study the Monad instance for Cont, let's instead just study the shape of the Cont Kleisli arrow and infer what it does from its type alone:
  a -> Cont r b
~ a -> (b -> r) -> r    -- Expand the definition of Cont
~ (b -> r) -> (a -> r)  -- Flip the arguments
In other words, we take a function that handles bs and transform it into a function that handles as.

This suggests a basic starting intuition for the continuation monad: we transform handlers.

Let's build on that intuition by revisiting our previous example:
unitAttack :: Target -> ContT () IO Target
unitAttack target = ContT $ \todo -> do
    swingBack 60
    valid <- isTargetValid target
    if valid
    then todo target
    else sayUhOh
We need to supply a completion function of type:
handler :: Target -> IO ()
We could complete this function ... or we could half-ass it and leave our work incomplete:
halfAssedCompletion :: Target -> IO ()
halfAssedCompletion target = do
    registerUnitBeingAttacked
    playDamageSound
    ??? 40  -- So close...
This means we essentially created a new continuation with a slightly smaller hole:
halfAssedCompletion :: Target -> ContT () IO Int
halfAssedCompletion target = ContT $ \todo -> do
    registerUnitBeingAttacked
    playDamageSound
    todo 40
This is a Kleisli arrow! That means we can compose it with our previous Kleisli arrow:
unitAttack >=> halfAssedCompletion :: Target -> ContT () IO Int
This composition substitutes in halfAssedCompletion for each hole we left in the unitAttack function. However, halfAssedCompletion left smaller Int holes of its own that somebody else now has to finish up.

Notice how now we originally needed a handler of type:
handler :: Target -> IO ()
... but now we only need a smaller handler of type:
newHandler :: Int -> IO ()
... in other words, halfAssedCompletion acts as an intermediary that transforms handlers of type (Int -> IO ()) into handlers of type (Target -> IO ()).

The Cont monad is all about chaining these kinds of partial completions together until all the holes are finally filled. You could use this abstraction to complete a project in stages and seamlessly hand off work from person to person whenever circumstances require a change in maintainer before completing the project. Alternative, you can use this to condense the callback API of a framework into a single point of entry.


The Kleisli Category


Earlier I said that the key to a monad is its Kleisli arrows. The reason why is that Kleisli arrows are morphisms in the Kleisli category, where (>=>) is Kleisli arrow composition:
(>=>) :: (Monad m) => (a -> m b) -> (b -> m c) -> (a -> m c)
(f >=> g) x = f x >>= g
.. and return is the identity:
return :: (Monad m) => a -> m a
Like all categories, the Kleisli category must obey the category laws:
return >=> f = f                   -- Left identity

f >=> return = f                   -- Right identity

(f >=> g) >=> h = f >=> (g >=> h)  -- Associativity
Things that obey these laws have nice properties. For example, it guarantees that you can reason about each Kleisli arrow in a composition chain in isolation. Each Kleisli arrow's behavior is completely determined by its input (i.e. domain) and output (i.e. codomain). So let's think about how that modularity translates to the Cont Kleisli category.

When you switch maintainers, you don't have to give the next maintainer a bunch of holes sprawled out over a large code base like this:
largeProgram = do
    ...
    x <- ???_1 y
    ...
    ???_2 horseTheyRodeInOn
    ...
    spawn ???_29 foo
Instead you can unify all the holes using a single callback that accepts a single type (the "codomain") unifying all the holes you left:
largeProgram :: () -> ContT () IO Hole
largeProgram () = ContT $ \k -> do
    ...
    x <- k (Hole1 y)
    ...
    k Hole2
    ...
    k (Hole29 spawn foo)
This give the next person a single point of entry to continue from, because now they only have to write a Kleisli arrow that handles a single Hole input which encompasses all the previous holes:
nextContribution :: Hole -> ContT () IO NextHole
nextContribution currHole = ContT $ \nextHole -> case currHole of
    Hole1 y -> ... -- Fill first hole
    Hole2   -> ... -- Fill second hole
    ...
    Hole29 spawn foo -> ... -- File 29th hole
Then you just use Kleisli composition to connect your code contribution:
largeProgram >=> nextContribution
This cleanly modularizes the first person's contribution so that you can hermetically seal it off from subsequent contributions. By repeating this process, each subsequent contribution to the code base becomes its own modular and composable Kleisli arrow, cleanly separated from other contributions:
alice'sWork :: a -> ContT r m b 
bob'sWork   :: b -> ContT r m c
carlo'sWork :: c -> ContT r m d 

engine = alice'sWork >=> bob'sWork >=> carlo'sWork
 :: a -> ContT r m d

customMap :: d -> ContT r m e

completeGame = engine >=> customMap
 :: a -> ContT r m e
This is why frameworks and game custom map makers all use continuations to delimit the interface between the company's code and the user's code. The continuation monad is all about establishing air-tight code boundaries, both internally within a project, and externally for user facing APIs. This lets you isolate responsibilities if you can separate each code contribution into its own Kleisli arrow.


Callback Hell


Frameworks are the canonical example of separating responsibilities, where the framework writer provides some code, but the user is expected to fill in the gap with callbacks of their own. This often results in callback hell in frameworks that take this principle to the extreme, like Node.js.

But it doesn't have to be that way. The continuation monad teaches us that we can always condense a sprawling API filled with callbacks into a single callback that takes a single argument. Even better, we get monadic syntactic sugar for composing multiple layers of callbacks.

I'll use the GLUT package as an example, which requires several callbacks like:
type ReshapeCallback = Size -> IO ()

type VisibilityCallback = Visibility -> IO ()

type WindowStateCallback = WindowState -> IO ()

type CloseCallback = IO ()

-- there are more, but I'll stop here
Instead, we can wrap GLUT's multiple callbacks into a uniform ContT API:
glut :: () -> ContT () IO Hole

data Hole
   = Reshape Size
   | Visible Visibility
   | Window WindowState
   | Close
   ...
Now the end user has a single entry point to the GLUT monad, so they can now complete the framework in a single function:
userCallbacks :: Hole -> ContT () IO a
userCallbacks hole = ContT $ \_ -> case hole of
    Reshape size -> ... -- Handle reshapes
    Visibility v -> ... -- Handle visibility switches
    Window ws    -> ... -- Handle changes to window state
    Close        -> ... -- Handle window closing
    ...
Moreover, they can now just compose their code with the glut framework:
glut >=> userCallbacks :: () -> ContT () IO a

The Buck Stops Here


How do we know when we are done and there are no continuations left? Well, let's see what type the compiler infers if we have no more holes and never use the continuation:
>>> let done = ContT $ \_ -> return ()
>>> :t done
done :: Monad m => ContT () m a
It says the return type is polymorphic, meaning that there is no hole left to fill. The above function just inserts return () in all holes and calls it a day. We can even prove a chain of continuations is done if its final return value type-checks as Void, the empty type:
absurd :: Void -> a  -- from the "void" package

run :: (Monad m) => ContT r m Void -> m r
run c = runContT c absurd
run only accepts completed programs that have no holes left. We can use run for our previous GLUT example, since the final user callback handler leaves no unfinished holes:
run ((glut >=> userCallbacks) ()) :: IO ()

Conclusion


I hope this post inspires people to use the continuation monad to structure and modularize code completion boundaries. The continuation monad naturally arises at the boundaries between programmers and cleanly abstracts away callback hell into a simple and uniform interface with a single entry point.

28 comments:

  1. Are you missing the '60' in your first invocation of swingAxeBack?

    ReplyDelete
  2. do you speak english too?

    ReplyDelete
    Replies
    1. I originally wrote this this for the /r/haskell audience, so it assumes some familiarity with Haskell already.

      Delete
  3. I'm impressed that someone wrote an entire article on continuations and didn't once mention call/cc.

    ReplyDelete
    Replies
    1. I don't know if that's a good or bad thing. :)

      I left it out because the article is about continuations as monads, and call/cc doesn't have anything to do with their role as monads.

      Delete
  4. What are your opinions about delimcc?

    ReplyDelete
    Replies
    1. I actually don't know much about it, but some people have told me it's a more powerful version of what I've just described. I haven't had the chance to study it, yet.

      Delete
    2. There's an Oleg classic written about it, but it's unsurprisingly dense.

      Delete
  5. I think there's another typo here:

    damageTarget :: Target -> IO ()
    ... and then supply it to our continuation to complete it:
    runContT (unitAttack target) damage :: IO ()

    That should be

    runConT (unitAttack target) damageTarget :: IO ()

    ReplyDelete
    Replies
    1. Sorry for the late reply. You're right, and I corrected it.

      Delete
  6. Something is bothering me here at about the point where the second hole appears. It's fine if you use the ContT constructor directly:

    newtype ContT r m a = ContT { runContT :: (a -> m r) -> m r }

    because here the continuation is represented as an ordinary function *that returns*, so it can be called multiple times, eg once with (Swing 60) and again with (Attack Target).

    However, is using the ContT constructor like this really what you're supposed to do? If the constructor is hidden, then the standard way to muck about with the continuation is to use callCC, which leads me to write something like this:

    unitAttack target = callCC $ \k -> do
    k (Swing 60)
    valid <- isTargetValid target
    if valid
    then k (Attack target)
    else sayUhOh

    BUT, when you do this, the first call to k aborts the rest of the computation--k never returns and the target is never attacked. Surely, to get the effect you are after without breaking the continuation monad abstraction is to use composable or delimited continuations? I'm only just learning about delimcc and all that so I'm not sure if I've got the right end of the stick yet...

    ReplyDelete
    Replies
    1. Using the constructor is the right approach for that specific example that I gave.

      To make an analogy, let's draw a parallel with StateT. Let's say I have a function of type:

      f :: s -> m (r, s)

      ... and I want to embed that in StateT. The obvious way would be to just wrap it in the StateT constructor, but let's say that I didn't allow myself to use the constructor (or anything equivalent) and restricted myself to using get, lift, and put. Then I would have to write:

      do s <- get
      (r, s) <- lift (f s)
      put s
      return r

      Weird, right? That's basically how awkward it would be to use callCC for something where the ContT constructor is more appropriate.

      Now, ContT differs from StateT in one important way: in StateT our mental model of state most closely matches the 'get' and 'put' commands, which is why we like to use those more frequently than wrapping things in the StateT constructors. However, with ContT the situation is the opposite. The ContT constructor most closely resembles our mental model for how continuations work, which is why we use it more often than we use callCC.

      So I hope that explains why ContT is a bit unusual in that idiomatic usage tends to use the constructor more heavily than other monad transformers. It's just that internal type already closely matches our mental model so we don't need to deviate that far from the original constructor and abstract over it with higher-level primitives.

      Delete
  7. 1/ You explained how to deal with variable arguments, but what about variable return types ?

    For example, the following function has 2 holes with distinct return types :

    unitAttack :: Target -> IO ()
    unitAttack target = do
    valid1 <- ???_1 60
    valid2 <- isTargetValid target
    if (valid1 && valid2)
    then ???_2 target
    else sayUhOh

    How would you use the continuation monad in this case ?

    2/ For many monads (Reader, Writer, Error...), one can generalize any function "f1 :: xxxT m a" into "f2 (Monadxxx m) => m a" ; is it possible to do the same with MonadCont ?
    I guess it's not since MonadCont is a *single*-parameter typeclass, while ContT is a *multi*-parameter type constructor...
    Any insight about how it could or why it cannot be possible, would be much appreciated :) .

    ReplyDelete
    Replies
    1. So, the answer to part 1 is that you would probably need to invoke two separate monad transformer layers (one for each type of continuation) then run each one separately (i.e. provide a separate continuation for each one). I'm not aware of a good way to combine two distinct return types into a single monad.

      I don't know how to generalize `ContT` into a type class, but I do know how to generalize an equivalent monad into a type class. The idea is that you can actually implement `ContT` using the `Server` type from `pipes`, where you replace every continuation `k` with a call to `respond`. The argument to `respond` is the argument of the continuation and the return value of `respond` is the return value of the continuation. Then you feed the continuation using the `(//>)` operation from `pipes`, which is analogous to `(>>=)` for an indexed continuation monad.

      In fact, you can actually show that this behaves exactly like an indexed `ListT` monad (where `(>>=)` = `for`/(//>)` and `return` = `yield`/`respond`). `pipes` provides a non-indexed `ListT` monad that you can study to see what I mean.

      Now, `pipes` currently does not provide a type class for this, but it used to. If you study the `3.*` series of `pipes` you will see that there is a `Proxy` type class which is sort of like the `mtl`-ization of `pipes`. I ended up dropping it in version 4.0, but it's there for you to study.

      So that's a long-winded way of saying that it is possible to type class this behavior if you implement it in terms of an indexed `ListT` monad and then type class that.

      Delete
  8. Hi Gabriel. I found this old article looking for literature about continuations.

    Unlike in other functional languages, that lack a monad instance, there is a simpler way to see continuations in haskell:

    the continuation is the 'f' in the bind operation. x >>= f

    Because 'f' is the rest of the computation. It is not needed a structure above to deal with continuations in haskell, thanks to the monad instance.

    I was very surprised whit this simple idea. It was in the process of avoiding callback hell. I tried to be as pragmatic as possible. So I created a simple monad in which I hold the 'f' in a state monad, so it can be executed at any time. In particular I created a client side framework with this, hplayground, that avoid the callback hell and has fully composable widgets. The whole idea is described here https://www.fpcomplete.com/user/agocorona/a-monad-for-reactive-programming-part-1. the drawbacks of this approach (that indeed would appear in any kind of continuation monad) are solved in a second part and other articles in the same site.

    ReplyDelete
    Replies
    1. You might also like this other post of mine where I show an easy mnemonic for implementing the continuation monad:

      http://www.haskellforall.com/2014/04/how-continuation-monad-works.html

      It's very similar to the trick you described with `f` being the rest of the computation.

      I also really like using the continuation monad to avoid callback hell. I agree that it's a really powerful trick and I wish more programming languages could do it as easily as Haskell does.

      Delete
  9. See https://www.reddit.com/r/haskell/comments/42jbkh/the_html_monad_part_i/ (I read your post a while ago, forgot it, and was probably subconciously influenced by it when I wrote mine.)

    ReplyDelete
  10. Am I right - wrong - or somewhere in the middle - when under the impression that the "hole filling approach" you explained has at least some conceptual similarity to what is described in paragraph 3.1 of this paper? http://www.cs.ru.nl/~herman/PUBS/CC_types_paper.pdf

    ReplyDelete
    Replies
    1. Could you clarify what you mean by "paragraph 3.1"? I'm not sure which section of the paper you are referring to

      Delete
  11. Hi Gabriel, can you elaborate on why you convert (a -> b -> r) -> r to r ^ ((r ^ a) ^ b) and not r ^ ((r ^ b) ^ a) - even though they both give the r ^ (r ^ (a * b))?

    ReplyDelete
    Replies
    1. Oh, that was just due to sloppiness on my part. `r ^ ((r ^ b) ^ a)` would be the exact translation

      Delete
  12. runCont (unitAttack target) continue :: IO ()
    should it be
    runContT (unitAttack target) continue :: IO ()

    ReplyDelete
    Replies
    1. Yeah, you're right! I just fixed it. Thank you for catching that

      Delete
    2. Hi Gabriella, where could I learn more about those translations:
      Either a b <=> a + b
      (a, b) <=> a * b
      a -> b <=> b ^ a
      The third one is new to me. Thank you.

      Delete
  13. Thank you for writing this! I've been using the continuation monad to wrap `bracket` and `withForeignPtr`, but got stuck with `withSystemTempFile` because the callback takes two parameters. This article gave me the insight get myself unstuck:

    withSystemTempFileC :: MonadUnliftIO m => String -> ContT r m (FilePath, Handle)
    withSystemTempFileC template = ContT $ withSystemTempFile template . curry

    ReplyDelete
  14. Although, still quite dense for me, this was a beautiful article, which I greatly enjoyed reading and re-reading. Thank you very much for putting in so much effort!

    I just have one question . . . isn't there a typo in the data constructor of ContT here:
    nextContribution currHole = ConT $ \nextHole -> case currHole of

    ReplyDelete