{-# OPTIONS_HADDOCK show-extensions #-}

module Test.Fluent.Assertions.Core
  ( -- ** Assertion util functions
    assertThat,
    assertThatIO,
    assertThat',
    assertThatIO',
    assertThrown,
    assertThrown',
    assertThrows',
    assertThrows,
  )
where

import Control.Exception (Exception (fromException), throwIO, try)
import Data.Data (typeOf)
import GHC.Stack (HasCallStack, callStack, getCallStack)
import Test.Fluent.Assertions (FluentTestFailure (..), simpleAssertion)
import Test.Fluent.Assertions.Exceptions (ExceptionSelector)
import Test.Fluent.Internal.AssertionConfig
  ( AssertionConfig,
    defaultConfig,
  )
import Test.Fluent.Internal.Assertions
  ( Assertion',
    assertThat,
    assertThat',
    assertThatIO,
    assertThatIO',
    assertThatIO'',
  )

-- |
-- Module      : Test.Fluent.Assertions.Core
-- Description : Set util function to execute assertions against given value
-- Copyright   : (c) Pawel Nosal, 2021
-- License     : MIT
-- Maintainer  : p.nosal1986@gmail.com
-- Stability   : experimental

-- | Verify if given `IO` action throws expected exception.
assertThrows :: (HasCallStack, Exception e) => IO a -> ExceptionSelector e -> IO ()
assertThrows :: IO a -> ExceptionSelector e -> IO ()
assertThrows IO a
givenIO ExceptionSelector e
selector = AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e e -> IO ()
forall e a b.
(HasCallStack, Exception e) =>
AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown' AssertionConfig
defaultConfig 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"))

assertThrows' :: (HasCallStack, Exception e) => AssertionConfig -> IO a -> ExceptionSelector e -> IO ()
assertThrows' :: AssertionConfig -> IO a -> ExceptionSelector e -> IO ()
assertThrows' AssertionConfig
config IO a
givenIO ExceptionSelector e
selector = AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e e -> IO ()
forall e a b.
(HasCallStack, Exception e) =>
AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown' AssertionConfig
config 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"))

-- | Execute assertions against selected exception
assertThrown :: (HasCallStack, Exception e) => IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown :: IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown = AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
forall e a b.
(HasCallStack, Exception e) =>
AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown' AssertionConfig
defaultConfig

assertThrown' :: (HasCallStack, Exception e) => AssertionConfig -> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown' :: AssertionConfig
-> IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
assertThrown' AssertionConfig
config IO a
givenIO ExceptionSelector e
predicate = AssertionConfig
-> IO a -> (IO a -> IO e) -> Assertion' e b -> IO ()
forall a b c.
HasCallStack =>
AssertionConfig
-> IO a -> (IO a -> IO b) -> Assertion' b c -> IO ()
assertThatIO'' AssertionConfig
config 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