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

Introduce ensurePartOfDayIs

Browse source
This commit is contained in:
Sven van Heugten 2026-01-14 21:50:47 +01:00
parent 8f53033db4
commit b3689108a7
3 changed files with 46 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -49,3 +49,21 @@ let ensureLightHasPower (light: Light) (genInteractions: Gen<Interaction list>)
interactions interactions
else else
interactions @ [ HumanInteraction(LightPoweredOn light) ]) interactions @ [ HumanInteraction(LightPoweredOn light) ])
let ensurePartOfDayIs (desiredPartOfDay: PartOfDay) (genInteractions: Gen<Interaction list>) =
genInteractions
|> Gen.bind (fun interactions ->
let maybeActualTime =
interactions
|> Seq.choose (fun interaction ->
match interaction with
| Interaction.TimeChanged time -> Some time
| _ -> None)
|> Seq.tryLast
if maybeActualTime |> Option.map getPartOfDay = Some desiredPartOfDay then
Gen.constant interactions
else
desiredPartOfDay
|> genTimeChangedToPartOfDay
|> Gen.map (fun tc -> interactions @ [ tc ]))

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

@ -27,10 +27,8 @@ type NightLightTests() =
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>] [<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``All lights should be either off, white or yellow during the day`` (light: Light) = let ``All lights should be either off, white or yellow during the day`` (light: Light) =
concatGens genRandomInteractions light
[ genRandomInteractions light |> ensurePartOfDayIs Day
genTimeChangedToRandomDayTime |> Gen.map List.singleton
genRandomInteractionsExcept light isTimeChangedToAnyNightTime ]
|> ensureStartsWithTimeChanged |> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
@ -43,10 +41,8 @@ type NightLightTests() =
[<Property(Arbitrary = [| typeof<ArbitraryLight> |])>] [<Property(Arbitrary = [| typeof<ArbitraryLight> |])>]
let ``All lights should be either off or red during the night`` (light: Light) = let ``All lights should be either off or red during the night`` (light: Light) =
concatGens genRandomInteractions light
[ genRandomInteractions light |> ensurePartOfDayIs Night
genTimeChangedToRandomNightTime |> Gen.map List.singleton
genRandomInteractionsExcept light isTimeChangedToAnyDayTime ]
|> ensureStartsWithTimeChanged |> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
@ -60,8 +56,8 @@ type NightLightTests() =
[<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) =
genRandomInteractions light genRandomInteractions light
|> ensureStartsWithTimeChanged
|> ensureLightHasPower light |> ensureLightHasPower light
|> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
@ -71,8 +67,8 @@ type NightLightTests() =
[<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>] [<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
let ``All remote controlled lights with power should be on if the remote was never used`` (light: Light) = let ``All remote controlled lights with power should be on if the remote was never used`` (light: Light) =
genRandomInteractionsExcept light _.IsRemoteInteraction genRandomInteractionsExcept light _.IsRemoteInteraction
|> ensureStartsWithTimeChanged
|> ensureLightHasPower light |> ensureLightHasPower light
|> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
@ -87,8 +83,8 @@ type NightLightTests() =
[ genRandomInteractions light [ genRandomInteractions light
RemoteInteraction RemotePressedOnButton |> List.singleton |> Gen.constant RemoteInteraction RemotePressedOnButton |> List.singleton |> Gen.constant
genRandomInteractionsExcept light _.IsRemoteInteraction ] genRandomInteractionsExcept light _.IsRemoteInteraction ]
|> ensureStartsWithTimeChanged
|> ensureLightHasPower light |> ensureLightHasPower light
|> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
<| fun interactions -> <| fun interactions ->
@ -100,10 +96,8 @@ type NightLightTests() =
(light: Light) (light: Light)
= =
concatGens concatGens
[ genRandomInteractions light [ genRandomInteractions light |> ensurePartOfDayIs Night
genTimeChangedToRandomNightTime |> Gen.map List.singleton genTimeChangedToPartOfDay Day |> Gen.map List.singleton
genRandomInteractionsExcept light isTimeChangedToAnyDayTime
genTimeChangedToRandomDayTime |> Gen.map List.singleton
genRandomInteractionsExcept light _.IsRemoteInteraction ] genRandomInteractionsExcept light _.IsRemoteInteraction ]
|> ensureStartsWithTimeChanged |> ensureStartsWithTimeChanged
|> ensureLightHasPower light |> ensureLightHasPower light
@ -121,7 +115,7 @@ type NightLightTests() =
[ genRandomInteractions light [ genRandomInteractions light
RemoteInteraction RemotePressedOffButton |> List.singleton |> Gen.constant RemoteInteraction RemotePressedOffButton |> List.singleton |> Gen.constant
genRandomInteractionsExcept light (fun interaction -> genRandomInteractionsExcept light (fun interaction ->
interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ] interaction.IsRemoteInteraction || interaction |> isTimeChangedToPartOfDay Day) ]
|> ensureStartsWithTimeChanged |> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll
@ -153,7 +147,7 @@ type NightLightTests() =
[ genRandomInteractions light [ genRandomInteractions light
RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant
genRandomInteractionsExcept light (fun interaction -> genRandomInteractionsExcept light (fun interaction ->
interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ] interaction.IsRemoteInteraction || interaction |> isTimeChangedToPartOfDay Day) ]
|> ensureStartsWithTimeChanged |> ensureStartsWithTimeChanged
|> Arb.fromGen |> Arb.fromGen
|> Prop.forAll |> Prop.forAll

32
NightLight.Core.Tests/TimeChangedGenerators.fs
View file

@ -3,24 +3,26 @@ module NightLight.Core.Tests.TimeChangedGenerators
open System open System
open FsCheck.FSharp open FsCheck.FSharp
let private isDay (time: DateTime) = type PartOfDay =
time.TimeOfDay >= TimeSpan.FromHours 6 | Day
&& time.TimeOfDay < TimeSpan.FromHours 20.5 | Night
let private isTimeChangedMeetingCondition condition interaction = let getPartOfDay (dateTime: DateTime) =
match interaction with match dateTime with
| TimeChanged time when condition time -> true | _ when
| _ -> false dateTime.TimeOfDay >= TimeSpan.FromHours 6
&& dateTime.TimeOfDay < TimeSpan.FromHours 20.5
let isTimeChangedToAnyDayTime = isTimeChangedMeetingCondition isDay ->
Day
let isTimeChangedToAnyNightTime = isTimeChangedMeetingCondition (not << isDay) | _ -> Night
let genTimeChanged = let genTimeChanged =
ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
let genTimeChangedToRandomDayTime = let isTimeChangedToPartOfDay partOfDay interaction =
genTimeChanged |> Gen.filter isTimeChangedToAnyDayTime match interaction with
| TimeChanged time when getPartOfDay time = partOfDay -> true
| _ -> false
let genTimeChangedToRandomNightTime = let genTimeChangedToPartOfDay (partOfDay: PartOfDay) =
genTimeChanged |> Gen.filter isTimeChangedToAnyNightTime genTimeChanged |> Gen.filter (isTimeChangedToPartOfDay partOfDay)