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

-- | Exception handling
module Test.Cleveland.Internal.Actions.ExceptionHandling
  ( module Test.Cleveland.Internal.Actions.ExceptionHandling
  ) where

import Data.Either.Validation (Validation(..))
import Data.List.NonEmpty qualified as NE
import Fmt (Builder, build, indentF, nameF, pretty, unlinesF)

import Lorentz (CustomError(..), ErrorTagMap, IsError, Label, MText, MustHaveErrorArg)
import Lorentz.Constraints
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Actions.Assertions
import Test.Cleveland.Internal.Actions.Helpers
import Test.Cleveland.Internal.Actions.Misc
import Test.Cleveland.Internal.Actions.TransferFailurePredicate
import Test.Cleveland.Internal.Client qualified as Client (TestError(..))
import Test.Cleveland.Internal.Exceptions (WithCallStack(..))
import Test.Cleveland.Internal.Pure as Pure (TestError(..))

-- | Attempt to run an action and return its result or, if interpretation fails, an error.
attempt
  :: forall e caps m a. (HasCallStack, MonadCleveland caps m, Exception e)
  => m a -> m (Either e a)
attempt :: forall e caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Exception e) =>
m a -> m (Either e a)
attempt m a
action = do
  caps
caps <- m caps
forall r (m :: * -> *). MonadReader r m => m r
ask
  let ClevelandBaseMonad caps a
action' :: ClevelandBaseMonad caps a = ReaderT caps (ClevelandBaseMonad caps) a
-> caps -> ClevelandBaseMonad caps a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT m a
ReaderT caps (ClevelandBaseMonad caps) a
action caps
caps
  ClevelandBaseMonad caps (Either e a)
-> ReaderT caps (ClevelandBaseMonad caps) (Either e a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ClevelandBaseMonad caps (Either e a)
 -> ReaderT caps (ClevelandBaseMonad caps) (Either e a))
-> ClevelandBaseMonad caps (Either e a)
-> ReaderT caps (ClevelandBaseMonad caps) (Either e a)
forall a b. (a -> b) -> a -> b
$ ClevelandMiscImpl (ClevelandBaseMonad caps)
-> forall a e.
   (Exception e, HasCallStack) =>
   ClevelandBaseMonad caps a -> ClevelandBaseMonad caps (Either e a)
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a e. (Exception e, HasCallStack) => m a -> m (Either e a)
cmiAttempt (caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
forall caps.
HasClevelandCaps caps =>
caps -> ClevelandMiscImpl (ClevelandBaseMonad caps)
getMiscCap caps
caps) ClevelandBaseMonad caps a
action'

-- | Asserts that a transfer should fail, and returns the exception.
catchTransferFailure :: (HasCallStack, MonadCleveland caps m) => m a -> m TransferFailure
catchTransferFailure :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
m a -> m TransferFailure
catchTransferFailure m a
action =
  m a -> m (Either TransferFailure a)
forall e caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Exception e) =>
m a -> m (Either e a)
attempt m a
action m (Either TransferFailure a)
-> (Either TransferFailure a -> m TransferFailure)
-> m TransferFailure
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left TransferFailure
err -> TransferFailure -> m TransferFailure
forall (m :: * -> *) a. Monad m => a -> m a
return TransferFailure
err
    Right a
_ -> IO TransferFailure -> m TransferFailure
forall caps (m :: * -> *) res.
(HasCallStack, MonadCleveland caps m) =>
IO res -> m res
runIO (IO TransferFailure -> m TransferFailure)
-> IO TransferFailure -> m TransferFailure
forall a b. (a -> b) -> a -> b
$ GenericTestError -> IO TransferFailure
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM GenericTestError
UnexpectedSuccess

-- | Asserts that a transfer should fail, and runs some 'TransferFailurePredicate's over the
-- exception.
--
-- > expectTransferFailure (failedWith (constant @MText "NOT_ADMIN")) $
-- >   call contractAddr (Call @"Ep") arg
--
-- > call contractAddr (Call @"Ep") arg & expectTransferFailure
-- >   ( failedWith (customError #tag 3) &&
-- >     addressIs contractAddr
-- >   )
expectTransferFailure :: (HasCallStack, MonadCleveland caps m) => TransferFailurePredicate -> m a -> m ()
expectTransferFailure :: forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure TransferFailurePredicate
predicate m a
act = do
  TransferFailure
err <- m a -> m TransferFailure
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
m a -> m TransferFailure
catchTransferFailure m a
act
  TransferFailure -> TransferFailurePredicate -> m ()
forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
TransferFailure -> TransferFailurePredicate -> m ()
checkTransferFailure TransferFailure
err TransferFailurePredicate
predicate

-- | Check whether a given predicate holds for a given 'TransferFailure'.
checkTransferFailure :: (HasCallStack, MonadCleveland caps m) => TransferFailure -> TransferFailurePredicate -> m ()
checkTransferFailure :: forall caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
TransferFailure -> TransferFailurePredicate -> m ()
checkTransferFailure TransferFailure
err TransferFailurePredicate
predicate =
  case TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go TransferFailurePredicate
predicate of
    Success () -> m ()
forall (f :: * -> *). Applicative f => f ()
pass
    Failure NonEmpty Builder
expectedOutcome -> Builder -> m ()
forall a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m) =>
Builder -> m a
failure (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
"Expected transfer to fail with an error such that:"
      , Builder
""
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ NonEmpty Builder -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF NonEmpty Builder
expectedOutcome
      , Builder
""
      , Builder
"But these conditions were not met."
      , Builder
"Actual transfer error:"
      , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ TransferFailure -> Builder
forall p. Buildable p => p -> Builder
build TransferFailure
err
      ]
  where
    go :: TransferFailurePredicate -> Validation (NonEmpty Builder) ()
    go :: TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go = \case
      AndPredicate NonEmpty TransferFailurePredicate
