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