Merge pull request #1062 from fabulous-dev/debounce-cmd

Add Cmd.debounce

src/Fabulous.Tests/CmdTests.fs

@@ -0,0 +1,43 @@
+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)
+
+            actualValue <- None
+
+            triggerCmd 4 |> CmdTestsHelper.execute dispatch
+            do! Async.Sleep 75
+            triggerCmd 5 |> CmdTestsHelper.execute dispatch
+            do! Async.Sleep 125
+
+            Assert.AreEqual(Some(NewValue 5), actualValue)
+        }

src/Fabulous.Tests/Fabulous.Tests.fsproj

@@ -16,6 +16,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,26 @@ 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.Dispose()
+                          cts <- null
+                      },
+                      cts.Token
+                  ) ]