{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
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
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`
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`
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
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`
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`
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)
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`
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`
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`
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`
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`
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)
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
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
stringsNotEqualButShouldHaveBeenEqual :: String -> String -> Assertion
stringsNotEqualButShouldHaveBeenEqual :: String -> String -> Assertion
stringsNotEqualButShouldHaveBeenEqual String
actual String
expected = String -> String -> Assertion
NotEqualButShouldHaveBeenEqual String
actual String
expected
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)
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)
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
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))
type Expectation = IO ()
type Selector a = (a -> Bool)
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
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