Merge pull request #2 from svenvanheugten/add-tests

Add tests
2026-01-04 12:13:16 +01:00 · 2026-01-04 12:13:16 +01:00 · 4e6fc6645c
commit 4e6fc6645c
parent f6fdbddafd 48aaabde3b
10 changed files with 280 additions and 52 deletions
--- a/NightLight.Core.Tests/Arbitraries.fs
+++ b/NightLight.Core.Tests/Arbitraries.fs
@ -0,0 +1,22 @@
+namespace NightLight.Core.Tests
+
+open System
+open FsCheck.FSharp
+open NightLight.Core.Models
+
+type Arbitraries =
+    static member Interaction() =
+        let genTimeChangedInteraction =
+            gen {
+                let! time = ArbMap.defaults |> ArbMap.generate<DateTime>
+                return Interaction.TimeChanged time
+            }
+
+        let genHumanInteraction =
+            gen {
+                let! light = Gen.elements lights
+                let! humanInteraction = Gen.elements [ LightTurnedOn light; LightTurnedOff light ]
+                return Interaction.HumanInteraction humanInteraction
+            }
+
+        Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] |> Arb.fromGen
--- a/NightLight.Core.Tests/FakeHome.fs
+++ b/NightLight.Core.Tests/FakeHome.fs
@ -0,0 +1,135 @@
+namespace NightLight.Core.Tests
+
+open System
+open System.Text.RegularExpressions
+open NightLight.Core.Models
+open NightLight.Core.Core
+open FsToolkit.ErrorHandling
+open FSharp.Data
+
+type HumanInteraction =
+    | LightTurnedOn of Light
+    | LightTurnedOff of Light
+
+type Interaction =
+    | HumanInteraction of HumanInteraction
+    | TimeChanged of DateTime
+
+type Color =
+    | White
+    | Yellow
+    | Red
+
+type LightState =
+    | Off
+    | On of Brightness: byte * Color: Color
+
+type FakeLight(light: Light) =
+    let mutable hasPower = false
+    let mutable brightness: byte = 255uy
+    let mutable color: Color = White
+
+    member _.LightWithState = light, if hasPower then On(brightness, color) else Off
+
+    member _.TurnOn() = hasPower <- true
+
+    member _.TurnOff() = hasPower <- false
+
+    member _.SetBrightness(newBrightness: byte) =
+        if hasPower then
+            brightness <- newBrightness
+
+    member _.SetColor(newColor: Color) =
+        if hasPower then
+            color <- newColor
+
+type FakeHome(now: DateTime) =
+    let mutable time = now
+
+    let mutable nightLightStateMachine = NightLightStateMachine now
+
+    let assertIsOkAndGet result =
+        match result with
+        | Ok value -> value
+        | Error error -> failwith $"Expected Ok, got Error {error}"
+
+    let friendlyNameToFakeLight =
+        lights
+        |> Seq.map (fun light -> light.FriendlyName, FakeLight light)
+        |> Map.ofSeq
+
+    let processCommand command =
+        option {
+            let! friendlyName =
+                let m = Regex.Match(command.Topic, "^zigbee2mqtt/(.+)/set$")
+                if m.Success then Some m.Groups.[1].Value else None
+
+            let! fakeLight = Map.tryFind friendlyName friendlyNameToFakeLight
+
+            let parsedPayload = JsonValue.Parse command.Payload
+
+            match parsedPayload.TryGetProperty "brightness" with
+            | Some(JsonValue.Number newBrightness) -> fakeLight.SetBrightness(byte newBrightness)
+            | None -> ()
+            | value -> failwith $"Unexpected brightness value {value}"
+
+            match parsedPayload.TryGetProperty "color" with
+            | Some color ->
+                match color.TryGetProperty "x", color.TryGetProperty "y" with
+                | Some(JsonValue.Number 0.3227M), Some(JsonValue.Number 0.329M) -> fakeLight.SetColor White
+                | Some(JsonValue.Number 0.6942M), Some(JsonValue.Number 0.2963M) -> fakeLight.SetColor Red
+                | _ -> failwith $"Unexpected color value {color}"
+            | None -> ()
+
+            match parsedPayload.TryGetProperty "color_temp" with
+            | Some(JsonValue.Number temperature) when temperature = 454M -> fakeLight.SetColor Yellow
+            | None -> ()
+            | value -> failwith $"Unexpected color temperature value {value}"
+        }
+        |> ignore
+
+    let sendEvent event =
+        let newState, commands =
+            event |> nightLightStateMachine.OnEventReceived |> assertIsOkAndGet
+
+        commands |> Seq.iter processCommand
+        nightLightStateMachine <- newState
+
+    member _.Time = time
+
+    member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState
+
+    member _.Interact(interaction: Interaction) =
+        match interaction with
+        | HumanInteraction(LightTurnedOn light) ->
+            friendlyNameToFakeLight[light.FriendlyName].TurnOn()
+
+            { Topic = "zigbee2mqtt/bridge/event"
+              Payload =
+                $@"{{
+                    ""type"": ""device_announce"",
+                    ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }}
+                  }}" }
+            |> ReceivedZigbeeEvent
+            |> sendEvent
+        | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff()
+        | TimeChanged newTime ->
+            time <- newTime
+            newTime |> Event.TimeChanged |> sendEvent
+
+type FakeHome with
+    member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact
+
+    member this.ForAllLightsThatAreOn condition =
+        this.LightStates
+        |> Seq.choose (fun (light, state) ->
+            match state with
+            | On(brightness, color) -> Some(light, brightness, color)
+            | Off -> None)
+        |> Seq.forall condition
+
+    member this.IsDay() =
+        this.Time.TimeOfDay >= TimeSpan.FromHours 5.5
+        && this.Time.TimeOfDay < TimeSpan.FromHours 20.5
+
+    member this.IsNight() = not (this.IsDay())
--- a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj
+++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj
@ -0,0 +1,28 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <OutputType>Exe</OutputType>
+        <TargetFramework>net9.0</TargetFramework>
+        <TreatWarningsAsErrors>true</TreatWarningsAsErrors>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <Compile Include="FakeHome.fs" />
+        <Compile Include="Arbitraries.fs" />
+        <Compile Include="NightLightTests.fs" />
+    </ItemGroup>
+
+    <ItemGroup>
+	<PackageReference Include="coverlet.collector" Version="6.0.2" />
+	<PackageReference Include="Microsoft.NET.Test.Sdk" Version="17.12.0" />
+	<PackageReference Include="xunit" Version="2.9.2" />
+	<PackageReference Include="xunit.runner.visualstudio" Version="2.8.2" />
+	<PackageReference Include="FsCheck" Version="3.3.0" />
+	<PackageReference Include="FsCheck.Xunit" Version="3.3.0" />
+    </ItemGroup>
+
+    <ItemGroup>
+        <ProjectReference Include="../NightLight.Core/NightLight.Core.fsproj" />
+    </ItemGroup>
+
+</Project>
--- a/NightLight.Core.Tests/NightLightTests.fs
+++ b/NightLight.Core.Tests/NightLightTests.fs
@ -0,0 +1,29 @@
+namespace NightLight.Core.Tests
+
+open System
+open FsCheck.Xunit
+open FsCheck.FSharp
+
+[<Properties(Arbitrary = [| typeof<Arbitraries> |])>]
+type NightLightTests() =
+    [<Property>]
+    let ``Brightness should always be under 255`` (now: DateTime) (interactions: Interaction list) =
+        let fakeHome = FakeHome now
+        fakeHome.Interact interactions
+        fakeHome.ForAllLightsThatAreOn(fun (_, brightness, _) -> brightness < 255uy)
+
+    [<Property>]
+    let ``Lights should be red during the night`` (now: DateTime) (interactions: Interaction list) =
+        let fakeHome = FakeHome now
+        fakeHome.Interact interactions
+
+        fakeHome.IsNight()
+        ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)
+
+    [<Property>]
+    let ``Lights should be white or yellow during the day`` (now: DateTime) (interactions: Interaction list) =
+        let fakeHome = FakeHome now
+        fakeHome.Interact interactions
+
+        fakeHome.IsDay()
+        ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)
--- a/NightLight.Core/Core.fs
+++ b/NightLight.Core/Core.fs
@ -1,46 +0,0 @@
-module NightLight.Core.Core
-
-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 =
-    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 onEventReceived (state: State) (event: Event) : Result<State * Message seq, ParseEventError> =
-    result {
-        let partOfDay = getPartOfDay state.Time
-
-        match event with
-        | ReceivedZigbeeEvent payload ->
-            let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError
-
-            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
-    }
--- a/NightLight.Core/Models.fs
+++ b/NightLight.Core/Models.fs
@ -2,8 +2,6 @@ module NightLight.Core.Models

 open System

