{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ImplicitParams #-}
module Test.Hspec.Expectations (
Expectation
, expectationFailure
, shouldBe
, shouldSatisfy
, shouldStartWith
, shouldEndWith
, shouldContain
, shouldMatchList
, shouldReturn
, shouldNotBe
, shouldNotSatisfy
, shouldNotContain
, shouldNotReturn
, shouldThrow
, Selector
, anyException
, anyErrorCall
, anyIOException
, anyArithException
, errorCall
, HasCallStack
) where
import qualified Test.HUnit
import Test.HUnit ((@?=))
import Control.Exception
import Data.Typeable
import Data.List
import Control.Monad (unless)
import Test.Hspec.Expectations.Matcher
#if MIN_VERSION_HUnit(1,4,0)
import Data.CallStack (HasCallStack)
#else
#if MIN_VERSION_base(4,8,1)
import qualified GHC.Stack as GHC
type HasCallStack = (?loc :: GHC.CallStack)
#else
import GHC.Exts (Constraint)
type HasCallStack = (() :: Constraint)
#endif
#endif
type Expectation = Test.HUnit.Assertion
expectationFailure :: HasCallStack => String -> Expectation
expectationFailure :: String -> Expectation
expectationFailure = String -> Expectation
forall a. HasCallStack => String -> IO a
Test.HUnit.assertFailure
expectTrue :: HasCallStack => String -> Bool -> Expectation
expectTrue :: String -> Bool -> Expectation
expectTrue msg :: String
msg b :: Bool
b = Bool -> Expectation -> Expectation
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (HasCallStack => String -> Expectation
String -> Expectation
expectationFailure String
msg)
infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow`
infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn`
shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
actual :: a
actual shouldBe :: a -> a -> Expectation
`shouldBe` expected :: a
expected = a
actual a -> a -> Expectation
forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?= a
expected
shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
v :: a
v shouldSatisfy :: a -> (a -> Bool) -> Expectation
`shouldSatisfy` p :: a -> Bool
p = HasCallStack => String -> Bool -> Expectation
String -> Bool -> Expectation
expectTrue ("predicate failed on: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v) (a -> Bool
p a
v)
compareWith :: (HasCallStack, Show a) => (a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith :: (a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith comparator :: a -> a -> Bool
comparator errorDesc :: String
errorDesc result :: a
result expected :: a
expected = HasCallStack => String -> Bool -> Expectation
String -> Bool -> Expectation
expectTrue String
errorMsg (a -> a -> Bool
comparator a
expected a
result)
where
errorMsg :: String
errorMsg = a -> String
forall a. Show a => a -> String
show a
result String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
errorDesc String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
expected
shouldStartWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldStartWith :: [a] -> [a] -> Expectation
shouldStartWith = ([a] -> [a] -> Bool) -> String -> [a] -> [a] -> Expectation
forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf "does not start with"
shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldEndWith :: [a] -> [a] -> Expectation
shouldEndWith = ([a] -> [a] -> Bool) -> String -> [a] -> [a] -> Expectation
forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf "does not end with"
shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldContain :: [a] -> [a] -> Expectation
shouldContain = ([a] -> [a] -> Bool) -> String -> [a] -> [a] -> Expectation
forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf "does not contain"
shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
xs :: [a]
xs shouldMatchList :: [a] -> [a] -> Expectation
`shouldMatchList` ys :: [a]
ys = Expectation
-> (String -> Expectation) -> Maybe String -> Expectation
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return ()) HasCallStack => String -> Expectation
String -> Expectation
expectationFailure ([a] -> [a] -> Maybe String
forall a. (Show a, Eq a) => [a] -> [a] -> Maybe String
matchList [a]
xs [a]
ys)
shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
action :: IO a
action shouldReturn :: IO a -> a -> Expectation
`shouldReturn` expected :: a
expected = IO a
action IO a -> (a -> Expectation) -> Expectation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected)
shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
actual :: a
actual shouldNotBe :: a -> a -> Expectation
`shouldNotBe` notExpected :: a
notExpected = HasCallStack => String -> Bool -> Expectation
String -> Bool -> Expectation
expectTrue ("not expected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
actual) (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
notExpected)
shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
v :: a
v shouldNotSatisfy :: a -> (a -> Bool) -> Expectation
`shouldNotSatisfy` p :: a -> Bool
p = HasCallStack => String -> Bool -> Expectation
String -> Bool -> Expectation
expectTrue ("predicate succeeded on: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
v) ((Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) a
v)
shouldNotContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
list :: [a]
list shouldNotContain :: [a] -> [a] -> Expectation
`shouldNotContain` sublist :: [a]
sublist = HasCallStack => String -> Bool -> Expectation
String -> Bool -> Expectation
expectTrue String
errorMsg ((Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
sublist) [a]
list)
where
errorMsg :: String
errorMsg = [a] -> String
forall a. Show a => a -> String
show [a]
list String -> String -> String
forall a. [a] -> [a] -> [a]
++ " does contain " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
sublist
shouldNotReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
action :: IO a
action shouldNotReturn :: IO a -> a -> Expectation
`shouldNotReturn` notExpected :: a
notExpected = IO a
action IO a -> (a -> Expectation) -> Expectation
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> a -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldNotBe` a
notExpected)
type Selector a = (a -> Bool)
shouldThrow :: (HasCallStack, Exception e) => IO a -> Selector e -> Expectation
action :: IO a
action shouldThrow :: IO a -> Selector e -> Expectation
`shouldThrow` p :: Selector e
p = do
Either e a
r <- IO a -> IO (Either e a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
case Either e a
r of
Right _ ->
HasCallStack => String -> Expectation
String -> Expectation
expectationFailure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
"did not get expected exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exceptionType
Left e :: e
e ->
(HasCallStack => String -> Bool -> Expectation
String -> Bool -> Expectation
`expectTrue` Selector e
p e
e) (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$
"predicate failed on expected exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exceptionType String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
e String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")"
where
exceptionType :: String
exceptionType = (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String)
-> (Selector e -> TypeRep) -> Selector e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf (e -> TypeRep) -> (Selector e -> e) -> Selector e -> TypeRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Selector e -> e
forall a. Selector a -> a
instanceOf) Selector e
p
where
instanceOf :: Selector a -> a
instanceOf :: Selector a -> a
instanceOf _ = String -> a
forall a. HasCallStack => String -> a
error "Test.Hspec.Expectations.shouldThrow: broken Typeable instance"
anyException :: Selector SomeException
anyException :: Selector SomeException
anyException = Bool -> Selector SomeException
forall a b. a -> b -> a
const Bool
True
anyErrorCall :: Selector ErrorCall
anyErrorCall :: Selector ErrorCall
anyErrorCall = Bool -> Selector ErrorCall
forall a b. a -> b -> a
const Bool
True
errorCall :: String -> Selector ErrorCall
#if MIN_VERSION_base(4,9,0)
errorCall :: String -> Selector ErrorCall
errorCall s :: String
s (ErrorCallWithLocation msg :: String
msg _) = String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
msg
#else
errorCall s (ErrorCall msg) = s == msg
#endif
anyIOException :: Selector IOException
anyIOException :: Selector IOException
anyIOException = Bool -> Selector IOException
forall a b. a -> b -> a
const Bool
True
anyArithException :: Selector ArithException
anyArithException :: Selector ArithException
anyArithException = Bool -> Selector ArithException
forall a b. a -> b -> a
const Bool
True