Implement the 'Left' button on the remote

This commit is contained in:
Sven van Heugten 2026-01-14 19:49:34 +01:00
parent 6ecb6d07ac
commit 2950b21488
7 changed files with 91 additions and 19 deletions

View file

@ -9,6 +9,7 @@ open FSharp.Data
type RemoteInteraction = type RemoteInteraction =
| RemotePressedOnButton | RemotePressedOnButton
| RemotePressedOffButton | RemotePressedOffButton
| RemotePressedLeftButton
type HumanInteraction = type HumanInteraction =
| LightPoweredOn of Light | LightPoweredOn of Light
@ -133,6 +134,11 @@ type FakeHome() =
Payload = @"{ ""action"": ""off"" }" } Payload = @"{ ""action"": ""off"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| RemoteInteraction RemotePressedLeftButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""arrow_left_click"" }" }
|> ReceivedZigbeeEvent
|> onEventPublished.Trigger
| TimeChanged newTime -> newTime |> Event.TimeChanged |> onEventPublished.Trigger | TimeChanged newTime -> newTime |> Event.TimeChanged |> onEventPublished.Trigger
type FakeHome with type FakeHome with

View file

@ -11,7 +11,7 @@ let private genHumanInteraction biasTowardsLight =
|> Gen.map Interaction.HumanInteraction |> Gen.map Interaction.HumanInteraction
let private genRemoteInteraction = let private genRemoteInteraction =
Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ]
|> Gen.map RemoteInteraction |> Gen.map RemoteInteraction
let private genInteraction biasTowardsLight = let private genInteraction biasTowardsLight =

View file

@ -9,10 +9,31 @@ type ArbitraryLight =
type ArbitraryNonRemotelyControlledLight = type ArbitraryNonRemotelyControlledLight =
static member Light() = static member Light() =
lights 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 |> Gen.elements
|> Arb.fromGen |> Arb.fromGen
type ArbitraryRemotelyControlledLight = type ArbitraryRemotelyControlledLight =
static member Light() = 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

View file

@ -128,3 +128,35 @@ type NightLightTests() =
<| fun interactions -> <| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOff 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
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOff

View file

@ -40,32 +40,37 @@ type DeviceFriendlyName =
match this with match this with
| DeviceFriendlyName deviceFriendlyName -> deviceFriendlyName | DeviceFriendlyName deviceFriendlyName -> deviceFriendlyName
type LightControl =
| NonRemote
| RemoteLeft
| RemoteRight
type Light = type Light =
{ FriendlyName: DeviceFriendlyName { FriendlyName: DeviceFriendlyName
Room: Room Room: Room
Bulb: Bulb Bulb: Bulb
ControlledWithRemote: bool } ControlledWithRemote: LightControl }
let lights = let lights =
[ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa" [ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa"
Room = LivingRoom Room = LivingRoom
Bulb = IkeaBulb Bulb = IkeaBulb
ControlledWithRemote = true } ControlledWithRemote = RemoteRight }
{ FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa" { FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa"
Room = LivingRoom Room = LivingRoom
Bulb = PaulmannBulb Bulb = PaulmannBulb
ControlledWithRemote = false } ControlledWithRemote = NonRemote }
{ FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa" { FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa"
Room = LivingRoom Room = LivingRoom
Bulb = PaulmannBulb Bulb = PaulmannBulb
ControlledWithRemote = false } ControlledWithRemote = NonRemote }
{ FriendlyName = DeviceFriendlyName "Badrum - Taklampa" { FriendlyName = DeviceFriendlyName "Badrum - Taklampa"
Room = Bathroom Room = Bathroom
Bulb = IkeaBulb Bulb = IkeaBulb
ControlledWithRemote = false } ControlledWithRemote = NonRemote }
{ FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa" { FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa"
Room = Bedroom Room = Bedroom
Bulb = IkeaBulb Bulb = IkeaBulb
ControlledWithRemote = true } ] ControlledWithRemote = RemoteLeft } ]
let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll" let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll"

View file

