diff --git a/test/Qd/Observable/ObservablePrioritySpec.hs b/test/Qd/Observable/ObservablePrioritySpec.hs new file mode 100644 index 0000000000000000000000000000000000000000..52ecf637ff08476cb2a0b249f3adcd4629e64428 --- /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 cd4753fc9c10722ad5c3ec4fd34de99972243b6c..a824f8c30c8d0402a34ed34ad58153e59f95b76f 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 #-}