do not wrap exceptions when rethrowing

freckle-exception/CHANGELOG.md

@@ -1,4 +1,15 @@
-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-exception-v0.0.0.0...main)
+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-exception-v0.1.0.0...main)
+
+## [v0.1.0.0](https://github.com/freckle/freckle-app/compare/freckle-exception-v0.0.0.0...freckle-exception-v0.1.0.0)
+
+Adjustment to the behavior of `catchJust`, `tryJust`, and `withException`:
+Previously, if any of these utilities would catch and then rethrow an exception,
+the exception would always be wrapped in `AnnotatedException` when rethrown.
+Now any rethrown exceptions are rethrown exactly as they were caught.
+
+The `HasCallStack` constraint has been removed from all of these functions, as they
+now never construct or modify any exceptions and therefore have no reason to access
+the call stack.
 
 ## [v0.0.0.0](https://github.com/freckle/freckle-app/tree/freckle-exception-v0.0.0.0/freckle-exception)
 

freckle-exception/freckle-exception.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.18
 -- see: https://github.com/sol/hpack
 
 name:           freckle-exception
-version:        0.0.0.0
+version:        0.1.0.0
 synopsis:       Some extensions to the annotated-exception library
 description:    Please see README.md
 category:       Exceptions

freckle-exception/library/Freckle/App/Exception/MonadThrow.hs

@@ -61,14 +61,19 @@ catch action handler = withFrozenCallStack $ Annotated.catch action handler
 
 catchJust
   :: forall e b m a
-   . (Exception e, MonadCatch m, HasCallStack)
+   . (Exception e, MonadCatch m)
   => (e -> Maybe b)
   -> m a
   -> (b -> m a)
   -> m a
 catchJust test action handler =
-  withFrozenCallStack $ Annotated.catch action $ \e ->
-    maybe (Control.Monad.Catch.throwM e) handler (test e)
+  Control.Monad.Catch.catches
+    action
+    [ Control.Monad.Catch.Handler $ \caught ->
+        maybe (Control.Monad.Catch.throwM caught) handler (test caught)
+    , Control.Monad.Catch.Handler $ \caught@(AnnotatedException _ unwrapped) ->
+        maybe (Control.Monad.Catch.throwM caught) handler (test unwrapped)
+    ]
 
 catches
   :: forall m a
@@ -97,25 +102,38 @@ try action = withFrozenCallStack $ Annotated.try action
 
 tryJust
   :: forall e b m a
-   . (Exception e, MonadCatch m, HasCallStack)
+   . (Exception e, MonadCatch m)
   => (e -> Maybe b)
   -> m a
   -- ^ Action to run
   -> m (Either b a)
 tryJust test action =
-  withFrozenCallStack $ Annotated.catch (Right <$> action) $ \e ->
-    maybe (Control.Monad.Catch.throwM e) (pure . Left) (test e)
+  withFrozenCallStack $
+    Control.Monad.Catch.catches
+      (Right <$> action)
+      [ Control.Monad.Catch.Handler $ \caught ->
+          maybe (Control.Monad.Catch.throwM caught) (pure . Left) (test caught)
+      , Control.Monad.Catch.Handler $ \caught@(AnnotatedException _ unwrapped) ->
+          maybe (Control.Monad.Catch.throwM caught) (pure . Left) (test unwrapped)
+      ]
 
 withException
   :: forall e a m b
-   . (Exception e, MonadCatch m, HasCallStack)
+   . (Exception e, MonadCatch m)
   => m a
   -> (e -> m b)
   -> m a
 withException action onException =
-  withFrozenCallStack $ Annotated.catch action $ \e -> do
-    void $ onException e
-    Control.Monad.Catch.throwM e
+  withFrozenCallStack $
+    Control.Monad.Catch.catches
+      action
+      [ Control.Monad.Catch.Handler $ \caught -> do
+          void $ onException caught
+          Control.Monad.Catch.throwM caught
+      , Control.Monad.Catch.Handler $ \caught@(AnnotatedException _ unwrapped) -> do
+          void $ onException unwrapped
+          Control.Monad.Catch.throwM caught
+      ]
 
 -- | When dealing with a library that does not use 'AnnotatedException',
 --   apply this function to augment its exceptions with call stacks.

freckle-exception/library/Freckle/App/Exception/MonadUnliftIO.hs

@@ -62,14 +62,23 @@ catch action handler = withFrozenCallStack $ Annotated.catch action handler
 
 catchJust
   :: forall e b m a
-   . (Exception e, MonadUnliftIO m, HasCallStack)
+   . (Exception e, MonadUnliftIO m)
   => (e -> Maybe b)
   -> m a
   -> (b -> m a)
   -> m a
 catchJust test action handler =
-  withFrozenCallStack $ Annotated.catch action $ \e ->
-    maybe (UnliftIO.Exception.throwIO e) handler (test e)
+  withFrozenCallStack $
+    UnliftIO.Exception.catches
+      action
+      [ UnliftIO.Exception.Handler $ \caught ->
+          maybe (UnliftIO.Exception.throwIO caught) handler (test caught)
+      , UnliftIO.Exception.Handler $ \caught@(AnnotatedException _ unwrapped) ->
+          maybe (UnliftIO.Exception.throwIO caught) handler (test unwrapped)
+      ]
+
+-- action $ \e ->
+--   maybe (UnliftIO.Exception.throwIO e) handler (test e)
 
 catches
   :: forall m a
@@ -98,25 +107,38 @@ try = withFrozenCallStack Annotated.try
 
 tryJust
   :: forall e b m a
-   . (Exception e, MonadUnliftIO m, HasCallStack)
+   . (Exception e, MonadUnliftIO m)
   => (e -> Maybe b)
   -> m a
   -- ^ Action to run
   -> m (Either b a)
 tryJust test action =
-  withFrozenCallStack $ Annotated.catch (Right <$> action) $ \e ->
-    maybe (UnliftIO.Exception.throwIO e) (pure . Left) (test e)
+  withFrozenCallStack $
+    UnliftIO.Exception.catches
+      (Right <$> action)
+      [ UnliftIO.Exception.Handler $ \caught ->
+          maybe (UnliftIO.Exception.throwIO caught) (pure . Left) (test caught)
+      , UnliftIO.Exception.Handler $ \caught@(AnnotatedException _ unwrapped) ->
+          maybe (UnliftIO.Exception.throwIO caught) (pure . Left) (test unwrapped)
+      ]
 
 withException
   :: forall e a m b
-   . (Exception e, MonadUnliftIO m, HasCallStack)
+   . (Exception e, MonadUnliftIO m)
   => m a
   -> (e -> m b)
   -> m a
 withException action onException =
-  withFrozenCallStack $ Annotated.catch action $ \e -> do
-    void $ onException e
-    UnliftIO.Exception.throwIO e
+  withFrozenCallStack $
+    UnliftIO.Exception.catches
+      action
+      [ UnliftIO.Exception.Handler $ \caught -> do
+          void $ onException caught
+          UnliftIO.Exception.throwIO caught
+      , UnliftIO.Exception.Handler $ \caught@(AnnotatedException _ unwrapped) -> do
+          void $ onException unwrapped
+          UnliftIO.Exception.throwIO caught
+      ]
 
 -- | When dealing with a library that does not use 'AnnotatedException',
 --   apply this function to augment its exceptions with call stacks.

freckle-exception/package.yaml

@@ -1,5 +1,5 @@
 name: freckle-exception
-version: 0.0.0.0
+version: 0.1.0.0
 maintainer: Freckle Education
 category: Exceptions
 github: freckle/freckle-app