How to Build an Accumulating Either Builder

Question

I want to build an computational expression for either expressions. That is simple enough

type Result<'TSuccess> = 
| Success of 'TSuccess
| Failure of List<string>

type Foo = {
    a: int
    b: string
    c: bool
}

type EitherBuilder () =
    member this.Bind(x, f) = 
        match x with
        | Success s -> f s
        | Failure f -> Failure f

        member this.Return x = Success x

let either = EitherBuilder ()

let Ok = either {
    let! a = Success 1
    let! b = Success "foo"
    let! c = Success true
    return 
        {
             a = a
             b = b
             c = c
        }
}

let fail1 = either {
    let! a = Success 1
    let! b = Failure ["Oh nose!"]
    let! c = Success true
    return 
        {
             a = a
             b = b
             c = c
        }
    } //returns fail1 = Failure ["Oh nose!"]

But in the case of Failures (multiple) I want to accumulate those and return an Failure as below.

let fail2 = either {
    let! a = Success 1
    let! b = Failure ["Oh nose!"]
    let! c = Failure ["God damn it, uncle Bob!"]
    return 
        {
             a = a
             b = b
             c = c
        }
    } //should return fail2 = Failure ["Oh nose!"; "God damn it, uncle Bob!"]

I have an idea on how to do that by rewriting Bind and always returning Success (albeit with some additional structure that signifies the accumulated erors). However if I do this then I am missing the stop signal and I always get back the return value (actually not really as I will run into a runtime exception, but in principle)

Answer 1

We now have applicative computation expressions with and! and MergeSources in the builder.

See this for a solution

Answer 2

As @tomasp is saying one approach is to always provide a value in addition to the failures in order to make bind work properly. This is the approach I have been using when dealing with this subject. I would then change the definition of Result to, for example, this:

type BadCause =
  | Exception of exn
  | Message   of string

type BadTree =
  | Empty
  | Leaf  of BadCause
  | Fork  of BadTree*BadTree

type [<Struct>] Result<'T> = Result of 'T*BadTree

This means that a Result always has a value whether it's good or bad. The value is good iff the BadTree is empty.

The reason I prefer trees over list is that Bind will aggregate two separate results that may have subfailures leading to list concatenations.

Some functions that let us create either good or bad value:

let rreturn     v       = Result (v, Empty)
let rbad        bv bt   = Result (bv, bt)
let rfailwith   bv msg  = rbad bv (Message msg |> Leaf)

Because even bad results need to carry a value in order to make Bind work we need to provide the value through bv parameter. For types that support Zero we can create a convinience method:

let inline rfailwithz  msg  = rfailwith LanguagePrimitives.GenericZero<_> msg

Bind is easy to implement:

let rbind (Result (tv, tbt)) uf =
  let (Result (uv, ubt)) = uf tv
  Result (uv, btjoin tbt ubt)

That is; we evaluate both results and join the bad trees if needed.

With a computation expression builder the following program:

  let r =
    result {
      let! a = rreturn    1
      let! b = rfailwithz "Oh nose!"
      let! c = rfailwithz "God damn it, uncle Bob!"
      return a + b + c
    }

  printfn "%A" r

Outputs:

Result (1,Fork (Leaf (Message "Oh nose!"),Leaf (Message "God damn it, uncle Bob!")))

That is; we get a bad value 1 and the reasons it's bad is because of the two joined error leafs.

I have used this approach when transforming and validating tree structures using composable combinators. It's in my case important to get all validation failure, not just the first. This means that both branches in Bind needs to be evaluated but in order to do we must always have a value in order to call uf in Bind t uf.

As in OP:s own answer I did experiment with Unchecked.defaultof<_> but I abandoned for example because the default value of a string is null and it usually leads to crashes when invoking uf. I did create a map Type -> empty value but in my final solution I require a bad value when constructing a bad result.

Hope this helps

Full example:

type BadCause =
  | Exception of exn
  | Message   of string

type BadTree =
  | Empty
  | Leaf  of BadCause
  | Fork  of BadTree*BadTree

type [<Struct>] Result<'T> = Result of 'T*BadTree

