diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 65bfc62..a1c64bc 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -6,11 +6,15 @@ open NightLight.Core.Models open FsToolkit.ErrorHandling open FSharp.Data -type RemoteInteraction = +type BedroomControllingRemoteInteraction = | RemotePressedOnButton | RemotePressedOffButton + +type LivingRoomControllingRemoteAction = | RemotePressedLeftButton | RemotePressedRightButton + | LivingRoomRemotePressedOnButton + | LivingRoomRemotePressedOffButton type HumanInteraction = | LightPoweredOn of Light @@ -18,7 +22,8 @@ type HumanInteraction = type Interaction = | HumanInteraction of HumanInteraction - | RemoteInteraction of RemoteInteraction + | BedroomControllingRemoteInteraction of BedroomControllingRemoteInteraction + | LivingRoomControllingRemoteInteraction of LivingRoomControllingRemoteAction | TimeChanged of DateTime type Color = @@ -123,26 +128,36 @@ type FakeHome() = |> ReceivedZigbeeEvent |> onEventPublished.Trigger | HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[(lightProps light).FriendlyName].PowerOff() - | RemoteInteraction RemotePressedOnButton -> + | BedroomControllingRemoteInteraction RemotePressedOnButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""on"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | RemoteInteraction RemotePressedOffButton -> + | BedroomControllingRemoteInteraction RemotePressedOffButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""off"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | RemoteInteraction RemotePressedLeftButton -> + | LivingRoomControllingRemoteInteraction RemotePressedLeftButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""arrow_left_click"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger - | RemoteInteraction RemotePressedRightButton -> + | LivingRoomControllingRemoteInteraction RemotePressedRightButton -> { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" Payload = @"{ ""action"": ""arrow_right_click"" }" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger + | LivingRoomControllingRemoteInteraction LivingRoomRemotePressedOnButton -> + { Topic = $"zigbee2mqtt/{livingRoomRemoteControlFriendlyName.Get}" + Payload = @"{ ""action"": ""on"" }" } + |> ReceivedZigbeeEvent + |> onEventPublished.Trigger + | LivingRoomControllingRemoteInteraction LivingRoomRemotePressedOffButton -> + { Topic = $"zigbee2mqtt/{livingRoomRemoteControlFriendlyName.Get}" + Payload = @"{ ""action"": ""off"" }" } + |> 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 7b7b484..42d0f5f 100644 --- a/NightLight.Core.Tests/InteractionListGenerators.fs +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -36,12 +36,14 @@ let private genHumanInteraction = |> Gen.map Interaction.HumanInteraction let private genRemoteInteraction = - Gen.elements - [ RemotePressedOnButton - RemotePressedOffButton - RemotePressedLeftButton - RemotePressedRightButton ] - |> Gen.map RemoteInteraction + Gen.oneof + [ ArbMap.defaults + |> ArbMap.generate + |> Gen.map BedroomControllingRemoteInteraction + + ArbMap.defaults + |> ArbMap.generate + |> Gen.map LivingRoomControllingRemoteInteraction ] let private genInteraction = Gen.frequency [ 4, genTimeChanged; 1, genHumanInteraction; 1, genRemoteInteraction ] diff --git a/NightLight.Core.Tests/InteractionListHelpers.fs b/NightLight.Core.Tests/InteractionListHelpers.fs index ca2198d..958157d 100644 --- a/NightLight.Core.Tests/InteractionListHelpers.fs +++ b/NightLight.Core.Tests/InteractionListHelpers.fs @@ -36,12 +36,13 @@ let doesLightHavePowerAfterInteractions light interactions = |> Seq.tryLast |> Option.defaultValue false -let tryGetLastRemoteInteraction interactions = +let tryGetLastBedroomControllingRemoteInteraction interactions = interactions |> Seq.indexed - |> Seq.choose (fun interaction -> + |> Seq.choose (fun (index, interaction) -> match interaction with - | index, Interaction.RemoteInteraction remoteInteraction -> Some(index, remoteInteraction) + | Interaction.BedroomControllingRemoteInteraction bedroomRemoteInteraction -> + Some(index, bedroomRemoteInteraction) | _ -> None) |> Seq.tryLast diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 99f323b..7ad546b 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -7,6 +7,12 @@ open NightLight.Core.Models open FsCheck.Xunit open FsCheck.FSharp +type private BedroomLightsCycle = + | BothOff + | BothOn + | LeftOn + | RightOn + type NightLightTests() = let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) = let mutable nightLightStateMachine = NightLightStateMachine() @@ -41,13 +47,13 @@ type NightLightTests() = |> Prop.label fakeHome.Label |> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0) - [ |])>] + [ |], MaxTest = 500)>] let ``All lights should either be off or have a brightness that fits its color`` (interactions: Interaction list) = let fakeHome = createFakeHomeWithNightLightAndInteract interactions let time = getTimeAfterInteractions interactions |> _.TimeOfDay let alarm = - hasNewDayStartedSince interactions (tryGetLastRemoteInteraction interactions) + hasNewDayStartedSince interactions (tryGetLastBedroomControllingRemoteInteraction interactions) && startOfDay <= time && time <= endOfAlarm @@ -81,7 +87,7 @@ type NightLightTests() = |> Prop.label fakeHome.Label |> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0) - [ |])>] + [ |], MaxTest = 500)>] let ``All lights with power should have the correct state`` (interactions: Interaction list) = let fakeHome = createFakeHomeWithNightLightAndInteract interactions @@ -90,51 +96,62 @@ type NightLightTests() = |> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions) |> Seq.toList - let lastBedroomRemoteInteraction = + let lastBedroomControllingRemoteInteraction = + tryGetLastBedroomControllingRemoteInteraction interactions + + let newDayStartedSinceLastBedroomControllingRemoteInteraction = + hasNewDayStartedSince interactions lastBedroomControllingRemoteInteraction + + let livingRoomLightsToggledOn = interactions - |> Seq.indexed - |> Seq.choose (fun (index, interaction) -> - match interaction with - | Interaction.RemoteInteraction remoteInteraction -> - match remoteInteraction with - | RemotePressedOnButton - | RemotePressedOffButton - | RemotePressedLeftButton -> Some(index, remoteInteraction) - | RemotePressedRightButton -> None + |> Seq.choose (function + | Interaction.LivingRoomControllingRemoteInteraction interaction -> Some interaction | _ -> None) - |> Seq.tryLast + |> Seq.fold + (fun state interaction -> + match interaction with + | RemotePressedLeftButton -> not state + | RemotePressedRightButton -> not state + | LivingRoomRemotePressedOnButton -> true + | LivingRoomRemotePressedOffButton -> false) + true - let newDayStartedSinceBedroomRemote = - hasNewDayStartedSince interactions lastBedroomRemoteInteraction - - let hasPressedRight = + let bedroomLightsCycle = interactions - |> Seq.exists (function - | Interaction.RemoteInteraction RemotePressedRightButton -> true - | _ -> false) + |> Seq.choose (function + | Interaction.BedroomControllingRemoteInteraction interaction -> Some interaction + | _ -> None) + |> Seq.fold + (fun state interaction -> + match state, interaction with + | _, RemotePressedOffButton -> BothOff + | BothOff, RemotePressedOnButton -> BothOn + | BothOn, RemotePressedOnButton -> LeftOn + | LeftOn, RemotePressedOnButton -> RightOn + | RightOn, RemotePressedOnButton -> BothOn) + BothOn let isExpectedOn light = match light with - | LeftBedroomLamp + | LeftBedroomLamp -> + newDayStartedSinceLastBedroomControllingRemoteInteraction + || bedroomLightsCycle = BothOn + || bedroomLightsCycle = LeftOn | RightBedroomLamp -> - if newDayStartedSinceBedroomRemote then - true - else - match lastBedroomRemoteInteraction with - | Some(_, RemotePressedOffButton) -> false - | Some(_, RemotePressedLeftButton) -> light = LeftBedroomLamp - | Some(_, RemotePressedOnButton) -> true - | Some(_, RemotePressedRightButton) -> failwith "unexpected" - | None -> true + newDayStartedSinceLastBedroomControllingRemoteInteraction + || bedroomLightsCycle = BothOn + || bedroomLightsCycle = RightOn | LivingRoomWallLamp - | LivingRoomFloorLamp -> not hasPressedRight + | LivingRoomFloorLamp -> livingRoomLightsToggledOn | BathroomCeilingLamp -> true lightsWithPower |> Seq.forall (fun (light, state) -> state.IsOn = isExpectedOn light) - |> Prop.collect $"last bedroom remote interaction is {lastBedroomRemoteInteraction |> Option.map snd}" - |> Prop.collect $"pressed right: {hasPressedRight}" |> Prop.collect $"{lightsWithPower.Length} light(s) with power" - |> Prop.classify newDayStartedSinceBedroomRemote "new day since bedroom remote" + |> Prop.collect $"bedroom lights cycle = {bedroomLightsCycle}" + |> Prop.classify livingRoomLightsToggledOn "living room lights toggled on" + |> Prop.classify + newDayStartedSinceLastBedroomControllingRemoteInteraction + "new day started since last bedroom controlling remote interaction" |> Prop.label fakeHome.Label |> Prop.trivial (lightsWithPower.Length = 0) diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index d0206f7..7d03e45 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -83,10 +83,17 @@ let lights = let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll" +let livingRoomRemoteControlFriendlyName = DeviceFriendlyName "Living Room Remote" + type internal State = | On | Off + member this.Invert() = + match this with + | On -> Off + | Off -> On + type internal Brightness = | Brightness of int @@ -98,7 +105,7 @@ type internal Color = | ColorByCoordinates of float * float | ColorByTemperature of int -type internal LightState = +type internal LightSettings = { State: State Brightness: Brightness Color: Color } diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 59fdbc5..1c75b0b 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -11,77 +11,60 @@ open FsToolkit.ErrorHandling let internal tryFindLight friendlyName = Seq.tryFind (fun light -> (lightProps light).FriendlyName = friendlyName) lights -let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightState: LightState) = +let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightSettings: LightSettings) = seq { - if desiredLightState.State = Off then - yield generateStateCommand desiredLightState.State light + if desiredLightSettings.State = Off then + yield generateStateCommand desiredLightSettings.State light - if desiredLightState.State = On then - yield generateBrightnessCommand light desiredLightState.Brightness - yield generateColorCommand light desiredLightState.Color + if desiredLightSettings.State = On then + yield generateBrightnessCommand light desiredLightSettings.Brightness + yield generateColorCommand light desiredLightSettings.Color } type internal NightLightState = { Time: DateTime Alarm: bool - LightToState: Map } + LightToManualState: Map } -let internal createOrUpdateNightLightState - (time: DateTime) - (alarm: bool) - (maybeOldLightToState: Map option) - = - let partOfDay = getPartOfDay time +let internal computeLightSettings (light: Light) (nightLightState: NightLightState) = + let partOfDay = getPartOfDay nightLightState.Time - let lightToState = - lights - |> Seq.map (fun light -> - let color, brightness = - getDesiredMood (lightProps light).Room partOfDay - |> getDesiredColorAndBrightness (lightProps light).Bulb + let color, brightness = + getDesiredMood (lightProps light).Room partOfDay + |> getDesiredColorAndBrightness (lightProps light).Bulb - let previousState = - maybeOldLightToState - |> Option.map (fun lightToState -> lightToState[light].State) - |> Option.defaultValue On - - light, - { Color = color - Brightness = - if alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then - brightness.Scale(getAlarmWeight time) - else - brightness - State = - if alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then - On - else - previousState }) - |> Map.ofSeq - - { Time = time - Alarm = alarm - LightToState = lightToState } + { Color = color + Brightness = + if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then + brightness.Scale(getAlarmWeight nightLightState.Time) + else + brightness + State = + if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then + On + else + nightLightState.LightToManualState[light] } let internal withStateFor (light: Light) (state: State) (oldNightLightState: NightLightState) = - let oldState = oldNightLightState.LightToState[light] + { oldNightLightState with + LightToManualState = Map.add light state oldNightLightState.LightToManualState } - createOrUpdateNightLightState - oldNightLightState.Time - oldNightLightState.Alarm - (Map.add light { oldState with State = state } oldNightLightState.LightToState - |> Some) +let internal withInvertedStateFor (light: Light) (oldNightLightState: NightLightState) = + oldNightLightState + |> withStateFor light (oldNightLightState.LightToManualState[light].Invert()) let internal withAlarmOff (oldNightLightState: NightLightState) = - createOrUpdateNightLightState oldNightLightState.Time false (Some oldNightLightState.LightToState) + { oldNightLightState with + Alarm = false } let internal generateZigbeeCommandsForDifference (maybeBefore: NightLightState option) (after: NightLightState) = - after.LightToState - |> Seq.collect (fun (KeyValue(light, newState)) -> - let oldState = maybeBefore |> Option.map _.LightToState[light] + lights + |> Seq.collect (fun light -> + let oldLightSettings = maybeBefore |> Option.map (computeLightSettings light) + let newLightSettings = after |> computeLightSettings light - if oldState <> Some newState then - generateZigbeeCommandsToFixLight light after.LightToState[light] + if oldLightSettings <> Some newLightSettings then + generateZigbeeCommandsToFixLight light newLightSettings else Seq.empty) @@ -101,7 +84,10 @@ type NightLightStateMachine private (maybeState: NightLightState option) = this, match maybeLight with - | Some light -> generateZigbeeCommandsToFixLight light currentState.LightToState[light] + | Some light -> + currentState + |> computeLightSettings light + |> generateZigbeeCommandsToFixLight light | None -> Seq.empty | ButtonPress action -> let newNightLightState = @@ -109,21 +95,29 @@ type NightLightStateMachine private (maybeState: NightLightState option) = | PressedOn -> currentState |> withAlarmOff - |> withStateFor RightBedroomLamp On - |> withStateFor LeftBedroomLamp On + |> match + currentState.LightToManualState[LeftBedroomLamp], + currentState.LightToManualState[RightBedroomLamp] + with + | Off, _ -> withStateFor LeftBedroomLamp On >> withStateFor RightBedroomLamp On + | On, On -> withStateFor LeftBedroomLamp On >> withStateFor RightBedroomLamp Off + | On, Off -> withStateFor LeftBedroomLamp Off >> withStateFor RightBedroomLamp On | PressedOff -> currentState |> withAlarmOff |> withStateFor RightBedroomLamp Off |> withStateFor LeftBedroomLamp Off - | PressedLeft -> - currentState - |> withAlarmOff - |> withStateFor RightBedroomLamp Off - |> withStateFor LeftBedroomLamp On + | PressedLeft | PressedRight -> currentState - |> withAlarmOff + |> withInvertedStateFor LivingRoomWallLamp + |> withInvertedStateFor LivingRoomFloorLamp + | PressedLivingRoomOn -> + currentState + |> withStateFor LivingRoomWallLamp On + |> withStateFor LivingRoomFloorLamp On + | PressedLivingRoomOff -> + currentState |> withStateFor LivingRoomWallLamp Off |> withStateFor LivingRoomFloorLamp Off @@ -143,7 +137,12 @@ type NightLightStateMachine private (maybeState: NightLightState option) = || maybeCurrentState |> Option.map _.Alarm |> Option.defaultValue false let newNightLightState = - createOrUpdateNightLightState newTime alarm (maybeCurrentState |> Option.map _.LightToState) + { Time = newTime + Alarm = alarm + LightToManualState = + maybeCurrentState + |> Option.map _.LightToManualState + |> Option.defaultValue (lights |> Seq.map (fun light -> light, On) |> Map.ofSeq) } return NightLightStateMachine(Some newNightLightState), diff --git a/NightLight.Core/ZigbeeCommands.fs b/NightLight.Core/ZigbeeCommands.fs index dd13aff..9f16656 100644 --- a/NightLight.Core/ZigbeeCommands.fs +++ b/NightLight.Core/ZigbeeCommands.fs @@ -15,8 +15,7 @@ let generateStateCommand state light = | On -> "ON" | Off -> "OFF" - if (lightProps light).Bulb = IkeaBulb then - commandObj["transition"] <- 0 + commandObj["transition"] <- 0 commandObj.ToJsonString() |> toZigbeeCommand light diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index 13e4301..700df43 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/NightLight.Core/ZigbeeEvents.fs @@ -9,6 +9,8 @@ type Action = | PressedOff | PressedLeft | PressedRight + | PressedLivingRoomOn + | PressedLivingRoomOff type ZigbeeEvent = | DeviceAnnounce of DeviceFriendlyName @@ -41,5 +43,12 @@ let parseZigbeeEvent (message: Message) = | Some(JsonValue.String "arrow_right_click") -> Ok(ButtonPress PressedRight) | Some _ -> Error InvalidActionField | None -> Error MissingActionField + | "zigbee2mqtt/Living Room Remote" -> + return! + match jsonValue.TryGetProperty "action" with + | Some(JsonValue.String "on") -> Ok(ButtonPress PressedLivingRoomOn) + | Some(JsonValue.String "off") -> Ok(ButtonPress PressedLivingRoomOff) + | Some _ -> Error InvalidActionField + | None -> Error MissingActionField | _ -> return! Error <| UnknownTopic message.Topic } diff --git a/NightLight/Program.fs b/NightLight/Program.fs index eecfc4b..e011f3b 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -1,4 +1,4 @@ -open System +open System open System.Text open System.Threading open System.Threading.Tasks @@ -103,7 +103,7 @@ let mainAsync _ = :> Task) do! - [ "zigbee2mqtt/bridge/event"; $"zigbee2mqtt/{remoteControlFriendlyName.Get}" ] + [ "zigbee2mqtt/bridge/event"; $"zigbee2mqtt/{remoteControlFriendlyName.Get}"; $"zigbee2mqtt/{livingRoomRemoteControlFriendlyName.Get}" ] |> Seq.map (fun topic -> async { return! mqttClient.SubscribeAsync topic |> Async.AwaitTask }) |> Async.Sequential |> Async.Ignore