svenvanheugten/night-light
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #3 from svenvanheugten/make-fake-home-independent

Browse source 
Make FakeHome independent of NightLightStateMachine
This commit is contained in:
Sven van Heugten 2026-01-04 20:23:55 +01:00 • committed by GitHub
commit 2fb5bde636
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
6 changed files with 99 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

33
NightLight.Core.Tests/Arbitraries.fs
View file

@ -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<DateTime>
return Interaction.TimeChanged time
}
static member Interactions() : Arbitrary<Interaction list> =
gen {
let genTimeChangedInteraction =
gen {
let! time = ArbMap.defaults |> ArbMap.generate<DateTime>
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

44
NightLight.Core.Tests/FakeHome.fs
View file

@ -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
@ -43,22 +42,20 @@ type FakeLight(light: Light) =
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}"
type FakeHome() =
let friendlyNameToFakeLight =
lights
|> Seq.map (fun light -> light.FriendlyName, FakeLight light)
|> Map.ofSeq
let processCommand command =
let onEventPublished = new Event<Event>()
member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState
[<CLIEvent>]
member _.OnEventPublished = onEventPublished.Publish
member _.ProcessCommand(command: Message) =
option {
let! friendlyName =
let m = Regex.Match(command.Topic, "^zigbee2mqtt/(.+)/set$")
@ -88,17 +85,6 @@ type FakeHome(now: DateTime) =
}
|> 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) ->
@ -111,11 +97,9 @@ type FakeHome(now: DateTime) =
""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }}
}}" }
|> ReceivedZigbeeEvent
|> sendEvent
|> onEventPublished.Trigger
| HumanInteraction(LightTurnedOff light) -> friendlyNameToFakeLight[light.FriendlyName].TurnOff()
| TimeChanged newTime ->
time <- 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
@ -127,9 +111,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())

56
NightLight.Core.Tests/NightLightTests.fs
View file

@ -1,29 +1,63 @@
namespace NightLight.Core.Tests
open System
open NightLight.Core.Core
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
[<Properties(Arbitrary = [| typeof<Arbitraries> |])>]
type NightLightTests() =
[<Property>]
let ``Brightness should always be under 255`` (now: DateTime) (interactions: Interaction list) =
let fakeHome = FakeHome now
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
[<Property>]
let ``Brightness should always be under 255`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.ForAllLightsThatAreOn(fun (_, brightness, _) -> brightness < 255uy)
[<Property>]
let ``Lights should be red during the night`` (now: DateTime) (interactions: Interaction list) =
let fakeHome = FakeHome now
fakeHome.Interact interactions
let ``Lights should be red during the night`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.IsNight()
InteractionsHelpers.isNightAfter interactions
==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)
[<Property>]
let ``Lights should be white or yellow during the day`` (now: DateTime) (interactions: Interaction list) =
let fakeHome = FakeHome now
fakeHome.Interact interactions
let ``Lights should be white or yellow during the day`` (interactions: Interaction list) =
let fakeHome = createFakeHomeWithNightLightAndInteract interactions
fakeHome.IsDay()
InteractionsHelpers.isDayAfter interactions
==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow)

4
NightLight.Core/Models.fs
View file

@ -17,7 +17,9 @@ type ParseZigbeeEventError =
| InvalidFriendlyNameField
| UnknownType
type ParseEventError = ParseZigbeeEventError of ParseZigbeeEventError
type OnEventReceivedError =
| ParseZigbeeEventError of ParseZigbeeEventError
| TimeIsUnknown
type Room =
| Bathroom

21
NightLight.Core/NightLightStateMachine.fs
View file

@ -17,13 +17,15 @@ let internal generateZigbeeCommandToFixLight partOfDay light =
generateZigbeeCommand light.FriendlyName color brightness
type NightLightStateMachine(time: DateTime) =
member this.OnEventReceived(event: Event) : Result<NightLightStateMachine * Message seq, ParseEventError> =
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<NightLightStateMachine * Message seq, OnEventReceivedError> =
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
}

9
NightLight/Program.fs
View file

@ -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 {