I'm trying to filter out further upstream items based on a downstream condition. mapProcess essentially starts a Process (script or exe). The process can take some time to complete and I want to ignore any further up stream items until its done. createProcess also returns an Observable of StdOut. We switch into the IObservable created by createProcess and map arg to the StdOut.
EXAMPLE:
let mapProcess obs =
obs
|> Observable.map (fun arg -> createProcess arg)
|> Observable.switch
WHAT I'VE TRIED: This works but no entirely happy with the mutable here.
let mapProcess obs =
let mutable processNotRunning = true
obs
|> Observable.filter (fun _ -> processNotRunning)
|> Observable.map (fun arg -> processNotRunning <- false
createProcess arg)
|> Observable.switch
|> Observable.iter (fun _ -> processNotRunning <- true)
|> Observable.finallyDo (fun _ -> processNotRunning <- true)
I think what I may need is some sort of "switchIfSeen" Observable function that will only switch if the currently subscribed observable has produced an item or is finished. Am I perhaps missing an easier way by just combining some existing RX functions?
[...] only switch if the currently subscribed observable has produced an
item or is finished
A way to ignore values is to convert the hot observable into a cold observable - so it can push out items regardless of who's listening. Then, you only listen when you need to.
var map = argn.Select(CreateProcess).Publish().RefCount();
map.SelectMany(o => o) //flatmap
.Take(1)
.Repeat()
.Subscribe(d => Console.WriteLine($"Did task which took {d * 100}msecs" ));
Test:
(CreateProcess is just a timer which creates a fixed delay of x100 milliseconds.)
private static void Main(string[] args)
{
var argn = Observable.Interval(TimeSpan.FromMilliseconds(100)).Publish().RefCount();
argn.Subscribe(Console.WriteLine);
var map = argn.Select(CreateProcess).Publish().RefCount();
map.SelectMany(o => o)
.Take(1)
.Repeat()
.Subscribe(d => Console.WriteLine($"Did task which took {d * 100}msecs" ));
Console.ReadKey();
}
static IObservable<long> CreateProcess(long i) => Observable.Timer(TimeSpan.FromMilliseconds(i * 100)).Select(_ => i);
Output:
0
Did task which took 0msecs
1
2
Did task which took 100msecs
3
4
5
Did task which took 300msecs
6
7
8
9
10
11
Did task which took 600msecs
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
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()
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 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
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
)