Introduce ensurePartOfDayIs

NightLight.Core.Tests/InteractionListGenerators.fs

@@ -49,3 +49,21 @@ let ensureLightHasPower (light: Light) (genInteractions: Gen<Interaction list>)
             interactions
         else
             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 ]))

NightLight.Core.Tests/NightLightTests.fs

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

NightLight.Core.Tests/TimeChangedGenerators.fs

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