diff --git a/NightLight.Core.Tests/Arbitraries.fs b/NightLight.Core.Tests/Arbitraries.fs new file mode 100644 index 0000000..39433dc --- /dev/null +++ b/NightLight.Core.Tests/Arbitraries.fs @@ -0,0 +1,22 @@ +namespace NightLight.Core.Tests + +open System +open FsCheck.FSharp +open NightLight.Core.Models + +type Arbitraries = + static member Interaction() = + let genTimeChangedInteraction = + gen { + let! time = ArbMap.defaults |> ArbMap.generate + return Interaction.TimeChanged time + } + + let genHumanInteraction = + gen { + let! light = Gen.elements lights + let! humanInteraction = Gen.elements [ LightTurnedOn light; LightTurnedOff light ] + return Interaction.HumanInteraction humanInteraction + } + + Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] |> Arb.fromGen diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs new file mode 100644 index 0000000..c7bffd9 --- /dev/null +++ b/NightLight.Core.Tests/FakeHome.fs @@ -0,0 +1,135 @@ +namespace NightLight.Core.Tests + +open System +open System.Text.RegularExpressions +open NightLight.Core.Models +open NightLight.Core.Core +open FsToolkit.ErrorHandling +open FSharp.Data + +type HumanInteraction = + | LightTurnedOn of Light + | LightTurnedOff of Light + +type Interaction = + | HumanInteraction of HumanInteraction + | TimeChanged of DateTime + +type Color = + | White + | Yellow + | Red + +type LightState = + | Off + | On of Brightness: byte * Color: Color + +type FakeLight(light: Light) = + let mutable hasPower = false + let mutable brightness: byte = 255uy + let mutable color: Color = White + + member _.LightWithState = light, if hasPower then On(brightness, color) else Off + + member _.TurnOn() = hasPower <- true + + member _.TurnOff() = hasPower <- false + + member _.SetBrightness(newBrightness: byte) = + if hasPower then + brightness <- newBrightness + + member _.SetColor(newColor: Color) = + if hasPower then + color <- newColor + +type FakeHome(now: DateTime) = + let mutable time = now + + let mutable nightLightStateMachine = NightLightStateMachine now + + let assertIsOkAndGet result = + match result with + | Ok value -> value + | Error error -> failwith $"Expected Ok, got Error {error}" + + let friendlyNameToFakeLight = + lights + |> Seq.map (fun light -> light.FriendlyName, FakeLight light) + |> Map.ofSeq + + let processCommand command = + option { + let! friendlyName = + let m = Regex.Match(command.Topic, "^zigbee2mqtt/(.+)/set$") + if m.Success then Some m.Groups.[1].Value else None + + let! fakeLight = Map.tryFind friendlyName friendlyNameToFakeLight + + let parsedPayload = JsonValue.Parse command.Payload + + match parsedPayload.TryGetProperty "brightness" with + | Some(JsonValue.Number newBrightness) -> fakeLight.SetBrightness(byte newBrightness) + | None -> () + | value -> failwith $"Unexpected brightness value {value}" + + match parsedPayload.TryGetProperty "color" with + | Some color -> + match color.TryGetProperty "x", color.TryGetProperty "y" with + | Some(JsonValue.Number 0.3227M), Some(JsonValue.Number 0.329M) -> fakeLight.SetColor White + | Some(JsonValue.Number 0.6942M), Some(JsonValue.Number 0.2963M) -> fakeLight.SetColor Red + | _ -> failwith $"Unexpected color value {color}" + | None -> () + + match parsedPayload.TryGetProperty "color_temp" with + | Some(JsonValue.Number temperature) when temperature = 454M -> fakeLight.SetColor Yellow + | None -> () + | value -> failwith $"Unexpected color temperature value {value}" + } + |> ignore + + let sendEvent event = + let newState, commands = + event |> nightLightStateMachine.OnEventReceived |> assertIsOkAndGet + + commands |> Seq.iter processCommand + nightLightStateMachine <- newState + + member _.Time = time + + member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState + + member _.Interact(interaction: Interaction) = + match interaction with + | HumanInteraction(LightTurnedOn light) -> + friendlyNameToFakeLight[light.FriendlyName].TurnOn() + + { Topic = "zigbee2mqtt/bridge/event" + Payload = + $@"{{ + ""type"": ""device_announce"", + ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} + }}" } + |> ReceivedZigbeeEvent + |> sendEvent + | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() + | TimeChanged newTime -> + time <- newTime + newTime |> Event.TimeChanged |> sendEvent + +type FakeHome with + member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact + + member this.ForAllLightsThatAreOn condition = + this.LightStates + |> Seq.choose (fun (light, state) -> + match state with + | On(brightness, color) -> Some(light, brightness, color) + | Off -> None) + |> Seq.forall condition + + member this.IsDay() = + this.Time.TimeOfDay >= TimeSpan.FromHours 5.5 + && this.Time.TimeOfDay < TimeSpan.FromHours 20.5 + + member this.IsNight() = not (this.IsDay()) diff --git a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj new file mode 100644 index 0000000..5d37e21 --- /dev/null +++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj @@ -0,0 +1,28 @@ + + + + Exe + net9.0 + true + + + + + + + + + + + + + + + + + + + + + + diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs new file mode 100644 index 0000000..e74a2a0 --- /dev/null +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -0,0 +1,29 @@ +namespace NightLight.Core.Tests + +open System +open FsCheck.Xunit +open FsCheck.FSharp + +[ |])>] +type NightLightTests() = + [] + let ``Brightness should always be under 255`` (now: DateTime) (interactions: Interaction list) = + let fakeHome = FakeHome now + fakeHome.Interact interactions + fakeHome.ForAllLightsThatAreOn(fun (_, brightness, _) -> brightness < 255uy) + + [] + let ``Lights should be red during the night`` (now: DateTime) (interactions: Interaction list) = + let fakeHome = FakeHome now + fakeHome.Interact interactions + + fakeHome.IsNight() + ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red) + + [] + let ``Lights should be white or yellow during the day`` (now: DateTime) (interactions: Interaction list) = + let fakeHome = FakeHome now + fakeHome.Interact interactions + + fakeHome.IsDay() + ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) diff --git a/NightLight.Core/Core.fs b/NightLight.Core/Core.fs deleted file mode 100644 index 83cc290..0000000 --- a/NightLight.Core/Core.fs +++ /dev/null @@ -1,46 +0,0 @@ -module NightLight.Core.Core - -open NightLight.Core.Models -open NightLight.Core.PartsOfDay -open NightLight.Core.ZigbeeEvents -open NightLight.Core.ZigbeeCommands -open NightLight.Core.Moods -open FsToolkit.ErrorHandling - -let internal tryFindLight friendlyName = - Seq.tryFind (fun light -> light.FriendlyName = friendlyName) lights - -let internal generateZigbeeCommandToFixLight partOfDay light = - let color, brightness = - getDesiredMood light.Room partOfDay |> getDesiredColorAndBrightness light.Bulb - - generateZigbeeCommand light.FriendlyName color brightness - -let onEventReceived (state: State) (event: Event) : Result = - result { - let partOfDay = getPartOfDay state.Time - - match event with - | ReceivedZigbeeEvent payload -> - let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError - - return - state, - match zigbeeEvent with - | DeviceAnnounce friendlyName -> - let maybeLight = tryFindLight friendlyName - - match maybeLight with - | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton - | None -> Seq.empty - | TimeChanged time -> - let newState = { Time = time } - let newPartOfDay = getPartOfDay time - - return - newState, - if partOfDay <> newPartOfDay then - lights |> Seq.map (generateZigbeeCommandToFixLight newPartOfDay) - else - Seq.empty - } diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 2fb7f54..0d40ef0 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -2,8 +2,6 @@ module NightLight.Core.Models open System -type State = { Time: DateTime } - type Message = { Topic: string; Payload: string } type Event = diff --git a/NightLight.Core/NightLight.Core.fsproj b/NightLight.Core/NightLight.Core.fsproj index 31b2b6e..890f218 100644 --- a/NightLight.Core/NightLight.Core.fsproj +++ b/NightLight.Core/NightLight.Core.fsproj @@ -11,7 +11,7 @@ - + diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs new file mode 100644 index 0000000..02590e5 --- /dev/null +++ b/NightLight.Core/NightLightStateMachine.fs @@ -0,0 +1,48 @@ +module NightLight.Core.Core + +open System +open NightLight.Core.Models +open NightLight.Core.PartsOfDay +open NightLight.Core.ZigbeeEvents +open NightLight.Core.ZigbeeCommands +open NightLight.Core.Moods +open FsToolkit.ErrorHandling + +let internal tryFindLight friendlyName = + Seq.tryFind (fun light -> light.FriendlyName = friendlyName) lights + +let internal generateZigbeeCommandToFixLight partOfDay light = + let color, brightness = + getDesiredMood light.Room partOfDay |> getDesiredColorAndBrightness light.Bulb + + generateZigbeeCommand light.FriendlyName color brightness + +type NightLightStateMachine(time: DateTime) = + member this.OnEventReceived(event: Event) : Result = + result { + let partOfDay = getPartOfDay time + + match event with + | ReceivedZigbeeEvent payload -> + let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError + + return + this, + match zigbeeEvent with + | DeviceAnnounce friendlyName -> + let maybeLight = tryFindLight friendlyName + + match maybeLight with + | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton + | None -> Seq.empty + | TimeChanged newTime -> + let newState = NightLightStateMachine newTime + let newPartOfDay = getPartOfDay newTime + + return + newState, + if partOfDay <> newPartOfDay then + lights |> Seq.map (generateZigbeeCommandToFixLight newPartOfDay) + else + Seq.empty + } diff --git a/NightLight.sln b/NightLight.sln index 0918513..7985b44 100644 --- a/NightLight.sln +++ b/NightLight.sln @@ -4,6 +4,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight", "NightLight\Ni EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight.Core", "NightLight.Core\NightLight.Core.fsproj", "{FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "NightLight.Core.Tests", "NightLight.Core.Tests\NightLight.Core.Tests.fsproj", "{23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -38,6 +40,18 @@ Global {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x64.Build.0 = Release|Any CPU {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x86.ActiveCfg = Release|Any CPU {FE406BDE-B6C1-4BDA-A29D-54D50A7828A9}.Release|x86.Build.0 = Release|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|Any CPU.Build.0 = Debug|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x64.ActiveCfg = Debug|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x64.Build.0 = Debug|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x86.ActiveCfg = Debug|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Debug|x86.Build.0 = Debug|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|Any CPU.ActiveCfg = Release|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|Any CPU.Build.0 = Release|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x64.ActiveCfg = Release|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x64.Build.0 = Release|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x86.ActiveCfg = Release|Any CPU + {23C7B106-B1B8-49A8-B2CF-22C078C8DDB3}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE diff --git a/NightLight/Program.fs b/NightLight/Program.fs index c140173..90ebd12 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -29,12 +29,12 @@ let private publishZigbeeCommands (mqttClient: IMqttClient) (logger: ILogger) (c |> Async.Ignore } -let private handleEvent (mqttClient: IMqttClient) (logger: ILogger) (state: State) (event: Event) = +let private handleEvent (mqttClient: IMqttClient) (logger: ILogger) (state: NightLightStateMachine) (event: Event) = match event with | ReceivedZigbeeEvent payload -> logger.LogInformation("Received message with payload {Payload}", payload) | _ -> () - let result = event |> onEventReceived state + let result = event |> state.OnEventReceived match result with | Ok(newState, commands) -> @@ -77,7 +77,7 @@ let mainAsync _ = let mqttClientOptions = MqttClientOptionsBuilder().WithTcpServer(server).Build() let stateLock = new SemaphoreSlim(1, 1) - let mutable state = { Time = DateTime.Now } + let mutable state = NightLightStateMachine DateTime.Now mqttClient.add_ApplicationMessageReceivedAsync (fun e -> async {