diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index ab922b8..c8ede0a 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/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 diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs index a6c2871..d78ef69 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/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.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ]) - - let genRemoteInteraction = - Gen.elements [ RemotePressedOnButton; RemotePressedOffButton ] - - Gen.oneof [ genLightInteraction; genRemoteInteraction ] + Gen.oneof [ Gen.constant biasTowardsLight; Gen.elements lights ] + |> Gen.bind (fun light -> Gen.elements [ LightPoweredOn light; LightPoweredOff light ]) |> Gen.map Interaction.HumanInteraction +let private genRemoteInteraction = + Gen.elements [ RemotePressedOnButton; RemotePressedOffButton; RemotePressedLeftButton ] + |> Gen.map RemoteInteraction + let private genInteraction biasTowardsLight = Gen.oneof [ genTimeChanged; genHumanInteraction biasTowardsLight ] diff --git a/NightLight.Core.Tests/LightArbitraries.fs b/NightLight.Core.Tests/LightArbitraries.fs index e91e114..d1de91a 100644 --- a/NightLight.Core.Tests/LightArbitraries.fs +++ b/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 diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 85053e8..c9ceaa9 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -69,10 +69,8 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - let ``All remote controlled lights with power should be on if the 'Off' button on the remote was never pressed`` - (light: Light) - = - genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) + let ``All remote controlled lights with power should be on if the remote was never used`` (light: Light) = + genRandomInteractionsExcept light _.IsRemoteInteraction |> ensureStartsWithTimeChanged |> ensureLightHasPower light |> Arb.fromGen @@ -82,13 +80,13 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - 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 - genRandomInteractionsExcept light ((=) (HumanInteraction RemotePressedOffButton)) ] + RemoteInteraction RemotePressedOnButton |> List.singleton |> Gen.constant + genRandomInteractionsExcept light _.IsRemoteInteraction ] |> ensureStartsWithTimeChanged |> ensureLightHasPower light |> Arb.fromGen @@ -98,7 +96,7 @@ type NightLightTests() = fakeHome.LightShouldHaveState light _.IsOn [ |])>] - 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 [ |])>] - 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 |> isTimeChangedToAnyDayTime) ] + interaction.IsRemoteInteraction || interaction |> isTimeChangedToAnyDayTime) ] + |> ensureStartsWithTimeChanged + |> Arb.fromGen + |> Prop.forAll + <| fun interactions -> + let fakeHome = createFakeHomeWithNightLightAndInteract interactions + fakeHome.LightShouldHaveState light _.IsOff + + [ |])>] + 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 + + [ |])>] + 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 diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 5243bcb..d37cc9a 100644 --- a/NightLight.Core/Models.fs +++ b/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" diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 4de831d..c04ea1f 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/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 - | false, On -> () - | false, Off -> failwith $"Unexpectly trying to turn off {light}. It's not remote-controlled." + | NonRemote, On -> () + | NonRemote, 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 = 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 - | PressedOff -> Off - - let newLightToState = updateLightStateForRemoteControlledLights desiredLightState + | PressedOn -> updateLightStateForRemoteControlledLights On + | PressedOff -> updateLightStateForRemoteControlledLights Off + | PressedLeft -> + 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 diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index 632c6b1..7786a28 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/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