Merge pull request #11 from svenvanheugten/half-off

Implement the "Left" button on the remote

NightLight.Core.Tests/FakeHome.fs

@@ -6,14 +6,18 @@ open NightLight.Core.Models
 open FsToolkit.ErrorHandling
 open FSharp.Data
 
+type RemoteInteraction =
+    | RemotePressedOnButton
+    | RemotePressedOffButton
+    | RemotePressedLeftButton
+
 type HumanInteraction =
     | LightPoweredOn of Light
     | LightPoweredOff of Light
-    | RemotePressedOnButton
-    | RemotePressedOffButton
 
 type Interaction =
     | HumanInteraction of HumanInteraction
+    | RemoteInteraction of RemoteInteraction
     | TimeChanged of DateTime
 
 type Color =
@@ -120,16 +124,21 @@ type FakeHome() =
             |> ReceivedZigbeeEvent
             |> onEventPublished.Trigger
         | HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[light.FriendlyName].PowerOff()
-        | HumanInteraction RemotePressedOnButton ->
+        | RemoteInteraction RemotePressedOnButton ->
             { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
               Payload = @"{ ""action"": ""on"" }" }
             |> ReceivedZigbeeEvent
             |> onEventPublished.Trigger
-        | HumanInteraction RemotePressedOffButton ->
+        | RemoteInteraction RemotePressedOffButton ->
             { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
               Payload = @"{ ""action"": ""off"" }" }
             |> ReceivedZigbeeEvent
             |> onEventPublished.Trigger
+        | RemoteInteraction RemotePressedLeftButton ->
+            { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
+              Payload = @"{ ""action"": ""arrow_left_click"" }" }
+            |> ReceivedZigbeeEvent
+            |> onEventPublished.Trigger
         | TimeChanged newTime -> newTime |> Event.TimeChanged |> onEventPublished.Trigger
 
 type FakeHome with

NightLight.Core.Tests/InteractionListGenerators.fs

@@ -6,16 +6,14 @@ open NightLight.Core.Tests.TimeChangedGenerators
 open FsCheck
 
 let private genHumanInteraction biasTowardsLight =
-    let genLightInteraction =
+    Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ]
-        Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ]
+    |> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ])
-        |> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ])
-
-    let genRemoteInteraction =
-        Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ]
-
-    Gen.oneof [ genLightInteraction; genRemoteInteraction ]
     |> Gen.map Interaction.HumanInteraction
 
+let private genRemoteInteraction =
+    Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ]
+    |> Gen.map RemoteInteraction
+
 let private genInteraction biasTowardsLight =
     Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight ]
 

NightLight.Core.Tests/LightArbitraries.fs

@@ -9,10 +9,24 @@ type ArbitraryLight =
 type ArbitraryNonRemotelyControlledLight =
     static member Light() =
         lights
-        |> Seq.filter (not << _.ControlledWithRemote)
+        |> Seq.filter _.ControlledWithRemote.IsNonRemote
+        |> Gen.elements
+        |> Arb.fromGen
+
+type ArbitraryLeftRemotelyControlledLight =
+    static member Light() =
+        remoteControlledLights
+        |> Seq.filter _.ControlledWithRemote.IsRemoteLeft
+        |> Gen.elements
+        |> Arb.fromGen
+
+type ArbitraryRightRemotelyControlledLight =
+    static member Light() =
+        remoteControlledLights
+        |> Seq.filter _.ControlledWithRemote.IsRemoteRight
         |> Gen.elements
         |> Arb.fromGen
 
 type ArbitraryRemotelyControlledLight =
     static member Light() =
-        lights |> Seq.filter _.ControlledWithRemote |> Gen.elements |> Arb.fromGen
+        remoteControlledLights |> Gen.elements |> Arb.fromGen

NightLight.Core.Tests/NightLightTests.fs

@@ -69,10 +69,8 @@ type NightLightTests() =
             fakeHome.LightShouldHaveState light _.IsOn
 
     [<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
-    let ``All remote controlled lights with power should be on if the 'Off' button on the remote was never pressed``
+    let ``All remote controlled lights with power should be on if the remote was never used`` (light: Light) =
-        (light: Light)
+        genRandomInteractionsExcept light _.IsRemoteInteraction
-        =
-        genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton))
         |> ensureStartsWithTimeChanged
         |> ensureLightHasPower light
         |> Arb.fromGen
