@@ -50,12 +50,18 @@
5050-- [4] "Delivery of Messages", post on erlang-questions
5151-- http://erlang.org/pipermail/erlang-questions/2012-February/064767.html
5252module Control.Distributed.Process
53− ( -- * Cloud Haskell API
53+ ( -- * Basic cloud Haskell API
5454 ProcessId
5555 , Process
5656 , expect
5757 , send
5858 , getSelfPid
59+ , monitorProcess
60+ , linkProcess
61+ -- * Monitoring
62+ , MonitorAction(..)
63+ , ProcessMonitorException(..)
64+ , SignalReason(..)
5965 -- * Initialization
6066 , newLocalNode
6167 , forkProcess
@@ -68,18 +74,18 @@ import qualified Data.ByteString.Lazy as BSL ( ByteString
6874 , fromChunks
6975 , splitAt
7076 )
71−import Data.Binary (Binary, decode, encode, put, get)
77+import Data.Binary (Binary, decode, encode, put, get, getWord8, putWord8)
7278import Data.Map (Map)
7379import qualified Data.Map as Map (empty, lookup, insert, delete)
7480import qualified Data.List as List (delete)
7581import Data.Int (Int32)
7682import Data.Typeable (Typeable)
77−import Control.Monad (void, liftM2)
83+import Control.Monad (void, liftM, liftM2)
7884import Control.Monad.Reader (MonadReader(..), ReaderT, runReaderT)
7985import Control.Monad.IO.Class (MonadIO, liftIO)
8086import Control.Applicative ((<$>))
8187import Control.Category ((>>>))
82−import Control.Exception (throwIO)
88+import Control.Exception (Exception, throwIO)
8389import Control.Concurrent (forkIO)
8490import Control.Concurrent.MVar ( MVar
8591 , newMVar
@@ -168,7 +174,7 @@ newtype Process a = Process { unProcess :: ReaderT ProcessState IO a }
168174 deriving (Functor, Monad, MonadIO, MonadReader ProcessState)
169175
170176--------------------------------------------------------------------------------
171−-- Cloud Haskell API --
177+-- Basic Cloud Haskell API --
172178--------------------------------------------------------------------------------
173179
174180expect :: forall a. Serializable a => Process a
@@ -192,6 +198,100 @@ send pid msg = do
192198getSelfPid :: Process ProcessId
193199getSelfPid = processId <$> ask
194200
201+monitorProcess :: ProcessId -> ProcessId -> MonitorAction -> Process ()
202+monitorProcess = undefined
203+
204+linkProcess :: ProcessId -> Process ()
205+linkProcess = undefined
206+
207+--------------------------------------------------------------------------------
208+-- Monitoring --
209+-- --
210+-- TODO: Many of these definitions are not available in the paper, and are --
211+-- taken from 'remote'. Do we want to stick to them precisely? --
212+--------------------------------------------------------------------------------
213+
214+-- | The different kinds of monitoring available between processes.
215+data MonitorAction =
216+ -- ^ MaMonitor means that the monitor process will be sent a
217+ -- ProcessMonitorException message when the monitee terminates for any
218+ -- reason.
219+ MaMonitor
220+ -- ^ MaLink means that the monitor process will receive an asynchronous
221+ -- exception of type ProcessMonitorException when the monitee terminates
222+ -- for any reason
223+ | MaLink
224+ -- ^ MaLinkError means that the monitor process will receive an
225+ -- asynchronous exception of type ProcessMonitorException when the monitee
226+ -- terminates abnormally
227+ | MaLinkError
228+ deriving (Typeable, Show, Ord, Eq)
229+
230+-- | The main form of notification to a monitoring process that a monitored
231+-- process has terminated. This data structure can be delivered to the monitor
232+-- either as a message (if the monitor is of type 'MaMonitor') or as an
233+-- asynchronous exception (if the monitor is of type 'MaLink' or
234+-- 'MaLinkError'). It contains the PID of the monitored process and the reason
235+-- for its nofication.
236+data ProcessMonitorException = ProcessMonitorException ProcessId SignalReason
237+ deriving (Typeable)
238+
239+-- | Part of the notification system of process monitoring, indicating why the
240+-- monitor is being notified.
241+data SignalReason =
242+ -- ^ the monitee terminated normally
243+ SrNormal
244+ -- ^ the monitee terminated with an uncaught exception, which is given as a
245+ -- string
246+ | SrException String
247+ -- ^ the monitee is believed to have ended or be inaccessible, as the node
248+ -- on which its running is not responding to pings. This may indicate a
249+ -- network bisection or that the remote node has crashed.
250+ | SrNoPing
251+ -- ^ SrInvalid: the monitee was not running at the time of the attempt to
252+ -- establish monitoring
253+ | SrInvalid
254+ deriving (Typeable,Show)
255+
256+instance Binary MonitorAction where
257+ put MaMonitor = putWord8 0
258+ put MaLink = putWord8 1
259+ put MaLinkError = putWord8 2
260+
261+ get = do x <- getWord8
262+ case x of
263+ 0 -> return MaMonitor
264+ 1 -> return MaLink
265+ 2 -> return MaLinkError
266+ _ -> fail "Invalid MonitorAction"
267+
268+instance Binary ProcessMonitorException where
269+ put (ProcessMonitorException pid sr) = put pid >> put sr
270+ get = liftM2 ProcessMonitorException get get
271+
272+instance Binary SignalReason where
273+ put SrNormal = putWord8 0
274+ put (SrException s) = putWord8 1 >> put s
275+ put SrNoPing = putWord8 2
276+ put SrInvalid = putWord8 3
277+
278+ get = do a <- getWord8
279+ case a of
280+ 0 -> return SrNormal
281+ 1 -> liftM SrException get
282+ 2 -> return SrNoPing
283+ 3 -> return SrInvalid
284+ _ -> fail "Invalid SignalReason"
285+
286+instance Exception ProcessMonitorException
287+
288+instance Show ProcessMonitorException where
289+ show (ProcessMonitorException pid why) =
290+ "ProcessMonitorException: "
291+ ++ show pid
292+ ++ " has terminated because "
293+ ++ show why
294+
195295--------------------------------------------------------------------------------
196296-- Initialization --
197297--------------------------------------------------------------------------------