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

Merge pull request #5 from svenvanheugten/refactor-tests-to-use-better-arbitraries

Browse source 
Refactor tests to use better arbitraries
This commit is contained in:
Sven van Heugten 2026-01-05 20:29:02 +01:00 • committed by GitHub
commit 9e97d9a37b
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
9 changed files with 98 additions and 80 deletions
Download patch file Download diff file Expand all files Collapse all files

29
NightLight.Core.Tests/Arbitraries.fs
View file

@ -1,29 +0,0 @@
namespace NightLight.Core.Tests
open System
open FsCheck
open FsCheck.FSharp
open NightLight.Core.Models
type Arbitraries =
static member Interactions() : Arbitrary<Interaction list> =
gen {
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
}
let! initialTimeChangedInteraction = genTimeChangedInteraction
let! remainingInteractions = Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] |> Gen.listOf
return initialTimeChangedInteraction :: remainingInteractions
}
|> Arb.fromGen

25
NightLight.Core.Tests/ArbitraryInteractionLists.fs Normal file
View file

@ -0,0 +1,25 @@
module NightLight.Core.Tests.ArbitraryInteractionLists
open System
open FsCheck.FSharp
open NightLight.Core.Tests.InteractionListGenerators
let private isDay (time: DateTime) =
time.TimeOfDay >= TimeSpan.FromHours 5.5
&& time.TimeOfDay < TimeSpan.FromHours 20.5
type ArbitraryInteractionsListThatEndsDuringTheDay =
static member InteractionsList() =
ArbMap.defaults
|> ArbMap.generate<DateTime>
|> Gen.filter isDay
|> Gen.bind genInteractionsListThatEndsAtTime
|> Arb.fromGen
type ArbitraryInteractionsListThatEndsDuringTheNight =
static member InteractionsList() =
ArbMap.defaults
|> ArbMap.generate<DateTime>
|> Gen.filter (not << isDay)
|> Gen.bind genInteractionsListThatEndsAtTime
|> Arb.fromGen

8
NightLight.Core.Tests/FakeHome.fs
View file

@ -59,7 +59,11 @@ type FakeHome() =
option {
let! friendlyName =
let m = Regex.Match(command.Topic, "^zigbee2mqtt/(.+)/set$")
if m.Success then Some m.Groups.[1].Value else None
if m.Success then
Some(DeviceFriendlyName m.Groups.[1].Value)
else
None
let! fakeLight = Map.tryFind friendlyName friendlyNameToFakeLight
@ -94,7 +98,7 @@ type FakeHome() =
Payload =
$@"{{
""type"": ""device_announce"",
""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }}
""data"": {{ ""friendly_name"": ""{light.FriendlyName.Get}"" }}
}}" }
|> ReceivedZigbeeEvent
|> onEventPublished.Trigger

41
NightLight.Core.Tests/InteractionListGenerators.fs Normal file
View file

@ -0,0 +1,41 @@
module NightLight.Core.Tests.InteractionListGenerators
open System
open FsCheck.FSharp
open NightLight.Core.Models
let private genTimeChangedInteraction =
ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
let private genHumanInteraction =
Gen.elements lights
|> Gen.bind (fun light ->
[ LightTurnedOn light; LightTurnedOff light ]
|> Gen.elements
|> Gen.map Interaction.HumanInteraction)
let private genInteraction =
Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ]
let private genInteractionsListThatStartsWithTimeChange =
gen {
let! firstInteraction = genTimeChangedInteraction
let! remainingInteractions = Gen.listOf genInteraction
return firstInteraction :: remainingInteractions
}
let private genInteractionsListWhere condition =
Gen.listOf (genInteraction |> Gen.filter condition)
let genInteractionsListThatEndsAtTime time =
let genTrivialList = Gen.constant <| List.singleton (Interaction.TimeChanged time)
let genNonTrivialList =
gen {
let! before = genInteractionsListThatStartsWithTimeChange
let interactionThatSetsEndTime = Interaction.TimeChanged time
let! after = genInteractionsListWhere (not << _.IsTimeChanged)
return before @ interactionThatSetsEndTime :: after
}
Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ]

3
NightLight.Core.Tests/NightLight.Core.Tests.fsproj
View file

@ -8,7 +8,8 @@
<ItemGroup>
<Compile Include="FakeHome.fs" />
<Compile Include="Arbitraries.fs" />
<Compile Include="InteractionListGenerators.fs" />
<Compile Include="ArbitraryInteractionLists.fs" />
<Compile Include="NightLightTests.fs" />
</ItemGroup>

45
NightLight.Core.Tests/NightLightTests.fs
View file

