A Functional Architecture Demonstration

About

Home: https://github.com/simendsjo/functional-christmas-2020_functional-architecture-demo

This repository is a blogpost for the Functional Christmas 2020 Advent Calendar: https://functional.christmas/2020/22. The main experience report is in the file Large.fs, while the smaller demo application for the shorter advent blogpost is located in Small.fs.

Type dotnet run to run the demo.

—-

Introduction

When I first started learning functional programming, I had already been programming for many years, mostly in object oriented languages the last decade. How would the architecture for a functional program look like? How can we avoid mutation, which is a cornerstone of OOP? How can functions be used as an abstraction?

In this post, I’m going to show the design of a functional program which solved a difficult problem while being easy to get right and performant. By avoiding mutation, we were also able to implement “time-travel” to look how an action would affect the future, easy rollbacks and stale data detection.

In OOP, there are often deep call-stacks, which I consider a smell itself, and mutation of state and side-effects often happen at a deep level. When constructing an application which should be mostly pure with immutable data, we have to push the side-effects up the call-stack to the outer boundary. This means that we need to return to the caller rather than keep diving deeper in the call-stack.

To recap some terminology:

pure

Given the same arguments, it returns the same result. And it has no effect (other than generating heat) on the outside world. This means no visible mutation, and no visible side-effects.

immutable

Once a value is set, it cannot be changed. “Mutation” is done by constructing a new copy rather than modifying in place.

side-effect

A modification to state outside the local environment.

There are some key parts in the architecture I’m demoing here:

State

A record containing all state in the application

Operation

A small language of verbs which describes changes to State

ApplicationEvent

Some external event which should trigger changes to our state

Handler

A function which maps from an ApplicationEvent to an Operation

You don’t need an event driven application to take advantage of the architecture in this post. Using just immutable state with pure functions to change the state, will still yield most of the benefits. Having events and a custom language might be a nice addition, or it might be over-engineering.

Given the above parts, the flow of the application is then:

• Something triggers an ApplicationEvent
• Handlers translates to Operations
• We run each Operation on the State, producing an updated State
• We use the new state for fun and profit

When the new state is produced, we can act on the result by interpreting the changes. We might validate the changes. We might save to the database. We might detect stale data by rerunning the application. We might use it for transactions. Our production implementation does all this, not just without any side-effects or mutation, but because there are no side-effects or mutations. We can safely rerun things, throw away things, copy, interpret results, and there are never a chance of introducing an error outside of our changes – Changes in one place can never affect something else.

Smaller demo

We’ll go through the key parts of our Small demo. More/different comments are in the actual source file, so I encourage you to look there as well.

The demo will model changes to an Order Line in an online shopping chart. It’s probably completely overkill for such use, but it’s difficult to create good examples – see an actual use-case in the Large demo.

We can Add an OrderLine, we can Increment and Decrement the count, and we can Remove an OrderLine. To make things a bit more interesting, I also added a Reset and Add with another initial count than 1.

We’ll use an integer as a unique id for the OrderLine, and a integer for the actual count and initial value.

type Key = int
type Value = int

Defining a custom language for our domain

We encode the possible operations on an OrderLine using a Discriminated Union (also called a Sum Type). These operations are the verbs in our domain, and our Embedded Domain Specific Language (EDSL) for manipulating OrderLine items.

Only Set is needed to support our described operations, but we create some more constructs in our language. Putting more in the language will make mapping events to operations simpler as the language is more expressive, at the cost of a more complex language. It’s difficult to decide what goes in the language, and what should only be helper functions. If you need to distinguish between different operations (e.g. increment vs set) when interpreting the operations, having them as separate operations might be a good idea.

type Operation =
    | Set of (Key * Value)
    | Reset of Key
    | Remove of Key
    | Incr of Key
    | Decr of Key

Application state as an immutable record

The State is where we hold information about all OrderItems. The state includes things necessary to execute our lanugage. In addition, we keep things which is convenient for other usecases, but could in theory just as well be held in other structures. The Audit field is a list of all operations which has been executed, which makes it easy to do things like maintaining an audit log, persisting changes, detecting stale data, rollback transactions, and so on.

Our last field, LastPersisted, is state for the interpreter which persists changes to disk. Depending on the interpreter and application, this state might be better to keep separate.

Having a single structure makes it easy to have a clean architecture without much boilerplate (just State -> State functions), but it can be difficult to find out what information is used where, and who changes what. As with any decision, it’s a tradeoff, but having a simple architecture might be more beneficial than a clean separation of state – remember, there is no mutation or side-effects in the functions which operates on the state!

