Skip to content

Commit

Permalink
added helpers and tests for creating throttled and buffered throttled…
Browse files Browse the repository at this point in the history
… command factories

similar to Cmd.debounce
  • Loading branch information
h0lg committed Mar 2, 2024
1 parent c6f3cf2 commit e5e8234
Show file tree
Hide file tree
Showing 2 changed files with 189 additions and 0 deletions.
107 changes: 107 additions & 0 deletions src/Fabulous.Tests/CmdTests.fs
Original file line number Diff line number Diff line change
Expand Up @@ -42,3 +42,110 @@ type ``Cmd tests``() =
Assert.AreEqual(2, messageCount)
Assert.AreEqual(Some(NewValue 5), actualValue)
}

[<Test>]
member _.``Cmd.throttle issues message at specified intervals``() =
async {
let mutable messageCount = 0
let mutable actualValue = None

let dispatch msg =
messageCount <- messageCount + 1
actualValue <- Some msg

let throttleCmd = Cmd.throttle 100 NewValue

throttleCmd 1 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 50
throttleCmd 2 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 75
throttleCmd 3 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 125

Assert.AreEqual(2, messageCount)
Assert.AreEqual(Some(NewValue 3), actualValue)

throttleCmd 4 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 75
throttleCmd 5 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 125

Assert.AreEqual(3, messageCount)
Assert.AreEqual(Some(NewValue 4), actualValue)
}

[<Test>]
member _.``Cmd.throttle issues only one message per interval``() =
async {
let mutable messageCount = 0
let mutable actualValue = None

let dispatch msg =
messageCount <- messageCount + 1
actualValue <- Some msg

let throttleCmd = Cmd.throttle 100 NewValue

throttleCmd 1 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 20
throttleCmd 2 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 35
throttleCmd 3 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 125

// Only the first message should have been dispatched
Assert.AreEqual(1, messageCount)
Assert.AreEqual(Some(NewValue 1), actualValue)
}

[<Test>]
member _.``Cmd.bufferedThrottle dispatches the first and most recent message within the specified interval``() =
async {
let mutable messageCount = 0
let mutable actualValue = None

let dispatch msg =
messageCount <- messageCount + 1
actualValue <- Some msg

let throttleCmd = Cmd.bufferedThrottle 100 NewValue

throttleCmd 1 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 20
throttleCmd 2 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 10
throttleCmd 3 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 20
throttleCmd 4 |> CmdTestsHelper.execute dispatch
do! Async.Sleep 125

// Only the first and most recent message should be dispatched
Assert.AreEqual(2, messageCount)
Assert.AreEqual(Some(NewValue 4), actualValue)
}

[<Test>]
member _.``Cmd.bufferedThrottle dispatches the most recent message even if delayed``() =
async {
let mutable actualValue = None
let mutable messageCount = 0

let dispatch msg =
messageCount <- messageCount + 1
actualValue <- Some msg

let throttleCmd = Cmd.bufferedThrottle 100 NewValue

throttleCmd 1 |> CmdTestsHelper.execute dispatch
throttleCmd 2 |> CmdTestsHelper.execute dispatch

// Only the first message should have been dispatched
Assert.AreEqual(1, messageCount)
Assert.AreEqual(Some(NewValue 1), actualValue)

do! Async.Sleep 200 // Wait longer than the throttle interval

// the second message should have been dispatched delayed
Assert.AreEqual(2, messageCount)
Assert.AreEqual(Some(NewValue 2), actualValue)
}
82 changes: 82 additions & 0 deletions src/Fabulous/Cmd.fs
Original file line number Diff line number Diff line change
Expand Up @@ -215,3 +215,85 @@ module Cmd =
},
cts.Token
)) ]

/// <summary>Creates a factory for Commands that dispatch a message only
/// if the factory produced no other Command within the specified interval.
/// This limits how often a message is dispatched by ensuring to only dispatch once within a certain time interval
/// and dropping messages that are produces during the cooldown.
/// Useful for limiting how often a progress message is shown or preventing too many updates to a UI element in a short time.
/// Note that this creates an object with internal state and is intended to be used per Program or longer-running background process
/// rather than once per message in the update function.</summary>
/// <param name="interval">The minimum time interval between two consecutive Command executions in milliseconds.</param>
/// <param name="fn">Maps a factory input value to a message for dispatch.</param>
/// <returns>A Command factory function that maps an input value to a "throttled" Command which dispatches a message (mapped from the value)
/// if the minimum time interval has elapsed since the last Command execution; otherwise, it does nothing.</returns>
let throttle (interval: int) (fn: 'value -> 'msg) : 'value -> Cmd<'msg> =
let mutable lastDispatch = System.DateTime.MinValue

// return a factory function mapping input values to "throttled" Commands that only dispatch if enough time passed
fun (value: 'value) ->
[ fun dispatch ->
let now = System.DateTime.UtcNow

// If the interval has elapsed since the last execution, dispatch the message
if now - lastDispatch >= System.TimeSpan.FromMilliseconds(float interval) then
lastDispatch <- now
dispatch(fn value) ]

/// <summary>
/// Creates a Command factory that dispatches the most recent message in a given interval - even if delayed.
/// This makes it similar to <see cref="throttle"/> in that it rate-limits the message dispatch
/// and similar to <see cref="debounce"/> in that it guarantees the last message (within the interval or in total) is dispatched.
/// Helpful for scenarios where you want to throttle, but cannot risk losing the last message to throttling
/// - like the last progress update that completes a progress.
/// Note that this function creates an object with internal state and is intended to be used per Program or longer-running background process
/// rather than once per message in the update function.
/// </summary>
/// <param name="interval">The minimum time interval between two consecutive Command executions in milliseconds.</param>
/// <param name="fn">A function that maps a factory input value to a message for dispatch.</param>
/// <returns>
/// A Command factory function that maps an input value to a "buffered throttle" Command which dispatches the most recent message (mapped from the value)
/// if the minimum time interval has elapsed since the last Command execution; otherwise, it does nothing.
/// </returns>
let bufferedThrottle (interval: int) (fn: 'value -> 'msg) : 'value -> Cmd<'msg> =
let funLock = obj() // ensures safe access to resources shared across different threads
let mutable lastDispatch = System.DateTime.MinValue
let mutable cts: CancellationTokenSource = null // if set, allows cancelling the last issued Command

// Return a factory function mapping input values to buffered throttled Commands with delayed dispatch of the most recent message
fun (value: 'value) ->
[ fun dispatch ->
// Lock to ensure thread-safe access to shared resources
lock funLock (fun () ->
let now = System.DateTime.UtcNow
let elapsedSinceLastDispatch = now - lastDispatch
let rateLimit = System.TimeSpan.FromMilliseconds(float interval)

// If the interval has elapsed since the last dispatch, dispatch immediately
if elapsedSinceLastDispatch >= rateLimit then
lastDispatch <- now
dispatch(fn value)
else // schedule the dispatch for when the interval is up
// cancel the last sleeping Command issued earlier from this factory
if cts <> null then
cts.Cancel()
cts.Dispose()

// make cancellation available to the factory's next Command
cts <- new CancellationTokenSource()

// asynchronously wait for the remaining time before dispatch
Async.Start(
async {
do! Async.Sleep(rateLimit - elapsedSinceLastDispatch)

lock funLock (fun () ->
dispatch(fn value)

// done; invalidate own cancellation token
if cts <> null then
cts.Dispose()
cts <- null)
},
cts.Token
)) ]

0 comments on commit e5e8234

Please sign in to comment.