Obtaining cancellation tokens in Async.FromContinuations declarations - f#

Consider the following definition
let test =
Async.FromContinuations(
fun (cont,econt,ccont) ->
let rec inner () =
async {
do printfn "looping..."
do! Async.Sleep 1000
return! inner ()
}
Async.Start(inner ())
cont ())
Suppose I want to try the computation like so
let cts = new CancellationTokenSource ()
Async.Start(test, cts.Token)
cts.Cancel()
This will naturally not make the inner loop stop, since I have not passed the suitable cancellation token. Is there any way I can obtain the outer cancellation token through Async.FromContinuations? I could rewrite this using the async builder and Async.CancellationToken, but then I would lose the ability to pass continuations to the inner expression.

Can you describe what are you trying to do? If I understand your code correctly, you want to start the inner loop function in the background and then, in parallel, continue running the rest of the workflow (using the cont() call).
To do this, you do not need Async.FromContinuations. There is a function that does exactly this and it also takes care of handling exceptions, cancellation tokens etc.
I think you could rewrite your program like this:
let test =
// The inner loop function from your example
let rec inner () = async {
do printfn "looping..."
do! Async.Sleep 1000
return! inner () }
async {
// Start the inner loop as a child async
let! _ = Async.StartChild(inner())
// ... continue doing other things in parllel if you wish
do printfn "main body running..." }
Starting and cancelling of the computation looks as before:
let cts = new CancellationTokenSource ()
Async.Start(test, cts.Token)
// This will cancel the 'inner' loop as well
cts.Cancel()
If you call Async.StartChild using let! then it will start the inner task, pass it the cancellation token etc. It returns a token that you can use later to wait until the child task completes, but since you're not doing that, I used the _ pattern.

smth like this?
let test =
async {
let! ct = Async.CancellationToken
return! Async.FromContinuations(
fun (cont,econt,ccont) ->
let rec inner () =
async {
do printfn "looping..."
do! Async.Sleep 1000
return! inner ()
}
Async.Start(inner (), cancellationToken = ct)
cont ())
}
let cts = new CancellationTokenSource ()
Async.Start(test, cts.Token)
cts.CancelAfter(1000)

Related

How to use while loop in F# Async expression?

How would I go about writing the following in F#?
var reader = await someDatabaseCommand.ExecuteReaderAsync();
while (await reader.ReadAsync())
{
var foo = reader.GetDouble(1);
// ...
}
I'm very new to F# so this is the best I can come up with
task {
let! reader = someDatabaseCommand.ExecuteReaderAsync ()
let! tmp1 = reader.ReadAsync ()
let mutable hasNext = tmp1
while hasNext do
// ...
let! tmp2 = reader.ReadAsync ()
hasNext <- tmp2
}
I know it's a C# library so it's not going to be perfect, but I'd like to avoid needing to store the result of ReadAsync in a variable, let alone have two temporaries. I don't know of a way to get the "result" of a Task without binding it to a name. Perhaps a recursive solution would work?
This library works very nicely with C#, because you can use await in the condition of the loop. I think that using recursive computation expression in F# is a bit nicer than the imperative solution (I do not think you can simplify that), but it is about the same length:
task {
let! reader = someDatabaseCommand.ExecuteReaderAsync ()
let rec loop () = task {
let! hasNext = reader.ReadAsync ()
if hasNext then
// ..
return! loop () }
return! loop ()
}
A more elaborate solution would be to use F# asynchronous sequences (from the FSharp.Control.AsyncSeq library). I think this only works for async (and so you'd have to use that instead of task), but it makes the code nicer. You can define a function that runs a command and returns an asynchronous sequence of results (for simplicity, I just return the reader, which is a bit dirty, but works):
#r "nuget: FSharp.Control.AsyncSeq"
#r "nuget: System.Data.SqlClient"
open FSharp.Control
let runCommand (cmd:System.Data.SqlClient.SqlCommand) = asyncSeq {
let! reader = cmd.ExecuteReaderAsync () |> Async.AwaitTask
let rec loop () = asyncSeq {
let! hasNext = reader.ReadAsync () |> Async.AwaitTask
if hasNext then
yield reader
yield! loop () }
yield! loop () }
Given this, you can very nicely iterate over the results using plain for loop inside async (using an overload added by the AsyncSeq library):
async {
for reader in runCommand someDatabaseCommand do
let foo = reader.GetDouble(1)
() }

