Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Overload catches as well

  • Loading branch information...
commit 682cc3689b3a8d7e8c33728a2efa748d8aa6e6ef 1 parent b9f90bf
@norm2782 norm2782 authored
View
11 src/Snap/Internal/Instances.hs
@@ -81,3 +81,14 @@ instance (MonadSnap m, Monoid w) => MonadSnap (WriterT w m) where
------------------------------------------------------------------------------
instance (MonadSnap m, Monoid w) => MonadSnap (LWriter.WriterT w m) where
liftSnap = lift . liftSnap
+
+
+instance (Error e, MonadCatchControl m) => MonadCatchControl (ErrorT e m)
+instance (MonadCatchControl m) => MonadCatchControl (ListT m)
+instance (MonadCatchControl m) => MonadCatchControl (StateT s m)
+instance (MonadCatchControl m) => MonadCatchControl (ReaderT r m)
+instance (Monoid w, MonadCatchControl m) => MonadCatchControl (RWST r w s m)
+instance (Monoid w, MonadCatchControl m) => MonadCatchControl (LRWS.RWST r w s m)
+instance (Monoid w, MonadCatchControl m) => MonadCatchControl (WriterT w m)
+instance (Monoid w, MonadCatchControl m) => MonadCatchControl (LWriter.WriterT w m)
+
View
16 src/Snap/Internal/Types.hs
@@ -15,7 +15,7 @@ module Snap.Internal.Types where
import Blaze.ByteString.Builder
import Blaze.ByteString.Builder.Char.Utf8
import Control.Applicative
-import Control.Exception.Control hiding (catch)
+import Control.Exception.Control hiding (catch, catches)
import qualified Control.Exception.Control as CEC
import Control.Monad
import Control.Monad.IO.Control
@@ -126,8 +126,8 @@ transformers ('ReaderT', 'WriterT', 'StateT', etc.).
------------------------------------------------------------------------------
-- | 'MonadSnap' is a type class, analogous to 'MonadIO' for 'IO', that makes
-- it easy to wrap 'Snap' inside monad transformers.
-class (Monad m, MonadIO m, MonadControlIO m, MonadPlus m, Functor m,
- Applicative m, Alternative m) => MonadSnap m where
+class (Monad m, MonadIO m, MonadCatchControl m, MonadControlIO m, MonadPlus m,
+ Functor m, Applicative m, Alternative m) => MonadSnap m where
liftSnap :: Snap a -> m a
@@ -196,8 +196,12 @@ class (MonadControlIO m) => MonadCatchControl m where
-> m a
catch = CEC.catch
-instance (MonadCatchControl m) => MonadCatchControl (StateT s m)
+ catches :: m a -> [CEC.Handler m a] -> m a
+ catches = CEC.catches
+
instance (MonadCatchControl m) => MonadCatchControl (Iteratee a m)
+instance (MonadCatchControl m) => MonadCatchControl (StateT s m)
+
instance MonadCatchControl IO
instance MonadCatchControl Snap where
@@ -208,7 +212,9 @@ instance MonadCatchControl Snap where
maybe (throw e)
(\e' -> let (Snap z) = handler e' in z)
(fromException e)
-
+ catches a handlers = a `catch` handler where
+ handler e = foldr tryH (throw e) handlers where
+ tryH (CEC.Handler h) res = maybe res h $ fromException e
------------------------------------------------------------------------------
rethrowIfTermination :: (MonadIO m) =>
View
2  src/Snap/Util/FileUploads.hs
@@ -67,7 +67,7 @@ module Snap.Util.FileUploads
import Control.Arrow
import Control.Applicative
import Control.Concurrent.MVar
-import Control.Exception.Control hiding (catch)
+import Control.Exception.Control hiding (catch, catches)
import Control.Monad
import Control.Monad.IO.Control
import Control.Monad.Trans
Please sign in to comment.
Something went wrong with that request. Please try again.