The idea is that whenever we have a monoidal value - a type that is an instance of the Monoid type class - we can sometimes produce a more ergonomic API if we change our functions to instead to a list of these monoidal values.

I recently proposed an instance of this pattern to lucid, and it was well received and ultimately merged as part of the new lucid2 package. To motivate this post, I’m going to start by reiterating my proposal.

lucid is a domain specific language for producing HTML documents. In lucid we have the Attribute type which represents a single key-value pairing. When we construct HTML elements, we supply a [Attribute] list. For example,

div_ :: [Attribute] -> Html a -> Html a

(Note that lucid has an overloading mechanism, and this is one possible type of div_).

The problem with this API is that it makes it difficult to abstract groups of attributes and reuse them.

Example 1

My motivation came from using the fantastic HTMX library, and wanting to group a common set of attributes that are needed whenever you connect an element with an end-point that serves server-sent events. More specifically, I wanted to “tail” an event stream, automatically scrolling the latest element of the stream into view (using Alpine.js). An example of the attributes are:

<div
   hx-sse="connect:/stream"
   hx-swap="beforeend"
   x-on:sse-message.camel="$el.scrollIntoView(false);">

In lucid, we can express this as:

div_
  [ makeAttribute "hx-sse" "connect:/stream"
  , makeAttribute "hx-swap" "beforeend"
  , makeAttribute "x-on:sse-message.camel" "$el.scrollIntoView(false);"
  ]

This is great, but my problem is wanting to re-use these attributes. If I have another page that I also want to have a stream in, I could copy these attributes, but the programmer in me is unhappy with that. Instead, I want to try and share this definition.

One option is:

tailSSE url =
  [ makeAttribute "hx-sse" $ "connect:" <> url
  , makeAttribute "hx-swap" "beforeend"
  , makeAttribute "x-on:sse-message.camel" "$el.scrollIntoView(false);"
  ]

But look what happens when I use this:

div_
  (concat [ tailSSE "/stream", [ class_ "stream-container" ] ])

Urgh! Just using this requires that I call concat, and to use more attributes I have to nest them in another list, and then I have to surround the whole thing in parenthesis. Worse, look what happens if we consider this code in the context of more “ordinary” HTML:

div_ [class_ "page"] do
  h1_ "Heading"
  div_
    [class_ "scroll"]
    do
      div_
        ( concat
            [ tailSSE "/stream",
              [ class_ "stream-container",
                id_ "stream-1"
              ]
            ]
        )

Our SSE attributes stand out like a sore thumb, ruining the nice DSL that lucid gives us.

At this point, we need to start thinking about ways to fix this.

Before we get to that, let’s look at one more example

Example 2

Continuing with lucid, I’m also a user of Tailwind for styling pages. In Tailwind, we combine primitive classes to style our elements. Sometimes, this styling needs to be conditional. When we we layout a list, we might want to emphasize a particular element:

ul_ do
  li_ [ class_ "p-4" ] "Item 1"
  li_ [ class_ "p-4 font-bold" ] "Item 2"
  li_ [ class_ "p-4" ] "Item 3"

Generally this list will come from another container which we want to enumerate over:

ul_ do
  for_ items \item ->
    li_ [ class_ $ if active item then "p-4 font-bold" else "p-4" ]

It’s unfortunate that we’ve had to repeat p-4 here. We could of course factor that out, but what I more generally want to do is define a common attribute for list items, and another attribute that indicates active. Then, for active items I can just conditionally add the “active” element:

ul_ do
  for_ items \item ->
    li_
      [ class_ "p-4"
      , if active item then class_ "font-bold" else ???
      ]
      (toHTML (caption item))

But what we are we going to put for ???? There isn’t really an “identity” attribute. A common hack is to add class_ "", but that is definitely a hack.

Solutions

If you see both of these problems, a natural reaction might be to make Attribute an instance of Monoid. We might change the type of

div_ :: Attributes -> Html a -> Html a

However, when we do this we momentarily make things a little worse. Starting with the second example 2:

ul_ do
  for_ items \item ->
    li_
      ( mconcat
          [ class_ "p-4",
          , if active item then class_ "font-bold" else mempty
          ]
      )
      (toHTML (caption item))

Our ??? becomes mempty which literally means “no attributes at all”. This solves our problem, but the cost is that overall the API has got more verbose.

How about our first example?

div_ (class_ "page") do
  h1_ "Heading"
  div_
    (class_ "scroll")
    do
      div_
        ( mconcat
            [ tailSSE "/stream",
            , class_ "stream-container",
            , id_ "stream-1"
            ]
        )

The result here is somewhat mixed. Applying a single attribute isn’t too bad, but my main objection to this was that it’s inconsistent, and here it’s even more inconsistent - a single attribute uses parethesis, but multiple attributes need a call to mconcat. It is nice though that our tailSSE call no longer sticks out, and just looks like any other attribute.

The list of monoids pattern

With that setup, I can now present my solution - the list of monoids pattern. As the name suggests, the trick is to simply change our Attributes argument to now be a [Attributes]. This is essentially a list-of-lists of key-value pairs, which is probably not our first instinct when creating this API. However, I think it pays of when we try and lay out HTML using lucid:

div_ [ class_ "page" ] do
  h1_ "Heading"
  div_
    [ class_ "scroll" ]
    do
      div_
        [ tailSSE "/stream",
        , class_ "stream-container",
        , id_ "stream-1"
        ]

We’re back to where we started! However, we’ve also retained a solution to the second example:

ul_ do
  for_ items \item ->
    li_
      [ class_ "p-4",
      , if active item then class_ "font-bold" else mempty
      ]
      (toHTML (caption item))

lucid could go further

Interestingly, once I had this observation I realised that lucid could actually go further. Html a is a Monoid, but notice that when we construct a div_ we supply a single Html a. This post suggests that an alternative API is instead:

div_ :: [Attributes] -> [Html a] -> Html a

Users of Elm might be getting a sense of déjà vu, as this is very similar to the type that Elm uses! I like this form because I think it makes HTML documents much more regular:

div_
  [ class_ "p-4 font-bold" ]
  [ p_ "Paragraph 1"
  , img_ [ src_ "haskell.gif" ]
  , p_ "More"
  ]

Elm falls short of the pattern advocated in this blog post, as both attributes and html elements lack an identity element, so while Elm uses lists, they aren’t lists of monoidal values.

optparse-applicative

I want to briefly compare this to the API in optparse-applicative. Gabriella postulated that optparse-applicative might be more approachable if it used records instead of its current monoidal based API. While I don’t disagree, I want to suggest that the list-of-monoids pattern here might also help.

When we use optparse-applicative, we often end up with code like:

flag
  True
  False
   ( long "no-extensions"
   <> short 'E'
   <> help "Don't show the possible extensions for physical files" 
   )

Here we’re using a <> like a list. Unfortunately, this has two problems:

• Automatic code formatters already have a way to format lists, but they aren’t generally aware that we’re using <> as if it were constructing a list. This leads to either unexpected formatting, or special-casing within the formatter.

• It’s less discoverable to new Haskell users that they can supply multiple values. Even an experienced Haskell user will likely have to look up the type and spot the Monoid instance.

If optparse-applicative instead used a list of monoids, the API would be a little more succinct for users, while not losing any functionality:

flag
  True
  False
  [ long "no-extensions"
  , short 'E'
  , help "Don't show the possible extensions for physical files"
  ]

Modifiers can be grouped and abstracted as before, and if we want to compute modifiers with an option to produce no modifiers at all, we can still return mempty. However users are no longer burdened with needing to combine modifiers using <>, and can instead lean on Haskell’s special syntax for lists.

Concluding thoughts

If at this point you’re somewhat underwhelmed by this blog post, don’t worry! This pattern is extremely simple - there are no complex tricks required, it’s just literally wrapping things in a list, moving a call to mconcat, and you’re done. However, I think the implications are fairly significant, and I highly recommend you give this a try.

The Problem

Before we start looking at any code, let’s look at some requirements, and understand the problems that come with some potential solutions. The main requirement is that we are able to write code that requires some effects (in essence, writing our code to an effect interface), and then run this code with different interpretations. For example, in production I might want to run as fast as possible, in local development I might want further diagnostics, and in testing I might want a pure or in memory solution. This change in representation shouldn’t require me to change the underlying library code.

Seasoned Haskellers might be familiar with the use of effect systems to solve these kinds of problems. Perhaps the most familiar is the mtl approach - perhaps unfortunately named as the technique itself doesn’t have much to do with the library. In the mtl approach, we write our interfaces as type classes abstracting over some Monad m, and then provide instances of these type classes - either by stacking transformers (“plucking constraints”, in the words of Matt Parson), or by a “mega monad” that implements many of these instances at once (e.g., like Tweag’s capability) approach.

Despite a few annoyances (e.g., the “n+k” problem, the lack of implementations being first-class, and a few other things), this approach can work well. It also has the potential to generate a great code, but in practice it’s rarely possible to achieve maximal performance. In her excellent talk “Effects for Less”, Alexis King hits the nail on the head - despite being able to provide good code for the implementations of particular parts of an effect, the majority of effectful code is really just threading around inside the Monad constraint. When we’re being polymorphic over any Monad m, GHC is at a loss to do any further optimization - and how could it? We know nothing more than “there will be some >>= function when you get here, promise!” Let’s look at this in a bit more detail.

Say we have the following:

foo :: Monad m => m Int
foo = go 0 1_000_000_000
  where
    go acc 0 = return acc
    go acc i = return acc >> go (acc + 1) (i - 1)

This is obviously “I needed an example for my blog” levels of contrived, but at least small. How does it execute? What are the runtime consequences of this code? To answer, we’ll go all the way down to the STG level with -ddump-stg:

$wfoo =
    \r [ww_s2FA ww1_s2FB]
        let {
          Rec {
          $sgo_s2FC =
              \r [sc_s2FD sc1_s2FE]
                  case eqInteger# sc_s2FD lvl1_r2Fp of {
                    __DEFAULT ->
                        let {
                          sat_s2FK =
                              \u []
                                  case +# [sc1_s2FE 1#] of sat_s2FJ {
                                    __DEFAULT ->
                                        case minusInteger sc_s2FD lvl_r2Fo of sat_s2FI {
                                          __DEFAULT -> $sgo_s2FC sat_s2FI sat_s2FJ;
                                        };
                                  }; } in
                        let {
                          sat_s2FH =
                              \u []
                                  let { sat_s2FG = CCCS I#! [sc1_s2FE]; } in  ww1_s2FB sat_s2FG;
                        } in  ww_s2FA sat_s2FH sat_s2FK;
                    1# ->
                        let { sat_s2FL = CCCS I#! [sc1_s2FE]; } in  ww1_s2FB sat_s2FL;
                  };
          end Rec }
        } in  $sgo_s2FC lvl2_r2Fq 0#;

foo =
    \r [w_s2FM]
        case w_s2FM of {
          C:Monad _ _ ww3_s2FQ ww4_s2FR -> $wfoo ww3_s2FQ ww4_s2FR;
        };

In STG, whenever we have a let we have to do a heap allocation - and this code has quite a few! Of particular interest is the what’s going on inside the actual loop $sgo_s2FC. This loop first compares i to see if it’s 0. In the case that’s it’s not, we allocate two objects and call ww_s2Fa. If you squint, you’ll notice that ww_s2FA is the first argument to $wfoo, and it ultimately comes from unpacking a C:Monad dictionary. I’ll save you the labor of working out what this is - ww_s2Fa is the >>. We can see that every iteration of our loop incurs two allocations for each argument to >>. A heap allocation doesn’t come for free - not only do we have to do the allocation, the entry into the heap incurs a pointer indirection (as heap objects have an info table that points to their entry), and also by merely being on the heap we increase our GC time as we have a bigger heap to traverse. While my STG knowledge isn’t great, my understanding of this code is that every time we want to call >>, we need to supply it with its arguments. This means we have to allocate two closures for this function call - which is basically whenever we pressed “return” on our keyboard when we wrote the code. This seems crazy - can you imagine if you were told in C that merely using ; would cost time and memory?

