UnliftIOSpec.hs

{-# language ScopedTypeVariables, RecordWildCards, StrictData, RankNTypes #-}

module Control.Exception.Annotated.UnliftIOSpec where

import Test.Hspec

import Control.Exception.Annotated.UnliftIO
import qualified Control.Exception.Safe as Safe
import Data.Annotation
import GHC.Stack

import Data.AnnotationSpec ()
import Control.Exception.AnnotatedSpec
    ( TestException(..)
    , callStackFunctionNamesShouldBe
    )
import Data.Maybe

asIO :: IO a -> IO a
asIO = id

spec :: Spec
spec = do
    describe "catch" $ do
        describe "the right exception" $ do
            it "works" $ asIO $ do
                throw TestException
                    `catch` \(AnnotatedException _ TestException) ->
                        pure ()

        describe "the wrong exception" $ do
            it "works" $ asIO $ do
                let
                    action =
                        throw (userError "oh no")
                            `catch` \(AnnotatedException _ TestException) ->
                                expectationFailure "Should not catch"
                action `shouldThrow` \(AnnotatedException _ e) ->
                    e == userError "oh no"
        it "includes a callstack location" $ do
            let
                action =
                    throw TestException
                        `catch`
                            \TestException ->
                                throw TestException
            action
                `Safe.catch`
                        \(e :: AnnotatedException TestException) -> do
                            annotations e
                                `callStackFunctionNamesShouldBe`
                                    [ "throw"
                                    , "throw"
                                    , "catch"
                                    ]
    describe "catches" $ do
        it "has a callstack entry" $ do
            let
                action =
                    throw TestException
                        `catches`
                            [ Handler $ \TestException ->
                                throw TestException
                            ]
            action
                `Safe.catch`
                        \(e :: AnnotatedException TestException) -> do
                            annotations e
                                `callStackFunctionNamesShouldBe`
                                    [ "throw"
                                    , "throw"
                                    , "catches"
                                    ]


        describe "the right exception" $ do
            it "works" $ asIO $ do
                throw TestException
                    `catches`
                        [ Handler $ \TestException ->
                            pure ()
                        ]