Using Task and Async together for Asynchronous operations on seperate threads in F#

I'm being a little adventurous with my code for the amount of experience I have with F# and I am a little worried about cross threading issues.
Background:
I have a number of orders where I need to validate the address. Some of the orders can be validated against google maps geocoding API which allows 50/ second. the rest are Australian PO Boxes which we don't have many of - but I need to validate them against a different API that only allows 1 call per second.
I have switched over most of my code from async{} functions to task{} functions and I am assuming to get something on several threads at the same time it needs to be in an async{} function or block and be piped to Async.Parallel
Question: Is this the right way to do this or will it fall over? I am wondering if I am fundamentally thinking about this the wrong way.
Notes:
I am passing a database context into the async function and updating the database within that function
I will call this from a C# ( WPF ) Application and report the progress
Am I going to have cross threading issues?
let validateOrder
(
order: artooProvider.dataContext.``dbo.OrdersEntity``,
httpClient: HttpClient,
ctx: artooProvider.dataContext,
isAuPoBox: bool
) =
async {
// Validate Address
let! addressExceptions = ValidateAddress.validateAddress (order, httpClient, ctx, isAuPoBox) |> Async.AwaitTask
// SaveExceptions
do! ctx.SubmitUpdatesAsync()
// return Exception count
return ""
}
let validateGMapOrders(httpClient: HttpClient, ctx: artooProvider.dataContext, orders: artooProvider.dataContext.``dbo.OrdersEntity`` list) =
async {
let ordersChunked = orders |> List.chunkBySize 50
for fiftyOrders in ordersChunked do
let! tasks =
fiftyOrders
|> List.map (fun (order) -> validateOrder (order, httpClient, ctx, false) )
|> Async.Parallel
do! Async.Sleep(2000)
}
let validateOrders (ctx: artooProvider.dataContext, progress: IProgress<DownloadProgressModel>) =
task {
let unvalidatedOrders =
query {
for orders in ctx.Dbo.Orders do
where (orders.IsValidated.IsNone)
select (orders)
}
|> Seq.toList
let auPoBoxOrders =
unvalidatedOrders
|> List.filter (fun order -> isAUPoBox(order) = true )
let gMapOrders =
unvalidatedOrders
|> List.filter (fun order -> isAUPoBox(order) = false )
let googleHttpClient = new HttpClient()
let auspostHttpclient = Auspost.AuspostApi.getApiClient ()
// Google maps validations
do! validateGMapOrders(googleHttpClient,ctx,gMapOrders)
// PO Box Validations
for position in 0 .. auPoBoxOrders.Length - 1 do
let! result = validateOrder (gMapOrders[position], auspostHttpclient, ctx, true)
do! Task.Delay(1000)
return true
}
When I have had to deal with rate-limited API problems I hide that API behind a MailboxProcessor that maintains an internal time to comply with the rate limit but appears as a normal async API from the outside.
Since you have two API's with different rate limits I'd parameterise the time delay and processing action then create one object for each API.
open System
type Request = string
type Response = string
type RateLimitedProcessor() =
// Initialise 1s in past so ready to start immediately.
let mutable lastCall = DateTime.Now - TimeSpan(0, 0, 1)
let mbox = new MailboxProcessor<Request * AsyncReplyChannel<Response>>((fun mbox ->
let rec f () =
async {
let! (req, reply) = mbox.Receive()
let msSinceCall = (DateTime.Now - lastCall).Milliseconds
// wait 1s between requests
if msSinceCall < 1000 then
do! Async.Sleep (1000 - msSinceCall)
lastCall <- DateTime.Now
reply.Reply "Response"
// Call self recursively to process the next incoming message
return! f()
}
f()
))
do mbox.Start()
member __.Process(req:Request): Async<Response> =
async {
return! mbox.PostAndAsyncReply(fun reply -> req, reply)
}
interface IDisposable with
member this.Dispose() = (mbox :> IDisposable).Dispose()

Throttle a stream such that writes will be queued until a response was received to the previous write

