enclosed-exceptions-1.0.0: test/main.hs

{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
import Test.Hspec
import Test.QuickCheck.Arbitrary ()
import Control.Exception.Lifted hiding (throwTo)
import Data.IORef
import Data.Typeable
import Control.Monad.IO.Class
import Control.Concurrent (throwTo, threadDelay, forkIO)
import Control.Exception.Enclosed

{-# ANN main ("HLint: ignore Redundant do"::String) #-}
main :: IO ()
main = hspec $ do
    describe "any exceptions" $ do
        it "catchAny" $ do
            failed <- newIORef 0
            tid <- forkIO $ do
                catchAny
                    (threadDelay 20000)
                    (const $ writeIORef failed 1)
                writeIORef failed 2
            threadDelay 10000
            throwTo tid DummyException
            threadDelay 50000
            didFail <- readIORef failed
            liftIO $ didFail `shouldBe` (0 :: Int)
        it "tryAny" $ do
            failed <- newIORef False
            tid <- forkIO $ do
                _ <- tryAny $ threadDelay 20000
                writeIORef failed True
            threadDelay 10000
            throwTo tid DummyException
            threadDelay 50000
            didFail <- readIORef failed
            liftIO $ didFail `shouldBe` False
        it "tryAnyDeep" $ do
            eres <- tryAnyDeep $ return $ throw DummyException
            case eres of
                Left e
                    | Just DummyException <- fromException e -> return ()
                    | otherwise -> error "Expected a DummyException"
                Right () -> error "Expected an exception" :: IO ()

data DummyException = DummyException
    deriving (Show, Typeable)
instance Exception DummyException