Improve Show instance of Effectful.Error.Static.ErrorWrapper

For example, if a third-party library spawns worker threads and if a job throws,
it simply catches SomeException, logs it and retries the job later, as of today
internal exceptions representing errors of the `Error` effect wouldn't show any
info about the error, just the backtrace.

This fixes it at the cost of small API breakage.

effectful-core/src/Effectful/Error/Dynamic.hs

@@ -14,7 +14,9 @@ module Effectful.Error.Dynamic
   , runErrorNoCallStackWith
 
     -- ** Operations
+  , throwErrorWith
   , throwError
+  , throwError_
   , catchError
   , handleError
   , tryError
@@ -34,7 +36,8 @@ import Effectful.Error.Static qualified as E
 
 -- | Provide the ability to handle errors of type @e@.
 data Error e :: Effect where
-  ThrowError :: e -> Error e m a
+  -- | @since 2.4.0.0
+  ThrowErrorWith :: (e -> String) -> e -> Error e m a
   CatchError :: m a -> (E.CallStack -> e -> m a) -> Error e m a
 
 type instance DispatchOf (Error e) = Dynamic
@@ -44,7 +47,7 @@ runError
   :: Eff (Error e : es) a
   -> Eff es (Either (E.CallStack, e) a)
 runError = reinterpret E.runError $ \env -> \case
-  ThrowError e   -> E.throwError e
+  ThrowErrorWith display e -> E.throwErrorWith display e
   CatchError m h -> localSeqUnlift env $ \unlift -> do
     E.catchError (unlift m) (\cs -> unlift . h cs)
 
@@ -81,13 +84,36 @@ runErrorNoCallStackWith handler m = runErrorNoCallStack m >>= \case
   Left e -> handler e
   Right a -> pure a
 
--- | Throw an error of type @e@.
+-- | Throw an error of type @e@ along with a display function in case a
+-- third-party code catches the internal exception and 'show's it.
+--
+-- @since 2.4.0.0
+throwErrorWith
+  :: (HasCallStack, Error e :> es)
+  => (e -> String)
+  -- ^ The display function.
+  -> e
+  -- ^ The error.
+  -> Eff es a
+throwErrorWith display = withFrozenCallStack send . ThrowErrorWith display
+
+-- | Throw an error of type @e@ with 'show' as a display function.
 throwError
+  :: (HasCallStack, Error e :> es, Show e)
+  => e
+  -- ^ The error.
+  -> Eff es a
+throwError = throwErrorWith show
+
+-- | Throw an error of type @e@ with no display function.
+--
+-- @since 2.4.0.0
+throwError_
   :: (HasCallStack, Error e :> es)
   => e
   -- ^ The error.
   -> Eff es a
-throwError e = withFrozenCallStack $ send (ThrowError e)
+throwError_ = throwErrorWith (const "<opaque>")
 
 -- | Handle an error of type @e@.
 catchError

effectful-core/src/Effectful/Error/Static.hs

@@ -86,7 +86,9 @@ module Effectful.Error.Static
   , runErrorNoCallStackWith
 
     -- ** Operations
+  , throwErrorWith
   , throwError
+  , throwError_
   , catchError
   , handleError
   , tryError
@@ -161,15 +163,38 @@ runErrorNoCallStackWith handler m = runErrorNoCallStack m >>= \case
   Left e -> handler e
   Right a -> pure a
 
--- | Throw an error of type @e@.
+-- | Throw an error of type @e@ along with a display function in case a
+-- third-party code catches the internal exception and 'show's it.
+--
+-- @since 2.4.0.0
+throwErrorWith
+  :: forall e es a. (HasCallStack, Error e :> es)
+  => (e -> String)
+  -- ^ The display function.
+  -> e
+  -- ^ The error.
+  -> Eff es a
+throwErrorWith display e = unsafeEff $ \es -> do
+  Error eid <- getEnv @(Error e) es
+  throwIO $ ErrorWrapper eid callStack (display e) (toAny e)
+
+-- | Throw an error of type @e@ with 'show' as a display function.
 throwError
+  :: forall e es a. (HasCallStack, Error e :> es, Show e)
+  => e
+  -- ^ The error.
+  -> Eff es a
+throwError = throwErrorWith show
+
+-- | Throw an error of type @e@ with no display function.
+--
+-- @since 2.4.0.0
+throwError_
   :: forall e es a. (HasCallStack, Error e :> es)
   => e
   -- ^ The error.
   -> Eff es a
-throwError e = unsafeEff $ \es -> do
-  Error eid <- getEnv @(Error e) es
-  throwIO $ ErrorWrapper eid callStack (toAny e)
+throwError_ = throwErrorWith (const "<opaque>")
 
 -- | Handle an error of type @e@.
 catchError
@@ -222,21 +247,25 @@ tryHandler
   -> IO r
   -> IO r
 tryHandler ex eid0 handler next = case fromException ex of
-  Just (ErrorWrapper eid cs e)
+  Just (ErrorWrapper eid cs _ e)
     | eid0 == eid -> pure $ handler cs (fromAny e)
     | otherwise   -> next
   Nothing -> next
 
-data ErrorWrapper = ErrorWrapper !ErrorId CallStack Any
+data ErrorWrapper = ErrorWrapper !ErrorId CallStack String Any
+
 instance Show ErrorWrapper where
-  showsPrec p (ErrorWrapper _ cs _)
-    = ("Effectful.Error.Static.ErrorWrapper\n\n" ++)
-    . showsPrec p (prettyCallStack cs)
+  showsPrec _ (ErrorWrapper _ cs errRep _)
+    = ("Effectful.Error.Static.ErrorWrapper: " ++)
+    . (errRep ++)
+    . ("\n" ++)
+    . (prettyCallStack cs ++)
+
 instance Exception ErrorWrapper
 
 catchErrorIO :: ErrorId -> IO a -> (CallStack -> e -> IO a) -> IO a
 catchErrorIO eid m handler = do
-  m `catch` \err@(ErrorWrapper etag cs e) -> do
+  m `catch` \err@(ErrorWrapper etag cs _ e) -> do
     if eid == etag
       then handler cs (fromAny e)
       else throwIO err

effectful-plugin/tests/PluginTests.hs

@@ -63,7 +63,7 @@ oStrState = put "hello"
 err :: Error e :> es => Eff es Bool
 err =
   catchError
-    (throwError (error ""))
+    (throwError_ (error ""))
     (\_ _ -> pure True)
 
 errState :: (Num s, Error e :> es, State s :> es) => Eff es Bool