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 diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index c7bffd9..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 @@ -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() + + 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$") @@ -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()) diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index e74a2a0..cc8edfc 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -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 + [ |])>] type NightLightTests() = - [] - 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 + + [] + let ``Brightness should always be under 255`` (interactions: Interaction list) = + let fakeHome = createFakeHomeWithNightLightAndInteract 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 + 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) [] - 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) 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 {