I was actually quite pleased that I got my state/error monad working (F#: Pipelined Monads), but there was a far more elegant solution staring me in the face. Thanks to other members of the F# community, I have reverted my code back to how it was and added two operators. In doing so the code is now far more elegant. Read on to see more, but thanks again to:

- Keith Battocchi who added a workaround on Microsoft Connect
- Felix (felixmar) on hubFS (http://cs.hubfs.net/forums/thread/11829.aspx)

**An elegant solution**

The solutions from both Keith and Felix recognised that *bind* already had the behaviour I needed, of taking a wrapped result and passing it to a monad maker function. I had failed to recognise that that was exactly what I was trying to do. I was concerned about breaking up expressions into functions to delay their evaluation, but I failed to notice that the expressions were partially applied functions (in my real code) and so they would never be evaluated in advance.

The solutions from both Felix and Keith involved creating a single operator that wrapped *bind*. Felix did this directly and Keith did it by using the computation expression syntax in F#. I have chosen to use Felix’s approach as it is slightly less verbose:

let (>>=) x f = myBuilder.Bind(x, f)

I have adapted the code as follows:

- I have used a different character sequence for the operator, |>> because this changes the operator associativity to be similar to pipeline (|>)
- I have added a second operator that wraps the first operand in a call to
*Return*so that a simple value can be used to begin the pipeline

Below is an extract of some of my testing code that uses this approach:

let m : ModelResult<Model> = modelResultOf { let scopeSystem = "System"::[] let scopeString = "String"::scopeSystem let scopeMySystem = "MySystem"::[] let! result = Model.Empty |-> Model.add (Definition.create [] "System" DefinitionType.Namespace EmptySpec) |>> Model.add (Definition.create [] "Steve" DefinitionType.Namespace EmptySpec) |>> Model.add (Definition.create scopeSystem "ModuleOne" DefinitionType.Module (ModuleSpec({autoOpen = true; autoOpenAssembly = true}))) |>> Model.add (Definition.create scopeSystem "String" DefinitionType.CustomClass (CustomClassSpec( () ))) |>> Model.add (Definition.create scopeString "Empty" DefinitionType.DependencyProperty (DependencyPropertySpec( () ))) |>> (fun (m:Model) -> Model.rename (m.[scopeSystem] |> Option.get) "MySystem" m) |>> (fun (m:Model) -> Model.renameAndMove (m.[scopeMySystem] |> Option.get) "MyMovedSystem" ("Steve"::[]) m) return result } |> ModelResult.complete

The syntax is exactly what I wanted to achieve, so thanks again to Keith and Felix.

Here is the full code:

#light // defined elsewhere in my project but not needed for this blog post type Definition = unit // used to implement ModelResult.catch type internal 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 | _ -> 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 result x = ModelValue x let rec bind k e = match e with | ModelValue v -> DelayedModelValue (fun () -> k v) | DelayedModelValue work -> DelayedModelValue (fun () -> bind k (work())) | _ -> e.CastException<_>() let zero = result () let delay f = result() |> bind f let rec private 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 complete (e:ModelResult<'a>) = e.Complete() let get = function | ModelValue v -> v | DelayedModelValue _ -> "ModelResult has not been executed and cannot be accessed with ModelResult.get" | _ -> 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 (|>>) e k = modelResultOf.Bind(e,k) let (|->) e k = modelResultOf.Bind(modelResultOf.Return(e),k)

Pingback: F#: Pipelined Monads « Steve Horsfield

Pingback: Rick Minerich's Development Wonderland : F# Discoveries This Week 10/11/2009