type State = {
    Data : Map<Key, (Value * Value)> // (Initial, Current)
    Audit : Operation list
    LastPersisted : Operation
} with
    static member Empty = {
        Data = Map.empty
        Audit = []
        // Store an invalid value for simplicity rather than creating a NullObject, null, Option, empty list etc.
        LastPersisted = Remove -1
    }

Helpers for “manipulating” state, i.e. State -> State functions

As you start creating mappings from ApplicationEvent to Operation, you’ll quickly see patterns repeating for state querying and manipulation. I like to extract these to helper functions as I go. For our demo, I’ve created three helper functions.

Notice that the design here is to “never fail”, and rather just return sensible defaults instead. This of course depends on the application, but this demo is modelled after our production application, which should never fail to process an event.

[<Literal>]
let defaultInitial = 1

// Get value or default if the key doesn't exist
let getValue (key : Key) (state : State) : (Value * Value) =
    state.Data
    |> Map.tryFind key
    |> Option.defaultValue (defaultInitial, defaultInitial)

// Set initial and value
let setInitialAndValue (key : Key) (initial : Value) (value : Value) (state : State) : State =
    { state with Data = Map.add key (initial, value) state.Data }

// Set only value. Note that we reuse both other functions
let setValue (key : Key) (value : Value) (state : State) : State =
    let initial, _ = getValue key state
    setInitialAndValue key initial value state

Interpreting our language and executing on State

With the helper functions, we’re now able to process our language. We’ll look at each operation, and manipulate the state accordingly. As a final step, we log the operation we’ve executed. Even though we “execute” the language, we’re not mutating any existing state or doing any side-effects. We’re creating a new state as we go. It’s thus important that we use immutable/persistent datastructures that’s fast for such use, and that we’re using them correctly e.g. by prepending to the list rather than appending.

You might notice a print inside here, and scream SIDE-EFFECT! And yes, it’s true, but it’s for demo purposes, and you shouldn’t do this :)

let execute (op : Operation) (state : State) : State =
    match op with
    | Set (key, value) ->
        setValue key value state
    | Reset key ->
        let initial, value = getValue key state
        setInitialAndValue key initial value state
    | Remove key ->
        { state with Data = Map.remove key state.Data }
    | Incr key ->
        let _, value = getValue key state
        setValue key (value + 1) state
    | Decr key ->
        let _, value = getValue key state
        setValue key (value - 1) state
    |> fun state ->
        printfn "Executed %A" op
        { state with Audit = op :: state.Audit }

Interpreting our language and auditlog to persist to database

Now that we have a way of changing the state, we can write an interpreter that runs side-effects. This simulates writing to a database. Remember that this interpreter has its state in State, so it has to return a copy of it. In Haskell, this would be a State -> IO State function as it has side-effects, but in F#, we just do side-effects without help from the type-system. The interpreters can be made more efficient by avoiding unnecessary work. [Add 1, Remove 1] can be reduced to a noop.

let persist (state : State) : State =
    state.Audit
    |> Seq.takeWhile (fun op -> not (obj.ReferenceEquals(op, state.LastPersisted)))
    |> Seq.rev
    |> Seq.fold (fun state op ->
        printfn "Saving %A" op
        { state with LastPersisted = op }
    ) state

Mapping application events to our custom language

We still haven’t hooked our implementation up to the outer application, but let’s do this now. The key part is our Handler function which does the mapping. It can access the state in case it needs to look at anything, and it returns an Operation option in case the ApplicationEvent should trigger a change in the state. An alternative implementation could return Operation list instead to support 0+ rather than just 0-1. For events which should trigger more than one change, we can just write multiple handlers, which is what we did in our production application. In retrospect, a list would have been more expressive, and might have made some mappings more readable.

type ApplicationEvent(key) =
    member val Key = key with get, set

type Handler = State -> ApplicationEvent -> Operation option

Given an event has happened in the application, we need a way to run this through all possible handlers, accumulating the changes. This implementation runs in sequence, where each handler will see the changes done by the previous. Depending on the use-case, you might want to run them in parallel, merging the result, or similar.

let handle (handlers : Handler list) (ev : ApplicationEvent) (state : State) : State =
    printfn "handle %A" ev
    handlers
    |> Seq.fold (fun state handler ->
        handler state ev
        |> Option.map (fun op -> execute op state)
        |> Option.defaultValue state
    ) state

