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

Re-write the remaining tests

Browse source
This commit is contained in:
Sven van Heugten 2026-01-17 10:03:17 +01:00
parent ec90147c07
commit 62c8e446c9
6 changed files with 116 additions and 199 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1,14 +1,15 @@
module NightLight.Core.Tests.InteractionListGenerators
open FsCheck.FSharp
open System
open NightLight.Core.Models
open NightLight.Core.Tests.TimeChangedGenerators
open FsCheck
open FsCheck.FSharp
let private genHumanInteraction maybeBiasTowardsLight =
match maybeBiasTowardsLight with
| Some biasTowardsLight -> Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ]
| None -> Gen.elements lights
let private genTimeChanged =
ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
let private genHumanInteraction =
Gen.elements lights
|> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ])
|> Gen.map Interaction.HumanInteraction
@ -16,86 +17,18 @@ let private genRemoteInteraction =
Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ]
|> Gen.map RemoteInteraction
let private genInteraction maybeBiasTowardsLight =
Gen.oneof
[ genTimeChanged
genHumanInteraction maybeBiasTowardsLight
genRemoteInteraction ]
let private genInteraction =
Gen.oneof [ genTimeChanged; genHumanInteraction; genRemoteInteraction ]
let genBiasedInteractionsExcept biasTowardsLight disqualifier =
Some biasTowardsLight
|> genInteraction
|> Gen.filter (not << disqualifier)
|> Gen.listOf
let private genInteractions = genInteraction |> Gen.listOf
let genBiasedInteractions biasTowardsLight =
genBiasedInteractionsExcept biasTowardsLight (fun _ -> false)
let genInteractions = genInteraction None |> Gen.listOf
let getPartOfDayAfterInteractions interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| Interaction.TimeChanged time -> Some time
| _ -> None)
|> Seq.last
|> getPartOfDay
let doesLightHavePowerAfterInteractions light interactions =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| HumanInteraction(LightPoweredOff l) when l = light -> Some false
| HumanInteraction(LightPoweredOn l) when l = light -> Some true
| _ -> None)
|> Seq.tryLast
|> Option.defaultValue false
let ensureStartsWithTimeChanged (genInteractions: Gen<Interaction list>) =
let private 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))
let ensureLightHasPower (light: Light) (genInteractions: Gen<Interaction list>) =
genInteractions
|> Gen.map (fun interactions ->
if doesLightHavePowerAfterInteractions light interactions then
interactions
else
interactions @ [ HumanInteraction(LightPoweredOn light) ])
let ensurePartOfDayIs (desiredPartOfDay: PartOfDay) (genInteractions: Gen<Interaction list>) =
genInteractions
|> Gen.bind (fun interactions ->
if getPartOfDayAfterInteractions interactions = desiredPartOfDay then
Gen.constant interactions
else
desiredPartOfDay
|> genTimeChangedToPartOfDay
|> Gen.map (fun tc -> interactions @ [ tc ]))
let ensureLastRemoteInteractionIs
(desiredLastRemoteInteraction: RemoteInteraction)
(genInteractions: Gen<Interaction list>)
=
genInteractions
|> Gen.map (fun interactions ->
let maybeLastRemoteInteraction =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| Interaction.RemoteInteraction remoteInteraction -> Some remoteInteraction
| _ -> None)
|> Seq.tryLast
if maybeLastRemoteInteraction = Some desiredLastRemoteInteraction then
interactions
else
interactions @ [ RemoteInteraction desiredLastRemoteInteraction ])
type ArbitraryInteractions() =
static member Interactions() =
genInteractions |> ensureStartsWithTimeChanged |> Arb.fromGen