0 people like it.

Deferrable event

An event that can defer publication of certain values until a later time, or drop them entirely.

  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: 
 41: 
 42: 
 43: 
 44: 
 45: 
 46: 
 47: 
 48: 
 49: 
 50: 
 51: 
 52: 
 53: 
 54: 
 55: 
 56: 
 57: 
 58: 
 59: 
 60: 
 61: 
 62: 
 63: 
 64: 
 65: 
 66: 
 67: 
 68: 
 69: 
 70: 
 71: 
 72: 
 73: 
 74: 
 75: 
 76: 
 77: 
 78: 
 79: 
 80: 
 81: 
 82: 
 83: 
 84: 
 85: 
 86: 
 87: 
 88: 
 89: 
 90: 
 91: 
 92: 
 93: 
 94: 
 95: 
 96: 
 97: 
 98: 
 99: 
100: 
101: 
102: 
103: 
104: 
105: 
106: 
107: 
108: 
109: 
110: 
111: 
112: 
113: 
114: 
115: 
116: 
open System

/// An event that can defer publication of certain values until a later time,
/// or drop them entirely.
type DeferrableEvent<'a>() =

  let locker = obj()
  let event = Event<'a>()

  /// The deferred predicates keyed by deferral ID
  let mutable deferPredicates : Map<Guid, 'a -> bool> = Map.empty

  /// The deferred arguments with the list the deferral IDs that caused them to be deferred
  let mutable deferredArgs : ('a * Set<Guid>) list = []

  /// Defers publication of values for which the predicate returns true.
  /// The deferral ends when the returned object is disposed. When the deferral
  /// ends, all deferred values that are no longer deferred will be transformed
  /// and then triggered. Note that a call to Defer will only affect later calls
  /// to Trigger; any values that are already deferred and match the specified
  /// predicate will not be affected by this call.
  member __.Defer (predicate: 'a -> bool, transformDeferred: 'a list -> 'a list) =
    lock locker (fun () ->
      let deferralId = Guid.NewGuid ()
      deferPredicates <- deferPredicates.Add (deferralId, predicate)
      { new IDisposable with
          member __.Dispose () =
            lock locker (fun () ->
              // Remove the deferral predicate
              deferPredicates <- deferPredicates.Remove deferralId

              // Remove the deferral ID from the args that have been deferred from itS
              deferredArgs <-
                deferredArgs
                |> List.map (fun (arg, defIds) -> arg, defIds.Remove deferralId)

              // Remove arguments that are no longer deferred and trigger them
              let noLongerDeferred, stillDeferred =
                deferredArgs |> List.partition (snd >> Set.isEmpty)
              deferredArgs <- stillDeferred
              noLongerDeferred
              |> List.map fst
              |> transformDeferred
              |> List.iter event.Trigger
            )
      }
    )

  /// Shortcut for this.Defer(predicate, id)
  member this.Defer predicate =
    this.Defer (predicate, id)

  /// Like Defer, but values are dropped instead of deferred. Shortcut for
  /// Defer(predicate, fun _ -> []). Se Defer for more information.
  member this.Drop predicate =
    this.Defer (predicate, fun _ -> [])

  /// Publishes an observation as a first class value.
  member __.Publish = event.Publish

  /// Triggers the observation using the given parameter. If the value is deferred,
  /// it will only be deferred by the deferrals that are currently active when Trigger
  /// is called. Subsequent calls to Defer with predicates that match the value
  /// will not affect the deferral of this particular value (but future identical
  /// values will be affected).
  member __.Trigger arg =
    lock locker (fun () ->
      let defIds =
        deferPredicates
        |> Map.filter (fun _ predicate -> predicate arg)
        |> Map.toSeq
        |> Seq.map fst
        |> Set.ofSeq
      if defIds.IsEmpty then event.Trigger arg
      else deferredArgs <- deferredArgs @ [arg, defIds]
    )

///////////
// USAGE //
///////////

let e = DeferrableEvent<int>()
e.Publish.Add (printfn "Triggered: %i")

e.Trigger 1  // "Triggered: 1"
let d = e.Defer ((fun i -> i > 5), List.distinct)  // Normally you'd use the "use" keyword
e.Trigger 2  // "Triggered: 2"
e.Trigger 6  // (no output)
e.Trigger 7  // (no output)
e.Trigger 6  // (no output)
e.Trigger 10  // (no output)

d.Dispose()
// "Triggered: 6"
// "Triggered: 7"
// "Triggered: 10"

e.Trigger 6  // "Triggered: 6"


// Example of behavior with multiple overlapping deferrals
let d1 = e.Defer (fun i -> i > 5)
e.Trigger 11 // (no output)
e.Trigger 12 // (no output)
let d2 = e.Defer (fun i -> i > 10)
e.Trigger 11 // (no output)

d1.Dispose ()
// "Triggered: 11"
// "Triggered: 12"

e.Trigger 13 // (no output)

d2.Dispose ()
// "Triggered: 11"
// "Triggered: 13"
namespace System
Multiple items
type DeferrableEvent<'a> =
  new : unit -> DeferrableEvent<'a>
  member Defer : predicate:('a -> bool) -> IDisposable
  member Defer : predicate:('a -> bool) * transformDeferred:('a list -> 'a list) -> IDisposable
  member Drop : predicate:('a -> bool) -> IDisposable
  member Trigger : arg:'a -> unit
  member Publish : IEvent<'a>

Full name: Script.DeferrableEvent<_>


 An event that can defer publication of certain values until a later time,
 or drop them entirely.


--------------------
new : unit -> DeferrableEvent<'a>
val locker : Object
type obj = Object

Full name: Microsoft.FSharp.Core.obj
val event : Event<'a>
Multiple items
module Event

from Microsoft.FSharp.Control

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  member Trigger : arg:'T -> unit
  member Publish : IEvent<'T>

Full name: Microsoft.FSharp.Control.Event<_>

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

Full name: Microsoft.FSharp.Control.Event<_,_>

--------------------
new : unit -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
val mutable deferPredicates : Map<Guid,('a -> bool)>


 The deferred predicates keyed by deferral ID
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
type Guid =
  struct
    new : b:byte[] -> Guid + 4 overloads
    member CompareTo : value:obj -> int + 1 overload
    member Equals : o:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member ToByteArray : unit -> byte[]
    member ToString : unit -> string + 2 overloads
    static val Empty : Guid
    static member NewGuid : unit -> Guid
    static member Parse : input:string -> Guid
    static member ParseExact : input:string * format:string -> Guid
    ...
  end

Full name: System.Guid

--------------------
Guid()
Guid(b: byte []) : unit
Guid(g: string) : unit
Guid(a: int, b: int16, c: int16, d: byte []) : unit
Guid(a: uint32, b: uint16, c: uint16, d: byte, e: byte, f: byte, g: byte, h: byte, i: byte, j: byte, k: byte) : unit
Guid(a: int, b: int16, c: int16, d: byte, e: byte, f: byte, g: byte, h: byte, i: byte, j: byte, k: byte) : unit
type bool = Boolean

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

Full name: Microsoft.FSharp.Collections.Map.empty
val mutable deferredArgs : ('a * Set<Guid>) list


 The deferred arguments with the list the deferral IDs that caused them to be deferred
Multiple items
module Set

from Microsoft.FSharp.Collections

--------------------
type Set<'T (requires comparison)> =
  interface IComparable
  interface IEnumerable
  interface IEnumerable<'T>
  interface ICollection<'T>
  new : elements:seq<'T> -> Set<'T>
  member Add : value:'T -> Set<'T>
  member Contains : value:'T -> bool
  override Equals : obj -> bool
  member IsProperSubsetOf : otherSet:Set<'T> -> bool
  member IsProperSupersetOf : otherSet:Set<'T> -> bool
  ...

Full name: Microsoft.FSharp.Collections.Set<_>

--------------------
new : elements:seq<'T> -> Set<'T>
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
member DeferrableEvent.Defer : predicate:('a -> bool) * transformDeferred:('a list -> 'a list) -> IDisposable

Full name: Script.DeferrableEvent`1.Defer


 Defers publication of values for which the predicate returns true.
 The deferral ends when the returned object is disposed. When the deferral
 ends, all deferred values that are no longer deferred will be transformed
 and then triggered. Note that a call to Defer will only affect later calls
 to Trigger; any values that are already deferred and match the specified
 predicate will not be affected by this call.
val predicate : ('a -> bool)
val transformDeferred : ('a list -> 'a list)
val lock : lockObject:'Lock -> action:(unit -> 'T) -> 'T (requires reference type)

Full name: Microsoft.FSharp.Core.Operators.lock
val deferralId : Guid
Guid.NewGuid() : Guid
member Map.Add : key:'Key * value:'Value -> Map<'Key,'Value>
type IDisposable =
  member Dispose : unit -> unit

Full name: System.IDisposable
val __ : DeferrableEvent<'a>
member Map.Remove : key:'Key -> Map<'Key,'Value>
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member GetSlice : startIndex:int option * endIndex:int option -> 'T list
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val map : mapping:('T -> 'U) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.map
val arg : 'a
val defIds : Set<Guid>
member Set.Remove : value:'T -> Set<'T>
val noLongerDeferred : ('a * Set<Guid>) list
val stillDeferred : ('a * Set<Guid>) list
val partition : predicate:('T -> bool) -> list:'T list -> 'T list * 'T list

Full name: Microsoft.FSharp.Collections.List.partition
val snd : tuple:('T1 * 'T2) -> 'T2

Full name: Microsoft.FSharp.Core.Operators.snd
val isEmpty : set:Set<'T> -> bool (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.isEmpty
val fst : tuple:('T1 * 'T2) -> 'T1

Full name: Microsoft.FSharp.Core.Operators.fst
val iter : action:('T -> unit) -> list:'T list -> unit

Full name: Microsoft.FSharp.Collections.List.iter
member Event.Trigger : arg:'T -> unit
val this : DeferrableEvent<'a>
member DeferrableEvent.Defer : predicate:('a -> bool) -> IDisposable

Full name: Script.DeferrableEvent`1.Defer


 Shortcut for this.Defer(predicate, id)
member DeferrableEvent.Defer : predicate:('a -> bool) -> IDisposable


 Shortcut for this.Defer(predicate, id)

member DeferrableEvent.Defer : predicate:('a -> bool) * transformDeferred:('a list -> 'a list) -> IDisposable


 Defers publication of values for which the predicate returns true.
 The deferral ends when the returned object is disposed. When the deferral
 ends, all deferred values that are no longer deferred will be transformed
 and then triggered. Note that a call to Defer will only affect later calls
 to Trigger; any values that are already deferred and match the specified
 predicate will not be affected by this call.
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
member DeferrableEvent.Drop : predicate:('a -> bool) -> IDisposable

Full name: Script.DeferrableEvent`1.Drop


 Like Defer, but values are dropped instead of deferred. Shortcut for
 Defer(predicate, fun _ -> []). Se Defer for more information.
member DeferrableEvent.Publish : IEvent<'a>

Full name: Script.DeferrableEvent`1.Publish


 Publishes an observation as a first class value.
property Event.Publish: IEvent<'a>
member DeferrableEvent.Trigger : arg:'a -> unit

Full name: Script.DeferrableEvent`1.Trigger


 Triggers the observation using the given parameter. If the value is deferred,
 it will only be deferred by the deferrals that are currently active when Trigger
 is called. Subsequent calls to Defer with predicates that match the value
 will not affect the deferral of this particular value (but future identical
 values will be affected).
val filter : predicate:('Key -> 'T -> bool) -> table:Map<'Key,'T> -> Map<'Key,'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.filter
val toSeq : table:Map<'Key,'T> -> seq<'Key * 'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Map.toSeq
module Seq

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

Full name: Microsoft.FSharp.Collections.Seq.map
val ofSeq : elements:seq<'T> -> Set<'T> (requires comparison)

Full name: Microsoft.FSharp.Collections.Set.ofSeq
property Set.IsEmpty: bool
val e : DeferrableEvent<int>

Full name: Script.e
Multiple items
val int : value:'T -> int (requires member op_Explicit)

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

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
property DeferrableEvent.Publish: IEvent<int>


 Publishes an observation as a first class value.
member IObservable.Add : callback:('T -> unit) -> unit
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
member DeferrableEvent.Trigger : arg:'a -> unit


 Triggers the observation using the given parameter. If the value is deferred,
 it will only be deferred by the deferrals that are currently active when Trigger
 is called. Subsequent calls to Defer with predicates that match the value
 will not affect the deferral of this particular value (but future identical
 values will be affected).
val d : IDisposable

Full name: Script.d
val i : int
val distinct : list:'T list -> 'T list (requires equality)

Full name: Microsoft.FSharp.Collections.List.distinct
IDisposable.Dispose() : unit
val d1 : IDisposable

Full name: Script.d1
val d2 : IDisposable

Full name: Script.d2

More information

Link:http://fssnip.net/7VL
Posted:10 months ago
Author:Christer van der Meeren
Tags: defer , event