Following code is trying to do some work and retries if there is an error. There is also a callback on error which is calling a function that logs an error to the console.
When executed, error is logged to console only once and when the program is paused, the main thread is blocked in retryErrorForever
and a worker thread is blocked while getting a log
.
But why?
module Program
type MyLogger(loggerName: string) =
member __.Warn fmt =
Printf.kprintf (printfn "%s: %s" loggerName) fmt
let log = MyLogger("Logger")
let retryErrorForever errorCallback retryTimeout work =
let rec loop () = async {
let! result = work
match result with
| Error e ->
errorCallback e
do! Async.Sleep retryTimeout
return! loop()
| Ok x -> return Ok x
}
loop ()
let retryWorkUntilOk logError timeout (work: unit -> Result<string, string>) =
let workflow = async {
return work ()
}
let result =
retryErrorForever logError timeout workflow
|> Async.RunSynchronously
match result with
| Ok x -> x
| Error e -> failwith <| sprintf "Cannot doWork: %s" e
let logError error =
log.Warn "%s" error
let doWork work =
retryWorkUntilOk logError 1000 work
let errorOnly () : Result<string, string> =
Error "You have no power here"
let result = doWork errorOnly
[<EntryPoint>]
let main _ =
printfn "%A" result
0
When run in interactive, this program does exactly what it's supposed to do: prints "You have no power here" every second forever.
But if you're compiling it and running the executable, there is one problem: the line let result = ...
is evaluated on assembly initialization, before main
is even run, and the whole program content is executed during that time. However, assembly initialization is supposed to be synchronous. It can kick off async tasks, but they will not be completed until the static initialization is done - and the way your program is written, static initialization is waiting for those async tasks to complete. So you get a deadlock.
To fix this, just make the whole thing run from main
, not during static initialization. This can be done by making result
a function and then calling it from main
:
let result() = doWork errorOnly
[<EntryPoint>]
let main _ =
printfn "%A" <| result()
0