diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..23e9b2b --- /dev/null +++ b/.editorconfig @@ -0,0 +1,10 @@ +root = true + +[*] +end_of_line = lf + +[*.{fs,fsi,fsx}] +indent_size = 4 +indent_style = space +trim_trailing_whitespace=true + diff --git a/NightLight.Core/Configuration.fs b/NightLight.Core/Configuration.fs deleted file mode 100644 index 6f50b26..0000000 --- a/NightLight.Core/Configuration.fs +++ /dev/null @@ -1,34 +0,0 @@ -module internal NightLight.Configuration - -open NightLight.Moods -open NightLight.Lights - -let getDesiredColorAndBrightness bulb mood = - let white = ColorByCoordinates(0.3227, 0.329) - let yellow = ColorByTemperature 454 - let red = ColorByCoordinates(0.6942, 0.2963) - - match bulb, mood with - | IkeaBulb, White -> white, Brightness 254 - | IkeaBulb, Yellow -> yellow, Brightness 210 - | IkeaBulb, Red -> red, Brightness 254 - | PaulmannBulb, White -> white, Brightness 35 - | PaulmannBulb, Yellow -> yellow, Brightness 35 - | PaulmannBulb, Red -> red, Brightness 80 - -let lights = - [ { FriendlyName = "Vardagsrum - Fönsterlampa" - Room = LivingRoom - Bulb = IkeaBulb } - { FriendlyName = "Vardagsrum - Vägglampa" - Room = LivingRoom - Bulb = PaulmannBulb } - { FriendlyName = "Vardagsrum - Golvlampa" - Room = LivingRoom - Bulb = PaulmannBulb } - { FriendlyName = "Badrum - Taklampa" - Room = Bathroom - Bulb = IkeaBulb } - { FriendlyName = "Sovrum - Nattduksbordlampa" - Room = Bedroom - Bulb = IkeaBulb } ] diff --git a/NightLight.Core/Core.fs b/NightLight.Core/Core.fs index 742b43d..83cc290 100644 --- a/NightLight.Core/Core.fs +++ b/NightLight.Core/Core.fs @@ -1,11 +1,10 @@ -module NightLight.Core +module NightLight.Core.Core -open NightLight.PartsOfDay -open NightLight.ZigbeeEvents -open NightLight.ZigbeeCommands -open NightLight.Moods -open NightLight.Lights -open NightLight.Configuration +open NightLight.Core.Models +open NightLight.Core.PartsOfDay +open NightLight.Core.ZigbeeEvents +open NightLight.Core.ZigbeeCommands +open NightLight.Core.Moods open FsToolkit.ErrorHandling let internal tryFindLight friendlyName = @@ -17,19 +16,31 @@ let internal generateZigbeeCommandToFixLight partOfDay light = generateZigbeeCommand light.FriendlyName color brightness -let onZigbeeEventReceived (partOfDay: PartOfDay) (decodedPayload: string) = +let onEventReceived (state: State) (event: Event) : Result = result { - let! zigbeeEvent = parseZigbeeEvent decodedPayload + let partOfDay = getPartOfDay state.Time - return - match zigbeeEvent with - | DeviceAnnounce friendlyName -> - let maybeLight = tryFindLight friendlyName + match event with + | ReceivedZigbeeEvent payload -> + let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError - match maybeLight with - | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton - | None -> Seq.empty + return + state, + match zigbeeEvent with + | DeviceAnnounce friendlyName -> + let maybeLight = tryFindLight friendlyName + + match maybeLight with + | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton + | None -> Seq.empty + | TimeChanged time -> + let newState = { Time = time } + let newPartOfDay = getPartOfDay time + + return + newState, + if partOfDay <> newPartOfDay then + lights |> Seq.map (generateZigbeeCommandToFixLight newPartOfDay) + else + Seq.empty } - -let onPartOfDayChanged (partOfDay: PartOfDay) = - lights |> Seq.map (generateZigbeeCommandToFixLight partOfDay) diff --git a/NightLight.Core/Lights.fs b/NightLight.Core/Lights.fs deleted file mode 100644 index be03dbf..0000000 --- a/NightLight.Core/Lights.fs +++ /dev/null @@ -1,18 +0,0 @@ -module internal NightLight.Lights - -open NightLight.Moods - -type Bulb = - | IkeaBulb - | PaulmannBulb - -type Color = - | ColorByCoordinates of float * float - | ColorByTemperature of int - -type Brightness = Brightness of int - -type Light = - { FriendlyName: string - Room: Room - Bulb: Bulb } diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs new file mode 100644 index 0000000..2fb7f54 --- /dev/null +++ b/NightLight.Core/Models.fs @@ -0,0 +1,53 @@ +module NightLight.Core.Models + +open System + +type State = { Time: DateTime } + +type Message = { Topic: string; Payload: string } + +type Event = + | ReceivedZigbeeEvent of Message + | TimeChanged of DateTime + +type ParseZigbeeEventError = + | InvalidJson + | MissingTypeField + | MissingDataField + | MissingFriendlyNameField + | InvalidTypeField + | InvalidFriendlyNameField + | UnknownType + +type ParseEventError = ParseZigbeeEventError of ParseZigbeeEventError + +type Room = + | Bathroom + | LivingRoom + | Bedroom + +type Bulb = + | IkeaBulb + | PaulmannBulb + +type Light = + { FriendlyName: string + Room: Room + Bulb: Bulb } + +let lights = + [ { FriendlyName = "Vardagsrum - Fönsterlampa" + Room = LivingRoom + Bulb = IkeaBulb } + { FriendlyName = "Vardagsrum - Vägglampa" + Room = LivingRoom + Bulb = PaulmannBulb } + { FriendlyName = "Vardagsrum - Golvlampa" + Room = LivingRoom + Bulb = PaulmannBulb } + { FriendlyName = "Badrum - Taklampa" + Room = Bathroom + Bulb = IkeaBulb } + { FriendlyName = "Sovrum - Nattduksbordlampa" + Room = Bedroom + Bulb = IkeaBulb } ] diff --git a/NightLight.Core/Moods.fs b/NightLight.Core/Moods.fs index c9c8d44..9f33cf3 100644 --- a/NightLight.Core/Moods.fs +++ b/NightLight.Core/Moods.fs @@ -1,20 +1,35 @@ -module internal NightLight.Moods +module internal NightLight.Core.Moods -open NightLight.PartsOfDay +open NightLight.Core.PartsOfDay +open NightLight.Core.Models type Mood = | White | Yellow | Red -type Room = - | Bathroom - | LivingRoom - | Bedroom - let getDesiredMood room partOfDay = match room, partOfDay with | Bathroom, Day -> White | LivingRoom, Day -> Yellow | Bedroom, Day -> Yellow | _, Night -> Red + +type Color = + | ColorByCoordinates of float * float + | ColorByTemperature of int + +type Brightness = Brightness of int + +let getDesiredColorAndBrightness bulb mood = + let white = ColorByCoordinates(0.3227, 0.329) + let yellow = ColorByTemperature 454 + let red = ColorByCoordinates(0.6942, 0.2963) + + match bulb, mood with + | IkeaBulb, White -> white, Brightness 254 + | IkeaBulb, Yellow -> yellow, Brightness 210 + | IkeaBulb, Red -> red, Brightness 254 + | PaulmannBulb, White -> white, Brightness 35 + | PaulmannBulb, Yellow -> yellow, Brightness 35 + | PaulmannBulb, Red -> red, Brightness 80 diff --git a/NightLight.Core/NightLight.Core.fsproj b/NightLight.Core/NightLight.Core.fsproj index d8796ce..31b2b6e 100644 --- a/NightLight.Core/NightLight.Core.fsproj +++ b/NightLight.Core/NightLight.Core.fsproj @@ -6,12 +6,11 @@ + - - diff --git a/NightLight.Core/PartsOfDay.fs b/NightLight.Core/PartsOfDay.fs index f7b47d2..8cfc3c3 100644 --- a/NightLight.Core/PartsOfDay.fs +++ b/NightLight.Core/PartsOfDay.fs @@ -1,4 +1,4 @@ -module NightLight.PartsOfDay +module internal NightLight.Core.PartsOfDay open System @@ -8,5 +8,9 @@ type PartOfDay = let getPartOfDay (dateTime: DateTime) = match dateTime with - | _ when dateTime.TimeOfDay >= TimeSpan.FromHours 4.75 && dateTime.TimeOfDay < TimeSpan.FromHours 20.5 -> Day + | _ when + dateTime.TimeOfDay >= TimeSpan.FromHours 5.5 + && dateTime.TimeOfDay < TimeSpan.FromHours 20.5 + -> + Day | _ -> Night diff --git a/NightLight.Core/ZigbeeCommands.fs b/NightLight.Core/ZigbeeCommands.fs index 2ebbb08..6df6e85 100644 --- a/NightLight.Core/ZigbeeCommands.fs +++ b/NightLight.Core/ZigbeeCommands.fs @@ -1,11 +1,10 @@ -module NightLight.ZigbeeCommands +module internal NightLight.Core.ZigbeeCommands open System.Text.Json.Nodes -open NightLight.Lights +open NightLight.Core.Models +open NightLight.Core.Moods -type ZigbeeCommand = ZigbeeCommand of Topic: string * Payload: string - -let internal generateZigbeeCommand friendlyName targetColor targetBrightness = +let generateZigbeeCommand friendlyName targetColor targetBrightness = let commandObj = JsonObject() match targetColor with @@ -23,4 +22,4 @@ let internal generateZigbeeCommand friendlyName targetColor targetBrightness = let topic = $"zigbee2mqtt/{friendlyName}/set" let payload = commandObj.ToJsonString() - ZigbeeCommand(topic, payload) + { Topic = topic; Payload = payload } diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index 24f0b02..b435698 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/NightLight.Core/ZigbeeEvents.fs @@ -1,22 +1,14 @@ -module NightLight.ZigbeeEvents +module internal NightLight.Core.ZigbeeEvents +open NightLight.Core.Models open FsToolkit.ErrorHandling open FSharp.Data type ZigbeeEvent = DeviceAnnounce of FriendlyName: string -type ParseZigbeeEventError = - | InvalidJson - | MissingTypeField - | MissingDataField - | MissingFriendlyNameField - | InvalidTypeField - | InvalidFriendlyNameField - | UnknownType - -let internal parseZigbeeEvent str = +let parseZigbeeEvent (message: Message) = result { - let! jsonValue = JsonValue.TryParse str |> Result.requireSome InvalidJson + 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 diff --git a/NightLight/Program.fs b/NightLight/Program.fs index 9d390d2..c140173 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -1,55 +1,58 @@ open System open System.Text +open System.Threading open System.Threading.Tasks open Microsoft.Extensions.Logging open MQTTnet open MQTTnet.Protocol -open NightLight.PartsOfDay -open NightLight.ZigbeeEvents -open NightLight.ZigbeeCommands -open NightLight.Core +open NightLight.Core.Models +open NightLight.Core.Core let private generateMqttMessage zigbeeCommand = - match zigbeeCommand with - | ZigbeeCommand(topic, payload) -> - MqttApplicationMessageBuilder() - .WithTopic(topic) - .WithPayload(payload) - .WithQualityOfServiceLevel(MqttQualityOfServiceLevel.AtLeastOnce) - .Build() + MqttApplicationMessageBuilder() + .WithTopic(zigbeeCommand.Topic) + .WithPayload(zigbeeCommand.Payload) + .WithQualityOfServiceLevel(MqttQualityOfServiceLevel.AtLeastOnce) + .Build() -let private publishZigbeeCommands (mqttClient: IMqttClient) (logger: ILogger) (commands: ZigbeeCommand seq) = +let private publishZigbeeCommands (mqttClient: IMqttClient) (logger: ILogger) (commands: Message seq) = async { commands |> Seq.iter (fun command -> - match command with - | ZigbeeCommand(topic, payload) -> - logger.LogInformation("Publishing message {Payload} to topic {Topic}...", payload, topic)) + logger.LogInformation("Publishing message {Payload} to topic {Topic}...", command.Payload, command.Topic)) return! commands |> Seq.map generateMqttMessage - |> Seq.map mqttClient.PublishAsync - |> Seq.map Async.AwaitTask + |> Seq.map (fun message -> async { return! mqttClient.PublishAsync message |> Async.AwaitTask }) |> Async.Sequential |> Async.Ignore } -let private onMqttMessageReceived (mqttClient: IMqttClient) (logger: ILogger) (message: MqttApplicationMessage) = +let private handleEvent (mqttClient: IMqttClient) (logger: ILogger) (state: State) (event: Event) = + match event with + | ReceivedZigbeeEvent payload -> logger.LogInformation("Received message with payload {Payload}", payload) + | _ -> () + + let result = event |> onEventReceived state + + match result with + | Ok(newState, commands) -> + async { + do! publishZigbeeCommands mqttClient logger commands + return newState + } + | Error(ParseZigbeeEventError UnknownType) -> async.Return state + | Error e -> + logger.LogError("Error {Error} while {Event}", e, event) + async.Return state + +let private decodeMqttApplicationMessage (message: MqttApplicationMessage) = let payload = message.Payload let decodedPayload = Encoding.UTF8.GetString(&payload) - logger.LogInformation("Received message with payload {Payload}", decodedPayload) - - let commandsResult = - decodedPayload |> onZigbeeEventReceived (getPartOfDay DateTime.Now) - - match commandsResult with - | Ok commands -> publishZigbeeCommands mqttClient logger commands - | Error UnknownType -> async.Return() - | Error e -> - logger.LogError("Error {Error} while processing {Payload}", e, payload) - async.Return() + { Topic = message.Topic + Payload = decodedPayload } [] let mainAsync _ = @@ -73,8 +76,21 @@ let mainAsync _ = let mqttClientOptions = MqttClientOptionsBuilder().WithTcpServer(server).Build() + let stateLock = new SemaphoreSlim(1, 1) + let mutable state = { Time = DateTime.Now } + mqttClient.add_ApplicationMessageReceivedAsync (fun e -> - onMqttMessageReceived mqttClient logger e.ApplicationMessage + async { + let event = ReceivedZigbeeEvent <| decodeMqttApplicationMessage e.ApplicationMessage + + do! stateLock.WaitAsync() |> Async.AwaitTask + + try + let! newState = event |> handleEvent mqttClient logger state + state <- newState + finally + stateLock.Release() |> ignore + } |> Async.StartAsTask :> Task) @@ -85,14 +101,14 @@ let mainAsync _ = |> Async.AwaitTask |> Async.Ignore - let mutable previousPartOfDay: PartOfDay option = None - while true do - let currentPartOfDay = getPartOfDay DateTime.Now + do! stateLock.WaitAsync() |> Async.AwaitTask - if previousPartOfDay <> Some currentPartOfDay then - do! onPartOfDayChanged currentPartOfDay |> publishZigbeeCommands mqttClient logger - previousPartOfDay <- Some currentPartOfDay + try + let! newState = TimeChanged DateTime.Now |> handleEvent mqttClient logger state + state <- newState + finally + stateLock.Release() |> ignore do! Async.Sleep 10_000 diff --git a/README.md b/README.md index 1446cf8..b70f026 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ This is an F# program that turns all the lights in our apartment * _red_ at 8.30pm in the evening, and -* _white_/_yellow_ (depending on the room) at 4.45am in the morning. +* _white_/_yellow_ (depending on the room) at 5.30am in the morning. `NightLight.Core` is the functional core, and `NightLight` is the imperative shell.