Stop propagating parse errors throughout the tests

This commit is contained in:
Sven van Heugten 2026-01-04 09:14:02 +01:00
parent 109ebde64a
commit a741938f89
3 changed files with 22 additions and 25 deletions

View file

@ -59,23 +59,20 @@ type FakeHome(now: DateTime) =
member _.LightStates = friendlyNameToFakeLight.Values |> Seq.map _.LightWithState
member _.Interact(interaction: Interaction) : Result<unit, ParseEventError> =
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()

View file

@ -11,12 +11,18 @@ type NightLightStateMachine(now: DateTime) =
let transmittedCommands = new List<Message>()
let assertIsOk (result: Result<unit, 'a>) : 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()

View file

@ -2,15 +2,9 @@ module NightLight.Core.Tests.NightLightTests
open FsCheck.Xunit
let private assertIsOk (result: Result<unit, 'a>) : unit =
match result with
| Ok() -> ()
| Error error -> failwith $"Expected Ok, got Error {error}"
[<Property(Arbitrary = [| typeof<Arbitraries> |])>]
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) ->