From 6ecb6d07acaaec705704b545dafd73fa749515c7 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Wed, 14 Jan 2026 19:49:17 +0100 Subject: [PATCH] Simplify tests to prepare for a more complicated remote --- NightLight.Core.Tests/FakeHome.fs | 13 +++++++---- .../InteractionListGenerators.fs | 14 +++++------ NightLight.Core.Tests/NightLightTests.fs | 23 ++++++++----------- 3 files changed, 24 insertions(+), 26 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index ab922b8..bbbe049 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -6,14 +6,17 @@ open NightLight.Core.Models open FsToolkit.ErrorHandling open FSharp.Data -type HumanInteraction = - | LightPoweredOn of Light - | LightPoweredOff of Light +type RemoteInteraction = | RemotePressedOnButton | RemotePressedOffButton +type HumanInteraction = + | LightPoweredOn of Light + | LightPoweredOff of Light + type Interaction = | HumanInteraction of HumanInteraction + | RemoteInteraction of RemoteInteraction | TimeChanged of DateTime type Color = @@ -120,12 +123,12 @@ type FakeHome() = |> ReceivedZigbeeEvent |> onEventPublished.Trigger | HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[light.FriendlyName].PowerOff() - | HumanInteraction RemotePressedOnButton -> + | RemoteInteraction RemotePressedOnButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""on"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | HumanInteraction RemotePressedOffButton -> + | RemoteInteraction RemotePressedOffButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""off"" }" } |> ReceivedZigbeeEvent diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index a6c2871..3435eba 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -6,16 +6,14 @@ open NightLight.Core.Tests.TimeChangedGenerators open FsCheck let private genHumanInteraction biasTowardsLight = - let genLightInteraction = - Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ] - |> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ]) - - let genRemoteInteraction = - Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] - - Gen.oneof [ genLightInteraction; genRemoteInteraction ] + Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ] + |> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ]) |> Gen.map Interaction.HumanInteraction +let private genRemoteInteraction = + Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] + |> Gen.map RemoteInteraction + let private genInteraction biasTowardsLight = Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight ] diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 85053e8..360932e 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -69,10 +69,8 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - let ``All remote controlled lights with power should be on if the 'Off' button on the remote was never pressed`` - (light: Light) - = - genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) + let ``All remote controlled lights with power should be on if the remote was never used`` (light: Light) = + genRandomInteractionsExcept light _.IsRemoteInteraction |> ensureStartsWithTimeChanged |> ensureLightHasPower light |> Arb.fromGen @@ -82,13 +80,13 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - let ``After pressing 'On' on the remote, if the 'Off' button isn't pressed, all remotely controlled lights with power should be on`` + let ``After pressing 'On' on the remote, if the remote isn't used again, all remotely controlled lights with power should be on`` (light: Light) = concatGens [ genRandomInteractions light - HumanInteraction RemotePressedOnButton |> List.singleton |> Gen.constant - genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ] + RemoteInteraction RemotePressedOnButton |> List.singleton |> Gen.constant + genRandomInteractionsExcept light _.IsRemoteInteraction ] |> ensureStartsWithTimeChanged |> ensureLightHasPower light |> Arb.fromGen @@ -98,7 +96,7 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - let ``After a new day starts, if the 'Off' button isn't pressed, all remotely controlled lights with power should be on`` + let ``After a new day starts, if the remote isn't used, all remotely controlled lights with power should be on`` (light: Light) = concatGens @@ -106,7 +104,7 @@ type NightLightTests() = genTimeChangedToRandomNightTime |> Gen.map List.singleton genRandomInteractionsExcept light isTimeChangedToAnyDayTime genTimeChangedToRandomDayTime |> Gen.map List.singleton - genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ] + genRandomInteractionsExcept light _.IsRemoteInteraction ] |> ensureStartsWithTimeChanged |> ensureLightHasPower light |> Arb.fromGen @@ -116,15 +114,14 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - let ``After pressing 'Off' on the remote, if the 'On' button isn't pressed and a new day doesn't start, all remotely controlled lights should be off`` + let ``After pressing 'Off' on the remote, if the remote isn't used again and a new day doesn't start, all remotely controlled lights should be off`` (light: Light) = concatGens [ genRandomInteractions light - HumanInteraction RemotePressedOffButton |> List.singleton |> Gen.constant + RemoteInteraction RemotePressedOffButton |> List.singleton |> Gen.constant genRandomInteractionsExcept light (fun interaction -> - interaction = HumanInteraction RemotePressedOnButton - || interaction |> isTimeChangedToAnyDayTime) ] + interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ] |> ensureStartsWithTimeChanged |> Arb.fromGen |> Prop.forAll