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 FsToolkit.ErrorHandling
open FSharp.Data open FSharp.Data
type RemoteInteraction = type BedroomControllingRemoteInteraction =
| RemotePressedOnButton | RemotePressedOnButton
| RemotePressedOffButton | RemotePressedOffButton
type LivingRoomControllingRemoteAction =
| RemotePressedLeftButton | RemotePressedLeftButton
| RemotePressedRightButton | RemotePressedRightButton
| LivingRoomRemotePressedOnButton
| LivingRoomRemotePressedOffButton
type HumanInteraction = type HumanInteraction =
| LightPoweredOn of Light | LightPoweredOn of Light
@ -18,7 +22,8 @@ type HumanInteraction =
type Interaction = type Interaction =
| HumanInteraction of HumanInteraction | HumanInteraction of HumanInteraction
| RemoteInteraction of RemoteInteraction | BedroomControllingRemoteInteraction of BedroomControllingRemoteInteraction
| LivingRoomControllingRemoteInteraction of LivingRoomControllingRemoteAction
| TimeChanged of DateTime | TimeChanged of DateTime
type Color = type Color =
@ -123,26 +128,36 @@ type FakeHome() =
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[(lightProps light).FriendlyName].PowerOff() | HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[(lightProps light).FriendlyName].PowerOff()
| RemoteInteraction RemotePressedOnButton -> | BedroomControllingRemoteInteraction RemotePressedOnButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""on"" }" } Payload = @"{ ""action"": ""on"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| RemoteInteraction RemotePressedOffButton -> | BedroomControllingRemoteInteraction RemotePressedOffButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""off"" }" } Payload = @"{ ""action"": ""off"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| RemoteInteraction RemotePressedLeftButton -> | LivingRoomControllingRemoteInteraction RemotePressedLeftButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""arrow_left_click"" }" } Payload = @"{ ""action"": ""arrow_left_click"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| RemoteInteraction RemotePressedRightButton -> | LivingRoomControllingRemoteInteraction RemotePressedRightButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""arrow_right_click"" }" } Payload = @"{ ""action"": ""arrow_right_click"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> 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 | TimeChanged newTime -> newTime |> Event.TimeChanged |> onEventPublished.Trigger
type FakeHome with type FakeHome with

View file

@ -36,12 +36,14 @@ let private genHumanInteraction =
|> Gen.map Interaction.HumanInteraction |> Gen.map Interaction.HumanInteraction
let private genRemoteInteraction = let private genRemoteInteraction =
Gen.elements Gen.oneof
[ RemotePressedOnButton [ ArbMap.defaults
RemotePressedOffButton |> ArbMap.generate<BedroomControllingRemoteInteraction>
RemotePressedLeftButton |> Gen.map BedroomControllingRemoteInteraction
RemotePressedRightButton ]
|> Gen.map RemoteInteraction ArbMap.defaults
|> ArbMap.generate<LivingRoomControllingRemoteAction>
|> Gen.map LivingRoomControllingRemoteInteraction ]
let private genInteraction = let private genInteraction =
Gen.frequency [ 4, genTimeChanged; 1, genHumanInteraction; 1, genRemoteInteraction ] Gen.frequency [ 4, genTimeChanged; 1, genHumanInteraction; 1, genRemoteInteraction ]

View file

@ -36,12 +36,13 @@ let doesLightHavePowerAfterInteractions light interactions =
|> Seq.tryLast |> Seq.tryLast
|> Option.defaultValue false |> Option.defaultValue false
let tryGetLastRemoteInteraction interactions = let tryGetLastBedroomControllingRemoteInteraction interactions =
interactions interactions
|> Seq.indexed |> Seq.indexed
|> Seq.choose (fun interaction -> |> Seq.choose (fun (index, interaction) ->
match interaction with match interaction with
| index, Interaction.RemoteInteraction remoteInteraction -> Some(index, remoteInteraction) | Interaction.BedroomControllingRemoteInteraction bedroomRemoteInteraction ->
Some(index, bedroomRemoteInteraction)
| _ -> None) | _ -> None)
|> Seq.tryLast |> Seq.tryLast

View file

