{-# OPTIONS_HADDOCK not-home #-}
module Test.Cleveland.Internal.Actions.Assertions
( module Test.Cleveland.Internal.Actions.Assertions
) where
import Fmt (Buildable, Builder, build, pretty, unlinesF)
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Actions.Helpers
{-# ANN module ("HLint: ignore Avoid lambda using `infix`" :: Text) #-}
failure :: forall a caps m. (HasCallStack, MonadCleveland caps m) => Builder -> m a
failure :: forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure Builder
msg = do
(caps -> ClevelandMiscImpl (ClevelandBaseMonad caps))
-> (ClevelandMiscImpl (ClevelandBaseMonad caps)
-> ClevelandBaseMonad caps a)
-> ReaderT caps (ClevelandBaseMonad caps) a
forall (m :: * -> *) caps cap a.
Monad m =>
(caps -> cap) -> (cap -> m a) -> ReaderT caps m a
withCap caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap \ClevelandMiscImpl (ClevelandBaseMonad caps)
cap -> ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall a. HasCallStack => Builder -> ClevelandBaseMonad caps a
forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Builder -> m a
cmiFailure ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Builder
msg
assert :: (HasCallStack, MonadCleveland caps m) => Bool -> Builder -> m ()
assert :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert Bool
b Builder
errMsg =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Builder -> m ()
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure Builder
errMsg
(@==)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> a
-> a
-> m ()
a
actual @== :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
a -> a -> m ()
@== a
expected =
Bool -> Builder -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected) (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"Failed comparison"
, Builder
"━━ Expected (rhs) ━━"
, a -> Builder
forall p. Buildable p => p -> Builder
build a
expected
, Builder
"━━ Got (lhs) ━━"
, a -> Builder
forall p. Buildable p => p -> Builder
build a
actual
]
infix 1 @==
(@/=)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> a -> a -> m ()
a
a @/= :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
a -> a -> m ()
@/= a
b =
Bool -> Builder -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b) (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$
[Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Builder
"The two values are equal:"
, a -> Builder
forall p. Buildable p => p -> Builder
build a
a
]
infix 1 @/=
(@@==)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> m a
-> a
-> m ()
m a
getActual @@== :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
m a -> a -> m ()
@@== a
expected = do
a
actual <- m a
getActual
a
actual a -> a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
a -> a -> m ()
@== a
expected
infix 1 @@==
(@@/=)
:: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
=> m a -> a -> m ()
m a
getA @@/= :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
m a -> a -> m ()
@@/= a
b = do
a
a <- m a
getA
a
a a -> a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Eq a, Buildable a) =>
a -> a -> m ()
@/= a
b
infix 1 @@/=
checkCompares
:: forall a b caps m
. (HasCallStack, MonadCleveland caps m, Buildable a, Buildable b)
=> a
-> (a -> b -> Bool)
-> b
-> m ()
checkCompares :: forall a b caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, Buildable a, Buildable b) =>
a -> (a -> b -> Bool) -> b -> m ()
checkCompares a
a a -> b -> Bool
f b
b = (a -> Text) -> a -> (a -> b -> Bool) -> (b -> Text) -> b -> m ()
forall a b caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
(a -> Text) -> a -> (a -> b -> Bool) -> (b -> Text) -> b -> m ()
checkComparesWith a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a
a a -> b -> Bool
f b -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty b
b
checkComparesWith
:: forall a b caps m
. (HasCallStack, MonadCleveland caps m)
=> (a -> Text)
-> a
-> (a -> b -> Bool)
-> (b -> Text)
-> b
-> m ()
checkComparesWith :: forall a b caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
(a -> Text) -> a -> (a -> b -> Bool) -> (b -> Text) -> b -> m ()
checkComparesWith a -> Text
showA a
a a -> b -> Bool
f b -> Text
showB b
b =
Bool -> Builder -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Builder -> m ()
assert (a -> b -> Bool
f a
a b
b) (Builder -> m ()) -> Builder -> m ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
[ Text
"Failed"
, Text
"━━ lhs ━━"
, a -> Text
showA a
a
, Text
"━━ rhs ━━"
, b -> Text
showB b
b
]
evalJust :: (HasCallStack, MonadCleveland caps m) => Builder -> Maybe a -> m a
evalJust :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
Builder -> Maybe a -> m a
evalJust Builder
err = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Builder -> m a
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure Builder
err) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
evalRight :: (HasCallStack, MonadCleveland caps m) => (a -> Builder) -> Either a b -> m b
evalRight :: forall caps (m :: * -> *) a b.
(HasCallStack, MonadCleveland caps m) =>
(a -> Builder) -> Either a b -> m b
evalRight a -> Builder
mkErr = (a -> m b) -> (b -> m b) -> Either a b -> m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Builder -> m b
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (Builder -> m b) -> (a -> Builder) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Builder
mkErr) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure