Using "bind" with an async function - f#

Let's say I have some function that returns Async<Result<string>>:
let getData id = async {
return Ok (string id)
}
Now the input to this function is the result of another function that returns Result<int>.
I'm struggling on how to compose the 2 together with Result.bind inside the async CE.
For example:
let main = async {
let id = Ok 123
let! x = id |> Result.bind getData
return x
}
This doesn't work, I get the error:
error FS0001: Type mismatch. Expecting a
'Result<int,'a> -> Async<'b>'
but given a
'Result<int,'a> -> Result<'c,'a>'
Or if I don't use let! I get and just use let
error FS0001: Type mismatch. Expecting a
'int -> Result<'a,'b>'
but given a
'int -> Async<Result<string,'c>>
I've seen some answers that say don't use Result<'a> and just let the Async exception handling do the hard work, but I face the same problems with Option<'a> and Option.bind.
I know I could use Option.isSome/isNone and/or write my own isOk/isError functions for Result, but I feel I shouldn't have to.
Any ideas on the best way to compose something like this together?

The problem is Result.bind can not be used with getData because the signatures do not match. Result.bind expects a function that produces a Result<> but getData produces an Async<Result<_,_>>. You need a bind for Async<Result<_,_>>.
Define an AsyncResult.bind function for Async<Result<_,_>> like this:
module AsyncResult =
let bind fRA vRA = async {
let! vR = vRA
match vR with
| Ok v -> return! fRA v
| Error m -> return Error m
}
now you can compose your getData function with a function that returns a Result like this:
let composed p = resultFunction p |> async.Return |> AsyncResult.bind getData
If you define a CE for AsyncResult then you can compose it like this:
let composed2 p = asyncResult {
let! id = resultFunction p |> async.Return
return! getData id
}
Here is a full implementation I use for handling Async<Result<>>.
First some useful definitions for Result:
module Result =
open Result
let rtn = Ok
let toOption r = r |> function Ok v -> Some v | _ -> None
let defaultWith f r = r |> function Ok v -> v | Error e -> f e
let defaultValue d r = r |> function Ok v -> v | Error _ -> d
let failIfTrue m v = if v then m |> Error else Ok ()
let failIfFalse m v = if not v then m |> Error else Ok ()
let iter fE f r = r |> map f |> defaultWith fE : unit
let get r = r |> defaultWith (string >> failwith)
let ofOption f vO = vO |> Option.map Ok |> Option.defaultWith (f >> Error)
let insertO vRO = vRO |> Option.map(map Some) |> Option.defaultWith(fun () -> Ok None)
let absorbO f vOR = vOR |> bind (ofOption f)
... and for Async:
module Async =
let inline rtn v = async.Return v
let inline bind f vA = async.Bind( vA, f)
let inline map f = bind (f >> rtn)
let inline iterS (f: 'a->unit) = map f >> Async.RunSynchronously
let inline iterA f = map f >> Async.Start
... and now for AsyncResult:
type AsyncResult<'v, 'm> = Async<Result<'v, 'm>>
module AsyncResult =
let mapError fE v = v |> Async.map (Result.mapError fE)
let rtn v = async.Return(Ok v )
let rtnR vR = async.Return vR
let iterS fE f vRA = Async.iterS (Result.iter fE f) vRA
let iterA fE f vRA = Async.iterA (Result.iter fE f) vRA
let bind fRA vRA = async {
let! vR = vRA
match vR with
| Ok v -> return! fRA v
| Error m -> return Error m
}
let inline map f m = bind (f >> rtn) m
let rec whileLoop cond fRA =
if cond ()
then fRA () |> bind (fun () -> whileLoop cond fRA)
else rtn ()
let (>>=) v f = bind f v
let rec traverseSeq f sq = let folder head tail = f head >>= (fun h -> tail >>= (fun t -> List.Cons(h,t) |> rtn))
Array.foldBack folder (Seq.toArray sq) (rtn List.empty) |> map Seq.ofList
let inline sequenceSeq sq = traverseSeq id sq
let insertO vRAO = vRAO |> Option.map(map Some) |> Option.defaultWith(fun () -> rtn None)
let insertR ( vRAR:Result<_,_>) = vRAR |> function | Error m -> rtn (Error m) | Ok v -> map Ok v
let absorbR vRRA = vRRA |> Async.map (Result.bind id)
let absorbO f vORA = vORA |> Async.map (Result.absorbO f)
Finally, a builder for the CE asyncResult { ... }
type AsyncResultBuilder() =
member __.ReturnFrom vRA : Async<Result<'v , 'm>> = vRA
member __.ReturnFrom vR : Async<Result<'v , 'm>> = AsyncResult.rtnR vR
member __.Return v : Async<Result<'v , 'm>> = AsyncResult.rtn v
member __.Zero () : Async<Result<unit, 'm>> = AsyncResult.rtn ()
member __.Bind (vRA, fRA) : Async<Result<'b , 'm>> = AsyncResult.bind fRA vRA
member __.Bind (vR , fRA) : Async<Result<'b , 'm>> = AsyncResult.bind fRA (vR |> AsyncResult.rtnR)
member __.Combine (vRA, fRA) : Async<Result<'b , 'm>> = AsyncResult.bind fRA vRA
member __.Combine (vR , fRA) : Async<Result<'b , 'm>> = AsyncResult.bind fRA (vR |> AsyncResult.rtnR)
member __.Delay fRA = fRA
member __.Run fRA = AsyncResult.rtn () |> AsyncResult.bind fRA
member __.TryWith (fRA , hnd) : Async<Result<'a , 'm>> = async { try return! fRA() with e -> return! hnd e }
member __.TryFinally(fRA , fn ) : Async<Result<'a , 'm>> = async { try return! fRA() finally fn () }
member __.Using(resource , fRA) : Async<Result<'a , 'm>> = async.Using(resource, fRA)
member __.While (guard , fRA) : Async<Result<unit, 'a>> = AsyncResult.whileLoop guard fRA
member th.For (s: 'a seq, fRA) : Async<Result<unit, 'b>> = th.Using(s.GetEnumerator (), fun enum ->
th.While(enum.MoveNext,
th.Delay(fun () -> fRA enum.Current)))
let asyncResult = AsyncResultBuilder()
[<AutoOpen>]
module Extensions =
type AsyncResultBuilder with
member __.ReturnFrom (vA: Async<'a> ) : Async<Result<'a, 'b>> = Async.map Ok vA
member __.Bind (vA: Async<'a>, fRA) : Async<Result<'b, 'c>> = AsyncResult.bind fRA (Async.map Ok vA)
member __.Combine (vA: Async<'a>, fRA) : Async<Result<'b, 'c>> = AsyncResult.bind fRA (Async.map Ok vA)

Related

Is there an async validate lib for F#?

I'm using asyncResult a lot in my code but it'll exit at the first error:
asyncResult {
let! a = allGood()
let! b = thisReturnsError()
let! c = neverExecuted()
}
but sometimes I want to execute ALL functions and sum up the errors:
validation {
let! a = doSomething()
and! b = doSomethingElse()
and! c = andAnotherThing()
}
and then I either get an Ok, or a Error with a list of errors.
This is great, but I would like to be able to do both!
asyncValidation {
let! a = doSomethingAsync()
and! b = doSomethingElseAsync()
and! c = andAnotherThingAsync()
}
Is there a lib doing this?
With F#+ you can combine applicatives by using Compose:
#r #"nuget: FSharpPlus"
open FSharpPlus
open FSharpPlus.Data
// Generic applicative CE. At the moment not included in the library.
type ApplicativeBuilder<'a>() =
inherit MonadFxStrictBuilder<'a>()
member inline _.BindReturn(x, f) = map f x
let applicative<'t> = ApplicativeBuilder<'t> ()
let allGoodAsync () : Async<Validation<string, int>> = async { printfn "first success"; return Success 1 }
let thisResturnsErrorAsync () : Async<Validation<string, int>> = async { return Failure "thisReturnsError" }
let neverExecutedAsync () : Async<Validation<string, int>> = async { printfn "actually executed"; return Success 3 }
let x: Async<Validation<string, _>> =
applicative {
let! (a: int) = allGoodAsync () |> Compose
and! (b: int) = thisResturnsErrorAsync () |> Compose
and! (c: int) = neverExecutedAsync () |> Compose
return a + b + c
}
|> Compose.run
let y = Async.RunSynchronously x
results in
>
first success
actually executed
val y: Validation<string,int> = Failure "thisReturnsError"
UPDATE
Revisiting this answer, this could be further simplified as follow:
type ApplicativeBuilder2<'a>() =
inherit Builder<'a>()
member inline _.BindReturn(x, f) = map f x
member inline _.Source x = Compose x
member inline _.Run x = Compose.run x
let applicative2<'t> = ApplicativeBuilder2<'t> ()
So you don't need to mess with Compose :
let x: Async<Validation<string, _>> =
applicative2 {
let! (a: int) = allGoodAsync ()
and! (b: int) = thisResturnsErrorAsync ()
and! (c: int) = neverExecutedAsync ()
return a + b + c
}
and since the F# type inference bug mentioned in the comments still wasn't fixed I can say now that both applicative and applicative2 will be definitely included in next version of F#+.
I just threw this together, but I think it works:
type Validation<'a, 'err> = Result<'a, List<'err>>
type AsyncValidation<'a, 'err> = Async<Validation<'a, 'err>>
module AsyncValidation =
let bind (f : _ -> AsyncValidation<_, _>) (av : AsyncValidation<_, _>) : AsyncValidation<_, _> =
async {
match! av with
| Ok a -> return! (f a)
| Error errs -> return Error errs
}
let ok a : AsyncValidation<_, _> =
async { return Ok a }
let zip (av1 : AsyncValidation<_, _>) (av2 : AsyncValidation<_, _>) : AsyncValidation<_, _> =
async {
let! v1 = av1
let! v2 = av2
match v1, v2 with
| Ok a1, Ok a2 -> return Ok (a1, a2)
| Error errs, Ok _
| Ok _, Error errs -> return Error errs
| Error errs1, Error errs2 -> return Error (errs1 # errs2)
}
type AsyncValidationBuilder() =
member _.Bind(av, f) = AsyncValidation.bind f av
member _.Return(a) = AsyncValidation.ok a
member _.MergeSources(av1, av2) = AsyncValidation.zip av1 av2
let asyncValidation = AsyncValidationBuilder()
Test code:
let doSomethingAsync () = async { return Ok 1 }
let doSomethingElseAsync () = async { return Error ["hello"] }
let andAnotherThingAsync () = async { return Error ["world"] }
let test =
asyncValidation {
let! a = doSomethingAsync ()
and! b = doSomethingElseAsync ()
and! c = andAnotherThingAsync ()
return a + b + c
} |> Async.RunSynchronously
printfn "%A" test // Error ["hello"; "world"]

Using F# Custom Operator Caused FS0002 Compile Error

I defined some custom pipeline operators for Async and Task objects, but get compile error FS0002.
[<AutoOpen>]
module AsyncOperators =
type AsyncOperatorHelper = AsyncOperatorHelper with
static member (=>) (computation, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation, cont)
static member (=>) (computation: Task<'a>, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation |> Async.AwaitTask, cont)
static member (=>) (computation: Task, AsyncOperatorHelper) =
fun cont ->
async.Bind(computation |> Async.AwaitTask, cont)
static member (=->) (cont: 'a -> Task<'b>, AsyncOperatorHelper) =
cont >> Async.AwaitTask
static member (=->) (cont: 'a -> Task, AsyncOperatorHelper) =
cont >> Async.AwaitTask
static member (=->) (cont: 'a -> Async<'t>, AsyncOperatorHelper) =
cont
let inline (|~>) a b = (a => AsyncOperatorHelper) (b =-> AsyncOperatorHelper)
let inline (>~>) a b x = x |> (a =-> AsyncOperatorHelper) |~> (b =-> AsyncOperatorHelper)
let _test () =
let x = async.Return 0
let add1 = fun (s: int) -> (async.Return(s + 1))
// COMPILE OK !!
let y = x |~> add1
// But if I expand add1 in the expression:
// error FS0002: This function takes too many arguments, or is used in a context where a function is not expected
let z = x |~> (fun (s: int) -> (async.Return(s + 1)))
()
The two expressions look the same, but why the second one get FS0002 error? How can I fix the problem?

How to switch from error track back to success track in railway-oriented program in F#?

Using AsyncResult from Scott Wlashin and wondering how I can change from the error track to the success track.
Pseudo-code:
let orchestratorFunction() : AsyncResult<Customer, CustomerError> = asyncResult {
let! output1 = callFunction1 arg1 arg2 |> AsyncResult.MapError CustomerError.Val1
let! output2 = callFunction2 arg1 arg2 |> AsyncResult.MapError CustomerError.Val2
let! output3 = callFunction3 arg1 arg2 |> AsyncResult.MapError (fun e -> ********HERE I WANT TO GET BACK TO THE SUCCESS PATH AND RETURN output3*********)
}
or a more realistic example:
let createCustomer() : AsyncResult<Customer, CustomerError> = asyncResult {
let! customerDto = mapDtoFromHttpRequest arg1 arg2 |> AsyncResult.MapError CustomerError.Val1
let! validatedCustomer = validateCustomer arg1 arg2 |> AsyncResult.MapError CustomerError.Val2
let! validatedCustomer = insertCustomer arg1 arg2
|> AsyncResult.MapError (fun e ->
match e with
| DuplicateCustomer _ ->
loadCustomerById xx
|> (fun c ->
if c.LastCausationId = validatedCustomer.LastCausationId
then c
else e))
}
So basically I am trying to get out of the unhappy path, because this is an idempotent REST operation and any repetitive requests will be answered with 200 OK, as if they were the original request, so that the client can have a simple logic.
Based on the answer from #Gus to this question (AsyncResult and handling rollback) it seems that bindError is what I needed. I created a similar to his bindError bindExn, and it seems to work as well, so now both error and exns can be converted to Ok:
(From Gus):
/// Apply a monadic function to an AsyncResult error
let bindError (f: 'a -> AsyncResult<'b,'c>) (xAsyncResult : AsyncResult<_, _>) :AsyncResult<_,_> = async {
let! xResult = xAsyncResult
match xResult with
| Ok x -> return Ok x
| Error err -> return! f err
}
(My code):
let bindExn
(f: exn -> AsyncResult<'a,'b>)
(xAsyncResult:AsyncResult<_,_>)
: AsyncResult<'a,'b>
=
async {
let! res =
xAsyncResult
|> Async.Catch
|> Async.map(function
| Choice1Of2 res -> res |> AsyncResult.ofResult
| Choice2Of2 (ex:exn) ->
f ex
)
return! res
}

How to Unify a Type Implementing an Interface and the Same Type as a Parameter?

Given the following types
type IDocPartX<'delta, 'pures> =
abstract member ToDelta: 'pures -> 'delta
abstract member ToPure: 'delta -> 'pures
abstract member Validate: 'pures -> Option<'pures>
type InitX<'a>(v:'a) =
member this.Value = v
type Foo<'a> = {value: 'a} with
interface IDocPartX<Foo<int>, Foo<string>> with
member this.ToDelta x = Unchecked.defaultof<_>
member this.ToPure x = Unchecked.defaultof<_>
member this.Validate x = Unchecked.defaultof<_>
this function
let inline ValidateInitX(x:InitX<IDocPartX<'d,'p>>) =
let r = x.Value
let d = r :?> 'd
let o =
d
|> r.ToPure
|> r.Validate
match o with
| Some v -> r.ToDelta v |> Init |> Some
| _ -> None
and this values
let a = InitX {value = 1}
let b = ValidateInitX a
why is the value a not recognized to be of InitX<IDocPartX<'a, 'b>>?
OK, a bit of SRTPs magic on the function definition will do the trick
let inline ValidateInitX<'d, 'p when 'd :> IDocPartX<'d,'p>>(x:InitX<'d>) =
let r = x.Value
let o =
r
|> r.ToPure
|> r.Validate
match o with
| Some v -> r.ToDelta v |> Init |> Some
| _ -> None

How to define Yield and For for custom computation operation in F#

I'm working on some DSL for my application and here's how I defined computation type and builder:
// expression type
type Action<'a,'b> = Action of ('a -> Async<'b>)
let runAction (Action r) ctx = r ctx
let returnF a = Action (fun _ -> async {return a})
let bind m f = Action (fun r -> async {
let! a = runAction m r in return! runAction (f a) r
})
let bindA ac f = Action (fun r -> async {
let! a = ac in return! runAction (f a) r
})
type ActionBuilder<'x>() =
member this.Return(c) = returnF c
member this.Zero() = returnF ()
member this.Delay(f) = bind (returnF ()) f
// binds both monadic and for async computations
member this.Bind(m, f) = bind m f
member this.Bind(m, f) = bindA m f
member this.Combine(r1, r2) = bind r1 (fun () -> r2)
member this.For(s:seq<_>, f) = Action (fun x -> async {
for i in s do runAction (f i) x |> ignore
})
// here's the attempt to implement 'need' operations
[<CustomOperation("need")>]
member this.Need(Action a, targets: string list) =
Action (fun x ->
let r = a x
printfn "need(%A, [%A])" a targets
r)
member this.For(a, f) = bindA a f
member this.Yield(()) =
returnF ()
let action = ActionBuilder<string>()
/////////////////////////////////////////////////////////////
// other functions for Action
/// Gets action context
let getCtx = Action (fun ctx -> async {return ctx})
let needFn res = action {
let! ctx = getCtx
printfn "need([%A]) in %A" res ctx
}
The resulting code is supposed to be:
let program1 = fun filename -> action {
let! a = async {return 123}
let f = a+1
// need ["def"; "dd"]
do! needFn ["def"; "dd"]
printfn "after need"
for i in [0..10] do
do! Async.Sleep (1)
printfn "i: %A" i
let! d = async {return f}
let! ctx = getCtx
printfn "ctx: %A, %A" ctx f
}
Async.RunSynchronously(runAction (program1 "m.c") "abc")
Now I would like to change do! needFn ["def"; "dd"] syntax to a nicer one by defining "need" custom operation, but getting various complains from compiler. Is it correct approach or I'm misusing the computation expressions?
The other issue is that for does not work if do! is used inside loop body.
After reading papers, by trial and error method I came to the following for implementation (Yield builder method is not required):
let forF (e: seq<_>) prog =
usingF (e.GetEnumerator()) (fun e ->
whileF
(fun () -> e.MoveNext())
((fun () -> prog e.Current) |> delayF)
)
Full source code for computation expression builder could be found in the target project. The whole project is a variation of Fake build system.
Note: Action was renamed to Recipe. need operator cannot be implemented at all.

Resources