Make tests target specific lights when testing

This commit is contained in:
Sven van Heugten 2026-01-08 21:33:30 +01:00
parent 0ddcd17fd4
commit d57ca23822
5 changed files with 72 additions and 74 deletions

View file

@ -135,15 +135,5 @@ type FakeHome() =
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.ForAllRemotelyControlledLights condition =
this.LightStates
|> Seq.filter (fst >> _.ControlledWithRemote)
|> Seq.forall condition
member this.LightShouldHaveState light condition =
this.LightStates |> Seq.find (fst >> (=) light) |> snd |> condition

View file

@ -5,9 +5,9 @@ open NightLight.Core.Models
open NightLight.Core.Tests.GenHelpers
open NightLight.Core.Tests.TimeChangedGenerators
let private genHumanInteraction =
let private genHumanInteraction biasTowardsLight =
let genLightInteraction =
Gen.elements lights
Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ]
|> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ])
let genRemoteInteraction =
@ -16,15 +16,17 @@ let private genHumanInteraction =
Gen.oneof [ genLightInteraction; genRemoteInteraction ]
|> Gen.map Interaction.HumanInteraction
let private genInteraction = Gen.oneof [ genTimeChanged; genHumanInteraction ]
let private genInteraction biasTowardsLight =
Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight ]
let private genInteractionsListThatStartsWithTimeChanged =
[ genTimeChanged |> Gen.map List.singleton; Gen.listOf genInteraction ]
let private genInteractionsListThatStartsWithTimeChanged biasTowardsLight =
[ genTimeChanged |> Gen.map List.singleton
Gen.listOf <| genInteraction biasTowardsLight ]
|> concatGens
let genInitialInteractionsAndEndWith (endsWith: Interaction) =
let genInitialInteractionsAndEndWith biasTowardsLight (endsWith: Interaction) =
let genNonTrivialList =
genInteractionsListThatStartsWithTimeChanged
genInteractionsListThatStartsWithTimeChanged biasTowardsLight
|> Gen.map (fun lst -> lst @ [ endsWith ])
match endsWith with
@ -33,5 +35,7 @@ let genInitialInteractionsAndEndWith (endsWith: Interaction) =
Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ]
| _ -> genNonTrivialList
let genInteractionsExcept disqualifier =
genInteraction |> Gen.filter (not << disqualifier) |> Gen.listOf
let genInteractionsExcept biasTowardsLight disqualifier =
genInteraction biasTowardsLight
|> Gen.filter (not << disqualifier)
|> Gen.listOf

View file

@ -0,0 +1,11 @@
namespace NightLight.Core.Tests
open NightLight.Core.Models
open FsCheck.FSharp
type ArbitraryLight =
static member Light() = lights |> Gen.elements |> Arb.fromGen
type ArbitraryRemotelyControlledLight =
static member Light() =
lights |> Seq.filter _.ControlledWithRemote |> Gen.elements |> Arb.fromGen

View file

@ -11,6 +11,7 @@
<Compile Include="GenHelpers.fs" />
<Compile Include="TimeChangedGenerators.fs" />
<Compile Include="InteractionListGenerators.fs" />
<Compile Include="LightArbitraries.fs" />
<Compile Include="NightLightTests.fs" />
</ItemGroup>

View file