When we write handlers, we’ll quickly notice some patterns, and we can write helpers for these. As the handlers are functions, the helpers are in the form of Higher Order Functions, which means functions that takes functions as arguments and/or returns a new function as the result – our helpers does both. For our usecase, we’ll define two functions to avoid writing too much type-casting. Our production application has helpers down to the operations as many different events should trigger the same operations.

let onEventOptional<'ev, 'op when 'ev :> ApplicationEvent> ctor (handler : ('ev -> 'op option)) : Handler = fun _ ev ->
    if ev :? 'ev then
        handler (ev :?> 'ev)
        |> Option.map ctor
    else
        None

let onEvent<'ev, 'op when 'ev :> ApplicationEvent> ctor (handler : ('ev -> 'op)) : Handler = fun source ->
    onEventOptional<'ev, _> ctor (handler >> Some) source

Now we can create the mappings themselves. As our language is complex, the handlers are simple. If the language was much smaller, complexity would have to be pushed into helper functions and/or handlers. This is a tradeoff, and there is probably no right or wrong answer. Think about how this would relate to the programming languages you know. Simpler programming languages, pushes the complexity to the users, while in more expressive languages, the complexity can be hidden in libraries. We’re using the helpers here, but there’s nothing wrong with dropping down a level when needed.

Our events is very simple

type OrderLineCreated(key) =
    inherit ApplicationEvent(key)

type OrderLineWithInitialValueCreated(key, value) =
    inherit ApplicationEvent(key)
    member val Value = value with get,set

type OrderLineRemoved(key) =
    inherit ApplicationEvent(key)

type OrderLineReset(key) =
    inherit ApplicationEvent(key)

type OrderLineProductAdded(key) =
    inherit ApplicationEvent(key)

type OrderLineProductRemoved(key) =
    inherit ApplicationEvent(key)

And as the events map nicely to our language, the handlers are also simple.

let handlers : Handler list = [
    onEvent<OrderLineCreated, _>
        Set
        (fun ev -> (ev.Key, defaultInitial))
    onEvent<OrderLineWithInitialValueCreated, _>
        Set
        (fun ev -> (ev.Key, ev.Value))
    onEvent<OrderLineReset, _>
        Reset
        (fun ev -> ev.Key)
    onEvent<OrderLineProductAdded, _>
        Incr
        (fun ev -> ev.Key)
    onEvent<OrderLineProductRemoved, _>
        Decr
        (fun ev -> ev.Key)
]

Demoing our implementation

And that should be everything needed to support our application. We can test it by running some events through the system. We first create a couple of orderlines and does some changes to them. We then persist the result, and finally do some more changes and persist again. We’ll see that the second persist will only process the new changes.

printfn "Demo Small"
printfn "=========="
let events : ApplicationEvent list =
    [
    OrderLineCreated 1 // 1
    OrderLineProductAdded 1 // 2

    OrderLineWithInitialValueCreated (2, 2)
    OrderLineProductAdded 2 // 3
    OrderLineReset 2 // 2
    ]

printfn "Processing application events: %A" events

let oldState = State.Empty
let newState =
    events
    |> Seq.fold (fun state ev -> handle handlers ev state) oldState
let newState = persist newState
printfn "State: %A" newState

let oldState = newState
let events : ApplicationEvent list =
    [
        OrderLineProductRemoved 2 // 1
    ]

printfn ""
printfn "Processing application events: %A" events
let newState =
    events
    |> Seq.fold (fun state ev -> handle handlers ev state) oldState
let newState = persist newState
printfn "Old state: %A" oldState
printfn "New state: %A" newState

The output from the demo application

Demo Small
==========
Processing application events: [Small+OrderLineCreated; Small+OrderLineProductAdded;
 Small+OrderLineWithInitialValueCreated; Small+OrderLineProductAdded;
 Small+OrderLineReset]
handle Small+OrderLineCreated
Executed Set (1, 1)
handle Small+OrderLineProductAdded
Executed Incr 1
handle Small+OrderLineWithInitialValueCreated
Executed Set (2, 2)
handle Small+OrderLineProductAdded
Executed Incr 2
handle Small+OrderLineReset
Executed Reset 2
Saving Set (1, 1)
Saving Incr 1
Saving Set (2, 2)
Saving Incr 2
Saving Reset 2
State: { Data = map [(1, (1, 2)); (2, (1, 3))]
  Audit = [Reset 2; Incr 2; Set (2, 2); Incr 1; Set (1, 1)]
  LastPersisted = Reset 2 }

Processing application events: [Small+OrderLineProductRemoved]
handle Small+OrderLineProductRemoved
Executed Decr 2
Saving Decr 2
Old state: { Data = map [(1, (1, 2)); (2, (1, 3))]
  Audit = [Reset 2; Incr 2; Set (2, 2); Incr 1; Set (1, 1)]
  LastPersisted = Reset 2 }
New state: { Data = map [(1, (1, 2)); (2, (1, 2))]
  Audit = [Decr 2; Reset 2; Incr 2; Set (2, 2); Incr 1; Set (1, 1)]
  LastPersisted = Decr 2 }

Concluding remarks

This concludes our little demo, with an architecture which is pure, immutable, and side-effect free. The side-effects is pushed to the boundaries, making the core of the application easy to test and make bug free. Check out the repository for some code and the larger demo based on the production application. If you’re interested in learning more about F#, I wrote a short post with various useful links at the Getting Started With F# calendar post.

Larger production-like demo program

I recommend looking at the Small.fs program and reading the walkthrough of that application before diving into this demo. The high-level architecture is mostly the same, but it’s easier to grok as there’s less other code. This application, Large.fs, is a somewhat simplified version of our production application. Much of the code is copy/pasted with only slight simplifications and changes to stuff everything into a single file.

Before we look at the program, let’s examine the problem. We have many different types of entities in our system, and they have date ranges in which they are “valid”, and they have dependencies amongst themselves. We might have an item Z, which is dependent on P and Q. P in turn might be dependant on A and B, or Q on R and S. If S is “invalid” for some period, then none of the dependencies can be invalid. If it was deleted, then all dependencies must be deleted. We call these periods of valid/invalid for Timelines, and we have code which is able to merge timelines into a new timeline and calculating if something is active/inactive/inactivated by a dependency/reactivated by a dependency.

To show an examle in glorious ASCII-art. Legend:

[

Inclusive date for when a state starts

)

Exclusive date for when a state ends

a

State is active

blank

State is inactive

d

An active state is inactivated by a dependency

r

An inactivated by dependency state is recativated

x=

Calculated state for timeline x

Each column is a date, and we can calculate things by looking top to down. If everything is active for a given date, then it is active.

  R    aa    aaaa
  S   aaa   aaaa
 Q       aaa aaaaaa
 Q=      ddd rrrddd
  A aaa   aaaaa
  B  aaaaaaa aaaa
 P  aaa aaaaaa
 P= drr ddrrdr
Z    aaaa    aaaa
Z=   dddd    rddd
             ^
             The active period

In the example above, only a single date is active. The timelines can be thought of as ordered sets, and the calculation and intersections of sets. While these timelines and the calculation might be interesting in itself, we’re not going to look more into this in this post, but rather look at the problem related to “changes” to these timelines.

What happens when someone adds a new active period? When a period is changed or deleted? What when a dependency is added or changed? When something happens, we need to recalculated all dependencies, and cache them for fast lookup. So this is mostly a cache problem, which in itself is a difficult problem, in addition to maintaining these hierarchies and calculating the timelines.

So how large is the program? While a lines of code doesn’t say much as it’s very dependant on style, loc shows the following

--------------------------------------------------------------------------------
 Language             Files        Lines        Blank      Comment         Code
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
 F#                       7         1862          246          132         1484
--------------------------------------------------------------------------------
|./AssemblyInfo.fs                   14            4            4            6
|./Utils.fs                          22            6            4           12
|./State.fs                         370           59           29          282
|./Calculation.fs                   148           20           13          115
|./Database.fs                      371           51            9          311
|./EventHandlers.fs                 871           90           72          709
|./Api.fs                            66           16            1           49

The largest file, EventHandlers.fs is mostly application specific code; the mapping between application events and what operations they describe on timelines. So this is the only file we’re modifying, the other files is the infrastructure part of the codebase, and has remained mostly unchanged since its inception.

When I start designing a system, I usually start with pen and paper, and gradually move to experimenting with code. I never intended to write this program in F#, it just happened as I started modelling the problem using Discriminated Unions, and the experimentation lead to a robust implementation quite fast. This is one of the great strength of F# (and other languages in the ML family) – they make domain modelling natural and let you describe both low level and high level using simple constructs.

Before looking at the implementation, let’s discuss the architecture and how it works. The inner core of the application is pure, which means it doesn’t have side-effects. The effects is done at the perimiter of the application. In order to support this, calls to the inner core has to return some values to the outer functions so it knows can execute these effects. This kind of pattern is sometimes called Functional Core, Imperative Shell.

So let’s dive inte the implementation. We start describing the high-level, and leave out some details, before we revisit the code to add some details.

At a very high level, the flow of the application goes like the following

• A user user does an action
• for each application event resulting from that action:
  • Decide if it’s related to a timeline, and say what kind of operation it is
  • Execute the operation on the application state, producing a new state
• for each operation on the timelines:
  • persist it to database

What kind of operations are needed to support this application?

Someone might:

• delete an object/timeline
• add a dependency
• remove a dependency
• add a period to a timeline
• change a period in a timeline
• remove a period from a timeline

We can model this using a Discriminated Union. We don’t actually care if someone is adding a new or changing an existing period, so we can merge “add” and “change” into “set”, but the possible actions are otherwise mapped 1-to-1:

type Operation =
    // Entire timeline and all dependencies will be deleted
    | DeleteTimeline of TimelineId
    // Adds a dependency. Child and everything dependent on it will be marked as dirty
    | AddDependency of Dependency
    // Removes a dependency. Child and everything dependent on it will be marked as dirty
    | RemoveDependency of Dependency
    // Adds or updates a timeline item. The timeline and everthing dependent on it will be marked as dirty
    | SetTimelineItem of (TimelineId * TimelineItem)
    // Removes a timeline item. The timeline and everything dependent on it will be marked as dirty
    | DeleteTimelineItem of (TimelineId * TimelineItemId)

These five operations are the only possible operations on the system. This can be viewed as a small embedded domain specific language (EDSL).

The domain logic lies in interpreting the application events. This interpretation is done by functions on the form:

type Handler = State -> IApplicationEvent -> Operation option

The State record contains all data, and is available to the handlers to support advanced use-cases, but in reality, 99% don’t look at it at all as the events contain the necessary data to choose the operation which requiring looking up other data.

Our state is more complex than our small example, but we’re still using the same patterns, which makes the increased complexity maintainable.

type State = {
    // All items
    ThisTimeline : Map<TimelineId, TimelineItem list>

    // Dependencies from two directions for fast lookups
    DependenciesFor : Map<Child, Dependency list>
    DependentOn : Map<Parent, Dependency list>

    // An audit of the current changes, think of it
    // as a write-ahead log used by transactions and
    // interpreters like database persisting
    Executed : Effect list

    // Various state here
    Calculated : Map<TimelineId, Timeline>

    // "Dirty" timelines which must be calculated before persisted
    // or shown to the user
    NeedsRecalculation : Set<TimelineId>

    // State for the database interpreted
    Unpersisted : Set<TimelineId>

    // ... and of course the actual timelines which we don't care about in this example
} with
    static member Empty : State = {
        ThisTimeline = Map.empty
        DependenciesFor = Map.empty
        DependentOn = Map.empty
        Calculated = Map.empty
        Executed = []
        NeedsRecalculation = Set.empty
        Unpersisted = Set.empty
    }

Like with the small example, we have helpers to manipulate the state. We have a larger state, larger language, and more complex domain, so the state manipulations are also more complex. Notice that the bottom-most functions maps quite nicely to the operations in our language.

[<AutoOpen>]
module StateManipulation =
    let private removeValue k v map =
        let withoutValue =
            Map.tryFind k map
            |> Option.defaultValue []
            |> List.filter ((<>) v)
        if List.isEmpty withoutValue then
            // Avoid having both None and []
            // meaning the same thing
            Map.remove k map
        else
            Map.add k withoutValue map

    let private insertValue k v map =
        Map.add k (v :: (Map.tryFind k map |> Option.defaultValue [])) map

    let removeCache (tl : TimelineId) (state : State) : State =
        { state with
            Calculated = Map.remove tl state.Calculated
            // .. and clears other caches
        }

    let rec private deepGetDependentOn (parent : Parent) (state : State) : Dependency list =
        Map.tryFind parent state.DependentOn
        |> Option.defaultValue []
        |> List.fold (fun allDeps dep -> [dep] :: (deepGetDependentOn dep.Child state) :: allDeps) []
        |> List.concat
        |> List.distinct

    // Whenever something is modified, we need to mark everything as dirty. It's turtles all the way down.
    let rec private markDirty (tl : TimelineId) (state : State) : State =
        deepGetDependentOn tl state
        |> Seq.map (fun dep -> dep.Child)
        |> Seq.append [tl]
        |> Seq.fold (fun state tl ->
            { state with
                NeedsRecalculation = Set.add tl state.NeedsRecalculation
                Unpersisted = Set.add tl state.Unpersisted
            }
            |> removeCache tl
        ) state

    let private addDependency (dep : Dependency) (state : State) : State =
        { state with
            DependenciesFor = insertValue dep.Child dep state.DependenciesFor
            DependentOn = insertValue dep.Parent dep state.DependentOn
        }
        |> markDirty dep.Child

    let private deepDeleteTimelines (tl : TimelineId) (state : State) : State =
        // Delete everything dependant on this timeline
        deepGetDependentOn tl state
        // Delete this timeline even though it doesn't have any dependencies
        // We add it as a fictional dependency to reuse the other code
        |> List.append [{Child = tl; Parent = tl; Relation = "Self"}]
        // Delete this the dependency references for this timeline
        |> List.append (Map.tryFind tl state.DependenciesFor |> Option.defaultValue [])
        // Actually delete dependencies and timelines
        |> List.fold (fun state dep ->
            { state with
                ThisTimeline = Map.remove dep.Child state.ThisTimeline
                DependenciesFor = removeValue dep.Child dep state.DependenciesFor
                DependentOn = removeValue dep.Parent dep state.DependentOn
            }
            |> removeCache dep.Child
            |> fun state ->
                { state with
                    // Mark that the timeline is changed, but don't recalculate an empty timeline as we've deleted it
                    Unpersisted = Set.add dep.Child state.Unpersisted
                    NeedsRecalculation = Set.remove dep.Child state.NeedsRecalculation
                }
        ) state

    let private removeDependency (dep : Dependency) (state : State) : State =
        { state with
            DependenciesFor = removeValue dep.Child dep state.DependenciesFor
            DependentOn = removeValue dep.Parent dep state.DependentOn
        }
        |> markDirty dep.Child

    let private deleteTimelineItem ((tlId, item) : (TimelineId*TimelineItemId)) (state : State) : (State * TimelineId) =
        let tl =
            Map.tryFind tlId state.ThisTimeline
            |> Option.defaultValue ([])
            |> List.filter (fun x -> x.Key <> item)
        { state with ThisTimeline = Map.add tlId tl state.ThisTimeline }
        |> markDirty tlId
        |> fun state -> (state, tlId)

    let private setTimelineItem ((tlId, item) : (TimelineId*TimelineItem)) (state : State) : (State * TimelineId) =
        let tl =
            Map.tryFind tlId state.ThisTimeline
            |> Option.defaultValue ([])
            |> List.filter (fun x -> x.Key <> item.Key)
            |> fun pre -> List.append pre [item]

        { state with ThisTimeline = Map.add tlId tl state.ThisTimeline }
        |> markDirty tlId
        |> fun state -> (state, tlId)

    let rec deepGetDependenciesFor (child : Child) (state : State) : Dependency list =
        Map.tryFind child state.DependenciesFor
        |> Option.defaultValue []
        |> List.fold (fun allDeps dep -> [dep] :: (deepGetDependenciesFor dep.Parent state) :: allDeps) []
        |> List.concat

    let execute (op : Operation) (state : State) : (State * Operation list) =
        match op with
        | DeleteTimeline tl ->
            let tls =
                let children = deepGetDependentOn tl state |> List.map (fun dep -> dep.Child)
                tl :: children
            let state = deepDeleteTimelines tl state
            let ops = tls |> List.map DeleteTimeline
            (state, ops)
        | AddDependency dep ->
            (addDependency dep state, [op])
        | RemoveDependency dep ->
            (removeDependency dep state, [op])
        | SetTimelineItem (tl, item) ->
            let state, tl = setTimelineItem (tl, item) state
            (state, [(SetTimelineItem (tl, item))])
        | DeleteTimelineItem (tl, item) ->
            let state, tl = deleteTimelineItem (tl, item) state
            (state, [(DeleteTimelineItem (tl, item))])

So each user action, will trigger zero or more application events, which triggers zero or more operations on the timelines.

The events flows through a series of functions:

// Process all events before calculating
let handleEvents (handlers : Handler list) (events : IApplicationEvent seq) (state : State) : State =
    events
    |> Seq.fold (fun state ev -> handle handlers ev state) state
    |> calculate

// Process a single event. Run it through all handlers
let handle (handlers : Handler list) (source : IApplicationEvent) (state : State) : State =
    (handlers, state)
    ||> Seq.fold (fun state handler ->
        handler state source
        |> Option.map (fun op ->
            execute op state
            ||> Seq.fold (fun state op ->
                { state with Executed = (source, op) :: state.Executed }
            )
        )
        |> Option.defaultValue state
    )

Our actual production application also allows Operations to be handled by recursively call handle with the produced operations, but this turned out to be unnecessary, and I deleted the feature in the demo.

This simulates persisting to the database. The real application looks at the operations in order to find the affected timelines, and persists them to the database.

let persistExecuted (state : State) : State =
    let inOrder = state.Executed |> Seq.rev |> Seq.toList
    let state =
        calculate state
        // Someone might have calculated something we want to delete manually
        // (for instance "calculate all affected timelines")
        // To avoid storing this in the database, we delete it from the cache
        // just in case
        |> fun state ->
            inOrder
            |> Seq.choose (function | (_, DeleteTimeline tl) -> Some tl | _ -> None)
            |> Seq.fold (fun state tl -> removeCache tl state) state

    // The actual implementation is highly optimized for writing fast to the database, but we'll just print
    // to simulate the side-effects
    inOrder |> Seq.iter (snd >> printf "Storing to database: %A")

    // Storing to the database is the last thing we done when our transaction is done, so we'll also clear
    // the Executed state
    { state with
        Executed = []
        Unpersisted = Set.empty
    }

As with the Small demo, we have helpers for mapping from events to operations. In this implementation we go further, by adding even more abstractions to better reflect our language, and lets us write the handlers in a more declarative way. And finally, we have the most application specific code, which maps from the application events to the operations.

Our example domain will be bank accounts. An account will be stopped if the bank is closed, if the owner dies, and so on. Nothing to do with out production application, but it shows some of the feature of our small language.

type CompanyCreated(company, created) =
    inherit ApplicationEvent(company)
    member val Created : DateTime  = created

type CompanyDiscontinued(company, closed) =
    inherit ApplicationEvent(company)
    member val Closed : DateTime = closed

type AccountOpened(account, bank, owner, opened) =
    inherit ApplicationEvent(account)
    member val Owner : EntityId = owner
    member val Bank : EntityId = bank
    member val Opened : DateTime = opened

type AccountSuspended(account, suspended) =
    inherit ApplicationEvent(account)
    member val Suspended : DateTime = suspended

type AccountReopened(account, reopened) =
    inherit ApplicationEvent(account)
    member val Reopened : DateTime = reopened

type AccountClosed(account, closed) =
    inherit ApplicationEvent(account)
    member val Closed : DateTime = closed

type PersonCreated(person, birthday) =
    inherit ApplicationEvent(person)
    member val Birthday : DateTime = birthday

type PersonDied(person, timeOfDeath) =
    inherit ApplicationEvent(person)
    member val TimeOfDeath : DateTime = timeOfDeath

[<AutoOpen>]
module ApplicationEventHandlers =
    // These are our helper functions. Functions that create other functions.
    [<AutoOpen>]
    module private Helpers =
        // In our example, we notice a pattern where we only care about certain type of events.
        // Another pattern is that we always call a constructor from Operation.
        // This function wraps these two patterns.
        let onEventOptional<'ev, 'op when 'ev :> ApplicationEvent> ctor (handler : ('ev -> 'op option)) : Handler = fun _ ev ->
            if ev :? 'ev
            then handler (ev :?> 'ev) |> Option.map ctor
            else None

        // Often, an operation should always be created given an event. For this case, we don't need to have
        // an optional handler, but can have it just return the operation, and let us wrap it in a Some
        let onEvent<'ev, 'op when 'ev :> ApplicationEvent> ctor (handler : ('ev -> 'op)) : Handler = fun source ->
            onEventOptional<'ev, _> ctor (handler >> Some) source

        // Helper to create a dependency operation
        let onDependencyEvent<'ev when 'ev :> ApplicationEvent> ctor (relation : string) (extractChild : ('ev -> EntityRef)) (extractParent : ('ev -> EntityRef)) : Handler =
            onEvent<'ev, _> ctor (fun ev ->
                let dep = {
                    Child = extractChild ev
                    Parent = extractParent ev
                    Relation = relation
                }
                dep
            )

        // This is where we're creating functions that matches our domain specific language

        let deletesTimeline<'ev when 'ev :> ApplicationEvent> (extractTimelineId : ('ev -> TimelineId)) : Handler =
            onEvent<'ev, _> DeleteTimeline (fun ev ->
                extractTimelineId ev
            )

        let addsDependency<'ev when 'ev :> ApplicationEvent> =
            onDependencyEvent<'ev> AddDependency

        let removesDependency<'ev when 'ev :> ApplicationEvent> =
            onDependencyEvent<'ev> RemoveDependency

        // As these functions are abstractions, we can build logic into them. For instance can we say that
        // MaxDate should be interpreted as "not yet active", and we can patch small values to be at least of some
        // size (like a large enough value to not crash MSSQL)
        let minDate = DateTime(1753, 1, 2)
        let setsTimelineItem<'ev when 'ev :> ApplicationEvent> (f : ('ev -> (TimelineId*TimelineItem))) : Handler =
            onEventOptional<'ev, _> SetTimelineItem (fun ev ->
                let tl, itm = f ev
                if itm.From = DateTime.MaxValue
                then None
                else
                let itm =
                    if itm.From < minDate
                    then { itm with From = minDate }
                    else itm
                Some (tl, itm))

        let deletesTimelineItem<'ev when 'ev :> ApplicationEvent> (f : ('ev -> (TimelineId*TimelineItemId))) : Handler =
            onEvent<'ev, _> DeleteTimelineItem (fun ev ->
                let tl, itm = f ev
                (tl, itm))

        // As this is only functions creating other functions, we can easily drop down to lower levels when needed,
        // or we can build ever larger abstractions. If Handler was changed to return a list of Operations instead,
        // we could have functions that creates many operations with a single function.

    // Using the helpers, we can now create handlers for our events. The handlers should just be a list of Handler.
    // This gives us a lot of flexibility. The real implementation has one sublist per feature, and then concat them
    // together to create a complete list.
    let handlers : Handler list = [
        setsTimelineItem<CompanyCreated> (fun ev ->
            let tl = ("Company", ev.Entity)
            let item = {
                Key = "Created"
                State = ThisTimelineDetailedState.ActiveManually
                From = ev.Created
                Item = "Created"
            }
            (tl, item)
        )
        setsTimelineItem<CompanyDiscontinued> (fun ev ->
            let tl = ("Company", ev.Entity)
            let item = {
                Key = "Discontinued"
                State = ThisTimelineDetailedState.InactiveManually
                From = ev.Closed
                Item = "Discontinued"
            }
            (tl, item)
        )

        setsTimelineItem<PersonCreated> (fun ev ->
            let tl = ("Person", ev.Entity)
            let item = {
                Key = "Birthday"
                State = ThisTimelineDetailedState.ActiveManually
                From = ev.Birthday
                Item = "Birthday"
            }
            (tl, item)
        )

        setsTimelineItem<PersonDied> (fun ev ->
            let tl = ("Person", ev.Entity)
            let item = {
                Key = "Death"
                State = ThisTimelineDetailedState.InactiveManually
                From = ev.TimeOfDeath
                Item = "Death"
            }
            (tl, item)
        )

        addsDependency<AccountOpened> "Bank" (fun ev -> ("Account", ev.Entity)) (fun ev -> ("Bank", ev.Bank))
        addsDependency<AccountOpened> "Owner" (fun ev -> ("Account", ev.Entity)) (fun ev -> ("Person", ev.Owner))
        setsTimelineItem<AccountOpened> (fun ev ->
            let tl = ("Account", ev.Entity)
            let item = {
                Key = "Opened"
                State = ThisTimelineDetailedState.ActiveManually
                From = ev.Opened
                Item = "Opened"
            }
            (tl, item)
        )

        setsTimelineItem<AccountSuspended> (fun ev ->
            let tl = ("Account", ev.Entity)
            let item = {
                Key = sprintf "Suspended %A" ev.Suspended
                State = ThisTimelineDetailedState.InactiveManually
                From = ev.Suspended
                Item = "Suspended"
            }
            (tl, item)
        )

        setsTimelineItem<AccountReopened> (fun ev ->
            let tl = ("Account", ev.Entity)
            let item = {
                Key = sprintf "Reopened %A" ev.Reopened
                State = ThisTimelineDetailedState.ActiveManually
                From = ev.Reopened
                Item = "Reopened"
            }
            (tl, item)
        )
    ]

Running the example application will create some of these events and updating states based on it. The output is quite large, so you can run the application yourself if you wish.

Excercise to the reader: Implement AccountOwnerChanged which transfers an account to another person.

Hopefully, these demo applications helps explaining how we can design applications using functional patterns.