I am trying to run a function to update a grid for a game of life function written with f# and everything has to be recursive with no mutables. I want to add a pause button to my form by running the Update function asyncronously however when I do this only one square is updated. However when I step through the program without async all of the squares are updated. Any ideas why?
let buttonGrid : Button list list = (Startup ar);;
//transform buttongrid to int grid
let rec bg2ig (bg:Button list list) =
let rec innerLoop (bl:Button list) =
match bl with
|[] -> []
|x::xs -> if (x.Name = "0") then 0::(innerLoop xs) else 1::(innerLoop xs)
match bg with
|[] -> []
|y::ys -> (innerLoop y)::(bg2ig ys)
let Update (bg:Button list list)=
let ar = (bg2ig bg)
let rec innerUpdate (bg:Button list list)=
let rec arrayLoop (bl:Button list) y =
match bl with
|[] -> 0
|x::xs ->
let X = (15-xs.Length)
let n = (neighbors X y ar)
if (ar.[X].[y] = 0) then (if n=3 then buttonGrid.[X].[y].Name<-"1") else (if (n=2||n=3)=false then buttonGrid.[X].[y].Name<-"0")
if buttonGrid.[15-xs.Length].[y].Name="0"
then buttonGrid.[15-xs.Length].[y].BackColor <- Color.White
else buttonGrid.[15-xs.Length].[y].BackColor <- Color.Black
arrayLoop xs y
match bg with
|[] -> []
|y::ys ->
ignore (arrayLoop y (15-ys.Length))
innerUpdate ys
innerUpdate bg
let Running = async {
let rec SubRun (x:int) =
ignore (Update buttonGrid)
if x = 1 then
SubRun 1
else
0
ignore (SubRun 1)
do! Async.Sleep(1000)
}
let RunAll() =
Running
|> Async.RunSynchronously
|> ignore
As mentioned in the comments, Async.RunSynchronously is a wrong function for this scenario. It starts the workflow on a background thread (which is wrong, because you want to access GUI elements) and then it blocks the calling thread until the background work is done (which is wrong because you do not want to block the GUI thread).
You need to use Async.StartImmediate which starts the work on the current thread (which will be the GUI thread) without blocking. When the first part of the workflow completes (before Sleep) the GUI thread is free to do other work. After Sleep the workflow will again continue on the GUI thread (this is done automatically thanks to StartImmediate) and so you can again access the GUI.
Aside, your SubRun function that does the actual looping needs to be asynchronous too - so I'd expect the main part of the loop to look something like this:
let Running = async {
let rec SubRun (x:int) =
// Perform update and then sleep before recursive call
ignore (Update buttonGrid)
do! Async.Sleep(1000)
if x = 1 then
return! SubRun 1
else
return 0 }
// Start the loop and asynchronously ignore the result
SubRun 1 |> Async.Ignore
let RunAll() =
// Start the computation immediately on the current threada
Running |> Async.StartImmediate
Tomas Petricek solved the initial issue I was having but in order to make things correctly I ended up solving it differently. I think my initial issue may have been stemming from updating the form incorrectly or not at all and thus it looked very wrong.
I ended up writing my async function like this
let rec async1(syncContext, form : System.Windows.Forms.Form, cancellationSource:CancellationTokenSource, (limit:int)) =
async {
do! Async.SwitchToContext(syncContext)
ignore (Update buttonGrid)
do! Async.SwitchToThreadPool()
do! Async.Sleep(300)
if limit > 1 then
ignore (Async.Start (async1(syncContext, form, cancellationSource, (limit-1)),cancellationSource.Token))
else if limit = -1 then
ignore (Async.Start (async1(syncContext, form, cancellationSource, limit),cancellationSource.Token))
}
and then I can call on it like this witha start and stop button
let b = new Button(Location=new Point(50,500), Text=("Run"), Width=100, Height=40)
let btnPause = new Button(Location=new Point(150, 500), Text="Stop", Width=100, Height=40, Enabled=false)
b.Click.Add(fun _ ->
let cancellationSource = new CancellationTokenSource()
b.Enabled <- false
btnPause.Enabled <- true
btnSave.Enabled <- false
btnLoad.Enabled <- false
btnStep.Enabled <- false
inputBox.Enabled <- false
btnPause.Click.Add(fun _ ->
b.Enabled <- true
btnPause.Enabled <- false
btnSave.Enabled <- true
btnLoad.Enabled <- true
btnStep.Enabled <- true
inputBox.Enabled <- true
cancellationSource.Cancel())
ignore (Async.Start (async1(syncContext, form, cancellationSource, (int inputBox.Text)),cancellationSource.Token))
ignore (inputBox.Text <- "0"))
I have also added a step button for stepping through the program and an input box where I can run the program endlessly until the cancel token is called or have it run through an n number of times and then stop
Related
I have many threads running the same recursive loop with different parameters.
Since the loop does download files from an AWS service and writes data to a database, I do some throttling with semaphores.
A simple version would be:
let rec doStuffAsync a b c =
async {
// wait before I can run
executionSemaphores.WaitOne() |> ignore
// do some stuff
// multiples paths out
if a then
...
executionSemaphores.Release() |> ignore
return! doStuffAsync a b c
elif b then
...
executionSemaphores.Release() |> ignore
return! doStuffAsync a b c
else
...
executionSemaphores.Release() |> ignore
return! doStuffAsync a b c
}
The issue here is that each exit branch has its own executionSmaphores.Release() call.
How could I restructure this to avoid the duplication? The best I can think about is to do a WaitOne before the first loop and Release then WaitOne right at the loop entrance.
Or, is there a better way?
Perhaps just refactor the common code into a function (called loop below), and then call that function at each exit point:
let executionSemaphores = new System.Threading.Semaphore(1, 1)
let rec doStuffAsync a b c =
let loop a b c =
async {
executionSemaphores.Release() |> ignore
if a || b || c then
return! doStuffAsync a b c
}
async {
// wait before I can run
executionSemaphores.WaitOne() |> ignore
// do some stuff
printfn "%A %A %A" a b c
// multiples paths out
if a then return! loop false b c
elif b then return! loop a false c
else return! loop a b false
}
doStuffAsync true true true
|> Async.RunSynchronously
Output is:
true true true
false true true
false false true
Note that I also made some changes to prevent the code from looping infinitely.
I prefer to use language support for IDisposable which works more reliable in case of exceptions.
First, we need an IDisposable which will release semaphore
type SemaphoreReleaser(semaphore: SemaphoreSlim) =
interface IDisposable with
member _.Dispose() = semaphore.Release()
// and extension method for convenience
type SemaphoreSlim with
member s.Enter() =
s.Wait()
SemaphoreReleaser(s)
Then it can be used with use _ = s.Enter() or using (s.Enter()) (fun _ -> ...)
Now let's look at code. From given sample, it looks like an infinite loop, so let's refactor it from recursion
let doStuffAsync a b c =
async {
while true do
use _ = executionSemaphores.Enter()
if a then
...
elif b then
...
else
...
}
Advantage is that you won't need to add call to Release, it will be automatically released even if exception occurred
Building on a snippet and answer, would it be possible to return results to the caller from the throttling queue? I've tried PostAndAsyncReply to receive reply on a channel but it's throwing an error if I pipe it with Enqueue. Here's the code.
Appreciate a F# core vanilla based solution around Queue or Mailbox design patterns.
Question
The question is to be able to call functions asynchronously based on the throttle (max 3 at a time), passing each item from the array, wait on the whole queue/array until it's finished while collecting all the results and then return the results to the caller. (Return the results to the caller is what's pending in here)
Callee Code
// Message type used by the agent - contains queueing
// of work items and notification of completion
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
/// Represents an agent that runs operations in concurrently. When the number
/// of concurrent operations exceeds 'limit', they are queued and processed later
let throttlingAgent limit =
MailboxProcessor.Start(fun inbox ->
async {
// The agent body is not executing in parallel,
// so we can safely use mutable queue & counter
let queue = System.Collections.Generic.Queue<Async<unit>>()
let running = ref 0
while true do
// Enqueue new work items or decrement the counter
// of how many tasks are running in the background
let! msg = inbox.Receive()
match msg with
| Completed -> decr running
| Enqueue w -> queue.Enqueue(w)
// If we have less than limit & there is some work to
// do, then start the work in the background!
while running.Value < limit && queue.Count > 0 do
let work = queue.Dequeue()
incr running
do! // When the work completes, send 'Completed'
// back to the agent to free a slot
async {
do! work
inbox.Post(Completed)
}
|> Async.StartChild
|> Async.Ignore
})
let requestDetailAsync (url: string) : Async<Result<string, Error>> =
async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? WebException as e ->
return Error {Code = "500"; Message = "Internal Server Error"; Status = HttpStatusCode.InternalServerError}
}
let requestMasterAsync() : Async<Result<System.Collections.Concurrent.ConcurrentBag<_>, Error>> =
async {
let urls = [|
"http://www.example.com/1";
"http://www.example.com/2";
"http://www.example.com/3";
"http://www.example.com/4";
"http://www.example.com/5";
"http://www.example.com/6";
"http://www.example.com/7";
"http://www.example.com/8";
"http://www.example.com/9";
"http://www.example.com/10";
|]
let results = System.Collections.Concurrent.ConcurrentBag<_>()
let agent = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> Enqueue
|> agent.Post
return Ok results
}
Caller Code
[<TestMethod>]
member this.TestRequestMasterAsync() =
match Entity.requestMasterAsync() |> Async.RunSynchronously with
| Ok result -> Console.WriteLine result
| Error error -> Console.WriteLine error
You could use Hopac.Streams for that. With such tool it is pretty trivial:
open Hopac
open Hopac.Stream
open System
let requestDetailAsync url = async {
Console.WriteLine ("Simulating request " + url)
try
do! Async.Sleep(1000) // let's say each request takes about a second
return Ok (url + ":body...")
with :? Exception as e ->
return Error e
}
let requestMasterAsync() : Stream<Result<string,exn>> =
[| "http://www.example.com/1"
"http://www.example.com/2"
"http://www.example.com/3"
"http://www.example.com/4"
"http://www.example.com/5"
"http://www.example.com/6"
"http://www.example.com/7"
"http://www.example.com/8"
"http://www.example.com/9"
"http://www.example.com/10" |]
|> Stream.ofSeq
|> Stream.mapPipelinedJob 3 (requestDetailAsync >> Job.fromAsync)
requestMasterAsync()
|> Stream.iterFun (printfn "%A")
|> queue //prints all results asynchronously
let allResults : Result<string,exn> list =
requestMasterAsync()
|> Stream.foldFun (fun results cur -> cur::results ) []
|> run //fold stream into list synchronously
ADDED
In case you want to use only vanilla FSharp.Core with mailboxes only try this:
type ThrottlingAgentMessage =
| Completed
| Enqueue of Async<unit>
let inline (>>=) x f = async.Bind(x, f)
let inline (>>-) x f = async.Bind(x, f >> async.Return)
let throttlingAgent limit =
let agent = MailboxProcessor.Start(fun inbox ->
let queue = System.Collections.Generic.Queue<Async<unit>>()
let startWork work =
work
>>- fun _ -> inbox.Post Completed
|> Async.StartChild |> Async.Ignore
let rec loop curWorkers =
inbox.Receive()
>>= function
| Completed when queue.Count > 0 ->
queue.Dequeue() |> startWork
>>= fun _ -> loop curWorkers
| Completed ->
loop (curWorkers - 1)
| Enqueue w when curWorkers < limit ->
w |> startWork
>>= fun _ -> loop (curWorkers + 1)
| Enqueue w ->
queue.Enqueue w
loop curWorkers
loop 0)
Enqueue >> agent.Post
It is pretty much the same logic, but slightly optimized to not use queue if there is free worker capacity (just start job and don't bother with queue/dequeue).
throttlingAgent is a function int -> Async<unit> -> unit
Because we don't want client to bother with our internal ThrottlingAgentMessage type.
use like this:
let throttler = throttlingAgent 3
for url in urls do
async {
let! res = requestDetailAsync url
results.Add res
}
|> throttler
My understanding is that what a workflow builder does is that it first "builds" the expression, and then subsequently executes it. So given that it first builds the expression, it should be able to count the number of let! statements before actually executing, right? And then it should be able to inject some logging that monitors progress? So is it possible to rework the async builder to automatically report progress and kill the printfn redundancy below?
async {
let! a = doSomething1 ()
printfn "%d/%d" 1 4
let! b = doSomething2 a
printfn "%d/%d" 2 4
let! c = doSomething3 b
printfn "%d/%d" 3 4
let! d = doSomething4 c
printfn "%d/%d" 4 4
return d
}
For loops, I guess just assume that the whole loop is a single step. Only top-level expressions count as steps here.
(Note if there's a way to do this without making a whole new workflow builder I guess that's fine too).
Note I've already gone through the path of a) making a "Task" iterator that just iterates tasks (but then you lose e.g. use handling, so it ended up being inadequate), and b) making a task counter, but that always had to be seeded and iterated manually so I'm hoping for something better.
As you tagged the question with the tag monads, I'll start by a theoretical nitpick. What you want to do would not actually be a monad. The problem is that monads require certain laws (see the Haskell page on monads). For F#, this means that the following two snippets should mean the same thing:
let computation1 =
async { let! x = m
return x }
let computation2 = m
This would not be the case for the extension you suggest, because computation1 has one more let! than computation2. Now, I do not think this is actually a problem - the logging could still be useful (even if it may give different results than you'd expect in some cases).
Adding this feature to F# async is not as easy - the problem is that you'd need to define your own type that replaces (or wraps) standard Async<'T>. The type needs to store the number of steps. If you can store the number of steps somewhere else (e.g. some mutable counter), then you just need to redefine the computation builder for async.
Here is a minimal example that does something like this - it just prints "step" for each let!:
// A custom computation builder that redirects all operations to
// the standard 'async' builder, but prints "step" in the Bind method
type LogAsyncBuilder() =
member x.Bind(c1, f) = async {
let! arg = c1
printfn "step!"
return! f arg }
member x.Return(v) = async.Return(v)
member x.ReturnFrom(c) = async.ReturnFrom(c)
// An instance of our custom computation builder
let logAsync = LogAsyncBuilder()
// Example that prints 'step' 4 times (for every Bind - let!)
let doSomething n = logAsync {
return n + 10 }
logAsync {
let! a = doSomething 0
let! b = doSomething a
let! c = doSomething b
let! d = doSomething c
return d }
|> Async.RunSynchronously
You could use a tuple ('a, int, int) to track the current result, the total number of steps and the number executed so far. Then you could write a function to take the current state, and the next async function to execute e.g.
//create the initial state
let startCount steps = ((), 0, steps)
let withCount af (a, c, steps) = async {
let nc = c + 1
let! res = af a
do printfn "%d %d" nc steps
return (res, nc, steps)
}
withCount takes a function which returns the next async operation, and the current state. It creates the next workflow, increments the number of executed steps and prints the status before returning the new state.
You can then use it like:
async {
let init = startCount 4
let! t = withCount doSomething init
let! t2 = withCount doSomething2 t
let! (r, _, _) = withCount doSomething3 t2
return r
}
I am new to functional programming in general and started learning F# recently. I wanted to use an async workflow returning Async<'U option> to pick an item in a Sequence. I find a nice Seq.pick function, but I am not sure how I could use that with an async workflow.
If that is not possible, is there another alternative to using an imperative style program to pick the item from the list. The following is a modified variation of my program. Any feedback is highly appreciated.
let run = async {
while not stopped do
use! resource = acquireResourceLockAsync
let! items = fetchItemsAsync 5
let! item = Seq.pick returnIfLocked items
let! status = performTaskAsync item
do! updateStatusAsync status
do! Async.Sleep 1000
}
Thanks in anticipation.
EDIT: Updated my question based on the answer by jpalmer. I noticed both Seq.filter and Seq.pick earlier and decided that Seq.pick will meet my need better, as I need the first item that I am able to lock. However, I forgot to change the return value of my function - instead of returning true, it should return Some(item). Now with that update, is there an elegant way to approach this without 1) blocking a thread to convert Async<'U option> to 'U and 2) resorting to an imperative style looping?
I am unclear exactly what you are trying to do. If you want to convert from Async<'T> to 'T non-blocking, then you want to use let! in an async workflow. So the seq-like logic probably needs to be written as its own loop, as suggested below. If that doesn't help, then perhaps share more code, especially the intended types of items/item/returnIfLocked, as I'm unclear what's async in your example.
let asyncPick f (s:seq<_>) =
async {
use e = s.GetEnumerator()
let r = ref None
while Option.isNone(!r) && e.MoveNext() do
let! x = f e.Current
r := x
match !r with
| Some z -> return z
| None -> return failwith "no matching item found"
}
let chooser ax =
async {
let! x = ax
if x%3 = 0 then
return Some x
else
return None
}
let s = seq { for i in 1..10 do yield async { return i } }
let main() =
async {
let! firstChosen = s |> asyncPick chooser
return firstChosen
}
|> Async.RunSynchronously
|> printfn "%d"
main()
It is important to look at the signature of the function you are using,
Seq.pick expects a function which returns option<'t>, you want to use Seq.Filter which takes a function which returns a bool.
You will still have another problem though in that you have Async<bool> - you will need to convert that to a normal bool, but you could do this inside your 'Seq.Filter' function
I'd like to write some code that runs a sequence of F# scripts (.fsx). The thing is that I could have literally hundreds of scripts and if I do that:
let shellExecute program args =
let startInfo = new ProcessStartInfo()
do startInfo.FileName <- program
do startInfo.Arguments <- args
do startInfo.UseShellExecute <- true
do startInfo.WindowStyle <- ProcessWindowStyle.Hidden
//do printfn "%s" startInfo.Arguments
let proc = Process.Start(startInfo)
()
scripts
|> Seq.iter (shellExecute "fsi")
it could stress too much my 2GB system. Anyway, I'd like to run scripts by batch of n, which seems also a good exercise for learning Async (I guess it's the way to go).
I have started to write some code for that but unfortunately it doesn't work:
open System.Diagnostics
let p = shellExecute "fsi" #"C:\Users\Stringer\foo.fsx"
async {
let! exit = Async.AwaitEvent p.Exited
do printfn "process has exited"
}
|> Async.StartImmediate
foo.fsx is just a hello world script.
What would be the most idiomatic way of solving this problem?
I'd like also to figure out if it's doable to retrieve a return code for each executing script and if not, find another way. Thanks!
EDIT:
Thanks a lot for your insights and links! I've learned a lot.
I just want to add some code for running batchs in parallel using Async.Parallel as Tomas suggested it. Please comment if there is a better implementation for my cut function.
module Seq =
/// Returns a sequence of sequences of N elements from the source sequence.
/// If the length of the source sequence is not a multiple
/// of N, last element of the returned sequence will have a length
/// included between 1 and N-1.
let cut (count : int) (source : seq<´T>) =
let rec aux s length = seq {
if (length < count) then yield s
else
yield Seq.take count s
if (length <> count) then
yield! aux (Seq.skip count s) (length - count)
}
aux source (Seq.length source)
let batchCount = 2
let filesPerBatch =
let q = (scripts.Length / batchCount)
q + if scripts.Length % batchCount = 0 then 0 else 1
let batchs =
scripts
|> Seq.cut filesPerBatch
|> Seq.map Seq.toList
|> Seq.map loop
Async.RunSynchronously (Async.Parallel batchs) |> ignore
EDIT2:
So I had some troubles to get Tomas's guard code working. I guess the f function had to be called in AddHandler method, otherwise we loose the event for ever... Here's the code:
module Event =
let guard f (e:IEvent<´Del, ´Args>) =
let e = Event.map id e
{ new IEvent<´Args> with
member this.AddHandler(d) = e.AddHandler(d); f() //must call f here!
member this.RemoveHandler(d) = e.RemoveHandler(d); f()
member this.Subscribe(observer) =
let rm = e.Subscribe(observer) in f(); rm }
The interesting thing (as mentioned by Tomas) is that it looks like the Exited event is stored somewhere when the process terminates, even though the process has not started with EnableRaisingEvents set to true.
When this property is finally set to true, the event is fired up.
Since I'm not sure that this is the official specification (and also a bit paranoid), I found another solution that consists in starting the process in the guard function, so we ensure that the code will work on whichever situation:
let createStartInfo program args =
new ProcessStartInfo
(FileName = program, Arguments = args, UseShellExecute = false,
WindowStyle = ProcessWindowStyle.Normal,
RedirectStandardOutput = true)
let createProcess info =
let p = new Process()
do p.StartInfo <- info
do p.EnableRaisingEvents <- true
p
let rec loop scripts = async {
match scripts with
| [] -> printfn "FINISHED"
| script::scripts ->
let args = sprintf "\"%s\"" script
let p = createStartInfo "notepad" args |> createProcess
let! exit =
p.Exited
|> Event.guard (fun () -> p.Start() |> ignore)
|> Async.AwaitEvent
let output = p.StandardOutput.ReadToEnd()
do printfn "\nPROCESSED: %s, CODE: %d, OUTPUT: %A"script p.ExitCode output
return! loop scripts
}
Notice I've replaced fsi.exe by notepad.exe so I can replay different scenarios step by step in the debugger and control explicitly the exit of the process myself.
I did some experiments and here is one way to deal with the problem discussed in the comments below my post and in the answer from Joel (which I think doesn't work currently, but could be fixed).
I think the specification of Process is that it can trigger the Exited event after we set the EnableRaisingEvents property to true (and will trigger the event even if the process has already completed before we set the property). To handle this case correctly, we need to enable raising of events after we attach handler to the Exited event.
This is a problme, because if we use AwaitEvent it will block the workflow until the event fires. We cannot do anything after calling AwaitEvent from the workflow (and if we set the property before calling AwaitEvent, then we get a race....). Vladimir's approach is correct, but I think there is a simpler way to deal with this.
I'll create a function Event.guard taking an event and returning an event, which allows us to specify some function that will be executed after a handler is attached to the event. This means that if we do some operation (which in turn triggers the event) inside this function, the event will be handled.
To use it for the problem discussed here, we need to change my original solution as follows. Firstly, the shellExecute function must not set the EnableRaisingEvents property (otherwise, we could lose the event!). Secondly, the waiting code should look like this:
let rec loop scripts = async {
match scripts with
| [] -> printf "FINISHED"
| script::scripts ->
let p = shellExecute fsi script
let! exit =
p.Exited
|> Event.guard (fun () -> p.EnableRaisingEvents <- true)
|> Async.AwaitEvent
let output = p.StandardOutput.ReadToEnd()
return! loop scripts }
Note the use of the Event.guard function. Roughly, it says that after the workflow attaches handler to the p.Exited event, the provided lambda function will run (and will enable raising of events). However, we already attached the handler to the event, so if this causes the event immediately, we're fine!
The implementation (for both Event and Observable) looks like this:
module Event =
let guard f (e:IEvent<'Del, 'Args>) =
let e = Event.map id e
{ new IEvent<'Args> with
member x.AddHandler(d) = e.AddHandler(d)
member x.RemoveHandler(d) = e.RemoveHandler(d); f()
member x.Subscribe(observer) =
let rm = e.Subscribe(observer) in f(); rm }
module Observable =
let guard f (e:IObservable<'Args>) =
{ new IObservable<'Args> with
member x.Subscribe(observer) =
let rm = e.Subscribe(observer) in f(); rm }
Nice thing is that this code is very straightforward.
Your approach looks great to me, I really like the idea of embedding process execution into asynchronous workflows using AwaitEvent!
The likely reason why it didn't work is that you need to set EnableRisingEvents property of the Process to true if you want it to ever trigger the Exited event (don't ask my why you have to do that, it sounds pretty silly to me!) Anyway, I did a couple of other changes to your code when testing it, so here is a version that worked for me:
open System
open System.Diagnostics
let shellExecute program args =
// Configure process to redirect output (so that we can read it)
let startInfo =
new ProcessStartInfo
(FileName = program, Arguments = args, UseShellExecute = false,
WindowStyle = ProcessWindowStyle.Hidden,
RedirectStandardOutput = true)
// Start the process
// Note: We must enable rising events explicitly here!
Process.Start(startInfo, EnableRaisingEvents = true)
Most importantly, the code now sets EnableRaisingEvents to true. I also changed the code to use a syntax where you specify properties of an object when constructing it (to make the code a bit more succinct) and I changed a few properties, so that I can read the output (RedirectStandardOutput).
Now, we can use the AwaitEvent method to wait until a process completes. I'll assume that fsi contains the path to fsi.exe and that scripts is a list of FSX scripts. If you want to run them sequentially, you could use a loop implemented using recursion:
let rec loop scripts = async {
match scripts with
| [] -> printf "FINISHED"
| script::scripts ->
// Start the proces in background
let p = shellExecute fsi script
// Wait until the process completes
let! exit = Async.AwaitEvent p.Exited
// Read the output produced by the process, the exit code
// is available in the `ExitCode` property of `Process`
let output = p.StandardOutput.ReadToEnd()
printfn "\nPROCESSED: %s, CODE: %d\n%A" script p.ExitCode output
// Process the rest of the scripts
return! loop scripts }
// This starts the workflow on background thread, so that we can
// do other things in the meantime. You need to add `ReadLine`, so that
// the console application doesn't quit immedeiately
loop scripts |> Async.Start
Console.ReadLine() |> ignore
Of course, you could also run the processes in parallel (or for example run 2 groups of them in parallel etc.) To do that you would use Async.Parallel (in the usual way).
Anyway, this is a really nice example of using asynchronous workflows in an area where I haven't seen them used so far. Very interesting :-)
In response to Tomas's answer, would this be a workable solution to the race condition involved in starting the process, and then subscribing to its Exited event?
type Process with
static member AsyncStart psi =
let proc = new Process(StartInfo = psi, EnableRaisingEvents = true)
let asyncExit = Async.AwaitEvent proc.Exited
async {
proc.Start() |> ignore
let! args = asyncExit
return proc
}
Unless I'm mistaken, this would subscribe to the event prior to starting the process, and package it all up as an Async<Process> result.
This would allow you to rewrite the rest of the code like this:
let shellExecute program args =
// Configure process to redirect output (so that we can read it)
let startInfo =
new ProcessStartInfo(FileName = program, Arguments = args,
UseShellExecute = false,
WindowStyle = ProcessWindowStyle.Hidden,
RedirectStandardOutput = true)
// Start the process
Process.AsyncStart(startInfo)
let fsi = "PATH TO FSI.EXE"
let rec loop scripts = async {
match scripts with
| [] -> printf "FINISHED"
| script::scripts ->
// Start the proces in background
use! p = shellExecute fsi script
// Read the output produced by the process, the exit code
// is available in the `ExitCode` property of `Process`
let output = p.StandardOutput.ReadToEnd()
printfn "\nPROCESSED: %s, CODE: %d\n%A" script p.ExitCode output
// Process the rest of the scripts
return! loop scripts
}
If that does the job, it's certainly a lot less code to worry about than Vladimir's Async.GetSubject.
What about a mailboxprocessor?
It is possible to simplify version of Subject from blogpost. instead of returning imitation of event, getSubject can return workflow.
Result workflow itself is state machine with two states
1. Event wasn't triggered yet: all pending listeners should be registered
2. Value is already set, listener is served immediately
In code it will appear like this:
type SubjectState<'T> = Listen of ('T -> unit) list | Value of 'T
getSubject implementation is trivial
let getSubject (e : IEvent<_, _>) =
let state = ref (Listen [])
let switchState v =
let listeners =
lock state (fun () ->
match !state with
| Listen ls ->
state := Value v
ls
| _ -> failwith "Value is set twice"
)
for l in listeners do l v
Async.StartWithContinuations(
Async.AwaitEvent e,
switchState,
ignore,
ignore
)
Async.FromContinuations(fun (cont, _, _) ->
let ok, v = lock state (fun () ->
match !state with
| Listen ls ->
state := Listen (cont::ls)
false, Unchecked.defaultof<_>
| Value v ->
true, v
)
if ok then cont v
)