@ -4,6 +4,7 @@ open NightLight.Core.Core
open NightLight.Core.Tests.GenHelpers
open NightLight.Core.Tests.TimeChangedGenerators
open NightLight.Core.Tests.InteractionListGenerators
open NightLight.Core.Models
open FsCheck.Xunit
open FsCheck.FSharp
@ -24,7 +25,7 @@ type NightLightTests() =
fakeHome
let doesLightHavePowerAfter interactions light =
let doesLightHavePowerAfter light interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
@ -34,87 +35,78 @@ type NightLightTests() =
|> Seq.tryLast
|> Option.defaultValue false
let filterToLightsWithPower interactions lights =
lights |> Seq.filter (fst >> doesLightHavePowerAfter interactions)
[<Property>]
let ``All lights that are on should be white or yellow during the day`` () =
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``All lights should be either off, white or yellow during the day`` (light: Light) =
concatGens
[ genInitialInteractionsAndEndWith =<< genTimeChangedToDay
genInteractionsExcept isTimeChangedToNight ]
[ genInitialInteractionsAndEndWith light =<< genTimeChangedToDay
genInteractionsExcept light isTimeChangedToNight ]
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)
|> Prop.trivial (fakeHome.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.isEmpty)
fakeHome.LightShouldHaveState light (function
| Off -> true
| On(_, color) -> color = White || color = Yellow)
[<Property>]
let ``All lights that are on should be red during the night`` () =
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``All lights should be either off or red during the night`` (light: Light) =
concatGens
[ genInitialInteractionsAndEndWith =<< genTimeChangedToNight
genInteractionsExcept isTimeChangedToDay ]
[ genInitialInteractionsAndEndWith light =<< genTimeChangedToNight
genInteractionsExcept light isTimeChangedToDay ]
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)
|> Prop.trivial (fakeHome.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.isEmpty)
fakeHome.LightShouldHaveState light (function
| Off -> true
| On(_, color) -> color = Red)
[<Property>]
let ``After pressing 'On' on the remote, all lights that have power should be on as long as the 'Off' button isn't pressed``
()
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``After pressing 'On' on the remote, all lights with power should be on, as long as the 'Off' button isn't pressed``
(light: Light)
=
concatGens
[ genInitialInteractionsAndEndWith (HumanInteraction RemotePressedOnButton)
genInteractionsExcept ((=) (HumanInteraction RemotePressedOffButton)) ]
[ genInitialInteractionsAndEndWith light (HumanInteraction RemotePressedOnButton)
genInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let lightsWithPower = fakeHome.LightStates |> filterToLightsWithPower interactions
lightsWithPower
|> Seq.map snd
|> Seq.forall _.IsOn
|> Prop.trivial (Seq.isEmpty lightsWithPower)
doesLightHavePowerAfter light interactions
==> fakeHome.LightShouldHaveState light _.IsOn
[<Property>]
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``After a new day starts, all lights with power should be on, as long as the 'Off' button isn't pressed``
(light: Light)
=
concatGens
[ genInitialInteractionsAndEndWith light =<< genTimeChangedToNight
genInteractionsExcept light isTimeChangedToDay
genTimeChangedToDay |> Gen.map List.singleton
genInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
doesLightHavePowerAfter light interactions
==> fakeHome.LightShouldHaveState light _.IsOn
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
let ``After pressing 'Off' on the remote, all remotely controlled lights should be off as long as the 'On' button isn't pressed and a new day doesn't start``
()
(light: Light)
=
concatGens
[ genInitialInteractionsAndEndWith (HumanInteraction RemotePressedOffButton)
genInteractionsExcept (fun interaction ->
[ genInitialInteractionsAndEndWith light (HumanInteraction RemotePressedOffButton)
genInteractionsExcept light (fun interaction ->
interaction = HumanInteraction RemotePressedOnButton
|| interaction |> isTimeChangedToDay) ]
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let lightsWithPower = fakeHome.LightStates |> filterToLightsWithPower interactions
fakeHome.ForAllRemotelyControlledLights(fun (_, state) -> state = Off)
|> Prop.trivial (Seq.isEmpty lightsWithPower)
[<Property>]
let ``After a new day starts, all lights that have power should be on as long as the 'Off' button isn't pressed``
()
=
concatGens
[ genInitialInteractionsAndEndWith =<< genTimeChangedToNight
genInteractionsExcept isTimeChangedToDay
genTimeChangedToDay |> Gen.map List.singleton
genInteractionsExcept ((=) (HumanInteraction RemotePressedOffButton)) ]
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let lightsWithPower = fakeHome.LightStates |> filterToLightsWithPower interactions
lightsWithPower
|> Seq.map snd
|> Seq.forall _.IsOn
|> Prop.trivial (Seq.isEmpty lightsWithPower)
fakeHome.LightShouldHaveState light _.IsOff