-type State = { Time: DateTime }
-
 type Message = { Topic: string; Payload: string }

 type Event =
--- a/NightLight.Core/NightLight.Core.fsproj
+++ b/NightLight.Core/NightLight.Core.fsproj
@ -11,7 +11,7 @@
        <Compile Include="Moods.fs" />
        <Compile Include="ZigbeeEvents.fs" />
        <Compile Include="ZigbeeCommands.fs" />
-        <Compile Include="Core.fs" />
+        <Compile Include="NightLightStateMachine.fs" />
    </ItemGroup>

    <ItemGroup>
--- a/NightLight.Core/NightLightStateMachine.fs
+++ b/NightLight.Core/NightLightStateMachine.fs
@ -0,0 +1,48 @@
+module NightLight.Core.Core
+
+open System
+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 =
+    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
+
+type NightLightStateMachine(time: DateTime) =
+    member this.OnEventReceived(event: Event) : Result<NightLightStateMachine * Message seq, ParseEventError> =
+        result {
+            let partOfDay = getPartOfDay time
+
+            match event with
+            | ReceivedZigbeeEvent payload ->
+                let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError
+
+                return
+                    this,
+                    match zigbeeEvent with
+                    | DeviceAnnounce friendlyName ->
+                        let maybeLight = tryFindLight friendlyName
+
+                        match maybeLight with
+                        | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton
+                        | None -> Seq.empty
+            | TimeChanged newTime ->
+                let newState = NightLightStateMachine newTime
+                let newPartOfDay = getPartOfDay newTime
+
+                return
+                    newState,
+                    if partOfDay <> newPartOfDay then
+                        lights |> Seq.map (generateZigbeeCommandToFixLight newPartOfDay)
+                    else
+                        Seq.empty
+        }
--- a/NightLight.sln
+++ b/NightLight.sln
@ -4,6 +4,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight", "NightLight\Ni
 EndProject
 Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight.Core", "NightLight.Core\NightLight.Core.fsproj", "{FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}"
 EndProject
+Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight.Core.Tests", "NightLight.Core.Tests\NightLight.Core.Tests.fsproj", "{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}"
+EndProject
 Global
 	GlobalSection(SolutionConfigurationPlatforms) = preSolution
 		Debug|Any CPU = Debug|Any CPU
@ -38,6 +40,18 @@ Global
 		{FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x64.Build.0 = Release|Any CPU
 		{FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x86.ActiveCfg = Release|Any CPU
 		{FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x86.Build.0 = Release|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|Any CPU.Build.0 = Debug|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x64.ActiveCfg = Debug|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x64.Build.0 = Debug|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x86.ActiveCfg = Debug|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x86.Build.0 = Debug|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|Any CPU.ActiveCfg = Release|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|Any CPU.Build.0 = Release|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x64.ActiveCfg = Release|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x64.Build.0 = Release|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x86.ActiveCfg = Release|Any CPU
+		{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x86.Build.0 = Release|Any CPU
 	EndGlobalSection
 	GlobalSection(SolutionProperties) = preSolution
 		HideSolutionNode = FALSE
--- a/NightLight/Program.fs
+++ b/NightLight/Program.fs
@ -29,12 +29,12 @@ let private publishZigbeeCommands (mqttClient: IMqttClient) (logger: ILogger) (c
            |> Async.Ignore
    }

-let private handleEvent (mqttClient: IMqttClient) (logger: ILogger) (state: State) (event: Event) =
+let private handleEvent (mqttClient: IMqttClient) (logger: ILogger) (state: NightLightStateMachine) (event: Event) =
    match event with
    | ReceivedZigbeeEvent payload -> logger.LogInformation("Received message with payload {Payload}", payload)
    | _ -> ()

-    let result = event |> onEventReceived state
+    let result = event |> state.OnEventReceived

    match result with
    | Ok(newState, commands) ->
@ -77,7 +77,7 @@ let mainAsync _ =
        let mqttClientOptions = MqttClientOptionsBuilder().WithTcpServer(server).Build()

        let stateLock = new SemaphoreSlim(1, 1)
-        let mutable state = { Time = DateTime.Now }
+        let mutable state = NightLightStateMachine DateTime.Now

        mqttClient.add_ApplicationMessageReceivedAsync (fun e ->
            async {