From 134aec9af641e8885858d69011628fb04aef30a3 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Fri, 17 Jun 2016 11:19:24 +0300
Subject: [PATCH] Add instances for MonadCatch and MonadMask for Either

Came up in a discussion with @bitonic. There's no downside I can see to
the MonadCatch instance. However, the MonadMask instance is a little bit
more controversial, in that it's not actually doing any masking.
However, it's impossible to know that it's not masking the async
exceptions since there are no side-effects from the Either monad.

Of course, by using unsafePerformIO, we could observe the difference,
but I think that's a valid trade-off.

One final argument against MonadMask for Either: it's probably not
terribly useful.
---
 CHANGELOG.markdown         |  4 ++++
 exceptions.cabal           |  2 +-
 src/Control/Monad/Catch.hs | 16 ++++++++++++++--
 3 files changed, 19 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index 7f3989e..d314d42 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,7 @@
+0.8.3
+-----
+* `MonadCatch` and `MonadMask` instances for `Either SomeException`
+
 0.8.1
 -----
 * Support for throwing in the `template-haskell` `Q` monad
diff --git a/exceptions.cabal b/exceptions.cabal
index c7c51e5..9c34a9d 100644
--- a/exceptions.cabal
+++ b/exceptions.cabal
@@ -1,6 +1,6 @@
 name:          exceptions
 category:      Control, Exceptions, Monad
-version:       0.8.2.1
+version:       0.8.3
 cabal-version: >= 1.8
 license:       BSD3
 license-file:  LICENSE
diff --git a/src/Control/Monad/Catch.hs b/src/Control/Monad/Catch.hs
index 4d01444..546876c 100644
--- a/src/Control/Monad/Catch.hs
+++ b/src/Control/Monad/Catch.hs
@@ -183,8 +183,6 @@ instance MonadThrow [] where
   throwM _ = []
 instance MonadThrow Maybe where
   throwM _ = Nothing
-instance e ~ SomeException => MonadThrow (Either e) where
-  throwM = Left . toException
 instance MonadThrow Q where
   throwM = fail . show
 
@@ -201,6 +199,20 @@ instance MonadThrow STM where
 instance MonadCatch STM where
   catch = STM.catchSTM
 
+instance e ~ SomeException => MonadThrow (Either e) where
+  throwM = Left . toException
+-- | @since 0.8.3
+instance e ~ SomeException => MonadCatch (Either e) where
+  catch (Left e) f =
+    case fromException e of
+      Nothing -> Left e
+      Just e' -> f e'
+  catch x@(Right _) _ = x
+-- | @since 0.8.3
+instance e ~ SomeException => MonadMask (Either e) where
+  mask f = f id
+  uninterruptibleMask f = f id
+
 instance MonadThrow m => MonadThrow (IdentityT m) where
   throwM e = lift $ throwM e
 instance MonadCatch m => MonadCatch (IdentityT m) where
-- 
GitLab