@@ -82,13 +80,13 @@ type NightLightTests() =
             fakeHome.LightShouldHaveState light _.IsOn
 
     [<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
-    let ``After pressing 'On' on the remote, if the 'Off' button isn't pressed, all remotely controlled lights with power should be on``
+    let ``After pressing 'On' on the remote, if the remote isn't used again, all remotely controlled lights with power should be on``
         (light: Light)
         =
         concatGens
             [ genRandomInteractions light
-              HumanInteraction RemotePressedOnButton |> List.singleton |> Gen.constant
+              RemoteInteraction RemotePressedOnButton |> List.singleton |> Gen.constant
-              genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
+              genRandomInteractionsExcept light _.IsRemoteInteraction ]
         |> ensureStartsWithTimeChanged
         |> ensureLightHasPower light
         |> Arb.fromGen
@@ -98,7 +96,7 @@ type NightLightTests() =
             fakeHome.LightShouldHaveState light _.IsOn
 
     [<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
-    let ``After a new day starts, if the 'Off' button isn't pressed, all remotely controlled lights with power should be on``
+    let ``After a new day starts, if the remote isn't used, all remotely controlled lights with power should be on``
         (light: Light)
         =
         concatGens
@@ -106,7 +104,7 @@ type NightLightTests() =
               genTimeChangedToRandomNightTime |> Gen.map List.singleton
               genRandomInteractionsExcept light isTimeChangedToAnyDayTime
               genTimeChangedToRandomDayTime |> Gen.map List.singleton
-              genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ]
+              genRandomInteractionsExcept light _.IsRemoteInteraction ]
         |> ensureStartsWithTimeChanged
         |> ensureLightHasPower light
         |> Arb.fromGen
@@ -116,15 +114,46 @@ type NightLightTests() =
             fakeHome.LightShouldHaveState light _.IsOn
 
     [<Property(Arbitrary = [| typeof<ArbitraryRemotelyControlledLight> |])>]
-    let ``After pressing 'Off' on the remote, if the 'On' button isn't pressed and a new day doesn't start, all remotely controlled lights should be off``
+    let ``After pressing 'Off' on the remote, if the remote isn't used again and a new day doesn't start, all remotely controlled lights should be off``
         (light: Light)
         =
         concatGens
             [ genRandomInteractions light
-              HumanInteraction RemotePressedOffButton |> List.singleton |> Gen.constant
+              RemoteInteraction RemotePressedOffButton |> List.singleton |> Gen.constant
               genRandomInteractionsExcept light (fun interaction ->
-                  interaction = HumanInteraction RemotePressedOnButton
+                  interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ]
-                  || interaction |> isTimeChangedToAnyDayTime) ]
+        |> ensureStartsWithTimeChanged
+        |> Arb.fromGen
+        |> Prop.forAll
+        <| fun interactions ->
+            let fakeHome = createFakeHomeWithNightLightAndInteract interactions
+            fakeHome.LightShouldHaveState light _.IsOff
+
+    [<Property(Arbitrary = [| typeof<ArbitraryLeftRemotelyControlledLight> |])>]
+    let ``After pressing 'Left' on the remote, if the remote isn't used again, all left-side remotely controlled lights with power should be on``
+        (light: Light)
+        =
+        concatGens
+            [ genRandomInteractions light
+              RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant
+              genRandomInteractionsExcept light _.IsRemoteInteraction ]
+        |> ensureStartsWithTimeChanged
+        |> ensureLightHasPower light
+        |> Arb.fromGen
+        |> Prop.forAll
+        <| fun interactions ->
+            let fakeHome = createFakeHomeWithNightLightAndInteract interactions
+            fakeHome.LightShouldHaveState light _.IsOn
+
+    [<Property(Arbitrary = [| typeof<ArbitraryRightRemotelyControlledLight> |])>]
+    let ``After pressing 'Left' on the remote, if the remote isn't used again and a new day doesn't start, all right-side remotely controlled lights should be off``
+        (light: Light)
+        =
+        concatGens
+            [ genRandomInteractions light
+              RemoteInteraction RemotePressedLeftButton |> List.singleton |> Gen.constant
+              genRandomInteractionsExcept light (fun interaction ->
+                  interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ]
         |> ensureStartsWithTimeChanged
         |> Arb.fromGen
         |> Prop.forAll

NightLight.Core/Models.fs

@@ -40,32 +40,40 @@ type DeviceFriendlyName =
         match this with
         | DeviceFriendlyName deviceFriendlyName -> deviceFriendlyName
 
+type LightControl =
+    | NonRemote
+    | RemoteLeft
+    | RemoteRight
+
 type Light =
     { FriendlyName: DeviceFriendlyName
       Room: Room
       Bulb: Bulb
-      ControlledWithRemote: bool }
+      ControlledWithRemote: LightControl }
 
 let lights =
     [ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa"
-        Room = LivingRoom
+        Room = Bedroom
         Bulb = IkeaBulb
-        ControlledWithRemote = true }
+        ControlledWithRemote = RemoteRight }
       { FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa"
         Room = LivingRoom
         Bulb = PaulmannBulb
-        ControlledWithRemote = false }
+        ControlledWithRemote = NonRemote }
       { FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa"
         Room = LivingRoom
         Bulb = PaulmannBulb
-        ControlledWithRemote = false }
+        ControlledWithRemote = NonRemote }
       { FriendlyName = DeviceFriendlyName "Badrum - Taklampa"
         Room = Bathroom
         Bulb = IkeaBulb
-        ControlledWithRemote = false }
+        ControlledWithRemote = NonRemote }
       { FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa"
         Room = Bedroom
         Bulb = IkeaBulb
-        ControlledWithRemote = true } ]
+        ControlledWithRemote = RemoteLeft } ]
+
+let remoteControlledLights =
+    lights |> Seq.filter (not << _.ControlledWithRemote.IsNonRemote)
 
 let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll"