@ -1,31 +1,9 @@
namespace NightLight.Core.Tests
open System
open NightLight.Core.Core
open NightLight.Core.Tests.ArbitraryInteractionLists
open FsCheck.Xunit
open FsCheck.FSharp
module InteractionsHelpers =
let getTimeAfter interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| TimeChanged time -> Some time
| _ -> None)
|> Seq.tryLast
|> function
| Some time -> time
| None -> failwith "Time wasn't changed"
let isDayAfter interactions =
let time = getTimeAfter interactions
time.TimeOfDay >= TimeSpan.FromHours 5.5
&& time.TimeOfDay < TimeSpan.FromHours 20.5
let isNightAfter = not << isDayAfter
[<Properties(Arbitrary = [| typeof<Arbitraries> |])>]
type NightLightTests() =
let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) =
let mutable nightLightStateMachine = NightLightStateMachine()
@ -43,21 +21,12 @@ type NightLightTests() =
fakeHome
[<Property>]
let ``Brightness should always be under 255`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, brightness, _) -> brightness < 255uy)
[<Property>]
let ``Lights should be red during the night`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
InteractionsHelpers.isNightAfter interactions
==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)
[<Property>]
[<Property(Arbitrary = [| typeof<ArbitraryInteractionsListThatEndsDuringTheDay> |])>]
let ``Lights should be white or yellow during the day`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)
InteractionsHelpers.isDayAfter interactions
==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)
[<Property(Arbitrary = [| typeof<ArbitraryInteractionsListThatEndsDuringTheNight> |])>]
let ``Lights should be red during the night`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)

19
NightLight.Core/Models.fs
View file

@ -30,24 +30,31 @@ type Bulb =
| IkeaBulb
| PaulmannBulb
type DeviceFriendlyName =
| DeviceFriendlyName of string
member this.Get =
match this with
| DeviceFriendlyName deviceFriendlyName -> deviceFriendlyName
type Light =
{ FriendlyName: string
{ FriendlyName: DeviceFriendlyName
Room: Room
Bulb: Bulb }
let lights =
[ { FriendlyName = "Vardagsrum - Fönsterlampa"
[ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa"
Room = LivingRoom
Bulb = IkeaBulb }
{ FriendlyName = "Vardagsrum - Vägglampa"
{ FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa"
Room = LivingRoom
Bulb = PaulmannBulb }
{ FriendlyName = "Vardagsrum - Golvlampa"
{ FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa"
Room = LivingRoom
Bulb = PaulmannBulb }
{ FriendlyName = "Badrum - Taklampa"
{ FriendlyName = DeviceFriendlyName "Badrum - Taklampa"
Room = Bathroom
Bulb = IkeaBulb }
{ FriendlyName = "Sovrum - Nattduksbordlampa"
{ FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa"
Room = Bedroom
Bulb = IkeaBulb } ]

4
NightLight.Core/ZigbeeCommands.fs
View file

@ -4,7 +4,7 @@ open System.Text.Json.Nodes
open NightLight.Core.Models
open NightLight.Core.Moods
let generateZigbeeCommand friendlyName targetColor targetBrightness =
let generateZigbeeCommand (friendlyName: DeviceFriendlyName) targetColor targetBrightness =
let commandObj = JsonObject()
match targetColor with
@ -19,7 +19,7 @@ let generateZigbeeCommand friendlyName targetColor targetBrightness =
match targetBrightness with
| Brightness b -> b
let topic = $"zigbee2mqtt/{friendlyName}/set"
let topic = $"zigbee2mqtt/{friendlyName.Get}/set"
let payload = commandObj.ToJsonString()
{ Topic = topic; Payload = payload }

4
NightLight.Core/ZigbeeEvents.fs
View file

@ -4,7 +4,7 @@ open NightLight.Core.Models
open FsToolkit.ErrorHandling
open FSharp.Data
type ZigbeeEvent = DeviceAnnounce of FriendlyName: string
type ZigbeeEvent = DeviceAnnounce of DeviceFriendlyName
let parseZigbeeEvent (message: Message) =
result {
@ -17,7 +17,7 @@ let parseZigbeeEvent (message: Message) =
match messageType with
| JsonValue.String "device_announce" ->
match messageData.TryGetProperty "friendly_name" with
| Some(JsonValue.String friendlyName) -> Ok(DeviceAnnounce friendlyName)
| Some(JsonValue.String friendlyName) -> Ok <| DeviceAnnounce(DeviceFriendlyName friendlyName)
| Some _ -> Error InvalidFriendlyNameField
| None -> Error MissingFriendlyNameField
| JsonValue.String _ -> Error UnknownType