{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Test.Fluent.Assertions.Core
-- Description : Set util function for HSpec to execute assertions against given value.
-- Copyright   : (c) Pawel Nosal, 2021
-- License     : MIT
-- Maintainer  : p.nosal1986@gmail.com
-- Stability   : experimental
module Test.Fluent.Hspec
  ( -- ** Assertion util functions for HSpec
    assertThat,
    assertThat',
    assertThatIO,
    assertThatIO',
    assertThrown,
    assertThrown',
    assertThrows,
    assertThrows',
  )
where

import Control.Exception (Exception, throwIO, try)
import Data.List (intercalate)
import GHC.Exception (prettySrcLoc)
import GHC.Stack (HasCallStack)
import Test.Fluent.Assertions (Assertion', AssertionConfig, FluentTestFailure)
import qualified Test.Fluent.Assertions.Core as FC
import Test.Fluent.Assertions.Exceptions (ExceptionSelector)
import Test.Fluent.Internal.Assertions (FluentTestFailure (FluentTestFailure))
import Test.HUnit.Lang
  ( FailureReason (Reason),
    HUnitFailure (HUnitFailure),
  )

-- | 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
given ExceptionSelector e
selector = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a -> ExceptionSelector e -> IO ()
forall e a.
(HasCallStack, Exception e) =>
IO a -> ExceptionSelector e -> IO ()
FC.assertThrows IO a
given ExceptionSelector e
selector

assertThrows' :: (HasCallStack, Exception e) => AssertionConfig -> IO a -> ExceptionSelector e -> IO ()
assertThrows' :: AssertionConfig -> IO a -> ExceptionSelector e -> IO ()
assertThrows' AssertionConfig
config IO a
given ExceptionSelector e
selector = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AssertionConfig -> IO a -> ExceptionSelector e -> IO ()
forall e a.
(HasCallStack, Exception e) =>
AssertionConfig -> IO a -> ExceptionSelector e -> IO ()
FC.assertThrows' AssertionConfig
config IO a
given ExceptionSelector e
selector

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
given ExceptionSelector e
selector Assertion' e b
assertions = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ 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 ()
FC.assertThrown' AssertionConfig
config IO a
given ExceptionSelector e
selector Assertion' e b
assertions

-- | 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 IO a
given ExceptionSelector e
selector Assertion' e b
assertions = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
forall e a b.
(HasCallStack, Exception e) =>
IO a -> ExceptionSelector e -> Assertion' e b -> IO ()
FC.assertThrown IO a
given ExceptionSelector e
selector Assertion' e b
assertions

-- | Execute assertions against given subject under test extracted from IO action.
assertThatIO :: HasCallStack => IO a -> Assertion' a b -> IO ()
assertThatIO :: IO a -> Assertion' a b -> IO ()
assertThatIO IO a
given Assertion' a b
assertions = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO a -> Assertion' a b -> IO ()
forall a b. HasCallStack => IO a -> Assertion' a b -> IO ()
FC.assertThatIO IO a
given Assertion' a b
assertions

-- | A variant of `assertThatIO` which allow to pass additional configuration.
assertThatIO' :: HasCallStack => AssertionConfig -> IO a -> Assertion' a b -> IO ()
assertThatIO' :: AssertionConfig -> IO a -> Assertion' a b -> IO ()
assertThatIO' AssertionConfig
config IO a
given Assertion' a b
assertions = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AssertionConfig -> IO a -> Assertion' a b -> IO ()
forall a c.
HasCallStack =>
AssertionConfig -> IO a -> Assertion' a c -> IO ()
FC.assertThatIO' AssertionConfig
config IO a
given Assertion' a b
assertions

-- | A variant of `assertThat` which allow to pass additional configuration.
assertThat' :: HasCallStack => AssertionConfig -> a -> Assertion' a b -> IO ()
assertThat' :: AssertionConfig -> a -> Assertion' a b -> IO ()
assertThat' AssertionConfig
config a
given Assertion' a b
assertions = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ AssertionConfig -> a -> Assertion' a b -> IO ()
forall a b.
HasCallStack =>
AssertionConfig -> a -> Assertion' a b -> IO ()
FC.assertThat' AssertionConfig
config a
given Assertion' a b
assertions

-- | Execute assertions against given subject under test.
assertThat :: HasCallStack => a -> Assertion' a b -> IO ()
assertThat :: a -> Assertion' a b -> IO ()
assertThat a
given Assertion' a b
assertions = HasCallStack => IO () -> IO ()
IO () -> IO ()
toHspecError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> Assertion' a b -> IO ()
forall a b. HasCallStack => a -> Assertion' a b -> IO ()
FC.assertThat a
given Assertion' a b
assertions

toHspecError :: HasCallStack => IO () -> IO ()
toHspecError :: IO () -> IO ()
toHspecError IO ()
a = do
  Either FluentTestFailure ()
res :: Either FluentTestFailure () <- IO () -> IO (Either FluentTestFailure ())
forall e a. Exception e => IO a -> IO (Either e a)
try IO ()
a
  case Either FluentTestFailure ()
res of
    Left (FluentTestFailure Maybe SrcLoc
srcLoc [(String, Maybe SrcLoc)]
msg Int
_ Int
_) -> do
      let assertionMessages :: String
assertionMessages = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" (((String, Maybe SrcLoc) -> String)
-> [(String, Maybe SrcLoc)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Maybe SrcLoc) -> String
formatMsg [(String, Maybe SrcLoc)]
msg)
      HUnitFailure -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HUnitFailure -> IO ()) -> HUnitFailure -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe SrcLoc -> FailureReason -> HUnitFailure
HUnitFailure Maybe SrcLoc
srcLoc (String -> FailureReason
Reason String
assertionMessages)
    Right () -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    formatMsg :: (String, Maybe SrcLoc) -> String
formatMsg (String
message, Just SrcLoc
srcLoc) = SrcLoc -> String
prettySrcLoc SrcLoc
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message
    formatMsg (String
message, Maybe SrcLoc
Nothing) = String
message