{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.Sandwich.Expectations where
import Control.Exception.Safe
import Control.Monad.IO.Class
import qualified Data.List as L
import Data.String.Interpolate
import qualified Data.Text as T
import GHC.Stack
import Test.Sandwich.Types.Spec
expectationFailure :: (HasCallStack, MonadThrow m) => String -> m a
expectationFailure :: String -> m a
expectationFailure = FailureReason -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailureReason -> m a)
-> (String -> FailureReason) -> String -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CallStack -> String -> FailureReason
Reason (CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack)
pending :: (HasCallStack, MonadThrow m) => m ()
pending :: m ()
pending = FailureReason -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailureReason -> m ()) -> FailureReason -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CallStack -> Maybe String -> FailureReason
Pending (CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack) Maybe String
forall a. Maybe a
Nothing
pendingWith :: (HasCallStack, MonadThrow m) => String -> m ()
pendingWith :: String -> m ()
pendingWith String
msg = FailureReason -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailureReason -> m ()) -> FailureReason -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CallStack -> Maybe String -> FailureReason
Pending (CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack) (String -> Maybe String
forall a. a -> Maybe a
Just String
msg)
xit :: (HasCallStack, Monad m, MonadThrow m) => String -> ExampleT context m1 () -> SpecFree context m ()
xit :: String -> ExampleT context m1 () -> SpecFree context m ()
xit String
name ExampleT context m1 ()
_ex = String -> ExampleT context m () -> SpecFree context m ()
forall context (m :: * -> *).
HasCallStack =>
String -> ExampleT context m () -> Free (SpecCommand context m) ()
it String
name (FailureReason -> ExampleT context m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (FailureReason -> ExampleT context m ())
-> FailureReason -> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ Maybe CallStack -> Maybe String -> FailureReason
Pending (CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack) Maybe String
forall a. Maybe a
Nothing)
shouldFail :: (HasCallStack, MonadCatch m, MonadThrow m) => m () -> m ()
shouldFail :: m () -> m ()
shouldFail m ()
action = do
m () -> m (Either FailureReason ())
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m ()
action m (Either FailureReason ())
-> (Either FailureReason () -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (FailureReason
_ :: FailureReason) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right () -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected test to fail|]
shouldFailPredicate :: (HasCallStack, MonadCatch m, MonadThrow m) => (FailureReason -> Bool) -> m () -> m ()
shouldFailPredicate :: (FailureReason -> Bool) -> m () -> m ()
shouldFailPredicate FailureReason -> Bool
pred m ()
action = do
m () -> m (Either FailureReason ())
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m ()
action m (Either FailureReason ())
-> (Either FailureReason () -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left (FailureReason
err :: FailureReason) -> case FailureReason -> Bool
pred FailureReason
err of
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected test to fail with a failure matching the predicate, but got a different failure: '#{err}'|]
Right () -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected test to fail, but it succeeded|]
shouldThrow :: (HasCallStack, MonadThrow m, MonadCatch m, MonadIO m, Exception e) =>
m a
-> (e -> Bool)
-> m ()
shouldThrow :: m a -> (e -> Bool) -> m ()
shouldThrow m a
action e -> Bool
f = do
m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> m (Either e a)
try m a
action m (Either e a) -> (Either e a -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right a
_ -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected exception to be thrown.|]
Left e
e | e -> Bool
f e
e -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Left e
e -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Exception didn't match predicate: '#{show e}'|]
shouldBe :: (HasCallStack, MonadThrow m, Eq a, Show a) => a -> a -> m ()
shouldBe :: a -> a -> m ()
shouldBe a
x a
y
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = FailureReason -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (Maybe CallStack -> ShowEqBox -> ShowEqBox -> FailureReason
ExpectedButGot (CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack) (a -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB a
y) (a -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB a
x))
shouldNotBe :: (HasCallStack, MonadThrow m, Eq a, Show a) => a -> a -> m ()
shouldNotBe :: a -> a -> m ()
shouldNotBe a
x a
y
| a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = FailureReason -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (Maybe CallStack -> ShowEqBox -> FailureReason
DidNotExpectButGot (CallStack -> Maybe CallStack
forall a. a -> Maybe a
Just CallStack
HasCallStack => CallStack
callStack) (a -> ShowEqBox
forall s. (Show s, Eq s) => s -> ShowEqBox
SEB a
y))
shouldContain :: (HasCallStack, MonadThrow m, Eq a, Show a) => [a] -> [a] -> m ()
shouldContain :: [a] -> [a] -> m ()
shouldContain [a]
haystack [a]
needle = case [a]
needle [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` [a]
haystack of
Bool
True -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
False -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected #{show haystack} to contain #{show needle}|]
shouldContainPredicate :: (HasCallStack, MonadThrow m, Eq a, Show a) => [a] -> (a -> Bool) -> m ()
shouldContainPredicate :: [a] -> (a -> Bool) -> m ()
shouldContainPredicate [a]
haystack a -> Bool
pred = case (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find a -> Bool
pred [a]
haystack of
Just a
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Maybe a
Nothing -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected #{show haystack} to contain an item matching the predicate|]
shouldNotContain :: (HasCallStack, MonadThrow m, Eq a, Show a) => [a] -> [a] -> m ()
shouldNotContain :: [a] -> [a] -> m ()
shouldNotContain [a]
haystack [a]
needle = case [a]
needle [a] -> [a] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` [a]
haystack of
Bool
True -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected #{show haystack} not to contain #{show needle}|]
Bool
False -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shouldNotContainPredicate :: (HasCallStack, MonadThrow m, Eq a, Show a) => [a] -> (a -> Bool) -> m ()
shouldNotContainPredicate :: [a] -> (a -> Bool) -> m ()
shouldNotContainPredicate [a]
haystack a -> Bool
pred = case (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find a -> Bool
pred [a]
haystack of
Maybe a
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
_ -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
expectationFailure [i|Expected #{show haystack} not to contain an item matching the predicate|]
textShouldContain :: (HasCallStack, MonadThrow m) => T.Text -> T.Text -> m ()
Text
t textShouldContain :: Text -> Text -> m ()
`textShouldContain` Text
txt = ((Text -> String
T.unpack Text
t) :: String) String -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
[a] -> [a] -> m ()
`shouldContain` (Text -> String
T.unpack Text
txt)
textShouldNotContain :: (HasCallStack, MonadThrow m) => T.Text -> T.Text -> m ()
Text
t textShouldNotContain :: Text -> Text -> m ()
`textShouldNotContain` Text
txt = ((Text -> String
T.unpack Text
t) :: String) String -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
[a] -> [a] -> m ()
`shouldNotContain` (Text -> String
T.unpack Text
txt)