Applicative and Monadic Result builder

ResultBuilder.fs

module Result =
    let join x1 x2 =
        match x1, x2 with
        | Ok x1res, Ok x2res -> Ok(x1res, x2res)
        | Error e1, Error e2 -> Error(e1 @ e2)
        | Error e, _
        | _, Error e -> Error e


type ResultBuilder() =
    let errList m = Result.mapError List.singleton m

    member _.MergeSources(t1: Result<'T, 'U list>, t2: Result<'T1, 'U list>) = Result.join t1 t2

    member this.MergeSources(t1: Result<'T, 'U list>, t2: Result<'T1, 'U>) = this.MergeSources(t1, (errList t2))

    member this.MergeSources(t1: Result<'T, 'U>, t2: Result<'T1, 'U list>) = this.MergeSources(errList t1, t2)

    member this.MergeSources(t1: Result<'T, 'U>, t2: Result<'T1, 'U>) =
        this.MergeSources(errList t1, errList t2)

    member _.BindReturn(x: Result<'T, 'U list>, f) = Result.map f x
    member _.BindReturn(x: Result<'T, 'U>, f) = Result.map f x
    member _.Return(v) = Ok v
    member _.ReturnFrom(x) = x

    member _.Bind(m: Result<'T, 'U>, f: 'T -> Result<'R, 'U>) = Result.bind f m

    member _.Bind(m: Result<'T, 'U>, f: 'T -> Result<'R, 'U list>) = Result.bind f (errList m)

    member _.Bind(m: Result<'T, 'U list>, f: 'T -> Result<'R, 'U list>) = Result.bind f m

    member _.Bind(m: Result<'T, 'U list>, f: 'T -> Result<'R, 'U>) = Result.bind (f >> errList) m

    // noncomposable methods
    member _.Delay(f) = f
    member _.Run(f) = f ()

    member this.TryWith(body, handler) =
        try
            this.ReturnFrom(body ())
        with e ->
            handler e

    member this.TryFinally(body, compensation) =
        try
            this.ReturnFrom(body ())
        finally
            compensation ()

    member this.Using(disposable: #System.IDisposable, body) =
        let body' = fun () -> body disposable

        this.TryFinally(
            body',
            fun () ->
                match disposable with
                | null -> ()
                | disp -> disp.Dispose()
        )

    member this.Zero() = this.Return()

let result = ResultBuilder()

let ok v : Result<int, string> = Ok v
let err v : Result<int, string> = Error v

let res =
    result {
        let! a = ok 10
        and! b = ok 8
        and! c = ok 3

        try
            let! d = ok 100
            return a + b - c + d
        with _ ->
            return 0
    }

let res2 =
    result {
        let! a = ok 10
        let! b = ok 2
        return a - b
    }

let res3 =
    result {
        let! a = ok 10
        and! b = err "error B"
        and! c = err "error C"

        let! d = ok 100

        return a + b - c + d
    }

let res4 =
    result {
        let! a = ok 10
        let! d = err "failure"

        return a + d
    }


printfn "%A" <| res
printfn "%A" <| res2
printfn "%A" <| res3
printfn "%A" <| res4