Test the SerializeUTCTime property

default.nix

@@ -1,7 +1,7 @@
 { mkDerivation, aeson, annotated-exception, async, base, bytestring
-, cereal, containers, directory, ekg-core, hedgehog, hspec
-, hspec-hedgehog, katip, lens, lens-aeson, lib, network, process
-, stm, text, time, unordered-containers, uuid, websockets
+, cereal, containers, directory, ekg-core, filepath, hedgehog
+, hspec, hspec-hedgehog, katip, lens, lens-aeson, lib, network
+, process, stm, text, time, unordered-containers, uuid, websockets
 }:
 mkDerivation {
   pname = "home-assistant-controller";
@@ -11,13 +11,13 @@ mkDerivation {
   isExecutable = true;
   libraryHaskellDepends = [
     aeson annotated-exception async base bytestring cereal containers
-    directory ekg-core katip lens lens-aeson network process stm text
-    time unordered-containers uuid websockets
+    directory ekg-core filepath katip lens lens-aeson network process
+    stm text time unordered-containers uuid websockets
   ];
   executableHaskellDepends = [ base ];
   testHaskellDepends = [
-    aeson annotated-exception async base containers directory ekg-core
-    hedgehog hspec hspec-hedgehog katip process stm text time
+    aeson annotated-exception async base cereal containers directory
+    ekg-core hedgehog hspec hspec-hedgehog katip process stm text time
     unordered-containers uuid
   ];
   license = lib.meta.getLicenseFromSpdxId "BSD-3-Clause";

home-assistant-controller.cabal

@@ -169,6 +169,7 @@ test-suite home-assistant-controller-test
         hspec,
         stm,
         aeson,
+        cereal,
         text,
         async,
         hedgehog,

src/AFRP.hs

@@ -390,9 +390,8 @@ data DelayState x a = DelayState
 instance (Serialize x, Serialize a) => Serialize (DelayState x a)
 
 newtype SerializeUTCTime = SerializeUTCTime UTCTime
-  deriving Eq
+  deriving (Eq, Show)
 
--- TODO: Needs '\x -> pure x == get (put x)' test
 instance Serialize SerializeUTCTime where
   put (SerializeUTCTime (UTCTime day time)) = do
     put (toModifiedJulianDay day)

test/AFRPSpec.hs

@@ -9,9 +9,10 @@ import Data.Foldable (for_)
 import AFRP
 import Data.Functor.Identity (Identity (..))
 import Data.List (sort)
+import Data.Serialize (get, put, runGet, runPut)
 import qualified Data.Set as S
 import qualified Data.Text as T
-import Data.Time (NominalDiffTime, UTCTime (..), utc)
+import Data.Time (Day (..), NominalDiffTime, UTCTime (..), picosecondsToDiffTime, utc)
 import Data.UUID (nil)
 import Hedgehog
 import qualified Hedgehog.Gen as Gen
@@ -86,6 +87,7 @@ spec = describe "AFRP" $ do
   delayEventSpec
   debounceSpec
   rollupSpec
+  serializeSpec
   effSpec
   mapAccumRequestSpec
   preMapAccumRequestSpec
@@ -404,6 +406,20 @@ eventGen = Gen.frequency
   , (1, pure Tick)
   ]
 
+timeGen :: Gen SerializeUTCTime
+timeGen = do
+  day <- ModifiedJulianDay . fromIntegral <$> Gen.int (Range.linear 0 100000)
+  pico <- picosecondsToDiffTime . fromIntegral
+    <$> Gen.int (Range.linear 0 (86400 * 10 ^ (12 :: Int) - 1))
+  pure $ SerializeUTCTime (UTCTime day pico)
+
+serializeSpec :: Spec
+serializeSpec = describe "SerializeUTCTime" $ do
+  it "get (put x) == pure x" $
+    hedgehog $ do
+      x <- forAll timeGen
+      tripping x (runPut . put) (runGet get)
+
 effSpec :: Spec
 effSpec = describe "eff" $ do
   it "lifts a pure effect function into a stateless Mealy" $