@@ -8,21 +8,25 @@
88-- semantics are based on /A unified semantics for future Erlang/ by Hans
99-- Svensson, Lars-Åke Fredlund and Clara Benac Earle.
1010module Control.Distributed.Process
11− ( -- * Basic cloud Haskell API
11+ ( -- * Basic types
1212 ProcessId
1313 , NodeId
1414 , Process
15− , expect
15+ -- * Basic messaging
1616 , send
17− , getSelfPid
18− , spawn
19− -- * Matching messages
17+ , expect
18+ -- * Advanced messaging
2019 , Match
20+ , receiveWait
21+ , receiveTimeout
2122 , match
2223 , matchIf
2324 , matchUnknown
24− , receiveWait
25− , receiveTimeout
25+ -- * Process management
26+ , spawn
27+ , SpawnRef
28+ , getSelfPid
29+ , getSelfNode
2630 -- * Monitoring and linking
2731 , link
2832 , unlink
@@ -153,57 +157,42 @@ import Control.Distributed.Process.Internal.MessageT
153157-- http://erlang.org/pipermail/erlang-questions/2012-February/064767.html
154158
155159--------------------------------------------------------------------------------
156−-- Basic Cloud Haskell API --
160+-- Basic messaging --
157161--------------------------------------------------------------------------------
158162
159−-- | Wait for a message of a specific type
160−expect :: forall a. Serializable a => Process a
161−expect = receiveWait [match return]
162−
163163-- | Send a message
164164send :: Serializable a => ProcessId -> a -> Process ()
165165-- This requires a lookup on every send. If we want to avoid that we need to
166166-- modify serializable to allow for stateful (IO) deserialization
167167send them msg = lift $ sendMessage (Left them) msg
168168
169−-- | Our own process ID
170−getSelfPid :: Process ProcessId
171−getSelfPid = processId <$> ask
172−
173−-- | Monitor another process
174−monitor :: ProcessId -> Process MonitorRef
175−monitor them = do
176− monitorRef <- getMonitorRefFor them
177− sendCtrlMsg Nothing $ Monitor them monitorRef
178− return monitorRef
179−
180−-- | Link to a remote process
181−link :: ProcessId -> Process ()
182−link = sendCtrlMsg Nothing . Link
183−
184−-- | Remove a monitor
185−unmonitor :: MonitorRef -> Process ()
186−unmonitor = sendCtrlMsg Nothing . Unmonitor
187−
188−-- | Remove a link
189−unlink :: ProcessId -> Process ()
190−unlink = sendCtrlMsg Nothing . Unlink
169+-- | Wait for a message of a specific type
170+expect :: forall a. Serializable a => Process a
171+expect = receiveWait [match return]
191172
192−-- | Spawn a process
193−spawn :: NodeId -> Closure (Process ()) -> Process ProcessId
194−spawn nid proc = do
195− ref <- spawnAsync nid proc
196− receiveWait [ matchIf (\(DidSpawn ref' _) -> ref == ref')
197− (\(DidSpawn _ pid) -> return pid)
198− ]
199−
200173--------------------------------------------------------------------------------
201−-- Matching --
174+-- Advanced messaging --
202175--------------------------------------------------------------------------------
203176
204177-- | Opaque type used in 'receiveWait' and 'receiveTimeout'
205178newtype Match b = Match { unMatch :: Message -> Maybe (Process b) }
206179
180+-- | Test the matches in order against each message in the queue
181+receiveWait :: [Match b] -> Process b
182+receiveWait ms = do
183+ queue <- processQueue <$> ask
184+ Just proc <- liftIO $ dequeue queue Nothing (map unMatch ms)
185+ proc
186+
187+-- | Like 'receiveWait' but with a timeout
188+receiveTimeout :: Int -> [Match b] -> Process (Maybe b)
189+receiveTimeout t ms = do
190+ queue <- processQueue <$> ask
191+ mProc <- liftIO $ dequeue queue (Just t) (map unMatch ms)
192+ case mProc of
193+ Nothing -> return Nothing
194+ Just proc -> Just <$> proc
195+
207196-- | Match against any message of the right type
208197match :: forall a b. Serializable a => (a -> Process b) -> Match b
209198match = matchIf (const True)
@@ -214,28 +203,55 @@ matchIf c p = Match $ \msg ->
214203 let decoded :: a
215204 decoded = decode . messageEncoding $ msg in
216205 if messageFingerprint msg == fingerprint (undefined :: a) && c decoded
217− then Just . p . decode . messageEncoding $ msg
206+ then Just $ p decoded
218207 else Nothing
219208
220209-- | Remove any message from the queue
221210matchUnknown :: Process b -> Match b
222211matchUnknown = Match . const . Just
223212
224−-- | Test the matches in order against each message in the queue
225−receiveWait :: [Match b] -> Process b
226−receiveWait ms = do
227− queue <- processQueue <$> ask
228− Just proc <- liftIO $ dequeue queue Nothing (map unMatch ms)
229− proc
213+--------------------------------------------------------------------------------
214+-- Process management --
215+--------------------------------------------------------------------------------
230216
231−-- | Like 'receiveWait' but with a timeout
232−receiveTimeout :: Int -> [Match b] -> Process (Maybe b)
233−receiveTimeout t ms = do
234− queue <- processQueue <$> ask
235− mProc <- liftIO $ dequeue queue (Just t) (map unMatch ms)
236− case mProc of
237− Nothing -> return Nothing
238− Just proc -> Just <$> proc
217+-- | Spawn a process
218+spawn :: NodeId -> Closure (Process ()) -> Process ProcessId
219+spawn nid proc = do
220+ ref <- spawnAsync nid proc
221+ receiveWait [ matchIf (\(DidSpawn ref' _) -> ref == ref')
222+ (\(DidSpawn _ pid) -> return pid)
223+ ]
224+
225+-- | Our own process ID
226+getSelfPid :: Process ProcessId
227+getSelfPid = processId <$> ask
228+
229+-- | Get the node ID of our local node
230+getSelfNode :: Process NodeId
231+getSelfNode = localNodeId <$> lift getLocalNode
232+
233+--------------------------------------------------------------------------------
234+-- Monitoring and linking --
235+--------------------------------------------------------------------------------
236+
237+-- | Link to a remote process
238+link :: ProcessId -> Process ()
239+link = sendCtrlMsg Nothing . Link
240+
241+-- | Remove a link
242+unlink :: ProcessId -> Process ()
243+unlink = sendCtrlMsg Nothing . Unlink
244+
245+-- | Monitor another process
246+monitor :: ProcessId -> Process MonitorRef
247+monitor them = do
248+ monitorRef <- getMonitorRefFor them
249+ sendCtrlMsg Nothing $ Monitor them monitorRef
250+ return monitorRef
251+
252+-- | Remove a monitor
253+unmonitor :: MonitorRef -> Process ()
254+unmonitor = sendCtrlMsg Nothing . Unmonitor
239255
240256--------------------------------------------------------------------------------
241257-- Closures --