{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ImplicitParams #-}
-- |
-- Introductory documentation: <https://github.com/hspec/hspec-expectations#readme>
module Test.Hspec.Expectations (

-- * Setting expectations
  Expectation
, expectationFailure
, shouldBe
, shouldSatisfy
, shouldStartWith
, shouldEndWith
, shouldContain
, shouldMatchList
, shouldReturn

, shouldNotBe
, shouldNotSatisfy
, shouldNotContain
, shouldNotReturn

-- * Expecting exceptions
, shouldThrow

-- ** Selecting exceptions
, Selector

-- ** Predefined type-based selectors
-- |
-- There are predefined selectors for some standard exceptions.  Each selector
-- is just @const True@ with an appropriate type.
, anyException
, anyErrorCall
, anyIOException
, anyArithException

-- ** Combinators for defining value-based selectors
-- |
-- Some exceptions (most prominently `ErrorCall`) have no `Eq` instance.
-- Selecting a specific value would require pattern matching.
--
-- For such exceptions, combinators that construct selectors are provided.
-- Each combinator corresponds to a constructor; it takes the same arguments,
-- and has the same name (but starting with a lower-case letter).
, errorCall

-- * Re-exports
, 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 :: HasCallStack => String -> Expectation
expectationFailure = forall a. HasCallStack => String -> IO a
Test.HUnit.assertFailure

expectTrue :: HasCallStack => String -> Bool -> Expectation
expectTrue :: HasCallStack => String -> Bool -> Expectation
expectTrue String
msg Bool
b = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (HasCallStack => String -> Expectation
expectationFailure String
msg)

infix 1 `shouldBe`, `shouldSatisfy`, `shouldStartWith`, `shouldEndWith`, `shouldContain`, `shouldMatchList`, `shouldReturn`, `shouldThrow`
infix 1 `shouldNotBe`, `shouldNotSatisfy`, `shouldNotContain`, `shouldNotReturn`

-- |
-- @actual \`shouldBe\` expected@ sets the expectation that @actual@ is equal
-- to @expected@.
shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
a
actual shouldBe :: forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected = a
actual forall a. (HasCallStack, Eq a, Show a) => a -> a -> Expectation
@?= a
expected

-- |
-- @v \`shouldSatisfy\` p@ sets the expectation that @p v@ is @True@.
shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
a
v shouldSatisfy :: forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` a -> Bool
p = HasCallStack => String -> Bool -> Expectation
expectTrue (String
"predicate failed on: " forall a. [a] -> [a] -> [a]
++ 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 :: forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith a -> a -> Bool
comparator String
errorDesc a
result a
expected = HasCallStack => String -> Bool -> Expectation
expectTrue String
errorMsg (a -> a -> Bool
comparator a
expected a
result)
  where
    errorMsg :: String
errorMsg = forall a. Show a => a -> String
show a
result forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
errorDesc forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
expected

-- |
-- @list \`shouldStartWith\` prefix@ sets the expectation that @list@ starts with @prefix@,
shouldStartWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldStartWith :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldStartWith = forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"does not start with"

-- |
-- @list \`shouldEndWith\` suffix@ sets the expectation that @list@ ends with @suffix@,
shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldEndWith :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldEndWith = forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
"does not end with"

-- |
-- @list \`shouldContain\` sublist@ sets the expectation that @sublist@ is contained,
-- wholly and intact, anywhere in @list@.
shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldContain :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldContain = forall a.
(HasCallStack, Show a) =>
(a -> a -> Bool) -> String -> a -> a -> Expectation
compareWith forall a. Eq a => [a] -> [a] -> Bool
isInfixOf String
"does not contain"

-- |
-- @xs \`shouldMatchList\` ys@ sets the expectation that @xs@ has the same
-- elements that @ys@ has, possibly in another order
shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
[a]
xs shouldMatchList :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
`shouldMatchList` [a]
ys = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return ()) HasCallStack => String -> Expectation
expectationFailure (forall a. (Show a, Eq a) => [a] -> [a] -> Maybe String
matchList [a]
xs [a]
ys)

-- |
-- @action \`shouldReturn\` expected@ sets the expectation that @action@
-- returns @expected@.
shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
IO a
action shouldReturn :: forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldReturn` a
expected = IO a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` a
expected)

-- |
-- @actual \`shouldNotBe\` notExpected@ sets the expectation that @actual@ is not
-- equal to @notExpected@
shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> Expectation
a
actual shouldNotBe :: forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldNotBe` a
notExpected = HasCallStack => String -> Bool -> Expectation
expectTrue (String
"not expected: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
actual) (a
actual forall a. Eq a => a -> a -> Bool
/= a
notExpected)

-- |
-- @v \`shouldNotSatisfy\` p@ sets the expectation that @p v@ is @False@.
shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
a
v shouldNotSatisfy :: forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldNotSatisfy` a -> Bool
p = HasCallStack => String -> Bool -> Expectation
expectTrue (String
"predicate succeeded on: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
v) ((Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p) a
v)

-- |
-- @list \`shouldNotContain\` sublist@ sets the expectation that @sublist@ is not
-- contained anywhere in @list@.
shouldNotContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
[a]
list shouldNotContain :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
`shouldNotContain` [a]
sublist = HasCallStack => String -> Bool -> Expectation
expectTrue String
errorMsg ((Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
sublist) [a]
list)
  where
    errorMsg :: String
errorMsg = forall a. Show a => a -> String
show [a]
list forall a. [a] -> [a] -> [a]
++ String
" does contain " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [a]
sublist

-- |
-- @action \`shouldNotReturn\` notExpected@ sets the expectation that @action@
-- does not return @notExpected@.
shouldNotReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
IO a
action shouldNotReturn :: forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> Expectation
`shouldNotReturn` a
notExpected = IO a
action forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldNotBe` a
notExpected)

-- |
-- A @Selector@ is a predicate; it can simultaneously constrain the type and
-- value of an exception.
type Selector a = (a -> Bool)

-- |
-- @action \`shouldThrow\` selector@ sets the expectation that @action@ throws
-- an exception.  The precise nature of the expected exception is described
-- with a 'Selector'.
shouldThrow :: (HasCallStack, Exception e) => IO a -> Selector e -> Expectation
IO a
action shouldThrow :: forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> Expectation
`shouldThrow` Selector e
p = do
  Either e a
r <- forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
  case Either e a
r of
    Right a
_ ->
      HasCallStack => String -> Expectation
expectationFailure forall a b. (a -> b) -> a -> b
$
        String
"did not get expected exception: " forall a. [a] -> [a] -> [a]
++ String
exceptionType
    Left e
e ->
      (HasCallStack => String -> Bool -> Expectation
`expectTrue` Selector e
p e
e) forall a b. (a -> b) -> a -> b
$
        String
"predicate failed on expected exception: " forall a. [a] -> [a] -> [a]
++ String
exceptionType forall a. [a] -> [a] -> [a]
++ String
"\n" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show e
e
  where
    -- a string representation of the expected exception's type
    exceptionType :: String
exceptionType = (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Selector a -> a
instanceOf) Selector e
p
      where
        instanceOf :: Selector a -> a
        instanceOf :: forall a. Selector a -> a
instanceOf Selector a
_ = forall a. HasCallStack => String -> a
error String
"Test.Hspec.Expectations.shouldThrow: broken Typeable instance"

anyException :: Selector SomeException
anyException :: Selector SomeException
anyException = forall a b. a -> b -> a
const Bool
True

anyErrorCall :: Selector ErrorCall
anyErrorCall :: Selector ErrorCall
anyErrorCall = 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 String
s (ErrorCallWithLocation String
msg String
_) = String
s forall a. Eq a => a -> a -> Bool
== String
msg
#else
errorCall s (ErrorCall msg) = s == msg
#endif

anyIOException :: Selector IOException
anyIOException :: Selector IOException
anyIOException = forall a b. a -> b -> a
const Bool
True

anyArithException :: Selector ArithException
anyArithException :: Selector ArithException
anyArithException = forall a b. a -> b -> a
const Bool
True