Suppose I have a stream which only allows one request/response at a time but is used in several threads.
Requests/commands should be throttled such that a new request can only occur once
the previous request has been sent and a reply has been received.
The user would be able to do this
let! res = getResponse("longResp")
let! res2 = getResponse("shortResp")
and not really know or care about the throttle.
I have tried with a modified version of Tomas Petricek's Throttling Agent that allows async with return values, but this requires the user to call getResponse("..") |> Enqueue |> w.Post which is a recipe for disaster (in case they forget to do so).
Is there a good/idiomatic way of doing this in F#?
Then make it explicit in your type system that the returned type needs to be unwrapped with another function. So instead of returning an Async<'T> which as you pointed out can be called directly with Async.Start, rather return something like:
type Queuable<'T> = Queuable of Async<'T>
Then getResponse changes to return a Queueable:
let getResponse (s:string) =
let r =
async{
do! write to your stream
return! read from your stream
}
Queuable r
Provide a function that unwraps the Queuable:
let enqueue (Queuable q) = async{
return! processor.PostAndAsyncReply(fun replyChannel -> replyChannel,q)
}
The processor is an agent that simply runs the Async workflow. Something like this:
let processor = new MailboxProcessor<_>(fun inbox ->
let rec Loop() = async {
let! (r:AsyncReplyChannel<_>,job) = inbox.Receive()
let! res = job
r.Reply res
return! Loop()}
Loop())

Cancel a sub-block of an F# async workflow

I'm trying to make an async workflow, where there's a main async loop, which executes an async sub-block in each loop. And I want this async sub-block to be cancellable, but when it cancels then I don't want the main loop to cancel. I want it to continue, at the line after the do! subBlock.
The only method I see in Async that even has an acceptable signature (takes CancellationToken, returns something that can be converted to async) is Async.StartAsTask, but that seems to hang when canceled; in the below, it prints "cancelled" and then nothing else.
open System
open System.Threading
open System.Threading.Tasks
// runs until cancelled
let subBlock =
async {
try
while true do
printfn "doing it"
do! Async.Sleep 1000
printfn "did it"
finally
printfn "cancelled!"
}
[<EntryPoint>]
let main argv =
let ctsRef = ref <| new CancellationTokenSource()
let mainBlock =
//calls subBlock in a loop
async {
while true do
ctsRef := new CancellationTokenSource()
do! Async.StartAsTask(subBlock, TaskCreationOptions.None, (!ctsRef).Token)
|> Async.AwaitTask
printfn "restarting"
}
Async.Start mainBlock
//loop to cancel CTS at each keypress
while true do
Console.ReadLine() |> ignore
(!ctsRef).Cancel()
0
Is there any way to do this?
Whether the caller that starts and cancels the worker is an async too doesn't really affect this problem, since the worker is managed via its explicitly specified cancellation token.
Asyncs have three continutations: the normal one, which can return a value, one for exceptions, and one for cancellation. There are multiple ways to add a cancellation continuation to an async, such as Async.OnCancel, Async.TryCancelled, or the general Async.FromContinuations, which includes the exception case. Here's a program that has the desired output:
let rec doBlocks () =
async { printfn "doing it"
do! Async.Sleep 1000
printfn "did it"
do! doBlocks () }
let rec runMain () =
use cts = new CancellationTokenSource()
let worker = Async.TryCancelled(doBlocks (), fun _ -> printfn "Cancelled")
Async.Start(worker, cts.Token)
let k = Console.ReadKey(true)
cts.Cancel()
if k.Key <> ConsoleKey.Q then runMain ()
This works just as well if runMain is an async. In this simple case, you could also just have it print the "cancelled" message itself.
I hope this helps. I don't think there is a general answer to how to structure the program; that depends on the concrete use case.
What happens here is that when your child task is cancelled, the OperationCanceledException brings down your mainBlock as well. I was able to get it to work by using this:
let rec mainBlock =
async {
ctsRef := new CancellationTokenSource()
let task = Async.StartAsTask(subBlock, TaskCreationOptions.None, (!ctsRef).Token) |> Async.AwaitTask
do! Async.TryCancelled(task, fun e ->
(!ctsRef).Dispose()
printfn "restarting"
Async.Start mainBlock)
}
When the task is cancelled, mainBlock is explicitly restarted in the cancelation handler. You need to add #nowarn "40" for it since mainBlock is used inside its definition. Also note the dispose on token source.
You can find more information on this problem (and perhaps a nicer solution in the form of StartCatchCancellation) in these two threads.