ps ->
        (NonEmpty Builder -> NonEmpty Builder)
-> Validation (NonEmpty Builder) ()
-> Validation (NonEmpty Builder) ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes Builder
"AND") ((Element (NonEmpty TransferFailurePredicate)
 -> Validation (NonEmpty Builder) ())
-> NonEmpty TransferFailurePredicate
-> Validation (NonEmpty Builder) ()
forall t (f :: * -> *) b.
(Container t, Applicative f) =>
(Element t -> f b) -> t -> f ()
traverse_ Element (NonEmpty TransferFailurePredicate)
-> Validation (NonEmpty Builder) ()
TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go NonEmpty TransferFailurePredicate
ps)
      OrPredicate NonEmpty TransferFailurePredicate
ps ->
        case (Element (NonEmpty TransferFailurePredicate)
 -> Validation (NonEmpty Builder) ())
-> NonEmpty TransferFailurePredicate
-> Validation (NonEmpty Builder) ()
forall t (f :: * -> *) b.
(Container t, Applicative f) =>
(Element t -> f b) -> t -> f ()
traverse_ Element (NonEmpty TransferFailurePredicate)
-> Validation (NonEmpty Builder) ()
TransferFailurePredicate -> Validation (NonEmpty Builder) ()
go NonEmpty TransferFailurePredicate
ps of
          Success () -> () -> Validation (NonEmpty Builder) ()
forall e a. a -> Validation e a
Success ()
          Failure NonEmpty Builder
expectedOutcomes ->
            if NonEmpty Builder -> Int
forall t. Container t => t -> Int
length NonEmpty Builder
expectedOutcomes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmpty TransferFailurePredicate -> Int
forall t. Container t => t -> Int
length NonEmpty TransferFailurePredicate
ps
              -- If all sub-predicates failed, then this predicate failed.
              then NonEmpty Builder -> Validation (NonEmpty Builder) ()
forall e a. e -> Validation e a
Failure (NonEmpty Builder -> Validation (NonEmpty Builder) ())
-> NonEmpty Builder -> Validation (NonEmpty Builder) ()
forall a b. (a -> b) -> a -> b
$ Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes Builder
"OR" NonEmpty Builder
expectedOutcomes
              -- If at least 1 sub-predicate succeeded, then this predicate succeeded.
              else () -> Validation (NonEmpty Builder) ()
forall e a. a -> Validation e a
Success ()
      TransferFailurePredicate TransferFailure -> Validation Builder ()
p -> (Builder -> NonEmpty Builder)
-> Validation Builder () -> Validation (NonEmpty Builder) ()
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Builder -> NonEmpty Builder
forall x. One x => OneItem x -> x
one (Validation Builder () -> Validation (NonEmpty Builder) ())
-> Validation Builder () -> Validation (NonEmpty Builder) ()
forall a b. (a -> b) -> a -> b
$ TransferFailure -> Validation Builder ()
p TransferFailure
err

    fmtExpectedOutcomes :: Builder -> NonEmpty Builder -> NonEmpty Builder
    fmtExpectedOutcomes :: Builder -> NonEmpty Builder -> NonEmpty Builder
fmtExpectedOutcomes Builder
delimiter = \case
      Builder
expectedOutcome :| [] -> OneItem (NonEmpty Builder) -> NonEmpty Builder
forall x. One x => OneItem x -> x
one Builder
OneItem (NonEmpty Builder)
expectedOutcome
      NonEmpty Builder
expectedOutcomes ->
        OneItem (NonEmpty Builder) -> NonEmpty Builder
