**Update (12 September 2009)**: The community has provided a more elegant solution to this problem. See my more recent post for more details here: F# Pipelined Monads – Solutions From the Community. Thanks go to **Keith Battocchi** and **Felix (felixmar on hubFS)** for the revised solution. **I have left this post unchanged and I advise you to use the revised solution in your own projects.**

I recently completed my own construction of a couple of monads that I am using in a mini-project. I like the way that I am able to compose functions returning monadic values by using *let!* and *do!* directly. However, I was frustrated by the need to use multiple *let!* statements when I needed to chain constructs into a pipeline, for example:

let result = myBuilder { let result1 = initialValue let! r2 = r1 |> f1 let! r3 = r2 |> f2 let! r4 = r3 |> f3 return r4 }

It is important to use *let!* because each step in the pipeline is allowed to fail. More generally, the behaviour required is that *bind* must be incorporated into the pipeline. Additionally, the proliferation of intermediary variables greatly increased the possibility of error in my code because I might have referred to one of the intermediate results, rather than the most recent result. Compare this to a non-computation expression version:

let result = initialValue |> f1 |> f2 |> f3

The challenge before me was could I do any better?

**An important observation**

The best solution to this problem requires a change to the compiler. The compiler inserts additional code as part of the processing of computation expressions. Specifically:

let! x = expr in [cexpr] ==> builder.Bind(expr, fun x -> [cexpr])

do! expr in [cexpr] ==> builder.Bind(expr, fun () -> [cexpr])

It is not possible to split an expression into separate functions in code and so it is necessary to use this feature of the compiler. This means that a sequence of either *let!* or *do!* constructs is necessary and this introduces several requirements to any solution. A much nicer alternative would be for Microsoft to add a monadic pipeline keyword that has the same effect as the above solution using multiple *let!* statements.

**A solution**

The solution I chose was to use a state monad approach. I found the following forum post helpful as I was developing the monad: Custom Workflow functions (hubFS).

I chose the state monad because I needed to provide storage for intermediary results. This is because I needed to use *do!* to avoid introducing intermediary variables but *do!* expects to return *unit*. Therefore, I needed to allow these statements to store the result into the monad state.

I used a generic form of the state monad as:

Monad<‘T,’Sin,’Sout>

In addition to the usual monad functions, I needed to provide functions and/or operators that would transform other functions and values into state-adjusting monads:

- insert : ‘a -> Monad<unit,’b,’a>
- extract : Monad<‘a,’a,unit>
- peek : Monad<‘a,’a,’a>
- simplePipeline : (‘a -> ‘b) -> Monad<unit,’a,’b>
- complexPipeline : ‘a -> (‘b -> Monad<‘c,’a,’d>) -> Monad<‘c,’b,’d>
- chainedPipeline : ‘a -> (‘b -> Monad<‘c,’a,’d>) -> Monad<unit,’b,’c>

These deserve some explanation. Each of these are either a value that is a monad or else a function that returns one. This allows them to be composed using *do!* and *let!*, and therefore used in *bind*.

**insert** creates a monad that replaces any existing state with the provided value. It can be used as:

do! insert value

**extract** is a monad that extracts the value of the state as a normal result. Because the result type is not *unit* it must be used with *let!*:

let! state = extract

Note that *extract* replaces the existing state with *unit*.

**peek** is similar to *extract* but it maintains the value of the existing state:

let! state = peek

**simplePipeline** applies a normal function to the state value. It can be used as:

do! insert 0 do! simplePipeline ((+) 5)

**complexPipeline** passes the state value to a monad maker function and executes that monad. Because the monad state value is passed to the monad maker, another value must be used as the initial state for the secondary monad. This initial state is usually *unit*. Here is an example based on the original problem at the beginning of this post:

do! insert initialValue do! complexPipeline () f

This is most useful when *f* returns a monad with a *unit* value.

**chainedPipeline** is a more useful variation of *complexPipeline*. It combines the behaviour of *insert* and *complexPipeline* so that the result of the function is stored in the monad state, ready for the next pipelined invocation. Here is the resulting code:

do! insert initialValue do! chainedPipeline () f1 do! chainedPipeline () f2 do! chainedPipeline () f3 do! chainedPipeline () f4 let! result = extract return result

Finally, by defining operators it is possible to abbreviate the standard cases of using *insert* and *chainedPipeline*:

do! !<- initialValue do! !-> f1 do! !-> f2 do! !-> f3 do! !-> f4 let! result = extract return result

I am fairly pleased with the result, although I would prefer that the language included a keyword for this instead.

**Implementation**

My implementation is based on my previous post: F#: Custom Monad (Workflow) Development. However, the delayed execution semantics that I describe in that post are not necessary in this implementation because the state monad introduces the same behaviour.

