0 people like it.

Global Events

The following is a simplistic implementation of global events, which is the precise dual of the dependency injection implementation found in http://fssnip.net/dg. This is just a proof of concept, unwise to use in real life.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
type Mode = Once | Always

type private ActionContainer<'T> () =
    // this implementation does not account for thread safety
    // a good way to go would be to wrap the container map
    // in an atom structure like the one in http://fssnip.net/bw
    static let container : Map<string option, ('T -> unit) list> ref = ref Map.empty

    static let morph mode (f : 'T -> unit) =
        match mode with
        | Once ->
            let untriggered = ref true
            fun t -> if !untriggered then f t ; untriggered := false
        | Always -> f

    static let getActions param = defaultArg ((!container).TryFind param) []

    static member Subscribe (mode, action : 'T -> unit, param) =
        container := (!container).Add(param, morph mode action :: getActions param)

    static member Trigger (input, param) =
        getActions param
        |> Seq.map (fun action -> async { do action input })
        |> Async.Parallel
        |> Async.Ignore
        |> Async.Start            


type GlobalEvent =
    static member Subscribe<'T> (mode, action, ?param) = ActionContainer<'T>.Subscribe(mode, action, param)
    static member Trigger<'T> (input, ?param) = ActionContainer<'T>.Trigger (input, param)


// example
        
GlobalEvent.Subscribe (Always, printfn "%d")
GlobalEvent.Subscribe (Always, printfn "other %d", "other")
GlobalEvent.Subscribe (Once, (fun i -> printfn "other %d" <| i + 1), "other")

GlobalEvent.Trigger (2, "other")
union case Mode.Once: Mode
union case Mode.Always: Mode
Multiple items
type private ActionContainer<'T> =
  new : unit -> ActionContainer<'T>
  static member Subscribe : mode:Mode * action:('T -> unit) * param:string option -> unit
  static member Trigger : input:'T * param:string option -> unit

Full name: Script.ActionContainer<_>

--------------------
private new : unit -> ActionContainer<'T>
val container : Map<string option,('T -> unit) list> ref
Multiple items
module Map

from Microsoft.FSharp.Collections

--------------------
type Map<'Key,'Value (requires comparison)> =
  interface IEnumerable
  interface IComparable
  interface IEnumerable<KeyValuePair<'Key,'Value>>
  interface ICollection<KeyValuePair<'Key,'Value>>
  interface IDictionary<'Key,'Value>
  new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
  member Add : key:'Key * value:'Value -> Map<'Key,'Value>
  member ContainsKey : key:'Key -> bool
  override Equals : obj -> bool
  member Remove : key:'Key -> Map<'Key,'Value>
  ...

Full name: Microsoft.FSharp.Collections.Map<_,_>

--------------------
new : elements:seq<'Key * 'Value> -> Map<'Key,'Value>
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
Multiple items
val ref : value:'T -> 'T ref

Full name: Microsoft.FSharp.Core.Operators.ref

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
val empty<'Key,'T (requires comparison)> : Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.empty
val morph : (Mode -> ('T -> unit) -> 'T -> unit)
val mode : Mode
val f : ('T -> unit)
val untriggered : bool ref
val t : 'T
val getActions : (string option -> ('T -> unit) list)
val param : string option
val defaultArg : arg:'T option -> defaultValue:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.defaultArg
static member private ActionContainer.Subscribe : mode:Mode * action:('T -> unit) * param:string option -> unit

Full name: Script.ActionContainer`1.Subscribe
val action : ('T -> unit)
static member private ActionContainer.Trigger : input:'T * param:string option -> unit

Full name: Script.ActionContainer`1.Trigger
val input : 'T
module Seq

from Microsoft.FSharp.Collections
val map : mapping:('T -> 'U) -> source:seq<'T> -> seq<'U>

Full name: Microsoft.FSharp.Collections.Seq.map
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member Async.Ignore : computation:Async<'T> -> Async<unit>
static member Async.Start : computation:Async<unit> * ?cancellationToken:System.Threading.CancellationToken -> unit
type GlobalEvent =
  static member Subscribe : mode:Mode * action:('T -> unit) * ?param:string -> unit
  static member Trigger : input:'T * ?param:string -> unit

Full name: Script.GlobalEvent
static member GlobalEvent.Subscribe : mode:Mode * action:('T -> unit) * ?param:string -> unit

Full name: Script.GlobalEvent.Subscribe
static member GlobalEvent.Trigger : input:'T * ?param:string -> unit

Full name: Script.GlobalEvent.Trigger
static member GlobalEvent.Subscribe : mode:Mode * action:('T -> unit) * ?param:string -> unit
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val i : int
static member GlobalEvent.Trigger : input:'T * ?param:string -> unit

More information

Link:http://fssnip.net/dh
Posted:11 years ago
Author:Eirik Tsarpalis
Tags: events , duality