Is there a way to identify CLR event instances in F#? - f#

When I'm working in F# Interactive, I often want to make changes to an event handler. Simply calling the Subscribe or Add or AddHandler functions on an event causes the old event to continue being called, which is rarely the intention.
One solution is to use the IDisposable that it returns, but that requires tracking the IDisposables in your own code, which is cumbersome for exploratory tasks.
I've tried making a Dictionary<IEvent,IDisposable> to call Dispose() when the same event is subscribed to again:
let events = Dictionary<obj, IDisposable>()
let subonce (e:IEvent<'h,'e>) (handler: 'e -> unit) =
if events.ContainsKey e then
events.[e].Dispose()
events.Remove e |> ignore
let d = e.Subscribe handler
events.Add (e,d) |> ignore
let w = Window()
w.Show()
//Running this line in FSI a second time onward should Dispose() the previous subscription
subonce w.MouseUp (fun e -> printfn "%A" <| e.GetPosition(w))
Unfortunately, as it turns out, F# generates a new IEvent instance, so naively using = or obj.Equals doesn't cut it.
> w.MouseUp;;
val it : IEvent<Input.MouseButtonEventHandler,Input.MouseButtonEventArgs> =
<published event> {addHandler = <fun:it#5-70>;
createHandler = <fun:it#5-72>;
removeHandler = <fun:it#5-71>;}
> w.MouseUp;;
val it : IEvent<Input.MouseButtonEventHandler,Input.MouseButtonEventArgs> =
<published event> {addHandler = <fun:it#6-74>; //note that these functions are of a different anonymous instance
createHandler = <fun:it#6-76>;
removeHandler = <fun:it#6-75>;}
Are there any properties or fields I can find within an IEvent that would identify it against other instances of the owner and against different events in that owner?

Not exactly an answer to the question, but I can't think of many other scenarios in which you'd need to identify an event instance, so maybe this is good enough:
type OneHandler<'e> = { mutable h : 'e -> unit }
let onehandler (e:IEvent<'h,'e>) =
let h = { h = fun _ -> () }
e.Subscribe(fun e -> h.h e) |> ignore
h
let w = Window()
let wmouseup = onehandler w.MouseUp
wmouseup.h <- (fun e -> printfn "%A" <| e.GetPosition(w))
This way, by evaluating just the assignment to wmouseup.h, we can change the event handler without having to restart the w or juggle IDisposable or Handler objects.

Related

Waiting for database rows to load using TableDependency and F#

I've got an F# project that loads some files to an outside subsystem and then uses Table Dependency to wait for some rows to be added to a table as a side effect.
Table Dependency is used in the type below to watch for the db changes. It fires a custom event when a row is added/changed/whatever:
// just using this type for the RecordChangedEvent to marshal the id we want into something
type AccountLoaded() =
let mutable someId = ""
// this property name matches the name of the table column (SomeId)
member this.SomeId
with get () = someId
and set (value) = someId <- value
// AccountLoadWatcher
type AccountLoadWatcher() =
let mutable _tableDependency = null
let event = new Event<_>()
interface IDisposable with
member this.Dispose() =
_tableDependency.Stop()
_tableDependency.Dispose()
// custom event we can send when an account is loaded
[<CLIEvent>]
member this.AccountLoaded = event.Publish
member private this.NotifyAccountLoaded(sender : RecordChangedEventArgs<AccountLoaded>) =
let accountLoaded = sender.Entity
event.Trigger(accountLoaded.SomeId)
member this.Watch() =
_tableDependency <- DbLib.getTableDependency "dbo" "AccountTable"
null
_tableDependency.OnChanged.Add(this.NotifyAccountLoaded)
_tableDependency.Start()
What I want to do is take the above object and just wait for all the rows with ids I care about to be loaded. What I have so far is:
let waitForRows(csvFileRows) =
let idsToWaitFor = parseUniqueIdsFromAllRows csvFileRows
let mutable collected = Set.empty
let isInSet id = Set.contains id idsToWaitFor
let notDone = not <| (Set.difference idsToWaitFor collected = Set.empty)
let accountLoadedHandler id =
collected <- collected.Add id
printfn "Id loaded %s, waiting for %A\n" id (Set.difference idsToWaitFor collected)
loadToSubsystem csvFileRows |> ignore
// wait for all the watcher events; filtering each event object for ids we care about
watcher.AccountLoaded
|> Observable.takeWhile (fun _ -> notDone)
|> Observable.filter (fun e -> isInSet e)
|> Observable.subscribe accountLoadedHandler
|> ignore
doMoreWork()
but that just continues to doMoreWork without waiting for all the events i need above.
Do I need to use a task or async? F# Agents?
Given that you are using Observable.takeWhile in your example, I'm assuming that you are using the FSharp.Control.Reactive wrapper to get access to the full range of reactive combinators.
Your approach has some good ideas, such as using takeWhile to wait until you collect all IDs, but the use of mutation is quite unfortunate - it might not even be safe to do this because of possible race conditions.
A nice alternative is to use one of the various scan function to collect a state as the events happen. You can use Observable.scanInit to start with an empty set and add all IDs; followed by Observable.takeWhile to keep accepting events until you have all the IDs you're waiting for. To actually wait (and block), you can use Observable.wait. Something like this:
let waitForRows(csvFileRows) =
let idsToWaitFor = parseUniqueIdsFromAllRows csvFileRows
let finalCollectedIDs =
watcher.AccountLoaded
|> Observable.scanInit Set.empty (fun collected id -> Set.add id collected)
|> Observable.takeWhile (fun collected -> not (Set.isSubset idsToWaitFor co llected))
|> Observable.wait
printfn "Completed. Final collected IDs are: %A" finalCollectedIDs

Is returning results from MailboxProcessor via Rx a good idea?

I am a little curious about the code example below and what people think.
The idea was to read from a NetworkStream (~20 msg/s) and instead of working in the main, pass things to MainboxProcessor to handle and get things back for bindings when done.
The usual way is to use PostAndReply, but I want to bind to ListView or other control in C#. Must do magic with LastN items and filtering anyway.
Plus, Rx has some error handling.
The example below observes numbers from 2..10 and returns "hello X". On 8 it stops like it was EOF. Made it to ToEnumerable because other thread finishes before otherwise, but it works with Subscribe as well.
What bothers me:
passing Subject(obj) around in recursion. I don't see any problems having around 3-4 of those. Good idea?
Lifetime of Subject.
open System
open System.Threading
open System.Reactive.Subjects
open System.Reactive.Linq // NuGet, take System.Reactive.Core also.
open System.Reactive.Concurrency
type SerializedLogger() =
let _letters = new Subject<string>()
// create the mailbox processor
let agent = MailboxProcessor.Start(fun inbox ->
// the message processing function
let rec messageLoop (letters:Subject<string>) = async{
// read a message
let! msg = inbox.Receive()
printfn "mailbox: %d in Thread: %d" msg Thread.CurrentThread.ManagedThreadId
do! Async.Sleep 100
// write it to the log
match msg with
| 8 -> letters.OnCompleted() // like EOF.
| x -> letters.OnNext(sprintf "hello %d" x)
// loop to top
return! messageLoop letters
}
// start the loop
messageLoop _letters
)
// public interface
member this.Log msg = agent.Post msg
member this.Getletters() = _letters.AsObservable()
/// Print line with prefix 1.
let myPrint1 x = printfn "onNext - %s, Thread: %d" x Thread.CurrentThread.ManagedThreadId
// Actions
let onNext = new Action<string>(myPrint1)
let onCompleted = new Action(fun _ -> printfn "Complete")
[<EntryPoint>]
let main argv =
async{
printfn "Main is on: %d" Thread.CurrentThread.ManagedThreadId
// test
let logger = SerializedLogger()
logger.Log 1 // ignored?
let xObs = logger
.Getletters() //.Where( fun x -> x <> "hello 5")
.SubscribeOn(Scheduler.CurrentThread)
.ObserveOn(Scheduler.CurrentThread)
.ToEnumerable() // this
//.Subscribe(onNext, onCompleted) // or with Dispose()
[2..10] |> Seq.iter (logger.Log)
xObs |> Seq.iter myPrint1
while true
do
printfn "waiting"
System.Threading.Thread.Sleep(1000)
return 0
} |> Async.RunSynchronously // return an integer exit code
I have done similar things, but using the plain F# Event type rather than Subject. It basically lets you create IObservable and trigger its subscribes - much like your use of more complex Subject. The event-based version would be:
type SerializedLogger() =
let letterProduced = new Event<string>()
let lettersEnded = new Event<unit>()
let agent = MailboxProcessor.Start(fun inbox ->
let rec messageLoop (letters:Subject<string>) = async {
// Some code omitted
match msg with
| 8 -> lettersEnded.Trigger()
| x -> letterProduced.Trigger(sprintf "hello %d" x)
// ...
member this.Log msg = agent.Post msg
member this.LetterProduced = letterProduced.Publish
member this.LettersEnded = lettersEnded.Publish
The important differences are:
Event cannot trigger OnCompleted, so I instead exposed two separate events. This is quite unfortunate! Given that Subject is very similar to events in all other aspects, this might be a good reason for using subject instead of plain event.
The nice aspect of using Event is that it is a standard F# type, so you do not need any external dependencies in the agent.
I noticed your comment noting that the first call to Log was ignored. That's because you subscribe to the event handler only after this call happens. I think you could use ReplaySubject variation on the Subject idea here - it replays all events when you subscribe to it, so the one that happened earlier would not be lost (but there is a cost to caching).
In summary, I think using Subject is probably a good idea - it is essentially the same pattern as using Event (which I think is quite standard way of exposing notifications from agents), but it lets you trigger OnCompleted. I would probably not use ReplaySubject, because of the caching cost - you just have to make sure to subscribe before triggering any events.

Rewriting simple C# nested class

What would be an elegant way to implement the functionality of this nested class in F#?
private class Aliaser {
private int _count;
internal Aliaser() { }
internal string GetNextAlias() {
return "t" + (_count++).ToString();
}
}
This was my first attempt, but it feels like there should be a sexy one-liner for this:
let aliases = (Seq.initInfinite (sprintf "t%d")).GetEnumerator()
let getNextAlias() =
aliases.MoveNext() |> ignore
aliases.Current
The usual way of writing is to create a function with local state captured in a closure:
let getNextAlias =
let count = ref 0
(fun () ->
count := !count + 1;
sprintf "t%d" (!count))
The type of getNextAlias is simply unit -> string and when you call it repeatedly, it returns strings "t1", "t2", ... This relies on mutable state, but the mutable state is hidden from the user.
Regarding whether you can do this without mutable state - the simple answer is NO, because when you call a purely functional function with the same parameter twice, it must return the same result. Thus, you'd have to write something with the following structure:
let alias, state1 = getNextAlias state0
printf "first alias %s" alias
let alias, state2 = getNextAlias state1
printf "second alias %s" alias
// ...
As you can see, you'd need to keep some state and maintain it through the whole code. In F#, the standard way of dealing with this is to use mutable state. In Haskell, you could use State monad, which allows you to hide the passing of the state. Using the implementation from this question, you could write something like:
let getNextAlias = state {
let! n = getState
do! setState (n + 1)
return sprintf "t%d" n }
let program =
state {
let! alias1 = getNextAlias()
let! alias2 = getNextAlias()
// ...
}
execute progam 0 // execute with initial state
This is quite similar to other computations such as lazy or seq, actually - computations in the state { .. } block have some state and you can execute them by providing initial value of the state. However, unless you have good reasons for requiring purely functional solution, I'd prefer the first version for practical F# programming.
Here is the quick and dirty translation
type Aliaser () =
let mutable _count = 0
member x.GetNextAlias() =
let value = _count.ToString()
_count <- _count + 1
"t" + value
A more functional approach without state is to use continuations.
let createAliaser callWithValue =
let rec inner count =
let value = "t" + (count.ToString())
callWithValue value (fun () -> inner (count + 1))
inner 1
This is a declaration which will call the function callWithValue with both the value and the function to execute to repeat with the next value.
And here's an example using it
let main () =
let inner value (next : unit -> unit )=
printfn "Value: %s" value
let input = System.Console.ReadLine()
if input <> "quit" then next()
createAliaser inner
main()
I would use Seq.unfold : (('a -> ('b * 'a) option) -> 'a -> seq<'b>) to generate the aliases.
Implemented as:
let alias =
Seq.unfold (fun count -> Some(sprintf "t%i" count, count+1)) 0

Need help regarding Async and fsi

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
)

How to check if an event is being handled in F#

What is the F# equivalent of the following C# code? Specifically, I need to check if an event is being handled.
protected virtual void OnClicked(ClickEventArgs e) {
if (this.Clicked != null) //how can I perform this check in F#
this.Clicked(this, e);
}
Okay, I think I figured this thing out. Taking a cue from Don Syme's blog, specifically the section "The Implementation of the IEvent Module."
Instead of the following:
let validationFailedEvent = new Event<DataValidationEventHandler, DataValidationEventArgs>()
I had to implement IEvent myself and create a variable to hold the invocation list:
let mutable listeners: Delegate = null
let validationFailedEvent = { new IEvent<DataValidationEventHandler, DataValidationEventArgs> with
member x.AddHandler(d) =
listeners <- Delegate.Combine(listeners, d)
member x.RemoveHandler(d) =
listeners <- Delegate.Remove(listeners, d)
member x.Subscribe(observer) =
let h = new Handler<_>(fun sender args -> observer.OnNext(args))
(x :?> IEvent<_,_>).AddHandler(h)
{ new System.IDisposable with
member x.Dispose() = (x :?> IEvent<_,_>).RemoveHandler(h) } }
Then, to check if there are listeners, and, if not, raise an exception:
member private x.fireValidationFailedEvent(e:DataValidationEventArgs) =
match listeners with
| null -> failwith "No listeners"
| d -> d.DynamicInvoke([| box x; box e |])
An alternative way to implement RequiresSubscriptionEvent is to build on top of the existing Event functionality (using composition) and just add a counter that counts the number of registered handlers and add a property HasListeners (or even publish the number of listeners if you wanted...)
This makes the code a bit easier to use and hopefuly also safer, because if you don't check whether it has any listneres, it will still work as the usual F# code. And if you want to perform the check, you can...
type RequiresSubscriptionEvent<_>() =
let evt = new Event<_>()
let mutable counter = 0
let published =
{ new IEvent<_> with
member x.AddHandler(h) =
evt.Publish.AddHandler(h)
counter <- counter + 1;
member x.RemoveHandler(h) =
evt.Publish.RemoveHandler(h)
counter <- counter - 1;
member x.Subscribe(s) =
let h = new Handler<_>(fun _ -> s.OnNext)
x.AddHandler(h)
{ new System.IDisposable with
member y.Dispose() = x.RemoveHandler(h) } }
member x.Trigger(v) = evt.Trigger(v)
member x.Publish = published
member x.HasListeners = counter > 0
Sample usage:
type Demo() =
let evt = new RequiresSubscriptionEvent<_>()
[<CLIEvent>]
member x.OnSomething = evt.Publish
member x.FooThatFiresSomething() =
if evt.HasListeners then
evt.Trigger("foo!")
else
printfn "No handlers!"
Even though this isn't a part of standard F# libraries, it shows the great advantage of F# first class events. If there is some missing functionality, you can simply implement it yourself!
Typically, you don't need to do that check in F# (the event infrastructure checks for you):
type T() =
let ev = new Event<_>()
[<CLIEvent>]
member x.Event = ev.Publish
member x.OnClicked() =
ev.Trigger()
I followed kvb's suggestion and put this logic in a class. I copied Event from the F# sources and added a Handled property, which checks if the Delegate is null. I tried adding to, then removing handlers from the event to make sure it gets set back to null, and indeed it does.
type EventEx<'Delegate,'Args when 'Delegate : delegate<'Args,unit> and 'Delegate :> System.Delegate >() =
let mutable multicast : System.Delegate = null
static let argTypes =
let instanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
let mi = typeof<'Delegate>.GetMethod("Invoke",instanceBindingFlags)
mi.GetParameters() |> (fun arr -> arr.[1..]) |> Array.map (fun p -> p.ParameterType)
member x.Handled = (multicast <> null)
member x.Trigger(sender:obj,args:'Args) =
match multicast with
| null -> ()
| d ->
if argTypes.Length = 1 then
d.DynamicInvoke([| sender; box args |]) |> ignore
else
d.DynamicInvoke(Array.append [| sender |] (Microsoft.FSharp.Reflection.FSharpValue.GetTupleFields(box args))) |> ignore
member x.Publish =
{ new IEvent<'Delegate,'Args> with
member x.AddHandler(d) =
multicast <- System.Delegate.Combine(multicast, d)
member x.RemoveHandler(d) =
multicast <- System.Delegate.Remove(multicast, d)
member e.Subscribe(observer) =
let h = new Handler<_>(fun sender args -> observer.OnNext(args))
(e :?> IEvent<_,_>).AddHandler(h)
{ new System.IDisposable with
member x.Dispose() = (e :?> IEvent<_,_>).RemoveHandler(h) } }
This article here http://geekswithblogs.net/Erik/archive/2008/05/22/122302.aspx says you do not need to check for null events in F#, though I don't know what his reference is.
This article http://blogs.msdn.com/dsyme/articles/FSharpCompositionalEvents.aspx by Don Symes goes into F# events in quite a bit of detail. It looks like events are not owned by the class in F#
From the above,
it is that events are now first-class
values in the F# langauge. Indeed,
events are not a separate notion at
all in the language design, rather,
events are just values of type
Microsoft.FSharp.Idioms.IEvent<_>, and
.NET events are effectively just
properties of this type.
And
One of the restrictions of C# is that
events can only exist as members
within classes. With the F# model,
new event values can be created just
as values as part of any expression.

Resources