From 6ecb6d07acaaec705704b545dafd73fa749515c7 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Wed, 14 Jan 2026 19:49:17 +0100 Subject: [PATCH 1/4] 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 From 2950b21488c83cdbc4b9876ea5d5f740d2ea6a87 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Wed, 14 Jan 2026 19:49:34 +0100 Subject: [PATCH 2/4] Implement the 'Left' button on the remote --- NightLight.Core.Tests/FakeHome.fs | 6 ++++ .../InteractionListGenerators.fs | 2 +- NightLight.Core.Tests/LightArbitraries.fs | 25 +++++++++++++-- NightLight.Core.Tests/NightLightTests.fs | 32 +++++++++++++++++++ NightLight.Core/Models.fs | 17 ++++++---- NightLight.Core/NightLightStateMachine.fs | 26 +++++++++------ NightLight.Core/ZigbeeEvents.fs | 2 ++ 7 files changed, 91 insertions(+), 19 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index bbbe049..c8ede0a 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -9,6 +9,7 @@ open FSharp.Data type RemoteInteraction = | RemotePressedOnButton | RemotePressedOffButton + | RemotePressedLeftButton type HumanInteraction = | LightPoweredOn of Light @@ -133,6 +134,11 @@ type FakeHome() = Payload = @"{ ""action"": ""off"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger + | RemoteInteraction RemotePressedLeftButton -> + { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" + Payload = @"{ ""action"": ""arrow_left_click"" }" } + |> ReceivedZigbeeEvent + |> onEventPublished.Trigger | TimeChanged newTime -> newTime |> Event.TimeChanged |> onEventPublished.Trigger type FakeHome with diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index 3435eba..d78ef69 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -11,7 +11,7 @@ let private genHumanInteraction biasTowardsLight = |> Gen.map Interaction.HumanInteraction let private genRemoteInteraction = - Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] + Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ] |> Gen.map RemoteInteraction let private genInteraction biasTowardsLight = diff --git a/NightLight.Core.Tests/LightArbitraries.fs b/NightLight.Core.Tests/LightArbitraries.fs index e91e114..026e0b1 100644 --- a/NightLight.Core.Tests/LightArbitraries.fs +++ b/NightLight.Core.Tests/LightArbitraries.fs @@ -9,10 +9,31 @@ type ArbitraryLight = type ArbitraryNonRemotelyControlledLight = static member Light() = lights - |> Seq.filter (not << _.ControlledWithRemote) + |> Seq.filter _.ControlledWithRemote.IsNonRemote + |> Gen.elements + |> Arb.fromGen + +type ArbitraryLeftRemotelyControlledLight = + static member Light() = + lights + |> Seq.filter _.ControlledWithRemote.IsRemoteLeft + |> Gen.elements + |> Arb.fromGen + +type ArbitraryRightRemotelyControlledLight = + static member Light() = + lights + |> Seq.filter _.ControlledWithRemote.IsRemoteRight |> Gen.elements |> Arb.fromGen type ArbitraryRemotelyControlledLight = static member Light() = - lights |> Seq.filter _.ControlledWithRemote |> Gen.elements |> Arb.fromGen + lights + |> Seq.filter (fun light -> + match light.ControlledWithRemote with + | RemoteLeft -> true + | RemoteRight -> true + | NonRemote -> false) + |> Gen.elements + |> Arb.fromGen diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 360932e..c9ceaa9 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -128,3 +128,35 @@ type NightLightTests() = <| fun interactions -> let fakeHome = createFakeHomeWithNightLightAndInteract interactions fakeHome.LightShouldHaveState light _.IsOff + + [ |])>] + let ``After pressing 'Left' on the remote, if the remote isn't used again, all left-side remotely controlled lights with power should be on`` + (light: Light) + = + concatGens + [ genRandomInteractions light + RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant + genRandomInteractionsExcept light _.IsRemoteInteraction ] + |> ensureStartsWithTimeChanged + |> ensureLightHasPower light + |> Arb.fromGen + |> Prop.forAll + <| fun interactions -> + let fakeHome = createFakeHomeWithNightLightAndInteract interactions + fakeHome.LightShouldHaveState light _.IsOn + + [ |])>] + let ``After pressing 'Left' on the remote, if the remote isn't used again and a new day doesn't start, all right-side remotely controlled lights should be off`` + (light: Light) + = + concatGens + [ genRandomInteractions light + RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant + genRandomInteractionsExcept light (fun interaction -> + interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ] + |> ensureStartsWithTimeChanged + |> Arb.fromGen + |> Prop.forAll + <| fun interactions -> + let fakeHome = createFakeHomeWithNightLightAndInteract interactions + fakeHome.LightShouldHaveState light _.IsOff diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 5243bcb..1b1237d 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -40,32 +40,37 @@ type DeviceFriendlyName = match this with | DeviceFriendlyName deviceFriendlyName -> deviceFriendlyName +type LightControl = + | NonRemote + | RemoteLeft + | RemoteRight + type Light = { FriendlyName: DeviceFriendlyName Room: Room Bulb: Bulb - ControlledWithRemote: bool } + ControlledWithRemote: LightControl } let lights = [ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa" Room = LivingRoom Bulb = IkeaBulb - ControlledWithRemote = true } + ControlledWithRemote = RemoteRight } { FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa" Room = LivingRoom Bulb = PaulmannBulb - ControlledWithRemote = false } + ControlledWithRemote = NonRemote } { FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa" Room = LivingRoom Bulb = PaulmannBulb - ControlledWithRemote = false } + ControlledWithRemote = NonRemote } { FriendlyName = DeviceFriendlyName "Badrum - Taklampa" Room = Bathroom Bulb = IkeaBulb - ControlledWithRemote = false } + ControlledWithRemote = NonRemote } { FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa" Room = Bedroom Bulb = IkeaBulb - ControlledWithRemote = true } ] + ControlledWithRemote = RemoteLeft } ] let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll" diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 4de831d..f85212d 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -14,9 +14,9 @@ let internal tryFindLight friendlyName = let internal generateZigbeeCommandsToFixLight state partOfDay (light: Light) = seq { match light.ControlledWithRemote, state with - | true, _ -> yield generateStateCommand state light - | false, On -> () - | false, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled." + | NonRemote, On -> () + | NonRemote, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled." + | _, _ -> yield generateStateCommand state light if state = On then let color, brightness = @@ -32,7 +32,9 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M member this.OnEventReceived(event: Event) : Result = result { let maybePartOfDay = maybeTime |> Option.map getPartOfDay - let remoteControlledLights = lights |> Seq.filter _.ControlledWithRemote + + let remoteControlledLights = + lights |> Seq.filter (not << _.ControlledWithRemote.IsNonRemote) let updateLightStateForRemoteControlledLights desiredLightState = remoteControlledLights @@ -52,16 +54,20 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M | Some light -> generateZigbeeCommandsToFixLight lightToState[light] partOfDay light | None -> Seq.empty | ButtonPress action -> - let desiredLightState = + let newLightToState = match action with - | PressedOn -> On - | PressedOff -> Off - - let newLightToState = updateLightStateForRemoteControlledLights desiredLightState + | PressedOn -> updateLightStateForRemoteControlledLights On + | PressedOff -> updateLightStateForRemoteControlledLights Off + | PressedLeft -> + updateLightStateForRemoteControlledLights Off + |> Map.add + (lights |> Seq.find (fun light -> light.ControlledWithRemote = RemoteLeft)) + On NightLightStateMachine(maybeTime, newLightToState), remoteControlledLights - |> Seq.collect (fun light -> generateZigbeeCommandsToFixLight desiredLightState partOfDay light) + |> Seq.collect (fun light -> + generateZigbeeCommandsToFixLight newLightToState[light] partOfDay light) | TimeChanged newTime, maybePartOfDay -> let newPartOfDay = getPartOfDay newTime diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index 632c6b1..7786a28 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/NightLight.Core/ZigbeeEvents.fs @@ -7,6 +7,7 @@ open FSharp.Data type Action = | PressedOn | PressedOff + | PressedLeft type ZigbeeEvent = | DeviceAnnounce of DeviceFriendlyName @@ -35,6 +36,7 @@ let parseZigbeeEvent (message: Message) = match jsonValue.TryGetProperty "action" with | Some(JsonValue.String "on") -> Ok(ButtonPress PressedOn) | Some(JsonValue.String "off") -> Ok(ButtonPress PressedOff) + | Some(JsonValue.String "arrow_left_click") -> Ok(ButtonPress PressedLeft) | Some _ -> Error InvalidActionField | None -> Error MissingActionField | _ -> return! Error <| UnknownTopic message.Topic From 0d21e81b82821a06ee19b180184b1557dbc27104 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Wed, 14 Jan 2026 19:55:58 +0100 Subject: [PATCH 3/4] Introduce a global remoteControlledLights value --- NightLight.Core.Tests/LightArbitraries.fs | 13 +++---------- NightLight.Core/Models.fs | 3 +++ NightLight.Core/NightLightStateMachine.fs | 6 ++---- 3 files changed, 8 insertions(+), 14 deletions(-) diff --git a/NightLight.Core.Tests/LightArbitraries.fs b/NightLight.Core.Tests/LightArbitraries.fs index 026e0b1..d1de91a 100644 --- a/NightLight.Core.Tests/LightArbitraries.fs +++ b/NightLight.Core.Tests/LightArbitraries.fs @@ -15,25 +15,18 @@ type ArbitraryNonRemotelyControlledLight = type ArbitraryLeftRemotelyControlledLight = static member Light() = - lights + remoteControlledLights |> Seq.filter _.ControlledWithRemote.IsRemoteLeft |> Gen.elements |> Arb.fromGen type ArbitraryRightRemotelyControlledLight = static member Light() = - lights + remoteControlledLights |> Seq.filter _.ControlledWithRemote.IsRemoteRight |> Gen.elements |> Arb.fromGen type ArbitraryRemotelyControlledLight = static member Light() = - lights - |> Seq.filter (fun light -> - match light.ControlledWithRemote with - | RemoteLeft -> true - | RemoteRight -> true - | NonRemote -> false) - |> Gen.elements - |> Arb.fromGen + remoteControlledLights |> Gen.elements |> Arb.fromGen diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 1b1237d..989b2c6 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -73,4 +73,7 @@ let lights = Bulb = IkeaBulb ControlledWithRemote = RemoteLeft } ] +let remoteControlledLights = + lights |> Seq.filter (not << _.ControlledWithRemote.IsNonRemote) + let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll" diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index f85212d..c04ea1f 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -33,9 +33,6 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M result { let maybePartOfDay = maybeTime |> Option.map getPartOfDay - let remoteControlledLights = - lights |> Seq.filter (not << _.ControlledWithRemote.IsNonRemote) - let updateLightStateForRemoteControlledLights desiredLightState = remoteControlledLights |> Seq.fold (fun acc key -> Map.add key desiredLightState acc) lightToState @@ -61,7 +58,8 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M | PressedLeft -> updateLightStateForRemoteControlledLights Off |> Map.add - (lights |> Seq.find (fun light -> light.ControlledWithRemote = RemoteLeft)) + (remoteControlledLights + |> Seq.find (fun light -> light.ControlledWithRemote = RemoteLeft)) On NightLightStateMachine(maybeTime, newLightToState), From 6e4c89c4368758a49fd946b2a3490364991d7be8 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Wed, 14 Jan 2026 19:56:15 +0100 Subject: [PATCH 4/4] Fix room on one of the lamps --- NightLight.Core/Models.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 989b2c6..d37cc9a 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -53,7 +53,7 @@ type Light = let lights = [ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa" - Room = LivingRoom + Room = Bedroom Bulb = IkeaBulb ControlledWithRemote = RemoteRight } { FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa"