FSharp.Rop.fs

module FSharp.Rop

let bind2 f x y = 
    match x, y with
    | Ok xR, Ok yR -> f xR yR
    | Error e, _ | _, Error e -> Error e

let apply resultF result =
    match resultF with
    | Ok f -> Result.map f result
    | Error e -> Error e

let fold results =
    let foldFn item acc =
        match acc, item with
        | Error e, _ | _, Error e -> Error e
        | Ok l, Ok v -> v :: l |> Ok
    List.foldBack foldFn results (Ok [])

type ResultBuilder() = 
    member __.Zero() = Ok()
    member __.Bind(m, f) = Result.bind f m
    member __.Return(x) = Ok x
    member __.ReturnFrom(x) = x
    member __.Combine (a, b) = Result.bind b a
    member __.Delay f = f
    member __.Run f = f ()
    member __.TryWith (body, handler) =
        try
            body()
        with
        | e -> handler e
    member __.TryFinally (body, compensation) =
        try
            body()
        finally
            compensation()
    member x.Using(d:#System.IDisposable, body) =
        let result = fun () -> body d
        x.TryFinally (result, fun () ->
            match d with
            | null -> ()
            | d -> d.Dispose())
    member x.While (guard, body) =
        if not <| guard () then
            x.Zero()
        else
            Result.bind (fun () -> x.While(guard, body)) (body())
    member x.For(s:seq<_>, body) =
        x.Using(s.GetEnumerator(), fun enum ->
            x.While(enum.MoveNext,
                x.Delay(fun () -> body enum.Current)))

let result = ResultBuilder()

let (>>=) result f = Result.bind f result
let (<!>) result f = Result.map f result
let (<*>) = apply

module Async =

    let bind (f:'a -> Async<Result<'b,'c>>) result = 
        async {
            let! res = result
            match res with
            | Ok s -> return! (f s)
            | Error f -> return Error f
        }
    
    let mapError f inp = 
        async {
            let! res = inp
            match res with
            | Ok x -> return Ok x
            | Error e -> return Error (f e)
        }
    
    let apply resultF result =
        async {
            let! resF = resultF
            let! res = result
            return resF <*> res
        }

    let bind2 f x y = 
        async {
            let! xR = x
            let! yR = y
            match xR, yR with
            | Ok xR, Ok yR -> return! f xR yR
            | Error e, _ | _, Error e -> return Error e
        }

    let (>>=) result f = bind f result
    let (<!>) result f = bind (f >> Ok >> async.Return) result
    let (<*>) = apply