diff --git a/NightLight.Core.Tests/ArbitraryInteractionLists.fs b/NightLight.Core.Tests/ArbitraryInteractionLists.fs index 9098db1..1a80df4 100644 --- a/NightLight.Core.Tests/ArbitraryInteractionLists.fs +++ b/NightLight.Core.Tests/ArbitraryInteractionLists.fs @@ -8,18 +8,18 @@ let private isDay (time: DateTime) = time.TimeOfDay >= TimeSpan.FromHours 5.5 && time.TimeOfDay < TimeSpan.FromHours 20.5 -type ArbitraryInteractionsListThatEndsDuringTheDay = +type ArbitraryInteractionListThatEndsDuringTheDay = static member InteractionsList() = ArbMap.defaults |> ArbMap.generate |> Gen.filter isDay - |> Gen.bind genInteractionsListThatEndsAtTime + |> Gen.bind genInteractionListThatEndsAtTime |> Arb.fromGen -type ArbitraryInteractionsListThatEndsDuringTheNight = +type ArbitraryInteractionListThatEndsDuringTheNight = static member InteractionsList() = ArbMap.defaults |> ArbMap.generate |> Gen.filter (not << isDay) - |> Gen.bind genInteractionsListThatEndsAtTime + |> Gen.bind genInteractionListThatEndsAtTime |> Arb.fromGen diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index d1e1925..5d620f3 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -17,25 +17,29 @@ let private genHumanInteraction = let private genInteraction = Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] -let private genInteractionsListThatStartsWithTimeChange = +let private genInteractionsListThatStartsWithTimeChanged = gen { let! firstInteraction = genTimeChangedInteraction let! remainingInteractions = Gen.listOf genInteraction return firstInteraction :: remainingInteractions } -let private genInteractionsListWhere condition = - Gen.listOf (genInteraction |> Gen.filter condition) +let private genInteractionListContaining containingInteraction afterFilter = + gen { + let genNonTrivialList = + gen { + let! before = genInteractionsListThatStartsWithTimeChanged + let! after = Gen.listOf (genInteraction |> Gen.filter afterFilter) + return before @ containingInteraction :: after + } -let genInteractionsListThatEndsAtTime time = - let genTrivialList = Gen.constant <| List.singleton (Interaction.TimeChanged time) + return! + match containingInteraction with + | Interaction.TimeChanged _ -> + let genTrivialList = Gen.constant <| List.singleton containingInteraction + Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ] + | _ -> genNonTrivialList + } - let genNonTrivialList = - gen { - let! before = genInteractionsListThatStartsWithTimeChange - let interactionThatSetsEndTime = Interaction.TimeChanged time - let! after = genInteractionsListWhere (not << _.IsTimeChanged) - return before @ interactionThatSetsEndTime :: after - } - - Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ] +let genInteractionListThatEndsAtTime time = + genInteractionListContaining (Interaction.TimeChanged time) (not << _.IsTimeChanged) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 6423a68..a10c86d 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -21,12 +21,12 @@ type NightLightTests() = fakeHome - [ |])>] + [ |])>] let ``Lights should be white or yellow during the day`` (interactions: Interaction list) = let fakeHome = createFakeHomeWithNightLightAndInteract interactions fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) - [ |])>] + [ |])>] let ``Lights should be red during the night`` (interactions: Interaction list) = let fakeHome = createFakeHomeWithNightLightAndInteract interactions fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)