F#: Delayed, Compositional Maybe Monad (Workflow) – Full Source

There are some good examples of the maybe monad in F# based on the option ‘a type. However, this approach has some shortcomings. This is a short post with code that I am using to provide the semantics of the maybe monad in F#.

To start with, here is a great blog entry that demonstrates a typical example of a maybe monad in F#: Matthew Doig: The Maybe Monad in F#. Now, this is a good example of how to do a maybe monad, so please do not misunderstand me. The limitation I am concerned with is in delay and it affects the usefulness of the monad as a whole. Matthew’s implementation is typical of others that I have found.

In Matthew’s example, as with many others, the standard option type is used which is ideal. Unfortunately, this does not allow for delayed execution semantics to be modelled effectively. A delayed type would have the signature:

option<unit ->’a>

and a direct value type would have the signature:

option<‘a>

Because these two types differ, it is difficult to maintain static type checking and provide delayed execution semantics. Sadly, there is not an easy way around this and so I have chosen to create a new type which includes a third union case to represent a delayed function:

  [<Microsoft.FSharp.Core.CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue)>]
  type MaybeMonad<'a> =
    | MaybeNone    
    | MaybeValue of 'a
    | MaybeDelayedValue of (unit -> MaybeMonad<'a>)

So why is delayed execution important? Delayed execution allows for monadic composition of functions. Workflows provide a computation expression mechanism that are expanded by the compiler to:

builder.Run(builder.Delay(fun () -> expr))

If the Delay function evaluates expr then the monad does not support delayed execution and the value is immediately available. Similarly, if Run executes the monad then the monad does not support delayed execution. Instead, it is desirable that a manual function is used to evaluate the expression. In that way, a computation can be built from a set of computation expressions that are only evaluated as needed or at an explicit stage in the overall program execution.

Here is the full code for my implementation:

#light

namespace SteveHorsfield.FSharp.ExtensionsLibrary.MaybeMonad

  // this attribute breaks the WordPress formatting so I have inserted extra spaces
  // you will need to remove them if you are copying the code
  [ < Microsoft.FSharp.Core.CompilationRepresentation(CompilationRepresentationFlags.UseNullAsTrueValue) > ]
  type MaybeMonad<'a> =
    | MaybeNone    
    | MaybeValue of 'a
    | MaybeDelayedValue of (unit -> MaybeMonad<'a>)
    static member evaluate (s: MaybeMonad<'a>) =
      let rec eval s =
        match s with
        | MaybeNone -> None
        | MaybeValue v -> Some v
        | MaybeDelayedValue f -> eval (f())
      eval s
    static member wrap (o: 'a option) =
      match o with
      | None -> MaybeNone
      | Some v -> MaybeValue v
    static member unwrap (o: MaybeMonad<'a option>) =
      match o with
      | MaybeNone -> None
      | MaybeValue v -> Some v
      | _ -> failwith "value has not been evaluated"

  type internal MaybeException<'a> =
    | MaybeOK of MaybeMonad<'a>
    | MaybeException of System.Exception

namespace SteveHorsfield.FSharp.ExtensionsLibrary.MaybeMonad

  module Maybe =
  
    let wrap (o:'a option) = MaybeMonad.wrap o
  
    let internal result x = MaybeValue(x)

    let rec internal bind k e =
      match e with
      | MaybeNone -> MaybeNone
      | MaybeValue(v) -> MaybeDelayedValue(fun () -> k v)
      | MaybeDelayedValue(f) -> MaybeDelayedValue(fun () -> bind k (f()))
        
    let internal zero = result ()
    
    let internal delay f = result () |> bind f
    
    let rec internal catch (e:MaybeMonad<_>) =
      match e with
      | MaybeDelayedValue work ->
        MaybeDelayedValue(fun () ->
          let res = try (MaybeOK(work())) with | e -> MaybeException(e)
          match res with
          | MaybeOK cont -> catch cont
          | MaybeException e -> result (MaybeException(e)))
      | MaybeNone -> MaybeNone
      | MaybeValue v -> result (MaybeOK(MaybeValue v))

    let internal tryFinally (e:MaybeMonad<'a>) (compensation:unit->unit) : MaybeMonad<'a> =
      catch (e)
      |> bind (fun (res:MaybeException<'a>) -> 
          compensation() ;
          match res with
          | MaybeOK v -> v
          | MaybeException e -> raise e)
          
    let internal tryWith e handler =
         catch e
      |> bind (function
          | MaybeException e -> handler e
          | MaybeOK v -> v)

    let rec internal whileLoop gd body =
      if gd() then body |> bind (fun v -> whileLoop gd body)
      else result ()

    let internal combine e1 e2 =
      e1 |> bind (fun () -> e2)

    let internal using (resource: #System.IDisposable) f =
      tryFinally 
        (f resource) 
        (fun () -> resource.Dispose())

    let internal 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 evaluate<'a> (e:MaybeMonad<'a>) =
      MaybeMonad<'a>.evaluate e

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

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


  [<AutoOpen>]
  module MaybePervasives =
    let maybe = new MaybeBuilder()
    let maybeI = new MaybeImmediateBuilder()
    type MaybeMonad<'a> with
      // this is an extension because 's' may be null
      member s.Evaluate() = MaybeMonad<'a>.evaluate s

I have made use of a number of features in this implementation:

• A null value representation for a discriminated union case
• Accessibility constraints on types and members
• The double pipeline operator ||>
• AutoOpen attribute to provide custom pervasives
• Extension methods
• An alternative builder, maybeI, for immediate evaluation when desired. Note that this builder can compose maybe constructions but the reverse requires Maybe.wrap

Finally, here is a simple example:

  let map2_try_find key1 key2 (m:Map<_,Map<_,_>>) =
    maybe { let! m2 = m.TryFind(key1) |> Maybe.wrap
            return! m2.TryFind(key2) |> Maybe.wrap }
    |> Maybe.evaluate

Maybe.wrap is necessary for functions that return a standard option type. For this reason, using alternative maybe monad implementations is desirable when delayed execution is not necessary. However, for custom functions designed to use this implementation, the constructors MaybeValue and MaybeNone are just as straightforward as Some and None, but they have the added benefit of clarifying that they are intended for use with the maybe monad.

Update (9 September 2009): There was an error in Maybe.evaluate: it did not actually evaluate a delayed expression. I have now fixed it.