Inconsistent behaviour when cancelling different kinds of Asyncs

I have problems with seemingly inconsistent behavior when cancelling different kinds of Asyncs.
To reproduce the problem, let's says there is a function that takes a list of "jobs" (Async<_> list), waits for them to complete and prints their results. The function also gets a cancellation token so it can be cancelled:
let processJobs jobs cancel =
Async.Start(async {
try
let! results = jobs |> Async.Parallel
printfn "%A" results
finally
printfn "stopped"
}, cancel)
The function is called like that:
let jobs = [job1(); job2(); job3(); job4(); job5()]
use cancel = new CancellationTokenSource()
processJobs jobs cancel.Token
And somewhat later it is cancelled:
Thread.Sleep(1000)
printfn "cancelling..."
cancel.Cancel()
When the cancellation token source is cancelled, the function should execute the finally-block and print "stopped".
That works fine for job1, 2 and 3, but doesn't work when there is a job4 or job5 in the list.
Job1 just Async.Sleeps:
let job1() = async {
do! Async.Sleep 1000000
return 10
}
Job2 starts some async childs and waits for them:
let job2() = async {
let! child1 = Async.StartChild(async {
do! Async.Sleep 1000000
return 10
})
let! child2 = Async.StartChild(async {
do! Async.Sleep 1000000
return 10
})
let! results = [child1; child2] |> Async.Parallel
return results |> Seq.sum
}
Job3 waits for some ugly wait handle that's set by some even uglier thread:
let job3() = async {
use doneevent = new ManualResetEvent(false)
let thread = Thread(fun () -> Thread.Sleep(1000000); doneevent.Set() |> ignore)
thread.Start()
do! Async.AwaitWaitHandle(doneevent :> WaitHandle) |> Async.Ignore
return 30
}
Job4 posts to and waits for a reply from a MailboxProcessor:
let job4() = async {
let worker = MailboxProcessor.Start(fun inbox -> async {
let! (msg:AsyncReplyChannel<int>) = inbox.Receive()
do! Async.Sleep 1000000
msg.Reply 40
})
return! worker.PostAndAsyncReply (fun reply -> reply) // <- cannot cancel this
}
Job5 waits for a Task (or TaskCompletionSource):
let job5() = async {
let tcs = TaskCompletionSource<int>()
Async.Start(async {
do! Async.Sleep 1000000
tcs.SetResult 50
})
return! (Async.AwaitTask tcs.Task) // <- cannot cancel this
}
Why can Job1, 2 and 3 be cancelled ("stopped" gets printed), while Job4 and 5 make the function hang "forever"?
So far I always relied on F# to handle cancellation behind the scenes - as long as I'm in async-blocks and use !s (let!, do!, return!,...) everything should be fine.. but that doesn't seem to be the case all the time.
Quote:
In F# asynchronous workflows, the CancellationToken object is passed
around automatically under the cover. This means that we don't have to
do anything special to support cancellation. When running asynchronous
workflow, we can give it cancellation token and everything will work
automatically.
Complete code is available here: http://codepad.org/euVO3xgP
EDIT
I noticed that piping an async through Async.StartAsTask followed by Async.AwaitTask makes it cancelable in all cases.
i.e. for Job4 that means changing the line:
return! worker.PostAndAsyncReply (fun reply -> reply)
to:
return! cancelable <| worker.PostAndAsyncReply (fun reply -> reply)
With cancelable being:
let cancelable (x:Async<_>) = async {
let! cancel = Async.CancellationToken
return! Async.StartAsTask(x, cancellationToken = cancel) |> Async.AwaitTask
}
The same works for making Job5 cancelable.
But.. that's just a workaround and I can hardly put that around each call to an unknown Async<_>.
Only the Async. methods handle using the default CancellationToken themselves.
In your MailboxProcessor example the cancel should go on the Start method
let! ct= Async.CancellationToken
use worker := MailboxProcessor.Start( theWork, ct)
In the TaskCompletionSource example, you are going to have to register a callback to cancel it.
let! ct = Async.CancellationToken
use canceler = ct.Register( fun () -> tcs.TrySetCanceled() |> ignore )

Resources