diff --git a/Ui/App.fs b/Ui/App.fs index 6bb49c0..73b61f4 100644 --- a/Ui/App.fs +++ b/Ui/App.fs @@ -175,7 +175,7 @@ module App = let cacheFolder = Folder.GetPath Folders.cache let dataStore = JsonFileDataStore cacheFolder let youtube = Youtube(dataStore, VideoIndexRepository cacheFolder) - let dispatchProgress = Cmd.debounce 100 (fun progress -> + let dispatchProgress = CmdExtensions.bufferedThrottle 100 (fun progress -> System.Diagnostics.Debug.WriteLine("############# progress dispatched" + Environment.NewLine + progress.ToString()) SearchProgress progress) command.SetProgressReporter(Progress(fun progress -> diff --git a/Ui/CmdExtensions.fs b/Ui/CmdExtensions.fs new file mode 100644 index 0000000..f58418e --- /dev/null +++ b/Ui/CmdExtensions.fs @@ -0,0 +1,63 @@ +namespace Ui + +open System.Threading +open Fabulous + +module CmdExtensions = + /// + /// Creates a Command factory that dispatches the most recent message in a given interval - even if delayed. + /// This makes it similar to in that it rate-limits the message dispatch + /// and similar to 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. + /// + /// The minimum time interval between two consecutive Command executions in milliseconds. + /// A function that maps a factory input value to a message for dispatch. + /// + /// 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. + /// + 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 + )) ] diff --git a/Ui/Ui.fsproj b/Ui/Ui.fsproj index 3fcb41d..590fec2 100644 --- a/Ui/Ui.fsproj +++ b/Ui/Ui.fsproj @@ -27,6 +27,7 @@ true +