Add naive remote control implementation

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"

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

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"
+    commandObj.ToJsonString() |> toZigbeeCommand light
-    let payload = commandObj.ToJsonString()
-
-    { Topic = topic; Payload = payload }

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
+        match message.Topic with
-        let! messageData = jsonValue.TryGetProperty "data" |> Result.requireSome MissingDataField
+        | "zigbee2mqtt/bridge/event" ->
+            let! messageType = jsonValue.TryGetProperty "type" |> Result.requireSome MissingTypeField
+            let! messageData = jsonValue.TryGetProperty "data" |> Result.requireSome MissingDataField
 
-        return!
+            return!
-            match messageType with
+                match messageType with
-            | JsonValue.String "device_announce" ->
+                | JsonValue.String "device_announce" ->
-                match messageData.TryGetProperty "friendly_name" with
+                    match messageData.TryGetProperty "friendly_name" with
-                | Some(JsonValue.String friendlyName) -> Ok <| DeviceAnnounce(DeviceFriendlyName friendlyName)
+                    | Some(JsonValue.String friendlyName) -> Ok <| DeviceAnnounce(DeviceFriendlyName friendlyName)
-                | Some _ -> Error InvalidFriendlyNameField
+                    | Some _ -> Error InvalidFriendlyNameField
-                | None -> Error MissingFriendlyNameField
+                    | None -> Error MissingFriendlyNameField
-            | JsonValue.String _ -> Error UnknownType
+                | JsonValue.String _ -> Error UnknownType
-            | _ -> Error InvalidTypeField
+                | _ -> 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
     }

NightLight/Program.fs

@@ -104,8 +104,9 @@ let mainAsync _ =
         do! mqttClient.ConnectAsync mqttClientOptions |> Async.AwaitTask |> Async.Ignore
 
         do!
-            mqttClient.SubscribeAsync "zigbee2mqtt/bridge/event"
+            [ "zigbee2mqtt/bridge/event"; $"zigbee2mqtt/{remoteControlFriendlyName.Get}" ]
-            |> Async.AwaitTask
+            |> Seq.map (fun topic -> async { return! mqttClient.SubscribeAsync topic |> Async.AwaitTask })
+            |> Async.Sequential
             |> Async.Ignore
 
         while true do