{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

-- | 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual forall a. Eq a => a -> a -> Bool
== a
expected) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
NotEqualButShouldHaveBeenEqual (forall a. Show a => a -> String
ppShow a
actual) (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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual forall a. Eq a => a -> a -> Bool
/= a
expected) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
EqualButShouldNotHaveBeenEqual (forall a. Show a => a -> String
ppShow a
actual) (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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
p a
actual) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateFailedButShouldHaveSucceeded (forall a. Show a => a -> String
ppShow a
actual) 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
p a
actual) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateFailedButShouldHaveSucceeded (forall a. Show a => a -> String
ppShow a
actual) (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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
actual) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateSucceededButShouldHaveFailed (forall a. Show a => a -> String
ppShow a
actual) 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
actual) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> Maybe String -> Assertion
PredicateSucceededButShouldHaveFailed (forall a. Show a => a -> String
ppShow a
actual) (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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual forall a. Eq a => a -> a -> Bool
== a
expected) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
NotEqualButShouldHaveBeenEqual (forall a. Show a => a -> String
ppShow a
actual) (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
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual forall a. Eq a => a -> a -> Bool
/= a
expected) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> String -> Assertion
EqualButShouldNotHaveBeenEqual (forall a. Show a => a -> String
ppShow a
actual) (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 = forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"has prefix\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
ppShow [a]
i) (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 = forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"has suffix\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
ppShow [a]
s) (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 = forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"has infix\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
ppShow [a]
i) (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 = forall a.
(HasCallStack, Show a) =>
a -> String -> (a -> Bool) -> IO ()
shouldSatisfyNamed [a]
a (String
"matches list\n" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
ppShow [a]
b) (forall a. Eq a => [a] -> [a] -> Bool
matches [a]
b)
  where
    matches :: [a] -> [a] -> Bool
matches [a]
x [a]
y = forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
x forall a. Eq a => [a] -> [a] -> [a]
\\ [a]
y) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a]
y 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
actual forall a. Eq a => a -> a -> Bool
== String
expected) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO 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 = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Text
actual forall a. Eq a => a -> a -> Bool
== Text
expected) forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO 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 (forall a. Show a => a -> String
show ByteString
actual) (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 = forall e a. Exception e => e -> IO a
throwIO 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. a -> IO a
evaluate)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(SomeException e
e) -> forall e a. Exception e => e -> IO a
throwIO (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 <- forall e a. Exception e => IO a -> IO (Either e a)
try IO a
action
  case Either e a
r of
    Right a
_ ->
      forall a. HasCallStack => String -> IO a
expectationFailure forall a b. (a -> b) -> a -> b
$
        String
"did not get expected exception: " forall a. [a] -> [a] -> [a]
++ String
exceptionType
    Left e
e ->
      forall a. String -> IO a -> IO a
context (String
"predicate failed on expected exception: " forall a. [a] -> [a] -> [a]
++ String
exceptionType forall a. [a] -> [a] -> [a]
++ String
" (" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show e
e forall a. [a] -> [a] -> [a]
++ String
")") forall a b. (a -> b) -> a -> b
$
        e
e 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 = (forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Typeable a => a -> TypeRep
typeOf @e) forall a. HasCallStack => a
undefined

infix 1 `shouldThrow`

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

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