{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_HADDOCK show-extensions #-}

-- |
-- Module      : Test.Fluent.Assertions.Exceptions
-- Description : Set of assertions for Exception type
-- Copyright   : (c) Pawel Nosal, 2021
-- License     : MIT
-- Maintainer  : p.nosal1986@gmail.com
-- Stability   : experimental
--
-- This mudule provide an assertion for check if expected Exception has been throw by IO action.
module Test.Fluent.Assertions.Exceptions
  ( -- ** Assertion util functions
    assertThrowing,
    assertThrowing',

    -- ** Exception selectors
    anyException,
    anyIOException,
    exceptionOfType,

    -- ** Exception selector type
    ExceptionSelector,
  )
where

import Control.Exception
  ( Exception (fromException),
    IOException,
    SomeException,
    throwIO,
    try,
  )
import Data.Data (typeOf)
import GHC.Exception
  ( getCallStack,
  )
import GHC.Stack (HasCallStack, callStack)
import Test.Fluent.Assertions (simpleAssertion)
import Test.Fluent.Internal.Assertions
  ( Assertion',
    FluentTestFailure (FluentTestFailure),
    assertThat',
  )

type ExceptionSelector a = a -> a

-- | Select all exceptions.
anyException :: ExceptionSelector SomeException
anyException :: ExceptionSelector SomeException
anyException = ExceptionSelector SomeException
forall a. a -> a
id

-- | Select all IOException.
anyIOException :: ExceptionSelector IOException
anyIOException :: ExceptionSelector IOException
anyIOException = ExceptionSelector IOException
forall a. a -> a
id

-- | Select all an Exception of given type.
-- This selector should be used with `TypeApplications`
--
-- @
-- data MyException = ThisException | ThatException
--  deriving (Show)
--
-- instance Exception MyException
--
-- selectMyException = exceptionType @MyException
-- @
exceptionOfType :: Exception e => ExceptionSelector e
exceptionOfType :: ExceptionSelector e
exceptionOfType = ExceptionSelector e
forall a. a -> a
id

assertThrowing' :: (HasCallStack, Exception e) => IO a -> ExceptionSelector e -> IO ()
assertThrowing' :: IO a -> ExceptionSelector e -> IO ()
assertThrowing' IO a
givenIO ExceptionSelector e
selector = IO a -> ExceptionSelector e -> Assertion' e e -> IO ()
forall e a b.
(HasCallStack, Exception e) =>
IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrowing IO a
givenIO ExceptionSelector e
selector ((e -> Bool) -> (e -> String) -> Assertion' e e
forall a.
HasCallStack =>
(a -> Bool) -> (a -> String) -> Assertion a
simpleAssertion (Bool -> e -> Bool
forall a b. a -> b -> a
const Bool
True) (String -> e -> String
forall a b. a -> b -> a
const String
"should not be invoked"))

assertThrowing :: (HasCallStack, Exception e) => IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrowing :: IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrowing IO a
givenIO ExceptionSelector e
predicate = IO a -> (IO a -> IO e) -> Assertion' e b -> IO ()
forall a b c.
HasCallStack =>
IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()
assertThat' IO a
givenIO ((IO a -> IO e) -> Assertion' e b -> IO ())
-> (IO a -> IO e) -> Assertion' e b -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO a
io -> do
  Either SomeException a
res <- IO a -> IO (Either SomeException a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
io
  case Either SomeException a
res of
    Left SomeException
e -> do
      let thrownException :: String
thrownException = SomeException -> String
forall a. Show a => a -> String
show SomeException
e
      case SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
        Just e
expectedException -> e -> IO e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
expectedException
        Maybe e
Nothing -> FluentTestFailure -> IO e
forall e a. Exception e => e -> IO a
throwIO (Maybe SrcLoc
-> [(String, Maybe SrcLoc)] -> Int -> Int -> FluentTestFailure
FluentTestFailure Maybe SrcLoc
location [(String
"should throw an exception of type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
expectedExceptionName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" , but " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
thrownException String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" has been thrown", Maybe SrcLoc
location)] Int
1 Int
0)
    Either SomeException a
_ -> FluentTestFailure -> IO e
forall e a. Exception e => e -> IO a
throwIO (Maybe SrcLoc
-> [(String, Maybe SrcLoc)] -> Int -> Int -> FluentTestFailure
FluentTestFailure Maybe SrcLoc
location [(String
"should throw an exception of type " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
expectedExceptionName String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", but it doesn't", Maybe SrcLoc
location)] Int
1 Int
0)
  where
    expectedExceptionName :: String
expectedExceptionName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (ExceptionSelector e -> e
forall a. (a -> a) -> a
exceptionName ExceptionSelector e
predicate)
    exceptionName :: (a -> a) -> a
    exceptionName :: (a -> a) -> a
exceptionName a -> a
_ = String -> a
forall a. HasCallStack => String -> a
error String
"instance of Typeable is broken"
    location :: Maybe SrcLoc
location = case [(String, SrcLoc)] -> [(String, SrcLoc)]
forall a. [a] -> [a]
reverse (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack) of
      (String
_, SrcLoc
loc) : [(String, SrcLoc)]
_ -> SrcLoc -> Maybe SrcLoc
forall a. a -> Maybe a
Just SrcLoc
loc
      [] -> Maybe SrcLoc
forall a. Maybe a
Nothing