{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}

-- | This module defines all the functions you will use to define your tests
module Test.Syd.Expectation where

import Control.Exception
#if MIN_VERSION_mtl(2,3,0)
import Control.Monad (unless, when)
#endif
import Control.Monad.Reader
import Data.ByteString (ByteString)
import Data.List
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable
import GHC.Stack
import Test.QuickCheck.IO ()
import Test.Syd.Run
import Text.Show.Pretty

-- | Assert that two values are equal according to `==`.
shouldBe :: (HasCallStack, Show a, Eq a) => a -> a -> IO ()
shouldBe :: forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
shouldBe a
actual a
expected = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
NotEqualButShouldHaveBeenEqual (a -> String
forall a. Show a => a -> String
ppShow a
actual) (a -> String
forall a. Show a => a -> String
ppShow a
expected)

infix 1 `shouldBe`

-- | Assert that two values are not equal according to `==`.
shouldNotBe :: (HasCallStack, Show a, Eq a) => a -> a -> IO ()
shouldNotBe :: forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
shouldNotBe a
actual a
expected = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
EqualButShouldNotHaveBeenEqual (a -> String
forall a. Show a => a -> String
ppShow a
actual) (a -> String
forall a. Show a => a -> String
ppShow a
expected)

infix 1 `shouldNotBe`

-- | Assert that a value satisfies the given predicate.
shouldSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
shouldSatisfy :: forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
shouldSatisfy a
actual a -> Bool
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
p a
actual) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateFailedButShouldHaveSucceeded (a -> String
forall a. Show a => a -> String
ppShow a
actual) Maybe String
forall a. Maybe a
Nothing

-- | Assert that a value satisfies the given predicate with the given predicate name.
shouldSatisfyNamed :: (HasCallStack, Show a) => a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed :: forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed a
actual String
name a -> Bool
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
p a
actual) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateFailedButShouldHaveSucceeded (a -> String
forall a. Show a => a -> String
ppShow a
actual) (String -> Maybe String
forall a. a -> Maybe a
Just String
name)

infix 1 `shouldSatisfy`

-- | Assert that a value does not satisfy the given predicate.
shouldNotSatisfy :: (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
shouldNotSatisfy :: forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
shouldNotSatisfy a
actual a -> Bool
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
actual) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateSucceededButShouldHaveFailed (a -> String
forall a. Show a => a -> String
ppShow a
actual) Maybe String
forall a. Maybe a
Nothing

infix 1 `shouldNotSatisfy`

-- | Assert that a value does not satisfy the given predicate with the given predicate name.
shouldNotSatisfyNamed :: (HasCallStack, Show a) => a -> String -> (a -> Bool) -> IO ()
shouldNotSatisfyNamed :: forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldNotSatisfyNamed a
actual String
name a -> Bool
p = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
actual) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateSucceededButShouldHaveFailed (a -> String
forall a. Show a => a -> String
ppShow a
actual) (String -> Maybe String
forall a. a -> Maybe a
Just String
name)

-- | Assert that computation returns the given value (according to `==`).
shouldReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
shouldReturn :: forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
shouldReturn IO a
computeActual a
expected = do
  a
actual <- IO a
computeActual
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
NotEqualButShouldHaveBeenEqual (a -> String
forall a. Show a => a -> String
ppShow a
actual) (a -> String
forall a. Show a => a -> String
ppShow a
expected)

infix 1 `shouldReturn`

-- | Assert that computation returns the given value (according to `==`).
shouldNotReturn :: (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
shouldNotReturn :: forall a. (HasCallStack, Show a, Eq a) => IO a -> a -> IO ()
shouldNotReturn IO a
computeActual a
expected = do
  a
actual <- IO a
computeActual
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
EqualButShouldNotHaveBeenEqual (a -> String
forall a. Show a => a -> String
ppShow a
actual) (a -> String
forall a. Show a => a -> String
ppShow a
expected)

infix 1 `shouldNotReturn`

-- | Assert that the given list has the given prefix
shouldStartWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldStartWith :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
shouldStartWith [a]
a [a]
i = [a] -> String -> ([a] -> Bool) -> IO ()
forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"has prefix\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a. Show a => a -> String
ppShow [a]
i) ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf [a]
i)

infix 1 `shouldStartWith`

-- | Assert that the given list has the given suffix
shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldEndWith :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
shouldEndWith [a]
a [a]
s = [a] -> String -> ([a] -> Bool) -> IO ()
forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"has suffix\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a. Show a => a -> String
ppShow [a]
s) ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf [a]
s)

infix 1 `shouldEndWith`

-- | Assert that the given list has the given infix
shouldContain :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldContain :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
shouldContain [a]
a [a]
i = [a] -> String -> ([a] -> Bool) -> IO ()
forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"has infix\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a. Show a => a -> String
ppShow [a]
i) ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [a]
i)

infix 1 `shouldContain`

-- | Assert that the given list contains all elements from the other
-- given list and only them, perhaps in a different order.
shouldMatchList :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldMatchList :: forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> IO ()
shouldMatchList [a]
a [a]
b = [a] -> String -> ([a] -> Bool) -> IO ()
forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"matches list\n" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [a] -> String
forall a. Show a => a -> String
ppShow [a]
b) ([a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
matches [a]
b)
  where
    matches :: [a] -> [a] -> Bool
matches [a]
x [a]
y = [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
x [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
y) Bool -> Bool -> Bool
&& [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
y [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
x)

-- | Assert that two 'String's are equal according to `==`.
--
-- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes.
-- In that case you may want to `show` your values first or use `shouldBe` instead.
stringShouldBe :: (HasCallStack) => String -> String -> IO ()
stringShouldBe :: HasCallStack => String -> String -> IO ()
stringShouldBe String
actual String
expected = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
actual String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
stringsNotEqualButShouldHaveBeenEqual String
actual String
expected

-- | Assert that two 'Text's are equal according to `==`.
--
-- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes.
-- In that case you may want to `show` your values first or use `shouldBe` instead.
textShouldBe :: (HasCallStack) => Text -> Text -> IO ()
textShouldBe :: HasCallStack => Text -> Text -> IO ()
textShouldBe Text
actual Text
expected = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
actual Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expected) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Assertion -> IO ()
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO ()) -> Assertion -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Assertion
textsNotEqualButShouldHaveBeenEqual Text
actual Text
expected

-- | An assertion that says two 'String's should have been equal according to `==`.
--
-- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes.
-- In that case you may want to `show` your values first or use `shouldBe` instead.
stringsNotEqualButShouldHaveBeenEqual :: String -> String -> Assertion
stringsNotEqualButShouldHaveBeenEqual :: String -> String -> Assertion
stringsNotEqualButShouldHaveBeenEqual String
actual String
expected = String -> String -> Assertion
NotEqualButShouldHaveBeenEqual String
actual String
expected

-- | An assertion that says two 'Text's should have been equal according to `==`.
--
-- Note that using function could mess up the colours in your terminal if the Texts contain ANSI codes.
-- In that case you may want to `show` your values first or use `shouldBe` instead.
textsNotEqualButShouldHaveBeenEqual :: Text -> Text -> Assertion
textsNotEqualButShouldHaveBeenEqual :: Text -> Text -> Assertion
textsNotEqualButShouldHaveBeenEqual Text
actual Text
expected = String -> String -> Assertion
NotEqualButShouldHaveBeenEqual (Text -> String
T.unpack Text
actual) (Text -> String
T.unpack Text
expected)

-- | An assertion that says two 'ByteString's should have been equal according to `==`.
bytestringsNotEqualButShouldHaveBeenEqual :: ByteString -> ByteString -> Assertion
bytestringsNotEqualButShouldHaveBeenEqual :: ByteString -> ByteString -> Assertion
bytestringsNotEqualButShouldHaveBeenEqual ByteString
actual ByteString
expected = String -> String -> Assertion
NotEqualButShouldHaveBeenEqual (ByteString -> String
forall a. Show a => a -> String
show ByteString
actual) (ByteString -> String
forall a. Show a => a -> String
show ByteString
expected)

-- | Make a test fail
--
-- Note that this is mostly backward compatible, but it has return type 'a' instead of '()' because execution will not continue beyond this function.
-- In this way it is not entirely backward compatible with hspec because now there could be an ambiguous type error.
expectationFailure :: (HasCallStack) => String -> IO a
expectationFailure :: forall a. HasCallStack => String -> IO a
expectationFailure = Assertion -> IO a
forall e a. Exception e => e -> IO a
throwIO (Assertion -> IO a) -> (String -> Assertion) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Assertion
ExpectationFailed

-- | Annotate a given action with a context, for contextual assertions
--
-- This is a completely different function from the function with the same name in hspec.
-- In hspec, context is a synonym for describe, but in sydtest, context is used for contextual failures.
context :: String -> IO a -> IO a
context :: forall a. String -> IO a -> IO a
context String
s IO a
action =
  (IO a
action IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate)
    IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException e
e) -> Contextual -> IO a
forall e a. Exception e => e -> IO a
throwIO (e -> String -> Contextual
forall e. Exception e => e -> String -> Contextual
addContextToException e
e String
s))

-- | For easy hspec migration
type Expectation = IO ()

-- | For easy hspec migration
type Selector a = (a -> Bool)

-- | Assert that a given IO action throws an exception that matches the given exception
shouldThrow :: forall e a. (HasCallStack, Exception e) => IO a -> Selector e -> Expectation
IO a
action shouldThrow :: forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> IO ()
`shouldThrow` 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 a
_ ->
      String -> IO ()
forall a. HasCallStack => String -> IO a
expectationFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        String
"did not get expected exception: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
exceptionType
    Left e
e ->
      String -> IO () -> IO ()
forall a. String -> IO a -> IO a
context (String
"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 -> 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]
++ String
")") (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        e
e e -> Selector e -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Selector e
p
  where
    -- a string repsentation of the expected exception's type
    exceptionType :: String
exceptionType = (TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> (e -> TypeRep) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf @e) e
forall a. HasCallStack => a
undefined

infix 1 `shouldThrow`

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

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