F# Either computation expression with while loop

Question

I want to implement an Either computation expression in F#. The computation executes a function inside a while loop, and this function's return type is Result<int, string>. The function might return an Error<string> if some condition is met, and then the whole computation expression should be stopped.

This is the code I have so far to illustrate what I am trying to achieve:

type EitherBuilder () =
  member this.Bind(x, f) =
    match x with
    | Ok s -> f s
    | Error f -> Error f
  member this.Return x = Ok(x)
  member this.ReturnFrom x = x
  member this.Zero() = Ok()
  member this.Delay(f) = f
  member this.Combine(x, f) = this.Bind(x, f)
  member this.Run(f) = f()
  member this.While(guard, body) =
    if guard () then this.Bind(body (), fun _ -> this.While(guard, body))
    else this.Zero()

let either = EitherBuilder ()

let mutable i = 0

let func i =
  if i < 3 then Ok(i)
  else Error("error")

let result = either {
  let mutable res = 0
  while i < 10 do 
    let! output = func i
    res <- output
    i <- i + 1
  return res
}

I have tested it and it looks like it is working and doing what I am after (in the example above, the computation is stopped when i becomes 3 and result is set to Error "error"), but I am not 100% sure if the implementation of the EitherBuilder is fully correct. I would appreciate some feedback.

Answer 1

There are a few things I would probably add or change about your implementation. When I create a new computation builder, I typically put the logic in a module, and then just call the functions in that module from the builder.

Another thing I would do is prefer the use of discriminated unions for Error types. This makes it possible to match on the error, and also lets you use a little trick with the implementation of delay/run on the computation builder to wrap up any unhandled exceptions that occur inside your computation expression as an Error as well, so you don't have to wrap things in try/with.

Next, I would implement some common operators like >>=, <*>, and <!>, as well as lift and apply functions. These will make it easier to work with the Results outside of the computation expression and interface with functions that don't natively work with Results.

Finally, I would implement at least all the standard members for the computation builder, including TryWith/TryFinally/Using/For. An example implementation might look like the following:

module Either =
    open FSharp.Reflection
    open System

    let inline bind f x =
        match x with
        | Ok s -> f s
        | Error e -> Error e

    let inline ok x = Ok x

    let inline zero () = Ok ()

    let inline convertExceptionToResult<'result,'event> (ex: exn) =
        let union = FSharpType.GetUnionCases(typeof<Result<'result, 'event>>)
        if typeof<'event>.IsAssignableFrom(typeof<exn>)
        then FSharpValue.MakeUnion(union.[1], [|[ex] |> box|]) |> unbox<Result<'result, 'event>>
        elif FSharpType.IsUnion typeof<'event>
        then let cases = FSharpType.GetUnionCases(typeof<'event>)
             match cases |> Seq.tryFind (fun case -> case.GetFields().Length = 1 && case.GetFields().[0].PropertyType.IsAssignableFrom(typeof<exn>)) with
             | Some case -> FSharpValue.MakeUnion(union.[1], [|[FSharpValue.MakeUnion(case, [|ex |> box|]) |> unbox<'event>] |> box|]) |> unbox<Result<'result, 'event>>
             | None -> failwithf "No Union Case of Event Type %s Supports Construction from an Unhandled Exception: \r\n%O" typeof<'event>.Name ex
        else failwithf "Unable To Construct a Failure of type %s from Unhandled Exception: \r\n%O" typeof<'event>.Name ex

    let inline delay<'result,'event> (f: unit -> Result<'result, 'event>) = fun () ->
        try f()
        with | ex -> convertExceptionToResult ex

    let inline run<'result,'event> (f: unit -> Result<'result, 'event>) =
        try f()
        with | ex -> convertExceptionToResult ex

    let inline (>>=) result f = bind f result

    let inline apply wrappedFunction result = 
        match wrappedFunction, result with
        | Ok a, Ok b -> Ok (a b)
        | Error e, Ok s -> Error e
        | Ok s, Error e -> Error e
        | Error e, Error _ -> Error e

    let inline (<*>) wrappedFunction result = apply wrappedFunction result

    let inline lift f result = apply (ok f) result

    let inline (<!>) f result = lift f result

    type EitherBuilder() = 
        member __.Zero() = zero()
        member __.Bind(x, f) = bind f x
        member __.Return(x) = ok x
        member __.ReturnFrom(x) = x
        member __.Yield(x) = ok x
        member __.YieldFrom(x) = x
        member __.Combine (a, b) = bind b a
        member __.Delay f = delay f
        member __.Run f = run f
        member __.TryWith (body, handler) =
            try body()
            with | ex -> handler ex
        member __.TryFinally (body, compensation) =
            try body()
            finally compensation()
        member this.Using(d:#IDisposable, body) =
            let result = fun () -> body d
            this.TryFinally (result, fun () ->
                match d with
                | null -> ()
                | d -> d.Dispose())
        member this.While (guard, body) =
            if not <| guard () 
            then this.Zero()
            else bind (fun () -> this.While(guard, body)) (body())
        member this.For(s:seq<_>, body) =
            this.Using(s.GetEnumerator(), fun enum ->
                this.While(enum.MoveNext,
                    this.Delay(fun () -> body enum.Current)))

    let either = EitherBuilder()

Looking at your example usage of the EitherBuilder, I would probably change the while loop to a tail-recursive function. You can still use while loops with the new EitherBuilder if you want, but using a tail-recursive function allows you to eliminate the mutable state, and correctly defining your Error cases as a discriminated union will allow you to access the failing values if you need to without having the global state i. That would look something like this:

open Either

type Errors =
| OutOfRange of int
| UnhandledException of exn // This is required to allow conversion from Exceptions to Errors

let func i =
  if i < 3 then Ok(i)
  else Error <| OutOfRange i

let result =
    let rec loop i res =
        either {
            if i < 10
            then let! output = func i
                 return! loop (i + 1) output
            else return res
        }
    loop 0 0

In which case, result has the value:

Result<int,Errors> = Error (OutOfRange 3)