Add Cmd.debounce

Author: TimLariviere

src/Fabulous.Tests/CmdTests.fs

@@ -0,0 +1,33 @@
+namespace Fabulous.Tests
+
+open Fabulous
+open NUnit.Framework
+
+type CmdTestsMsg = NewValue of int
+
+module CmdTestsHelper =
+    let execute dispatch (cmd: Cmd<'msg>) =
+        for sub in cmd do
+            sub dispatch
+    
+[<TestFixture>]
+type ``Cmd tests``() =
+    [<Test>]
+    member _.``Cmd.debounce only dispatch the last message``() =
+        async {
+            let mutable actualValue = None
+            let dispatch msg =
+                if actualValue.IsNone then
+                    actualValue <- Some msg
+            
+            let triggerCmd = Cmd.debounce 100 NewValue
+            
+            triggerCmd 1 |> CmdTestsHelper.execute dispatch
+            do! Async.Sleep 50
+            triggerCmd 2 |> CmdTestsHelper.execute dispatch
+            do! Async.Sleep 75
+            triggerCmd 3 |> CmdTestsHelper.execute dispatch
+            do! Async.Sleep 125
+            
+            Assert.AreEqual(Some(NewValue 3), actualValue)
+        }

src/Fabulous.Tests/Fabulous.Tests.fsproj

@@ -15,6 +15,7 @@
     <Compile Include="AttributesTests.fs" />
     <Compile Include="ViewTests.fs" />
     <Compile Include="ArrayTests.fs" />
+    <Compile Include="CmdTests.fs" />
   </ItemGroup>
   <ItemGroup>
     <PackageReference Include="BenchmarkDotNet" />

src/Fabulous/Cmd.fs

@@ -1,5 +1,6 @@
 namespace Fabulous
 
+open System.Threading
 open System.Threading.Tasks
 
 /// Dispatch - feed new message into the processing loop
@@ -104,3 +105,24 @@ module Cmd =
                       dispatch(failure ex)
               }
               |> ignore ]
+    
+    /// Command to issue a message if no other message has been issued within the specified timeout
+    let debounce (timeout: int) (fn: 'value -> 'msg): 'value -> Cmd<'msg> =
+        let mutable cts: CancellationTokenSource = null
+        
+        fun (value: 'value) ->
+            [ fun dispatch ->
+                if cts <> null then
+                    cts.Cancel()
+                    cts.Dispose()
+                
+                cts <- new CancellationTokenSource()
+                
+                Async.Start(
+                    async {
+                        do! Async.Sleep(timeout)
+                        dispatch (fn value)
+                    },
+                    cts.Token
+                )
+            ]