{-# OPTIONS_HADDOCK not-home #-}
module Test.Cleveland.Internal.Actions.Assertions
( module Test.Cleveland.Internal.Actions.Assertions
) where
import Fmt (Buildable, Doc, 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) => Doc -> m a
failure :: forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Doc -> m a
failure Doc
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 => Doc -> ClevelandBaseMonad caps a
forall (m :: * -> *).
ClevelandMiscImpl m -> forall a. HasCallStack => Doc -> m a
cmiFailure ClevelandMiscImpl (ClevelandBaseMonad caps)
cap Doc
msg
assert :: (HasCallStack, MonadCleveland caps m) => Bool -> Doc -> m ()
assert :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Doc -> m ()
assert Bool
b Doc
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
$ Doc -> m ()
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Doc -> m a
failure Doc
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 -> Doc -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Doc -> m ()
assert (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected) (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"Failed comparison"
, Doc
"━━ Expected (rhs) ━━"
, a -> Doc
forall a. Buildable a => a -> Doc
build a
expected
, Doc
"━━ Got (lhs) ━━"
, a -> Doc
forall a. Buildable a => a -> Doc
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 -> Doc -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Doc -> m ()
assert (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b) (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$
[Doc] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Doc
"The two values are equal:"
, a -> Doc
forall a. Buildable a => a -> Doc
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, FromDoc b) => a -> b
pretty a
a a -> b -> Bool
f b -> Text
forall a b. (Buildable a, FromDoc 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 -> Doc -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Bool -> Doc -> m ()
assert (a -> b -> Bool
f a
a b
b) (Doc -> m ()) -> Doc -> m ()
forall a b. (a -> b) -> a -> b
$
[Text] -> Doc
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Doc
unlinesF
[ Text
"Failed"
, Text
"━━ lhs ━━"
, a -> Text
showA a
a
, Text
"━━ rhs ━━"
, b -> Text
showB b
b
]
evalJust :: (HasCallStack, MonadCleveland caps m) => Doc -> Maybe a -> m a
evalJust :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
Doc -> Maybe a -> m a
evalJust Doc
err = m a -> (a -> m a) -> Maybe a -> m a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Doc -> m a
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Doc -> m a
failure Doc
err) a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
evalRight :: (HasCallStack, MonadCleveland caps m) => (a -> Doc) -> Either a b -> m b
evalRight :: forall caps (m :: * -> *) a b.
(HasCallStack, MonadCleveland caps m) =>
(a -> Doc) -> Either a b -> m b
evalRight a -> Doc
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 (Doc -> m b
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Doc -> m a
failure (Doc -> m b) -> (a -> Doc) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Doc
mkErr) b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure