From a022b492ff85f0121803a7895f493eabc708f381 Mon Sep 17 00:00:00 2001 From: Andrzej Rybczak Date: Fri, 9 Aug 2024 14:04:35 +0200 Subject: [PATCH] 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/CHANGELOG.md | 12 ++++- effectful-core/src/Effectful/Error/Dynamic.hs | 34 +++++++++++-- effectful-core/src/Effectful/Error/Static.hs | 49 +++++++++++++++---- effectful-core/src/Effectful/Labeled/Error.hs | 28 ++++++++++- effectful-plugin/tests/PluginTests.hs | 2 +- effectful/CHANGELOG.md | 12 ++++- 6 files changed, 116 insertions(+), 21 deletions(-) diff --git a/effectful-core/CHANGELOG.md b/effectful-core/CHANGELOG.md index 7ac9468..17a729c 100644 --- a/effectful-core/CHANGELOG.md +++ b/effectful-core/CHANGELOG.md @@ -6,8 +6,16 @@ * Improve `Effectful.Labeled`, add `Effectful.Labeled.Error`, `Effectful.Labeled.Reader`, `Effectful.Labeled.State` and `Effectful.Labeled.Writer`. -* **Breaking change**: `localSeqLend`, `localLend`, `localSeqBorrow` and - `localBorrow` now take a list of effects instead of a single one. +* Add `throwErrorWith` and `throwError_` to `Effectful.Error.Static` and + `Effectful.Error.Dynamic`. +* **Breaking changes**: + - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a + list of effects instead of a single one. + - `Effectful.Error.Static.throwError` now requires the error type to have a + `Show` constraint. If this is not the case for some of your error types, use + `throwError_` for them. + - `ThrowError` operation from the dynamic version of the `Error` effect was + replaced with `ThrowErrorWith`. # effectful-core-2.3.1.0 (2024-06-07) * Drop support for GHC 8.8. diff --git a/effectful-core/src/Effectful/Error/Dynamic.hs b/effectful-core/src/Effectful/Error/Dynamic.hs index 69eb863..0e17e41 100644 --- a/effectful-core/src/Effectful/Error/Dynamic.hs +++ b/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@ and specify 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 = withFrozenCallStack 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_ = withFrozenCallStack throwErrorWith (const "") -- | Handle an error of type @e@. catchError diff --git a/effectful-core/src/Effectful/Error/Static.hs b/effectful-core/src/Effectful/Error/Static.hs index c73158b..efe5402 100644 --- a/effectful-core/src/Effectful/Error/Static.hs +++ b/effectful-core/src/Effectful/Error/Static.hs @@ -86,7 +86,9 @@ module Effectful.Error.Static , runErrorNoCallStackWith -- ** Operations + , throwErrorWith , throwError + , throwError_ , catchError , handleError , tryError @@ -162,15 +164,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@ and specify 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 = withFrozenCallStack 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_ = withFrozenCallStack throwErrorWith (const "") -- | Handle an error of type @e@. catchError @@ -223,21 +248,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 diff --git a/effectful-core/src/Effectful/Labeled/Error.hs b/effectful-core/src/Effectful/Labeled/Error.hs index fef8114..b42d80c 100644 --- a/effectful-core/src/Effectful/Labeled/Error.hs +++ b/effectful-core/src/Effectful/Labeled/Error.hs @@ -13,7 +13,9 @@ module Effectful.Labeled.Error , runErrorNoCallStackWith -- ** Operations + , throwErrorWith , throwError + , throwError_ , catchError , handleError , tryError @@ -68,14 +70,36 @@ runErrorNoCallStackWith -> Eff es a runErrorNoCallStackWith = runLabeled @label . E.runErrorNoCallStackWith --- | Throw an error of type @e@. +-- | Throw an error of type @e@ and specify a display function in case a +-- third-party code catches the internal exception and 'show's it. +throwErrorWith + :: forall label e es a + . (HasCallStack, Labeled label (Error e) :> es) + => (e -> String) + -- ^ The display function. + -> e + -- ^ The error. + -> Eff es a +throwErrorWith display = + withFrozenCallStack send . Labeled @label . ThrowErrorWith display + +-- | Throw an error of type @e@ with 'show' as a display function. throwError + :: forall label e es a + . (HasCallStack, Labeled label (Error e) :> es, Show e) + => e + -- ^ The error. + -> Eff es a +throwError = withFrozenCallStack (throwErrorWith @label) show + +-- | Throw an error of type @e@ with no display function. +throwError_ :: forall label e es a . (HasCallStack, Labeled label (Error e) :> es) => e -- ^ The error. -> Eff es a -throwError e = withFrozenCallStack $ send (Labeled @label $ ThrowError e) +throwError_ = withFrozenCallStack (throwErrorWith @label) (const "") -- | Handle an error of type @e@. catchError diff --git a/effectful-plugin/tests/PluginTests.hs b/effectful-plugin/tests/PluginTests.hs index 3a28bc0..7f46741 100644 --- a/effectful-plugin/tests/PluginTests.hs +++ b/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 diff --git a/effectful/CHANGELOG.md b/effectful/CHANGELOG.md index a56d466..2b7b6e7 100644 --- a/effectful/CHANGELOG.md +++ b/effectful/CHANGELOG.md @@ -6,8 +6,16 @@ * Improve `Effectful.Labeled`, add `Effectful.Labeled.Error`, `Effectful.Labeled.Reader`, `Effectful.Labeled.State` and `Effectful.Labeled.Writer`. -* **Breaking change**: `localSeqLend`, `localLend`, `localSeqBorrow` and - `localBorrow` now take a list of effects instead of a single one. +* Add `throwErrorWith` and `throwError_` to `Effectful.Error.Static` and + `Effectful.Error.Dynamic`. +* **Breaking changes**: + - `localSeqLend`, `localLend`, `localSeqBorrow` and `localBorrow` now take a + list of effects instead of a single one. + - `Effectful.Error.Static.throwError` now requires the error type to have a + `Show` constraint. If this is not the case for some of your error types, use + `throwError_` for them. + - `ThrowError` operation from the dynamic version of the `Error` effect was + replaced with `ThrowErrorWith`. # effectful-2.3.1.0 (2024-06-07) * Drop support for GHC 8.8.