Merge pull request #5 from svenvanheugten/refactor-tests-to-use-better-arbitraries

Refactor tests to use better arbitraries

NightLight.Core.Tests/Arbitraries.fs

@@ -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<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! initialTimeChangedInteraction = genTimeChangedInteraction
-            let! remainingInteractions = Gen.oneof [ genTimeChangedInteraction; genHumanInteraction ] |> Gen.listOf
-
-            return initialTimeChangedInteraction :: remainingInteractions
-        }
-        |> Arb.fromGen

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<DateTime>
+        |> Gen.filter isDay
+        |> Gen.bind genInteractionsListThatEndsAtTime
+        |> Arb.fromGen
+
+type ArbitraryInteractionsListThatEndsDuringTheNight =
+    static member InteractionsList() =
+        ArbMap.defaults
+        |> ArbMap.generate<DateTime>
+        |> Gen.filter (not << isDay)
+        |> Gen.bind genInteractionsListThatEndsAtTime
+        |> Arb.fromGen

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

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<DateTime> |> 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 ]

NightLight.Core.Tests/NightLight.Core.Tests.fsproj

@@ -8,7 +8,8 @@
 
     <ItemGroup>
         <Compile Include="FakeHome.fs" />
-        <Compile Include="Arbitraries.fs" />
+        <Compile Include="InteractionListGenerators.fs" />
+        <Compile Include="ArbitraryInteractionLists.fs" />
         <Compile Include="NightLightTests.fs" />
     </ItemGroup>
 

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
-
-[<Properties(Arbitrary = [| typeof<Arbitraries> |])>]
 type NightLightTests() =
     let createFakeHomeWithNightLightAndInteract (interactions: Interaction list) =
         let mutable nightLightStateMachine = NightLightStateMachine()
@@ -43,21 +21,12 @@ type NightLightTests() =
 
         fakeHome
 
-    [<Property>]
+    [<Property(Arbitrary = [| typeof<ArbitraryInteractionsListThatEndsDuringTheDay> |])>]
-    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`` (interactions: Interaction list) =
-        let fakeHome = createFakeHomeWithNightLightAndInteract interactions
-
-        InteractionsHelpers.isNightAfter interactions
-        ==> fakeHome.ForAllLightsThatAreOn(fun (_, _, color) -> color = Red)
-
-    [<Property>]
     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
+    [<Property(Arbitrary = [| typeof<ArbitraryInteractionsListThatEndsDuringTheNight> |])>]
-        ==> 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)

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 } ]

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 }

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