svenvanheugten/night-light
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #2 from svenvanheugten/add-tests

Browse source 
Add tests
This commit is contained in:
Sven van Heugten 2026-01-04 12:13:16 +01:00 • committed by GitHub
commit 4e6fc6645c
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
10 changed files with 280 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

22
NightLight.Core.Tests/Arbitraries.fs Normal file
View file

@ -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

135
NightLight.Core.Tests/FakeHome.fs Normal file
View file

@ -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())

28
NightLight.Core.Tests/NightLight.Core.Tests.fsproj Normal file
View file

@ -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>

29
NightLight.Core.Tests/NightLightTests.fs Normal file
View file

@ -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)

46
NightLight.Core/Core.fs
View file

@ -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
}

2
NightLight.Core/Models.fs
View file

@ -2,8 +2,6 @@ module NightLight.Core.Models
open System
type State = { Time: DateTime }
type Message = { Topic: string; Payload: string }
type Event =

2
NightLight.Core/NightLight.Core.fsproj
View file

@ -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>

48
NightLight.Core/NightLightStateMachine.fs Normal file
View file

@ -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
}

14
NightLight.sln
View file

@ -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

6
NightLight/Program.fs
View file

@ -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 {