{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
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
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`
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`
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
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`
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`
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)
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`
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`
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`
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`
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`
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
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
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 (ByteString -> String
forall a. Show a => a -> String
show ByteString
actual) (ByteString -> String
forall a. Show a => a -> String
show ByteString
expected)
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
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))
type Expectation = IO ()
type Selector a = (a -> Bool)
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
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