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

Replace the 'initial interactions' concept with ensureStartsWithTimeChanged

Browse source 
This allows us to generate the case again where the list *just* contains
a TimeChanged interaction.
This commit is contained in:
Sven van Heugten 2026-01-09 19:12:52 +01:00
parent 9087efaab3
commit cefe696f97
2 changed files with 26 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -2,8 +2,8 @@ module NightLight.Core.Tests.InteractionListGenerators
open FsCheck.FSharp
open NightLight.Core.Models
open NightLight.Core.Tests.GenHelpers
open NightLight.Core.Tests.TimeChangedGenerators
open FsCheck
let private genHumanInteraction biasTowardsLight =
let genLightInteraction =
@ -19,17 +19,17 @@ let private genHumanInteraction biasTowardsLight =
let private genInteraction biasTowardsLight =
Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight ]
let genInitialInteractions biasTowardsLight =
[ genTimeChanged |> Gen.map List.singleton
Gen.listOf <| genInteraction biasTowardsLight ]
|> concatGens
let genRandomInteractionsExcept biasTowardsLight disqualifier =
genInteraction biasTowardsLight
|> Gen.filter (not << disqualifier)
|> Gen.listOf
let genInitialInteractionsExcept biasTowardsLight disqualifier =
[ genTimeChanged |> Gen.map List.singleton
genRandomInteractionsExcept biasTowardsLight disqualifier ]
|> concatGens
let genRandomInteractions biasTowardsLight =
genRandomInteractionsExcept biasTowardsLight (fun _ -> false)
let 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))

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

@ -46,9 +46,10 @@ type NightLightTests() =
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``All lights should be either off, white or yellow during the day`` (light: Light) =
concatGens
[ genInitialInteractions light
[ genRandomInteractions light
genTimeChangedToRandomDayTime |> Gen.map List.singleton
genRandomInteractionsExcept light isTimeChangedToAnyNightTime ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
@ -61,9 +62,10 @@ type NightLightTests() =
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``All lights should be either off or red during the night`` (light: Light) =
concatGens
[ genInitialInteractions light
[ genRandomInteractions light
genTimeChangedToRandomNightTime |> Gen.map List.singleton
genRandomInteractionsExcept light isTimeChangedToAnyDayTime ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
@ -75,7 +77,10 @@ type NightLightTests() =
[<Property(Arbitrary = [| typeof<ArbitraryNonRemotelyControlledLight> |])>]
let ``All non-remotely controlled lights should be on iff they have power`` (light: Light) =
genInitialInteractions light |> Arb.fromGen |> Prop.forAll
genRandomInteractions light
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
@ -85,7 +90,8 @@ type NightLightTests() =
let ``All remote controlled lights with power should be on if the 'Off' button on the remote was never pressed``
(light: Light)
=
genInitialInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton))
genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton))
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
@ -99,9 +105,10 @@ type NightLightTests() =
(light: Light)
=
concatGens
[ genInitialInteractions light
[ genRandomInteractions light
HumanInteraction RemotePressedOnButton |> List.singleton |> Gen.constant
genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
@ -115,11 +122,12 @@ type NightLightTests() =
(light: Light)
=
concatGens
[ genInitialInteractions light
[ genRandomInteractions light
genTimeChangedToRandomNightTime |> Gen.map List.singleton
genRandomInteractionsExcept light isTimeChangedToAnyDayTime
genTimeChangedToRandomDayTime |> Gen.map List.singleton
genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->
@ -133,11 +141,12 @@ type NightLightTests() =
(light: Light)
=
concatGens
[ genInitialInteractions light
[ genRandomInteractions light
HumanInteraction RemotePressedOffButton |> List.singleton |> Gen.constant
genRandomInteractionsExcept light (fun interaction ->
interaction = HumanInteraction RemotePressedOnButton
|| interaction |> isTimeChangedToAnyDayTime) ]
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions ->