module Genesis.Test.Hspec
( module Test.Hspec
, hspec
, expectationFailure
, shouldBe
, shouldSatisfy
, shouldStartWith
, shouldEndWith
, shouldContain
, shouldMatchList
, shouldReturn
, shouldNotBe
, shouldNotSatisfy
, shouldNotContain
, shouldNotReturn
, shouldThrow
) where
import qualified Test.Hspec as Hspec
import Control.Exception.Lifted (Exception, try)
import Control.Monad (unless)
import Control.Monad.Base (MonadBase, liftBase)
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.Proxy (Proxy(..))
import Data.Typeable (typeRep)
import GHC.Stack (HasCallStack)
import Test.Hspec hiding
( hspec
, expectationFailure
, shouldBe
, shouldSatisfy
, shouldStartWith
, shouldEndWith
, shouldContain
, shouldMatchList
, shouldReturn
, shouldNotBe
, shouldNotSatisfy
, shouldNotContain
, shouldNotReturn
, shouldThrow
)
hspec :: MonadBase IO m => Spec -> m ()
hspec x = liftBase $ Hspec.hspec x
expectationFailure :: (HasCallStack, MonadBase IO m) => String -> m ()
expectationFailure x = liftBase $ Hspec.expectationFailure x
expectTrue :: (HasCallStack, MonadBase IO m) => String -> Bool -> m ()
expectTrue msg b = unless b (expectationFailure msg)
shouldBe :: (HasCallStack, Show a, Eq a, MonadBase IO m) => a -> a -> m ()
shouldBe x y = liftBase $ Hspec.shouldBe x y
shouldSatisfy :: (HasCallStack, Show a, MonadBase IO m) => a -> (a -> Bool) -> m ()
shouldSatisfy x y = liftBase $ Hspec.shouldSatisfy x y
shouldStartWith :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()
shouldStartWith x y = liftBase $ Hspec.shouldStartWith x y
shouldEndWith :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()
shouldEndWith x y = liftBase $ Hspec.shouldEndWith x y
shouldContain :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()
shouldContain x y = liftBase $ Hspec.shouldContain x y
shouldMatchList :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()
shouldMatchList x y = liftBase $ Hspec.shouldMatchList x y
shouldNotBe :: (HasCallStack, Show a, Eq a, MonadBase IO m) => a -> a -> m ()
shouldNotBe x y = liftBase $ Hspec.shouldNotBe x y
shouldNotSatisfy :: (HasCallStack, Show a, MonadBase IO m) => a -> (a -> Bool) -> m ()
shouldNotSatisfy x y = liftBase $ Hspec.shouldNotSatisfy x y
shouldNotContain :: (HasCallStack, Show a, Eq a, MonadBase IO m) => [a] -> [a] -> m ()
shouldNotContain x y = liftBase $ Hspec.shouldNotContain x y
shouldReturn :: (HasCallStack, Show a, Eq a, MonadBase IO m) => m a -> a -> m ()
shouldReturn action x = action >>= (`shouldBe` x)
shouldNotReturn :: (HasCallStack, Show a, Eq a, MonadBase IO m) => m a -> a -> m ()
shouldNotReturn action x = action >>= (`shouldNotBe` x)
shouldThrow :: forall e a m. (HasCallStack, Exception e, MonadBaseControl IO m) => m a -> Selector e -> m ()
shouldThrow action p = try action >>= \case
Right _ -> expectationFailure $
"did not get expected exception: " ++ exceptionType
Left e -> flip expectTrue (p e) $
"predicate failed on expected exception: " ++ exceptionType ++ " (" ++ show e ++ ")"
where exceptionType = show $ typeRep (Proxy @e)