forall x. One x => OneItem x -> x
one (OneItem (NonEmpty Builder) -> NonEmpty Builder)
-> OneItem (NonEmpty Builder) -> NonEmpty Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF
          [ Builder
"("
          , Int -> Builder -> Builder
indentF Int
2 (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ NonEmpty Builder -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
unlinesF (NonEmpty Builder -> Builder) -> NonEmpty Builder -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> NonEmpty Builder -> NonEmpty Builder
forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse Builder
delimiter NonEmpty Builder
expectedOutcomes
          , Builder
")"
          ]

-- | Asserts that interpretation of a contract ended with @FAILWITH@, returning the given constant
-- value.
expectFailedWith
  :: forall err a caps m
   . (HasCallStack, MonadCleveland caps m, NiceConstant err)
  => err -> m a -> m ()
expectFailedWith :: forall err a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, NiceConstant err) =>
err -> m a -> m ()
expectFailedWith err
err = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (err -> SomeConstant
forall err. NiceConstant err => err -> SomeConstant
constant err
err)

-- | Asserts that interpretation of a contract ended with @FAILWITH@, returning the given lorentz
-- error.
expectError
  :: forall err a caps m
   . (HasCallStack, MonadCleveland caps m, IsError err)
  => err -> m a -> m ()
expectError :: forall err a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsError err) =>
err -> m a -> m ()
expectError err
err = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (err -> SomeConstant
forall err. IsError err => err -> SomeConstant
lerror err
err)

-- | Asserts that interpretation of a contract ended with @FAILWITH@, returning the given custom
-- lorentz error.
expectCustomError
  :: forall arg a tag caps m
   . ( HasCallStack, MonadCleveland caps m
     , IsError (CustomError tag)
     , MustHaveErrorArg tag (MText, arg)
     )
  => Label tag -> arg -> m a -> m ()
expectCustomError :: forall arg a (tag :: Symbol) caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsError (CustomError tag),
 MustHaveErrorArg tag (MText, arg)) =>
Label tag -> arg -> m a -> m ()
expectCustomError Label tag
tag arg
arg = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (Label tag -> arg -> SomeConstant
forall arg (tag :: Symbol).
(IsError (CustomError tag), MustHaveErrorArg tag (MText, arg)) =>
Label tag -> arg -> SomeConstant
customError Label tag
tag arg
arg)

-- | Version of 'expectCustomError' for error with @unit@ argument.
expectCustomError_
  :: ( HasCallStack, MonadCleveland caps m
     , IsError (CustomError tag)
     , MustHaveErrorArg tag (MText, ())
     )
  => Label tag -> m a -> m ()
expectCustomError_ :: forall caps (m :: * -> *) (tag :: Symbol) a.
(HasCallStack, MonadCleveland caps m, IsError (CustomError tag),
 MustHaveErrorArg tag (MText, ())) =>
Label tag -> m a -> m ()
expectCustomError_ Label tag
tag = Label tag -> () -> m a -> m ()
forall arg a (tag :: Symbol) caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsError (CustomError tag),
 MustHaveErrorArg tag (MText, arg)) =>
Label tag -> arg -> m a -> m ()
expectCustomError Label tag
tag ()

-- | Version of 'expectCustomError' specialized for expecting @NoErrorArg@s.
expectCustomErrorNoArg
  :: ( HasCallStack, MonadCleveland caps m
     , IsError (CustomError tag)
     , MustHaveErrorArg tag MText
     )
  => Label tag -> m a -> m ()
expectCustomErrorNoArg :: forall caps (m :: * -> *) (tag :: Symbol) a.
(HasCallStack, MonadCleveland caps m, IsError (CustomError tag),
 MustHaveErrorArg tag MText) =>
Label tag -> m a -> m ()
expectCustomErrorNoArg Label tag
tag = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (Label tag -> SomeConstant
forall (tag :: Symbol).
(IsError (CustomError tag), MustHaveErrorArg tag MText) =>
Label tag -> SomeConstant
customErrorNoArg Label tag
tag)

-- | Asserts that interpretation of a contract ended with @FAILWITH@, returning the given lorentz
-- numeric error.
expectNumericError
  :: forall err a caps m
   . (HasCallStack, MonadCleveland caps m, IsError err)
  => ErrorTagMap -> err -> m a -> m ()
expectNumericError :: forall err a caps (m :: * -> *).
(HasCallStack, MonadCleveland caps m, IsError err) =>
ErrorTagMap -> err -> m a -> m ()
expectNumericError ErrorTagMap
tagMap err
err = TransferFailurePredicate -> m a -> m ()
forall caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m) =>
TransferFailurePredicate -> m a -> m ()
expectTransferFailure (TransferFailurePredicate -> m a -> m ())
-> TransferFailurePredicate -> m a -> m ()
forall a b. (a -> b) -> a -> b
$ SomeConstant -> TransferFailurePredicate
failedWith (ErrorTagMap -> err -> SomeConstant
forall err. IsError err => ErrorTagMap -> err -> SomeConstant
numericError ErrorTagMap
tagMap err
err)

