|
| 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 | + )) ] |
0 commit comments