Automatically turn on lights at dawn

NightLight.Core.Tests/GenHelpers.fs

@@ -0,0 +1,9 @@
+module NightLight.Core.Tests.GenHelpers
+
+open FsCheck
+open FsCheck.FSharp
+
+let concatGens (gens: Gen<'a list> list) : Gen<'a list> =
+    match gens with
+    | [] -> Gen.constant []
+    | first :: rest -> rest |> List.fold (fun accGen g -> Gen.map2 (@) accGen g) first

NightLight.Core.Tests/InteractionListGenerators.fs

@@ -1,11 +1,9 @@
 module NightLight.Core.Tests.InteractionListGenerators
 
-open System
 open FsCheck.FSharp
 open NightLight.Core.Models
-
+open NightLight.Core.Tests.GenHelpers
-let private genTimeChangedInteraction =
+open NightLight.Core.Tests.TimeChangedGenerators
-    ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
 
 let private genHumanInteraction =
     let genLightInteraction =
@@ -18,29 +16,22 @@ let private genHumanInteraction =
     Gen.oneof [ genLightInteraction; genRemoteInteraction ]
     |> Gen.map Interaction.HumanInteraction
 
-let private genInteraction =
+let private genInteraction = Gen.oneof [ genTimeChanged; genHumanInteraction ]
-    Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ]
 
 let private genInteractionsListThatStartsWithTimeChanged =
-    gen {
+    [ genTimeChanged |> Gen.map List.singleton; Gen.listOf genInteraction ]
-        let! firstInteraction = genTimeChangedInteraction
+    |> concatGens
-        let! remainingInteractions = Gen.listOf genInteraction
-        return firstInteraction :: remainingInteractions
-    }
 
-let genInteractionListContaining containingInteraction disqualifiedAfter =
+let genInteractionListThatStartsWithTimeChangedAndEndsWith (endsWith: Interaction) =
-    gen {
+    let genNonTrivialList =
-        let genNonTrivialList =
+        genInteractionsListThatStartsWithTimeChanged
-            gen {
+        |> Gen.map (fun lst -> lst @ [ endsWith ])
-                let! before = genInteractionsListThatStartsWithTimeChanged
-                let! after = Gen.listOf (genInteraction |> Gen.filter (not << disqualifiedAfter))
-                return before @ containingInteraction :: after
-            }
 
-        return!
+    match endsWith with
-            match containingInteraction with
+    | Interaction.TimeChanged _ ->
-            | Interaction.TimeChanged _ ->
+        let genTrivialList = Gen.constant <| List.singleton endsWith
-                let genTrivialList = Gen.constant <| List.singleton containingInteraction
+        Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ]
-                Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ]
+    | _ -> genNonTrivialList
-            | _ -> genNonTrivialList
+
-    }
+let genInteractionListExcept disqualifier =
+    genInteraction |> Gen.filter (not << disqualifier) |> Gen.listOf

NightLight.Core.Tests/NightLight.Core.Tests.fsproj

@@ -8,8 +8,9 @@
 
     <ItemGroup>
         <Compile Include="FakeHome.fs" />
-        <Compile Include="InteractionListGenerators.fs" />
+        <Compile Include="GenHelpers.fs" />
         <Compile Include="TimeChangedGenerators.fs" />
+        <Compile Include="InteractionListGenerators.fs" />
         <Compile Include="NightLightTests.fs" />
     </ItemGroup>
 

NightLight.Core.Tests/NightLightTests.fs

@@ -1,6 +1,7 @@
 namespace NightLight.Core.Tests
 
 open NightLight.Core.Core
+open NightLight.Core.Tests.GenHelpers
 open NightLight.Core.Tests.TimeChangedGenerators
 open NightLight.Core.Tests.InteractionListGenerators
 open FsCheck.Xunit
@@ -38,8 +39,9 @@ type NightLightTests() =
 
     [<Property>]
     let ``All lights that are on should be white or yellow during the day`` () =
