@@ -43,8 +43,14 @@ module Control.Distributed.Process.Internal.Primitives
4343 , nsendRemote
4444 -- * Closures
4545 , unClosure
46− -- * Auxiliary API
46+ -- * Exception handling
4747 , catch
48+ , mask
49+ , onException
50+ , bracket
51+ , bracket_
52+ , finally
53+ -- * Auxiliary API
4854 , expectTimeout
4955 , spawnAsync
5056 , linkNode
@@ -67,8 +73,8 @@ import System.Locale (defaultTimeLocale)
6773import Control.Monad.Reader (ask)
6874import Control.Monad.IO.Class (MonadIO, liftIO)
6975import Control.Applicative ((<$>))
70−import Control.Exception (Exception, throw)
71−import qualified Control.Exception as Ex (catch)
76+import Control.Exception (Exception, throw, throwIO, SomeException)
77+import qualified Control.Exception as Ex (catch, mask)
7278import Control.Concurrent.MVar (modifyMVar)
7379import Control.Concurrent.Chan (writeChan)
7480import Control.Concurrent.STM
@@ -258,7 +264,7 @@ instance Exception ProcessTerminationException
258264
259265-- | Terminate (throws a ProcessTerminationException)
260266terminate :: Process a
261−terminate = liftIO $ throw ProcessTerminationException
267+terminate = liftIO $ throwIO ProcessTerminationException
262268
263269-- | Our own process ID
264270getSelfPid :: Process ProcessId
@@ -317,15 +323,51 @@ unmonitor ref = do
317323 ]
318324
319325--------------------------------------------------------------------------------
320−-- Auxiliary API --
326+-- Exception handling --
321327--------------------------------------------------------------------------------
322328
323−-- | Catch exceptions within a process
329+-- | Lift 'Control.Exception.catch'
324330catch :: Exception e => Process a -> (e -> Process a) -> Process a
325331catch p h = do
326332 lproc <- ask
327333 liftIO $ Ex.catch (runLocalProcess lproc p) (runLocalProcess lproc . h)
328334
335+-- | Lift 'Control.Exception.mask'
336+mask :: ((forall a. Process a -> Process a) -> Process b) -> Process b
337+mask p = do
338+ lproc <- ask
339+ liftIO $ Ex.mask $ \restore ->
340+ runLocalProcess lproc (p (liftRestore lproc restore))
341+ where
342+ liftRestore :: LocalProcess -> (forall a. IO a -> IO a) -> (forall a. Process a -> Process a)
343+ liftRestore lproc restoreIO = liftIO . restoreIO . runLocalProcess lproc
344+
345+-- | Lift 'Control.Exception.onException'
346+onException :: Process a -> Process b -> Process a
347+onException p what = p `catch` \e -> do _ <- what
348+ liftIO $ throwIO (e :: SomeException)
349+
350+-- | Lift 'Control.Exception.bracket'
351+bracket :: Process a -> (a -> Process b) -> (a -> Process c) -> Process c
352+bracket before after thing = do
353+ mask $ \restore -> do
354+ a <- before
355+ r <- restore (thing a) `onException` after a
356+ _ <- after a
357+ return r
358+
359+-- | Lift 'Control.Exception.bracket_'
360+bracket_ :: Process a -> Process b -> Process c -> Process c
361+bracket_ before after thing = bracket before (const after) (const thing)
362+
363+-- | Lift 'Control.Exception.finally'
364+finally :: Process a -> Process b -> Process a
365+finally a sequel = bracket_ (return ()) sequel a
366+
367+--------------------------------------------------------------------------------
368+-- Auxiliary API --
369+--------------------------------------------------------------------------------
370+
329371-- | Like 'expect' but with a timeout
330372expectTimeout :: forall a. Serializable a => Int -> Process (Maybe a)
331373expectTimeout timeout = receiveTimeout timeout [match return]
@@ -464,7 +506,7 @@ unClosure :: forall a. Typeable a => Closure a -> Process a
464506unClosure (Closure (Static label) env) = do
465507 rtable <- remoteTable . processNode <$> ask
466508 case resolveClosure rtable label env of
467− Nothing -> throw . userError $ "Unregistered closure " ++ show label
509+ Nothing -> error $ "Unregistered closure " ++ show label
468510 Just dyn -> return $ fromDyn dyn (throw (typeError dyn))
469511 where
470512 typeError dyn = userError $ "lookupStatic type error: "