{-# LANGUAGE RankNTypes #-}

-- | Functions for making assertions about test behavior.

module Test.Sandwich.Expectations where

import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import qualified Data.List as L
import qualified Data.Set as Set
import Data.String.Interpolate
import qualified Data.Text as T
import GHC.Stack
import Test.Sandwich.Types.Spec
import UnliftIO.Exception

-- * Manually fail a test or mark as pending

-- | General-purpose function to throw a test exception with a 'String'.
expectationFailure :: (HasCallStack, MonadIO m) => String -> m a
expectationFailure :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure = FailureReason -> m a
forall (m :: * -> *) e a. (MonadIO 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)

-- | Throws a 'Pending' exception, which will cause the test to be marked as pending.
pending :: (HasCallStack, MonadIO m) => m a
pending :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => m a
pending = FailureReason -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FailureReason -> m a) -> FailureReason -> m a
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

-- | Throws a 'Pending' exception with a message to add additional details.
pendingWith :: (HasCallStack, MonadIO m) => String -> m a
pendingWith :: forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
pendingWith String
msg = FailureReason -> m a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (FailureReason -> m a) -> FailureReason -> m a
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)

-- | Shorthand for a pending test example. You can quickly mark an 'it' node as pending by putting an "x" in front of it.
xit :: (HasCallStack, MonadIO m) => String -> ExampleT context m1 () -> SpecFree context m ()
xit :: forall (m :: * -> *) context (m1 :: * -> *).
(HasCallStack, MonadIO m) =>
String -> ExampleT context m1 () -> SpecFree context m ()
xit String
name ExampleT context m1 ()
_ex = String -> ExampleT context m () -> Free (SpecCommand 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. (MonadIO 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)

-- * Expecting failures

-- | Assert that a given action should fail with some 'FailureReason'.
shouldFail :: (HasCallStack, MonadUnliftIO m) => m () -> m ()
shouldFail :: forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
m () -> m ()
shouldFail m ()
action = do
  m () -> m (Either FailureReason ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m ()
action m (Either FailureReason ())
-> (Either FailureReason () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (FailureReason
_ :: FailureReason) -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Right () -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected test to fail|]

-- | Assert that a given action should fail with some 'FailureReason' matching a predicate.
shouldFailPredicate :: (HasCallStack, MonadUnliftIO m) => (FailureReason -> Bool) -> m () -> m ()
shouldFailPredicate :: forall (m :: * -> *).
(HasCallStack, MonadUnliftIO m) =>
(FailureReason -> Bool) -> m () -> m ()
shouldFailPredicate FailureReason -> Bool
p m ()
action = do
  m () -> m (Either FailureReason ())
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m ()
action m (Either FailureReason ())
-> (Either FailureReason () -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (FailureReason
err :: FailureReason) -> case FailureReason -> Bool
p FailureReason
err of
      Bool
True -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Bool
False -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO 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, MonadIO m) => String -> m a
expectationFailure [i|Expected test to fail, but it succeeded|]

-- | Asserts that an action should throw an exception. Accepts a predicate to determine if the exception matches.
shouldThrow :: (HasCallStack, MonadUnliftIO m, Exception e) =>
  m a
  -- ^ The action to run.
  -> (e -> Bool)
  -- ^ A predicate on the exception to determine if it's as expected.
  -> m ()
shouldThrow :: forall (m :: * -> *) e a.
(HasCallStack, MonadUnliftIO m, Exception e) =>
m a -> (e -> Bool) -> m ()
shouldThrow m a
action e -> Bool
f = do
  m a -> m (Either e a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try m a
action m (Either e a) -> (Either e a -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right a
_ -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected exception to be thrown.|]
    Left e
e | e -> Bool
f e
e -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left e
e -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Exception didn't match predicate: '#{show e}'|]

-- * Assertions

-- | Asserts that two things are equal.
shouldBe :: (HasCallStack, MonadIO m, Eq a, Show a) => a -> a -> m ()
shouldBe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
a -> a -> m ()
shouldBe a
x a
y
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = FailureReason -> m ()
forall (m :: * -> *) e a. (MonadIO 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))

-- | Asserts that two things are not equal.
shouldNotBe :: (HasCallStack, MonadIO m, Eq a, Show a) => a -> a -> m ()
shouldNotBe :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
a -> a -> m ()
shouldNotBe a
x a
y
  | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
y = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = FailureReason -> m ()
forall (m :: * -> *) e a. (MonadIO 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))

-- | Asserts that the given list contains a subsequence.
shouldContain :: (HasCallStack, MonadIO m, Eq a, Show a) => [a] -> [a] -> m ()
shouldContain :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
[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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Bool
False -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected #{show haystack} to contain #{show needle}|] -- TODO: custom exception type

-- | Asserts that the given list contains an item matching a predicate.
shouldContainPredicate :: (HasCallStack, MonadIO m, Show a) => [a] -> (a -> Bool) -> m ()
shouldContainPredicate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
[a] -> (a -> Bool) -> m ()
shouldContainPredicate [a]
haystack a -> Bool
p = case (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find a -> Bool
p [a]
haystack of
  Just a
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Maybe a
Nothing -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected #{show haystack} to contain an item matching the predicate|]

-- | Asserts that the given list does not contain a subsequence.
shouldNotContain :: (HasCallStack, MonadIO m, Eq a, Show a) => [a] -> [a] -> m ()
shouldNotContain :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
[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, MonadIO m) => String -> m a
expectationFailure [i|Expected #{show haystack} not to contain #{show needle}|]
  Bool
False -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Asserts that the given lists are equal as sets.
shouldBeSet :: (HasCallStack, MonadIO m, Ord a, Show a) => [a] -> [a] -> m ()
shouldBeSet :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Ord a, Show a) =>
[a] -> [a] -> m ()
shouldBeSet [a]
haystack [a]
needle = case [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
needle Set a -> Set a -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
haystack of
  Bool
True -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Bool
False -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected #{show haystack} to equal as a set #{show needle}|]

-- | Asserts that the given list contains an item matching a predicate.
shouldNotContainPredicate :: (HasCallStack, MonadIO m, Show a) => [a] -> (a -> Bool) -> m ()
shouldNotContainPredicate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
[a] -> (a -> Bool) -> m ()
shouldNotContainPredicate [a]
haystack a -> Bool
p = case (a -> Bool) -> [a] -> Maybe a
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find a -> Bool
p [a]
haystack of
  Maybe a
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Just a
_ -> String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected #{show haystack} not to contain an item matching the predicate|]

-- | Asserts that the given 'Maybe' is 'Nothing'.
shouldBeNothing :: (HasCallStack, MonadIO m, Show a) => Maybe a -> m ()
shouldBeNothing :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a) =>
Maybe a -> m ()
shouldBeNothing Maybe a
Nothing = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shouldBeNothing Maybe a
x = String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected Nothing but got #{x}|]

-- | Asserts that the given 'Maybe' is 'Just'.
shouldBeJust :: (HasCallStack, MonadIO m) => Maybe a -> m ()
shouldBeJust :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m) =>
Maybe a -> m ()
shouldBeJust (Just a
_) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shouldBeJust Maybe a
Nothing = String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected Just but got Nothing.|]

-- | Asserts that the given 'Either' is 'Left'.
shouldBeLeft :: (HasCallStack, MonadIO m, Show a, Show b) => Either a b -> m ()
shouldBeLeft :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, Show a, Show b) =>
Either a b -> m ()
shouldBeLeft (Left a
_) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shouldBeLeft Either a b
x = String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected Left but got #{x}|]

-- | Asserts that the given 'Either' is 'Right'.
shouldBeRight :: (HasCallStack, MonadIO m, Show a, Show b) => Either a b -> m ()
shouldBeRight :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, Show a, Show b) =>
Either a b -> m ()
shouldBeRight (Right b
_) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
shouldBeRight Either a b
x = String -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadIO m) => String -> m a
expectationFailure [i|Expected Right but got #{x}.|]

-- | Asserts that the given text contains a substring.
textShouldContain :: (HasCallStack, MonadIO m) => T.Text -> T.Text -> m ()
Text
t textShouldContain :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m ()
`textShouldContain` Text
txt = ((Text -> String
T.unpack Text
t) :: String) String -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
[a] -> [a] -> m ()
`shouldContain` (Text -> String
T.unpack Text
txt)

-- | Asserts that the given text does not contain a substring.
textShouldNotContain :: (HasCallStack, MonadIO m) => T.Text -> T.Text -> m ()
Text
t textShouldNotContain :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> m ()
`textShouldNotContain` Text
txt = ((Text -> String
T.unpack Text
t) :: String) String -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Eq a, Show a) =>
[a] -> [a] -> m ()
`shouldNotContain` (Text -> String
T.unpack Text
txt)