-        genTimeChangedToDay
+        concatGens
-        |> Gen.bind (fun timeChangedToDay -> genInteractionListContaining timeChangedToDay _.IsTimeChanged)
+            [ Gen.bind genInteractionListThatStartsWithTimeChangedAndEndsWith genTimeChangedToDay
+              genInteractionListExcept isTimeChangedToNight ]
         |> Arb.fromGen
         |> Prop.forAll
         <| fun interactions ->
@@ -50,8 +52,9 @@ type NightLightTests() =
 
     [<Property>]
     let ``All lights that are on should be red during the night`` () =
-        genTimeChangedToNight
+        concatGens
-        |> Gen.bind (fun timeChangedToNight -> genInteractionListContaining timeChangedToNight _.IsTimeChanged)
+            [ Gen.bind genInteractionListThatStartsWithTimeChangedAndEndsWith genTimeChangedToNight
+              genInteractionListExcept isTimeChangedToDay ]
         |> Arb.fromGen
         |> Prop.forAll
         <| fun interactions ->
@@ -61,13 +64,12 @@ type NightLightTests() =
             |> Prop.trivial (fakeHome.LightStates |> Seq.filter (snd >> _.IsOn) |> Seq.isEmpty)
 
     [<Property>]
-    let ``After pressing 'On' on the remote, the remotely controlled lights that have power should be on until they are powered off or 'Off' is pressed``
+    let ``After pressing 'On' on the remote, all lights that have power should be on as long as the 'Off' button isn't pressed``
         ()
         =
-        genInteractionListContaining (HumanInteraction RemotePressedOnButton) (function
+        concatGens
-            | HumanInteraction RemotePressedOffButton -> true
+            [ genInteractionListThatStartsWithTimeChangedAndEndsWith (HumanInteraction RemotePressedOnButton)
-            | HumanInteraction(LightPoweredOff l) when l.ControlledWithRemote -> true
+              genInteractionListExcept ((=) (HumanInteraction RemotePressedOffButton)) ]
-            | _ -> false)
         |> Arb.fromGen
         |> Prop.forAll
         <| fun interactions ->
@@ -80,12 +82,14 @@ type NightLightTests() =
             |> Prop.trivial (Seq.isEmpty lightsWithPower)
 
     [<Property>]
-    let ``After pressing 'Off' on the remote, the remotely controlled lights should stay off until 'On' is pressed``
+    let ``After pressing 'Off' on the remote, all lights that have power should be on as long as the 'On' button isn't pressed and a new day doesn't start``
         ()
         =
-        genInteractionListContaining
+        concatGens
-            (HumanInteraction RemotePressedOffButton)
+            [ genInteractionListThatStartsWithTimeChangedAndEndsWith (HumanInteraction RemotePressedOffButton)
-            ((=) (HumanInteraction RemotePressedOnButton))
+              genInteractionListExcept (fun interaction ->
+                  interaction = HumanInteraction RemotePressedOnButton
+                  || interaction |> isTimeChangedToDay) ]
         |> Arb.fromGen
         |> Prop.forAll
         <| fun interactions ->
@@ -94,3 +98,23 @@ type NightLightTests() =
 
             fakeHome.ForAllRemotelyControlledLights(fun (_, state) -> state = Off)
             |> Prop.trivial (Seq.isEmpty lightsWithPower)
+
+    [<Property>]
+    let ``After a new day starts, all lights that have power should be on as long as the 'Off' button isn't pressed``
+        ()
+        =
+        concatGens
+            [ Gen.bind genInteractionListThatStartsWithTimeChangedAndEndsWith genTimeChangedToNight
+              genInteractionListExcept isTimeChangedToDay
+              Gen.map List.singleton genTimeChangedToDay
+              genInteractionListExcept ((=) (HumanInteraction RemotePressedOffButton)) ]
+        |> Arb.fromGen
+        |> Prop.forAll
+        <| fun interactions ->
+            let fakeHome = createFakeHomeWithNightLightAndInteract interactions
+            let lightsWithPower = fakeHome.LightStates |> filterToLightsWithPower interactions
+
+            lightsWithPower
+            |> Seq.map snd
+            |> Seq.forall _.IsOn
+            |> Prop.trivial (Seq.isEmpty lightsWithPower)

