F#: Custom Monad (Workflow) Development

It is my experience that learning how to develop monads is hard. I could follow the theory, and I thought I could even read example code, but when I attempted to actually write my own then I found it hard to marry the implementation and the theory. If that is you experience, then I hope this post will help a little.

Introduction

In a simple sense, monadic development is a way to make functional composition easy, and it does, but only once the supporting code is in place. If you do not have the supporting code then you have to be able to understand the theory and then apply it to your own software development.

For the theory, I recommend the following talks by Microsoft’s Brian Beckman:

You should also have the F# specification accessible, particularly section 6.4.10: Computation Expressions. The reference is correct for the F# 1.9.6.16 Draft Language Specification.

Starting out

One thing that I have learnt is that it is worth thinking carefully about what you want to achieve before attempting to understand and create your monad. In particular, I think there are two distinct styles of monad:

  • Direct execution: expressions are executed as the monad is built
  • Delayed execution: expressions are executed either automatically, at the end of the computation expression, or on demand

In the direct execution approach, values are bound to functions, in the delayed execution approach it is functions that are bound to higher-order functions.  If you want to compose computation expressions then you will need to use the latter approach. In fact, several parts of the computation expression builder framework presume a delayed execution model, but you can still get basic computation expressions working with the direct execution model. And, starting with direct execution certainly helped me to understand what was happening when there were problems.

When things go wrong: if your computation expression is not compiling, try writing it out by hand by following the constructs in the F# Draft Language Specification. Then you will be able to diagnose what part of the expression is not compiling and why.

Execution mode in detail

The Eventually<‘T> type in the F# draft langauge specification is an example of a delayed execution monad.  The type is recursively defined as:

