Created
September 29, 2023 10:42
-
-
Save Savelenko/5e3f4b670b4d89a689d8713f1a73325c to your computer and use it in GitHub Desktop.
Async with early return capability CE for F#
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(* Library portion *) | |
/// Just like Async but supports early return with skipping the rest of computations. | |
type ContAsync<'r,'a> = ('a -> Async<'r>) -> Async<'r> | |
/// Early return. | |
let early (a : 'a) : ContAsync<'a,_> = fun _ -> async { return a } | |
/// Computation expression builder. | |
type ContAsyncBuilder () = | |
member _.Return(a : 'a) : ContAsync<'r,'a> = fun k -> k a | |
member _.ReturnFrom(comp : ContAsync<'r,'a>) = comp | |
member _.Bind(comp : ContAsync<'r,'a>, f) : ContAsync<'r,'b> = | |
fun k -> comp (fun a -> (f a) k) | |
member this.Combine(left : ContAsync<'r,_>, right : ContAsync<'r,'a>) : ContAsync<'r,'a> = | |
this.Bind(left, fun _ -> right) | |
member _.Delay(fcont) : ContAsync<'r,'a> = fun k -> (fcont ()) k | |
member this.Zero() = this.Return() | |
member inline _.Source(same : ContAsync<'r,'a>) = same | |
member _.Source(asyncComp : Async<_>) : ContAsync<'r,'a> = | |
fun k -> async { let! a = asyncComp in return! k a } | |
/// Computation expression builder. | |
let asyncEarly = ContAsyncBuilder () | |
/// Use this to "run" the async computation which can return early. This gives you a normal Async back. | |
let runContAsync (comp : ContAsync<'a,'a>) = comp (fun a -> async { return a }) | |
(* Usage example *) | |
// Run this with various combinations of `dingus` and `policy` to see early return in action. | |
let example dingus policy = Async.RunSynchronously (runContAsync (asyncEarly { | |
// The Dingus step | |
let! dingusOption = async { | |
printfn "Look up dingus" | |
return dingus | |
} | |
if not dingusOption then | |
return! early (Ok "Skipping processing of dingus because it was not found") | |
// Dingus found, policy step next | |
let! policyResult = async { | |
printfn "Can process dingus?" | |
return policy | |
} | |
if not policyResult then | |
return! early (Error "An attempt was made to process a dingus without having proper access ") | |
// Rest omitted | |
printfn "Dingus and policy are OK" | |
return Ok "Finalize dingus process" | |
})) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment