Add naive remote control implementation

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

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
}