Add naive remote control implementation
This commit is contained in:
parent
d2864fcc22
commit
838bbb79a3
5 changed files with 78 additions and 26 deletions
|
|
@ -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
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue