Skip to content

Commit a68a7b2

Browse files
h0lgh0lg
committed
added helpers and tests for creating throttled and buffered throttled command factories
similar to Cmd.debounce
1 parent c6f3cf2 commit a68a7b2

File tree

2 files changed

+192
-0
lines changed

2 files changed

+192
-0
lines changed

‎src/Fabulous.Tests/CmdTests.fs‎

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -42,3 +42,110 @@ type ``Cmd tests``() =
4242
Assert.AreEqual(2, messageCount)
4343
Assert.AreEqual(Some(NewValue 5), actualValue)
4444
}
45+
46+
[<Test>]
47+
member _.``Cmd.throttle issues message at specified intervals``() =
48+
async {
49+
let mutable messageCount = 0
50+
let mutable actualValue = None
51+
52+
let dispatch msg =
53+
messageCount <- messageCount + 1
54+
actualValue <- Some msg
55+
56+
let throttleCmd = Cmd.throttle 100 NewValue
57+
58+
throttleCmd 1 |> CmdTestsHelper.execute dispatch
59+
do! Async.Sleep 50
60+
throttleCmd 2 |> CmdTestsHelper.execute dispatch
61+
do! Async.Sleep 75
62+
throttleCmd 3 |> CmdTestsHelper.execute dispatch
63+
do! Async.Sleep 125
64+
65+
Assert.AreEqual(2, messageCount)
66+
Assert.AreEqual(Some(NewValue 3), actualValue)
67+
68+
throttleCmd 4 |> CmdTestsHelper.execute dispatch
69+
do! Async.Sleep 75
70+
throttleCmd 5 |> CmdTestsHelper.execute dispatch
71+
do! Async.Sleep 125
72+
73+
Assert.AreEqual(3, messageCount)
74+
Assert.AreEqual(Some(NewValue 4), actualValue)
75+
}
76+
77+
[<Test>]
78+
member _.``Cmd.throttle issues only one message per interval``() =
79+
async {
80+
let mutable messageCount = 0
81+
let mutable actualValue = None
82+
83+
let dispatch msg =
84+
messageCount <- messageCount + 1
85+
actualValue <- Some msg
86+
87+
let throttleCmd = Cmd.throttle 100 NewValue
88+
89+
throttleCmd 1 |> CmdTestsHelper.execute dispatch
90+
do! Async.Sleep 20
91+
throttleCmd 2 |> CmdTestsHelper.execute dispatch
92+
do! Async.Sleep 35
93+
throttleCmd 3 |> CmdTestsHelper.execute dispatch
94+
do! Async.Sleep 125
95+
96+
// Only the first message should have been dispatched
97+
Assert.AreEqual(1, messageCount)
98+
Assert.AreEqual(Some(NewValue 1), actualValue)
99+
}
100+
101+
[<Test>]
102+
member _.``Cmd.bufferedThrottle dispatches the first and most recent message within the specified interval``() =
103+
async {
104+
let mutable messageCount = 0
105+
let mutable actualValue = None
106+
107+
let dispatch msg =
108+
messageCount <- messageCount + 1
109+
actualValue <- Some msg
110+
111+
let throttleCmd = Cmd.bufferedThrottle 100 NewValue
112+
113+
throttleCmd 1 |> CmdTestsHelper.execute dispatch
114+
do! Async.Sleep 20
115+
throttleCmd 2 |> CmdTestsHelper.execute dispatch
116+
do! Async.Sleep 10
117+
throttleCmd 3 |> CmdTestsHelper.execute dispatch
118+
do! Async.Sleep 20
119+
throttleCmd 4 |> CmdTestsHelper.execute dispatch
120+
do! Async.Sleep 125
121+
122+
// Only the first and most recent message should be dispatched
123+
Assert.AreEqual(2, messageCount)
124+
Assert.AreEqual(Some(NewValue 4), actualValue)
125+
}
126+
127+
[<Test>]
128+
member _.``Cmd.bufferedThrottle dispatches the most recent message even if delayed``() =
129+
async {
130+
let mutable actualValue = None
131+
let mutable messageCount = 0
132+
133+
let dispatch msg =
134+
messageCount <- messageCount + 1
135+
actualValue <- Some msg
136+
137+
let throttleCmd = Cmd.bufferedThrottle 100 NewValue
138+
139+
throttleCmd 1 |> CmdTestsHelper.execute dispatch
140+
throttleCmd 2 |> CmdTestsHelper.execute dispatch
141+
142+
// Only the first message should have been dispatched
143+
Assert.AreEqual(1, messageCount)
144+
Assert.AreEqual(Some(NewValue 1), actualValue)
145+
146+
do! Async.Sleep 200 // Wait longer than the throttle interval
147+
148+
// the second message should have been dispatched delayed
149+
Assert.AreEqual(2, messageCount)
150+
Assert.AreEqual(Some(NewValue 2), actualValue)
151+
}