The main types are as follows:

// Definition is used by the full application but is not needed for this post type Definition = unit type internal ModelResultCatch<'T> = | ModelResultOK of 'T | ModelResultException of System.Exception type ModelResultState<'T, 'Sin, 'Sout> = | ModelResultState of ('Sin -> 'Sout * 'T) type ModelResult<'T> = | ModelValue of 'T // Exception semantics | Collision of Definition*Definition | UndefinedScope of string list | InvalidContainment of Definition*Definition | InvalidOperation of string member s.IsException () = match s with | ModelValue(_) -> false | _ -> true static member CastException<'T, 'U> (e:ModelResult<'T>) : ModelResult<'U> = match e with | ModelValue(_) -> failwith "invalid cast" | Collision(d1,d2) -> Collision(d1,d2) | UndefinedScope(s) -> UndefinedScope(s) | InvalidContainment(d1,d2) -> InvalidContainment(d1,d2) | InvalidOperation(s) -> InvalidOperation(s) type ModelResultMonad<'T,'Sin,'Sout> = ModelResultState<ModelResult<'T>,'Sin,'Sout> type ModelResultCatchValue<'T> = ModelResultCatch<ModelResult<'T>> type ModelResultCatchData<'T> = ModelResult<ModelResultCatchValue<'T>> type ModelResultCatchMonad<'T,'Sin,'Sout> = ModelResultState<ModelResultCatchData<'T>,'Sin,'Sout>

The type aliases can help to understand the behaviour of the functions. In particular, the three “catch” type aliases are only used internally.

The basic monad structure is a function that takes a state and returns a new state and a value of type *MonadResult*. *MonadResult* is generic and wraps either a computation error or any result value. See my previous article for more on *MonadResult* as it is almost identical. You can think of the structure as an error monad inside of a state monad.

When I began adapting *MonadResult* in this way, I tried to modify *MonadResult* to combine the behaviour of a state monad and an error monad directly. I found that this was not possible because I needed the actual value of the input state in order to decide whether an error or a result was needed.

The functions for the monad are incorporated in the *ModelResult* module, which I will describe in sections:

module ModelResult = // ------------------- Internal utility functions (START) let internal castException e = ModelResult.CastException<_,_>(e) let internal castState<'s> : 's = Unchecked.defaultof<'s> let internal castExceptionAndState e = castState<_>, castException e let internal run<'t,'sin,'sout> ((ModelResultState e):ModelResultMonad<'t,'sin,'sout>) (s:'sin) : 'sout * ModelResult<'t> = e s let internal wrapException (e:#System.Exception) : ModelResultCatchData<'a> = ModelValue(ModelResultException(e)) let internal wrapSuccess (v:ModelResult<'t>) : ModelResultCatchData<'t> = ModelValue(ModelResultOK(v)) // ------------------- Internal utility functions (END)

The first three functions allow for automatic type transitions when either an exception or a computation error occurs. In particular, *Unchecked.defaultof<_>* is worth knowing! Of course, it is the responsibility of the workflow author to ensure that unknown values are not used. An alternative would have been to wrap the state in a discriminated union type, similar to ModelResult, but I have not done so.

*run* is a simple function that unpacks the state monad function and executes it with the provided state. The type annotations are added to make the code more readable and compiler errors more targeted.

The final two, “wrap”, functions are utility functions used by *catch* later in the module. These help *catch* to create a true monadic value with success or exception details incorporated.

// ------------------- Composition functions (START) let insert (a:'a) : ModelResultMonad<unit, 'b, 'a> = ModelResultState (fun s -> a, ModelValue ()) let extract : ModelResultMonad<'a,'a,unit> = ModelResultState (fun s -> (), ModelValue s) let peek : ModelResultMonad<'a,'a,'a> = ModelResultState (fun s -> s, ModelValue s) let simplePipeline (f:'a->'b) : ModelResultMonad<unit,'a,'b> = ModelResultState (fun (s:'a) -> f s, ModelValue ()) let complexPipeline (si:'si) (f:'sin->ModelResultMonad<'t,'si,'sout>) : ModelResultMonad<'t,'sin,'sout> = ModelResultState (fun s -> let m = f s run m si) let chainedPipeline (si:'si) (f:'sin->ModelResultMonad<'t,'si,'so>) : ModelResultMonad<unit,'sin,'t> = ModelResultState (fun s -> let m = f s let s2, v = run m si match v with | ModelValue x -> x, ModelValue () | _ -> castExceptionAndState v) // ------------------- Composition functions (END)

These composition functions have the behaviour described earlier in this post.

