-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathnotify.rkt
148 lines (129 loc) · 7.37 KB
/
notify.rkt
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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
#lang racket
(require srfi/1)
(provide notify subscribe unsubscribe remove-subscriber remove-all-subscribers notify-prune-frequency-msec notify-prune-delta-msec)
(define notify-prune-frequency-msec (make-parameter 5000)) ; ugly hack to prevent memory leaks (see below in Private part)
(define notify-prune-delta-msec (make-parameter 8000)) ; see maybe-add-to-buffer
(define events (make-hash))
(define buffer '())
(define last-prune (current-inexact-milliseconds))
(define-struct receiver (subscriber callback exclusions))
(define (notify event notifier data)
(for ([rec (in-list (hash-ref events event '()))])
(let ((matching-buffered (get-maybe-matching-buffered event notifier rec))) ; find earlier event that might cause a cycle
(cond
(matching-buffered (remove-buffered matching-buffered)) ; if there is a cycle cause, then do not notify and remove the previous event from buffer
(else
(maybe-add-to-buffer event notifier rec)
((receiver-callback rec) event notifier data))))))
(define (subscribe subscriber event callback [exclusions'()])
(hash-update! events
event
(lambda (receivers)
(cons (make-receiver subscriber callback exclusions)
receivers))
'()))
(define (unsubscribe subscriber event)
(hash-update! events
event
(lambda (receivers)
(filter (lambda (rec)
(not (equal? (receiver-subscriber rec) subscriber)))
receivers)))
(when (null? (hash-ref events event)) ; filter might return '(), we don't want this event to hang around
(hash-remove! events event)))
(define (list-subscribed-events)
(for/list ([(k v) (in-hash events)])
k))
(define (remove-subscriber subscriber)
(for ([evt (in-list (list-subscribed-events))])
(unsubscribe subscriber evt)))
(define (remove-all-subscribers)
(set! events (make-hash))
(set! buffer '()))
;; ----------------------------------------
;; Private part
;; The problem is that there is no guarantee that the second of any pairs of mutually exclusive events
;; will occur, and so the buffer might grow indefinitely. That's why it is pruned every call to notify
;; if the last pruning was longer than (notify-prune-frequency-msec) ago and the buffer entry was added
;; more than or equal to (notify-prune-delta-msec) milliseconds ago. This means that event loops may occur
;; with mutually exclusive events if their handling takes longer than (notify-prune-delta-msec) milliseconds.
(define (maybe-add-to-buffer event notifier receiver)
(define now (current-inexact-milliseconds))
(when (> (- now last-prune) (notify-prune-frequency-msec))
(set! buffer (filter (lambda (elem) (< (- now (first elem)) (notify-prune-delta-msec)))
buffer))
(set! last-prune now))
(unless (empty? (receiver-exclusions receiver))
(set! buffer
(cons (list now event notifier receiver) buffer))))
(define (get-maybe-matching-buffered event notifier receiver)
(find (lambda (buffered)
(and (equal? (receiver-subscriber (fourth buffered)) notifier)
(equal? (third buffered) (receiver-subscriber receiver))
(member event (receiver-exclusions (fourth buffered)))))
buffer))
(define (remove-buffered buffered)
(set! buffer (filter (lambda (elem) (not (equal? elem buffered))) buffer)))
;; ----------------------------------------
;; Testing
(module+ test
(require rackunit
racket/set)
(define a #f)
;; Test for standard event notifications to multiple subscribers.
(check-not-exn (lambda () (notify 'test 'notifier1 '(hello world!))))
(check-not-exn (lambda () (subscribe 'subscriber1 'test (lambda (evt notifier data)
(check-equal? data '(test-2))) '())))
(check-not-exn (lambda () (subscribe 'subscriber2 'test (lambda (evt notifier data)
(check-equal? data '(test-2))) '())))
(check-not-exn (lambda () (notify 'test 'notifier2 '(test-2))))
(check-not-exn (lambda () (subscribe 'subscriber2 'test2 (lambda (evt notifier data)
(check-equal? data '(another test data))) '())))
;; Test for cyclic events. The following notifications would create an infinite cycle without the exclusions.
(check-not-exn (lambda () (subscribe 'model
'view-change
(lambda (evt notifier data)
(notify 'model-change 'model '(never triggered))
(set! a 'model))
'(model-change))))
(check-not-exn (lambda () (subscribe 'view
'model-change
(lambda (evt notifier data)
(notify 'view-change 'view '(never triggered))
(set! a 'view))
'(view-change))))
(check-not-exn (lambda () (notify 'view-change 'view '(view change data))))
(check-equal? a 'model)
(check-not-exn (lambda () (notify 'model-change 'model '(model change data))))
(check-equal? a 'view)
;; Unsubscribe and remove-subscriber
(check-not-exn (lambda () (unsubscribe 'subscriber2 'test)))
(check-true (set=? (list->set (list-subscribed-events)) (list->set '(test test2 view-change model-change))))
(check-not-exn (lambda () (remove-subscriber 'subscriber1)))
(check-not-exn (lambda () (remove-subscriber 'subscriber2)))
(check-true (set=? (list->set (list-subscribed-events)) (list->set '(view-change model-change))))
(check-not-exn (lambda () (remove-all-subscribers)))
(check-true (set-empty? (list->set (list-subscribed-events))))
;; Multiple exclusions
(check-not-exn (lambda () (subscribe 'model
'view-change1
(lambda (evt notifier data)
(notify 'model-change 'model '(never triggered))
(set! a 'model))
'(model-change1 model-change2))))
(check-not-exn (lambda () (subscribe 'model
'view-change2
(lambda (evt notifier data)
(notify 'model-change1 'model '(never triggered))
(set! a 'model))
'(model-change1 model-change2))))
(check-not-exn (lambda () (subscribe 'view
'model-change1
(lambda (evt notifier data)
(notify 'view-change2 'view '(never triggered))
(set! a 'view))
'(view-change1 view-change2))))
(check-not-exn (lambda () (notify 'view 'view-change1 '(view change 1 data))))
(check-not-exn (lambda () (notify 'model 'model-change2 '(model change 2 data))))
(check-not-exn (lambda () (remove-all-subscribers)))
)