‎src/Fabulous/Cmd.fs‎

Lines changed: 85 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -215,3 +215,88 @@ module Cmd =
215215
},
216216
cts.Token
217217
)) ]
218+
219+
/// <summary>Creates a factory for Commands that dispatch a message only
220+
/// if the factory produced no other Command within the specified interval.
221+
/// This limits how often a message is dispatched by ensuring to only dispatch once within a certain time interval
222+
/// and dropping messages that are produces during the cooldown.
223+
/// Useful for limiting how often a progress message is shown or preventing too many updates to a UI element in a short time.
224+
/// Note that this creates an object with internal state and is intended to be used per Program or longer-running background process
225+
/// rather than once per message in the update function.</summary>
226+
/// <param name="interval">The minimum time interval between two consecutive Command executions in milliseconds.</param>
227+
/// <param name="fn">Maps a factory input value to a message for dispatch.</param>
228+
/// <returns>A Command factory function that maps an input value to a "throttled" Command which dispatches a message (mapped from the value)
229+
/// if the minimum time interval has elapsed since the last Command execution; otherwise, it does nothing.</returns>
230+
let throttle (interval: int) (fn: 'value -> 'msg) : 'value -> Cmd<'msg> =
231+
let mutable lastDispatch = System.DateTime.MinValue
232+
233+
// return a factory function mapping input values to "throttled" Commands that only dispatch if enough time passed
234+
fun (value: 'value) ->
235+
[ fun dispatch ->
236+
let now = System.DateTime.UtcNow
237+
238+
// If the interval has elapsed since the last execution, dispatch the message
239+
if now - lastDispatch >= System.TimeSpan.FromMilliseconds(float interval) then
240+
lastDispatch <- now
241+
dispatch(fn value)
242+
]
243+
244+
/// <summary>
245+
/// Creates a Command factory that dispatches the most recent message in a given interval - even if delayed.
246+
/// This makes it similar to <see cref="throttle"/> in that it rate-limits the message dispatch
247+
/// and similar to <see cref="debounce"/> in that it guarantees the last message (within the interval or in total) is dispatched.
248+
/// Helpful for scenarios where you want to throttle, but cannot risk losing the last message to throttling
249+
/// - like the last progress update that completes a progress.
250+
/// Note that this function creates an object with internal state and is intended to be used per Program or longer-running background process
251+
/// rather than once per message in the update function.
252+
/// </summary>
253+
/// <param name="interval">The minimum time interval between two consecutive Command executions in milliseconds.</param>
254+
/// <param name="fn">A function that maps a factory input value to a message for dispatch.</param>
255+
/// <returns>
256+
/// A Command factory function that maps an input value to a "buffered throttle" Command which dispatches the most recent message (mapped from the value)
257+
/// if the minimum time interval has elapsed since the last Command execution; otherwise, it does nothing.
258+
/// </returns>
259+
let bufferedThrottle (interval: int) (fn: 'value -> 'msg) : 'value -> Cmd<'msg> =
260+
let funLock = obj() // ensures safe access to resources shared across different threads
261+
let mutable lastDispatch = System.DateTime.MinValue
262+
let mutable cts: CancellationTokenSource = null // if set, allows cancelling the last issued Command
263+
264+
// Return a factory function mapping input values to buffered throttled Commands with delayed dispatch of the most recent message
265+
fun (value: 'value) ->
266+
[ fun dispatch ->
267+
// Lock to ensure thread-safe access to shared resources
268+
lock funLock (fun () ->
269+
let now = System.DateTime.UtcNow
270+
let elapsedSinceLastDispatch = now - lastDispatch
271+
let rateLimit = System.TimeSpan.FromMilliseconds(float interval)
272+
273+
// If the interval has elapsed since the last dispatch, dispatch immediately
274+
if elapsedSinceLastDispatch >= rateLimit then
275+
lastDispatch <- now
276+
dispatch(fn value)
277+
else // schedule the dispatch for when the interval is up
278+
// cancel the last sleeping Command issued earlier from this factory
279+
if cts <> null then
280+
cts.Cancel()
281+
cts.Dispose()
282+
283+
// make cancellation available to the factory's next Command
284+
cts <- new CancellationTokenSource()
285+
286+
// asynchronously wait for the remaining time before dispatch
287+
Async.Start(
288+
async {
289+
do! Async.Sleep(rateLimit - elapsedSinceLastDispatch)
290+
291+
lock funLock (fun () ->
292+
dispatch(fn value)
293+
294+
// done; invalidate own cancellation token
295+
if cts <> null then
296+
cts.Dispose()
297+
cts <- null)
298+
},
299+
cts.Token
300+
)
301+
)
302+
]

0 commit comments

Comments
 (0)