diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index b9fa8db..363f085 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -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" diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index f1d5d54..5a66ec4 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -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 diff --git a/NightLight.Core/ZigbeeCommands.fs b/NightLight.Core/ZigbeeCommands.fs index 2d25c04..955c041 100644 --- a/NightLight.Core/ZigbeeCommands.fs +++ b/NightLight.Core/ZigbeeCommands.fs @@ -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 diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index e6a9769..0c31a63 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/NightLight.Core/ZigbeeEvents.fs @@ -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 } diff --git a/NightLight/Program.fs b/NightLight/Program.fs index 04b900f..08739ca 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -104,8 +104,9 @@ let mainAsync _ = do! mqttClient.ConnectAsync mqttClientOptions |> Async.AwaitTask |> Async.Ignore do! - mqttClient.SubscribeAsync "zigbee2mqtt/bridge/event" - |> Async.AwaitTask + [ "zigbee2mqtt/bridge/event"; $"zigbee2mqtt/{remoteControlFriendlyName.Get}" ] + |> Seq.map (fun topic -> async { return! mqttClient.SubscribeAsync topic |> Async.AwaitTask }) + |> Async.Sequential |> Async.Ignore while true do