diff --git a/NightLight.Core.Tests/Arbitraries.fs b/NightLight.Core.Tests/Arbitraries.fs deleted file mode 100644 index 379c39e..0000000 --- a/NightLight.Core.Tests/Arbitraries.fs +++ /dev/null @@ -1,29 +0,0 @@ -namespace NightLight.Core.Tests - -open System -open FsCheck -open FsCheck.FSharp -open NightLight.Core.Models - -type Arbitraries = - 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! initialTimeChangedInteraction = genTimeChangedInteraction - let! remainingInteractions = Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] |> Gen.listOf - - return initialTimeChangedInteraction :: remainingInteractions - } - |> Arb.fromGen diff --git a/NightLight.Core.Tests/ArbitraryInteractionLists.fs b/NightLight.Core.Tests/ArbitraryInteractionLists.fs new file mode 100644 index 0000000..9098db1 --- /dev/null +++ b/NightLight.Core.Tests/ArbitraryInteractionLists.fs @@ -0,0 +1,25 @@ +module NightLight.Core.Tests.ArbitraryInteractionLists + +open System +open FsCheck.FSharp +open NightLight.Core.Tests.InteractionListGenerators + +let private isDay (time: DateTime) = + time.TimeOfDay >= TimeSpan.FromHours 5.5 + && time.TimeOfDay < TimeSpan.FromHours 20.5 + +type ArbitraryInteractionsListThatEndsDuringTheDay = + static member InteractionsList() = + ArbMap.defaults + |> ArbMap.generate + |> Gen.filter isDay + |> Gen.bind genInteractionsListThatEndsAtTime + |> Arb.fromGen + +type ArbitraryInteractionsListThatEndsDuringTheNight = + static member InteractionsList() = + ArbMap.defaults + |> ArbMap.generate + |> Gen.filter (not << isDay) + |> Gen.bind genInteractionsListThatEndsAtTime + |> Arb.fromGen diff --git a/NightLight.Core.Tests/FakeHome.fs b/NightLight.Core.Tests/FakeHome.fs index 6413cbd..3facd72 100644 --- a/NightLight.Core.Tests/FakeHome.fs +++ b/NightLight.Core.Tests/FakeHome.fs @@ -59,7 +59,11 @@ type FakeHome() = option { let! friendlyName = let m = Regex.Match(command.Topic, "^zigbee2mqtt/(.+)/set$") - if m.Success then Some m.Groups.[1].Value else None + + if m.Success then + Some(DeviceFriendlyName m.Groups.[1].Value) + else + None let! fakeLight = Map.tryFind friendlyName friendlyNameToFakeLight @@ -94,7 +98,7 @@ type FakeHome() = Payload = $@"{{ ""type"": ""device_announce"", - ""data"": {{ ""friendly_name"": ""{light.FriendlyName}"" }} + ""data"": {{ ""friendly_name"": ""{light.FriendlyName.Get}"" }} }}" } |> ReceivedZigbeeEvent |> onEventPublished.Trigger diff --git a/NightLight.Core.Tests/InteractionListGenerators.fs b/NightLight.Core.Tests/InteractionListGenerators.fs new file mode 100644 index 0000000..d1e1925 --- /dev/null +++ b/NightLight.Core.Tests/InteractionListGenerators.fs @@ -0,0 +1,41 @@ +module NightLight.Core.Tests.InteractionListGenerators + +open System +open FsCheck.FSharp +open NightLight.Core.Models + +let private genTimeChangedInteraction = + ArbMap.defaults |> ArbMap.generate |> Gen.map Interaction.TimeChanged + +let private genHumanInteraction = + Gen.elements lights + |> Gen.bind (fun light -> + [ LightTurnedOn light; LightTurnedOff light ] + |> Gen.elements + |> Gen.map Interaction.HumanInteraction) + +let private genInteraction = + Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] + +let private genInteractionsListThatStartsWithTimeChange = + gen { + let! firstInteraction = genTimeChangedInteraction + let! remainingInteractions = Gen.listOf genInteraction + return firstInteraction :: remainingInteractions + } + +let private genInteractionsListWhere condition = + Gen.listOf (genInteraction |> Gen.filter condition) + +let genInteractionsListThatEndsAtTime time = + let genTrivialList = Gen.constant <| List.singleton (Interaction.TimeChanged time) + + let genNonTrivialList = + gen { + let! before = genInteractionsListThatStartsWithTimeChange + let interactionThatSetsEndTime = Interaction.TimeChanged time + let! after = genInteractionsListWhere (not << _.IsTimeChanged) + return before @ interactionThatSetsEndTime :: after + } + + Gen.frequency [ 1, genTrivialList; 9, genNonTrivialList ] diff --git a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj index 5d37e21..66f25e0 100644 --- a/NightLight.Core.Tests/NightLight.Core.Tests.fsproj +++ b/NightLight.Core.Tests/NightLight.Core.Tests.fsproj @@ -8,7 +8,8 @@ - + + diff --git a/NightLight.Core.Tests/NightLightTests.fs b/NightLight.Core.Tests/NightLightTests.fs index cc8edfc..6423a68 100644 --- a/NightLight.Core.Tests/NightLightTests.fs +++ b/NightLight.Core.Tests/NightLightTests.fs @@ -1,31 +1,9 @@ namespace NightLight.Core.Tests -open System open NightLight.Core.Core +open NightLight.Core.Tests.ArbitraryInteractionLists 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 createFakeHomeWithNightLightAndInteract (interactions: Interaction list) = let mutable nightLightStateMachine = NightLightStateMachine() @@ -43,21 +21,12 @@ type NightLightTests() = 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`` (interactions: Interaction list) = - 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 = createFakeHomeWithNightLightAndInteract interactions + fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) - InteractionsHelpers.isDayAfter interactions - ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = White || color = Yellow) + [ |])>] + let ``Lights should be red during the night`` (interactions: Interaction list) = + let fakeHome = createFakeHomeWithNightLightAndInteract interactions + fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red) diff --git a/NightLight.Core/Models.fs b/NightLight.Core/Models.fs index 7452f6e..b9fa8db 100644 --- a/NightLight.Core/Models.fs +++ b/NightLight.Core/Models.fs @@ -30,24 +30,31 @@ type Bulb = | IkeaBulb | PaulmannBulb +type DeviceFriendlyName = + | DeviceFriendlyName of string + + member this.Get = + match this with + | DeviceFriendlyName deviceFriendlyName -> deviceFriendlyName + type Light = - { FriendlyName: string + { FriendlyName: DeviceFriendlyName Room: Room Bulb: Bulb } let lights = - [ { FriendlyName = "Vardagsrum - Fönsterlampa" + [ { FriendlyName = DeviceFriendlyName "Vardagsrum - Fönsterlampa" Room = LivingRoom Bulb = IkeaBulb } - { FriendlyName = "Vardagsrum - Vägglampa" + { FriendlyName = DeviceFriendlyName "Vardagsrum - Vägglampa" Room = LivingRoom Bulb = PaulmannBulb } - { FriendlyName = "Vardagsrum - Golvlampa" + { FriendlyName = DeviceFriendlyName "Vardagsrum - Golvlampa" Room = LivingRoom Bulb = PaulmannBulb } - { FriendlyName = "Badrum - Taklampa" + { FriendlyName = DeviceFriendlyName "Badrum - Taklampa" Room = Bathroom Bulb = IkeaBulb } - { FriendlyName = "Sovrum - Nattduksbordlampa" + { FriendlyName = DeviceFriendlyName "Sovrum - Nattduksbordlampa" Room = Bedroom Bulb = IkeaBulb } ] diff --git a/NightLight.Core/ZigbeeCommands.fs b/NightLight.Core/ZigbeeCommands.fs index 6df6e85..2d25c04 100644 --- a/NightLight.Core/ZigbeeCommands.fs +++ b/NightLight.Core/ZigbeeCommands.fs @@ -4,7 +4,7 @@ open System.Text.Json.Nodes open NightLight.Core.Models open NightLight.Core.Moods -let generateZigbeeCommand friendlyName targetColor targetBrightness = +let generateZigbeeCommand (friendlyName: DeviceFriendlyName) targetColor targetBrightness = let commandObj = JsonObject() match targetColor with @@ -19,7 +19,7 @@ let generateZigbeeCommand friendlyName targetColor targetBrightness = match targetBrightness with | Brightness b -> b - let topic = $"zigbee2mqtt/{friendlyName}/set" + let topic = $"zigbee2mqtt/{friendlyName.Get}/set" let payload = commandObj.ToJsonString() { Topic = topic; Payload = payload } diff --git a/NightLight.Core/ZigbeeEvents.fs b/NightLight.Core/ZigbeeEvents.fs index b435698..e6a9769 100644 --- a/NightLight.Core/ZigbeeEvents.fs +++ b/NightLight.Core/ZigbeeEvents.fs @@ -4,7 +4,7 @@ open NightLight.Core.Models open FsToolkit.ErrorHandling open FSharp.Data -type ZigbeeEvent = DeviceAnnounce of FriendlyName: string +type ZigbeeEvent = DeviceAnnounce of DeviceFriendlyName let parseZigbeeEvent (message: Message) = result { @@ -17,7 +17,7 @@ let parseZigbeeEvent (message: Message) = match messageType with | JsonValue.String "device_announce" -> match messageData.TryGetProperty "friendly_name" with - | Some(JsonValue.String friendlyName) -> Ok(DeviceAnnounce friendlyName) + | Some(JsonValue.String friendlyName) -> Ok <| DeviceAnnounce(DeviceFriendlyName friendlyName) | Some _ -> Error InvalidFriendlyNameField | None -> Error MissingFriendlyNameField | JsonValue.String _ -> Error UnknownType