{-# 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
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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: 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 :: [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 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 `shouldStartWith`

-- | Assert that the given list has the given suffix
shouldEndWith :: (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
shouldEndWith :: [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 :: [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 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 :: 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 :: 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 :: 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 :: String -> IO a -> IO a
context String
s IO a
action = (IO a
action IO a -> (a -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> IO a
forall a. a -> IO a
evaluate) IO a -> (Assertion -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\Assertion
a -> Assertion -> IO a
forall e a. Exception e => e -> IO a
throwIO (Assertion -> String -> Assertion
Context Assertion
a 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 :: 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
. Typeable e => e -> TypeRep
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