// ------------------- Monad implementation methods (START) let resultDirect (e:ModelResult<'t>) : ModelResultMonad<'t,'s,'s> = ModelResultState(fun s -> s, e) let result<'t,'s> (x:'t) : ModelResultMonad<'t,'s,'s> = resultDirect (ModelValue(x)) let error (e:ModelResult<'u>) : ModelResultMonad<'t,'s,'s> = resultDirect (castException(e)) let bind (k:'t->ModelResultMonad<'u,'sinternal,'sout>) (e:ModelResultMonad<'t,'sin,'sinternal>) : ModelResultMonad<'u,'sin,'sout> = ModelResultState(fun s -> let s2, v = run e s match v with | ModelValue x -> run (k x) s2 | _ -> castExceptionAndState v) let zero<'s> : ModelResultMonad<unit,'s,'s> = result () let delay f : ModelResultMonad<_,_,_> = result() |> bind f

*result* is the usual monadic *return* function. However, because error values are wrapped in the state monad it is useful to factor out the internal construction of the value. *resultDirect* adds a state monad wrapper to any value and *error* inserts an existing error value (created by the discriminated union constructors), casting it to any required type as inferred by the F# compiler.

*bind* performs the function of adding a continuation to the monad, which is only executed if *e* results in a non-error value.

*zero* and *delay* are typical implementations.

