effectful-2.4.0.0: tests/ErrorTests.hs

module ErrorTests (errorTests) where

import Test.Tasty
import Test.Tasty.HUnit

import Effectful
import Effectful.Dispatch.Dynamic
import Effectful.Error.Dynamic qualified as D
import Effectful.Error.Static

errorTests :: TestTree
errorTests = testGroup "Error"
  [ testCase "different handlers are independent" test_independentHandlers
  , testCase "call stack of dynamic throwError doesn't show internal details" test_dynamicThrowErrorCallStack
  ]

test_independentHandlers :: Assertion
test_independentHandlers = runEff $ do
  result <- runError @String . runOuterThrow $ do
    runError @String outerThrow
  liftIO $ case result of
    Left (cs, _) -> assertBool "stack trace points to the correct action" $
      "outerThrow" == fst (last $ getCallStack cs)
    Right _ -> assertFailure "error caught by the wrong (inner) handler"

test_dynamicThrowErrorCallStack :: Assertion
test_dynamicThrowErrorCallStack = do
  Left (cs, ()) <- runEff . D.runError @() $ D.throwError ()
  case getCallStack cs of
    [("throwError", _)] -> pure ()
    _ -> assertFailure $ "invalid call stack: " ++ prettyCallStack cs

----------------------------------------
-- Helpers

data OuterThrow :: Effect where
  OuterThrow :: OuterThrow m ()

type instance DispatchOf OuterThrow = Dynamic

outerThrow :: (HasCallStack, OuterThrow :> es) => Eff es ()
outerThrow = send OuterThrow

runOuterThrow :: Error String :> es => Eff (OuterThrow : es) a -> Eff es a
runOuterThrow = interpret_ $ \case
  OuterThrow -> throwError "outer"