From 58825f513ae8048c13becf70c45d4e0ebf0dc5b6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9=20Larivi=C3=A8re?= Date: Sun, 28 Jan 2024 12:11:13 +0100 Subject: [PATCH 1/3] Add Cmd.debounce --- src/Fabulous.Tests/CmdTests.fs | 33 ++++++++++++++++++++++++ src/Fabulous.Tests/Fabulous.Tests.fsproj | 1 + src/Fabulous/Cmd.fs | 22 ++++++++++++++++ 3 files changed, 56 insertions(+) create mode 100644 src/Fabulous.Tests/CmdTests.fs diff --git a/src/Fabulous.Tests/CmdTests.fs b/src/Fabulous.Tests/CmdTests.fs new file mode 100644 index 000000000..ba62e601e --- /dev/null +++ b/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 + +[] +type ``Cmd tests``() = + [] + 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) + } \ No newline at end of file diff --git a/src/Fabulous.Tests/Fabulous.Tests.fsproj b/src/Fabulous.Tests/Fabulous.Tests.fsproj index 75566b9b0..edf55fb8d 100644 --- a/src/Fabulous.Tests/Fabulous.Tests.fsproj +++ b/src/Fabulous.Tests/Fabulous.Tests.fsproj @@ -15,6 +15,7 @@ + diff --git a/src/Fabulous/Cmd.fs b/src/Fabulous/Cmd.fs index 61366023e..c6ae0b3bb 100644 --- a/src/Fabulous/Cmd.fs +++ b/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 + ) + ] From 9edb16b1dd04cc086b928b7e10c25ce98ded2efc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9=20Larivi=C3=A8re?= Date: Sun, 28 Jan 2024 12:19:30 +0100 Subject: [PATCH 2/3] Update Fantomas and format code --- .config/dotnet-tools.json | 2 +- src/Fabulous.Tests/CmdTests.fs | 11 ++++++----- src/Fabulous/Builders.fs | 6 +++--- src/Fabulous/Cmd.fs | 33 ++++++++++++++++----------------- 4 files changed, 26 insertions(+), 26 deletions(-) diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json index 4b075dd90..81ed67865 100644 --- a/.config/dotnet-tools.json +++ b/.config/dotnet-tools.json @@ -3,7 +3,7 @@ "isRoot": true, "tools": { "fantomas": { - "version": "5.2.0", + "version": "6.2.3", "commands": [ "fantomas" ] diff --git a/src/Fabulous.Tests/CmdTests.fs b/src/Fabulous.Tests/CmdTests.fs index ba62e601e..8d044797e 100644 --- a/src/Fabulous.Tests/CmdTests.fs +++ b/src/Fabulous.Tests/CmdTests.fs @@ -9,25 +9,26 @@ module CmdTestsHelper = let execute dispatch (cmd: Cmd<'msg>) = for sub in cmd do sub dispatch - + [] type ``Cmd tests``() = [] 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) - } \ No newline at end of file + } diff --git a/src/Fabulous/Builders.fs b/src/Fabulous/Builders.fs index 3e91a9d81..936861bf0 100644 --- a/src/Fabulous/Builders.fs +++ b/src/Fabulous/Builders.fs @@ -38,9 +38,9 @@ type WidgetBuilder<'msg, 'marker> = DebugName = $"{typeof<'marker>.Name}<{typeof<'msg>.Name}>" #endif ScalarAttributes = - match StackList.length &scalarAttributes with - | 0us -> ValueNone - | _ -> ValueSome(Array.sortInPlace (fun a -> a.Key) (StackList.toArray &scalarAttributes)) + match StackList.length &scalarAttributes with + | 0us -> ValueNone + | _ -> ValueSome(Array.sortInPlace (fun a -> a.Key) (StackList.toArray &scalarAttributes)) WidgetAttributes = ValueOption.map (Array.sortInPlace(fun a -> a.Key)) widgetAttributes diff --git a/src/Fabulous/Cmd.fs b/src/Fabulous/Cmd.fs index c6ae0b3bb..3a4c489b0 100644 --- a/src/Fabulous/Cmd.fs +++ b/src/Fabulous/Cmd.fs @@ -105,24 +105,23 @@ 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 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 - ) - ] + if cts <> null then + cts.Cancel() + cts.Dispose() + + cts <- new CancellationTokenSource() + + Async.Start( + async { + do! Async.Sleep(timeout) + dispatch(fn value) + }, + cts.Token + ) ] From 484d7293cac059d0d9a2b329bf78d92a43e70da0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9=20Larivi=C3=A8re?= Date: Mon, 29 Jan 2024 09:38:49 +0100 Subject: [PATCH 3/3] Dispose correctly the cancellation token --- src/Fabulous.Tests/CmdTests.fs | 9 +++++++++ src/Fabulous/Cmd.fs | 3 +++ 2 files changed, 12 insertions(+) diff --git a/src/Fabulous.Tests/CmdTests.fs b/src/Fabulous.Tests/CmdTests.fs index 8d044797e..073b6d8fc 100644 --- a/src/Fabulous.Tests/CmdTests.fs +++ b/src/Fabulous.Tests/CmdTests.fs @@ -31,4 +31,13 @@ type ``Cmd tests``() = 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) } diff --git a/src/Fabulous/Cmd.fs b/src/Fabulous/Cmd.fs index 3a4c489b0..d1a8b19e7 100644 --- a/src/Fabulous/Cmd.fs +++ b/src/Fabulous/Cmd.fs @@ -122,6 +122,9 @@ module Cmd = async { do! Async.Sleep(timeout) dispatch(fn value) + + cts.Dispose() + cts <- null }, cts.Token ) ]