Merge pull request #167 from sjshuck/on-error

Add Control.Monad.Error.Class.onError

Author: sjshuck

Control/Monad/Error/Class.hs

@@ -48,6 +48,7 @@ module Control.Monad.Error.Class (
     tryError,
     withError,
     handleError,
+    onError,
     mapError,
     modifyError,
   ) where
@@ -72,9 +73,9 @@ import qualified Control.Monad.Trans.RWS.CPS as CPSRWS
 import qualified Control.Monad.Trans.Writer.CPS as CPSWriter
 import Control.Monad.Trans.Class (lift)
 import Control.Exception (IOException, catch, ioError)
-import Control.Monad (Monad)
+import Control.Monad (Monad ((>>=), (>>)))
 import Data.Monoid (Monoid)
-import Prelude (Either (Left, Right), Maybe (Nothing), either, flip, (.), IO, pure, (<$>), (>>=))
+import Prelude (Either (Left, Right), Maybe (Nothing), either, flip, (.), IO, pure, (<$>))
 
 {- |
 The strategy of combining computations that can throw exceptions
@@ -227,6 +228,14 @@ withError f = handleError (throwError . f)
 handleError :: MonadError e m => (e -> m a) -> m a -> m a
 handleError = flip catchError
 
+-- | If an action throws an error, run a second action and rethrow the error.
+-- If the second action also throws an error, it takes precedence.  Do not run
+-- the second action at all if the first succeeds.
+--
+-- @since 2.3.2
+onError :: MonadError e m => m a -> m b -> m a
+onError action1 action2 = action1 `catchError` \e -> action2 >> throwError e
+
 -- | 'MonadError' analogue of the 'mapExceptT' function.  The
 -- computation is unwrapped, a function is applied to the @Either@, and
 -- the result is lifted into the second 'MonadError' instance.

Control/Monad/Except.hs

@@ -41,6 +41,7 @@ module Control.Monad.Except
     Error.tryError,
     Error.withError,
     Error.handleError,
+    Error.onError,
     Error.mapError,
     Error.modifyError,
     -- * The ExceptT monad transformer