Skip to content

Commit b611717

Browse files
committed
added bufferedThrottle suggested in fabulous-dev/Fabulous#1070
1 parent 97f3517 commit b611717

File tree

3 files changed

+65
-1
lines changed

3 files changed

+65
-1
lines changed

Ui/App.fs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -175,7 +175,7 @@ module App =
175175
let cacheFolder = Folder.GetPath Folders.cache
176176
let dataStore = JsonFileDataStore cacheFolder
177177
let youtube = Youtube(dataStore, VideoIndexRepository cacheFolder)
178-
let dispatchProgress = Cmd.debounce 100 (fun progress ->
178+
let dispatchProgress = CmdExtensions.bufferedThrottle 100 (fun progress ->
179179
System.Diagnostics.Debug.WriteLine("############# progress dispatched" + Environment.NewLine + progress.ToString())
180180
SearchProgress progress)
181181
command.SetProgressReporter(Progress<BatchProgress>(fun progress ->

Ui/CmdExtensions.fs

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,63 @@
1+
namespace Ui
2+
3+
open System.Threading
4+
open Fabulous
5+
6+
module CmdExtensions =
7+
/// <summary>
8+
/// Creates a Command factory that dispatches the most recent message in a given interval - even if delayed.
9+
/// This makes it similar to <see cref="throttle"/> in that it rate-limits the message dispatch
10+
/// and similar to <see cref="debounce"/> in that it guarantees the last message (within the interval or in total) is dispatched.
11+
/// Helpful for scenarios where you want to throttle, but cannot risk losing the last message to throttling
12+
/// - like the last progress update that completes a progress.
13+
/// Note that this function creates an object with internal state and is intended to be used per Program or longer-running background process
14+
/// rather than once per message in the update function.
15+
/// </summary>
16+
/// <param name="interval">The minimum time interval between two consecutive Command executions in milliseconds.</param>
17+
/// <param name="fn">A function that maps a factory input value to a message for dispatch.</param>
18+
/// <returns>
19+
/// A Command factory function that maps an input value to a "buffered throttle" Command which dispatches the most recent message (mapped from the value)
20+
/// if the minimum time interval has elapsed since the last Command execution; otherwise, it does nothing.
21+
/// </returns>
22+
let bufferedThrottle (interval: int) (fn: 'value -> 'msg) : 'value -> Cmd<'msg> =
23+
let funLock = obj () // ensures safe access to resources shared across different threads
24+
let mutable lastDispatch = System.DateTime.MinValue
25+
let mutable cts: CancellationTokenSource = null // if set, allows cancelling the last issued Command
26+
27+
// Return a factory function mapping input values to buffered throttled Commands with delayed dispatch of the most recent message
28+
fun (value: 'value) ->
29+
[ fun dispatch ->
30+
// Lock to ensure thread-safe access to shared resources
31+
lock funLock (fun () ->
32+
let now = System.DateTime.UtcNow
33+
let elapsedSinceLastDispatch = now - lastDispatch
34+
let rateLimit = System.TimeSpan.FromMilliseconds(float interval)
35+
36+
// If the interval has elapsed since the last dispatch, dispatch immediately
37+
if elapsedSinceLastDispatch >= rateLimit then
38+
lastDispatch <- now
39+
dispatch (fn value)
40+
else // schedule the dispatch for when the interval is up
41+
// cancel the last sleeping Command issued earlier from this factory
42+
if cts <> null then
43+
cts.Cancel()
44+
cts.Dispose()
45+
46+
// make cancellation available to the factory's next Command
47+
cts <- new CancellationTokenSource()
48+
49+
// asynchronously wait for the remaining time before dispatch
50+
Async.Start(
51+
async {
52+
do! Async.Sleep(rateLimit - elapsedSinceLastDispatch)
53+
54+
lock funLock (fun () ->
55+
dispatch (fn value)
56+
57+
// done; invalidate own cancellation token
58+
if cts <> null then
59+
cts.Dispose()
60+
cts <- null)
61+
},
62+
cts.Token
63+
)) ]

Ui/Ui.fsproj

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@
2727
<DisableCodesignVerification>true</DisableCodesignVerification>
2828
</PropertyGroup>
2929
<ItemGroup>
30+
<Compile Include="CmdExtensions.fs" />
3031
<Compile Include="App.fs" />
3132
</ItemGroup>
3233
<ItemGroup>

0 commit comments

Comments
 (0)