Re-write the remaining tests

This commit is contained in:
Sven van Heugten 2026-01-17 10:03:17 +01:00
parent ec90147c07
commit 62c8e446c9
6 changed files with 116 additions and 199 deletions

View file

@ -147,5 +147,12 @@ type FakeHome with
member this.LightsThatAreOn =
this.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.toList
member this.LightShouldHaveState light condition =
this.LightStates |> Seq.find (fst >> (=) light) |> snd |> condition
member this.NonRemotelyControlledLightStates =
this.LightStates
|> Seq.filter (fst >> _.ControlledWithRemote >> (=) NonRemote)
|> Seq.toList
member this.RemotelyControlledLightStates =
this.LightStates
|> Seq.filter (fst >> _.ControlledWithRemote >> (<>) NonRemote)
|> Seq.toList

View file

@ -1,14 +1,15 @@
module NightLight.Core.Tests.InteractionListGenerators
open FsCheck.FSharp
open System
open NightLight.Core.Models
open NightLight.Core.Tests.TimeChangedGenerators
open FsCheck
open FsCheck.FSharp
let private genHumanInteraction maybeBiasTowardsLight =
match maybeBiasTowardsLight with
| Some biasTowardsLight -> Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ]
| None -> Gen.elements lights
let private genTimeChanged =
ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
let private genHumanInteraction =
Gen.elements lights
|> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ])
|> Gen.map Interaction.HumanInteraction
@ -16,86 +17,18 @@ let private genRemoteInteraction =
Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ]
|> Gen.map RemoteInteraction
let private genInteraction maybeBiasTowardsLight =
Gen.oneof
[ genTimeChanged
genHumanInteraction maybeBiasTowardsLight
genRemoteInteraction ]
let private genInteraction =
Gen.oneof [ genTimeChanged; genHumanInteraction; genRemoteInteraction ]
let genBiasedInteractionsExcept biasTowardsLight disqualifier =
Some biasTowardsLight
|> genInteraction
|> Gen.filter (not << disqualifier)
|> Gen.listOf
let private genInteractions = genInteraction |> Gen.listOf
let genBiasedInteractions biasTowardsLight =
genBiasedInteractionsExcept biasTowardsLight (fun _ -> false)
let genInteractions = genInteraction None |> Gen.listOf
let getPartOfDayAfterInteractions interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| Interaction.TimeChanged time -> Some time
| _ -> None)
|> Seq.last
|> getPartOfDay
let doesLightHavePowerAfterInteractions light interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| HumanInteraction(LightPoweredOff l) when l = light -> Some false
| HumanInteraction(LightPoweredOn l) when l = light -> Some true
| _ -> None)
|> Seq.tryLast
|> Option.defaultValue false
let ensureStartsWithTimeChanged (genInteractions: Gen<Interaction list>) =
let private ensureStartsWithTimeChanged (genInteractions: Gen<Interaction list>) =
genInteractions
|> Gen.bind (fun interactions ->
match interactions with
| Interaction.TimeChanged _ :: _ -> Gen.constant interactions
| _ -> genTimeChanged |> Gen.map (fun tc -> tc :: interactions))
let ensureLightHasPower (light: Light) (genInteractions: Gen<Interaction list>) =
genInteractions
|> Gen.map (fun interactions ->
if doesLightHavePowerAfterInteractions light interactions then
interactions
else
interactions @ [ HumanInteraction(LightPoweredOn light) ])
let ensurePartOfDayIs (desiredPartOfDay: PartOfDay) (genInteractions: Gen<Interaction list>) =
genInteractions
|> Gen.bind (fun interactions ->
if getPartOfDayAfterInteractions interactions = desiredPartOfDay then
Gen.constant interactions
else
desiredPartOfDay
|> genTimeChangedToPartOfDay
|> Gen.map (fun tc -> interactions @ [ tc ]))
let ensureLastRemoteInteractionIs
(desiredLastRemoteInteraction: RemoteInteraction)
(genInteractions: Gen<Interaction list>)
=
genInteractions
|> Gen.map (fun interactions ->
let maybeLastRemoteInteraction =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| Interaction.RemoteInteraction remoteInteraction -> Some remoteInteraction
| _ -> None)
|> Seq.tryLast
if maybeLastRemoteInteraction = Some desiredLastRemoteInteraction then
interactions
else
interactions @ [ RemoteInteraction desiredLastRemoteInteraction ])
type ArbitraryInteractions() =
static member Interactions() =
genInteractions |> ensureStartsWithTimeChanged |> Arb.fromGen

