functional event-sourcing – compose

Last Time I talked about how to abstract the reading part of event-sourcing into Projections. In this article I will show you how you can compose those without having to playback the events more than once.

extending the example

Going forward with the shipping example we already have a projection for the current location of a ship:

let locationOf (ship : Ship) =
    (function None -> Unknown | Some l -> l) <%>
    latest (function
        | Arrived (s,p) when s = ship -> Some (AtPort p)
        | Departed s    when s = ship -> Some AtSea
        | _                           -> None)

And we can get a list of loaded cargo easily:

let loadedCargo (ship : Ship) =
    aggregate Set.empty
        (fun ev cs ->
            match ev with
            | Loaded (s, c)
                when s = ship ->
                Set.add c cs
            | Unloaded (s, c)
                when s = ship -> 
                Set.remove c cs
            | _ -> cs)

But what if we want to have both?

Of course we could just playback the two projections, but in case the playback is expensive this might be not an option. So we would need to write another aggregate that combines the two things: finding the current location and tacking the loaded cargo.

Not very composable is it?

playing back two projections at once

To tackle that problem you might first notice, that it’s quite easy to just make the folding phase in parallel – instead of tracking one state we just track a pair of two states and apply the Projections fold and projection accordingly:

let pair (a : Projection<'ev,_,'outA>) 
         (b : Projection<'ev,_,'outB>) 
         : Projection<'ev, _, 'outA * 'outB> =
    { fold = 
        (fun ev (sa, sb) -> 
            (a.fold ev sa, b.fold ev sb))
    ; projection = 
        (fun (sa,sb) -> 
            (a.projection sa,   b.projection sb))
    ; empty = 
        (a.empty, b.empty)
    }

Using this we can get inductively get as much projections in parallel as we like – the rest is just a matter of using map to get the desired outcome.

For example this would get you the location and the cargo-list as a tuple:

let shipDetails (ship : Ship) =
    (fun (loc, cs) -> (loc, Set.toList cs)) <%>
    pair (locationOf ship) (loadedCargo ship)

making it applicative

With applicative functors we can do even better!

Let’s first see what this is about – the shipDetails example using applicative should look like this:

let shipDetails (ship : Ship) =
    (fun loc cs -> (loc, Set.toList cs)) <%>
    locationOf ship <*> loadedCargo ship

As you can see the difference is just that I use a curried function to but the pieces together instead of a tupled one; and that instead of pair I use another fancy operator (<*>).
The big advantage becomes obvious when we use yet another projection – let’s say we want to add the route the ship took:

let route (ship : Ship) =
    List.rev <%> aggregate []
        (fun ev rs ->
            match ev with
            | Arrived (s, port) 
                when s = ship ->
                port::rs
            | _ -> rs)

Here is a version using pair:

let shipDetails (ship : Ship) =
    (fun ( (loc, cs), rs) -> (loc, Set.toList cs, rs)) <%>
    pair (pair (locationOf ship) (loadedCargo ship)) 
         (route ship)

and here is the same using the applicative syntax:

let shipDetails (ship : Ship) =
    (fun loc cs rs -> (loc, Set.toList cs, rs)) <%>
    locationOf ship <*> loadedCargo ship <*> route ship

how does this work?

The idea behind this is, that applicatives have a function (the (<*>)) similar to the fmap of functors – but instead of lifting a f : 'a -> 'b into F<'a> -> F<'b> we want the function we started with to be already wrapped into the applicative functor, so we can get a A<'a> -> A<'b> from a f: A<'a -> 'b>.

In our case this just means that we need an operator (<*>) taking a projection pf : Projection<'ev,_,'a -> 'b> that produces a function-type and a matching projection pa : Projection<'ev,_,'a> and returns pf <*> pa : Projection<'ev,_,'b>.

If you follow the types in this way you see that in shipDetails works like this:

  • I first fmap the (fun loc cs rs ...) and locationOf ship into a Projection<'ev,_,Set<Cargo> -> Port list -> (Location * Cargo list * Port list).
  • Next I apply loadedCargo ship to this using (<*>) which yields a Projection<'ev,_,Port list -> (Location * Cargo list * Port list).
  • Finally I use (<*>) again and apply route ship to this, resulting in a Projection<'ev,_,(Location * Cargo list * Port list).

implementing (<*>)

The implementation is rather succinct if you follow the types and use pair:

let (<*>) (f : Projection<'ev,'sa,'a ->'b>) 
          (a : Projection<'ev,'sb,'a>) 
          : Projection<'ev,_,'b> =
    (fun (f,a) -> f a) <%> pair f a

Technically an applicative functor needs another operation pure that wraps a value into the applicative (the same as the return used in a Monad). Usually you will use <%> and <*> to compose but as it might come handy sometimes here it is – I just renamed it to constant as this might give a better clue about what it is doing:

let constant (o : 'out) 
             : Projection<'ev, _, 'out> =
    { fold       = (fun _ _ -> ()) 
    ; projection = (fun _ -> o)
    ; empty      = ()
    }

As the internal state here does not matter at all I just use unit for it.

CAUTION

An applicative functor has to obey some laws (see here) and Projections have some issues with that.

For example this law:

constant id <*> v = v

Obviously has some issues with the internal state:

constant id <*> constant () 
    : Projection<'ev, (unit * unit), unit>

but

constant () 
    : Projection<'ev,unit,unit>

so the types of the internal state does not match of course and so the two projections cannot be equal.

So keep this in mind, we are technically not dealing with an applicative functor here – but of course you can compose to your hearts content.

conclusion

Hopefully I could demonstrate you how you can get composition almost for free using applicatives.

You can find all the code so far in todays GIST.

Next time we will look at how we could try to make this more lazy 😉