From fc069edf31940036528004b22598cd362fe05f6a Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sat, 3 Jan 2026 20:55:45 +0100 Subject: [PATCH 1/9] Implement FakeHome --- NightLight.Core.Tests/FakeHome.fs | 81 +++++++++++++++++++ .../NightLight.Core.Tests.fsproj | 27 +++++++ .../NightLightStateMachine.fs | 28 +++++++ NightLight.sln | 14 ++++ 4 files changed, 150 insertions(+) create mode 100644 NightLight.Core.Tests/FakeHome.fs create mode 100644 NightLight.Core.Tests/NightLight.Core.Tests.fsproj create mode 100644 NightLight.Core.Tests/NightLightStateMachine.fs diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs new file mode 100644 index 0000000..df2da1b --- /dev/null +++ b/NightLight.Core.Tests/FakeHome.fs @@ -0,0 +1,81 @@ +namespace NightLight.Core.Tests + +open System +open System.Text.RegularExpressions +open NightLight.Core.Models +open FsToolkit.ErrorHandling +open FSharp.Data + +type HumanInteraction = + | LightTurnedOn of Light + | LightTurnedOff of Light + +type Interaction = + | HumanInteraction of HumanInteraction + | TimeChanged of DateTime + +type LightState = + | Off + | On of Brightness: byte + +type FakeLight(light: Light) = + let mutable hasPower = false + let mutable brightness: byte = 255uy + + member _.LightWithState = light, if hasPower then On brightness else Off + + member _.TurnOn() = hasPower <- true + + member _.TurnOff() = hasPower <- false + + member _.SetBrightness(newBrightness: byte) = + if hasPower then + brightness <- newBrightness + +type FakeHome(now: DateTime) = + let nightLightStateMachine = NightLightStateMachine now + + 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}" + } + |> ignore + + member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState + + member _.Interact(interaction: Interaction) : Result = + result { + match interaction with + | HumanInteraction(LightTurnedOn light) -> + friendlyNameToFakeLight[light.FriendlyName].TurnOn() + + do! + { Topic = "zigbee2mqtt/bridge/event" + Payload = + $@"{{ + ""type"": ""device_announce"", + ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} + }}" } + |> nightLightStateMachine.SendMessage + | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() + | TimeChanged time -> do! nightLightStateMachine.ChangeTime time + + nightLightStateMachine.TransmittedCommands |> Seq.iter processCommand + nightLightStateMachine.ClearTransmittedCommands() + } diff --git a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj new file mode 100644 index 0000000..4979a7a --- /dev/null +++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj @@ -0,0 +1,27 @@ + + + + Exe + net9.0 + true + + + + + + + + + + + + + + + + + + + + + diff --git a/NightLight.Core.Tests/NightLightStateMachine.fs b/NightLight.Core.Tests/NightLightStateMachine.fs new file mode 100644 index 0000000..0379a3b --- /dev/null +++ b/NightLight.Core.Tests/NightLightStateMachine.fs @@ -0,0 +1,28 @@ +namespace NightLight.Core.Tests + +open System +open System.Collections.Generic +open FsToolkit.ErrorHandling +open NightLight.Core.Models +open NightLight.Core.Core + +type NightLightStateMachine(now: DateTime) = + let mutable state = { Time = now } + + let transmittedCommands = new List() + + let sendEvent event = + result { + let! newState, commands = onEventReceived state event + state <- newState + transmittedCommands.AddRange commands + } + + member _.TransmittedCommands = transmittedCommands.AsReadOnly() + + member _.SendMessage message = + ReceivedZigbeeEvent message |> sendEvent + + member _.ChangeTime time = TimeChanged time |> sendEvent + + member _.ClearTransmittedCommands() = transmittedCommands.Clear() 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 From 109ebde64af3d0aad40924fa1832fc47a99f7014 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 09:09:50 +0100 Subject: [PATCH 2/9] Write the first test --- NightLight.Core.Tests/Arbitraries.fs | 22 +++++++++++++++++++ .../NightLight.Core.Tests.fsproj | 2 ++ NightLight.Core.Tests/NightLightTests.fs | 20 +++++++++++++++++ 3 files changed, 44 insertions(+) create mode 100644 NightLight.Core.Tests/Arbitraries.fs create mode 100644 NightLight.Core.Tests/NightLightTests.fs 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/NightLight.Core.Tests.fsproj b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj index 4979a7a..7a4c7eb 100644 --- a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj +++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj @@ -9,6 +9,8 @@ + + diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs new file mode 100644 index 0000000..b7419fd --- /dev/null +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -0,0 +1,20 @@ +module NightLight.Core.Tests.NightLightTests + +open FsCheck.Xunit + +let private assertIsOk (result: Result) : unit = + match result with + | Ok() -> () + | Error error -> failwith $"Expected Ok, got Error {error}" + +[ |])>] +let ``Brightness should always be under 255`` (fakeHome: FakeHome) (interactions: Interaction list) = + interactions + |> Seq.iter (fun interaction -> fakeHome.Interact interaction |> assertIsOk) + + fakeHome.LightStates + |> Seq.choose (fun (_, state) -> + match state with + | On brightness -> Some brightness + | Off -> None) + |> Seq.forall (fun brightness -> brightness < 255uy) From a741938f89056eeccef3b2f47c3e0b478593b915 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 09:14:02 +0100 Subject: [PATCH 3/9] Stop propagating parse errors throughout the tests --- NightLight.Core.Tests/FakeHome.fs | 33 +++++++++---------- .../NightLightStateMachine.fs | 6 ++++ NightLight.Core.Tests/NightLightTests.fs | 8 +---- 3 files changed, 22 insertions(+), 25 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index df2da1b..f9b9d2d 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -59,23 +59,20 @@ type FakeHome(now: DateTime) = member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState - member _.Interact(interaction: Interaction) : Result = - result { - match interaction with - | HumanInteraction(LightTurnedOn light) -> - friendlyNameToFakeLight[light.FriendlyName].TurnOn() + member _.Interact(interaction: Interaction) = + match interaction with + | HumanInteraction(LightTurnedOn light) -> + friendlyNameToFakeLight[light.FriendlyName].TurnOn() - do! - { Topic = "zigbee2mqtt/bridge/event" - Payload = - $@"{{ - ""type"": ""device_announce"", - ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} - }}" } - |> nightLightStateMachine.SendMessage - | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() - | TimeChanged time -> do! nightLightStateMachine.ChangeTime time + { Topic = "zigbee2mqtt/bridge/event" + Payload = + $@"{{ + ""type"": ""device_announce"", + ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} + }}" } + |> nightLightStateMachine.SendMessage + | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() + | TimeChanged time -> nightLightStateMachine.ChangeTime time - nightLightStateMachine.TransmittedCommands |> Seq.iter processCommand - nightLightStateMachine.ClearTransmittedCommands() - } + nightLightStateMachine.TransmittedCommands |> Seq.iter processCommand + nightLightStateMachine.ClearTransmittedCommands() diff --git a/NightLight.Core.Tests/NightLightStateMachine.fs b/NightLight.Core.Tests/NightLightStateMachine.fs index 0379a3b..f552cb1 100644 --- a/NightLight.Core.Tests/NightLightStateMachine.fs +++ b/NightLight.Core.Tests/NightLightStateMachine.fs @@ -11,12 +11,18 @@ type NightLightStateMachine(now: DateTime) = let transmittedCommands = new List() + let assertIsOk (result: Result) : unit = + match result with + | Ok() -> () + | Error error -> failwith $"Expected Ok, got Error {error}" + let sendEvent event = result { let! newState, commands = onEventReceived state event state <- newState transmittedCommands.AddRange commands } + |> assertIsOk member _.TransmittedCommands = transmittedCommands.AsReadOnly() diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index b7419fd..0fe7190 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -2,15 +2,9 @@ module NightLight.Core.Tests.NightLightTests open FsCheck.Xunit -let private assertIsOk (result: Result) : unit = - match result with - | Ok() -> () - | Error error -> failwith $"Expected Ok, got Error {error}" - [ |])>] let ``Brightness should always be under 255`` (fakeHome: FakeHome) (interactions: Interaction list) = - interactions - |> Seq.iter (fun interaction -> fakeHome.Interact interaction |> assertIsOk) + interactions |> Seq.iter (fun interaction -> fakeHome.Interact interaction) fakeHome.LightStates |> Seq.choose (fun (_, state) -> From bd550bfcd93d131252a77c6511cbf9aa96e84f26 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 10:13:18 +0100 Subject: [PATCH 4/9] Encapsulate State to make it impossible to read This was NightLightStateMachine's purpose, but it fits equally well in the actual production code. --- .../NightLightStateMachine.fs | 4 +- NightLight.Core/Core.fs | 50 ++++++++++--------- NightLight.Core/Models.fs | 2 - NightLight/Program.fs | 2 +- 4 files changed, 29 insertions(+), 29 deletions(-) diff --git a/NightLight.Core.Tests/NightLightStateMachine.fs b/NightLight.Core.Tests/NightLightStateMachine.fs index f552cb1..993157f 100644 --- a/NightLight.Core.Tests/NightLightStateMachine.fs +++ b/NightLight.Core.Tests/NightLightStateMachine.fs @@ -7,7 +7,7 @@ open NightLight.Core.Models open NightLight.Core.Core type NightLightStateMachine(now: DateTime) = - let mutable state = { Time = now } + let mutable state = State now let transmittedCommands = new List() @@ -18,7 +18,7 @@ type NightLightStateMachine(now: DateTime) = let sendEvent event = result { - let! newState, commands = onEventReceived state event + let! newState, commands = state.OnEventReceived event state <- newState transmittedCommands.AddRange commands } diff --git a/NightLight.Core/Core.fs b/NightLight.Core/Core.fs index 83cc290..083cb31 100644 --- a/NightLight.Core/Core.fs +++ b/NightLight.Core/Core.fs @@ -1,5 +1,6 @@ module NightLight.Core.Core +open System open NightLight.Core.Models open NightLight.Core.PartsOfDay open NightLight.Core.ZigbeeEvents @@ -16,31 +17,32 @@ let internal generateZigbeeCommandToFixLight partOfDay light = generateZigbeeCommand light.FriendlyName color brightness -let onEventReceived (state: State) (event: Event) : Result = - result { - let partOfDay = getPartOfDay state.Time +type State(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 + match event with + | ReceivedZigbeeEvent payload -> + let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError - return - state, - match zigbeeEvent with - | DeviceAnnounce friendlyName -> - let maybeLight = tryFindLight friendlyName + 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 time -> - let newState = { Time = time } - let newPartOfDay = getPartOfDay time + match maybeLight with + | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton + | None -> Seq.empty + | TimeChanged newTime -> + let newState = State newTime + let newPartOfDay = getPartOfDay newTime - return - newState, - if partOfDay <> newPartOfDay then - lights |> Seq.map (generateZigbeeCommandToFixLight newPartOfDay) - else - Seq.empty - } + 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/Program.fs b/NightLight/Program.fs index c140173..112d313 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -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 = State DateTime.Now mqttClient.add_ApplicationMessageReceivedAsync (fun e -> async { From 285874777a182295e7ff0299b56800f5dc4e1883 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 10:23:36 +0100 Subject: [PATCH 5/9] Get rid of NightLightStateMachine in the tests --- NightLight.Core.Tests/FakeHome.fs | 23 +++++++++---- .../NightLight.Core.Tests.fsproj | 1 - .../NightLightStateMachine.fs | 34 ------------------- 3 files changed, 17 insertions(+), 41 deletions(-) delete mode 100644 NightLight.Core.Tests/NightLightStateMachine.fs diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index f9b9d2d..9fe9223 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -3,6 +3,7 @@ namespace NightLight.Core.Tests open System open System.Text.RegularExpressions open NightLight.Core.Models +open NightLight.Core.Core open FsToolkit.ErrorHandling open FSharp.Data @@ -33,7 +34,12 @@ type FakeLight(light: Light) = brightness <- newBrightness type FakeHome(now: DateTime) = - let nightLightStateMachine = NightLightStateMachine now + let mutable nightLightStateMachine = State now + + let assertIsOkAndGet result = + match result with + | Ok value -> value + | Error error -> failwith $"Expected Ok, got Error {error}" let friendlyNameToFakeLight = lights @@ -57,6 +63,13 @@ type FakeHome(now: DateTime) = } |> ignore + let sendEvent event = + let newState, commands = + event |> nightLightStateMachine.OnEventReceived |> assertIsOkAndGet + + commands |> Seq.iter processCommand + nightLightStateMachine <- newState + member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState member _.Interact(interaction: Interaction) = @@ -70,9 +83,7 @@ type FakeHome(now: DateTime) = ""type"": ""device_announce"", ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} }}" } - |> nightLightStateMachine.SendMessage + |> ReceivedZigbeeEvent + |> sendEvent | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() - | TimeChanged time -> nightLightStateMachine.ChangeTime time - - nightLightStateMachine.TransmittedCommands |> Seq.iter processCommand - nightLightStateMachine.ClearTransmittedCommands() + | TimeChanged time -> time |> Event.TimeChanged |> sendEvent diff --git a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj index 7a4c7eb..5d37e21 100644 --- a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj +++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj @@ -7,7 +7,6 @@ - diff --git a/NightLight.Core.Tests/NightLightStateMachine.fs b/NightLight.Core.Tests/NightLightStateMachine.fs deleted file mode 100644 index 993157f..0000000 --- a/NightLight.Core.Tests/NightLightStateMachine.fs +++ /dev/null @@ -1,34 +0,0 @@ -namespace NightLight.Core.Tests - -open System -open System.Collections.Generic -open FsToolkit.ErrorHandling -open NightLight.Core.Models -open NightLight.Core.Core - -type NightLightStateMachine(now: DateTime) = - let mutable state = State now - - let transmittedCommands = new List() - - let assertIsOk (result: Result) : unit = - match result with - | Ok() -> () - | Error error -> failwith $"Expected Ok, got Error {error}" - - let sendEvent event = - result { - let! newState, commands = state.OnEventReceived event - state <- newState - transmittedCommands.AddRange commands - } - |> assertIsOk - - member _.TransmittedCommands = transmittedCommands.AsReadOnly() - - member _.SendMessage message = - ReceivedZigbeeEvent message |> sendEvent - - member _.ChangeTime time = TimeChanged time |> sendEvent - - member _.ClearTransmittedCommands() = transmittedCommands.Clear() From c7c5de9e2108ce50dedff197457b6819f2612272 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 10:24:55 +0100 Subject: [PATCH 6/9] State -> NightLightStateMachine --- NightLight.Core.Tests/FakeHome.fs | 2 +- NightLight.Core/NightLight.Core.fsproj | 2 +- NightLight.Core/{Core.fs => NightLightStateMachine.fs} | 6 +++--- NightLight/Program.fs | 6 +++--- 4 files changed, 8 insertions(+), 8 deletions(-) rename NightLight.Core/{Core.fs => NightLightStateMachine.fs} (87%) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 9fe9223..3d758d4 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -34,7 +34,7 @@ type FakeLight(light: Light) = brightness <- newBrightness type FakeHome(now: DateTime) = - let mutable nightLightStateMachine = State now + let mutable nightLightStateMachine = NightLightStateMachine now let assertIsOkAndGet result = match result with 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/Core.fs b/NightLight.Core/NightLightStateMachine.fs similarity index 87% rename from NightLight.Core/Core.fs rename to NightLight.Core/NightLightStateMachine.fs index 083cb31..02590e5 100644 --- a/NightLight.Core/Core.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -17,8 +17,8 @@ let internal generateZigbeeCommandToFixLight partOfDay light = generateZigbeeCommand light.FriendlyName color brightness -type State(time: DateTime) = - member this.OnEventReceived(event: Event) : Result = +type NightLightStateMachine(time: DateTime) = + member this.OnEventReceived(event: Event) : Result = result { let partOfDay = getPartOfDay time @@ -36,7 +36,7 @@ type State(time: DateTime) = | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton | None -> Seq.empty | TimeChanged newTime -> - let newState = State newTime + let newState = NightLightStateMachine newTime let newPartOfDay = getPartOfDay newTime return diff --git a/NightLight/Program.fs b/NightLight/Program.fs index 112d313..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 = State DateTime.Now + let mutable state = NightLightStateMachine DateTime.Now mqttClient.add_ApplicationMessageReceivedAsync (fun e -> async { From 6baf7257659a976c3a3d28361c13a5183fbf25b5 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 10:31:13 +0100 Subject: [PATCH 7/9] Put Arbitraries on the entire test class --- NightLight.Core.Tests/NightLightTests.fs | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 0fe7190..40bb097 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -1,14 +1,16 @@ -module NightLight.Core.Tests.NightLightTests +namespace NightLight.Core.Tests open FsCheck.Xunit -[ |])>] -let ``Brightness should always be under 255`` (fakeHome: FakeHome) (interactions: Interaction list) = - interactions |> Seq.iter (fun interaction -> fakeHome.Interact interaction) +[ |])>] +type NightLightTests() = + [] + let ``Brightness should always be under 255`` (fakeHome: FakeHome) (interactions: Interaction list) = + interactions |> Seq.iter (fun interaction -> fakeHome.Interact interaction) - fakeHome.LightStates - |> Seq.choose (fun (_, state) -> - match state with - | On brightness -> Some brightness - | Off -> None) - |> Seq.forall (fun brightness -> brightness < 255uy) + fakeHome.LightStates + |> Seq.choose (fun (_, state) -> + match state with + | On brightness -> Some brightness + | Off -> None) + |> Seq.forall (fun brightness -> brightness < 255uy) From 7125fee28ea4926e6d1571f4ad32fc882bed075e Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 10:42:47 +0100 Subject: [PATCH 8/9] Parse color commands in FakeHome --- NightLight.Core.Tests/FakeHome.fs | 27 ++++++++++++++++++++++-- NightLight.Core.Tests/NightLightTests.fs | 2 +- 2 files changed, 26 insertions(+), 3 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 3d758d4..e7c0112 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -15,15 +15,21 @@ type Interaction = | HumanInteraction of HumanInteraction | TimeChanged of DateTime +type Color = + | White + | Yellow + | Red + type LightState = | Off - | On of Brightness: byte + | 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 else Off + member _.LightWithState = light, if hasPower then On(brightness, color) else Off member _.TurnOn() = hasPower <- true @@ -33,6 +39,10 @@ type FakeLight(light: Light) = if hasPower then brightness <- newBrightness + member _.SetColor(newColor: Color) = + if hasPower then + color <- newColor + type FakeHome(now: DateTime) = let mutable nightLightStateMachine = NightLightStateMachine now @@ -60,6 +70,19 @@ type FakeHome(now: DateTime) = | 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 diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 40bb097..b9a361e 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -11,6 +11,6 @@ type NightLightTests() = fakeHome.LightStates |> Seq.choose (fun (_, state) -> match state with - | On brightness -> Some brightness + | On(brightness, _) -> Some brightness | Off -> None) |> Seq.forall (fun brightness -> brightness < 255uy) From 48aaabde3be922e64a32e9c12f52d1f21b185f62 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 10:50:18 +0100 Subject: [PATCH 9/9] Add tests for colors --- NightLight.Core.Tests/FakeHome.fs | 25 +++++++++++++++++++- NightLight.Core.Tests/NightLightTests.fs | 29 +++++++++++++++++------- 2 files changed, 45 insertions(+), 9 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index e7c0112..c7bffd9 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -44,6 +44,8 @@ type FakeLight(light: Light) = color <- newColor type FakeHome(now: DateTime) = + let mutable time = now + let mutable nightLightStateMachine = NightLightStateMachine now let assertIsOkAndGet result = @@ -93,6 +95,8 @@ type FakeHome(now: DateTime) = commands |> Seq.iter processCommand nightLightStateMachine <- newState + member _.Time = time + member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState member _.Interact(interaction: Interaction) = @@ -109,4 +113,23 @@ type FakeHome(now: DateTime) = |> ReceivedZigbeeEvent |> sendEvent | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() - | TimeChanged time -> time |> Event.TimeChanged |> sendEvent + | 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/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index b9a361e..e74a2a0 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -1,16 +1,29 @@ namespace NightLight.Core.Tests +open System open FsCheck.Xunit +open FsCheck.FSharp [ |])>] type NightLightTests() = [] - let ``Brightness should always be under 255`` (fakeHome: FakeHome) (interactions: Interaction list) = - interactions |> Seq.iter (fun interaction -> fakeHome.Interact interaction) + 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) - fakeHome.LightStates - |> Seq.choose (fun (_, state) -> - match state with - | On(brightness, _) -> Some brightness - | Off -> None) - |> Seq.forall (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)