next-ref-0.1.0.0: test/Spec.hs

{-# LANGUAGE LambdaCase #-}
import Test.Hspec
import Control.Concurrent.NextRef
import GHC.Conc
import Control.Monad (void, replicateM_)

while :: IO Bool -> IO () -> IO ()
while test act = test >>= \case 
  True  -> act >> while test act
  False -> return ()
  

main :: IO ()
main = hspec $ describe "NextRef" $ do 
  it "newNextRef/takeNext/takeNext blocks" $ do
    ref <- newNextRef ()
    takeNextRef ref
    threadId <- forkIO $ void $ takeNextRef ref
    
    while ((== ThreadRunning) `fmap` threadStatus threadId) $ threadDelay 100000
    
    stat <- threadStatus threadId 
    stat `shouldBe` ThreadBlocked BlockedOnSTM
    
  it "writing never blocks" $ do
    ref <- newNextRef 1
    replicateM_ 10 $ writeNextRef ref 2
    True `shouldBe` True 
  
  it "readLast does not block" $ do
    ref <- newNextRef ()
    takeNextRef ref
    readLast ref
    
    True `shouldBe` True 
    
  it "takeNext/write/takeNext doesn't block, updates correctly" $ do
    ref <- newNextRef (1 :: Int)
    actual <- takeNextRef ref
    actual `shouldBe` Just 1
    
    writeNextRef ref 2
    
    actual1 <- takeNextRef ref
    actual1 `shouldBe` Just 2
    
  it "takeNext/modify/takeNext doesn't block, updates correctly" $ do
    ref <- newNextRef (1 :: Int)
    actual <- takeNextRef ref
    actual `shouldBe` Just 1
    
    modifyNextRef ref (\x -> (x+1, ()))
    
    actual1 <- takeNextRef ref
    actual1 `shouldBe` Just 2
    
  it "close/takeNext give nothing" $ do
    ref <- newNextRef ()
    close ref
    actual <- takeNextRef ref
    actual `shouldBe` Nothing
    
  it "close/open/takeNext gives value" $ do
    ref <- newNextRef ()
    close ref
    open  ref
    actual <- takeNextRef ref
    actual `shouldBe` Just ()