Strange things... I just wanted to do a simple retry on exceptions in F# but the catch doesn't catch :) Any ideas?
let rec retry times next event =
async {
try
return! next event
with
| _ when times > 0 -> return! retry (times - 1) next event
| error -> return error.Reraise()
}
if the next is a function like;
let handler evt = async { failwith "Oh-no" }
Then the code in try executes but it is not catched. What is going on? :O
UPDATE
The reraise is an extension method as described here: https://github.com/fsharp/fslang-suggestions/issues/660 by nikonthethird.
type Exception with
member this.Reraise () =
(ExceptionDispatchInfo.Capture this).Throw ()
Unchecked.defaultof<_>
Your code does catch the exceptions. Here's the full program I'm running to test it:
let rec retry times next event =
async {
try
printfn "Retry: %A" times
return! next event
with
| _ when times > 0 -> return! retry (times - 1) next event
| error -> raise error
}
let handler evt =
async {
printfn "About to fail once"
failwith "Oh-no"
}
[<EntryPoint>]
let main argv =
retry 3 handler ()
|> Async.RunSynchronously
|> printfn "%A"
0
Output:
Retry: 3
About to fail once
Retry: 2
About to fail once
Retry: 1
About to fail once
Retry: 0
About to fail once
Unhandled exception. System.Exception: Oh-no
You can see that the exceptions are being caught, because handler is invoked multiple times before retry gives up.
Notes:
I replaced return error.Reraise() with raise error, since Exception.Reraise isn't a defined method. I'm not sure what you had in mind here, but it doesn't directly affect the answer to your question.
It's important to fully invoke retry with all three arguments (I used () as the "event"), and then run the resulting async computation synchronously. Maybe you weren't doing that?
You might want to look into using Async.Catch for handling async exceptions instead.
Related
I want to process a series of jobs in sequence, but I want to queue up those jobs in parallel.
Here is my code:
open System.Threading.Tasks
let performWork (work : int) =
task {
do! Task.Delay 1000
if work = 7 then
failwith "Oh no"
else
printfn $"Work {work}"
}
async {
let w = MailboxProcessor.Start (fun inbox -> async {
while true do
let! message = inbox.Receive()
let (ch : AsyncReplyChannel<_>), work = message
do!
performWork work
|> Async.AwaitTask
ch.Reply()
})
w.Error.Add(fun exn -> raise exn)
let! completed =
seq {
for i = 1 to 10 do
async {
do! Async.Sleep 100
do! w.PostAndAsyncReply(fun ch -> ch, i)
return i
}
}
|> fun jobs -> Async.Parallel(jobs, maxDegreeOfParallelism = 4)
printfn $"Completed {Seq.length completed} job(s)."
}
|> Async.RunSynchronously
I expect this code to crash once it reaches work item 7.
However, it hangs forever:
$ dotnet fsi ./Test.fsx
Work 3
Work 1
Work 2
Work 4
Work 5
Work 6
I think that the w.Error event is not firing correctly.
How should I be capturing and re-throwing this error?
If my work is async, then it crashes as expected:
let performWork (work : int) =
async {
do! Async.Sleep 1000
if work = 7 then
failwith "Oh no"
else
printfn $"Work {work}"
}
But I don't see why this should matter.
Leveraging a Result also works, but again, I don't know why this should be required.
async {
let w = MailboxProcessor.Start (fun inbox -> async {
while true do
let! message = inbox.Receive()
let (ch : AsyncReplyChannel<_>), work = message
try
do!
performWork work
|> Async.AwaitTask
ch.Reply(Ok ())
with exn ->
ch.Reply(Error exn)
})
let performWorkOnWorker (work : int) =
async {
let! outcome = w.PostAndAsyncReply(fun ch -> ch, work)
match outcome with
| Ok () ->
return ()
| Error exn ->
return raise exn
}
let! completed =
seq {
for i = 1 to 10 do
async {
do! Async.Sleep 100
do! performWorkOnWorker i
return i
}
}
|> fun jobs -> Async.Parallel(jobs, maxDegreeOfParallelism = 4)
printfn $"Completed {Seq.length completed} job(s)."
}
|> Async.RunSynchronously
I think the problem is in your error handling:
w.Error.Add(fun exn -> raise exn)
Instead of handling the exception, you're attempting to raise it again, which I think is causing an infinite loop.
You can change this to print the exception instead:
w.Error.Add(printfn "%A")
Result is:
Work 4
Work 2
Work 1
Work 3
Work 5
Work 6
System.AggregateException: One or more errors occurred. (Oh no)
---> System.Exception: Oh no
at Program.performWork#4.MoveNext() in C:\Users\Brian Berns\Source\Repos\FsharpConsole\FsharpConsole\Program.fs:line 8
--- End of inner exception stack trace ---
I think the gist of the 'why' here is that Microsoft changed the behaviour for 'unobserved' task exceptions back in .NET 4.5, and this was brought through into .NET Core: these exceptions no longer cause the process to terminate, they're effectively ignored. You can read more about it here.
I don't know the ins and outs of how Task and async are interoperating, but it would seem that the use of Task results in the continuations being attached to that and run on the TaskScheduler as a consequence. The exception is thrown as part of the async computation within the MailboxProcessor, and nothing is 'observing' it. This means the exception ends up in the mechanism referred to above, and that's why your process no longer crashes.
You can change this behaviour via a flag on .NET Framework via app.config, as explained in the link above. For .NET Core, you can't do this. You'd ordinarily try and replicate this by subscribing to the UnobservedTaskException event and re-throwing there, but that won't work in this case as the Task is hung and won't ever be garbage collected.
To try and prove the point, I've amended your example to include a timeout for PostAndReplyAsync. This means that the Task will eventually complete, can be garbage collected and, when the finaliser runs, the event fired.
open System
open System.Threading.Tasks
let performWork (work : int) =
task {
do! Task.Delay 1000
if work = 7 then
failwith "Oh no"
else
printfn $"Work {work}"
}
let worker = async {
let w = MailboxProcessor.Start (fun inbox -> async {
while true do
let! message = inbox.Receive()
let (ch : AsyncReplyChannel<_>), work = message
do!
performWork work
|> Async.AwaitTask
ch.Reply()
})
w.Error.Add(fun exn -> raise exn)
let! completed =
seq {
for i = 1 to 10 do
async {
do! Async.Sleep 100
do! w.PostAndAsyncReply((fun ch -> ch, i), 10000)
return i
}
}
|> fun jobs -> Async.Parallel(jobs, maxDegreeOfParallelism = 4)
printfn $"Completed {Seq.length completed} job(s)."
}
TaskScheduler.UnobservedTaskException.Add(fun ex ->
printfn "UnobservedTaskException was fired, re-raising"
raise ex.Exception)
try
Async.RunSynchronously worker
with
| :? TimeoutException -> ()
GC.Collect()
GC.WaitForPendingFinalizers()
The output I get here is:
Work 1
Work 3
Work 4
Work 2
Work 5
Work 6
UnobservedTaskException was fired, re-raising
Unhandled exception. System.AggregateException: A Task's exception(s) were not observed either by Waiting on the Task or accessing its Exception property. As a result, the unobserved exception was rethrown by the finalizer thread. (One or more errors occurred. (Oh no))
---> System.AggregateException: One or more errors occurred. (Oh no)
---> System.Exception: Oh no
at Program.performWork#5.MoveNext() in /Users/cmager/dev/ConsoleApp1/ConsoleApp2/Program.fs:line 9
--- End of inner exception stack trace ---
at Microsoft.FSharp.Control.AsyncPrimitives.Start#1078-1.Invoke(ExceptionDispatchInfo edi)
at Microsoft.FSharp.Control.Trampoline.Execute(FSharpFunc`2 firstAction) in D:\a\_work\1\s\src\fsharp\FSharp.Core\async.fs:line 104
at Microsoft.FSharp.Control.AsyncPrimitives.AttachContinuationToTask#1144.Invoke(Task`1 completedTask) in D:\a\_work\1\s\src\fsharp\FSharp.Core\async.fs:line 1145
at System.Threading.Tasks.ContinuationTaskFromResultTask`1.InnerInvoke()
at System.Threading.Tasks.Task.<>c.<.cctor>b__272_0(Object obj)
at System.Threading.ExecutionContext.RunInternal(ExecutionContext executionContext, ContextCallback callback, Object state)
--- End of stack trace from previous location ---
at System.Threading.ExecutionContext.RunInternal(ExecutionContext executionContext, ContextCallback callback, Object state)
at System.Threading.Tasks.Task.ExecuteWithThreadLocal(Task& currentTaskSlot, Thread threadPoolThread)
--- End of inner exception stack trace ---
at Program.clo#46-4.Invoke(UnobservedTaskExceptionEventArgs ex) in /Users/cmager/dev/ConsoleApp1/ConsoleApp2/Program.fs:line 48
at Microsoft.FSharp.Control.CommonExtensions.SubscribeToObservable#1989.System.IObserver<'T>.OnNext(T args) in D:\a\_work\1\s\src\fsharp\FSharp.Core\async.fs:line 1990
at Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers.h#379.Invoke(Object _arg1, TArgs args) in D:\a\_work\1\s\src\fsharp\FSharp.Core\seqcore.fs:line 379
at Program.clo#46-3.Invoke(Object delegateArg0, UnobservedTaskExceptionEventArgs delegateArg1) in /Users/cmager/dev/ConsoleApp1/ConsoleApp2/Program.fs:line 46
at System.Threading.Tasks.TaskScheduler.PublishUnobservedTaskException(Object sender, UnobservedTaskExceptionEventArgs ueea)
at System.Threading.Tasks.TaskExceptionHolder.Finalize()
As you can see, the exception is eventually published by the Task finaliser, and re-throwing it in that handler brings down the app.
While interesting, I'm not sure any of this is practically useful information. The suggestion to terminate the app within MailboxProcessor.Error handler is probably the right one.
As far as I see, when you throw an exception in the MailboxProcessor Body. Then the MailboxProcessor doesn't hang forever, it just stops the whole MailboxProcessor.
Your program also hangs, well because you do a Async.Parallel and wait until every async finished. But those with an exception, never finish, or returns a result. So your program overall, hangs forever.
If you want to explicitly abort, then you need to call System.Environment.Exit, not just throw an exception.
One way to re-write your program is like this.
open System.Threading.Tasks
let performWork (work : int) = task {
do! Task.Delay 1000
if work = 7
then failwith "Oh no"
else printfn $"Work {work}"
}
let mb =
let mbBody (inbox : MailboxProcessor<AsyncReplyChannel<_> * int>) = async {
while true do
let! (ch,work) = inbox.Receive()
try
do! performWork work |> Async.AwaitTask
ch.Reply ()
with error ->
System.Environment.Exit 0
}
MailboxProcessor.Start mbBody
Async.RunSynchronously (async {
let! completed =
let jobs = [|
for i = 1 to 10 do
async {
do! Async.Sleep 100
do! mb.PostAndAsyncReply(fun ch -> ch, i)
return i
}
|]
Async.Parallel(jobs)
printfn $"Completed {Seq.length completed} job(s)."
})
Btw. i changed the seq {} to an array, and additional removed the maxDegreeOfParallelism option. Otherwise the results seemed not to be very parallel in my tests. But you still can keep those if you want.
executing this program prints something like:
Work 10
Work 4
Work 9
Work 3
Work 8
Background.
I am trying to figure out MailboxProcessor. The idea is to use it as a some kind of state machine and pass arguments around between the states and then quit. Some parts are going to have async communication so I made a Sleep there.
It's a console application, making a Post does nothing because main thread quits and kills everything behind it. I am making a PostAndReply in main.
Also, I have tried without
let sleepWorkflow = async
, doesn't make any difference.
Questions.
(I am probably doing something wrong)
Go24 is not async. Changing RunSynchronously to StartImmediate makes no visible difference. The end should be somewhere below GetMe instead. At the same time Done is printed after Fetch. Isn't the control supposed t be returned to the main thread on sleep?
Go24, wait
go24 1, end
Fetch 1
Done
GetMe
...
Run time is terrible slow. Without delay in Fetch it's about 10s (stopwatch). I thought F# threads are lightweight and should use threadpool.
According to debugger it takes appr 1s to create every and it looks like real threads.
Also, changing to [1..100] will "pause" the program for 100s, according to ProcessExplorer 100 threads are created during that time and only then everything is printed. I would actually prefer fewer threads and slow increase.
Code.
Program.fs
[<EntryPoint>]
let main argv =
let a = Mailbox.MessageBasedCounter.DoGo24 1
let a = Mailbox.MessageBasedCounter.DoFetch 1
let b = Mailbox.MessageBasedCounter.GetMe
let task i = async {
//Mailbox.MessageBasedCounter.DoGo24 1
let a = Mailbox.MessageBasedCounter.DoFetch i
return a
}
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let x =
[1..10]
|> Seq.map task
|> Async.Parallel
|> Async.RunSynchronously
stopWatch.Stop()
printfn "%f" stopWatch.Elapsed.TotalMilliseconds
printfn "a: %A" a
printfn "b: %A" b
printfn "x: %A" x
0 // return an integer exit code
Mailbox.fs
module Mailbox
#nowarn "40"
type parserMsg =
| Go24 of int
| Done
| Fetch of int * AsyncReplyChannel<string>
| GetMe of AsyncReplyChannel<string>
type MessageBasedCounter () =
/// Create the agent
static let agent = MailboxProcessor.Start(fun inbox ->
// the message processing function
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Go24 n ->
let sleepWorkflow = async{
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone() // POST Done.
printfn "go24 %d, end" n
return! messageLoop()
}
Async.RunSynchronously sleepWorkflow
| Fetch (i, repl) ->
let sync = async{
printfn "Fetch %d" i
do! Async.Sleep 1000
repl.Reply( "Reply Fetch " + i.ToString() ) // Reply to the caller
return! messageLoop()
}
Async.RunSynchronously sync
| GetMe (repl) ->
let sync = async{
printfn "GetMe"
repl.Reply( "GetMe" ) // Reply to the caller
return! messageLoop()
}
Async.RunSynchronously sync
| Done ->
let sync = async{
printfn "Done"
return! messageLoop()
}
Async.RunSynchronously sync
}
// start the loop
messageLoop()
)
// public interface to hide the implementation
static member DoDone () = agent.Post( Done )
static member DoGo24 (i:int) = agent.Post( Go24(i) )
static member DoFetch (i:int) = agent.PostAndReply( fun reply -> Fetch(i, reply) )
static member GetMe = agent.PostAndReply( GetMe )
I'm not necessarily sure that this is the main problem, but the nested asyncs and Async.RunSynchrously in the agent code look suspicious.
You do not need to create a nested async - you can just call asynchronous operations in the body of the match clauses directly:
// the message processing function
let rec messageLoop() = async{
let! msg = inbox.Receive()
match msg with
| Go24 n ->
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone()
printfn "go24 %d, end" n
return! messageLoop()
| Fetch (i, repl) ->
(...)
Aside from that, it is important to understand that the agent has exactly one instance of the body computation running. So, if you block the body of the agent, all other operations will be queued.
If you want to start some task (like the synchronous operations) in the background and resume the agent immediately, you can use Async.Start inside the body (but be sure to call the main loop recursively in the main part of the body):
| Go24 n ->
// Create work item that will run in the background
let work = async {
printfn "Go24, wait"
do! Async.Sleep 4000
MessageBasedCounter.DoDone()
printfn "go24 %d, end" n }
// Queue the work in a thread pool to be processed
Async.Start(work)
// Continue the message loop, waiting for other messages
return! messageLoop()
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.
Experimenting some with F# async taught me that I can StartImmediate on the current running thread. This allows me, it seems, to run an async expression which can still pass out control, whenever getting inside of it to some async operation (e.g. do!), to the code outside of the async expression. Please see the simple example below:
open System.Threading
let workThenWait() = async {
printfn "async start"
do! Async.Sleep(1000)
printfn "async end"
}
let demo() =
workThenWait() |> Async.StartImmediate
printfn "main started"
// here I want to wait to the async expression in case it has passed control
printfn "main end"
demo()
The result we get is:
async start
main started
main end
async end
On the other hand, if I execute the same async expression (in this case workThenWait) using StartAsTask (inside demo), I can potentially wait on it at the end.
MY QUESTION is:
using the previous example using StartImmediate, can I run on the same thread, but ALSO wait at the end for the async expression in case some async operation (such as do!) is called and passes control forward?
I think You need Async.RunSynchronously (http://msdn.microsoft.com/en-us/library/ee370262.aspx)
update:
Ok, now I understand better what You want, and I was able to achieve this with Async.StartWithContinuations method.
Here's the code:
open System.Threading
let f() =
printfn "main thread: %A" Thread.CurrentThread.ManagedThreadId
let c1 =
async {
printfn "c1 async thread: %A" Thread.CurrentThread.ManagedThreadId
do! Async.Sleep(1000)
return "some result"
}
let continuation s =
printfn "continuation thread: %A" Thread.CurrentThread.ManagedThreadId
printfn "now the code You want after waiting and the result %s" s
Async.StartWithContinuations(
c1,
continuation,
(fun _ -> ()),
(fun _ -> ())
)
printfn "Code that runs during async computation"
Now this is definitely not very readable as the flow of the code is not obvious. I couldn't find any better solution.
You can do this with Hopac libary:
let workThenWait() = job {
printfn "async start"
do! Hopac.Timer.Global.sleep (TimeSpan.FromMilliseconds 1000.)
printfn "async end"
}
let demo() =
let promise = workThenWait() |> Promise.start |> run
printfn "main started"
// here I want to wait to the async expression in case it has passed control
let result = run promise
printfn "main end"
demo()
Hopac is both more performant and functional than async and is little known compared to how good it is. I highly recommend it.
I wonder, why MailboxProcessor's default strategy of handling exceptions is just silently ignore them. For example:
let counter =
MailboxProcessor.Start(fun inbox ->
let rec loop() =
async { printfn "waiting for data..."
let! data = inbox.Receive()
failwith "fail" // simulate throwing of an exception
printfn "Got: %d" data
return! loop()
}
loop ())
()
counter.Post(42)
counter.Post(43)
counter.Post(44)
Async.Sleep 1000 |> Async.RunSynchronously
and nothing happens. There is no fatal stop of the program execution, or message box with "An unhandled exception" arises. Nothing.
This situation becomes worse if someone uses PostAndReply method: a guaranteed deadlock as the result.
Any reasons for such behavior?
There is an Error event on the MailboxProcessor.
http://msdn.microsoft.com/en-us/library/ee340481
counter.Error.Add(fun e -> printfn "%A" e)
Of course, you can do something like Tomas' solution if you want to exert fine control yourself.
I think the reason why the MailboxProcessor in F# does not contain any mechanism for handling exceptions is that it is not clear what is the best way for doing that. For example, you may want to have a global event that is triggered when an unhandled exception happens, but you may want to rethrow the exception on the next call to Post or PostAndReply.
Both of the options can be implemented based on the standard MailboxProcessor, so it is possible to add the behaviour you want. For example, the following snippet shows HandlingMailbox that adds a global exception handler. It has the same interface as normal MailboxProcessor (I omitted some methods), but it adds OnError event that is triggered when an exception happens:
type HandlingMailbox<'T> private(f:HandlingMailbox<'T> -> Async<unit>) as self =
let event = Event<_>()
let inbox = new MailboxProcessor<_>(fun inbox -> async {
try
return! f self
with e ->
event.Trigger(e) })
member x.OnError = event.Publish
member x.Start() = inbox.Start()
member x.Receive() = inbox.Receive()
member x.Post(v:'T) = inbox.Post(v)
static member Start(f) =
let mbox = new HandlingMailbox<_>(f)
mbox.Start()
mbox
To use it, you would write the same code as what you wrote before, but you can now handle exceptions asynchronously:
let counter = HandlingMailbox<_>.Start(fun inbox -> async {
while true do
printfn "waiting for data..."
let! data = inbox.Receive()
failwith "fail" })
counter.OnError.Add(printfn "Exception: %A")
counter.Post(42)