svenvanheugten/night-light
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #11 from svenvanheugten/half-off

Browse source 
Implement the "Left" button on the remote
This commit is contained in:
Sven van Heugten 2026-01-14 20:04:40 +01:00 • committed by GitHub
commit d098dfc822
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
7 changed files with 108 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

17
NightLight.Core.Tests/FakeHome.fs
View file

@ -6,14 +6,18 @@ open NightLight.Core.Models
open FsToolkit.ErrorHandling
open FSharp.Data
type RemoteInteraction =
| RemotePressedOnButton
| RemotePressedOffButton
| RemotePressedLeftButton
type HumanInteraction =
| LightPoweredOn of Light
| LightPoweredOff of Light
| RemotePressedOnButton
| RemotePressedOffButton
type Interaction =
| HumanInteraction of HumanInteraction
| RemoteInteraction of RemoteInteraction
| TimeChanged of DateTime
type Color =
@ -120,16 +124,21 @@ 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
|> 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

14
NightLight.Core.Tests/InteractionListGenerators.fs
View file

@ -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; RemotePressedLeftButton ]
|> Gen.map RemoteInteraction
let private genInteraction biasTowardsLight =
Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight ]

18
NightLight.Core.Tests/LightArbitraries.fs
View file

@ -9,10 +9,24 @@ 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() =
remoteControlledLights
|> Seq.filter _.ControlledWithRemote.IsRemoteLeft
|> Gen.elements
|> Arb.fromGen
type ArbitraryRightRemotelyControlledLight =
static member Light() =
remoteControlledLights
|> Seq.filter _.ControlledWithRemote.IsRemoteRight
|> Gen.elements
|> Arb.fromGen
type ArbitraryRemotelyControlledLight =
static member Light() =
lights |> Seq.filter _.ControlledWithRemote |> Gen.elements |> Arb.fromGen
remoteControlledLights |> Gen.elements |> Arb.fromGen

55
NightLight.Core.Tests/NightLightTests.fs
View file

@ -69,10 +69,8 @@ type NightLightTests() =
fakeHome.LightShouldHaveState light _.IsOn
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
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
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
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
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
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,46 @@ type NightLightTests() =
fakeHome.LightShouldHaveState light _.IsOn
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
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
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOff
[<Property(Arbitrary = [| typeof<ArbitraryLeftRemotelyControlledLight> |])>]
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
[<Property(Arbitrary = [| typeof<ArbitraryRightRemotelyControlledLight> |])>]
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

22
NightLight.Core/Models.fs
View file

@ -40,32 +40,40 @@ 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
Room = Bedroom
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 remoteControlledLights =
lights |> Seq.filter (not << _.ControlledWithRemote.IsNonRemote)
let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll"

24
NightLight.Core/NightLightStateMachine.fs
View file

@ -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,6 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M
member this.OnEventReceived(event: Event) : Result<NightLightStateMachine * Message seq, OnEventReceivedError> =
result {
let maybePartOfDay = maybeTime |> Option.map getPartOfDay
let remoteControlledLights = lights |> Seq.filter _.ControlledWithRemote
let updateLightStateForRemoteControlledLights desiredLightState =
remoteControlledLights
@ -52,16 +51,21 @@ 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
(remoteControlledLights
|> 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

2
NightLight.Core/ZigbeeEvents.fs
View file

@ -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