Compare commits

..

No commits in common. "c09915ac604e76090d311019fa16697221c989a5" and "53fd129bb834aae5906b78c4fd2184cc2b8bae69" have entirely different histories.

9 changed files with 118 additions and 167 deletions

View file

@ -6,15 +6,11 @@ open NightLight.Core.Models
open FsToolkit.ErrorHandling open FsToolkit.ErrorHandling
open FSharp.Data open FSharp.Data
type BedroomControllingRemoteInteraction = type RemoteInteraction =
| RemotePressedOnButton | RemotePressedOnButton
| RemotePressedOffButton | RemotePressedOffButton
type LivingRoomControllingRemoteAction =
| RemotePressedLeftButton | RemotePressedLeftButton
| RemotePressedRightButton | RemotePressedRightButton
| LivingRoomRemotePressedOnButton
| LivingRoomRemotePressedOffButton
type HumanInteraction = type HumanInteraction =
| LightPoweredOn of Light | LightPoweredOn of Light
@ -22,8 +18,7 @@ type HumanInteraction =
type Interaction = type Interaction =
| HumanInteraction of HumanInteraction | HumanInteraction of HumanInteraction
| BedroomControllingRemoteInteraction of BedroomControllingRemoteInteraction | RemoteInteraction of RemoteInteraction
| LivingRoomControllingRemoteInteraction of LivingRoomControllingRemoteAction
| TimeChanged of DateTime | TimeChanged of DateTime
type Color = type Color =
@ -128,36 +123,26 @@ type FakeHome() =
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[(lightProps light).FriendlyName].PowerOff() | HumanInteraction(LightPoweredOff light) -> friendlyNameToFakeLight[(lightProps light).FriendlyName].PowerOff()
| BedroomControllingRemoteInteraction RemotePressedOnButton -> | RemoteInteraction RemotePressedOnButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""on"" }" } Payload = @"{ ""action"": ""on"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| BedroomControllingRemoteInteraction RemotePressedOffButton -> | RemoteInteraction RemotePressedOffButton ->
{ Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}" { Topic = $"zigbee2mqtt/{remoteControlFriendlyName.Get}"
Payload = @"{ ""action"": ""off"" }" } Payload = @"{ ""action"": ""off"" }" }
|> ReceivedZigbeeEvent |> ReceivedZigbeeEvent
|> onEventPublished.Trigger |> onEventPublished.Trigger
| LivingRoomControllingRemoteInteraction RemotePressedLeftButton -> | RemoteInteraction 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
| LivingRoomControllingRemoteInteraction RemotePressedRightButton -> | RemoteInteraction 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,14 +36,12 @@ let private genHumanInteraction =
|> Gen.map Interaction.HumanInteraction |> Gen.map Interaction.HumanInteraction
let private genRemoteInteraction = let private genRemoteInteraction =
Gen.oneof Gen.elements
[ ArbMap.defaults [ RemotePressedOnButton
|> ArbMap.generate<BedroomControllingRemoteInteraction> RemotePressedOffButton
|> Gen.map BedroomControllingRemoteInteraction RemotePressedLeftButton
RemotePressedRightButton ]
ArbMap.defaults |> Gen.map RemoteInteraction
|> 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,13 +36,12 @@ let doesLightHavePowerAfterInteractions light interactions =
|> Seq.tryLast |> Seq.tryLast
|> Option.defaultValue false |> Option.defaultValue false
let tryGetLastBedroomControllingRemoteInteraction interactions = let tryGetLastRemoteInteraction interactions =
interactions interactions
|> Seq.indexed |> Seq.indexed
|> Seq.choose (fun (index, interaction) -> |> Seq.choose (fun interaction ->
match interaction with match interaction with
| Interaction.BedroomControllingRemoteInteraction bedroomRemoteInteraction -> | index, Interaction.RemoteInteraction remoteInteraction -> Some(index, remoteInteraction)
Some(index, bedroomRemoteInteraction)
| _ -> None) | _ -> None)
|> Seq.tryLast |> Seq.tryLast

View file

@ -7,12 +7,6 @@ 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()
@ -47,13 +41,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> |], MaxTest = 500)>] [<Property(Arbitrary = [| typeof<ArbitraryInteractions> |])>]
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 (tryGetLastBedroomControllingRemoteInteraction interactions) hasNewDayStartedSince interactions (tryGetLastRemoteInteraction interactions)
&& startOfDay <= time && startOfDay <= time
&& time <= endOfAlarm && time <= endOfAlarm
@ -87,7 +81,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> |], MaxTest = 500)>] [<Property(Arbitrary = [| typeof<ArbitraryInteractions> |])>]
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
@ -96,62 +90,51 @@ type NightLightTests() =
|> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions) |> Seq.filter (fun (light, _) -> doesLightHavePowerAfterInteractions light interactions)
|> Seq.toList |> Seq.toList
let lastBedroomControllingRemoteInteraction = let lastBedroomRemoteInteraction =
tryGetLastBedroomControllingRemoteInteraction interactions
let newDayStartedSinceLastBedroomControllingRemoteInteraction =
hasNewDayStartedSince interactions lastBedroomControllingRemoteInteraction
let livingRoomLightsToggledOn =
interactions interactions
|> Seq.choose (function |> Seq.indexed
| Interaction.LivingRoomControllingRemoteInteraction interaction -> Some interaction |> Seq.choose (fun (index, interaction) ->
| _ -> None)
|> Seq.fold
(fun state interaction ->
match interaction with match interaction with
| RemotePressedLeftButton -> not state | Interaction.RemoteInteraction remoteInteraction ->
| RemotePressedRightButton -> not state match remoteInteraction with
| LivingRoomRemotePressedOnButton -> true | RemotePressedOnButton
| LivingRoomRemotePressedOffButton -> false) | RemotePressedOffButton
true | RemotePressedLeftButton -> Some(index, remoteInteraction)
| RemotePressedRightButton -> None
let bedroomLightsCycle =
interactions
|> Seq.choose (function
| Interaction.BedroomControllingRemoteInteraction interaction -> Some interaction
| _ -> None) | _ -> None)
|> Seq.fold |> Seq.tryLast
(fun state interaction ->
match state, interaction with let newDayStartedSinceBedroomRemote =
| _, RemotePressedOffButton -> BothOff hasNewDayStartedSince interactions lastBedroomRemoteInteraction
| BothOff, RemotePressedOnButton -> BothOn
| BothOn, RemotePressedOnButton -> LeftOn let hasPressedRight =
| LeftOn, RemotePressedOnButton -> RightOn interactions
| RightOn, RemotePressedOnButton -> BothOn) |> Seq.exists (function
BothOn | Interaction.RemoteInteraction RemotePressedRightButton -> true
| _ -> false)
let isExpectedOn light = let isExpectedOn light =
match light with match light with
| LeftBedroomLamp -> | LeftBedroomLamp
newDayStartedSinceLastBedroomControllingRemoteInteraction
|| bedroomLightsCycle = BothOn
|| bedroomLightsCycle = LeftOn
| RightBedroomLamp -> | RightBedroomLamp ->
newDayStartedSinceLastBedroomControllingRemoteInteraction if newDayStartedSinceBedroomRemote then
|| bedroomLightsCycle = BothOn true
|| bedroomLightsCycle = RightOn else
match lastBedroomRemoteInteraction with
| Some(_, RemotePressedOffButton) -> false
| Some(_, RemotePressedLeftButton) -> light = LeftBedroomLamp
| Some(_, RemotePressedOnButton) -> true
| Some(_, RemotePressedRightButton) -> failwith "unexpected"
| None -> true
| LivingRoomWallLamp | LivingRoomWallLamp
| LivingRoomFloorLamp -> livingRoomLightsToggledOn | LivingRoomFloorLamp -> not hasPressedRight
| 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.collect $"bedroom lights cycle = {bedroomLightsCycle}" |> Prop.classify newDayStartedSinceBedroomRemote "new day since bedroom remote"
|> 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,17 +83,10 @@ 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
@ -105,7 +98,7 @@ type internal Color =
| ColorByCoordinates of float * float | ColorByCoordinates of float * float
| ColorByTemperature of int | ColorByTemperature of int
type internal LightSettings = type internal LightState =
{ State: State { State: State
Brightness: Brightness Brightness: Brightness
Color: Color } Color: Color }

View file

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