type Eventually<'T> =
  | Done of 'T
  | NotYetDone of (unit -> Eventually<'T>)

Implementing a monad with delayed execution requires a similar construct.  Note as well that if you use:

type MyMonad<'T> =
  | Done of 'T
  | NotYetDone of (unit -> 'T)

Your definition will compile but your monad probably will not.  You are likely to get the following error:

Error 17 Type mismatch. Expecting a  MyMonad<‘a> but given a  ‘a. The resulting type would be infinite when unifying ”a’ and ‘MyMonad<‘a>’

You can fix this easily by changing “unit -> ‘T” to “unit -> MyMonad<‘T>”.

In contrast, a direct execution monad only holds values (although the value may be a function, the monad code treats it like any other value and there are no function applications involving the monad value).

Building a monad

Building a monad requires the following:

  • A basic type to represent a monad, this was Eventually<‘T> in the above example, but it can also be a type alias or a type expression
  • A set of core functions: construct, return, bind
  • If .NET exception statements are supported then:
    • A type to wrap a possible exception is required (this is provided by OkOrException<‘T> in the Eventually<‘T> example in the F# Draft Language Specification)
    • A catch function
    • Note: both for and use are forms based on try…finally and so rely on catch
  • A set of functions to support the workflow that can either be
    • Standard code based on return, bind and catch
    • Custom implementations
  • A class to act as the computation expression builder
  • (Optionally) a module to hold a default computation expression builder, which may also be automatically made available by using the AutoOpenAttribute at either the module or assembly level

That sounds a lot, but I will address each in turn.  I will also attempt to describe the differences between direct and delayed execution approaches.

A basic type to represent a monad

This type should always be generic as it must be able to hold any normal values resulting from an F# expression.  In my case, I wanted a type that could support the following:

type Definition = unit

type ModelResult<'T> =
  | ModelValue of 'T
  // Exception semantics
  | Collision of Definition*Definition
  | UndefinedScope of string list
  | InvalidContainment of Definition*Definition
  | InvalidOperation of string

For the sake of this post, I have replaced a custom type Definition with unit, but this does not affect the development of the monad.

ModelResult<‘T> is similar to the standard Maybe monad however I have allowed for a series of specific failures.  These could have been modelled as .NET exceptions but that would break the pure functional semantics intended for this type.  As shown above, the type does not support delayed execution.  For that, I needed to change the definition as follows:

type Definition = unit

type ModelResult<'T> =
  // Delayed execution semantics
  | ModelValue of 'T
  | DelayedModelValue of (unit->'T)
  // Exception semantics
  | Collision of Definition*Definition
  | UndefinedScope of string list
  | InvalidContainment of Definition*Definition
  | InvalidOperation of string

Finally, I also added several helper methods:

type Definition = unit

type ModelResult<'T> =
  // Delayed execution semantics
  | ModelValue of 'T
  | DelayedModelValue of (unit->'T)
  // Exception semantics
  | Collision of Definition*Definition
  | UndefinedScope of string list
  | InvalidContainment of Definition*Definition
  | InvalidOperation of string

  member s.IsDelayed () =
    match s with
    | DelayedModelValue(_) -> true
    | _ -> false

  member s.IsException () =
    match s with
    | ModelValue(_) -> false
    | DelayedModelValue(_) -> failwith "invalid operation"
    | _ -> true
 
  member s.Get() =
    match s with
    | ModelValue(m) -> m
    | _ -> failwith "invalid operation"
 
  member s.Complete() =
    let rec loop x =
      match x with
      | DelayedModelValue work -> loop (work())
      | _ -> x
    loop s
 
  member s.CastException<'U> () =
    match s with
    | ModelValue(_) -> failwith "invalid cast"
    | DelayedModelValue(_) -> failwith "invalid cast"
    | Collision(d1,d2) -> ModelResult<'U>.Collision(d1,d2)
    | UndefinedScope(s) -> ModelResult<'U>.UndefinedScope(s)
    | InvalidContainment(d1,d2) -> ModelResult<'U>.InvalidContainment(d1,d2)
    | InvalidOperation(s) -> ModelResult<'U>.InvalidOperation(s)

A set of core functions: construct, return, bind

construct is provided by the discriminated union type constructors: ModelValue, DelayedModelValue, Collision, UndefinedScope, InvalidContainment and InvalidOperation.  However, of these, ModelValue is most important as it can build a ModelResult that can represent any value.

For return, bind and other functions, I defined a new module: ModelResult.  Note that there is no conflict with ModelResult<‘T> because one is generic with one type parameter and the other is not generic.

return is easy.  return has the signature: ‘a -> ModelResult<‘a>.  This is correct whether the monad is a delayed execution monad or not.  In both cases, the implementation is just let return a = ModelValue(a).  In the code, return is called result because return is a keyword.  I hope that does not confuse you!

bind is not easy!  bind has the signature:

(‘a -> ModelResult<‘b>) -> ModelResult<‘a> -> ModelResult<‘b>

The implementation differs depending on whether a delayed execution model is used.  First, here is a direct execution implementation for ModelResult:

let bind k (e:ModelResult<'T>) =
    if (e.IsException()) then
        e.CastException<_>()
    else
        k (e.Get())

In contrast, here is the implementation for a delayed execution:

let rec bind k e =
    match e with
    | ModelValue v -> DelayedModelValue (fun () -> k v)
    | DelayedModelValue work -> DelayedModelValue (fun () -> bind k (work()))
    | _ -> e.CastException<_>()

As soon as bind is used in this implementation, a delayed result (or an exceptional case) is guaranteed.

Supporting .NET exceptions (try…with and try…finally)

In this and the following sections, I will not discuss supporting these constructs in a direct execution model as the code would look very different to the standard implementation.  Instead, the mechanism for a delayed execution approach is given.

To support .NET exceptions, and also to correctly implement both for and use, another type is needed.  The type is needed because it must be embedded in the existing monad type.  A result that may be an exception is wrapped as MonadValue<MaybeExceptionValue<MonadValue>>.  Understanding this is key to understanding the implementation of catch.

In my case, I defined a new type with identical semantics to the F# Draft Language Specification’s OkOrException<‘T>:

type ModelResultCatch<'T> =
  | ModelResultOK of 'T
  | ModelResultException of System.Exception

However, I have adapted the signature of catch. In the Eventually<‘T> example, catch has the following signature:

Eventually<‘T> -> Eventually<OkOrException<‘T>>

I have adapted it to:

ModelResult<‘a> -> ModelResult<ModelResultCatch<ModelResult<‘T>>>

This allows the embedded result to model any of the supported exception cases as well as a true value.  This also affects the implementation of the methods that use catch (but only slightly).

Here is my implementation:

let rec catch (e:ModelResult<'T>)=
    match e with
    | DelayedModelValue work ->
      let res : ModelResultCatch<ModelResult<_>> =
        try ModelResultOK(work()) with
        | e -> ModelResultException e
      match res with
      | ModelResultOK cont -> catch cont // note, a tailcall
      | ModelResultException e -> result (ModelResultException e)
    | _ -> result (ModelResultOK(e))

Note that catch executes a contained delayed ModelResult so a non-exceptional result will not include a DelayedModelValue instance.

A set of functions to support the workflow

The following functions are provided in the F# Draft Language Specification:

delay

  /// The delay operator
  /// This is boiler-plate in terms of result and bind.
  let delay f = (result ()) |> bind (fun () -> f())

delay is inserted automatically by the compiler in certain constructs.  Whenever it does so, the compiler converts an expression expr to:

delay (fun () -> expr)

Because this is done by the compiler (and not by code), it has the effect of delaying the calculation of expr and then passing that function

f: unit->MonadValue<‘T>

to delay which must wrap it in the monad type.  In my case, this meant passing the function into the DelayedModelResult constructor which is accomplised by bind.

tryFinally

  /// The tryFinally operator
  /// Based on boiler-plate code in terms of result‚ catch and bind.
  let tryFinally e compensation =
    catch (e)
    |> bind (fun res ->
        compensation() ;
        match res with
        | ModelResultOK v -> v // result v in Eventually<'T>
        | ModelResultException e -> raise e)

The execution of tryFinally is delayed, not by tryFinally itself, but by the automatic insertion of delay by the compiler.  delay is inserted twice, once in the tryFinally around e and also at the outset of the computation expression.

Note also the slight change in the first pattern match to support my altered catch implementation.

tryWith

  /// The tryWith operator
  /// Based on boiler-plate code in terms of result, catch and bind
  let tryWith e handler =
       catch e
    |> bind (function
        | ModelResultOK v -> v // result v in Eventually<'T>
        | ModelResultException e -> handler e)

Similar to tryFinally and also adjusted for the altered catch semantics.

whileLoop, combine, using and forLoop

These are all entirely boiler-plate code, straight from the F# Draft Language Specification:

  /// This is boiler-plate in terms of result and bind.
  let rec whileLoop gd body =
    if gd() then body |> bind (fun v -> whileLoop gd body)
    else result ()

  /// This is boiler-plate in terms of result and bind.
  let rec whileLoop gd body =
    if gd() then body |> bind (fun v -> whileLoop gd body)
    else result ()

  /// The sequanial composition operator
  /// This is boiler-plate in terms of result and bind.
  let combine e1 e2 =
    e1 |> bind (fun () -> e2)
 
  /// The using operator
  let using (resource: #System.IDisposable) f =
    tryFinally
      (f resource)
      (fun () -> resource.Dispose())
 
  /// The forLoop operator
  /// This is boiler-plate in terms of catch, result and bind.
  let forLoop (e:seq<_>) f =
    let ie = e.GetEnumerator()
    tryFinally
      (whileLoop
        (fun () -> ie.MoveNext())
        (delay (fun () ->
            let v = ie.Current
            f v)))
      (fun () -> ie.Dispose())

A class to act as the computation expression builder

This class is actually used to construct the computation expression and it follows the usage described in the F# Draft Language Specification.  In the above code, curried functions have been used but the builder requires parameter tuples and will not work with curried functions.  If you try it, you will get the following error when you try to use the computation expression:

error FS0001: This expression has type ‘b * ‘c but is here used with type ModelResult<‘a>

Another way to create problems is to get the tuple ordering wrong.  It can be hard to spot if you do.  Here’s my code:

type ModelResultBuilder() =
  member s.Bind(e,k) = ModelResult.bind k e // monad value, continuation
  member s.Return(v) = ModelResult.result v // raw value
  member s.Delay(f) = ModelResult.delay f // unit -> monad value
  member s.Run(e) = e // optionally can execute a delayed monad
  member s.Zero() = ModelResult.result () // note: Zero is a method not a property
  member x.Combine(e1,e2) = ModelResult.combine e1 e2 // monad value<unit>, monad value<unit>
  member x.TryWith(e,handler) = ModelResult.tryWith e handler // monad value<'T>, System.Exception -> unit
  member x.TryFinally(e,compensation) = ModelResult.tryFinally e compensation // monad value<'T>, unit -> unit
  member x.For(e:seq<_>,f) = ModelResult.forLoop e f // seq<'a>, body: 'a -> unit
  member x.Using(resource,e) = ModelResult.using resource e // IDisposable, continuation

A module to hold a default computation expression builder

Although not strictly necessary, this is almost always desired.  Depending on whether you want the computation expression to be always available or only when a particular namespace is opened, you can use [<AutoOpen>] on the module or [<assembly:AutoOpen(namespace.module)>] respectively.  All you need is a named instance of the builder:

[<AutoOpen>]
module ModelResultPervasives =
  let modelResultOf = new ModelResultBuilder()

An example

I am using this monad in my code already.  I will be able to give a complete example project soon but in the meantime, here is a small snippet of the code:

  static member check_local_name (d:Definition) =
    modelResultOf {
      if (System.String.IsNullOrEmpty d.localName) then
        return! InvalidOperation("Local name cannot be the empty string or null")
      }
 

  static member check_collision (d:Definition) (m:Model) =
    modelResultOf {
      let curMap = m.model.[d.scope]
      if curMap |> Map.contains d.localName then
        return! Collision(d, curMap.[d.localName])
      }
     
  static member add (d:Definition) (m:Model) =
    modelResultOf {
      do! m |> Model.verify_containment d
      do! d |> Model.check_local_name
      do! m |> Model.check_collision d
     
      let scope = d.scope
      let name = d.localName

      let curMap = m.model.[scope]

      let newMap = curMap |> Map.add name d
      let newModel =
           m.model
        |> Model.mutate_scope scope (Map.add name d)
        |> Map.add (name::scope) Map.Empty
      return ({m with model = newModel})
      }

  static member check_is_root fullName =
    modelResultOf {
      match fullName with
        | [] -> return true
        | _ -> return false
      }

  static member check_not_remove_root fullName =
    modelResultOf {
      let! test = Model.check_is_root fullName
      if test then
        return! InvalidOperation("Cannot remove the Root scope")
      }

  static member remove fullName (m:Model) =
    modelResultOf {
      do! fullName |> Model.check_not_remove_root
      let scope, name = Model.split_name fullName

      match (m |> Model.lookup_direct (scope,name)) with
      | None -> return m
      | Some _ ->
        let newModel =
             m.model
          |> Map.remove fullName
          |> Model.mutate_scope scope (Map.remove name)
        return {m with model = newModel}
      }

I cannot easily explain the code without introducing a large amount of code that is unrelated to this post, but I hope it helps you to get started.  If it does not, leave a comment and I will see if I can create a small example.

The monad code in full

Here is the monad code in full:

#light
type Definition = unit

// used to implement ModelResult.catch
type ModelResultCatch<'T> =
  | ModelResultOK of 'T
  | ModelResultException of System.Exception
 
type ModelResult<'T> =
  // Delayed execution semantics
  | ModelValue of 'T
  | DelayedModelValue of (unit->ModelResult<'T>)
  // Exception semantics
  | Collision of Definition*Definition
  | UndefinedScope of string list
  | InvalidContainment of Definition*Definition
  | InvalidOperation of string

  member s.IsDelayed () =
    match s with
    | DelayedModelValue(_) -> true
    | _ -> false

  member s.IsException () =
    match s with
    | ModelValue(_) -> false
    | DelayedModelValue(_) -> failwith "invalid operation"
    | _ -> true
 
  member s.Get() =
    match s with
    | ModelValue(m) -> m
    | _ -> failwith "invalid operation"
 
  member s.Complete() =
    let rec loop x =
      match x with
      | DelayedModelValue work -> loop (work())
      | _ -> x
    loop s
 
  member s.CastException<'U> () =
    match s with
    | ModelValue(_) -> failwith "invalid cast"
    | DelayedModelValue(_) -> failwith "invalid cast"
    | Collision(d1,d2) -> ModelResult<'U>.Collision(d1,d2)
    | UndefinedScope(s) -> ModelResult<'U>.UndefinedScope(s)
    | InvalidContainment(d1,d2) -> ModelResult<'U>.InvalidContainment(d1,d2)
    | InvalidOperation(s) -> ModelResult<'U>.InvalidOperation(s)

module ModelResult =
  let rec bind k e =
    match e with
    | ModelValue v -> DelayedModelValue (fun () -> k v)
    | DelayedModelValue work -> DelayedModelValue (fun () -> bind k (work()))
    | _ -> e.CastException<_>()

  let result x = ModelValue x
 
  let zero = result ()

  let delay f = result() |> bind f
 
  let rec catch (e:ModelResult<'T>)=
    match e with
    | DelayedModelValue work ->
      let res : ModelResultCatch<ModelResult<_>> =
        try ModelResultOK(work()) with
        | e -> ModelResultException e
      match res with
      | ModelResultOK cont -> catch cont // note, a tailcall
      | ModelResultException e -> result (ModelResultException e)
    | _ -> result (ModelResultOK(e))
 
  /// The tryFinally operator
  /// Based on boiler-plate code in terms of result, catch and bind.
  let tryFinally e compensation =
    catch (e)
    |> bind (fun res ->
        compensation() ;
        match res with
        | ModelResultOK v -> v
        | ModelResultException e -> raise e)
 
  /// The tryWith operator
  /// Based on boiler-plate code in terms of result, catch and bind.
  let tryWith e handler =
       catch e
    |> bind (function
        | ModelResultOK v -> v
        | ModelResultException e -> handler e)
 
  /// The whileLoop operator
  /// This is boiler-plate in terms of result and bind.
  let rec whileLoop gd body =
    if gd() then body |> bind (fun v -> whileLoop gd body)
    else result ()

  /// The sequential composition operator
  /// This is boiler-plate in terms of result and bind.
  let combine e1 e2 =
    e1 |> bind (fun () -> e2)
 
  /// The using operator
  let using (resource: #System.IDisposable) f =
    tryFinally
      (f resource)
      (fun () -> resource.Dispose())
 
  /// The forLoop operator
  /// This is boiler-plate in terms of catch‚ result and bind.
  let forLoop (e:seq<_>) f =
    let ie = e.GetEnumerator()
    tryFinally
      (whileLoop
        (fun () -> ie.MoveNext())
        (delay (fun () ->
            let v = ie.Current
            f v)))
      (fun () -> ie.Dispose())
 
  let rec complete (e:ModelResult<'a>) =
    e.Complete()

type ModelResultBuilder() =
  member s.Bind(e,k) = ModelResult.bind k e
  member s.Return(v) = ModelResult.result v
  member s.Delay(f) = ModelResult.delay f
  member s.Run(e) = e
  member s.Zero() = ModelResult.zero
  member x.Combine(e1,e2) = ModelResult.combine e1 e2
  member x.TryWith(e,handler) = ModelResult.tryWith e handler
  member x.TryFinally(e,compensation) = ModelResult.tryFinally e compensation
  member x.For(e:seq<_>,f) = ModelResult.forLoop e f
  member x.Using(resource,e) = ModelResult.using resource e

[<AutoOpen>]
module ModelResultPervasives =
  let modelResultOf = new ModelResultBuilder()

Let me know what you think.

Advertisements

One thought on “F#: Custom Monad (Workflow) Development

  1. Pingback: F#: Pipelined Monads « Steve Horsfield

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s