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

Rewrite two tests with Prop.classify instead

Browse source
This commit is contained in:
Sven van Heugten 2026-01-16 21:17:37 +01:00
parent 79405b3841
commit f22f31ee6c
3 changed files with 29 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

3
NightLight.Core.Tests/FakeHome.fs
View file

@ -144,5 +144,8 @@ type FakeHome() =
type FakeHome with type FakeHome with
member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact
member this.LightsThatAreOn =
this.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.toList
member this.LightShouldHaveState light condition = member this.LightShouldHaveState light condition =
this.LightStates |> Seq.find (fst >> (=) light) |> snd |> condition this.LightStates |> Seq.find (fst >> (=) light) |> snd |> condition

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

@ -31,6 +31,17 @@ let genBiasedInteractionsExcept biasTowardsLight disqualifier =
let genBiasedInteractions biasTowardsLight = let genBiasedInteractions biasTowardsLight =
genBiasedInteractionsExcept biasTowardsLight (fun _ -> false) 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 ensureStartsWithTimeChanged (genInteractions: Gen<Interaction list>) = let ensureStartsWithTimeChanged (genInteractions: Gen<Interaction list>) =
genInteractions genInteractions
|> Gen.bind (fun interactions -> |> Gen.bind (fun interactions ->

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

@ -25,33 +25,24 @@ type NightLightTests() =
fakeHome fakeHome
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>] [<Property>]
let ``All lights should be either off, white or yellow during the day`` (light: Light) = let ``All lights should either be off or have the right color`` () =
genBiasedInteractions light genInteractions |> ensureStartsWithTimeChanged |> Arb.fromGen |> Prop.forAll
|> ensurePartOfDayIs Day
|> ensureStartsWithTimeChanged
|> Arb.fromGen
|> Prop.forAll
<| fun interactions -> <| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let partOfDay = getPartOfDayAfterInteractions interactions
fakeHome.LightShouldHaveState light (function fakeHome.LightStates
| Off -> true |> Seq.forall (function
| On(_, color) -> color = White || color = Yellow) | _, Off -> true
| _, On(_, color) ->
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>] match partOfDay with
let ``All lights should be either off or red during the night`` (light: Light) = | Day -> color = White || color = Yellow
genBiasedInteractions light | Night -> color = Red)
|> ensurePartOfDayIs Night |> Prop.classify (partOfDay = Day) "day"
|> ensureStartsWithTimeChanged |> Prop.classify (partOfDay = Night) "night"
|> Arb.fromGen |> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0)
|> Prop.forAll |> Prop.collect $"{fakeHome.LightsThatAreOn.Length} light(s) on"
<| fun interactions ->
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.LightShouldHaveState light (function
| Off -> true
| On(_, color) -> color = Red)
[<Property(Arbitrary = [| typeof<ArbitraryNonRemotelyControlledLight> |])>] [<Property(Arbitrary = [| typeof<ArbitraryNonRemotelyControlledLight> |])>]
let ``All non-remotely controlled lights with power should be on`` (light: Light) = let ``All non-remotely controlled lights with power should be on`` (light: Light) =