NightLight.Core.Tests/TimeChangedGenerators.fs

@@ -7,14 +7,18 @@ let private isDay (time: DateTime) =
     time.TimeOfDay >= TimeSpan.FromHours 5.5
     && time.TimeOfDay < TimeSpan.FromHours 20.5
 
-let genTimeChangedToDay =
+let private isTimeChangedMeetingCondition condition interaction =
-    ArbMap.defaults
+    match interaction with
-    |> ArbMap.generate<DateTime>
+    | TimeChanged time when condition time -> true
-    |> Gen.filter isDay
+    | _ -> false
-    |> Gen.map Interaction.TimeChanged
 
-let genTimeChangedToNight =
+let isTimeChangedToDay = isTimeChangedMeetingCondition isDay
-    ArbMap.defaults
+
-    |> ArbMap.generate<DateTime>
+let isTimeChangedToNight = isTimeChangedMeetingCondition (not << isDay)
-    |> Gen.filter (not << isDay)
+
-    |> Gen.map Interaction.TimeChanged
+let genTimeChanged =
+    ArbMap.defaults |> ArbMap.generate<DateTime> |> Gen.map Interaction.TimeChanged
+
+let genTimeChangedToDay = genTimeChanged |> Gen.filter isTimeChangedToDay
+
+let genTimeChangedToNight = genTimeChanged |> Gen.filter isTimeChangedToNight

NightLight.Core/NightLightStateMachine.fs

@@ -28,6 +28,11 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M
     member this.OnEventReceived(event: Event) : Result<NightLightStateMachine * Message seq, OnEventReceivedError> =
         result {
             let maybePartOfDay = maybeTime |> Option.map getPartOfDay
+            let remoteControlledLights = lights |> Seq.filter _.ControlledWithRemote
+
+            let updateLightStateForRemoteControlledLights desiredLightState =
+                remoteControlledLights
+                |> Seq.fold (fun acc key -> Map.add key desiredLightState acc) lightToState
 
             match event, maybePartOfDay with
             | ReceivedZigbeeEvent payload, Some partOfDay ->
@@ -48,25 +53,30 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M
                             | PressedOn -> On
                             | PressedOff -> Off
 
-                        let remoteControlledLights = lights |> Seq.filter _.ControlledWithRemote
+                        let newLightToState = updateLightStateForRemoteControlledLights desiredLightState
-
-                        let newLightToState =
-                            remoteControlledLights
-                            |> Seq.fold (fun acc key -> Map.add key desiredLightState acc) lightToState
 
                         NightLightStateMachine(maybeTime, newLightToState),
                         remoteControlledLights
                         |> Seq.collect (fun light -> generateZigbeeCommandsToFixLight desiredLightState partOfDay light)
             | TimeChanged newTime, maybePartOfDay ->
-                let newState = NightLightStateMachine(Some newTime, lightToState)
                 let newPartOfDay = getPartOfDay newTime
 
+                let partOfDayChanged = maybePartOfDay <> Some newPartOfDay
+
+                let newLightToState =
+                    if partOfDayChanged && newPartOfDay = Day then
+                        updateLightStateForRemoteControlledLights On
+                    else
+                        lightToState
+
+                let newState = NightLightStateMachine(Some newTime, newLightToState)
+
                 return
                     newState,
-                    if maybePartOfDay <> Some newPartOfDay then
+                    if partOfDayChanged then
                         lights
                         |> Seq.collect (fun light ->
-                            generateZigbeeCommandsToFixLight lightToState[light] newPartOfDay light)
+                            generateZigbeeCommandsToFixLight newLightToState[light] newPartOfDay light)
                     else
                         Seq.empty
             | _, None -> return! Error TimeIsUnknown