@ -14,9 +14,9 @@ let internal tryFindLight friendlyName =
let internal generateZigbeeCommandsToFixLight state partOfDay (light: Light) = let internal generateZigbeeCommandsToFixLight state partOfDay (light: Light) =
seq { seq {
match light.ControlledWithRemote, state with match light.ControlledWithRemote, state with
| true, _ -> yield generateStateCommand state light | NonRemote, On -> ()
| false, On -> () | NonRemote, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled."
| false, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled." | _, _ -> yield generateStateCommand state light
if state = On then if state = On then
let color, brightness = let color, brightness =
@ -32,7 +32,9 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M
member this.OnEventReceived(event: Event) : Result<NightLightStateMachine * Message seq, OnEventReceivedError> = member this.OnEventReceived(event: Event) : Result<NightLightStateMachine * Message seq, OnEventReceivedError> =
result { result {
let maybePartOfDay = maybeTime |> Option.map getPartOfDay let maybePartOfDay = maybeTime |> Option.map getPartOfDay
let remoteControlledLights = lights |> Seq.filter _.ControlledWithRemote
let remoteControlledLights =
lights |> Seq.filter (not << _.ControlledWithRemote.IsNonRemote)
let updateLightStateForRemoteControlledLights desiredLightState = let updateLightStateForRemoteControlledLights desiredLightState =
remoteControlledLights remoteControlledLights
@ -52,16 +54,20 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M
| Some light -> generateZigbeeCommandsToFixLight lightToState[light] partOfDay light | Some light -> generateZigbeeCommandsToFixLight lightToState[light] partOfDay light
| None -> Seq.empty | None -> Seq.empty
| ButtonPress action -> | ButtonPress action ->
let desiredLightState = let newLightToState =
match action with match action with
| PressedOn -> On | PressedOn -> updateLightStateForRemoteControlledLights On
| PressedOff -> Off | PressedOff -> updateLightStateForRemoteControlledLights Off
| PressedLeft ->
let newLightToState = updateLightStateForRemoteControlledLights desiredLightState updateLightStateForRemoteControlledLights Off
|> Map.add
(lights |> Seq.find (fun light -> light.ControlledWithRemote = RemoteLeft))
On
NightLightStateMachine(maybeTime, newLightToState), NightLightStateMachine(maybeTime, newLightToState),
remoteControlledLights remoteControlledLights
|> Seq.collect (fun light -> generateZigbeeCommandsToFixLight desiredLightState partOfDay light) |> Seq.collect (fun light ->
generateZigbeeCommandsToFixLight newLightToState[light] partOfDay light)
| TimeChanged newTime, maybePartOfDay -> | TimeChanged newTime, maybePartOfDay ->
let newPartOfDay = getPartOfDay newTime let newPartOfDay = getPartOfDay newTime

View file

@ -7,6 +7,7 @@ open FSharp.Data
type Action = type Action =
| PressedOn | PressedOn
| PressedOff | PressedOff
| PressedLeft
type ZigbeeEvent = type ZigbeeEvent =
| DeviceAnnounce of DeviceFriendlyName | DeviceAnnounce of DeviceFriendlyName
@ -35,6 +36,7 @@ let parseZigbeeEvent (message: Message) =
match jsonValue.TryGetProperty "action" with match jsonValue.TryGetProperty "action" with
| Some(JsonValue.String "on") -> Ok(ButtonPress PressedOn) | Some(JsonValue.String "on") -> Ok(ButtonPress PressedOn)
| Some(JsonValue.String "off") -> Ok(ButtonPress PressedOff) | Some(JsonValue.String "off") -> Ok(ButtonPress PressedOff)
| Some(JsonValue.String "arrow_left_click") -> Ok(ButtonPress PressedLeft)
| Some _ -> Error InvalidActionField | Some _ -> Error InvalidActionField
| None -> Error MissingActionField | None -> Error MissingActionField
| _ -> return! Error <| UnknownTopic message.Topic | _ -> return! Error <| UnknownTopic message.Topic