NightLight.Core/NightLightStateMachine.fs

@@ -14,9 +14,9 @@ let internal tryFindLight friendlyName =
 let internal generateZigbeeCommandsToFixLight state partOfDay (light: Light) =
     seq {
         match light.ControlledWithRemote, state with
-        | true, _ -> yield generateStateCommand state light
+        | NonRemote, On -> ()
-        | false, On -> ()
+        | NonRemote, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled."
-        | false, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled."
+        | _, _ -> yield generateStateCommand state light
 
         if state = On then
             let color, brightness =
@@ -32,7 +32,6 @@ 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
@@ -52,16 +51,21 @@ type NightLightStateMachine private (maybeTime: DateTime option, lightToState: M
                         | Some light -> generateZigbeeCommandsToFixLight lightToState[light] partOfDay light
                         | None -> Seq.empty
                     | ButtonPress action ->
-                        let desiredLightState =
+                        let newLightToState =
                             match action with
-                            | PressedOn -> On
+                            | PressedOn -> updateLightStateForRemoteControlledLights On
-                            | PressedOff -> Off
+                            | PressedOff -> updateLightStateForRemoteControlledLights Off
-
+                            | PressedLeft ->
-                        let newLightToState = updateLightStateForRemoteControlledLights desiredLightState
+                                updateLightStateForRemoteControlledLights Off
+                                |> Map.add
+                                    (remoteControlledLights
+                                     |> Seq.find (fun light -> light.ControlledWithRemote = RemoteLeft))
+                                    On
 
                         NightLightStateMachine(maybeTime, newLightToState),
                         remoteControlledLights
-                        |> Seq.collect (fun light -> generateZigbeeCommandsToFixLight desiredLightState partOfDay light)
+                        |> Seq.collect (fun light ->
+                            generateZigbeeCommandsToFixLight newLightToState[light] partOfDay light)
             | TimeChanged newTime, maybePartOfDay ->
                 let newPartOfDay = getPartOfDay newTime
 

NightLight.Core/ZigbeeEvents.fs

@@ -7,6 +7,7 @@ open FSharp.Data
 type Action =
     | PressedOn
     | PressedOff
+    | PressedLeft
 
 type ZigbeeEvent =
     | DeviceAnnounce of DeviceFriendlyName
@@ -35,6 +36,7 @@ let parseZigbeeEvent (message: Message) =
                 match jsonValue.TryGetProperty "action" with
                 | Some(JsonValue.String "on") -> Ok(ButtonPress PressedOn)
                 | Some(JsonValue.String "off") -> Ok(ButtonPress PressedOff)
+                | Some(JsonValue.String "arrow_left_click") -> Ok(ButtonPress PressedLeft)
                 | Some _ -> Error InvalidActionField
                 | None -> Error MissingActionField
         | _ -> return! Error <| UnknownTopic message.Topic