-- SPDX-FileCopyrightText: 2022 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_HADDOCK not-home #-}

-- | Various test assertions in the 'MonadCleveland' context.
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) #-}

-- | Fails the test with the given error message.
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

-- | Fails the test with the given error message if the given condition is false.
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

-- | @x \@== expected@ fails the test if @x@ is not equal to @expected@.
(@==)
  :: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
  => a -- ^ The actual value.
  -> a -- ^ The expected value.
  -> 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 @==

-- | Fails the test if the two given values are equal.
(@/=)
  :: (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 @/=

-- | Monadic version of '@=='.
--
-- > getBalance addr @@== 10
(@@==)
  :: (HasCallStack, MonadCleveland caps m, Eq a, Buildable a)
  => m a -- ^ The actual value.
  -> a -- ^ The expected value.
  -> 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 @@==

-- | Monadic version of '@/='.
--
-- > getBalance addr @@/= 10
(@@/=)
  :: (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 @@/=

-- | Fails the test if the comparison operator fails when applied to the given arguments.
-- Prints an error message with both arguments.
--
-- Example:
--
-- > checkCompares 2 (>) 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

-- | Like 'checkCompares', but with an explicit show function.
-- This function does not have any constraint on the type parameters @a@ and @b@.
--
-- For example, to print with 'Fmt.pretty':
--
-- > checkComparesWith pretty a (<) pretty 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
      ]

-- | Fails the test if the `Maybe` is `Nothing`, otherwise returns the value in the `Just`.
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

-- | Fails the test if the `Either` is `Left`, otherwise returns the value in the `Right`.
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