Initial commit

NightLight.Core/Configuration.fs

@@ -0,0 +1,34 @@
+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 } ]

NightLight.Core/Core.fs

@@ -0,0 +1,35 @@
+module NightLight.Core
+
+open NightLight.PartsOfDay
+open NightLight.ZigbeeEvents
+open NightLight.ZigbeeCommands
+open NightLight.Moods
+open NightLight.Lights
+open NightLight.Configuration
+open FsToolkit.ErrorHandling
+
+let internal tryFindLight friendlyName =
+    Seq.tryFind (fun light -> light.FriendlyName = friendlyName) lights
+
+let internal generateZigbeeCommandToFixLight partOfDay light =
+    let color, brightness =
+        getDesiredMood light.Room partOfDay |> getDesiredColorAndBrightness light.Bulb
+
+    generateZigbeeCommand light.FriendlyName color brightness
+
+let onZigbeeEventReceived (partOfDay: PartOfDay) (decodedPayload: string) =
+    result {
+        let! zigbeeEvent = parseZigbeeEvent decodedPayload
+
+        return
+            match zigbeeEvent with
+            | DeviceAnnounce friendlyName ->
+                let maybeLight = tryFindLight friendlyName
+
+                match maybeLight with
+                | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton
+                | None -> Seq.empty
+    }
+
+let onPartOfDayChanged (partOfDay: PartOfDay) =
+    lights |> Seq.map (generateZigbeeCommandToFixLight partOfDay)

NightLight.Core/Lights.fs

@@ -0,0 +1,18 @@
+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 }

NightLight.Core/Moods.fs

@@ -0,0 +1,20 @@
+module internal NightLight.Moods
+
+open NightLight.PartsOfDay
+
+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

NightLight.Core/NightLight.Core.fsproj

@@ -0,0 +1,23 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>net9.0</TargetFramework>
+        <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="PartsOfDay.fs" />
+        <Compile Include="Moods.fs" />
+        <Compile Include="Lights.fs" />
+        <Compile Include="ZigbeeEvents.fs" />
+        <Compile Include="ZigbeeCommands.fs" />
+        <Compile Include="Configuration.fs" />
+        <Compile Include="Core.fs" />
+    </ItemGroup>
+
+    <ItemGroup>
+        <PackageReference Include="FSharp.Data" Version="6.6.0" />
+        <PackageReference Include="FsToolkit.ErrorHandling" Version="4.18.0" />
+    </ItemGroup>
+
+</Project>

NightLight.Core/PartsOfDay.fs

@@ -0,0 +1,12 @@
+module NightLight.PartsOfDay
+
+open System
+
+type PartOfDay =
+    | Day
+    | Night
+
+let getPartOfDay (dateTime: DateTime) =
+    match dateTime with
+    | _ when dateTime.TimeOfDay >= TimeSpan.FromHours 4.75 && dateTime.TimeOfDay < TimeSpan.FromHours 20.5 -> Day
+    | _ -> Night

NightLight.Core/ZigbeeCommands.fs

@@ -0,0 +1,26 @@
+module NightLight.ZigbeeCommands
+
+open System.Text.Json.Nodes
+open NightLight.Lights
+
+type ZigbeeCommand = ZigbeeCommand of Topic: string * Payload: string
+
+let internal generateZigbeeCommand friendlyName targetColor targetBrightness =
+    let commandObj = JsonObject()
+
+    match targetColor with
+    | ColorByCoordinates(x, y) ->
+        let colorObj = JsonObject()
+        colorObj["x"] <- x
+        colorObj["y"] <- y
+        commandObj["color"] <- colorObj
+    | ColorByTemperature t -> commandObj["color_temp"] <- t
+
+    commandObj["brightness"] <-
+        match targetBrightness with
+        | Brightness b -> b
+
+    let topic = $"zigbee2mqtt/{friendlyName}/set"
+    let payload = commandObj.ToJsonString()
+
+    ZigbeeCommand(topic, payload)

NightLight.Core/ZigbeeEvents.fs

@@ -0,0 +1,33 @@
+module NightLight.ZigbeeEvents
+
+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 =
+    result {
+        let! jsonValue = JsonValue.TryParse str |> Result.requireSome InvalidJson
+
+        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 friendlyName)
+                | Some _ -> Error InvalidFriendlyNameField
+                | None -> Error MissingFriendlyNameField
+            | JsonValue.String _ -> Error UnknownType
+            | _ -> Error InvalidTypeField
+    }