If we compile this code in a separate module, mark it as {-# NOINLINE #-}, and then call it from main - how’s the performance? Let’s check!

module Main (main) where

import Foo

main :: IO ()
main = print =<< foo

$ ./Main +RTS -s
1000000000
 176,000,051,368 bytes allocated in the heap
       8,159,080 bytes copied during GC
          44,408 bytes maximum residency (1 sample(s))
          33,416 bytes maximum slop
               0 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     169836 colls,     0 par    0.358s   0.338s     0.0000s    0.0001s
  Gen  1         1 colls,     0 par    0.000s   0.000s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time   54.589s  ( 54.627s elapsed)
  GC      time    0.358s  (  0.338s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time   54.947s  ( 54.965s elapsed)

  %GC     time       0.0%  (0.0% elapsed)

  Alloc rate    3,224,078,302 bytes per MUT second

  Productivity  99.3% of total user, 99.4% of total elapsed

OUCH. My i7 laptop took almost a minute to iterate a loop 1 billion times.

A little disclaimer: I’m intentionally painting a severe picture here - in practice this cost is irrelevant to all but the most performance sensitive programs. Also, notice where the let bindings are in the STG above - they are nested within the loop. This means that we’re essentially allocating “as we go” - these allocations are incredibly cheap, and the growth to GC is equal trivial, resulting in more like constant GC pressure, rather than impending doom. For code that is likely to do any IO, this cost is likely negligible compared to the rest of the work. Nonetheless, it is there, and when it’s there, it’s nice to know if there are alternatives.

So, is the TL;DR that Haskell is completely incapable of writing effectful code? No, of course not. There is another way to compile this program, but we need a bit more information. If we happen to know what m is and we have access to the Monad dictionary for m, then we might be able to inline >>=. When we do this, GHC can be a lot smarter. The end result is code that now doesn’t allocate for every single >>=, and instead just gets on with doing work. One trivial way to witness this is to define everything in a single module (Alexis rightly points out this is a trap for benchmarking that many fall into, but for our uses it’s the behavior we actually want).

This time, let’s write everything in one module:

module Main ( main ) where

And the STG:

lvl_r4AM = CCS_DONT_CARE S#! [0#];

lvl1_r4AN = CCS_DONT_CARE S#! [1#];

Rec {
main_$sgo =
    \r [void_0E sc1_s4AY sc2_s4AZ]
        case eqInteger# sc1_s4AY lvl_r4AM of {
          __DEFAULT ->
              case +# [sc2_s4AZ 1#] of sat_s4B2 {
                __DEFAULT ->
                    case minusInteger sc1_s4AY lvl1_r4AN of sat_s4B1 {
                      __DEFAULT -> main_$sgo void# sat_s4B1 sat_s4B2;
                    };
              };
          1# -> let { sat_s4B3 = CCCS I#! [sc2_s4AZ]; } in  Unit# [sat_s4B3];
        };
end Rec }

main2 = CCS_DONT_CARE S#! [1000000000#];

main1 =
    \r [void_0E]
        case main_$sgo void# main2 0# of {
          Unit# ipv1_s4B7 ->
              let { sat_s4B8 = \s [] $fShowInt_$cshow ipv1_s4B7;
              } in  hPutStr' stdout sat_s4B8 True void#;
        };

main = \r [void_0E] main1 void#;

main3 = \r [void_0E] runMainIO1 main1 void#;

main = \r [void_0E] main3 void#;

The same program compiled down to much tighter loop that is almost entirely free of allocations. In fact, the only allocation that happens is when the loop terminates, and it’s just boxing the unboxed integer that’s been accumulating in the loop.

As we might hope, the performance of this is much better:

$ ./Main +RTS -s
1000000000
  16,000,051,312 bytes allocated in the heap
         128,976 bytes copied during GC
          44,408 bytes maximum residency (1 sample(s))
          33,416 bytes maximum slop
               0 MB total memory in use (0 MB lost due to fragmentation)

                                     Tot time (elapsed)  Avg pause  Max pause
  Gen  0     15258 colls,     0 par    0.031s   0.029s     0.0000s    0.0000s
  Gen  1         1 colls,     0 par    0.000s   0.000s     0.0001s    0.0001s

  INIT    time    0.000s  (  0.000s elapsed)
  MUT     time    9.402s  (  9.405s elapsed)
  GC      time    0.031s  (  0.029s elapsed)
  EXIT    time    0.000s  (  0.000s elapsed)
  Total   time    9.434s  (  9.434s elapsed)

  %GC     time       0.0%  (0.0% elapsed)

  Alloc rate    1,701,712,595 bytes per MUT second

  Productivity  99.7% of total user, 99.7% of total elapsed

Our time in the garbage collector dropped by a factor of 10, from 0.3s to 0.03. Our total allocation dropped from 176GB (yes, you read that right) to 16GB (I’m still not entirely sure what this means, maybe someone can enlighten me). Most importantly our total runtime dropped from 54s to just under 10s. All this from just knowing what m is at compile time.

So GHC is capable of producing excellent code for monads - what are the circumstances under which this happens? We need, at least:

1. The source code of the thing we’re compiling must be available. This means it’s either defined in the same module, or is available with an INLINABLE pragma (or GHC has chosen to add this itself).

2. The definitions of >>= and friends must also be available in the same way.

These constraints start to feel a lot like needing whole program compilation, and in practice are unreasonable constraints to reach. To understand why, consider that most real world programs have a small Main module that opens some connections or opens some file handles, and then calls some library code defined in another module. If this code in the other module was already compiled, it will (probably) have been compiled as a function that takes a Monad dictionary, and just calls the >>= function repeatedly in the same manner as our original STG code. To get the allocation-free version, this library code needs to be available to the Main module itself - as that’s the module that choosing what type to instantiate ‘m’ with - which means the library code has to have marked that code as being inlinable. While we could add INLINE everywhere, this leads to an explosion in the amount of code produced, and can sky rocket compilation times.

Alexis’ eff library works around this by not being polymorphic in m. Instead, it chooses a concrete monad with all sorts of fancy continuation features. Likewise, if we commit to a particular monad (a transformer stack, or maybe using RIO), we again avoid this cost. Essentially, if the monad is known a priori at time of module compilation, GHC can go to town. However, the latter also commits to semantics - by choosing a transformer stack, we’re choosing a semantics for our monadic effects.

With the scene set, I now want to present you with another approach to solving this problem using Backpack.

A Backpack Primer

Vanilla GHC has a very simple module system - modules are essentially a method for name-spacing and separate compilation, they don’t do much more. The Backpack project extends this module system with a new concept - signatures. A signature is like the “type” of a module - a signature might mention the presence of some types, functions and type class instances, but it says nothing about what the definitions of these entities are. We’re going to (ab)use this system to build up transformer stacks at configuration time, and allow our library to be abstracted over different monads. By instantiating our library code with different monads, we get different interpretations of the same program.

I won’t sugar coat - what follows is going to pretty miserable. Extremely fun, but miserable to write in practice. I’ll let you decide if you want to inflict this misery on your coworkers in practice - I’m just here to show you it can be done!

A Signature for Monads

The first thing we’ll need is a signature for data types that are monads. This is essentially the “hole” we’ll rely on with our library code - it will give us the ability to say “there exists a monad”, without committing to any particular choice.

In our Cabal file, we have:

library monad-sig
  hs-source-dirs:   src-monad-sig
  signatures:       Control.Monad.Signature
  default-language: Haskell2010
  build-depends:    base

The important line here is signatures: Control.Monad.Signature which shows that this library is incomplete and exports a signature. The definition of Control/Monad/Signature.hsig is:

signature Control.Monad.Signature where

data M a
instance Functor M
instance Applicative M
instance Monad M

This simply states that any module with this signature has some type M with instances of Functor, Applicative and Monad.

Next, we’ll put that signature to use in our library code.

Libary Code

For our library code, we’ll start with a new library in our Cabal file:

library business-logic
  hs-source-dirs:   lib
  signatures:       BusinessLogic.Monad
  exposed-modules:  BusinessLogic
  build-depends:
    , base
    , fused-effects
    , monad-sig

  default-language: Haskell2010
  mixins:
    monad-sig requires (Control.Monad.Signature as BusinessLogic.Monad)

Our business-logic library itself exports a signature, which is really just a re-export of the Control.Monad.Signature, but we rename it something more meaningful. It’s this module that will provide the monad that has all of the effects we need. Along with this signature, we also export the BusinessLogic module:

{-# language FlexibleContexts #-}
module BusinessLogic where

import BusinessLogic.Monad ( M )
import Control.Algebra ( Has )
import Control.Effect.Empty ( Empty, guard )

businessCode :: Has Empty sig M => Bool -> M Int
businessCode b = do
  guard b
  return 42

In this module I’m using fused-effects as a framework to say which effects my monad should have (though this is not particularly important, I just like it!). Usually Has would be applied to a type variable m, but here we’re applying it to the type M. This type comes from BusinessLogic.Monad, which is a signature (you can confirm this by checking against the Cabal file). Other than that, this is all pretty standard!

Backpack-ing Monad Transformers

Now we get into the really fun stuff - providing implementations of effects. I mentioned earlier that one possible way to do this is with a stack of monad transformers. Generally speaking, one would write a single newtype T m a for each effect type class, and have that transformer dispatch any effects in that class, and to lift any effects from other classes - deferring their implementation to m.

We’re going to take the same approach here, but we’ll absorb the idea of a transformer directly into the module itself. Let’s look at an implementation of the Empty effect. The Empty effect gives us a special empty :: m a function, which serves the purpose of stopping execution immediately. As a monad transformer, one implementation is MaybeT:

newtype MaybeT m a = MaybeT { runMaybeT :: m (Maybe a) }

But we can also write this using Backpack. First, our Cabal library:

library fused-effects-empty-maybe
  hs-source-dirs:   src-fused-effects-backpack
  default-language: Haskell2010
  build-depends:
    , base
    , fused-effects
    , monad-sig

  exposed-modules: Control.Carrier.Backpack.Empty.Maybe
  mixins:
    monad-sig requires (Control.Monad.Signature as Control.Carrier.Backpack.Empty.Maybe.Base)

Our library exports the module Control.Carrier.Backpack.Empty.Maybe, but also has a hole - the type of base monad this transformer stacks on top of. As a monad transformer, this would be the m parameter, but when we use Backpack, we move that out into a separate module.

The implementation of Control.Carrier.Backpack.Empty.Maybe is short, and almost identical to the body of Control.Monad.Trans.Maybe - we just change any occurrences of m to instead refer to M from our .Base module:

{-# language BlockArguments, FlexibleContexts, FlexibleInstances, LambdaCase,
      MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}

module Control.Carrier.Backpack.Empty.Maybe where

import Control.Algebra
import Control.Effect.Empty
import qualified Control.Carrier.Backpack.Empty.Maybe.Base as Base

type M = EmptyT

-- We could also write: newtype EmptyT a = EmptyT { runEmpty :: MaybeT Base.M a }
newtype EmptyT a = EmptyT { runEmpty :: Base.M (Maybe a) }

instance Functor EmptyT where
  fmap f (EmptyT m) = EmptyT $ fmap (fmap f) m

instance Applicative EmptyT where
  pure = EmptyT . pure . Just
  EmptyT f <*> EmptyT x = EmptyT do
    f >>= \case
      Nothing -> return Nothing
      Just f' -> x >>= \case
        Nothing -> return Nothing
        Just x' -> return (Just (f' x'))

instance Monad EmptyT where
  return = pure
  EmptyT x >>= f = EmptyT do
    x >>= \case
      Just x' -> runEmpty (f x')
      Nothing -> return Nothing

Finally, we make sure that Empty can handle the Empty effect:

instance Algebra sig Base.M => Algebra (Empty :+: sig) EmptyT where
  alg handle sig context = case sig of
    L Empty -> EmptyT $ return Nothing
    R other -> EmptyT $ thread (maybe (pure Nothing) runEmpty ~<~ handle) other (Just context)

Base Monads

Now that we have a way to run the Empty effect, we need a base case to our transformer stack. As our transformer is now built out of modules that conform to the Control.Monad.Signature signature, we need some modules for each monad that we could use as a base. For this POC, I’ve just added the IO monad:

library fused-effects-lift-io
  hs-source-dirs:   src-fused-effects-backpack
  default-language: Haskell2010
  build-depends:    base
  exposed-modules:  Control.Carrier.Backpack.Lift.IO

module Control.Carrier.Backpack.Lift.IO where
type M = IO

That’s it!

Putting It All Together

Finally we can put all of this together into an actual executable. We’ll take our library code, instantiate the monad to be a combination of EmptyT and IO, and write a little main function that unwraps this all into an IO type. First, here’s the Main module:

module Main where

import BusinessLogic
import qualified BusinessLogic.Monad

main :: IO ()
main = print =<< BusinessLogic.Monad.runEmptyT (businessCode True)

The BusinessLogic module we’ve seen before, but previously BusinessLogic.Monad was a signature (remember, we renamed Control.Monad.Signature to BusinessLogic.Monad). In executables, you can’t have signatures - executables can’t be depended on, so it doesn’t make sense for them to have holes, they must be complete. The magic happens in our Cabal file:

executable test
  main-is:          Main.hs
  hs-source-dirs:   exe
  build-depends:
    , base
    , business-logic
    , fused-effects-empty-maybe
    , fused-effects-lift-io
    , transformers

  default-language: Haskell2010
  mixins:
    fused-effects-empty-maybe (Control.Carrier.Backpack.Empty.Maybe as BusinessLogic.Monad) requires (Control.Carrier.Backpack.Empty.Maybe.Base as BusinessLogic.Monad.Base),
    fused-effects-lift-io (Control.Carrier.Backpack.Lift.IO as BusinessLogic.Monad.Base)

Wow, that’s a mouthful! The work is really happening in mixins. Let’s take this step by step:

1. First, we can see that we need to mixin the fused-effects-empty-maybe library. The first (X as Y) section specifies a list of modules from fused-effects-empty-maybe and renames them for the test executable that’s currently being compiled. Here, we’re renaming Control.Carrier.Backpack.Empty.Maybe as BusinessLogic.Monad. By doing this, we satisfy the hole in the business-logic library, which was otherwise incomplete.

2. But fused-effects-empty-maybe itself has a hole - the base monad for the transformer. The requires part lets us rename this hole, but we’ll still need to plug it. For now, we rename Control.Carrier.Backpack.Empty.Maybe.Base).

3. Next, we mixin the fused-effects-lift-io library, and rename Control.Carrier.Backpack.Lift.IO to be BusinessLogic.Monad.Base. We’ve now satisfied the hole for fused-effects-empty-maybe, and our executable has no more holes and can be compiled.

We’re Done!

That’s “all” there is to it. We can finally run our program:

$ cabal run
Just 42

If you compare against businessCode you’ll see that we got passed the guard and returned 42. Because we instantiated BusinessLogic.Monad with a MaybeT-like transformer, this 42 got wrapped up in Just.

Is This Fast?

The best check here is to just look at the underlying code itself. If we add

{-# options -ddump-simpl -ddump-stg -dsuppress-all #-}

to BusinessLogic and recompile, we’ll see the final code output to STDERR. The core is:

businessCode1
  = \ @ sig_a2cM _ b_a13P eta_B1 ->
      case b_a13P of {
        False -> (# eta_B1, Nothing #);
        True -> (# eta_B1, lvl1_r2NP #)
      }

and the STG:

businessCode1 =
    \r [$d(%,%)_s2PE b_s2PF eta_s2PG]
        case b_s2PF of {
          False -> (#,#) [eta_s2PG Nothing];
          True -> (#,#) [eta_s2PG lvl1_r2NP];
        };

Voila!

Conclusion

In this post, I’ve hopefully shown how we can use Backpack to write effectful code without paying the cost of abstraction. What I didn’t answer is the question of whether or you not you should. There’s a lot more to effectful code than I’ve presented, and it’s unclear to me whether this approach can scale to the needs. For example, if we needed something like mmorph’s MFunctor, what do we do? Are we stuck? I don’t know! Beyond these technical challenges, it’s clear that Backpack here is also not remotely ergonomic, as is. We’ve had to write five components just to get this done, and I pray for any one who comes to read this code and has to orientate themselves.

Nonetheless, I think this an interesting point of the effect design space that hasn’t been explored, and maybe I’ve motivated some people to do some further exploration.

The code for this blog post can be found at https://github.com/ocharles/fused-effects-backpack.

Happy holidays, all!

To recap, authorization is

the function of specifying access rights/privileges to resources related to information security and computer security in general and to access control in particular.

This is in contrast to authentication, which is the act of showing that someone is who they claim to be.

Authorization is a very important process, especially in a business like CircuitHub where we host many confidential projects. Accidentally exposing this data could be catastrophic to both our business and customers, so we take it very seriously.

Out of the box, Servant has experimental support for authorization, which is a good start. servant-server gives us Servant.Server.Experimental.Auth which makes it a doddle to plug in our existing authorization mechanism (cookies & Redis). But that only shows that we know who is asking for resources, how do we check that they are allowed to access the resources?

As a case study, I want to have a look at a particular end-point, /projects/:id/price. This endpoint calculates the pricing options CircuitHub can offer a project, and there are few important points to how this endpoint works:

1. The pricing for a project depends on the user viewing it. This is because some users can consign parts so CircuitHub won’t order them. Naturally, this affects the price, so pricing is viewer dependent.
2. Some projects are owned by organizations, and should be priced by the organization as a whole. If a user is a member of the organization that owns the project pricing has been requested for, return the pricing for the organization. If the user is not in the organization, return their own custom pricing.
3. Private projects should only expose their pricing to superusers, the owner of the project, and any members of the project’s organization (if it’s owned by an organization).

This specification is messy and complicated, but that’s just reality doing it’s thing.

Our first approach was to try and represent this in Servant’s API type. We start with the “vanilla” route, with no authentication or authorization:

type API =
  "projects"
    :> Capture "id" ProjectId
    :> "price"
    :> Get '[ JSON ] Pricing

Next, we add authorization:

type API =
  AuthProtect CircuitHub
    :> "projects"
    :> Capture "id" ProjectId
    :> "price"
    :> Get '[ JSON ] Pricing

At this point, we’re on our own - Servant offers no authorization primitives (though there are discussions on this topic).

My first attempt to add authorization to this was:

type API =
  AuthorizeWith ( AuthProtect CircuitHub )
    :> "projects"
    :> CanView ( Capture "id" ProjectId )
    :> "price"
    :> Get '[ JSON ] Pricing

There are two new routing combinators here: AuthorizeWith and CanView. The idea is AuthorizeWith somehow captures the result of authenticating, and provides that information to CanView. CanView itself does some kind of authorization using a type class based on its argument - here Capture "id" ProjectId. The result is certainly something that worked, but I was unhappy with both the complexity to implement it (which is scope to get it wrong), and the lack of actual evidence of authorization.

The latter point needs some expanding. What I mean by “lacking evidence” is that with the current approach, the authorization is essentially like writing the following code:

foo = do
  checkAuthorization
  doThings

If I later add more resource access into doThings, what will hold me accountable to checking authorization on those resources? The answer is… nothing! This is similar to boolean blindless - we performed logical check, only to throw all the resulting evidence away immediately.

At this point I wanted to start exploring some different options. While playing around with ideas, I was reminded of the wonderful paper “Ghosts of Departed Proofs”, and it got me thinking… can we use these techniques for authorization?

Ghosts of Departed Proofs

The basic idea of GDP is to name values using higher-rank quantification, and then - in trusted modules - produce proofs that refer to these names. To name values, we introduce a Named type, and the higher-ranked function name to name things:

module Named ( Named, forgetName, name ) where

newtype Named n a = Named { forgetName :: a }

name :: a -> ( forall name. Named name a -> r ) -> r
name x f = f ( Named x )

Note that the only way to construct a Named value outside of this module is to use name, which introduces a completely distinct name for a limited scope. Within this scope, we can construct proofs that refer to these names. As a basic example, we could use GDP to prove that a number is prime:

module Prime ( IsPrime, checkPrime ) where

data IsPrime name = IsPrime

checkPrime :: Named name Int -> Maybe (IsPrime name)
checkPrime named | isPrime (forgetName named) = Just IsPrime
                 | otherwise                  = Nothing

Here we have our first proof witness - IsPrime. We can witness whether or not a named Int is prime using checkPrime - like the boolean value isPrime this determines if a number is or isn’t prime, but we get evidence that we’ve checked a specific value for primality.

This is the whirlwind tour of GDP, I highly recommend reading the paper for a more thorough explanation. Also, the library justified-containers explores these ideas in the context of maps, where we have proofs that specific items are in the map (giving us total lookups, rather than partial lookups).

GDP and Authorization

This is all well and good, but how does this help with authorization? The basic idea is that authorization is itself a proof - a proof that we can view or interact with resources in a particular way. First, we have to decide which functions need authorization - these functions will be modified to require proof values the refer to the function arguments. In this example, we’ll assume our Servant handler is going to itself make a call to the price :: ProjectId -> UserId -> m Price function. However, given the specification above, we need to make sure that user and project are compatible. To do this, we’ll name the arguments, and then introduce a proof that the user in question can view the project:

price
  :: Named projectId ProjectId
  -> Named userId UserId
  -> userId `CanViewProject` projectId
  -> m Price

But what is this CanViewProject proof?

A first approximation is to treat it as some kind of primitive or axiom. A blessed function can postulate this proof with no further evidence:

module CanViewProject ( CanViewProject, canViewProject ) where

data CanViewProject userId projectId =
  TrustMe

canViewProject
  :: Named projectId ProjectId
  -> Named userId UserId
  -> m ( Maybe ( CanViewProject userId projectId ) )
canViewProject = do
  -- ... lots of database access/IO

  if ...
    then return ( Just TrustMe )
    else return Nothing

This is a good start! Our price function can only be called with a CanViewProject that matches the named arguments, and the only way to construct such a value is to use canViewProject. Of course we could get the implementation of this wrong, so we should focus our testing efforts to make sure it’s doing the right thing.

However, the Agda programmer in me is a little unhappy about just blindly postulating CanViewProject at the end. We’ve got a bit of vision back from our boolean blindness, but the landscape is still blurry. Fortunately, all we have to do is recruit more of the same machinery so far to subdivide this proof into smaller ones:

module ProjectIsPublic ( ProjectIsPublic, projectIsPublic ) where

data ProjectIsPublic project = TrustMe

projectIsPublic
  :: Named projectId ProjectId
  -> m ( Maybe ( ProjectIsPublic projectId ) )

module UserBelongsToProjectOrganization
  ( UserBelongsToProjectOrganization, userBelongsToProjectOrganization )
  where

data UserBelongsToProjectOrganization user project = TrustMe

userBelongsToProjectOrganization
  :: Named userId UserId
  -> Named projectId ProjectId
  -> m ( Maybe ( UserBelongsToProjectOrganization userId projectId ) )

module UserIsSuperUser ( UserIsSuperUser, userIsSuperUser ) where

data UserIsSuperUser user = TrustMe

userIsSuperUser :: Named userId UserId -> m ( Maybe ( UserIsSuperUser userId ) )

module UserOwnsProject ( UserOwnsProject, userOwnsProject ) where

data UserOwnsProject user project = TrustMe

userOwnsProject
  :: Named userId UserId
  -> Named projectId ProjectId
  -> m ( Maybe ( UserOwnsProject userId projectId ) )

Armed with these smaller authorization primitives, we can build up our richer authorization scheme:

module CanViewProject where

data CanViewProject userId projectId
  = ProjectIsPublic (ProjectIsPublic projectId)
  | UserOwnsProject (UserOwnsProject userId projectId)
  | UserIsSuperUser (UserIsSuperUser userId)
  | UserBelongsToProjectOrganization
      (UserBelongsToProjectOrganization userId projectId)

canViewProject
  :: Named userId UserId
  -> Named projectId ProjectId
  -> m ( Maybe ( CanViewProject userId projectId ) )

Now canViewProject just calls out to the other authorization routines to build it’s proof. Furthermore, there’s something interesting here. CanViewProject doesn’t postulate anything - everything is attached with a proof of the particular authorization case. This means that we can actually open up the whole CanViewProject module to the world - there’s no need to keep anything private. By doing this and allowing people to pattern match on CanViewProject, authorization results become reusable - if something else only cares that a user is a super user, we might be able to pull this directly out of CanViewProject - no need for any redundant database checks!

In fact, this very idea can help us implement the final part of our original specification:

Some projects are owned by organizations, and should be priced by the organization as a whole. If a user is a member of the organization that owns the project pricing has been requested for, return the pricing for the organization. If the user is not in the organization, return their own custom pricing.

If we refine our UserBelongsToProjectOrganization proof, we can actually maintain a bit of extra evidence:

data UserBelongsToProjectOrganization userId projectId where
  UserBelongsToProjectOrganization
    :: { projectOrganizationId :: Named orgId UserId
       , organizationOwnsProject :: UserOwnsProject orgId projectId
       }
    -> UserBelongsToProjectOrganization userId projectId

withUserBelongsToProjectOrganizationEvidence
  :: UserBelongsToProjectOrganization userId projectId
  -> ( forall orgId. Named orgId UserId -> UserOwnsProject orgId projectId -> r )
  -> r
withUserBelongsToProjectOrganizationEvidence UserBelongsToProjectOrganization{..} k =
  k projectOrganizationId organizationOwnsProject

Now whenever we have a proof UserBelongsToProjectOrganization, we can pluck out the actual organization that we’re talking about. We also have evidence that the organization owns the project, so we can easily construct a new CanViewProject proof - proofs generate more proofs!

price
  :: Named projectId ProjectId
  -> Named userId UserId
  -> userId `CanViewProject` projectId
  -> m Price
price projectId userId = \case
  UserBelongsToProjectOrganization proof ->
    withUserBelongsToProjectOrganizationEvidence proof \orgId ownership ->
      price projectId orgId (UserOwnsProject ownership)

Relationship to Servant

At the start of this post, I mentioned that the goal was to integrate this with Servant. So far, we’ve looked at adding authorization to a single function, so how does this interact with Servant? Fortunately, it requires very little to change. The Servant API type is authorization free, but does mention authentication.

type API =
  AuthProtect CircuitHub
    :> "projects"
    :> Capture "id" ProjectId
    :> "price"
    :> Get '[ JSON ] Pricing

It’s only when we need to call our price function do we need to have performed some authorization, and this happens in the server-side handler. We do this by naming the respective arguments, witnessing the authorization proof, and then calling price:

priceProject :: User -> ProjectId -> Handler Pricing
priceProject user projectId = do
  name (userId user) \namedUserId ->
  name projectId \namedProjectId ->
    canViewProjectProof <-
      canViewProject namedUserId namedProjectId

    case mcanViewProjectProof of
      Nothing ->
        fail "Authorization failed"

      Just granted ->
        price namedProjectId namedUserId granted

Conclusion

That’s where I’ve got so far. It’s early days so far, but the approach is promising. What I really like is there is almost a virtual slider between ease and rigour. It can be easy to get carried away, naming absolutely everything and trying to find the most fundamental proofs possible. I’ve found so far that it’s better to back off a little bit - are you really going to get some set membership checks wrong? Maybe. But a property check is probably gonig to be enough to keep that function in check. We’re not in a formal proof engine setting, pretending we are just makes things harder than they need to be.

Roughly speaking, planning problems are a subclass of AI problems where we need to work out a plan that moves us from an initial state to some goal state. Typically, we have:

• A known starting state - information about the world we know to be true right now.
• A set of possible effects - deterministic ways we can change the world.
• A goal state that we wish to reach.

With this, we need to find a plan:

• A solution to a planning problem is a plan - a totally ordered sequence of steps that converge the starting state into the goal state.

Planning problems are essentially state space search problems, and crop up in all sorts of places. The common examples are that of moving a robot around, planning logistics problems, and so on, but they can be used for plenty more! For example, the Beam library uses state space search to work out how to converge a database from one state to another (automatic migrations) by adding/removing columns.

State space search is an intuitive approach - simply build a graph where nodes are states and edges are state transitions (effects), and find a path (possibly shortest) that gets you from the starting state to a state that satisfies some predicates. However, naive enumeration of all states rapidly grinds to a halt. Forming optimal plans (least cost, least steps, etc) is an extremely difficult problem, and there is a lot of literature on the topic (see ICAPS - the International Conference on Automated Planning and Scheduling and recent International Planning Competitions for an idea of the state of the art). The fast-downward library uses the state of the art Fast Downward solver and provides a small DSL to interface to it with Haskell.

In this post, we’ll look at using fast-downward in the context of solving a small planning problem - moving balls between rooms via a robot. This post is literate Haskell, here’s the context we’ll be working in:

{-# language DisambiguateRecordFields #-}

module FastDownward.Examples.Gripper where

import Control.Monad
import qualified FastDownward.Exec as Exec
import FastDownward.Problem

If you’d rather see the Haskell in it’s entirety without comments, simply head to the end of this post.

Modelling The Problem

Defining the Domain

As mentioned, in this example, we’ll consider the problem of transporting balls between rooms via a robot. The robot has two grippers and can move between rooms. Each gripper can hold zero or one balls. Our initial state is that everything is in room A, and our goal is to move all balls to room B.

First, we’ll introduce some domain specific types and functions to help model the problem. The fast-downward DSL can work with any type that is an instance of Ord.

data Room = RoomA | RoomB
  deriving (Eq, Ord, Show)

adjacent :: Room -> Room
adjacent RoomA = RoomB
adjacent RoomB = RoomA

data BallLocation = InRoom Room | InGripper
  deriving (Eq, Ord, Show)

data GripperState = Empty | HoldingBall
  deriving (Eq, Ord, Show)

A ball in our model is modelled by its current location. As this changes over time, it is a Var - a state variable.

type Ball = Var BallLocation

A gripper in our model is modelled by its state - whether or not it’s holding a ball.

type Gripper = Var GripperState

Finally, we’ll introduce a type of all possible actions that can be taken:

data Action = PickUpBall | SwitchRooms | DropBall
  deriving (Show)

With this, we can now begin modelling the specific instance of the problem. We do this by working in the Problem monad, which lets us introduce variables (Vars) and specify their initial state.

Setting the Initial State

problem :: Problem (SolveResult Action)
problem = do

First, we introduce a state variable for each of the 4 balls. As in the problem description, all balls are initially in room A.

  balls <- replicateM 4 (newVar (InRoom RoomA))

Next, introduce a variable for the room the robot is in - which also begins in room A.

  robotLocation <- newVar RoomA

We also introduce variables to track the state of each gripper.

  grippers <- replicateM 2 (newVar Empty)

This is sufficient to model our problem. Next, we’ll define some effects to change the state of the world.

Defining Effects

Effects are computations in the Effect monad - a monad that allows us to read and write to variables, and also fail (via MonadPlus). We could define these effects as top-level definitions (which might be better if we were writing a library), but here I’ll just define them inline so they can easily access the above state variables.

Effects may be used at any time by the solver. Indeed, that’s what solving planning problems is all about! The hard part is choosing effects intelligently, rather than blindly trying everything. Fortunately, you don’t need to worry about that - Fast Downward will take care of that for you!

  let

Picking Up Balls

The first effect takes a ball and a gripper, and attempts to pick up that ball with that gripper.

    pickUpBallWithGripper :: Ball -> Gripper -> Effect Action
    pickUpBallWithGripper b gripper = do
      Empty <- readVar gripper                  -- (1)

      robotRoom <- readVar robotLocation        -- (2)
      ballLocation <- readVar b
      guard (ballLocation == InRoom robotRoom)  -- (3)

      writeVar b InGripper                      -- (4)
      writeVar gripper HoldingBall

      return PickUpBall                         -- (5)

1. First we check that the gripper is empty. This can be done concisely by using an incomplete pattern match. do notation desugars incomplete pattern matches to a call to fail, which in the Effect monad simply means “this effect can’t currently be used”.

2. Next, we check where the ball and robot are, and make sure they are both in the same room.

3. Here we couldn’t choose a particular pattern match to use, because picking up a ball should be possible in either room. Instead, we simply observe the location of both the ball and the robot, and use an equality test with guard to make sure they match.

4. If we got this far then we can pick up the ball. The act of picking up the ball is to say that the ball is now in a gripper, and that the gripper is now holding a ball.

5. Finally, we return some domain specific information to use if the solver chooses this effect. This has no impact on the final plan, but it’s information we can use to execute the plan in the real world (e.g., sending actual commands to the robot).

Moving Between Rooms

This effect moves the robot to the room adjacent to its current location.

    moveRobotToAdjacentRoom :: Effect Action
    moveRobotToAdjacentRoom = do
      modifyVar robotLocation adjacent

      return SwitchRooms

This is an “unconditional” effect as we don’t have any explicit guards or pattern matches. We simply flip the current location by an adjacency function.

Again, we finish by returning some information to use when this effect is chosen.

Dropping Balls

Finally, we have an effect to drop a ball from a gripper.

    dropBall :: Ball -> Gripper -> Effect Action
    dropBall b gripper = do
      HoldingBall <- readVar gripper     -- (1)
      InGripper <- readVar b

      robotRoom <- readVar robotLocation -- (2)
      writeVar gripper Empty             -- (3)
      writeVar b (InRoom robotRoom)      -- (4)

      return DropBall                    -- (5)

1. First we check that the given gripper is holding a ball, and the given ball is in a gripper.

2. If we got here then those assumptions hold. We’ll update the location of the ball to be the location of the robot, so first read out the robot’s location.

3. Empty the gripper

4. Move the ball.

5. And we’re done! We’ll just return a tag to indicate that this effect was chosen.

Solving Problems

With our problem modelled, we can now attempt to solve it. We invoke solve with a particular search engine (in this case A* with landmark counting heuristics). We give the solver two bits of information:

1. A list of all effects - all possible actions the solver can use. These are precisely the effects we defined above, but instantiated for all balls and grippers.
2. A goal state. Here we’re using a list comprehension which enumerates all balls, adding the condition that the ball location must be InRoom RoomB.

  solve
    cfg
    ( [ pickUpBallWithGripper b g | b <- balls, g <- grippers ]
        ++ [ dropBall b g | b <- balls, g <- grippers ]
        ++ [ moveRobotToAdjacentRoom ]
    )
    [ b ?= InRoom RoomB | b <- balls ]

So far we’ve been working in the Problem monad. We can escape this monad by using runProblem :: Problem a -> IO a. In our case, a is SolveResult Action, so running the problem might give us a plan (courtesy of solve). If it did, we’ll print the plan.

main :: IO ()
main = do
  res <- runProblem problem
  case res of
    Solved plan -> do
      putStrLn "Found a plan!"
      zipWithM_ 
        ( \i step -> putStrLn ( show i ++ ": " ++ show step ) ) 
        [ 1::Int .. ] 
        ( totallyOrderedPlan plan )

    _ ->
      putStrLn "Couldn't find a plan!"

fast-downward allows you to extract a totally ordered plan from a solution, but can also provide a partiallyOrderedPlan. This type of plan is a graph (partial order) rather than a list (total order), and attempts to recover some concurrency. For example, if two effects do not interact with each other, they will be scheduled in parallel.

Well, Did it Work?!

All that’s left is to run the problem!

> main
Found a plan!
1: PickUpBall
2: PickUpBall
3: SwitchRooms
4: DropBall
5: DropBall
6: SwitchRooms
7: PickUpBall
8: PickUpBall
9: SwitchRooms
10: DropBall
11: DropBall

Woohoo! Not bad for 0.02 secs, too :)

Behind The Scenes

It might be interesting to some readers to understand what’s going on behind the scenes. Fast Downward is a C++ program, yet somehow it seems to be running Haskell code with nothing but an Ord instance - there are no marshalling types involved!

First, let’s understand the input to Fast Downward. Fast Downward requires an encoding in its own SAS format. This format has a list of variables, where each variable contains a list of values. The contents of the values aren’t actually used by the solver, rather it just works with indices into the list of values for a variable. This observations means we can just invent values on the Haskell side and careful manage mapping indices back and forward.

Next, Fast Downward needs a list of operators which are ground instantiations of our effects above. Ground instantiations of operators mention exact values of variables. Recounting our gripper example, pickUpBallWithGripper b gripper actually produces 2 operators - one for each room. However, we didn’t have to be this specific in the Haskell code, so how are we going to recover this information?

fast-downward actually performs expansion on the given effects to find out all possible ways they could be called, by non-deterministically evaluating them to find a fixed point.

A small example can be seen in the moveRobotToAdjacentRoom Effect. This will actually produce two operators - one to move from room A to room B, and one to move from room B to room A. The body of this Effect is (once we inline the definition of modifyVar)

  readVar robotLocation >>= writeVar robotLocation . adjacent

Initially, we only know that robotLocation can take the value RoomA, as that is what the variable was initialised with. So we pass this in, and see what the rest of the computation produces. This means we evaluate adjacent RoomA to yield RoomB, and write RoomB into robotLocation. We’re done for the first pass through this effect, but we gained new information - namely that robotLocation might at some point contain RoomB. Knowing this, we then rerun the effect, but the first readVar gives us two paths:

readVar robotLocation 
  >>= \RoomA -> writeVar robotLocation RoomB                     -- If we read RoomA
  >>= \RoomB -> writeVar robotLocation (adjacent RoomB -> RoomA) -- If we read RoomB

This shows us that robotLocation might also be set to RoomA. However, we already knew this, so at this point we’ve reached a fixed point.

In practice, this process is ran over all Effects at the same time because they may interact - a change in one Effect might cause new paths to be found in another Effect. However, because fast-downward only works with finite domain representations, this algorithm always terminates. Unfortunately, I have no way of enforcing this that I can see, which means a user could infinitely loop this normalisation process by writing modifyVar v succ, which would produce an infinite number of variable assignments.

Conclusion

CircuitHub are using this in production (and I mean real, physical production!) to coordinate activities in its factories. By using AI, we have a declarative interface to the production process – rather than saying what steps are to be performed, we can instead say what state we want to end up in and we can trust the planner to find a suitable way to make it so.

Haskell really shines here, giving a very powerful way to present problems to the solver. The industry standard is PDDL, a Lisp-like language that I’ve found in practice is less than ideal to actually encode problems. By using Haskell, we:

• Can easily feed the results of the planner into a scheduler to execute the plan, with no messy marshalling.
• Use well known means of abstraction to organise the problem. For example, in the above we use Haskell as a type of macro language – using do notation to help us succinctly formulate the problem.
• Abstract out the details of planning problems so the rest of the team can focus on the domain specific details – i.e., what options are available to the solver, and the domain specific constraints they are subject to.

fast-downward is available on Hackage now, and I’d like to express a huge thank you to CircuitHub for giving me the time to explore this large space and to refine my work into the best solution I could think of. This work is the result of numerous iterations, but I think it was worth the wait!

Appendix: Code Without Comments

Here is the complete example, as a single Haskell block:

{-# language DisambiguateRecordFields #-}

module FastDownward.Examples.Gripper where

import Control.Monad
import qualified FastDownward.Exec as Exec
import FastDownward.Problem


data Room = RoomA | RoomB
  deriving (Eq, Ord, Show)


adjacent :: Room -> Room
adjacent RoomA = RoomB
adjacent RoomB = RoomA


data BallLocation = InRoom Room | InGripper
  deriving (Eq, Ord, Show)


data GripperState = Empty | HoldingBall
  deriving (Eq, Ord, Show)


type Ball = Var BallLocation


type Gripper = Var GripperState

  
data Action = PickUpBall | SwitchRooms | DropBall
  deriving (Show)


problem :: Problem (Maybe [Action])
problem = do
  balls <- replicateM 4 (newVar (InRoom RoomA))
  robotLocation <- newVar RoomA
  grippers <- replicateM 2 (newVar Empty)

  let
    pickUpBallWithGripper :: Ball -> Gripper -> Effect Action
    pickUpBallWithGripper b gripper = do
      Empty <- readVar gripper
  
      robotRoom <- readVar robotLocation
      ballLocation <- readVar b
      guard (ballLocation == InRoom robotRoom)
  
      writeVar b InGripper
      writeVar gripper HoldingBall
  
      return PickUpBall


    moveRobotToAdjacentRoom :: Effect Action
    moveRobotToAdjacentRoom = do
      modifyVar robotLocation adjacent
      return SwitchRooms


    dropBall :: Ball -> Gripper -> Effect Action
    dropBall b gripper = do
      HoldingBall <- readVar gripper
      InGripper <- readVar b
  
      robotRoom <- readVar robotLocation
      writeVar b (InRoom robotRoom)
  
      writeVar gripper Empty
  
      return DropBall

  
  solve
    cfg
    ( [ pickUpBallWithGripper b g | b <- balls, g <- grippers ]
        ++ [ dropBall b g | b <- balls, g <- grippers ]
        ++ [ moveRobotToAdjacentRoom ]
    )
    [ b ?= InRoom RoomB | b <- balls ]

  
main :: IO ()
main = do
  plan <- runProblem problem
  case plan of
    Nothing ->
      putStrLn "Couldn't find a plan!"

    Just steps -> do
      putStrLn "Found a plan!"
      zipWithM_ (\i step -> putStrLn $ show i ++ ": " ++ show step) [1::Int ..] steps


cfg :: Exec.SearchEngine
cfg =
  Exec.AStar Exec.AStarConfiguration
    { evaluator =
        Exec.LMCount Exec.LMCountConfiguration
          { lmFactory =
              Exec.LMExhaust Exec.LMExhaustConfiguration
                { reasonableOrders = False
                , onlyCausalLandmarks = False
                , disjunctiveLandmarks = True
                , conjunctiveLandmarks = True
                , noOrders = False
                }
          , admissible = False
          , optimal = False
          , pref = True
          , alm = True
          , lpSolver = Exec.CPLEX
          , transform = Exec.NoTransform
          , cacheEstimates = True
          }
    , lazyEvaluator = Nothing
    , pruning = Exec.Null
    , costType = Exec.Normal
    , bound = Nothing
    , maxTime = Nothing
    }

Obviously, interacting with ListenBrainz requires some sort of IO so whatever API I will be offering has to live within some sort of monad. Currently, there are three major options:

1. Supply an API targetting a concrete monad stack.

   Under this option, our API would have types such as

   submitListens :: ... -> M ()
   getListens :: ... -> M Listens

   where M is some particular monad (or monad transformer).

2. Supply an API using type classes

   This is the mtl approach. Rather than choosing which monad my users have to work in, my API can be polymorphic over monads that support accessing the ListenBrainz API. This means my API is more like:

   submitListens :: MonadListenBrainz m => ... -> m ()
   getListens :: MonadListenBrainz m => ... -> m Listens

3. Use an extensible effects framework.

   Extensible effects are a fairly new entry, that are something of a mix of the above options. We target a family of concrete monads - Eff - but the extensible effects framework lets our effect (querying ListenBrainz) seamlessly compose with other effects. Using freer-effects, our API would be:

   submitListens :: Member ListenBrainzAPICall effects => ... -> Eff effects ()
   getListens :: Member ListenBrainzAPICall effects => ... -> Eff effects Listens

So, which do we choose? Evaluating the options, I have some concerns.

For option one, we impose pain on all our users who want to use a different monad stack. It’s unlikely that your application is going to be written solely to query ListenBrainz, which means client code becomes littered with lift. You may write that off as syntactic, but there is another problem - we have committed to an interpretation strategy. Rather than describing API calls, my library now skips directly to prescribing how to run API calls. However, it’s entirely possible that you want to intercept these calls - maybe introducing a caching layer or additional logging. Your only option is to duplicate my API into your own project and wrap each function call and then change your program to use your API rather than mine. Essentially, the program itself is no longer a first class value that you can transform.

Extensible effects gives us a solution to both of the above. The use of the Member type class automatically reshuffles effects so that multiple effects can be combined without syntatic overhead, and we only commit to an interpretation strategy when we actually run the program. Eff is essentially a free monad, which captures the syntax tree of effects, rather than the result of their execution.

Sounds good, but extensible effects come with (at least) two problems that make me hesistant: they are experimental and esoteric, and it’s unclear that they are performant. By using only extensible effects, I am forcing an extensible effects framework on my users, and I’d rather not dictate that. Of course, extensible effects can be composed with traditional monad transformers, but I’ve still imposed an unnecessary burden on my users.

So, what do we do? Well, as Old El Paso has taught us: why don’t we have both?

It’s trivial to actually support both a monad transformer stack and extensible effects by using an mtl type class. As I argue in Monad transformers, free monads, mtl, laws and a new approach, I think the best pattern for an mtl class is to be a monad homomorphism from a program description, and often a free monad is a fine choice to lift:

class Monad m => MonadListenBrainz m where
  liftListenBrainz :: Free f a -> m a

But what about f? As observed earlier, extensible effects are basically free monads, so we can actually share the same implementation. For freer-effects, we might describe the ListenBrainz API with a GADT such as:

data ListenBrainzAPICall returns where
  GetListens :: ... -> ListenBrainzAPICall Listens
  SubmitListens :: ... -> ListenBrainzAPICall ()

However, this isn’t a functor - it’s just a normal data type. In order for Free f a to actually be a monad, we need f to be a functor. We could rewrite ListenBrainzAPICall into a functor, but it’s even easier to just fabricate a functor for free - and that’s exactly what Coyoneda will do. Thus our mtl type class becomes:

class Monad m => MonadListenBrainz m where
  liftListenBrainz :: Free (Coyoneda ListenBrainzAPICall) a -> m a 

We can now provide an implementation in terms of a monad transformer:

instance Monad m => MonadListenBrainz (ListenBrainzT m)
  liftListenBrainz f =
    iterM (join . lowerCoyoneda . hoistCoyoneda go)

    where
      go :: ListenBrainzAPICall a -> ListenBrainzT m a

or extensible effects:

instance Member ListenBrainzAPICall effs => MonadListenBrainz (Eff effs) where
  liftListenBrainz f = iterM (join . lowerCoyoneda . hoistCoyoneda send) f 

or maybe directly to a free monad for later inspection:

instance MonadListenBrainz (Free (Coyoneda ListenBrainzAPICall)) where
  liftListenBrainz = id

For the actual implementation of performing the API call, I work with a concrete monad transformer stack:

performAPICall :: Manager -> ListenBrainzAPICall a -> IO (Either ServantError a)

which both my extensible effects “run” function calls, or the go function in the iterM call for ListenBrainzT’s MonadListenBrainz instance.

In conclusion, I’m able to offer my users a choice of either:

• a traditional monad transformer approach, which doesn’t commit to a particular intepretation strategy by using an mtl type class
• extensible effects

All without extra syntatic burden, a complicated type class, or duplicating the implementation.

You can see the final implementation of listenbrainz-client here.

Bonus - what about the ReaderT pattern?

The ReaderT design pattern has been mentioned recently, so where does this fit in? There are two options if we wanted to follow this pattern:

• We require a HTTP Manager in our environment, and commit to using this. This has all the problems of providing a concrete monad transformer stack - we are committing to an interpretation.
• We require a family of functions that explain how to perform each API call. This kind of like a van Laarhoven free monad, or really just explicit dictionary passing. I don’t see this really gaining much on abstracting with type classes.

I don’t feel like the ReaderT design pattern offers anything that isn’t already dealt with above.

transformers-eff takes inspiration from the work of algebraic effects and handlers, and splits each effect into composable programs for introducing effects and handlers that eliminate these effects. As the name indicates, this work is also closely related to monad transformer stacks, as they provide the implementation of the specific effects. I believe the novelty in my approach is that we can do this entirely within the system of monad transformers, and this observation makes it very convenient to create re-usable effects.

Core API

Before looking at an example, I want to start by presenting the core API. First, we have the Eff monad transformer:

data Eff (f :: * -> *) (m :: * -> *) (a :: *)

If you squint, you’ll see that Eff has the familiar shape of a monad transformer - it transforms a given monad m, providing it access to effects described by f. As Eff f m is itself a monad, it’s possible to stack Effs together. The type parameter f is used to indicate which effects this Eff transformer talks about.

Next, the library provides a way to eliminate Eff by translating it into a concrete monad transformer:

translate :: (Monad m,Monad (t m),MonadTrans t)
          => (forall x r. f x -> ContT r (t m) x)
          -> Eff f m a
          -> t m a

Translations are defined by a single function that is very similar to the type of “lifts” we saw in my previous blog post. The difference here is that the homomorphism maps into ContT, which allows the translation to adjust control flow. For many effects it will be enough to simply lift directly into this, but it can be useful to inspect the continuation, for example to build non-deterministic computations.

Finally, we have one type class method:

interpret :: (Monad m) => f a -> m a

However, this type class is fairly constrained in its instances, so you should read m as actually being some sort of monad transformer stack containing Eff f.

Examples

Let’s dive in and look at some examples.

Reader effects

Last post we spent a lot of time looking at various representations of the reader monad, so let’s see how this looks under transformers-eff.

We already have a definition for our language, r -> a as we saw last week. While we could work directly with this, we’ll be interpreting into ReaderT so I’ll use the Reader newtype for a little extra readibility. Given this language, we just need to write a translation into a concrete monad transformer, which will be ReaderT:

effToReaderT :: Monad m => Eff (Reader e) m a -> ReaderT e m a
effToReaderT = translate (\r -> lift (hoist generalize r))

This is a little dense, so let’s break it down. When we call translate, we have to provide a function with the type:

forall a m. Reader r a -> ContT _ (ReaderT r m) a

The ReaderT r m part is coming from the type we gave in the call to translate, that is – the type of effToReaderT. We don’t really need to concern outselves with continuations for this effect, as reading from a fixed environment does not change the flow of control - so we’ll begin with lift. We now have to produce a ReaderT r m a from a Reader r a. If we notice that Reader r a = ReaderT r Identity a, we can make use of the tools in the mmorph library, which lets us map that Identity to any m via hoist generalize.

We still need a way to easily introduce these effects into our programs, and that means writing an mtl type class. However, the instances require almost no work on our behalf and we only have to provide two, making this is a very quick process:

class (Monad m) => EffReader env m | m -> env where
  liftReader :: Reader env a -> m a

instance Monad m => EffReader env (Eff (Reader env) m) where
  liftReader = interpret

instance {-# OVERLAPPABLE #-} EffReader env m =>
           EffReader env (Eff effects m) where
  liftReader = lift . liftReader

I then provide a user-friendly API built on this lift operation:

ask :: EffEnv e m => m e
ask = liftReader (Reader id)

Finally, most users are probably more interested in running the effect rather than just translating it to ReaderT, so let’s provide a convenience function to translate and run all in one go:

runReader :: Eff (Reader r) m a -> r -> m a
runReader eff r = runReaderT (effToReaderT eff) r

In total, the reader effect is described as:

class (Monad m) => EffReader env m | m -> env where
  liftReader :: Reader env a -> m a

instance Monad m => EffReader env (Eff (Reader env) m) where
  liftReader = interpret

instance {-# OVERLAPPABLE #-} EffReader env m =>
           EffReader env (Eff effects m) where
  liftReader = lift . liftReader

ask :: EffEnv e m => m e
ask = liftReader (Reader id)

effToReaderT :: Monad m => Eff (Reader e) m a -> ReaderT e m a
effToReaderT = translate (\r -> lift (hoist generalize r))

A logging effect

We also looked at a logging effect last week, and this can also be built using transformers-eff:

data LoggingF message a = Log message deriving (Functor)

class (Monad m) => EffLog message m | m -> message where
  liftLog :: Free (LoggingF message) a -> m a

instance Monad m => EffLog env (Eff (Free (LoggingF message)) m) where
  liftLog = interpret

instance {-# OVERLAPPABLE #-} EffLog env m =>
           EffLog env (Eff effects m) where
  liftLog = lift . liftLog

log :: EffLog message m => message -> m ()
log = liftLog . liftF . Log

runLog :: (MonadIO m)
       => Eff (Free (LoggingF message) e) m a
       -> (message -> IO ())
       -> m a
runLog eff =
  runIdentityT (translate (iterM (\(Log msg) -> liftIO (io msg))))

The interpretation here is given an IO action to perform whenever a message is logged. I could have implemented this in a few ways - perhaps lifting the whole computation into ReaderT (message -> IO ()), but instead I have just used IdentityT as the target monad transformer, and added a MonadIO constraint onto m. Whenever a message is logged, we’ll directly call the given IO action. As you can also see, I’ve used a free monad as the source language for the effect. This example demonstrates that we are free to mix a variety of tools (here free monads, MonadIO and the identity transformer) in order to get the job done.

What does this approach bring?

Less type class instances

We saw above that when we introduced our EffLog type class, it was immediately available for use along side EffReader effects - and we didn’t have to do anything extra! To me, this is a huge win - I frequently find myself frustrated with the amount of work required to do when composing many different projects together with mtl, and this is not just a theoretical frustration. To provide just one example from today, I wanted to use ListT with some Yesod code that required MonadLogger. There is obviously no MonadLogger instance for ListT, and it’s almost unsolvable to provide such an instance withoutrs/o using orphan instances - neither one of those libraries should need to depend on the other, so we’re stuck! If you stay within Eff, this problem doesn’t occur.

Many will be quick to point out that in mtl it doesn’t necessary make sense to have all transformers compose due to laws (despite the lack of any laws actually being stated…), and I’m curious if this is true here. In this library, due to the limitation on having to write your effectful programs based on an underlying algebra, I’m not sure it’s possible to introduce the problematic type class methods like local and catch.

One effect at a time

In the mtl approach a single monad transformer stack might be able to deal with a whole selection of effects in one go. However, I’ve found that this can actually make it quite difficult to reason about the flow of code. To provide an example, let’s consider this small API:

findOllie :: (MonadDb m, MonadPlus m) => m Person
findOllie =
  do x <- dbLookup (PersonId 42)
     guard (personName x == "Ollie")
     return x

type QueryError = String
dbLookup :: (MonadDb m, MonadError QueryError m) => PersonId -> m Person

data DbT m a
instance Monad m => Monad (DbT m)
instance Monad m => MonadDb (DbT m)

runDb :: (MonadIO m) :: DbT m a -> m a

If we just try and apply runDb to findOllie, we’ll get

runDb findOllie :: (MonadError QueryError m, MonadIO m, MonadPlus m) => m Person

We still need to take care of MonadError and MonadPlus. For MonadError I’ll use ExceptT, and for MonadPlus I’ll use MaybeT:

runMaybeT (runExceptT (runDb findOllie)) :: IO (Maybe (Either QueryError Person))

Next, let’s consider a few scenarios. Firstly, the case where everything succeeds -

> runMaybeT (runExceptT (runDb findOllie))
Just (Right Person ...)

However, that query could fail, which would cause an error

> runMaybeT (runExceptT (runDb findOllie))
Just (Left "Table `person` not found")

Still as expected. Finally, person 42 might not actually be me, in which case we get

> runMaybeT (runExceptT (runDb findOllie))
Just (Left "")

Huh? What’s happened here is that we’ve hit the MonadPlus instance for ExceptT, and because our QueryError is a String we have a Monoid instance, so we were given an “empty” error. This is not at all what we were expecting!

While this example is a contrived one, I am very nervous that this accidental choice of instances could happen deep within another section of code, for example where I expect to do some local error handling and accidentally eliminate a chance of failure that I was expecting to deal with elsewhere.

In transformers-eff this is not possible, as each Eff deals with one and only one effect at a time. This could be done with mtl by introducing a separate type class for failure and only adding an instance for MaybeT, we are working around the problem by convention, and I would much rather bake that in to the types.

Fast code

The underlying implementation of Eff is built on top of continuations, and due to aggressive inlineing, GHC is able to work some serious magic. In fact, in all the benchmarks I’ve produced so far, Eff is as fast as transformers, and even comes out slightly faster in one (though within the same order of magnitude).

Compatible with the rest of Hackage

As Eff is just another monad transformer, you can stack in other monad transformers. Note that by doing this you may lack the type class instances you need, so explicit lifting might be necessary. I mainly expect this being useful by putting Eff “on the top” - for example I can use Eff locally with in a Snap monad computation, provided I eventually run back down to just Snap. This is the same pattern as locally using transformers.

1. Extensible. The approach we take should be open, allowing us to define new effects.
2. Composable. It should be possible to mix different effects with well defined, predictable behaviour.
3. Efficient. We should only have to pay a minimal cost for the use of the abstraction.
4. Terse. Haskell is generally not verbose, and whatever system we use should allow us to avoid excessive verbosity. The system should work with us, we should not have to work for it.

I would also add in a 5th point

5. Inferable. Type annotations should not be required for successful compilation.

With this list in mind, what are the current solutions, and how do they measure up?

Monad Transformers

Starting with the most basic, we can simply choose a concrete monad that does everything we need and work entirely in that – which is usually going to be IO. In a sense this is composable – certainly all programs in one monad compose together – but it’s composable in the same sense that dynamically typed languages fit together. Often choosing a single monad for each individual computation is too much, and it becomes very difficult to work out exactly what effects are being used in our individual functions: does this computation use IO? Will it throw exceptions? Fork threads? You don’t know without reading the source code.

Building a concrete monad can also be a lot of work. Consider a computation that needs access to some local state, a fixed environment and arbitrary IO. This has a type such as

newtype M a = M (Environment -> State -> IO (a, State))

However, to actually interact with the rest of the Haskell ecosystem we need to define (at least) instances of Functor, Applicative and Monad. This is boilerplate code and entirely determined by the choice of effects – and that means we should strive to have the compiler write it for us.

To combat this, we can make use of monad transformers. Unlike monads, monad transformers compose, which means we can build larger monads by stacking a collection of monad transformers together. The above monad M can now be defined using off-the-shelf components, but crucially we can derive all the necessary type classes in one fell swoop with the GeneralizedNewtypeDeriving language extension

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

newtype M a = M (ReaderT Environment (StateT State IO) a)
  deriving (Functor, Applicative, Monad)

This saves typing considerably, and is a definite improvement. We’ve achieved more of points 1 and 2 (extenability and composability) by having both programs and effects compose. Point 4 (terseness) is improved by the use of GeneralizedNewtypeDeriving. There is a slight risk in terms of efficiency, but I believe if transformers would just INLINE a few more definitions, the cost can be entirely erased. All of this code will infer as we’d expect, as we’re working entirely with explicit types

However, while we had to type less to define the effects, we have to type more to use the effects! If we want to access the environment for example, we can use the ask operation from Control.Monad.Trans.Reader, but we have to wrap this up in the M newtype:

env :: M Environment
env = M ask

However, if we want to retrieve the current state in the computation, we can use get from Control.Monad.Trans.State, but we also have to lift that into the ReaderT monad that is wrapping StateT:

currentState :: M State
currentState = M (lift get)

This is unfortunate – lift is mostly noise that we don’t want to be concerned with. There is also the problem in that the amount of lifts to perform is tied directly to the underlying definition of M. If I later decide I want to layer in the chance of failure (perhaps with MaybeT), I now have to change almost all code using lift, by adding an extra one in!

lift is a mechanical operation that is determined by the type of monad transformer stack and the operation that we want to perform. As we noted, for different stacks, the amount of lifting will vary, but it is determined by the type of stack. This suggests that these lifts could be inferred by the use of type classes, and this is the purpose of the monad transformer library – mtl.

The Monad Transformer Library (mtl)

The mtl is a library consisting of type classes that abstract over the operations provided by each monad transformer. For ReaderT, we have the ask operation, and likewise for StateT we have get and put operations. The novelty in this library is that the instances for these type classes are defined inductively over monad transformer stacks. A subset of the instances for MonadReader for example, show

class MonadReader r m | m -> r where
  ask :: m r

instance Monad m => MonadReader r (ReaderT r m) where
  ask = Control.Monad.Trans.ReaderT.ask

instance (MonadReader r m) => MonadReader r (StateT s) where
  ask = lift ask

We can read this as:

• a base case if the outermost transformer is ReaderT, in which case no lifting has to be performed.

• an inductive case, stating that if we know there is a MonadReader instance somewhere within the stack (that is, somewhere in the stack we are using ReaderT), then the outer monad transformer (in this case StateT) is also an instance of MonadReader by simply passing those operations through to the underlying instance via one application of lift.

With these instances the lifting now becomes automatic entirely at the use of the respective operations. But not only does it become easier to use the operations, our programs also become more generic and easier to reason about. For example, while env previously had the type M Environment, it could now generalise to simply

env :: (MonadReader Environment m) => m Environment
env = ask

Stating that env is reusable in any computation that has access to Environment. This leads to both more options for composition (we’re not tied to working in M), but also types that are more expressive of what effects are actually being used by the computation. In this case, we didn’t use StateT, so we didn’t incur a MonadState type class constraint on m.

Type classes open up a risk of losing type inference, and the approach in mtl is to use functional dependencies. mtl makes use of functional dependencies in order to retain type inference, but this comes at a compositional cost – the selected effect proceeds by induction from the outer most monad transformer until we reach the first matching instance. This means that even if there are multiple possible matches, the first one encountered will be selected. The following program demonstrates this, and will fail to type check:

getTheString :: ReaderT Int (ReaderT String IO) String
getTheString = ask

    Couldn't match type ‘Int’ with ‘[Char]’
    arising from a functional dependency between:
      constraint ‘MonadReader String (ReaderT Int (ReaderT String IO))’
        arising from a use of ‘ask’

When we used ask induction proceeded from the outermost transformer - ReaderT Int. This is an instance of MonadReader, and due to the functional dependency will be selected even though it doesn’t contain the String that we’re looking for. This manifests as a type error, which can be frustrating.

In practice, I’m not convinced this is really a problem, but in the scenario where environments don’t match up we have a few options:

1. Adapt the environment with tools like mapReaderT or magnify (from lens).

2. Use monad-classes which uses a little more type level computation to allow this to work. I’m not entirely sure what the story for inference is here, but I think there may be a risk of less inference.

3. Forgo the functional dependencies, as in mtl-unleashed. In this case you really do give up type inference, and I don’t consider it a viable option (it fails to satisfy point 5 in my criteria in the intro).

Interestingly, the generality we gained by being polymorphic over our choice of monad also opens the door to something we couldn’t do with monad transformers, which is to choose a different implementation of the type class. For example, here’s a different implementation of MonadReader for M:

instance MonadReader Environment M where
  ask = do
    env <- M ask
    liftIO (putStrLn "Requesting environment")
    liftIO (putStrLn ("It is currently " ++ show env)
    return env

While a slightly contrived example, we see that we now have the ability to provide a different interpretation for ask which makes use of the underlying IO in M by logging whenever a computation looks at the environment. This technique is even more useful when you start defining domain specific effects, as it gives you the option to provide a pure variant that uses mock data, which can be useful for unit testing.

Free monads

Let’s move away from monad transformer stacks and see what the other options are. One option that’s getting a lot of attention is the use of free monads. A free monad is essentially a type of construction that adds just enough structure over some data in order to have the structure of a monad – and nothing extra. We spend our days working with monads, and the reason the approach afforded by free monads is appealing is due to the way that we build them – namely, we just specify the syntax! To illustrate this, let me the consider the almost traditional example of free monads, the syntax of “teletype” programs.

To begin with, I have to define the syntax of teletype programs. These programs have access to two operations - printing a line to the screen, and reading a line from the operator.

data TeletypeF a = PrintLine String a
                 | GetLine (String -> a)
  deriving (Functor)

This functor defines the syntax of our programs - namely programs that read and write to the terminal. The parameter a allows us to chain programs together, such as this echo program that prints whatever the user types:

echo :: TeletypeF (TeletypeF ())
echo = GetLine (\line -> PrintLine line ())

However, this is kind of messy. The free monad construction allows us to generate a monad out of this functor, which provides the following presentation:

echo :: Free TeletypeF ()
echo = do
  l <- getLine
  printLine l

getLine :: Free TeletypeF String
getLine = liftF (GetLine id)

printLine :: String -> Free TeletypeF ()
printLine l = liftF (PrintLine l ())

This definition of echo looks much more like the programs we are used to writing.

The remaining step is to provide an interpretation of these programs, which means we can actually run them. We can interpret our teletype programs by using STDOUT and STDIN from IO:

runTeletype :: Free TeletypeF a -> IO a
runTeletype =
  iterM (\op ->
           case op of
             GetLine k -> readLine >>= k
             PrintLine l k -> putStrLn l >> k)

This rather elegant separation between syntax and semantics suggests a new approach to writing programs – rather than working under a specific monad, we can instead work under a free monad for some suitable functor that encodes all the operations we can perform in our programs.

That said, the approach we’ve looked at so far is not particularly extensible between different classes of effects, as everything is currently required to be in a single functor. Knowing that free monads are generated by functors, we can start to look at the constructions we can perform on functors. One very nice property of functors is that given any two functors, we can compose them. The following functors below witness three possible ways to compose functors:

data Sum f g a = InL (f a) | InR (g a) deriving (Functor)
data Product f g a = Product (f a) (g a) deriving (Functor)
data Compose f g a = g (f a) deriving (Functor)

Assuming f and g are Functors, all of these are also Functors - which means we can use them to build monads with Free.

The most interesting of these constructions (for our purposes) is Sum, which lets us choose between two different Functors. Taking a more concrete example, I’ll repeat part of John A. De Goes “Modern FP” article. In this, he defines two independent functors for programs that can access files in the cloud, and another for programs that can perform basic logging.

data CloudFilesF a
  = SaveFile Path Bytes a
  | ListFiles Path (List Path -> a)
  deriving (Functor)

data LoggingF a
  = Log Level String a
  deriving (Functor)

Both of these can now be turned into monads with Free as we saw before, but we can also combine both of these to write programs that have access to both the CloudFilesF API and LoggingF:

type M a = Free (Sum CloudFilesF LoggingF) a

However, in order to use our previous API, we’ll have to perform another round of lifting:

-- API specific to individual functors
log :: Level -> String -> Free LoggingF ()
log l s = liftF (Log l s ())

saveFile :: Path -> Bytes -> Free CloudFilesF ()
saveFile p b = lift (SaveFile p b ())

-- A program using multiple effects
saveAndLog :: Free (Sum CloudFilesF LoggingF) ()
saveAndLog = do
  liftLeft (log Info "Saving...")
  liftRight (saveFile "/data" "\0x42")

-- Lifting operations
liftLeft :: Free f a -> Free (Sum f g) a
liftLeft = hoistFree InL

liftRight :: Free g a -> Free (Sum f g) a
liftRight = hoistFree InR

This is a slightly unfortunate outcome - while we’ve witnessed that there is extensiblity, without more work the approaches don’t compose particularly well.

To solve the problem of having to lift everything leads us to the need for an mtl-like solution in the realm of free monads - that is, a system that automatically knows how to lift individual functors into our composite functor. This is essentially what’s happening in the extensible-effects library - as a user you define each individual Functor, and then extensible-effects provides the necessary type class magic to combine everything together.

We should also mention something on efficiency while we’re here. Free monads have at least two presentations that have different use cases. One of these is extremely easy to inspect (that is, write interpters) but has a costly implementation of >>=. We know how to solve this problem, but the trade off switches over to being costly to inspect. Recently, we learnt how to perform reads and binds in linear time, but the constant factors are apparently a little too high to be competative with raw transformers. So all in all, there is an efficiency cost of just working with a free monad approach.

mtl and laws

I want to now return to the monad transformer library. To recap, the definition of MonadReader is –

class MonadReader r m | m -> r where
  ask :: m r

But this alone makes me a little uneasy. Why? I am in the class of Haskellers who consider a type class without a law a smell, as it leaves us unable to reason about what the type class is even doing. For example, it doesn’t require much imagination to come up with nonsense implementations of ask:

newtype SomeM a = SomeM (StateT Int IO a)
  deriving (Functor, Applicative, Monad)

instance MonadReader Int SomeM where
  ask = SomeM $ do
    i <- get
    put (i + 1)
    return i

But then again – who’s to say this is nonsense? Given that we were never given a specification for what ask should do in the first place, this is actually perfectly reasonable! For this reason, I set out searching for a way to reason about mtl-style effects, such that we could at least get some laws.

A different approach

The transformers library also give us mtl-like type classes, one of which is MonadIO. However, this type class does have laws as well:

-- liftIO . return = return
-- liftIO (f >>= g) = liftIO f >>= liftIO . g
class MonadIO m where
  liftIO :: IO a -> m a

This law is an example of a homomorphism. To quote Wikipedia on the subject:

A homomorphism is a structure-preserving map between two algebraic structures (such as groups, rings, or vector spaces).

In this case the algebraic structure is the monad structure of IO. We see that any monad that is an instance of MonadIO has the ability to lift IO operations, and as this is a homomorphism, the laws state that it will preserve the underlying structure of IO.

It’s currently unclear how to apply this type of reasing to MonadReader, given its current definition – ask is just a value, it doesn’t even take an argument – so how can we even try and preserve anything?

Let’s take some inspiration from free monads, and consider the effect language for MonadReader. If we only have (Monad m, MonadReader r m), then the only thing we can do on top of the normal monad operations is ask the environment. This suggests a suitable functor would be:

data AskF r a = Ask (r -> a)
  deriving (Functor)

I can now wrap this up in Free in order to write programs with the ability to ask:

type Ask r a = Free (AskF r) a

Now we have an algebraic structure with properties (Ask r is a Monad) that we would like to preserve, so we can write this alternative form of MonadReader:

-- liftAsk . return = return
-- liftAsk (f >>= g) = liftAsk f >>= liftAsk . g
class Monad m => MonadReader r m | m -> r where
  liftAsk :: Ask r a -> m a

ask :: MonadReader r m => m r
ask = liftAsk (liftF (Ask id))

Et voilà! We now have an equally powerful MonadReader type class, except this time we have the ability to reason about it and its instances. If we return to the instance that I was questioning earlier, we can redefine it under the new API:

instance MonadReader Int SomeM where
  liftAsk askProgram = SomeM $ do
    x <- get
    out <- iterM (\(Ask k) -> return (k t)) askProgram
    put (x + 1)
    return out

Now that we have some laws, we can ask: is this a valid definition of MonadReader? To check, we’ll use equational reasoning. Working through the first law, we have

liftAsk (return a)
  = { definition of return for Free }
liftAsk (Pure a)
  = { definition of liftAsk for SomeM }
SomeM $ do
  x <- get
  out <- iterM (\(Ask k) -> return (k t)) (Pure a)
  put (x + 1)
  return out
  = { evaluate iterM for Pure a }
SomeM $ do
  x <- get
  out <- return a
  put (x + 1)
  return out
  = { monad laws }
SomeM $ do
  x <- get
  put (x + 1)
  return a

Already we have a problem. While we can see that this does return the original a it was given, it does so in a way that also incurred some side effects. That is, liftAsk (return a) is not the same as return a, so this isn’t a valid definition of MonadReader. Back to the drawing board… Now, it’s worth noting that there is an instance that is law abiding, but might still be considered as surprising:

instance MonadReader Int SomeM where
  liftAsk askProgram =
    iterM (\(Ask k) -> SomeM $ do
      x <- get
      put (x + 1)
      k x )

Applying the same equational reasoning to this is much easier, and shows that the first law is satisfied

liftAsk (return a)
  = { definition of liftAsk }
iterM (\(Ask k) -> SomeM $ do
  x <- get
  put (x + 1)
  k x)
  (return a)
  = { definition of return for Free }
iterM (\(Ask k) -> SomeM $ do
  x <- get
  put (x + 1)
  k x)
  (Pure a)
  = { definition of iterM given Pure}
return a

For the second law, I’ll omit the proof, but I want to demonstrate to sessions in GHCI:

> let runSomeM (M m) = evalState m 0

> runSomeM (liftAsk (ask >>= \r1 -> ask >>= \r2 -> return (r1, r2))
(1, 2)

> runSomeM (liftAsk ask >>= \r1 -> liftAsk >>= \r2 -> return (r1, r2)
(1, 2)

So while the answers agree - they probably don’t agree with your intuition! This is only surprising in that we have some assumption of how =Ask= programs should behave. Knowing more about =Ask=, we might seek this further law:

ask >> ask = ask

This law can also be seen as a reduction step in the classification of our Ask programs, but a Free monad is not powerful enough to capture that. Indeed, the documentation of Free mentions exactly this:

A free Monad is one that does no work during the normalisation step beyond simply grafting the two monadic values together. [] is not a free Monad (in this sense) because join [[a]] smashes the lists flat.

The law ask >> ask = ask follows by normalisation of our “reader” programs, so a free monad will be unable to capture that by construction – the best we can do is add an extra law to our type class. However, what we can also do is play a game of normalisation by evaluation. First, we write an evaluator for Free (AskF r) programs:

runAsk :: Free (AskF r) a -> (r -> a)
runAsk f r = iterM (\(AskF k) -> k r) f

and then witness that we can reify these r -> a terms back into Free (Ask r) a:

reify :: (r -> a) -> Free (Ask r) a
reify = AskF

You should also convince yourself that (r -> a) really is a normal form, and you may find the above linked article on this useful for formal proofs (search for “normalisation”). What we’ve essentially shown is that every Free (AskF r) a program can be expressed as a single r -> a function. The normal form of ask >> ask is now - by definition - a single ask, which is the law we were originally having to state.

As we’ve witnessed that r -> a is the normal form of Free (AskF r) a, this suggests that we could just as well write:

-- liftAsk . return = return
-- liftAsk (f >>= g) = liftAsk f >>= liftAsk . g
class MonadReader r m | m -> r where
  liftAsk :: (r -> a) -> m a

(The structure being preserved by the homomorphism is assuming that (r -> a) is a reader monad).

Our strange instance now becomes

instance MonadReader UTCTime SomeM where
  liftAsk f = SomeM $ do
    x <- get
    put (x + 1)
    return (f x)

With a little scrutiny, we can see that this is not going to satisfy the homomorphism laws. Not only does it fail to satisfy the return law (for the same reason), the second law states that liftAsk (f >>= g) = liftAsk f >>= liftAsk . g. Looking at our implementation this would mean that we would have to increase the state based on the amount of binds performed in f >>= g. However, we also know that >>= for r -> a simply reduces to another r -> a function - the implication being that it’s impossible to know how many binds were performed.

Here a counter example will help convince us that the above is wrong. First, we know

liftAsk (ask >> ask) = liftAsk ask

because ask >> ask = ask by definition.

By the homomorphism laws, we must also have

liftAsk (ask >> ask) = liftAsk ask >> liftAsk ask

Combining these, we expect

liftAsk ask = liftAsk (ask >> ask) = liftAsk ask >> liftAsk ask

However…

> runSomeM (liftAsk ask)
1

> runSomeM (liftAsk (ask >> ask))
1

> runSomeM (liftAsk ask >> liftAsk ask)
2

Now we can see that SomeM’s current definition of MonadReader fails. It’s much harder to write a law abiding form of MonadReader Int SomeM - but it will essentially require some fixed data throughout the scope of the computation. The easiest is of course to change the definition of SomeM:

newtype SomeM a = SomeM (ReaderT Int IO a)

instance MonadReader UTCTime SomeM where
  liftAsk f = SomeM (fmap f ask)

You should convince yourself that this instance is now law abiding - for example by considering the above counter-example, or by performing equational reasoning.

A pattern for effect design

The process we underwent to reach the new form of a =MonadReader= type class, extends well to many different type classes and suggests a new pattern for mtl-like type class operations. Here’s a rough framework that I’m having a lot of success with:

1. Define the operations as data

To begin, think about the language that your effect will talk about. For the reader monad, we defined the AskF functor, and the same can be done for the exception monad, the failure monad, the state monad, and so on. For more “domain specific” operations, a free monad also scales well - one could imagine a language for interacting with general relational databases, with operations to SELECT, UPDATE, DELETE, and so on.

2. Find a suitable way to compose operations

Individual operations are not enough, we also need a way to write programs using this language. This amounts to finding a suitable way to compose these operations together. An easy first approximation is to use a free structure, again – as we started with for the reader monad. In the case of the aforementioned domain specific relational database example, the free monad might be as far as we want to go.

It’s also worth exploring if there is a normal form that more succinctly captures the operations in your language along with equational reasoning. We saw that the normal form of Free (AskF r) a was r -> a, and the same process can be ran for Free (StateF s) a - reaching s -> (a, s) as a normal form. It’s important to note that if you go through the process of normalisation by evaluation, that you also make sure you can reify your evaluation result back into the original language. To illustrate why, consider the hypothetical relational database language:

data DatabaseF a = Query SqlQuery (Results -> a)

runDb :: Free DatabaseF a -> (DatabaseHandle -> IO a)
runDb h = iterM (\(Query q k) -> query h q >>= k)

This is fine for an interpreter, but DatabaseHandle -> IO a is not a normal form because we can’t reify these terms back into DatabaseF. This is important, because by working with a normal form it means that you can define a whole range of interpreters that see the necessary structure of the original programs. To illustrate one problem with DatabaseHandle -> IO a, if we attempted to write a pure interpreter, we would be unable to see which queries were performed in order to produce the data under a (not to mention the limitation that working in IO would cause).

3. Introduce a type class for homomorphisms

With your effect language defined, the next step is to define a type class for homomorphisms from this effect language into larger monad stacks. Often this will be a monad homomorphism – much as we saw with MonadReader and MonadIO – but the homomorphism need not be a monad homomorphism. For example, if your source effect language is a simple monoid, then the homomorphism will be a monoid homomorphism. We’ll see an example of this shortly.

4. Export polymorphic operations

With a type class of homomorphisms, we can now export a cleaner API. For MonadReader, this means exporting convenience ask operations that are defined in terms of liftAsk with the appropriate program in our AskF language.

5. Provide a reference implementation

I also suggest providing a “reference” implementation of this type class. For MonadReader, this reference implementation is ReaderT. The idea is that users can immediately take advantage of the effect we’re defining by introducing the appropriate monad transformer into their monad stack.

The type class allows them to more efficiently define the operations in terms of existing monadic capabilities (e.g., IO), but for many simply reusing a transformer will be sufficient.

A worked example for logging

To conclude this article I want to explore one more application of this pattern applied to building a logging effect. In fact, it is this very problem that motivated the research for this blog post, and so we’ll end up building the foundations of my logging-effect library.

The first step is to identify a language for programs that can perform logging. There’s not much involved here, simply the ability to append to the log at any point in time. Let’s formalise that idea with the appropriate functor:

data LoggingF message a = AppendLogMessage message a
  deriving (Functor)

This functor is parameterised by the type of log messages. The only constructor for LoggingF takes a log message and the rest of the computation to run. We could stop here and lift Free (LoggingF message) a programs, but I want to go a bit further and see are any other ways to express this. I’ll use normalisation by evaluation again, and see what happens.

runFreeLogging :: Free (LoggingF message) a -> (a, [message])
runFreeLogging (Pure a) = (a, [])
runFreeLogging (Free (AppendLogMessage m next)) =
  case runFreeLogging next of
    (a, messages) -> (a, m:messages)

We can also take a (a, [message]) and turn it back into the equivalent Free (LoggingF message) a, so (a, [message]) is another candidate for the language of our logging programs.

But this a bothers me. It occurs only in LoggingF message to capture the rest of the computation, but never does the result of logging affect the choice of what that next computation is. This suggests that it’s mostly noise, and maybe we can just erase it. This would lead us to have logging programs of the type [message]. This type is no longer the right kind for our lifting operation to be a monad homomorphism, which means we have to identify another algebraic structure. Well, lists are certainly a composable structure - they have all the properties of a monoid.

With that in mind, we need to consider what it means to be a monoid homomorphism into some monad. First, observe that monads also have a monoid-like operations:

monadMempty :: Monad m => ()
monadMempty = return ()

monadMappend :: Monad m => m () -> m () -> m ()
monadMappend l r = l >> r

We can now write our lifting type class with the laws of a monoid homomorphism:

liftLog mempty   = mempty                 -- = return ()
liftLog (x <> y) = liftLog x <> liftLog y -- = liftLog x >> liftLog y
class MonadLog message m | m -> message where
  liftLog :: [message] -> m ()

While we reached this type by normalisation-by-evaluation and then a little bit of fudging, there is another way we could have got here. In a sense, [] can be seen as another construction like Free - given any type a, [a] is a free monoid generated by a. An easier route to this type class would have been to describe the individual operations in our logging programs by:

data LoggingOp message = LogMessage message

and then using [] as our free construction. As LoggingOp message ~ Identity message ~ message, we know we could also use [message], and we’re back at the type class above.

(In my logging-effect library I chose a slightly different representation of the free monoid. Theoretically, this is a sounder way to talk about free monoids, but I’m mostly interested in the slight efficiency win by not having to build up lists only to immediately deconstruct them.)

The last steps are to provide polymorphic operations and a reference implementation that satisfies the laws:

logMessage :: (MonadLog message m) => message -> m ()
logMessage message = liftLog [message]

newtype LoggingT message m a = LoggingT (ReaderT (message -> IO ()) m a)

instance MonadIO m => MonadLog message (LoggingT message m) where
  liftLog messages = LoggingT (\dispatchLog -> liftIO (for_ messages dispatchLog))

Does this reference implementation satisfy the monoid homomorphism laws that is required by MonadLog?

liftLog mempty
  = { definition of mempty for lists }
liftLog []
  = { definition of liftLog for LoggingT }
LoggingT (\dispatchLog -> liftIO (for_ [] dispatchLog))
  = { definition of for_ for [] }
LoggingT (\dispatchLog -> liftIO (return ()))
  = { liftIO . return = return }
LoggingT (\dispatchLog -> return ())
  = { definition of return for LoggingT }
return ()

So far so good!

liftLog (x <> y)
  = { definition of liftLog for LoggingT }
LoggingT (\dispatchLog -> liftIO (for_ (x ++ y) dispatchLog))
  = { for_ distributes over ++ }
LoggingT (\dispatchLog -> liftIO (for_ x dispatchLog >> for_ y dispatchLog)
  = { liftIO (f >>= g) = liftIO f >>= liftIO . g }
LoggingT (\dispatchLog -> liftIO (for_ x dispatchLog) >> liftIO (for_ y dispatchLog))
  = { definition of (>>=) for LoggingT }
LoggingT (\dispatchLog -> liftIO (for_ x dispatchLog)) >>
LoggingT (\dispatchLog -> liftIO (for_ y dispatchLog)) >>
  = { definition of liftLog for LoggingT }
liftLog x >> liftLog y

Bingo!

Further thoughts

In this post I presented a pattern for building mtl-like type classes in a mechanical fashion, and this suggests that maybe some of the details can be automatically dealt with. In the next few days I’ll be presenting my algebraic-transformers library which will show exactly that.

For a while, we’ve had bindings to SDL 2 on Hackage, but these bindings are as close to 1:1 as you can get in Haskell. This results in a library that certainly can be used in Haskell, but does not feel particularly like writing ordinary Haskell! A real concern here is that this raises the barrier to entry for those new to either game programming or writing games in Haskell (or both!) - a barrier that I would certainly like to see lowered. To address this, myself and many others have spent the last year working on high-level bindings to abstract away the C-like feel of the existing library, and to present a more Haskell interface.

To give you an idea of how things look, here’s a basic application that opens a window, clears the screen, and quits when the user presses ‘q’:

{-# LANGUAGE OverloadedStrings #-}
module Main where

import SDL
import Linear (V4(..))
import Control.Monad (unless)

main :: IO ()
main = do
  initialize [InitEverything]
  window <- createWindow "My SDL Application" defaultWindow
  renderer <- createRenderer window (-1) defaultRenderer
  appLoop renderer

appLoop :: Renderer -> IO ()
appLoop renderer = do
  events <- pollEvents
  let eventIsQPress event =
        case eventPayload event of
          KeyboardEvent keyboardEvent ->
            keyboardEventKeyMotion keyboardEvent == Pressed &&
            keysymKeycode (keyboardEventKeysym keyboardEvent) == KeycodeQ
          _ -> False
      qPressed = not (null (filter eventIsQPress events))
  rendererDrawColor renderer $= V4 0 0 255 255
  clear renderer
  present renderer
  unless qPressed (appLoop renderer)

Hopefully you’ll agree that the code above is close to idiomatic Haskell.

We’ve tried to be extensive with the bindings, and at the moment the following should (!) all be working:

• Graphics routines have been our highest priority. The bindings should give you full control over window management, access to SDL’s new hardware-accelerated 2D rendering routines, and also the ability to set up an OpenGL context (which is compatible with the OpenGL and gl libraries).
• SDL’s audio abstraction is available, and the bindings allow you to open audio devices and stream audio data.
• A clean implementation of SDL’s event system, designed for use with pattern matching.
• Access to input devices, including keyboard, mouse, pointer devices, and joysticks.
• A large collection of example code, ported from the popular “lazyfoo” and “twinklebear” tutorials.

The bindings are not 100% exhaustive - we’ve omitted some routines that are already provided by the Haskell runtime, but we also currently lack bindings to the following:

• Force-feedback (SDL’s “haptic” functionality). While we do have some code in the repository here, none of the contributors own a device that is compatible with SDL2 to actually test this work. If you do, please drop us a line and help out!
• Gesture recording for touch screens. We’re currently targetting desktops and laptops, but SDL has support for Android and iOS. Hopefully when GHC is easier to target these devices, we can start to explore these SDL bindings.
• Other SDL2 compatible libraries, such as SDL2_net and SDL2_ttf. We’d love for these projects to have the same treatment, and are more than happy to host them under the haskell-game Github account.

We hope this enables more people to begin building interactive software and games in Haskell. It’s still early days for these bindings, so if you find any bugs (runtime problems or API bugs), or if you find the bindings lacking in anyway, please don’t hesitate to open an issue on our issue tracker.

Happy hacking!

Since those discussions took place, I’ve been playing with my point in the FRP-web-framework design space - Francium. I made some big refactorings on an application using Francium, mostly extending so called “component” data types (buttons, checkboxes, etc), and was frustrated with how much code broke just from introducing new record fields. The Commercial Haskell group published an article on how to design for extensibility back in March, so I decided to revisit that.

It turns out that with a little bit of modification, the approach proposed in designing for extensibility also covers optional arguments pretty well!

First, let’s recap what it means to design for extensibility. The key points are:

1. Functions take Settings values, which specify a general configuration.
2. These Settings values are opaque, meaning they cannot be constructed by a data constructor, but they have a smart constructor instead. This smart constructor allows you to provide default values.
3. Provide get/set functions for all configurable fields in your Settings data type, preventing the use of record syntax for updates (which leaks implementation details).

Regular Haskell users will already be familiar a pattern that can be seen in point 3: we often use a different piece of technology to solve this problem - lenses. Lenses are nice here because they reduce the surface area of our API - two exports can be reduced to just one, which I believe reduces the time to learn a new library. They also compose very nicely, in that they can be embedded into other computations with ease.

With point 3 amended to use some form of lens, we end up with the following type of presentation. Take a HTTP library for example. Our hypothetical library would have the following exports:

data HTTPSettings

httpKeepAlive :: Lens HTTPSettings Bool
httpCookieJar :: Lens HTTPSettings CookieJar

defaultHTTPSettings :: HTTPSettings

httpRequest :: HTTPSettings -> HTTPRequest -> IO Response

which might have usage

httpRequest
  (defaultHTTPSettings & httpKeepAlive .~ True)
  aRequest

This is an improvement, but I’ve never particularly liked the reverse function application stuff with &. The repeated use of & is essentially working in an Endo Writer monad, or more generally - a state monad. The lens library ships with operators for working specifically in state monads (of course it does), so let’s use that:

httpRequest :: State HTTPSettings x -> HTTPRequest -> IO Response

....

httpRequest
  (do httpKeepAlive .= True)
  aRequest

It’s a small change here, but when you are overriding a lot of parameters, the sugar offered by the use of do is hard to give up - especially when you throw in more monadic combinators like when and unless.

With this seemingly simple syntactic change, something interesting has happened; something which is easier to see if we break open httpRequest:

httpRequest :: State HTTPSettings x -> HTTPRequest -> IO Response
httpRequest mkConfig request =
  let config = execState mkConfig defaultHttpSettings
  in ...

Now the default configuration has moved inside the HTTP module, rather than being supplied by the user. All the user provides is essentially a function HTTPSettings -> HTTPSettings, dressed up in a state monad. This means that to use the default configuration, we simply provide a do-nothing state composition: return (). We can even give this a name

def :: State a ()
def = return ()

and voila, we now have the lovely name-overloading offered by Data.Default, but without the need to introduce a lawless type class!

To conclude, in this post I’ve shown that by slightly modifying the presentation of an approach to build APIs with extensibility in mind, we the main benefit of Data.Default. This main benefit - the raison d’être of Data.Default - is the ability to use the single symbol def whenever you just want a configuration, but don’t care what it is. We still have that ability, and we didn’t have to rely on an ad hoc type class to get there.

However, it’s not all rainbows and puppies: we did have to give something up to get here, and what we’ve given up is a compiler enforced consistency. With Data.Default, there is only a single choice of default configuration for a given type, so you know that def :: HTTPSettings will be the same set of defaults everywhere. With my approach, exactly what def means is down to the function you’re calling and how they want to interpret def. In practice, due to the lack of laws on def, there wasn’t much reasoning you could do about what that single instance was anyway, so I’m not sure much is given up in practice. I try and keep to a single interpretation of def in my libraries by still exporting defaultHTTPSettings, and then using execState mkConfig defaultHTTPSettings whenever I need to interpret a State HTTPConfig.

• Benjamin Kovach wrote about rebindable syntax and list comprehensions.
• Andraz Bajt wrote about GHC’s various “deriving” mechanisms.
• ertes took us through the concept of higher rank types, and their implementation in GHC.
• Roman Cheplyaka explained how to use existential quantification.
• Tim Docker showed us how the apparently simple “scoped type variables” extension is both useful and necessary.
• Tom Ellis showed us GHC’s special support for arrow notation.
• Sean Westfall showed us how to use Template Haskell.
• Mathieu Boespflug showed us the brand new static pointers extension. forthcoming in future GHC versions.
• Everyone else who submitted pull requests or otherwise informed me of minor typos.

I feel the guest posts have added a lot of variety to the series, and this year each post has consistently gone above and beyond my expectations, delivering incredibly high quality content. Once again, thank you all for your hard work - 24 DOGE wouldn’t be the same without you!

Over the course of the month, we’ve looked at just over 20 extensions - but as I mentioned in the opening post, the story certainly doesn’t stop there. GHC is full of many more interesting extensions - I was hoping to get on to looking at GADTs and data kinds, but alas - there are only so many days in the month. For an example of how these extensions all interact when we write “real-world” software, readers may be interested in viewing my recent Skills Matter talk - strongly typed publish/subscribe over websockets via singleton types.

I’ve been really happy to see comments this year from people who have learnt about new extensions, seen previous extensions in a different light, or simply formed a deeper understanding of extensions they were already using. While I was a little nervous about the series at the start, I’m now confident it’s been a great success. A huge thank you to everyone who participated in the discussions - as with 24 Days of Hackage in previous years, I feel the discussion around these posts is just as important.

Finally, a thank you to everyone who donated during the series - these tokens of appreciate are greatly appreciated.

To close 24 DOGE, well… a picture speaks a thousand words.