OnceAsync: run f# async function exactly once - asynchronous

Question

I'm trying to write a function (OnceAsync f) that ensures that an async function is run only once on a server (i.e. a multi-threaded environment). I thought it would be easy, but it became complicated quickly (locks, busy waits!!)
This is my solution, but I think it's over-engineered; there must be a better way. This should work in FSI:
let locked_counter init =
let c = ref init
fun x -> lock c <| fun () ->
c := !c + x
!c
let wait_until finished = async {
while not(finished()) do
do! Async.Sleep(1000)
}
let OnceAsync f =
// - ensure that the async function, f, is only called once
// - this function always returns the value, f()
let mutable res = None
let lock_inc = locked_counter 0
async {
let count = lock_inc 1
match res, count with
| None, 1 -> // 1st run
let! r = f
res <- Some r
| None, _ -> // nth run, wait for 1st run to finish
do! wait_until (fun() -> res.IsSome)
| _ -> () // 1st run done, return result
return res.Value
}
You can use this code to test if OnceAsync is correct:
let test() =
let mutable count = 0
let initUser id = async {
do! Async.Sleep 1000 // simulate work
count <- count + 1
return count
}
//let fmem1 = (initUser "1234")
let fmem1 = OnceAsync (initUser "1234")
async {
let ps = Seq.init 20 (fun i -> fmem1)
let! rs = ps |> Async.Parallel
printfn "rs = %A" rs // outputs: [|1; 1; 1; 1; 1; ....; 1|]
}
test() |> Async.Start

Answer 1

If it fits, the simplest approach overall would be to use Async.StartChild. Unlike your solution it causes the function to run even if the result is never actually used though, e.g. in the Seq.init 0 case.
//let fmem1 = OnceAsync (initUser "1234")
async {
let! fmem1 = Async.StartChild (initUser "1234")
let ps = Seq.init 20 (fun i -> fmem1)
let! rs = ps |> Async.Parallel
printfn "rs = %A" rs // outputs: [|1; 1; 1; 1; 1; ....; 1|]
} |> Async.RunSynchronously
The simplest approach most similar to yours would be to use a TaskCompletionSource as follows:
let OnceAsync f =
let count = ref 0
let tcs = TaskCompletionSource<_>()
async {
if Interlocked.Increment(count) = 1 then
let! r = f
tcs.SetResult r
return! Async.AwaitTask tcs.Task
}
A more functional approach would use a MailboxProcessor and have it cache the result after the first run, and respond with it to all subsequent requests.
let OnceAsync f =
let handler (agent: MailboxProcessor<AsyncReplyChannel<_>>) =
let rec run resultOpt =
async {
let! chan = agent.Receive()
let! result =
match resultOpt with
| None -> f
| Some result -> async.Return result
chan.Reply result
return! run (Some result)
}
run None
let mbp = MailboxProcessor.Start handler
async { return! mbp.PostAndAsyncReply id }