From d57ca238225c116676961aa06495083b660d95e4 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Thu, 8 Jan 2026 21:33:30 +0100 Subject: [PATCH] Make tests target specific lights when testing --- NightLight.Core.Tests/FakeHome.fs | 14 +-- .../InteractionListGenerators.fs | 22 +++-- NightLight.Core.Tests/LightArbitraries.fs | 11 +++ .../NightLight.Core.Tests.fsproj | 1 + NightLight.Core.Tests/NightLightTests.fs | 98 +++++++++---------- 5 files changed, 72 insertions(+), 74 deletions(-) create mode 100644 NightLight.Core.Tests/LightArbitraries.fs diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index bf1b919..ab922b8 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -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 diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index 8ebeba9..e254b1a 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -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 diff --git a/NightLight.Core.Tests/LightArbitraries.fs b/NightLight.Core.Tests/LightArbitraries.fs new file mode 100644 index 0000000..65240f6 --- /dev/null +++ b/NightLight.Core.Tests/LightArbitraries.fs @@ -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 diff --git a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj index 3af4cd3..dc2b44d 100644 --- a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj +++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj @@ -11,6 +11,7 @@ + diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index d84ebcb..2eea0ea 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -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) - - [] - let ``All lights that are on should be white or yellow during the day`` () = + [ |])>] + 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) - [] - let ``All lights that are on should be red during the night`` () = + [ |])>] + 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) - [] - let ``After pressing 'On' on the remote, all lights that have power should be on as long as the 'Off' button isn't pressed`` - () + [ |])>] + 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 - [] + [ |])>] + 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 + + [ |])>] 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) - - [] - 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