View file

@ -0,0 +1,61 @@
module NightLight.Core.Tests.InteractionListHelpers
open System
type PartOfDay =
| Day
| Night
let private getPartOfDay (dateTime: DateTime) =
match dateTime with
| _ when
dateTime.TimeOfDay >= TimeSpan.FromHours 6
&& dateTime.TimeOfDay < TimeSpan.FromHours 20.5
->
Day
| _ -> Night
let getPartOfDayAfterInteractions interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| Interaction.TimeChanged time -> Some time
| _ -> None)
|> Seq.last
|> getPartOfDay
let doesLightHavePowerAfterInteractions light interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| HumanInteraction(LightPoweredOff l) when l = light -> Some false
| HumanInteraction(LightPoweredOn l) when l = light -> Some true
| _ -> None)
|> Seq.tryLast
|> Option.defaultValue false
let tryGetLastRemoteInteraction interactions =
interactions
|> Seq.indexed
|> Seq.choose (fun interaction ->
match interaction with
| index, Interaction.RemoteInteraction remoteInteraction -> Some(index, remoteInteraction)
| _ -> None)
|> Seq.tryLast
let hasNewDayStartedSince interactions maybeSince =
let maybeLastNightToDayTransitionIndex =
interactions
|> Seq.indexed
|> Seq.choose (fun (index, interaction) ->
match interaction with
| Interaction.TimeChanged time -> Some(index, getPartOfDay time)
| _ -> None)
|> Seq.pairwise
|> Seq.tryFindBack (fun ((_, v1), (_, v2)) -> v1 = Night && v2 = Day)
|> Option.map (fun ((_, _), (i2, _)) -> i2)
match maybeLastNightToDayTransitionIndex, maybeSince with
| Some lastNightToDayTransitionIndex, Some(sinceIndex, _) -> sinceIndex < lastNightToDayTransitionIndex
| Some _, None -> true
| None, _ -> false

View file

@ -9,8 +9,8 @@
<ItemGroup>
<Compile Include="FakeHome.fs" />
<Compile Include="GenHelpers.fs" />
<Compile Include="TimeChangedGenerators.fs" />
<Compile Include="InteractionListGenerators.fs" />
<Compile Include="InteractionListHelpers.fs" />
<Compile Include="LightArbitraries.fs" />
<Compile Include="NightLightTests.fs" />
</ItemGroup>

View file

