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

Generalize the genInteractionListThatEndsAtTime concept

Browse source
This commit is contained in:
Sven van Heugten 2026-01-05 21:32:14 +01:00
parent 9e97d9a37b
commit 14cfaaeed5
3 changed files with 24 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

8
NightLight.Core.Tests/ArbitraryInteractionLists.fs
View file

@ -8,18 +8,18 @@ let private isDay (time: DateTime) =
time.TimeOfDay >= TimeSpan.FromHours 5.5 time.TimeOfDay >= TimeSpan.FromHours 5.5
&& time.TimeOfDay < TimeSpan.FromHours 20.5 && time.TimeOfDay < TimeSpan.FromHours 20.5
type ArbitraryInteractionsListThatEndsDuringTheDay = type ArbitraryInteractionListThatEndsDuringTheDay =
static member InteractionsList() = static member InteractionsList() =
ArbMap.defaults ArbMap.defaults
|> ArbMap.generate<DateTime> |> ArbMap.generate<DateTime>
|> Gen.filter isDay |> Gen.filter isDay
|> Gen.bind genInteractionsListThatEndsAtTime |> Gen.bind genInteractionListThatEndsAtTime
|> Arb.fromGen |> Arb.fromGen
type ArbitraryInteractionsListThatEndsDuringTheNight = type ArbitraryInteractionListThatEndsDuringTheNight =
static member InteractionsList() = static member InteractionsList() =
ArbMap.defaults ArbMap.defaults
|> ArbMap.generate<DateTime> |> ArbMap.generate<DateTime>
|> Gen.filter (not << isDay) |> Gen.filter (not << isDay)
|> Gen.bind genInteractionsListThatEndsAtTime |> Gen.bind genInteractionListThatEndsAtTime
|> Arb.fromGen |> Arb.fromGen

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

@ -17,25 +17,29 @@ let private genHumanInteraction =
let private genInteraction = let private genInteraction =
Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ]
let private genInteractionsListThatStartsWithTimeChange = let private genInteractionsListThatStartsWithTimeChanged =
gen { gen {
let! firstInteraction = genTimeChangedInteraction let! firstInteraction = genTimeChangedInteraction
let! remainingInteractions = Gen.listOf genInteraction let! remainingInteractions = Gen.listOf genInteraction
return firstInteraction :: remainingInteractions return firstInteraction :: remainingInteractions
} }
let private genInteractionsListWhere condition = let private genInteractionListContaining containingInteraction afterFilter =
Gen.listOf (genInteraction |> Gen.filter condition) gen {
let genInteractionsListThatEndsAtTime time =
let genTrivialList = Gen.constant <| List.singleton (Interaction.TimeChanged time)
let genNonTrivialList = let genNonTrivialList =
gen { gen {
let! before = genInteractionsListThatStartsWithTimeChange let! before = genInteractionsListThatStartsWithTimeChanged
let interactionThatSetsEndTime = Interaction.TimeChanged time let! after = Gen.listOf (genInteraction |> Gen.filter afterFilter)
let! after = genInteractionsListWhere (not << _.IsTimeChanged) return before @ containingInteraction :: after
return before @ interactionThatSetsEndTime :: after
} }
return!
match containingInteraction with
| Interaction.TimeChanged _ ->
let genTrivialList = Gen.constant <| List.singleton containingInteraction
Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ] Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ]
| _ -> genNonTrivialList
}
let genInteractionListThatEndsAtTime time =
genInteractionListContaining (Interaction.TimeChanged time) (not << _.IsTimeChanged)

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

@ -21,12 +21,12 @@ type NightLightTests() =
fakeHome fakeHome
[<Property(Arbitrary = [| typeof<ArbitraryInteractionsListThatEndsDuringTheDay> |])>] [<Property(Arbitrary = [| typeof<ArbitraryInteractionListThatEndsDuringTheDay> |])>]
let ``Lights should be white or yellow during the day`` (interactions: Interaction list) = let ``Lights should be white or yellow during the day`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)
[<Property(Arbitrary = [| typeof<ArbitraryInteractionsListThatEndsDuringTheNight> |])>] [<Property(Arbitrary = [| typeof<ArbitraryInteractionListThatEndsDuringTheNight> |])>]
let ``Lights should be red during the night`` (interactions: Interaction list) = let ``Lights should be red during the night`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red) fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)