let rec internal catch (e:ModelResultMonad<'t,'sin,'sout>) : ModelResultCatchMonad<'t,'sin,'sout> = ModelResultState(fun s -> try let s2, v = run e s s2, wrapSuccess v with | e -> castState, wrapException e )

*catch* was difficult to design! Defining the precise types that I needed it to accept and return was definitely the most important design step. After that it was much easier to determine how to proceed. The most important part to this was recognising that it should return a monadic value that was compatible with *bind*. This is why *ModelResultCatchMonad* is such a deep type structure.

/// The tryFinally operator let tryFinally (e:ModelResultMonad<'t,'sin,'sout>) compensation = catch (e) |> bind (fun (res:ModelResultCatchValue<'t>) -> ModelResultState(fun s -> compensation() ; match res with | ModelResultOK v -> s, v | ModelResultException e -> raise e)) /// The tryWith operator let tryWith e handler = catch (e) |> bind (fun (res:ModelResultCatchValue<'t>) -> ModelResultState(fun s -> match res with | ModelResultOK v -> s, v | ModelResultException e -> run (handler e) castState))

*tryFinally* was straightforward once *catch* was correct. The type annotations definitely helped in this.

For *tryWith*, I am fairly sure the implementation is correct. Normal operation is easy, but the decision was to treat *handler* as a function that returned a monad. I believe this is what the F# Draft Language Specification requires, as the handler can be a computation expression.

/// 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()) // ------------------- Monad implementation methods (END) let complete (initialState:'b) (e:ModelResultMonad<'a,'b,'c>) = run e initialState |> snd let get = function | ModelValue v -> v | _ -> failwith "ModelResult represents an error and cannot be accessed with ModelResult.get"

*whileLoop, combine, using* and *forLoop* are standard implementations based on other functions.

Because the monad does not execute automatically, *complete* is used for the purpose. If the result is successful, *get* can be used to retrieve the stored value. In general, this should not be used and instead a *match* clause should be used to act according to whether an error has resulted, however it is helpful for test code.

**The builder class and some operators**

The builder class is identical to the one in my previous post and has the semantics of a manual-execution monad:

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

The builder and operators are provided by the following module:

[<AutoOpen>] module ModelResultPervasives = let modelResultOf = new ModelResultBuilder() let (!<-) x = ModelResult.insert x let (!|>) f = ModelResult.simplePipeline f let (!->) f = ModelResult.chainedPipeline () f let (!+>) f = ModelResult.complexPipeline () f let (-->) s f = ModelResult.chainedPipeline s f let (++>) s f = ModelResult.complexPipeline s f let (!~~) e = ModelResult.error e

**Concluding remarks**

If you would like to see Microsoft add this functionality to the language, please consider voting for it on Microsoft Connect here: F#: Pipelining in monads/workflows (Microsoft Connect).

**Full code**

#light // Definition is used by the full application but is not needed for this post type Definition = unit type internal ModelResultCatch = | ModelResultOK of 'T | ModelResultException of System.Exception type ModelResultState = | ModelResultState of ('Sin -> 'Sout * 'T) type ModelResult = | ModelValue of 'T // Exception semantics | Collision of Definition*Definition | UndefinedScope of string list | InvalidContainment of Definition*Definition | InvalidOperation of string member s.IsException () = match s with | ModelValue(_) -> false | _ -> true static member CastException (e:ModelResult) : ModelResult = match e with | ModelValue(_) -> failwith "invalid cast" | Collision(d1,d2) -> Collision(d1,d2) | UndefinedScope(s) -> UndefinedScope(s) | InvalidContainment(d1,d2) -> InvalidContainment(d1,d2) | InvalidOperation(s) -> InvalidOperation(s) type ModelResultMonad = ModelResultState<ModelResult,'Sin,'Sout> type ModelResultCatchValue = ModelResultCatch<ModelResult> type ModelResultCatchData = ModelResult<ModelResultCatchValue> type ModelResultCatchMonad = ModelResultState<ModelResultCatchData,'Sin,'Sout> module ModelResult = // ------------------- Internal utility functions (START) let internal castException e = ModelResult.CastException<_,_>(e) let internal castState<'s> : 's = Unchecked.defaultof<'s> let internal castExceptionAndState e = castState<_>, castException e let internal run<'t,'sin,'sout> ((ModelResultState e):ModelResultMonad<'t,'sin,'sout>) (s:'sin) : 'sout * ModelResult<'t> = e s let internal wrapException (e:#System.Exception) : ModelResultCatchData<'a> = ModelValue(ModelResultException(e)) let internal wrapSuccess (v:ModelResult<'t>) : ModelResultCatchData<'t> = ModelValue(ModelResultOK(v)) // ------------------- Internal utility functions (END) // ------------------- Composition functions (START) let insert (a:'a) : ModelResultMonad<unit, 'b, 'a> = ModelResultState (fun s -> a, ModelValue ()) let extract : ModelResultMonad<'a,'a,unit> = ModelResultState (fun s -> (), ModelValue s) let peek : ModelResultMonad<'a,'a,'a> = ModelResultState (fun s -> s, ModelValue s) let simplePipeline (f:'a->'b) : ModelResultMonad<unit,'a,'b> = ModelResultState (fun (s:'a) -> f s, ModelValue ()) let complexPipeline (si:'si) (f:'sin->ModelResultMonad<'t,'si,'sout>) : ModelResultMonad<'t,'sin,'sout> = ModelResultState (fun s -> let m = f s run m si) let chainedPipeline (si:'si) (f:'sin->ModelResultMonad<'t,'si,'so>) : ModelResultMonad<unit,'sin,'t> = ModelResultState (fun s -> let m = f s let s2, v = run m si match v with | ModelValue x -> x, ModelValue () | _ -> castExceptionAndState v) // ------------------- Composition functions (END) // ------------------- Monad implementation methods (START) let resultDirect (e:ModelResult<'t>) : ModelResultMonad<'t,'s,'s> = ModelResultState(fun s -> s, e) let result<'t,'s> (x:'t) : ModelResultMonad<'t,'s,'s> = resultDirect (ModelValue(x)) let error (e:ModelResult<'u>) : ModelResultMonad<'t,'s,'s> = resultDirect (castException(e)) let bind (k:'t->ModelResultMonad<'u,'sinternal,'sout>) (e:ModelResultMonad<'t,'sin,'sinternal>) : ModelResultMonad<'u,'sin,'sout> = ModelResultState(fun s -> let s2, v = run e s match v with | ModelValue x -> run (k x) s2 | _ -> castExceptionAndState v) let zero<'s> : ModelResultMonad<unit,'s,'s> = result () let delay f : ModelResultMonad<_,_,_> = result() |> bind f let rec internal catch (e:ModelResultMonad<'t,'sin,'sout>) : ModelResultCatchMonad<'t,'sin,'sout> = ModelResultState(fun s -> try let s2, v = run e s s2, wrapSuccess v with | e -> castState, wrapException e ) /// The tryFinally operator let tryFinally (e:ModelResultMonad<'t,'sin,'sout>) compensation = catch (e) |> bind (fun (res:ModelResultCatchValue<'t>) -> ModelResultState(fun s -> compensation() ; match res with | ModelResultOK v -> s, v | ModelResultException e -> raise e)) /// The tryWith operator let tryWith e handler = catch (e) |> bind (fun (res:ModelResultCatchValue<'t>) -> ModelResultState(fun s -> match res with | ModelResultOK v -> s, v | ModelResultException e -> run (handler e) castState)) /// 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()) // ------------------- Monad implementation methods (END) let complete (initialState:'b) (e:ModelResultMonad<'a,'b,'c>) = run e initialState |> snd let get = function | ModelValue v -> v | _ -> failwith "ModelResult represents an error and cannot be accessed with ModelResult.get" 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 (!<-) x = ModelResult.insert x let (!|>) f = ModelResult.simplePipeline f let (!->) f = ModelResult.chainedPipeline () f let (!+>) f = ModelResult.complexPipeline () f let (-->) s f = ModelResult.chainedPipeline s f let (++>) s f = ModelResult.complexPipeline s f let (!~~) e = ModelResult.error e

I hope you have found this interesting.

Pingback: F# Pipelined Monads – Solutions From the Community « Steve Horsfield