Compare commits

...

10 commits

9 changed files with 167 additions and 118 deletions

View file

@ -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

View file

@ -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<BedroomControllingRemoteInteraction>
|> Gen.map BedroomControllingRemoteInteraction
ArbMap.defaults
|> ArbMap.generate<LivingRoomControllingRemoteAction>
|> Gen.map LivingRoomControllingRemoteInteraction ]
let private genInteraction =
Gen.frequency [ 4, genTimeChanged; 1, genHumanInteraction; 1, genRemoteInteraction ]

View file

@ -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

View file

@ -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)
[<Property(Arbitrary = [| typeof<ArbitraryInteractions> |])>]
[<Property(Arbitrary = [| typeof<ArbitraryInteractions> |], 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)
[<Property(Arbitrary = [| typeof<ArbitraryInteractions> |])>]
[<Property(Arbitrary = [| typeof<ArbitraryInteractions> |], 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)

View file

@ -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 }

View file

@ -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<Light, LightState> }
LightToManualState: Map<Light, State> }
let internal createOrUpdateNightLightState
(time: DateTime)
(alarm: bool)
(maybeOldLightToState: Map<Light, LightState> 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 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)
if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then
brightness.Scale(getAlarmWeight nightLightState.Time)
else
brightness
State =
if alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then
if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then
On
else
previousState })
|> Map.ofSeq
{ Time = time
Alarm = alarm
LightToState = lightToState }
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),

View file

@ -15,7 +15,6 @@ let generateStateCommand state light =
| On -> "ON"
| Off -> "OFF"
if (lightProps light).Bulb = IkeaBulb then
commandObj["transition"] <- 0
commandObj.ToJsonString() |> toZigbeeCommand light

View file

@ -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
}

View file

@ -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