From 2950b21488c83cdbc4b9876ea5d5f740d2ea6a87 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Wed, 14 Jan 2026 19:49:34 +0100 Subject: [PATCH] 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