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

Make biasing towards a light optional

Browse source
This commit is contained in:
Sven van Heugten 2026-01-16 20:25:33 +01:00
parent a9331853c0
commit 79405b3841
1 changed files with 11 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -5,8 +5,10 @@ open NightLight.Core.Models
open NightLight.Core.Tests.TimeChangedGenerators open NightLight.Core.Tests.TimeChangedGenerators
open FsCheck open FsCheck
let private genHumanInteraction biasTowardsLight = let private genHumanInteraction maybeBiasTowardsLight =
Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ] match maybeBiasTowardsLight with
| Some biasTowardsLight -> Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ]
| None -> Gen.elements lights
|> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ]) |> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ])
|> Gen.map Interaction.HumanInteraction |> Gen.map Interaction.HumanInteraction
@ -14,11 +16,15 @@ let private genRemoteInteraction =
Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ] Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ]
|> Gen.map RemoteInteraction |> Gen.map RemoteInteraction
let private genInteraction biasTowardsLight = let private genInteraction maybeBiasTowardsLight =
Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight; genRemoteInteraction ] Gen.oneof
[ genTimeChanged
genHumanInteraction maybeBiasTowardsLight
genRemoteInteraction ]
let genBiasedInteractionsExcept biasTowardsLight disqualifier = let genBiasedInteractionsExcept biasTowardsLight disqualifier =
genInteraction biasTowardsLight Some biasTowardsLight
|> genInteraction
|> Gen.filter (not << disqualifier) |> Gen.filter (not << disqualifier)
|> Gen.listOf |> Gen.listOf