@@ -62,6 +62,8 @@ module Control.Distributed.Process.Internal.Primitives
6262 , unStatic
6363 -- * Exception handling
6464 , catch
65+ , Handler(..)
66+ , catches
6567 , try
6668 , mask
6769 , onException
@@ -96,7 +98,7 @@ import Control.Monad (when)
9698import Control.Monad.Reader (ask)
9799import Control.Monad.IO.Class (MonadIO, liftIO)
98100import Control.Applicative ((<$>))
99−import Control.Exception (Exception, throwIO, SomeException)
101+import Control.Exception (Exception(..), throw, throwIO, SomeException)
100102import qualified Control.Exception as Ex (catch, mask, try)
101103import Control.Distributed.Process.Internal.StrictMVar
102104 ( StrictMVar
@@ -645,6 +647,23 @@ bracket_ before after thing = bracket before (const after) (const thing)
645647finally :: Process a -> Process b -> Process a
646648finally a sequel = bracket_ (return ()) sequel a
647649
650+-- | You need this when using 'catches'
651+data Handler a = forall e . Exception e => Handler (e -> Process a)
652+
653+instance Functor Handler where
654+ fmap f (Handler h) = Handler (fmap f . h)
655+
656+-- | Lift 'Control.Exception.catches'
657+catches :: Process a -> [Handler a] -> Process a
658+catches proc handlers = proc `catch` catchesHandler handlers
659+
660+catchesHandler :: [Handler a] -> SomeException -> Process a
661+catchesHandler handlers e = foldr tryHandler (throw e) handlers
662+ where tryHandler (Handler handler) res
663+ = case fromException e of
664+ Just e' -> handler e'
665+ Nothing -> res
666+
648667--------------------------------------------------------------------------------
649668-- Auxiliary API --
650669--------------------------------------------------------------------------------