@ -7,6 +7,12 @@ open NightLight.Core.Models
open FsCheck.Xunit open FsCheck.Xunit
open FsCheck.FSharp open FsCheck.FSharp
type private BedroomLightsCycle =
| BothOff
| BothOn
| LeftOn
| RightOn
type NightLightTests() = type NightLightTests() =
let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) = let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) =
let mutable nightLightStateMachine = NightLightStateMachine() let mutable nightLightStateMachine = NightLightStateMachine()
@ -41,13 +47,13 @@ type NightLightTests() =
|> Prop.label fakeHome.Label |> Prop.label fakeHome.Label
|> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0) |> 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 ``All lights should either be off or have a brightness that fits its color`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
let time = getTimeAfterInteractions interactions |> _.TimeOfDay let time = getTimeAfterInteractions interactions |> _.TimeOfDay
let alarm = let alarm =
hasNewDayStartedSince interactions (tryGetLastRemoteInteraction interactions) hasNewDayStartedSince interactions (tryGetLastBedroomControllingRemoteInteraction interactions)
&& startOfDay <= time && startOfDay <= time
&& time <= endOfAlarm && time <= endOfAlarm
@ -81,7 +87,7 @@ type NightLightTests() =
|> Prop.label fakeHome.Label |> Prop.label fakeHome.Label
|> Prop.trivial (fakeHome.LightsThatAreOn.Length = 0) |> 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 ``All lights with power should have the correct state`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions let fakeHome = createFakeHomeWithNightLightAndInteract interactions
@ -90,51 +96,62 @@ type NightLightTests() =
|> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions) |> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions)
|> Seq.toList |> Seq.toList
let lastBedroomRemoteInteraction = let lastBedroomControllingRemoteInteraction =
tryGetLastBedroomControllingRemoteInteraction interactions
let newDayStartedSinceLastBedroomControllingRemoteInteraction =
hasNewDayStartedSince interactions lastBedroomControllingRemoteInteraction
let livingRoomLightsToggledOn =
interactions interactions
|> Seq.indexed |> Seq.choose (function
|> Seq.choose (fun (index, interaction) -> | Interaction.LivingRoomControllingRemoteInteraction interaction -> Some interaction
match interaction with
| Interaction.RemoteInteraction remoteInteraction ->
match remoteInteraction with
| RemotePressedOnButton
| RemotePressedOffButton
| RemotePressedLeftButton -> Some(index, remoteInteraction)
| RemotePressedRightButton -> None
| _ -> None) | _ -> None)
|> Seq.tryLast |> Seq.fold
(fun state interaction ->
match interaction with
| RemotePressedLeftButton -> not state
| RemotePressedRightButton -> not state
| LivingRoomRemotePressedOnButton -> true
| LivingRoomRemotePressedOffButton -> false)
true
let newDayStartedSinceBedroomRemote = let bedroomLightsCycle =
hasNewDayStartedSince interactions lastBedroomRemoteInteraction
let hasPressedRight =
interactions interactions
|> Seq.exists (function |> Seq.choose (function
| Interaction.RemoteInteraction RemotePressedRightButton -> true | Interaction.BedroomControllingRemoteInteraction interaction -> Some interaction
| _ -> false) | _ -> 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 = let isExpectedOn light =
match light with match light with
| LeftBedroomLamp | LeftBedroomLamp ->
newDayStartedSinceLastBedroomControllingRemoteInteraction
|| bedroomLightsCycle = BothOn
|| bedroomLightsCycle = LeftOn
| RightBedroomLamp -> | RightBedroomLamp ->
if newDayStartedSinceBedroomRemote then newDayStartedSinceLastBedroomControllingRemoteInteraction
true || bedroomLightsCycle = BothOn
else || bedroomLightsCycle = RightOn
match lastBedroomRemoteInteraction with
| Some(_, RemotePressedOffButton) -> false
| Some(_, RemotePressedLeftButton) -> light = LeftBedroomLamp
| Some(_, RemotePressedOnButton) -> true
| Some(_, RemotePressedRightButton) -> failwith "unexpected"
| None -> true
| LivingRoomWallLamp | LivingRoomWallLamp
| LivingRoomFloorLamp -> not hasPressedRight | LivingRoomFloorLamp -> livingRoomLightsToggledOn
| BathroomCeilingLamp -> true | BathroomCeilingLamp -> true
lightsWithPower lightsWithPower
|> Seq.forall (fun (light, state) -> state.IsOn = isExpectedOn light) |> 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 $"{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.label fakeHome.Label
|> Prop.trivial (lightsWithPower.Length = 0) |> Prop.trivial (lightsWithPower.Length = 0)

View file

@ -83,10 +83,17 @@ let lights =
let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll" let remoteControlFriendlyName = DeviceFriendlyName "Fjärrkontroll"
let livingRoomRemoteControlFriendlyName = DeviceFriendlyName "Living Room Remote"
type internal State = type internal State =
| On | On
| Off | Off
member this.Invert() =
match this with
| On -> Off
| Off -> On
type internal Brightness = type internal Brightness =
| Brightness of int | Brightness of int
@ -98,7 +105,7 @@ type internal Color =
| ColorByCoordinates of float * float | ColorByCoordinates of float * float
| ColorByTemperature of int | ColorByTemperature of int
type internal LightState = type internal LightSettings =
{ State: State { State: State
Brightness: Brightness Brightness: Brightness
Color: Color } Color: Color }

View file

@ -11,77 +11,60 @@ open FsToolkit.ErrorHandling
let internal tryFindLight friendlyName = let internal tryFindLight friendlyName =
Seq.tryFind (fun light -> (lightProps light).FriendlyName = friendlyName) lights Seq.tryFind (fun light -> (lightProps light).FriendlyName = friendlyName) lights
let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightState: LightState) = let internal generateZigbeeCommandsToFixLight (light: Light) (desiredLightSettings: LightSettings) =
seq { seq {
if desiredLightState.State = Off then if desiredLightSettings.State = Off then
yield generateStateCommand desiredLightState.State light yield generateStateCommand desiredLightSettings.State light
if desiredLightState.State = On then if desiredLightSettings.State = On then
yield generateBrightnessCommand light desiredLightState.Brightness yield generateBrightnessCommand light desiredLightSettings.Brightness
yield generateColorCommand light desiredLightState.Color yield generateColorCommand light desiredLightSettings.Color
} }
type internal NightLightState = type internal NightLightState =
{ Time: DateTime { Time: DateTime
Alarm: bool Alarm: bool
LightToState: Map<Light, LightState> } LightToManualState: Map<Light, State> }
let internal createOrUpdateNightLightState let internal computeLightSettings (light: Light) (nightLightState: NightLightState) =
(time: DateTime) let partOfDay = getPartOfDay nightLightState.Time
(alarm: bool)
(maybeOldLightToState: Map<Light, LightState> option)
=
let partOfDay = getPartOfDay time
let lightToState = let color, brightness =
lights getDesiredMood (lightProps light).Room partOfDay
|> Seq.map (fun light -> |> getDesiredColorAndBrightness (lightProps light).Bulb
let color, brightness =
getDesiredMood (lightProps light).Room partOfDay
|> getDesiredColorAndBrightness (lightProps light).Bulb
let previousState = { Color = color
maybeOldLightToState Brightness =
|> Option.map (fun lightToState -> lightToState[light].State) if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then
|> Option.defaultValue On brightness.Scale(getAlarmWeight nightLightState.Time)
else
light, brightness
{ Color = color State =
Brightness = if nightLightState.Alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then
if alarm && (light = RightBedroomLamp || light = LeftBedroomLamp) then On
brightness.Scale(getAlarmWeight time) else
else nightLightState.LightToManualState[light] }
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) = let internal withStateFor (light: Light) (state: State) (oldNightLightState: NightLightState) =
let oldState = oldNightLightState.LightToState[light] { oldNightLightState with
LightToManualState = Map.add light state oldNightLightState.LightToManualState }
createOrUpdateNightLightState let internal withInvertedStateFor (light: Light) (oldNightLightState: NightLightState) =
oldNightLightState.Time oldNightLightState
oldNightLightState.Alarm |> withStateFor light (oldNightLightState.LightToManualState[light].Invert())
(Map.add light { oldState with State = state } oldNightLightState.LightToState
|> Some)
let internal withAlarmOff (oldNightLightState: NightLightState) = let internal withAlarmOff (oldNightLightState: NightLightState) =
createOrUpdateNightLightState oldNightLightState.Time false (Some oldNightLightState.LightToState) { oldNightLightState with
Alarm = false }
let internal generateZigbeeCommandsForDifference (maybeBefore: NightLightState option) (after: NightLightState) = let internal generateZigbeeCommandsForDifference (maybeBefore: NightLightState option) (after: NightLightState) =
after.LightToState lights
|> Seq.collect (fun (KeyValue(light, newState)) -> |> Seq.collect (fun light ->
let oldState = maybeBefore |> Option.map _.LightToState[light] let oldLightSettings = maybeBefore |> Option.map (computeLightSettings light)
let newLightSettings = after |> computeLightSettings light
if oldState <> Some newState then if oldLightSettings <> Some newLightSettings then
generateZigbeeCommandsToFixLight light after.LightToState[light] generateZigbeeCommandsToFixLight light newLightSettings
else else
Seq.empty) Seq.empty)
@ -101,7 +84,10 @@ type NightLightStateMachine private (maybeState: NightLightState option) =
this, this,
match maybeLight with match maybeLight with
| Some light -> generateZigbeeCommandsToFixLight light currentState.LightToState[light] | Some light ->
currentState
|> computeLightSettings light
|> generateZigbeeCommandsToFixLight light
| None -> Seq.empty | None -> Seq.empty
| ButtonPress action -> | ButtonPress action ->
let newNightLightState = let newNightLightState =
@ -109,21 +95,29 @@ type NightLightStateMachine private (maybeState: NightLightState option) =
| PressedOn -> | PressedOn ->
currentState currentState
|> withAlarmOff |> withAlarmOff
|> withStateFor RightBedroomLamp On |> match
|> withStateFor LeftBedroomLamp On 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 -> | PressedOff ->
currentState currentState
|> withAlarmOff |> withAlarmOff
|> withStateFor RightBedroomLamp Off |> withStateFor RightBedroomLamp Off
|> withStateFor LeftBedroomLamp Off |> withStateFor LeftBedroomLamp Off
| PressedLeft -> | PressedLeft
currentState
|> withAlarmOff
|> withStateFor RightBedroomLamp Off
|> withStateFor LeftBedroomLamp On
| PressedRight -> | PressedRight ->
currentState currentState
|> withAlarmOff |> withInvertedStateFor LivingRoomWallLamp
|> withInvertedStateFor LivingRoomFloorLamp
| PressedLivingRoomOn ->
currentState
|> withStateFor LivingRoomWallLamp On
|> withStateFor LivingRoomFloorLamp On
| PressedLivingRoomOff ->
currentState
|> withStateFor LivingRoomWallLamp Off |> withStateFor LivingRoomWallLamp Off
|> withStateFor LivingRoomFloorLamp Off |> withStateFor LivingRoomFloorLamp Off
@ -143,7 +137,12 @@ type NightLightStateMachine private (maybeState: NightLightState option) =
|| maybeCurrentState |> Option.map _.Alarm |> Option.defaultValue false || maybeCurrentState |> Option.map _.Alarm |> Option.defaultValue false
let newNightLightState = 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 return
NightLightStateMachine(Some newNightLightState), NightLightStateMachine(Some newNightLightState),

View file

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

View file

@ -9,6 +9,8 @@ type Action =
| PressedOff | PressedOff
| PressedLeft | PressedLeft
| PressedRight | PressedRight
| PressedLivingRoomOn
| PressedLivingRoomOff
type ZigbeeEvent = type ZigbeeEvent =
| DeviceAnnounce of DeviceFriendlyName | DeviceAnnounce of DeviceFriendlyName
@ -41,5 +43,12 @@ let parseZigbeeEvent (message: Message) =
| Some(JsonValue.String "arrow_right_click") -> Ok(ButtonPress PressedRight) | Some(JsonValue.String "arrow_right_click") -> Ok(ButtonPress PressedRight)
| Some _ -> Error InvalidActionField | Some _ -> Error InvalidActionField
| None -> Error MissingActionField | 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 | _ -> return! Error <| UnknownTopic message.Topic
} }

View file

@ -1,4 +1,4 @@
open System open System
open System.Text open System.Text
open System.Threading open System.Threading
open System.Threading.Tasks open System.Threading.Tasks
@ -103,7 +103,7 @@ let mainAsync _ =
:> Task) :> Task)
do! 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 }) |> Seq.map (fun topic -> async { return! mqttClient.SubscribeAsync topic |> Async.AwaitTask })
|> Async.Sequential |> Async.Sequential
|> Async.Ignore |> Async.Ignore