From c8e1f0c9feea6e5b50509dcd2d0530e8f2f0b01b Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 19:41:31 +0100 Subject: [PATCH 1/4] Make sure that the first interaction sets the time This is what happens in the `NightLight` program as well. --- NightLight.Core.Tests/Arbitraries.fs | 33 +++++++++++++++++----------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/NightLight.Core.Tests/Arbitraries.fs b/NightLight.Core.Tests/Arbitraries.fs index 39433dc..379c39e 100644 --- a/NightLight.Core.Tests/Arbitraries.fs +++ b/NightLight.Core.Tests/Arbitraries.fs @@ -1,22 +1,29 @@ namespace NightLight.Core.Tests open System +open FsCheck 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 - } + static member Interactions() : Arbitrary = + gen { + 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 - } + 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 + let! initialTimeChangedInteraction = genTimeChangedInteraction + let! remainingInteractions = Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] |> Gen.listOf + + return initialTimeChangedInteraction :: remainingInteractions + } + |> Arb.fromGen From db4434cd20fdc0fe6aa1b3d736d5a42048628983 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 19:42:28 +0100 Subject: [PATCH 2/4] Remove Time on FakeHome We'll have a lot more stuff that we need to compute from the actual interactions, so let's just get the boilerplate ready. --- NightLight.Core.Tests/FakeHome.fs | 14 +------------- NightLight.Core.Tests/NightLightTests.fs | 24 ++++++++++++++++++++++-- 2 files changed, 23 insertions(+), 15 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index c7bffd9..54bcb7a 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -44,8 +44,6 @@ type FakeLight(light: Light) = color <- newColor type FakeHome(now: DateTime) = - let mutable time = now - let mutable nightLightStateMachine = NightLightStateMachine now let assertIsOkAndGet result = @@ -95,8 +93,6 @@ type FakeHome(now: DateTime) = commands |> Seq.iter processCommand nightLightStateMachine <- newState - member _.Time = time - member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState member _.Interact(interaction: Interaction) = @@ -113,9 +109,7 @@ type FakeHome(now: DateTime) = |> ReceivedZigbeeEvent |> sendEvent | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() - | TimeChanged newTime -> - time <- newTime - newTime |> Event.TimeChanged |> sendEvent + | TimeChanged newTime -> newTime |> Event.TimeChanged |> sendEvent type FakeHome with member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact @@ -127,9 +121,3 @@ type FakeHome 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 e74a2a0..e1243ba 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -4,6 +4,26 @@ open System open FsCheck.Xunit open FsCheck.FSharp +module InteractionsHelpers = + let getTimeAfter interactions = + interactions + |> Seq.choose (fun interaction -> + match interaction with + | TimeChanged time -> Some time + | _ -> None) + |> Seq.tryLast + |> function + | Some time -> time + | None -> failwith "Time wasn't changed" + + let isDayAfter interactions = + let time = getTimeAfter interactions + + time.TimeOfDay >= TimeSpan.FromHours 5.5 + && time.TimeOfDay < TimeSpan.FromHours 20.5 + + let isNightAfter = not << isDayAfter + [ |])>] type NightLightTests() = [] @@ -17,7 +37,7 @@ type NightLightTests() = let fakeHome = FakeHome now fakeHome.Interact interactions - fakeHome.IsNight() + InteractionsHelpers.isNightAfter interactions ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red) [] @@ -25,5 +45,5 @@ type NightLightTests() = let fakeHome = FakeHome now fakeHome.Interact interactions - fakeHome.IsDay() + InteractionsHelpers.isDayAfter interactions ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) From 9531dee52bbb77228600848bf5839146ed1931b7 Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 19:52:09 +0100 Subject: [PATCH 3/4] Stop requiring the initial time in NightLightStateMachine We're only fooling ourselves if we think that it's ready *right* after construction anyway. After all, the initial state of the lights won't be updated when the state machine is constructed. --- NightLight.Core.Tests/FakeHome.fs | 4 ++-- NightLight.Core.Tests/NightLightTests.fs | 12 ++++++------ NightLight.Core/Models.fs | 4 +++- NightLight.Core/NightLightStateMachine.fs | 21 ++++++++++++--------- NightLight/Program.fs | 9 ++++++++- 5 files changed, 31 insertions(+), 19 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 54bcb7a..bf7aa6c 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -43,8 +43,8 @@ type FakeLight(light: Light) = if hasPower then color <- newColor -type FakeHome(now: DateTime) = - let mutable nightLightStateMachine = NightLightStateMachine now +type FakeHome() = + let mutable nightLightStateMachine = NightLightStateMachine() let assertIsOkAndGet result = match result with diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index e1243ba..612ad49 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -27,22 +27,22 @@ module InteractionsHelpers = [ |])>] type NightLightTests() = [] - let ``Brightness should always be under 255`` (now: DateTime) (interactions: Interaction list) = - let fakeHome = FakeHome now + let ``Brightness should always be under 255`` (interactions: Interaction list) = + let fakeHome = FakeHome() 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 + let ``Lights should be red during the night`` (interactions: Interaction list) = + let fakeHome = FakeHome() fakeHome.Interact interactions InteractionsHelpers.isNightAfter interactions ==> 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 + let ``Lights should be white or yellow during the day`` (interactions: Interaction list) = + let fakeHome = FakeHome() fakeHome.Interact interactions InteractionsHelpers.isDayAfter interactions diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 0d40ef0..7452f6e 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -17,7 +17,9 @@ type ParseZigbeeEventError = | InvalidFriendlyNameField | UnknownType -type ParseEventError = ParseZigbeeEventError of ParseZigbeeEventError +type OnEventReceivedError = + | ParseZigbeeEventError of ParseZigbeeEventError + | TimeIsUnknown type Room = | Bathroom diff --git a/NightLight.Core/NightLightStateMachine.fs b/NightLight.Core/NightLightStateMachine.fs index 02590e5..f1d5d54 100644 --- a/NightLight.Core/NightLightStateMachine.fs +++ b/NightLight.Core/NightLightStateMachine.fs @@ -17,13 +17,15 @@ let internal generateZigbeeCommandToFixLight partOfDay light = generateZigbeeCommand light.FriendlyName color brightness -type NightLightStateMachine(time: DateTime) = - member this.OnEventReceived(event: Event) : Result = - result { - let partOfDay = getPartOfDay time +type NightLightStateMachine private (maybeTime: DateTime option) = + new() = NightLightStateMachine None - match event with - | ReceivedZigbeeEvent payload -> + member this.OnEventReceived(event: Event) : Result = + result { + let maybePartOfDay = maybeTime |> Option.map getPartOfDay + + match event, maybePartOfDay with + | ReceivedZigbeeEvent payload, Some partOfDay -> let! zigbeeEvent = parseZigbeeEvent payload |> Result.mapError ParseZigbeeEventError return @@ -35,14 +37,15 @@ type NightLightStateMachine(time: DateTime) = match maybeLight with | Some light -> generateZigbeeCommandToFixLight partOfDay light |> Seq.singleton | None -> Seq.empty - | TimeChanged newTime -> - let newState = NightLightStateMachine newTime + | TimeChanged newTime, maybePartOfDay -> + let newState = NightLightStateMachine(Some newTime) let newPartOfDay = getPartOfDay newTime return newState, - if partOfDay <> newPartOfDay then + if maybePartOfDay <> Some newPartOfDay then lights |> Seq.map (generateZigbeeCommandToFixLight newPartOfDay) else Seq.empty + | _, None -> return! Error TimeIsUnknown } diff --git a/NightLight/Program.fs b/NightLight/Program.fs index 90ebd12..04b900f 100644 --- a/NightLight/Program.fs +++ b/NightLight/Program.fs @@ -77,7 +77,14 @@ let mainAsync _ = let mqttClientOptions = MqttClientOptionsBuilder().WithTcpServer(server).Build() let stateLock = new SemaphoreSlim(1, 1) - let mutable state = NightLightStateMachine DateTime.Now + + let! initialState = + let emptyNightLightStateMachine = NightLightStateMachine() + + TimeChanged DateTime.Now + |> handleEvent mqttClient logger emptyNightLightStateMachine + + let mutable state = initialState mqttClient.add_ApplicationMessageReceivedAsync (fun e -> async { From 15bf8db9f468f9e3eb30865d4e40c81102ae1ecf Mon Sep 17 00:00:00 2001 From: Sven van Heugten Date: Sun, 4 Jan 2026 20:17:35 +0100 Subject: [PATCH 4/4] Make FakeHome independent of NightLightStateMachine --- NightLight.Core.Tests/FakeHome.fs | 30 ++++++++---------------- NightLight.Core.Tests/NightLightTests.fs | 26 +++++++++++++++----- 2 files changed, 30 insertions(+), 26 deletions(-) diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index bf7aa6c..6413cbd 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -3,7 +3,6 @@ namespace NightLight.Core.Tests open System open System.Text.RegularExpressions open NightLight.Core.Models -open NightLight.Core.Core open FsToolkit.ErrorHandling open FSharp.Data @@ -44,19 +43,19 @@ type FakeLight(light: Light) = color <- newColor type FakeHome() = - let mutable nightLightStateMachine = NightLightStateMachine() - - 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 = + let onEventPublished = new Event() + + member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState + + [] + member _.OnEventPublished = onEventPublished.Publish + + member _.ProcessCommand(command: Message) = option { let! friendlyName = let m = Regex.Match(command.Topic, "^zigbee2mqtt/(.+)/set$") @@ -86,15 +85,6 @@ type FakeHome() = } |> 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) = match interaction with | HumanInteraction(LightTurnedOn light) -> @@ -107,9 +97,9 @@ type FakeHome() = ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} }}" } |> ReceivedZigbeeEvent - |> sendEvent + |> onEventPublished.Trigger | HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff() - | TimeChanged newTime -> newTime |> Event.TimeChanged |> sendEvent + | TimeChanged newTime -> newTime |> Event.TimeChanged |> onEventPublished.Trigger type FakeHome with member this.Interact(interactions: Interaction seq) = interactions |> Seq.iter this.Interact diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index 612ad49..cc8edfc 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -1,6 +1,7 @@ namespace NightLight.Core.Tests open System +open NightLight.Core.Core open FsCheck.Xunit open FsCheck.FSharp @@ -26,24 +27,37 @@ module InteractionsHelpers = [ |])>] type NightLightTests() = + let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) = + let mutable nightLightStateMachine = NightLightStateMachine() + + let fakeHome = FakeHome() + + fakeHome.OnEventPublished.Add(fun event -> + match event |> nightLightStateMachine.OnEventReceived with + | Ok(newState, commands) -> + commands |> Seq.iter fakeHome.ProcessCommand + nightLightStateMachine <- newState + | Error error -> failwith $"Unexpected error {error}") + + fakeHome.Interact interactions + + fakeHome + [] let ``Brightness should always be under 255`` (interactions: Interaction list) = - let fakeHome = FakeHome() - fakeHome.Interact interactions + let fakeHome = createFakeHomeWithNightLightAndInteract interactions fakeHome.ForAllLightsThatAreOn(fun (_, brightness, _) -> brightness < 255uy) [] let ``Lights should be red during the night`` (interactions: Interaction list) = - let fakeHome = FakeHome() - fakeHome.Interact interactions + let fakeHome = createFakeHomeWithNightLightAndInteract interactions InteractionsHelpers.isNightAfter interactions ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red) [] let ``Lights should be white or yellow during the day`` (interactions: Interaction list) = - let fakeHome = FakeHome() - fakeHome.Interact interactions + let fakeHome = createFakeHomeWithNightLightAndInteract interactions InteractionsHelpers.isDayAfter interactions ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)