{-# options_haddock prune #-}

-- |TestError data type, Internal
module Polysemy.Test.Data.TestError (
  TestError (TestError, UnsafeTestError),
  testError,
) where

-- | An error that occurred in the test machinery.
--
-- The pattern synonym is used for construction to ensure that the call site's stack is stored.
-- There is no 'IsString' instance because it can't propagate the call stack.
-- Use 'testError' to throw a string literal.
data TestError where
  UnsafeTestError :: HasCallStack => Text -> TestError

deriving stock instance Eq TestError
deriving stock instance Show TestError

-- | Construct a test error so that the call site's stack is stored in the value, for printing the correct location in
-- hedgehog messages.
pattern TestError :: HasCallStack => HasCallStack => Text -> TestError
pattern $mTestError :: forall {r}.
HasCallStack =>
TestError -> (HasCallStack => Text -> r) -> ((# #) -> r) -> r
$bTestError :: (HasCallStack, HasCallStack) => Text -> TestError
TestError err <- UnsafeTestError err where
  TestError Text
err = (HasCallStack => TestError) -> TestError
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => TestError) -> TestError)
-> (HasCallStack => TestError) -> TestError
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> TestError
Text -> TestError
UnsafeTestError Text
err
{-# complete TestError #-}

-- | Throw a 'TestError' with the call site's stack.
testError ::
  ∀ a r .
  HasCallStack =>
  Member (Error TestError) r =>
  Text ->
  Sem r a
testError :: forall a (r :: EffectRow).
(HasCallStack, Member (Error TestError) r) =>
Text -> Sem r a
testError Text
msg =
  (HasCallStack => Sem r a) -> Sem r a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Sem r a) -> Sem r a)
-> (HasCallStack => Sem r a) -> Sem r a
forall a b. (a -> b) -> a -> b
$ TestError -> Sem r a
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw ((HasCallStack, HasCallStack) => Text -> TestError
Text -> TestError
TestError Text
msg)