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

Add naive remote control implementation

Browse source
This commit is contained in:
Sven van Heugten 2026-01-05 21:53:48 +01:00
parent d2864fcc22
commit 838bbb79a3
5 changed files with 78 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

23
NightLight.Core/Models.fs
View file

@ -9,6 +9,7 @@ type Event =
| TimeChanged of DateTime
type ParseZigbeeEventError =
| UnknownTopic
| InvalidJson
| MissingTypeField
| MissingDataField
@ -16,6 +17,8 @@ type ParseZigbeeEventError =
| InvalidTypeField
| InvalidFriendlyNameField
| UnknownType
| MissingActionField
| InvalidActionField
type OnEventReceivedError =
| ParseZigbeeEventError of ParseZigbeeEventError
@ -40,21 +43,29 @@ type DeviceFriendlyName =
type Light =
{ FriendlyName: DeviceFriendlyName
Room: Room
Bulb: Bulb }
Bulb: Bulb
ControlledWithRemote: bool }
let lights =
[ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa"
Room = LivingRoom
Bulb = IkeaBulb }
Bulb = IkeaBulb
ControlledWithRemote = true }
{ FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa"
Room = LivingRoom
Bulb = PaulmannBulb }
Bulb = PaulmannBulb
ControlledWithRemote = false }
{ FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa"
Room = LivingRoom
Bulb = PaulmannBulb }
Bulb = PaulmannBulb
ControlledWithRemote = false }
{ FriendlyName = DeviceFriendlyName "Badrum - Taklampa"
Room = Bathroom
Bulb = IkeaBulb }
Bulb = IkeaBulb
ControlledWithRemote = false }
{ FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa"
Room = Bedroom
Bulb = IkeaBulb } ]
Bulb = IkeaBulb
ControlledWithRemote = true } ]
let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll"

8
NightLight.Core/NightLightStateMachine.fs
View file

@ -15,7 +15,7 @@ let internal generateZigbeeCommandToFixLight partOfDay light =
let color, brightness =
getDesiredMood light.Room partOfDay |> getDesiredColorAndBrightness light.Bulb
generateZigbeeCommand light.FriendlyName color brightness
generateZigbeeCommand color brightness light
type NightLightStateMachine private (maybeTime: DateTime option) =
new() = NightLightStateMachine None
@ -37,6 +37,12 @@ type NightLightStateMachine private (maybeTime: DateTime option) =
match maybeLight with
| Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton
| None -> Seq.empty
| ButtonPress action ->
let remoteControlledLights = lights |> Seq.filter _.ControlledWithRemote
match action with
| PressedOn -> remoteControlledLights |> Seq.map (generateStateCommand On)
| PressedOff -> remoteControlledLights |> Seq.map (generateStateCommand Off)
| TimeChanged newTime, maybePartOfDay ->
let newState = NightLightStateMachine(Some newTime)
let newPartOfDay = getPartOfDay newTime

28
NightLight.Core/ZigbeeCommands.fs
View file

@ -4,7 +4,28 @@ open System.Text.Json.Nodes
open NightLight.Core.Models
open NightLight.Core.Moods
let generateZigbeeCommand (friendlyName: DeviceFriendlyName) targetColor targetBrightness =
type State =
| On
| Off
let toZigbeeCommand light payload =
let topic = $"zigbee2mqtt/{light.FriendlyName.Get}/set"
{ Topic = topic; Payload = payload }
let generateStateCommand state light =
let commandObj = JsonObject()
commandObj["state"] <-
match state with
| On -> "ON"
| Off -> "OFF"
if light.Bulb = IkeaBulb then
commandObj["transition"] <- 0
commandObj.ToJsonString() |> toZigbeeCommand light
let generateZigbeeCommand targetColor targetBrightness light =
let commandObj = JsonObject()
match targetColor with
@ -19,7 +40,4 @@ let generateZigbeeCommand (friendlyName: DeviceFriendlyName) targetColor targetB
match targetBrightness with
| Brightness b -> b
let topic = $"zigbee2mqtt/{friendlyName.Get}/set"
let payload = commandObj.ToJsonString()
{ Topic = topic; Payload = payload }
commandObj.ToJsonString() |> toZigbeeCommand light

40
NightLight.Core/ZigbeeEvents.fs
View file

@ -4,22 +4,38 @@ open NightLight.Core.Models
open FsToolkit.ErrorHandling
open FSharp.Data
type ZigbeeEvent = DeviceAnnounce of DeviceFriendlyName
type Action =
| PressedOn
| PressedOff
type ZigbeeEvent =
| DeviceAnnounce of DeviceFriendlyName
| ButtonPress of Action
let parseZigbeeEvent (message: Message) =
result {
let! jsonValue = JsonValue.TryParse message.Payload |> Result.requireSome InvalidJson
let! messageType = jsonValue.TryGetProperty "type" |> Result.requireSome MissingTypeField
let! messageData = jsonValue.TryGetProperty "data" |> Result.requireSome MissingDataField
match message.Topic with
| "zigbee2mqtt/bridge/event" ->
let! messageType = jsonValue.TryGetProperty "type" |> Result.requireSome MissingTypeField
let! messageData = jsonValue.TryGetProperty "data" |> Result.requireSome MissingDataField
return!
match messageType with
| JsonValue.String "device_announce" ->
match messageData.TryGetProperty "friendly_name" with
| Some(JsonValue.String friendlyName) -> Ok <| DeviceAnnounce(DeviceFriendlyName friendlyName)
| Some _ -> Error InvalidFriendlyNameField
| None -> Error MissingFriendlyNameField
| JsonValue.String _ -> Error UnknownType
| _ -> Error InvalidTypeField
return!
match messageType with
| JsonValue.String "device_announce" ->
match messageData.TryGetProperty "friendly_name" with
| Some(JsonValue.String friendlyName) -> Ok <| DeviceAnnounce(DeviceFriendlyName friendlyName)
| Some _ -> Error InvalidFriendlyNameField
| None -> Error MissingFriendlyNameField
| JsonValue.String _ -> Error UnknownType
| _ -> Error InvalidTypeField
| "zigbee2mqtt/Fjärrkontroll" ->
return!
match jsonValue.TryGetProperty "action" with
| Some(JsonValue.String "on") -> Ok(ButtonPress PressedOn)
| Some(JsonValue.String "off") -> Ok(ButtonPress PressedOff)
| Some _ -> Error InvalidActionField
| None -> Error MissingActionField
| _ -> return! Error UnknownTopic
}