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

Make tests target specific lights when testing

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

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

@ -135,15 +135,5 @@ type FakeHome() =
type FakeHome with type FakeHome with
member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact
member this.ForAllLightsThatAreOn condition = member this.LightShouldHaveState light condition =
this.LightStates this.LightStates |> Seq.find (fst >> (=) light) |> snd |> condition
|> 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

22
NightLight.Core.Tests/InteractionListGenerators.fs
View file

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

11
NightLight.Core.Tests/LightArbitraries.fs Normal file
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

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

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

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

@ -4,6 +4,7 @@ open NightLight.Core.Core
open NightLight.Core.Tests.GenHelpers open NightLight.Core.Tests.GenHelpers
open NightLight.Core.Tests.TimeChangedGenerators open NightLight.Core.Tests.TimeChangedGenerators
open NightLight.Core.Tests.InteractionListGenerators open NightLight.Core.Tests.InteractionListGenerators
open NightLight.Core.Models
open FsCheck.Xunit open FsCheck.Xunit
open FsCheck.FSharp open FsCheck.FSharp
@ -24,7 +25,7 @@ type NightLightTests() =
fakeHome fakeHome
let doesLightHavePowerAfter interactions light = let doesLightHavePowerAfter light interactions =
interactions interactions
|> Seq.choose (fun interaction -> |> Seq.choose (fun interaction ->
match interaction with match interaction with
@ -34,87 +35,78 @@ type NightLightTests() =
|> Seq.tryLast |> Seq.tryLast
|> Option.defaultValue false |> Option.defaultValue false
let filterToLightsWithPower interactions lights = [<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
lights |> Seq.filter (fst >> doesLightHavePowerAfter interactions) let ``All lights should be either off, white or yellow during the day`` (light: Light) =
[<Property>]
let ``All lights that are on should be white or yellow during the day`` () =
concatGens concatGens
[ genInitialInteractionsAndEndWith =<< genTimeChangedToDay [ genInitialInteractionsAndEndWith light =<< genTimeChangedToDay
genInteractionsExcept isTimeChangedToNight ] genInteractionsExcept light isTimeChangedToNight ]
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) fakeHome.LightShouldHaveState light (function
|> Prop.trivial (fakeHome.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.isEmpty) | Off -> true
| On(_, color) -> color = White || color = Yellow)
[<Property>] [<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
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 concatGens
[ genInitialInteractionsAndEndWith =<< genTimeChangedToNight [ genInitialInteractionsAndEndWith light =<< genTimeChangedToNight
genInteractionsExcept isTimeChangedToDay ] genInteractionsExcept light isTimeChangedToDay ]
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red) fakeHome.LightShouldHaveState light (function
|> Prop.trivial (fakeHome.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.isEmpty) | Off -> true
| On(_, color) -> color = Red)
[<Property>] [<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
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 concatGens
[ genInitialInteractionsAndEndWith (HumanInteraction RemotePressedOnButton) [ genInitialInteractionsAndEndWith light (HumanInteraction RemotePressedOnButton)
genInteractionsExcept ((=) (HumanInteraction RemotePressedOffButton)) ] genInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let lightsWithPower = fakeHome.LightStates |> filterToLightsWithPower interactions
lightsWithPower doesLightHavePowerAfter light interactions
|> Seq.map snd ==> fakeHome.LightShouldHaveState light _.IsOn
|> Seq.forall _.IsOn
|> Prop.trivial (Seq.isEmpty lightsWithPower)
[<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`` 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 concatGens
[ genInitialInteractionsAndEndWith (HumanInteraction RemotePressedOffButton) [ genInitialInteractionsAndEndWith light (HumanInteraction RemotePressedOffButton)
genInteractionsExcept (fun interaction -> genInteractionsExcept light (fun interaction ->
interaction = HumanInteraction RemotePressedOnButton interaction = HumanInteraction RemotePressedOnButton
|| interaction |> isTimeChangedToDay) ] || interaction |> isTimeChangedToDay) ]
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let lightsWithPower = fakeHome.LightStates |> filterToLightsWithPower interactions
fakeHome.ForAllRemotelyControlledLights(fun (_, state) -> state = Off) fakeHome.LightShouldHaveState light _.IsOff
|> 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)