-- | Prefix /scenario-custom/ error messages (i.e. @CustomTestError@ either from pure or non-pure
-- implementation), potentially thrown from the given code block.
--
-- The prefix will be put at a separate line before the main text, if text is multiline, otherwise
-- it will be separated from the main text with @: @.
--
-- This affects errors produced by functions like 'failure', 'assert', '@==', etc.
-- Errors related to events in the chain will not be touched.
--
-- Example:
--
-- > for [1..10] \i -> clarifyErrors ("For i=" +| i |+ "") $
-- >   askContract i @@== i * 2
clarifyErrors :: forall caps m a. (MonadCleveland caps m)
              => Builder -> m a -> m a
clarifyErrors :: forall caps (m :: * -> *) a.
MonadCleveland caps m =>
Builder -> m a -> m a
clarifyErrors Builder
message m a
action = do
  m a -> m (Either SomeException a)
forall e caps (m :: * -> *) a.
(HasCallStack, MonadCleveland caps m, Exception e) =>
m a -> m (Either e a)
attempt m a
action m (Either SomeException a)
-> (Either SomeException a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left (SomeException
e :: SomeException) -> (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 =>
   SomeException -> ClevelandBaseMonad caps a
forall (m :: * -> *).
ClevelandMiscImpl m
-> forall a. HasCallStack => SomeException -> m a
cmiThrow ClevelandMiscImpl (ClevelandBaseMonad caps)
cap (SomeException -> SomeException
handle SomeException
e)
    Right a
val -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
  where
  handle :: SomeException -> SomeException
  handle :: SomeException -> SomeException
handle SomeException
e = SomeException -> Maybe SomeException -> SomeException
forall a. a -> Maybe a -> a
fromMaybe SomeException
e (Maybe SomeException -> SomeException)
-> Maybe SomeException -> SomeException
forall a b. (a -> b) -> a -> b
$
        (TestError -> TestError) -> SomeException -> Maybe SomeException
forall {b} {a}.
(Exception b, Exception a) =>
(a -> b) -> SomeException -> Maybe SomeException
wrap TestError -> TestError
testClientErrorHandler SomeException
e
    Maybe SomeException -> Maybe SomeException -> Maybe SomeException
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (TestError -> TestError) -> SomeException -> Maybe SomeException
forall {b} {a}.
(Exception b, Exception a) =>
(a -> b) -> SomeException -> Maybe SomeException
wrap TestError -> TestError
testPureErrorHandler SomeException
e
    Maybe SomeException -> Maybe SomeException -> Maybe SomeException
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (WithCallStack -> WithCallStack)
-> SomeException -> Maybe SomeException
forall {b} {a}.
(Exception b, Exception a) =>
(a -> b) -> SomeException -> Maybe SomeException
wrap WithCallStack -> WithCallStack
withCallStackErrorHandler SomeException
e

  wrap :: (a -> b) -> SomeException -> Maybe SomeException
wrap a -> b
f = (a -> SomeException) -> Maybe a -> Maybe SomeException
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> SomeException
forall e. Exception e => e -> SomeException
toException (b -> SomeException) -> (a -> b) -> a -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (Maybe a -> Maybe SomeException)
-> (SomeException -> Maybe a)
-> SomeException
-> Maybe SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Maybe a
forall e. Exception e => SomeException -> Maybe e
fromException

  addPrefix :: Text -> Text
addPrefix = Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (Builder -> Text) -> (Text -> Builder) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder -> Builder
nameF Builder
message (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
forall p. Buildable p => p -> Builder
build

  testClientErrorHandler :: Client.TestError -> Client.TestError
  testClientErrorHandler :: TestError -> TestError
testClientErrorHandler = \case
    Client.CustomTestError Text
msg -> Text -> TestError
Client.CustomTestError (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ Text -> Text
addPrefix Text
msg

  testPureErrorHandler :: Pure.TestError -> Pure.TestError
  testPureErrorHandler :: TestError -> TestError
testPureErrorHandler = \case
    Pure.CustomTestError Text
msg -> Text -> TestError
Pure.CustomTestError (Text -> TestError) -> Text -> TestError
forall a b. (a -> b) -> a -> b
$ Text -> Text
addPrefix Text
msg
    TestError
err -> TestError
err

  withCallStackErrorHandler :: WithCallStack -> WithCallStack
  withCallStackErrorHandler :: WithCallStack -> WithCallStack
withCallStackErrorHandler (WithCallStack CallStack
cst SomeException
e) = CallStack -> SomeException -> WithCallStack
WithCallStack CallStack
cst (SomeException -> WithCallStack) -> SomeException -> WithCallStack
forall a b. (a -> b) -> a -> b
$ SomeException -> SomeException
handle SomeException
e