Shows mixing of monadic and applicative CEs with a result builder

mixed-applicative-mondaic-result-ce.fsx

// First, define a 'zip' function
module Result =
    let zip x1 x2 = 
        match x1,x2 with
        | Ok x1res, Ok x2res -> Ok (x1res, x2res)
        | Error e, _ -> Error e
        | _, Error e -> Error e

type ResultBuilder() =
    member _.MergeSources(t1: Result<'T,'U>, t2: Result<'T1,'U>) = Result.zip t1 t2
    
    member _.BindReturn(x: Result<'T,'U>, f) = Result.map f x

    member _.Return (value: 'T) : Result<'T, 'TError> = Ok value

    member _.ReturnFrom (result: Result<'T, 'TError>) : Result<'T, 'TError> = result

    member this.Zero () : Result<unit, 'TError> = this.Return ()

    member _.Bind
        (result: Result<'T, 'TError>, binder: 'T -> Result<'U, 'TError>)
        : Result<'U, 'TError> =
        Result.bind binder result

    member _.Delay
        (generator: unit -> Result<'T, 'TError>)
        : unit -> Result<'T, 'TError> =
        generator

    member _.Run
        (generator: unit -> Result<'T, 'TError>)
        : Result<'T, 'TError> =
        generator ()

    member this.Combine
        (result: Result<unit, 'TError>, binder: unit -> Result<'T, 'TError>)
        : Result<'T, 'TError> =
      this.Bind(result, binder)

    member this.TryWith
        (generator: unit -> Result<'T, 'TError>,
         handler: exn -> Result<'T, 'TError>)
        : Result<'T, 'TError> =
      try this.Run generator with | e -> handler e

    member this.TryFinally
        (generator: unit -> Result<'T, 'TError>, compensation: unit -> unit)
        : Result<'T, 'TError> =
      try this.Run generator finally compensation ()

    member this.Using
        (resource: 'T when 'T :> IDisposable, binder: 'T -> Result<'U, 'TError>)
        : Result<'U, 'TError> =
      this.TryFinally (
        (fun () -> binder resource),
        (fun () -> if not <| obj.ReferenceEquals(resource, null) then resource.Dispose ())
      )

    member this.While
        (guard: unit -> bool, generator: unit -> Result<unit, 'TError>)
        : Result<unit, 'TError> =
      if not <| guard () then this.Zero ()
      else this.Bind(this.Run generator, fun () -> this.While (guard, generator))

    member this.For
        (sequence: #seq<'T>, binder: 'T -> Result<unit, 'TError>)
        : Result<unit, 'TError> =
      this.Using(sequence.GetEnumerator (), fun enum ->
        this.While(enum.MoveNext,
          this.Delay(fun () -> binder enum.Current)))
    
let result = ResultBuilder()

let private run r1 r2 r3 r4 =
    let r =
        // This outer result {} is monadic
        result {
            // This inner result {} is applicative!
            let! r1 = result {
                let! a = r1
                and! b = r2
                and! c = r3
                return a + b - c
            }
            let! r2 = r4
            return r1 * r2
        }
    match r with
    | Ok x -> printfn "%A" x
    | Error e -> printfn "%A" e
        
let printApplicatives () =
    let r1 = Ok 2
    let r2 = Ok 3 // Error "fail!"
    let r3 = Ok 4
    let r4 = Ok 4

    run r1 r2 r3 r4
    run r1 (Error "failure!") r3 r4

printApplicatives ()
// 4
// failure!

w00t!