let (|Good|Bad|) (Result (v, bt)) =
  let ra = ResizeArray 16
  let rec loop bt =
    match bt with
    | Empty         -> ()
    | Leaf  bc      -> ra.Add bc |> ignore
    | Fork  (l, r)  -> loop l; loop r
  loop bt
  if ra.Count = 0 then 
    Good v
  else 
    Bad (ra.ToArray ())

module Result =
  let btjoin      l  r    =
    match l, r with
    | Empty , _     -> r
    | _     , Empty -> l
    | _     , _     -> Fork (l, r)

  let rreturn     v       = Result (v, Empty)
  let rbad        bv bt   = Result (bv, bt)
  let rfailwith   bv msg  = rbad bv (Message msg |> Leaf)

  let inline rfailwithz  msg  = rfailwith LanguagePrimitives.GenericZero<_> msg

  let rbind (Result (tv, tbt)) uf =
    let (Result (uv, ubt)) = uf tv
    Result (uv, btjoin tbt ubt)

  type ResultBuilder () =
    member x.Bind         (t, uf) = rbind t uf
    member x.Return       v       = rreturn v
    member x.ReturnFrom   r       = r : Result<_>

let result = Result.ResultBuilder ()

open Result

[<EntryPoint>]
let main argv = 
  let r =
    result {
      let! a = rreturn    1
      let! b = rfailwithz "Oh nose!"
      let! c = rfailwithz "God damn it, uncle Bob!"
      return a + b + c
    }

  match r with
  | Good v  -> printfn "Good: %A" v
  | Bad  es -> printfn "Bad: %A" es

  0

Answer 3

Eventually with the hints of @tomas above I could come with this solution which leaves the data types as they are but creates an stateful builder.

Now the only question that remains for me is this thread safe - I would assume yes. Maybe someone could confirm?

type Result<'TSuccess> = 
    | Success of 'TSuccess
    | Failure of List<string>

type Foo = {
    a: int
    b: string
    c: bool
}

type EitherBuilder (msg) =
    let mutable errors = [msg]
    member this.Bind(x, fn) =
        match x with
        | Success s -> fn s
        | Failure f ->
            errors <- List.concat [errors;f] 
            fn (Unchecked.defaultof<_>)

    member this.Return x =
        if List.length errors = 1 then
            Success x
        else
            Failure errors

let either msg = EitherBuilder (msg)

let Ok = either("OK") {
    let! a = Success 1
    let! b = Success "foo"
    let! c = Success true
    return 
        {
                a = a
                b = b
                c = c
        }
}

let fail1 = either("Fail1") {
    let! a = Success 1
    let! b = Failure ["Oh nose!"]
    let! c = Success true
    return 
        {
                a = a
                b = b
                c = c
        }
} //returns fail1 = Failure ["Fail1"; "Oh nose!"]


let fail2 = either("Fail2") {
    let! a = Success 1
    let! b = Failure ["Oh nose!"]
    let! c = Failure ["God damn it, uncle Bob!"]
    return 
        {
                a = a
                b = b
                c = c
        }
} //should return fail2 = Failure ["Fail2"; "Oh nose!"; "God damn it, uncle Bob!"]

Answer 4

I think that what you are trying to do cannot be expressed using monads. The problem is that Bind can only call the rest of the computation (which may produce more failures) if it can get a value for the function argument. In your example:

let! a = Success 1
let! b = Failure ["Oh nose!"]
let! c = Failure ["God damn it, uncle Bob!"]

The binding cannot call the continuation starting with b because Failure ["Oh nose!"] does not provide a value for b. You could use default values and keep errors on the side, but this is changing the structure you are using:

type Result<'T> = { Value : 'T; Errors : list<string> }

You could write this using applicative functor abstraction where you need to have:

Merge  : F<'T1> * F<'T2> -> F<'T1 * 'T2>
Map    : ('T1 -> 'T2) -> M<'T1> -> M<'T2> 
Return : 'T -> M<'T>

You can implement all of these in a way that Merge accumulates errors (if both arguments represent a failure) and Map only applies the computation if there are no values.

There are various ways of encoding applicative functors in F#, but there is no nice syntax for that, so you'll most likely end up using ugly custom operators.