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

Implement the 'Left' button on the remote

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

17
NightLight.Core/Models.fs
View file

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

26
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,9 @@ 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 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

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