content: {-# LANGUAGE CPP #-}
  
  module UnliftIO.ExceptionSpec (spec) where
  
  import qualified Control.Exception
  import Control.Monad (void, (<=<))
  import Data.Bifunctor (first)
  import Test.Hspec
  import UnliftIO
  import UnliftIO.Concurrent (threadDelay)
  
  #if MIN_VERSION_async(2,2,0)
  cancelled :: AsyncCancelled
  cancelled = AsyncCancelled
  #else
  cancelled :: Control.Exception.AsyncException
  cancelled = Control.Exception.ThreadKilled
  #endif
  
  spec :: Spec
  spec = do
    let -- The callback will run in a thread that gets cancelled immediately,
        -- then get Exception2 thrown synchronously after 1 second.
        withAsyncExceptionThrown :: (IO a -> IO b) -> IO b
        withAsyncExceptionThrown f = do
          var <- newEmptyMVar
          a <- async $ f $ do
            putMVar var ()
            threadDelay 1000000
            throwIO Exception2
          -- wait until thread is running, then cancel
          takeMVar var
          cancel a
          -- check result
          wait a
        -- The callback will run in a thread that gets Exception1 thrown as
        -- an async exception immediately, then get Exception2 thrown
        -- synchronously after 1 second.
        withWrappedAsyncExceptionThrown :: (IO a -> IO b) -> IO b
        withWrappedAsyncExceptionThrown f = do
          var <- newEmptyMVar
          a <- async $ f $ do
            putMVar var ()
            threadDelay 1000000
            throwIO Exception2
          -- wait until thread is running, then cancel
          takeMVar var
          throwTo (asyncThreadId a) Exception1
          -- check result
          wait a
    describe "catchSyncOrAsync" $ do
      it "should catch sync exceptions" $ do
        result <- (`catchSyncOrAsync` return) $ throwIO Exception1
        result `shouldBe` Exception1
      it "should catch async exceptions" $ do
        result <- withAsyncExceptionThrown $ \m -> m `catchSyncOrAsync` return
        result `shouldBe` cancelled
      it "should catch unliftio-wrapped async exceptions" $ do
        result <- withWrappedAsyncExceptionThrown $ \m -> m `catchSyncOrAsync` return
        fromExceptionUnwrap result `shouldBe` Just Exception1
    describe "handleSyncOrAsync" $ do
      it "should catch sync exceptions" $ do
        result <- handleSyncOrAsync return $ throwIO Exception1
        result `shouldBe` Exception1
      it "should catch async exceptions" $ do
        result <- withAsyncExceptionThrown $ \m -> handleSyncOrAsync return m
        result `shouldBe` cancelled
      it "should catch unliftio-wrapped async exceptions" $ do
        result <- withWrappedAsyncExceptionThrown $ \m -> handleSyncOrAsync return m
        fromExceptionUnwrap result `shouldBe` Just Exception1
    describe "trySyncOrAsync" $ do
      it "should catch sync exceptions" $ do
        result <- trySyncOrAsync $ void $ throwIO Exception1
        result `shouldBe` Left Exception1
      it "should catch async exceptions" $ do
        result <- withAsyncExceptionThrown $ \m -> trySyncOrAsync (void m)
        result `shouldBe` Left cancelled
      it "should catch unliftio-wrapped async exceptions" $ do
        result <- withWrappedAsyncExceptionThrown $ \m -> trySyncOrAsync (void m)
        first fromExceptionUnwrap result `shouldBe` Left (Just Exception1)
  
    describe "fromExceptionUnwrap" $ do
      it "should be the inverse of toAsyncException" $ do
        fromExceptionUnwrap (toAsyncException Exception1) `shouldBe` Just Exception1
      it "should be the inverse of toSyncException" $ do
        let toAsyncToSync = toSyncException . toAsyncException
            fromSyncFromAsyc = fromExceptionUnwrap <=< fromExceptionUnwrap
        fromSyncFromAsyc (toAsyncToSync Exception1) `shouldBe` Just Exception1
  
    let shouldLeft x = either (const Nothing) Just x `shouldBe` Nothing
        shouldRight x = either (Just . show) (const Nothing) x `shouldBe` Nothing
    describe "pureTry" $ do
      it "Right for defined values" $ shouldRight $ pureTry ()
      it "Left for bottom" $ shouldLeft $ pureTry (undefined :: ())
      it "Right for wrapped bottom" $ shouldRight $ pureTry $ Just (undefined :: ())
    describe "pureTryDeep" $ do
      it "Right for defined values" $ shouldRight $ pureTryDeep ()
      it "Left for bottom" $ shouldLeft $ pureTryDeep (undefined :: ())
      it "Left for wrapped bottom" $ shouldLeft $ pureTryDeep $ Just (undefined :: ())
  
    describe "mapExceptionM" $ do
      it "should convert an exception" $ do
        result <- try $ mapExceptionM (\Exception1 -> Exception2) (throwIO Exception1)
        result `shouldBe` (Left Exception2 :: Either Exception2 ())
      it "should not convert unrelated exceptions" $ do
        result <- try $ mapExceptionM (\Exception1 -> Exception2) (throwIO Exception2)
        result `shouldBe` (Left Exception2 :: Either Exception2 ())
  
  data Exception1 = Exception1 deriving (Show, Eq)
  instance Exception Exception1
  
  data Exception2 = Exception2 deriving (Show, Eq)
  instance Exception Exception2
  