@ -1,9 +1,8 @@
namespace NightLight.Core.Tests
open NightLight.Core.Core
open NightLight.Core.Tests.GenHelpers
open NightLight.Core.Tests.TimeChangedGenerators
open NightLight.Core.Tests.InteractionListGenerators
open NightLight.Core.Tests.InteractionListHelpers
open NightLight.Core.Models
open FsCheck.Xunit
open FsCheck.FSharp
@ -42,105 +41,50 @@ type NightLightTests() =
|> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0)
[<Property(Arbitrary = [| typeof<ArbitraryInteractions> |])>]
let ``All non-remotely controlled lights that have power should be on`` (interactions: Interaction list) =
let ``All non-remotely controlled lights with power should be on`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let nonRemotelyControlledLightsWithPower =
fakeHome.LightStates
|> Seq.filter (fun (light, _) ->
light.ControlledWithRemote = NonRemote
&& doesLightHavePowerAfterInteractions light interactions)
fakeHome.NonRemotelyControlledLightStates
|> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions)
|> Seq.toList
nonRemotelyControlledLightsWithPower
|> Seq.forall (snd >> _.IsOn)
|> Prop.trivial (nonRemotelyControlledLightsWithPower.Length = 0)
|> Prop.collect $"{nonRemotelyControlledLightsWithPower.Length} non-remotely controlled light(s) with power"
|> Prop.trivial (nonRemotelyControlledLightsWithPower.Length = 0)
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
let ``If the remote was never used, all remote controlled lights with power should be on`` (light: Light) =
genBiasedInteractionsExcept light _.IsRemoteInteraction
|> ensureLightHasPower light
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
[<Property(Arbitrary = [| typeof<ArbitraryInteractions> |])>]
let ``All remotely-controlled lights with power should have the correct state`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOn
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
let ``If the last button that was pressed on the remote is 'On', all remotely controlled lights with power should be on``
(light: Light)
=
genBiasedInteractions light
|> ensureLastRemoteInteractionIs RemotePressedOnButton
|> ensureLightHasPower light
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOn
let remotelyControlledLightsWithPower =
fakeHome.RemotelyControlledLightStates
|> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions)
|> Seq.toList
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
let ``If a new day has started and the remote hasn't been used yet, all remotely controlled lights with power should be on``
(light: Light)
=
concatGens
[ genBiasedInteractions light
|> ensureStartsWithTimeChanged
|> ensurePartOfDayIs Night
genTimeChangedToPartOfDay Day |> Gen.map List.singleton
genBiasedInteractionsExcept light _.IsRemoteInteraction ]
|> ensureLightHasPower light
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOn
let allOn (ls: (Light * LightState) seq) = ls |> Seq.forall (snd >> _.IsOn)
let allOff (ls: (Light * LightState) seq) = ls |> Seq.forall (snd >> _.IsOff)
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
let ``If the last button that was pressed on the remote is 'Off' and a new day hasn't started yet, all remotely controlled lights should be off``
(light: Light)
=
concatGens
[ genBiasedInteractions light
RemoteInteraction RemotePressedOffButton |> List.singleton |> Gen.constant
genBiasedInteractionsExcept light (fun interaction ->
interaction.IsRemoteInteraction || interaction |> isTimeChangedToPartOfDay Day) ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOff
let controlledBy remote ls =
ls |> Seq.filter (fst >> _.ControlledWithRemote >> (=) remote)
[<Property(Arbitrary = [| typeof<ArbitraryLeftRemotelyControlledLight> |])>]
let ``If the last button that was pressed on the remote is 'Left', all left-side remotely controlled lights with power should be on``
(light: Light)
=
genBiasedInteractions light
|> ensureLastRemoteInteractionIs RemotePressedLeftButton
|> ensureStartsWithTimeChanged
|> ensureLightHasPower light
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOn
let maybeLastRemoteInteraction = tryGetLastRemoteInteraction interactions
[<Property(Arbitrary = [| typeof<ArbitraryRightRemotelyControlledLight> |])>]
let ``If the last button that was pressed on the remote is 'Left' and a new day hasn't started yet, all right-side remotely controlled lights should be off``
(light: Light)
=
concatGens
[ genBiasedInteractions light
RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant
genBiasedInteractionsExcept light (fun interaction ->
interaction.IsRemoteInteraction || interaction |> isTimeChangedToPartOfDay Day) ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light _.IsOff
let hasNewDayStartedSinceThen =
hasNewDayStartedSince interactions maybeLastRemoteInteraction
if hasNewDayStartedSinceThen then
remotelyControlledLightsWithPower |> allOn
else
match maybeLastRemoteInteraction with
| Some(_, RemotePressedOnButton) -> remotelyControlledLightsWithPower |> allOn
| Some(_, RemotePressedOffButton) -> remotelyControlledLightsWithPower |> allOff
| Some(_, RemotePressedLeftButton) ->
remotelyControlledLightsWithPower |> controlledBy RemoteLeft |> allOn
&& remotelyControlledLightsWithPower |> controlledBy RemoteRight |> allOff
| None -> remotelyControlledLightsWithPower |> allOn
|> Prop.collect $"last remote interaction is {maybeLastRemoteInteraction}"
|> Prop.collect $"{remotelyControlledLightsWithPower.Length} remotely controlled light(s) with power"
|> Prop.classify hasNewDayStartedSinceThen "new day has started since then"
|> Prop.trivial (remotelyControlledLightsWithPower.Length = 0)

View file

@ -1,28 +0,0 @@
module NightLight.Core.Tests.TimeChangedGenerators
open System
open FsCheck.FSharp
type PartOfDay =
| Day
| Night
let getPartOfDay (dateTime: DateTime) =
match dateTime with
| _ when
dateTime.TimeOfDay >= TimeSpan.FromHours 6
&& dateTime.TimeOfDay < TimeSpan.FromHours 20.5
->
Day
| _ -> Night
let genTimeChanged =
ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
let isTimeChangedToPartOfDay partOfDay interaction =
match interaction with
| TimeChanged time when getPartOfDay time = partOfDay -> true
| _ -> false
let genTimeChangedToPartOfDay (partOfDay: PartOfDay) =
genTimeChanged |> Gen.filter (isTimeChangedToPartOfDay partOfDay)