From d34bd2d7b0af183c8621e1dad678c0101a47f4fd Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Thu, 8 Oct 2020 01:57:46 +0200
Subject: [PATCH] Add test for ObservablePriority
---
test/Qd/Observable/ObservablePrioritySpec.hs | 43 ++++++++++++++++++++
test/Spec.hs | 3 +-
2 files changed, 44 insertions(+), 2 deletions(-)
create mode 100644 test/Qd/Observable/ObservablePrioritySpec.hs
diff --git a/test/Qd/Observable/ObservablePrioritySpec.hs b/test/Qd/Observable/ObservablePrioritySpec.hs
new file mode 100644
index 0000000..52ecf63
--- /dev/null
+++ b/test/Qd/Observable/ObservablePrioritySpec.hs
@@ -0,0 +1,43 @@
+module Qd.Observable.ObservablePrioritySpec where
+
+import Qd.Observable
+import Qd.Observable.ObservablePriority (ObservablePriority)
+import qualified Qd.Observable.ObservablePriority as OP
+
+import Control.Monad (void)
+import Data.IORef
+import Test.Hspec
+
+spec :: Spec
+spec = do
+ describe "ObservablePriority" $ parallel $ do
+ it "can be created" $ do
+ void $ OP.create
+ specify "getValue returns the value with the highest priority" $ do
+ (op :: ObservablePriority Int String) <- OP.create
+ p2 <- OP.insertValue op 2 "p2"
+ getValue op `shouldReturn` (Just "p2")
+ p1 <- OP.insertValue op 1 "p1"
+ getValue op `shouldReturn` (Just "p2")
+ deregister p2
+ getValue op `shouldReturn` (Just "p1")
+ deregister p1
+ getValue op `shouldReturn` (Nothing)
+ it "sends updates when its value changes" $ do
+ result <- newIORef []
+ let mostRecentShouldBe = (head <$> readIORef result `shouldReturn`)
+
+ (op :: ObservablePriority Int String) <- OP.create
+ _s <- subscribe op (modifyIORef result . (:))
+ readIORef result `shouldReturn` ([(Current, Nothing)])
+ p2 <- OP.insertValue op 2 "p2"
+
+ mostRecentShouldBe (Update, Just "p2")
+ p1 <- OP.insertValue op 1 "p1"
+ mostRecentShouldBe (Update, Just "p2")
+ deregister p2
+ mostRecentShouldBe (Update, Just "p1")
+ deregister p1
+ mostRecentShouldBe (Update, Nothing)
+
+ length <$> readIORef result `shouldReturn` 4
diff --git a/test/Spec.hs b/test/Spec.hs
index cd4753f..a824f8c 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,2 +1 @@
-main :: IO ()
-main = putStrLn "Test suite not yet implemented"
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
--
GitLab