From 3507385d6c53b113438f2dd593d9db430847a569 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 15 Mar 2026 10:50:22 +0100 Subject: [PATCH 01/10] LightState -> LightSettings --- NightLight.Core/Models.fs | 2 +- NightLight.Core/NightLightStateMachine.fs | 40 +++++++++++------------ 2 files changed, 21 insertions(+), 21 deletions(-) diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index d0206f7..b7a31ad 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -98,7 +98,7 @@ type internal Color = | ColorByCoordinates of float * float | ColorByTemperature of int -type internal LightState = +type internal LightSettings = { State: State Brightness: Brightness Color: Color } diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 59fdbc5..5fd91a5 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -11,29 +11,29 @@ open FsToolkit.ErrorHandling let internal tryFindLight friendlyName = Seq.tryFind (fun light -> (lightProps light).FriendlyName = friendlyName) lights -let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightState: LightState) = +let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightSettings: LightSettings) = seq { - if desiredLightState.State = Off then - yield generateStateCommand desiredLightState.State light + if desiredLightSettings.State = Off then + yield generateStateCommand desiredLightSettings.State light - if desiredLightState.State = On then - yield generateBrightnessCommand light desiredLightState.Brightness - yield generateColorCommand light desiredLightState.Color + if desiredLightSettings.State = On then + yield generateBrightnessCommand light desiredLightSettings.Brightness + yield generateColorCommand light desiredLightSettings.Color } type internal NightLightState = { Time: DateTime Alarm: bool - LightToState: Map } + LightToLightSettings: Map } let internal createOrUpdateNightLightState (time: DateTime) (alarm: bool) - (maybeOldLightToState: Map option) + (maybeOldLightToLightSettings: Map option) = let partOfDay = getPartOfDay time - let lightToState = + let lightToLightSettings = lights |> Seq.map (fun light -> let color, brightness = @@ -41,8 +41,8 @@ let internal createOrUpdateNightLightState |> getDesiredColorAndBrightness (lightProps light).Bulb let previousState = - maybeOldLightToState - |> Option.map (fun lightToState -> lightToState[light].State) + maybeOldLightToLightSettings + |> Option.map (fun lightToLightSettings -> lightToLightSettings[light].State) |> Option.defaultValue On light, @@ -61,27 +61,27 @@ let internal createOrUpdateNightLightState { Time = time Alarm = alarm - LightToState = lightToState } + LightToLightSettings = lightToLightSettings } let internal withStateFor (light: Light) (state: State) (oldNightLightState: NightLightState) = - let oldState = oldNightLightState.LightToState[light] + let oldState = oldNightLightState.LightToLightSettings[light] createOrUpdateNightLightState oldNightLightState.Time oldNightLightState.Alarm - (Map.add light { oldState with State = state } oldNightLightState.LightToState + (Map.add light { oldState with State = state } oldNightLightState.LightToLightSettings |> Some) let internal withAlarmOff (oldNightLightState: NightLightState) = - createOrUpdateNightLightState oldNightLightState.Time false (Some oldNightLightState.LightToState) + createOrUpdateNightLightState oldNightLightState.Time false (Some oldNightLightState.LightToLightSettings) let internal generateZigbeeCommandsForDifference (maybeBefore: NightLightState option) (after: NightLightState) = - after.LightToState + after.LightToLightSettings |> Seq.collect (fun (KeyValue(light, newState)) -> - let oldState = maybeBefore |> Option.map _.LightToState[light] + let oldState = maybeBefore |> Option.map _.LightToLightSettings[light] if oldState <> Some newState then - generateZigbeeCommandsToFixLight light after.LightToState[light] + generateZigbeeCommandsToFixLight light after.LightToLightSettings[light] else Seq.empty) @@ -101,7 +101,7 @@ type NightLightStateMachine private (maybeState: NightLightState option) = this, match maybeLight with - | Some light -> generateZigbeeCommandsToFixLight light currentState.LightToState[light] + | Some light -> generateZigbeeCommandsToFixLight light currentState.LightToLightSettings[light] | None -> Seq.empty | ButtonPress action -> let newNightLightState = @@ -143,7 +143,7 @@ type NightLightStateMachine private (maybeState: NightLightState option) = || maybeCurrentState |> Option.map _.Alarm |> Option.defaultValue false let newNightLightState = - createOrUpdateNightLightState newTime alarm (maybeCurrentState |> Option.map _.LightToState) + createOrUpdateNightLightState newTime alarm (maybeCurrentState |> Option.map _.LightToLightSettings) return NightLightStateMachine(Some newNightLightState), From 3913522cc3e59b62b01d96e231501b434831ee5a Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 15 Mar 2026 11:18:17 +0100 Subject: [PATCH 02/10] Store a lot less state --- .../InteractionListHelpers.fs | 11 ++- NightLight.Core.Tests/NightLightTests.fs | 20 +---- NightLight.Core/NightLightStateMachine.fs | 88 ++++++++----------- 3 files changed, 49 insertions(+), 70 deletions(-) diff --git a/NightLight.Core.Tests/InteractionListHelpers.fs b/NightLight.Core.Tests/InteractionListHelpers.fs index ca2198d..8d7f8ae 100644 --- a/NightLight.Core.Tests/InteractionListHelpers.fs +++ b/NightLight.Core.Tests/InteractionListHelpers.fs @@ -36,12 +36,17 @@ let doesLightHavePowerAfterInteractions light interactions = |> Seq.tryLast |> Option.defaultValue false -let tryGetLastRemoteInteraction interactions = +let tryGetLastBedroomRemoteInteraction interactions = interactions |> Seq.indexed - |> Seq.choose (fun interaction -> + |> Seq.choose (fun (index, interaction) -> match interaction with - | index, Interaction.RemoteInteraction remoteInteraction -> Some(index, remoteInteraction) + | Interaction.RemoteInteraction remoteInteraction -> + match remoteInteraction with + | RemotePressedOnButton + | RemotePressedOffButton + | RemotePressedLeftButton -> Some(index, remoteInteraction) + | RemotePressedRightButton -> None | _ -> None) |> Seq.tryLast diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 99f323b..14e89c5 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -41,13 +41,13 @@ type NightLightTests() = |> Prop.label fakeHome.Label |> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0) - [ |])>] + [ |], MaxTest = 500)>] let ``All lights should either be off or have a brightness that fits its color`` (interactions: Interaction list) = let fakeHome = createFakeHomeWithNightLightAndInteract interactions let time = getTimeAfterInteractions interactions |> _.TimeOfDay let alarm = - hasNewDayStartedSince interactions (tryGetLastRemoteInteraction interactions) + hasNewDayStartedSince interactions (tryGetLastBedroomRemoteInteraction interactions) && startOfDay <= time && time <= endOfAlarm @@ -81,7 +81,7 @@ type NightLightTests() = |> Prop.label fakeHome.Label |> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0) - [ |])>] + [ |], MaxTest = 500)>] let ``All lights with power should have the correct state`` (interactions: Interaction list) = let fakeHome = createFakeHomeWithNightLightAndInteract interactions @@ -90,19 +90,7 @@ type NightLightTests() = |> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions) |> Seq.toList - let lastBedroomRemoteInteraction = - interactions - |> Seq.indexed - |> Seq.choose (fun (index, interaction) -> - match interaction with - | Interaction.RemoteInteraction remoteInteraction -> - match remoteInteraction with - | RemotePressedOnButton - | RemotePressedOffButton - | RemotePressedLeftButton -> Some(index, remoteInteraction) - | RemotePressedRightButton -> None - | _ -> None) - |> Seq.tryLast + let lastBedroomRemoteInteraction = tryGetLastBedroomRemoteInteraction interactions let newDayStartedSinceBedroomRemote = hasNewDayStartedSince interactions lastBedroomRemoteInteraction diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 5fd91a5..bbab1d8 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -24,64 +24,43 @@ let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightSettin type internal NightLightState = { Time: DateTime Alarm: bool - LightToLightSettings: Map } + LightToManualState: Map } -let internal createOrUpdateNightLightState - (time: DateTime) - (alarm: bool) - (maybeOldLightToLightSettings: Map option) - = - let partOfDay = getPartOfDay time +let internal computeLightSettings (light: Light) (nightLightState: NightLightState) = + let partOfDay = getPartOfDay nightLightState.Time - let lightToLightSettings = - lights - |> Seq.map (fun light -> - let color, brightness = - getDesiredMood (lightProps light).Room partOfDay - |> getDesiredColorAndBrightness (lightProps light).Bulb + let color, brightness = + getDesiredMood (lightProps light).Room partOfDay + |> getDesiredColorAndBrightness (lightProps light).Bulb - let previousState = - maybeOldLightToLightSettings - |> Option.map (fun lightToLightSettings -> lightToLightSettings[light].State) - |> Option.defaultValue On - - light, - { Color = color - Brightness = - if alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then - brightness.Scale(getAlarmWeight time) - else - brightness - State = - if alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then - On - else - previousState }) - |> Map.ofSeq - - { Time = time - Alarm = alarm - LightToLightSettings = lightToLightSettings } + { Color = color + Brightness = + if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then + brightness.Scale(getAlarmWeight nightLightState.Time) + else + brightness + State = + if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then + On + else + nightLightState.LightToManualState[light] } let internal withStateFor (light: Light) (state: State) (oldNightLightState: NightLightState) = - let oldState = oldNightLightState.LightToLightSettings[light] - - createOrUpdateNightLightState - oldNightLightState.Time - oldNightLightState.Alarm - (Map.add light { oldState with State = state } oldNightLightState.LightToLightSettings - |> Some) + { oldNightLightState with + LightToManualState = Map.add light state oldNightLightState.LightToManualState } let internal withAlarmOff (oldNightLightState: NightLightState) = - createOrUpdateNightLightState oldNightLightState.Time false (Some oldNightLightState.LightToLightSettings) + { oldNightLightState with + Alarm = false } let internal generateZigbeeCommandsForDifference (maybeBefore: NightLightState option) (after: NightLightState) = - after.LightToLightSettings - |> Seq.collect (fun (KeyValue(light, newState)) -> - let oldState = maybeBefore |> Option.map _.LightToLightSettings[light] + lights + |> Seq.collect (fun light -> + let oldLightSettings = maybeBefore |> Option.map (computeLightSettings light) + let newLightSettings = after |> computeLightSettings light - if oldState <> Some newState then - generateZigbeeCommandsToFixLight light after.LightToLightSettings[light] + if oldLightSettings <> Some newLightSettings then + generateZigbeeCommandsToFixLight light newLightSettings else Seq.empty) @@ -101,7 +80,10 @@ type NightLightStateMachine private (maybeState: NightLightState option) = this, match maybeLight with - | Some light -> generateZigbeeCommandsToFixLight light currentState.LightToLightSettings[light] + | Some light -> + currentState + |> computeLightSettings light + |> generateZigbeeCommandsToFixLight light | None -> Seq.empty | ButtonPress action -> let newNightLightState = @@ -123,7 +105,6 @@ type NightLightStateMachine private (maybeState: NightLightState option) = |> withStateFor LeftBedroomLamp On | PressedRight -> currentState - |> withAlarmOff |> withStateFor LivingRoomWallLamp Off |> withStateFor LivingRoomFloorLamp Off @@ -143,7 +124,12 @@ type NightLightStateMachine private (maybeState: NightLightState option) = || maybeCurrentState |> Option.map _.Alarm |> Option.defaultValue false let newNightLightState = - createOrUpdateNightLightState newTime alarm (maybeCurrentState |> Option.map _.LightToLightSettings) + { Time = newTime + Alarm = alarm + LightToManualState = + maybeCurrentState + |> Option.map _.LightToManualState + |> Option.defaultValue (lights |> Seq.map (fun light -> light, On) |> Map.ofSeq) } return NightLightStateMachine(Some newNightLightState), From 1dc1faa16a23f2a849f785f065fd613a707ebb7e Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 15 Mar 2026 11:33:26 +0100 Subject: [PATCH 03/10] Improve types for remote button presses in tests --- NightLight.Core.Tests/FakeHome.fs | 16 +++++++++------- .../InteractionListGenerators.fs | 11 +++++------ NightLight.Core.Tests/InteractionListHelpers.fs | 10 +++------- NightLight.Core.Tests/NightLightTests.fs | 15 ++++++++------- 4 files changed, 25 insertions(+), 27 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 65bfc62..6642cc3 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -6,11 +6,12 @@ open NightLight.Core.Models open FsToolkit.ErrorHandling open FSharp.Data -type RemoteInteraction = +type BedroomControllingRemoteInteraction = | RemotePressedOnButton | RemotePressedOffButton | RemotePressedLeftButton - | RemotePressedRightButton + +type LivingRoomControllingRemoteAction = | RemotePressedRightButton type HumanInteraction = | LightPoweredOn of Light @@ -18,7 +19,8 @@ type HumanInteraction = type Interaction = | HumanInteraction of HumanInteraction - | RemoteInteraction of RemoteInteraction + | BedroomControllingRemoteInteraction of BedroomControllingRemoteInteraction + | LivingRoomControllingRemoteInteraction of LivingRoomControllingRemoteAction | TimeChanged of DateTime type Color = @@ -123,22 +125,22 @@ type FakeHome() = |> ReceivedZigbeeEvent |> onEventPublished.Trigger | HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[(lightProps light).FriendlyName].PowerOff() - | RemoteInteraction RemotePressedOnButton -> + | BedroomControllingRemoteInteraction RemotePressedOnButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""on"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | RemoteInteraction RemotePressedOffButton -> + | BedroomControllingRemoteInteraction RemotePressedOffButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""off"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | RemoteInteraction RemotePressedLeftButton -> + | BedroomControllingRemoteInteraction RemotePressedLeftButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""arrow_left_click"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | RemoteInteraction RemotePressedRightButton -> + | LivingRoomControllingRemoteInteraction RemotePressedRightButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""arrow_right_click"" }" } |> ReceivedZigbeeEvent diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index 7b7b484..a0b29df 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -36,12 +36,11 @@ let private genHumanInteraction = |> Gen.map Interaction.HumanInteraction let private genRemoteInteraction = - Gen.elements - [ RemotePressedOnButton - RemotePressedOffButton - RemotePressedLeftButton - RemotePressedRightButton ] - |> Gen.map RemoteInteraction + Gen.oneof + [ Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ] + |> Gen.map BedroomControllingRemoteInteraction + + Gen.constant (LivingRoomControllingRemoteInteraction RemotePressedRightButton) ] let private genInteraction = Gen.frequency [ 4, genTimeChanged; 1, genHumanInteraction; 1, genRemoteInteraction ] diff --git a/NightLight.Core.Tests/InteractionListHelpers.fs b/NightLight.Core.Tests/InteractionListHelpers.fs index 8d7f8ae..958157d 100644 --- a/NightLight.Core.Tests/InteractionListHelpers.fs +++ b/NightLight.Core.Tests/InteractionListHelpers.fs @@ -36,17 +36,13 @@ let doesLightHavePowerAfterInteractions light interactions = |> Seq.tryLast |> Option.defaultValue false -let tryGetLastBedroomRemoteInteraction interactions = +let tryGetLastBedroomControllingRemoteInteraction interactions = interactions |> Seq.indexed |> Seq.choose (fun (index, interaction) -> match interaction with - | Interaction.RemoteInteraction remoteInteraction -> - match remoteInteraction with - | RemotePressedOnButton - | RemotePressedOffButton - | RemotePressedLeftButton -> Some(index, remoteInteraction) - | RemotePressedRightButton -> None + | Interaction.BedroomControllingRemoteInteraction bedroomRemoteInteraction -> + Some(index, bedroomRemoteInteraction) | _ -> None) |> Seq.tryLast diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 14e89c5..96d2ec4 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -47,7 +47,7 @@ type NightLightTests() = let time = getTimeAfterInteractions interactions |> _.TimeOfDay let alarm = - hasNewDayStartedSince interactions (tryGetLastBedroomRemoteInteraction interactions) + hasNewDayStartedSince interactions (tryGetLastBedroomControllingRemoteInteraction interactions) && startOfDay <= time && time <= endOfAlarm @@ -90,15 +90,16 @@ type NightLightTests() = |> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions) |> Seq.toList - let lastBedroomRemoteInteraction = tryGetLastBedroomRemoteInteraction interactions + let lastBedroomControllingRemoteInteraction = + tryGetLastBedroomControllingRemoteInteraction interactions let newDayStartedSinceBedroomRemote = - hasNewDayStartedSince interactions lastBedroomRemoteInteraction + hasNewDayStartedSince interactions lastBedroomControllingRemoteInteraction let hasPressedRight = interactions |> Seq.exists (function - | Interaction.RemoteInteraction RemotePressedRightButton -> true + | Interaction.LivingRoomControllingRemoteInteraction RemotePressedRightButton -> true | _ -> false) let isExpectedOn light = @@ -108,11 +109,10 @@ type NightLightTests() = if newDayStartedSinceBedroomRemote then true else - match lastBedroomRemoteInteraction with + match lastBedroomControllingRemoteInteraction with | Some(_, RemotePressedOffButton) -> false | Some(_, RemotePressedLeftButton) -> light = LeftBedroomLamp | Some(_, RemotePressedOnButton) -> true - | Some(_, RemotePressedRightButton) -> failwith "unexpected" | None -> true | LivingRoomWallLamp | LivingRoomFloorLamp -> not hasPressedRight @@ -120,7 +120,8 @@ type NightLightTests() = lightsWithPower |> Seq.forall (fun (light, state) -> state.IsOn = isExpectedOn light) - |> Prop.collect $"last bedroom remote interaction is {lastBedroomRemoteInteraction |> Option.map snd}" + |> Prop.collect + $"last bedroom controlling remote interaction is {lastBedroomControllingRemoteInteraction |> Option.map snd}" |> Prop.collect $"pressed right: {hasPressedRight}" |> Prop.collect $"{lightsWithPower.Length} light(s) with power" |> Prop.classify newDayStartedSinceBedroomRemote "new day since bedroom remote" From 48c58b610c7a11bb98334e34e6d9267cd2cd8565 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 15 Mar 2026 11:49:27 +0100 Subject: [PATCH 04/10] Make the Right button toggle the living room lights --- NightLight.Core.Tests/NightLightTests.fs | 10 ++++++---- NightLight.Core/Models.fs | 5 +++++ NightLight.Core/NightLightStateMachine.fs | 8 ++++++-- 3 files changed, 17 insertions(+), 6 deletions(-) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 96d2ec4..f6946c7 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -96,11 +96,13 @@ type NightLightTests() = let newDayStartedSinceBedroomRemote = hasNewDayStartedSince interactions lastBedroomControllingRemoteInteraction - let hasPressedRight = + let livingRoomLightsToggledOn = interactions - |> Seq.exists (function + |> Seq.filter (function | Interaction.LivingRoomControllingRemoteInteraction RemotePressedRightButton -> true | _ -> false) + |> Seq.length + |> fun rightPresses -> rightPresses % 2 = 0 let isExpectedOn light = match light with @@ -115,15 +117,15 @@ type NightLightTests() = | Some(_, RemotePressedOnButton) -> true | None -> true | LivingRoomWallLamp - | LivingRoomFloorLamp -> not hasPressedRight + | LivingRoomFloorLamp -> livingRoomLightsToggledOn | BathroomCeilingLamp -> true lightsWithPower |> Seq.forall (fun (light, state) -> state.IsOn = isExpectedOn light) |> Prop.collect $"last bedroom controlling remote interaction is {lastBedroomControllingRemoteInteraction |> Option.map snd}" - |> Prop.collect $"pressed right: {hasPressedRight}" |> Prop.collect $"{lightsWithPower.Length} light(s) with power" + |> Prop.classify livingRoomLightsToggledOn "living room lights toggled on" |> Prop.classify newDayStartedSinceBedroomRemote "new day since bedroom remote" |> Prop.label fakeHome.Label |> Prop.trivial (lightsWithPower.Length = 0) diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index b7a31ad..122429b 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -87,6 +87,11 @@ type internal State = | On | Off + member this.Invert() = + match this with + | On -> Off + | Off -> On + type internal Brightness = | Brightness of int diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index bbab1d8..a09c418 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -49,6 +49,10 @@ let internal withStateFor (light: Light) (state: State) (oldNightLightState: Nig { oldNightLightState with LightToManualState = Map.add light state oldNightLightState.LightToManualState } +let internal withInvertedStateFor (light: Light) (oldNightLightState: NightLightState) = + oldNightLightState + |> withStateFor light (oldNightLightState.LightToManualState[light].Invert()) + let internal withAlarmOff (oldNightLightState: NightLightState) = { oldNightLightState with Alarm = false } @@ -105,8 +109,8 @@ type NightLightStateMachine private (maybeState: NightLightState option) = |> withStateFor LeftBedroomLamp On | PressedRight -> currentState - |> withStateFor LivingRoomWallLamp Off - |> withStateFor LivingRoomFloorLamp Off + |> withInvertedStateFor LivingRoomWallLamp + |> withInvertedStateFor LivingRoomFloorLamp NightLightStateMachine(Some newNightLightState), generateZigbeeCommandsForDifference (Some currentState) newNightLightState From 8cde891ba26348fdf0ba822790d476a2763bd687 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 15 Mar 2026 17:31:50 +0100 Subject: [PATCH 05/10] Add second remote --- NightLight.Core.Tests/FakeHome.fs | 15 ++++++++++++++- .../InteractionListGenerators.fs | 6 +++++- NightLight.Core.Tests/NightLightTests.fs | 15 ++++++++++----- NightLight.Core/Models.fs | 2 ++ NightLight.Core/NightLightStateMachine.fs | 8 ++++++++ NightLight.Core/ZigbeeCommands.fs | 3 +-- NightLight.Core/ZigbeeEvents.fs | 9 +++++++++ NightLight/Program.fs | 4 ++-- 8 files changed, 51 insertions(+), 11 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 6642cc3..f7042b7 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -11,7 +11,10 @@ type BedroomControllingRemoteInteraction = | RemotePressedOffButton | RemotePressedLeftButton -type LivingRoomControllingRemoteAction = | RemotePressedRightButton +type LivingRoomControllingRemoteAction = + | RemotePressedRightButton + | LivingRoomRemotePressedOnButton + | LivingRoomRemotePressedOffButton type HumanInteraction = | LightPoweredOn of Light @@ -145,6 +148,16 @@ type FakeHome() = Payload = @"{ ""action"": ""arrow_right_click"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger + | LivingRoomControllingRemoteInteraction LivingRoomRemotePressedOnButton -> + { Topic = $"zigbee2mqtt/{livingRoomRemoteControlFriendlyName.Get}" + Payload = @"{ ""action"": ""on"" }" } + |> ReceivedZigbeeEvent + |> onEventPublished.Trigger + | LivingRoomControllingRemoteInteraction LivingRoomRemotePressedOffButton -> + { Topic = $"zigbee2mqtt/{livingRoomRemoteControlFriendlyName.Get}" + Payload = @"{ ""action"": ""off"" }" } + |> 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 a0b29df..cdd72d1 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -40,7 +40,11 @@ let private genRemoteInteraction = [ Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ] |> Gen.map BedroomControllingRemoteInteraction - Gen.constant (LivingRoomControllingRemoteInteraction RemotePressedRightButton) ] + Gen.elements + [ RemotePressedRightButton + LivingRoomRemotePressedOnButton + LivingRoomRemotePressedOffButton ] + |> Gen.map LivingRoomControllingRemoteInteraction ] let private genInteraction = Gen.frequency [ 4, genTimeChanged; 1, genHumanInteraction; 1, genRemoteInteraction ] diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index f6946c7..6ffcb01 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -98,11 +98,16 @@ type NightLightTests() = let livingRoomLightsToggledOn = interactions - |> Seq.filter (function - | Interaction.LivingRoomControllingRemoteInteraction RemotePressedRightButton -> true - | _ -> false) - |> Seq.length - |> fun rightPresses -> rightPresses % 2 = 0 + |> Seq.choose (function + | Interaction.LivingRoomControllingRemoteInteraction interaction -> Some interaction + | _ -> None) + |> Seq.fold + (fun state interaction -> + match interaction with + | RemotePressedRightButton -> not state + | LivingRoomRemotePressedOnButton -> true + | LivingRoomRemotePressedOffButton -> false) + true let isExpectedOn light = match light with diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 122429b..7d03e45 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -83,6 +83,8 @@ let lights = let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll" +let livingRoomRemoteControlFriendlyName = DeviceFriendlyName "Living Room Remote" + type internal State = | On | Off diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index a09c418..4ed8d9e 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -111,6 +111,14 @@ type NightLightStateMachine private (maybeState: NightLightState option) = currentState |> withInvertedStateFor LivingRoomWallLamp |> withInvertedStateFor LivingRoomFloorLamp + | PressedLivingRoomOn -> + currentState + |> withStateFor LivingRoomWallLamp On + |> withStateFor LivingRoomFloorLamp On + | PressedLivingRoomOff -> + currentState + |> withStateFor LivingRoomWallLamp Off + |> withStateFor LivingRoomFloorLamp Off NightLightStateMachine(Some newNightLightState), generateZigbeeCommandsForDifference (Some currentState) newNightLightState diff --git a/NightLight.Core/ZigbeeCommands.fs b/NightLight.Core/ZigbeeCommands.fs index dd13aff..9f16656 100644 --- a/NightLight.Core/ZigbeeCommands.fs +++ b/NightLight.Core/ZigbeeCommands.fs @@ -15,8 +15,7 @@ let generateStateCommand state light = | On -> "ON" | Off -> "OFF" - if (lightProps light).Bulb = IkeaBulb then - commandObj["transition"] <- 0 + commandObj["transition"] <- 0 commandObj.ToJsonString() |> toZigbeeCommand light diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index 13e4301..700df43 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/NightLight.Core/ZigbeeEvents.fs @@ -9,6 +9,8 @@ type Action = | PressedOff | PressedLeft | PressedRight + | PressedLivingRoomOn + | PressedLivingRoomOff type ZigbeeEvent = | DeviceAnnounce of DeviceFriendlyName @@ -41,5 +43,12 @@ let parseZigbeeEvent (message: Message) = | Some(JsonValue.String "arrow_right_click") -> Ok(ButtonPress PressedRight) | Some _ -> Error InvalidActionField | None -> Error MissingActionField + | "zigbee2mqtt/Living Room Remote" -> + return! + match jsonValue.TryGetProperty "action" with + | Some(JsonValue.String "on") -> Ok(ButtonPress PressedLivingRoomOn) + | Some(JsonValue.String "off") -> Ok(ButtonPress PressedLivingRoomOff) + | Some _ -> Error InvalidActionField + | None -> Error MissingActionField | _ -> return! Error <| UnknownTopic message.Topic } diff --git a/NightLight/Program.fs b/NightLight/Program.fs index eecfc4b..e011f3b 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -1,4 +1,4 @@ -open System +open System open System.Text open System.Threading open System.Threading.Tasks @@ -103,7 +103,7 @@ let mainAsync _ = :> Task) do! - [ "zigbee2mqtt/bridge/event"; $"zigbee2mqtt/{remoteControlFriendlyName.Get}" ] + [ "zigbee2mqtt/bridge/event"; $"zigbee2mqtt/{remoteControlFriendlyName.Get}"; $"zigbee2mqtt/{livingRoomRemoteControlFriendlyName.Get}" ] |> Seq.map (fun topic -> async { return! mqttClient.SubscribeAsync topic |> Async.AwaitTask }) |> Async.Sequential |> Async.Ignore From 0c964719d9d831321cb0c033aac8da0b8c0c5010 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 16 Mar 2026 19:24:37 +0100 Subject: [PATCH 06/10] Improve variable name --- NightLight.Core.Tests/NightLightTests.fs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 6ffcb01..5a99241 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -93,7 +93,7 @@ type NightLightTests() = let lastBedroomControllingRemoteInteraction = tryGetLastBedroomControllingRemoteInteraction interactions - let newDayStartedSinceBedroomRemote = + let newDayStartedSinceLastBedroomControllingRemoteInteraction = hasNewDayStartedSince interactions lastBedroomControllingRemoteInteraction let livingRoomLightsToggledOn = @@ -113,7 +113,7 @@ type NightLightTests() = match light with | LeftBedroomLamp | RightBedroomLamp -> - if newDayStartedSinceBedroomRemote then + if newDayStartedSinceLastBedroomControllingRemoteInteraction then true else match lastBedroomControllingRemoteInteraction with @@ -131,6 +131,8 @@ type NightLightTests() = $"last bedroom controlling remote interaction is {lastBedroomControllingRemoteInteraction |> Option.map snd}" |> Prop.collect $"{lightsWithPower.Length} light(s) with power" |> Prop.classify livingRoomLightsToggledOn "living room lights toggled on" - |> Prop.classify newDayStartedSinceBedroomRemote "new day since bedroom remote" + |> Prop.classify + newDayStartedSinceLastBedroomControllingRemoteInteraction + "new day started since last bedroom controlling remote interaction" |> Prop.label fakeHome.Label |> Prop.trivial (lightsWithPower.Length = 0) From 6e6a600e3c217406b7037bfa49c77ade97d69d43 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 16 Mar 2026 19:35:17 +0100 Subject: [PATCH 07/10] Refactor tests to prepare for stateful bedroom On button --- NightLight.Core.Tests/NightLightTests.fs | 38 +++++++++++++++++------- 1 file changed, 27 insertions(+), 11 deletions(-) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 5a99241..cfbc25f 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -7,6 +7,12 @@ open NightLight.Core.Models open FsCheck.Xunit open FsCheck.FSharp +type private BedroomLightsCycle = + | BothOff + | BothOn + | LeftOn + | RightOn + type NightLightTests() = let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) = let mutable nightLightStateMachine = NightLightStateMachine() @@ -109,27 +115,37 @@ type NightLightTests() = | LivingRoomRemotePressedOffButton -> false) true + let bedroomLightsCycle = + interactions + |> Seq.choose (function + | Interaction.BedroomControllingRemoteInteraction interaction -> Some interaction + | _ -> None) + |> Seq.fold + (fun state interaction -> + match state, interaction with + | _, RemotePressedOffButton -> BothOff + | _, RemotePressedOnButton -> BothOn + | _, RemotePressedLeftButton -> LeftOn) + BothOn + let isExpectedOn light = match light with - | LeftBedroomLamp + | LeftBedroomLamp -> + newDayStartedSinceLastBedroomControllingRemoteInteraction + || bedroomLightsCycle = BothOn + || bedroomLightsCycle = LeftOn | RightBedroomLamp -> - if newDayStartedSinceLastBedroomControllingRemoteInteraction then - true - else - match lastBedroomControllingRemoteInteraction with - | Some(_, RemotePressedOffButton) -> false - | Some(_, RemotePressedLeftButton) -> light = LeftBedroomLamp - | Some(_, RemotePressedOnButton) -> true - | None -> true + newDayStartedSinceLastBedroomControllingRemoteInteraction + || bedroomLightsCycle = BothOn + || bedroomLightsCycle = RightOn | LivingRoomWallLamp | LivingRoomFloorLamp -> livingRoomLightsToggledOn | BathroomCeilingLamp -> true lightsWithPower |> Seq.forall (fun (light, state) -> state.IsOn = isExpectedOn light) - |> Prop.collect - $"last bedroom controlling remote interaction is {lastBedroomControllingRemoteInteraction |> Option.map snd}" |> Prop.collect $"{lightsWithPower.Length} light(s) with power" + |> Prop.collect $"bedroom lights cycle = {bedroomLightsCycle}" |> Prop.classify livingRoomLightsToggledOn "living room lights toggled on" |> Prop.classify newDayStartedSinceLastBedroomControllingRemoteInteraction From 451d8b09f1592f0accc43c68663e7248c5df82d4 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 16 Mar 2026 19:56:02 +0100 Subject: [PATCH 08/10] Make the 'On' button cycle between lights --- NightLight.Core.Tests/NightLightTests.fs | 5 ++++- NightLight.Core/NightLightStateMachine.fs | 9 +++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index cfbc25f..c1aab89 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -124,7 +124,10 @@ type NightLightTests() = (fun state interaction -> match state, interaction with | _, RemotePressedOffButton -> BothOff - | _, RemotePressedOnButton -> BothOn + | BothOff, RemotePressedOnButton -> BothOn + | BothOn, RemotePressedOnButton -> LeftOn + | LeftOn, RemotePressedOnButton -> RightOn + | RightOn, RemotePressedOnButton -> BothOn | _, RemotePressedLeftButton -> LeftOn) BothOn diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 4ed8d9e..73a3169 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -95,8 +95,13 @@ type NightLightStateMachine private (maybeState: NightLightState option) = | PressedOn -> currentState |> withAlarmOff - |> withStateFor RightBedroomLamp On - |> withStateFor LeftBedroomLamp On + |> match + currentState.LightToManualState[LeftBedroomLamp], + currentState.LightToManualState[RightBedroomLamp] + with + | Off, _ -> withStateFor LeftBedroomLamp On >> withStateFor RightBedroomLamp On + | On, On -> withStateFor LeftBedroomLamp On >> withStateFor RightBedroomLamp Off + | On, Off -> withStateFor LeftBedroomLamp Off >> withStateFor RightBedroomLamp On | PressedOff -> currentState |> withAlarmOff From 5d8406d8ad1738ce1f55f45f4cac73e4ac6a122a Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 16 Mar 2026 19:58:53 +0100 Subject: [PATCH 09/10] Make the Left and Right button behave the same way --- NightLight.Core.Tests/FakeHome.fs | 4 ++-- NightLight.Core.Tests/InteractionListGenerators.fs | 5 +++-- NightLight.Core.Tests/NightLightTests.fs | 4 ++-- NightLight.Core/NightLightStateMachine.fs | 6 +----- 4 files changed, 8 insertions(+), 11 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index f7042b7..a1c64bc 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -9,9 +9,9 @@ open FSharp.Data type BedroomControllingRemoteInteraction = | RemotePressedOnButton | RemotePressedOffButton - | RemotePressedLeftButton type LivingRoomControllingRemoteAction = + | RemotePressedLeftButton | RemotePressedRightButton | LivingRoomRemotePressedOnButton | LivingRoomRemotePressedOffButton @@ -138,7 +138,7 @@ type FakeHome() = Payload = @"{ ""action"": ""off"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | BedroomControllingRemoteInteraction RemotePressedLeftButton -> + | LivingRoomControllingRemoteInteraction RemotePressedLeftButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""arrow_left_click"" }" } |> ReceivedZigbeeEvent diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index cdd72d1..e8cbdf8 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -37,11 +37,12 @@ let private genHumanInteraction = let private genRemoteInteraction = Gen.oneof - [ Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ] + [ Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] |> Gen.map BedroomControllingRemoteInteraction Gen.elements - [ RemotePressedRightButton + [ RemotePressedLeftButton + RemotePressedRightButton LivingRoomRemotePressedOnButton LivingRoomRemotePressedOffButton ] |> Gen.map LivingRoomControllingRemoteInteraction ] diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index c1aab89..7ad546b 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -110,6 +110,7 @@ type NightLightTests() = |> Seq.fold (fun state interaction -> match interaction with + | RemotePressedLeftButton -> not state | RemotePressedRightButton -> not state | LivingRoomRemotePressedOnButton -> true | LivingRoomRemotePressedOffButton -> false) @@ -127,8 +128,7 @@ type NightLightTests() = | BothOff, RemotePressedOnButton -> BothOn | BothOn, RemotePressedOnButton -> LeftOn | LeftOn, RemotePressedOnButton -> RightOn - | RightOn, RemotePressedOnButton -> BothOn - | _, RemotePressedLeftButton -> LeftOn) + | RightOn, RemotePressedOnButton -> BothOn) BothOn let isExpectedOn light = diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 73a3169..1c75b0b 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -107,11 +107,7 @@ type NightLightStateMachine private (maybeState: NightLightState option) = |> withAlarmOff |> withStateFor RightBedroomLamp Off |> withStateFor LeftBedroomLamp Off - | PressedLeft -> - currentState - |> withAlarmOff - |> withStateFor RightBedroomLamp Off - |> withStateFor LeftBedroomLamp On + | PressedLeft | PressedRight -> currentState |> withInvertedStateFor LivingRoomWallLamp From c09915ac604e76090d311019fa16697221c989a5 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Mon, 16 Mar 2026 20:01:10 +0100 Subject: [PATCH 10/10] Stop hardcoding elements --- NightLight.Core.Tests/InteractionListGenerators.fs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index e8cbdf8..42d0f5f 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -37,14 +37,12 @@ let private genHumanInteraction = let private genRemoteInteraction = Gen.oneof - [ Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] + [ ArbMap.defaults + |> ArbMap.generate |> Gen.map BedroomControllingRemoteInteraction - Gen.elements - [ RemotePressedLeftButton - RemotePressedRightButton - LivingRoomRemotePressedOnButton - LivingRoomRemotePressedOffButton ] + ArbMap.defaults + |> ArbMap.generate |> Gen.map LivingRoomControllingRemoteInteraction ] let private genInteraction =