@@ -69,6 +69,7 @@ module Control.Distributed.Process
6969 , Match
7070 , match
7171 , matchIf
72+ , matchUnknown
7273 , receiveWait
7374 , receiveTimeout
7475 -- * Monitoring and linking
@@ -122,10 +123,7 @@ import Control.Concurrent.MVar ( newMVar
122123 )
123124import Control.Concurrent.Chan (newChan, writeChan)
124125import Control.Distributed.Process.Internal.CQueue (enqueue, dequeue, newCQueue)
125−import Control.Distributed.Process.Serializable ( Serializable
126− , Fingerprint
127− , fingerprint
128− )
126+import Control.Distributed.Process.Serializable (Serializable, fingerprint)
129127import qualified Network.Transport as NT ( Transport
130128 , EndPoint
131129 , Connection
@@ -223,42 +221,42 @@ unlink = postCtrlMsg . Unlink
223221-- Matching --
224222--------------------------------------------------------------------------------
225223
226−data Match b =
227− forall a. Serializable a => Match Fingerprint (a -> Process b)
228− | forall a. Serializable a => MatchIf Fingerprint (a -> Bool) (a -> Process b)
224+-- | Opaque type used in 'receiveWait' and 'receiveTimeout'
225+newtype Match b = Match { unMatch :: Message -> Maybe (Process b) }
229226
227+-- | Match against any message of the right type
230228match :: forall a b. Serializable a => (a -> Process b) -> Match b
231−match = Match (fingerprint (undefined :: a))
229+match = matchIf (const True)
232230
231+-- | Match against any message of the right type that satisfies a predicate
233232matchIf :: forall a b. Serializable a => (a -> Bool) -> (a -> Process b) -> Match b
234−matchIf = MatchIf (fingerprint (undefined :: a))
233+matchIf c p = Match $ \msg ->
234+ let decoded :: a
235+ decoded = decode . messageEncoding $ msg in
236+ if messageFingerprint msg == fingerprint (undefined :: a) && c decoded
237+ then Just . p . decode . messageEncoding $ msg
238+ else Nothing
239+
240+-- | Remove any message from the queue
241+matchUnknown :: Process b -> Match b
242+matchUnknown = Match . const . Just
235243
244+-- | Test the matches in order against each message in the queue
236245receiveWait :: [Match b] -> Process b
237246receiveWait ms = do
238247 queue <- processQueue <$> ask
239− Just proc <- liftIO $ dequeue queue Nothing (map evalMatch ms)
248+ Just proc <- liftIO $ dequeue queue Nothing (map unMatch ms)
240249 proc
241250
251+-- | Like 'receiveWait' but with a timeout
242252receiveTimeout :: Int -> [Match b] -> Process (Maybe b)
243253receiveTimeout t ms = do
244254 queue <- processQueue <$> ask
245− mProc <- liftIO $ dequeue queue (Just t) (map evalMatch ms)
255+ mProc <- liftIO $ dequeue queue (Just t) (map unMatch ms)
246256 case mProc of
247257 Nothing -> return Nothing
248258 Just proc -> Just <$> proc
249259
250−evalMatch :: Match b -> Message -> Maybe (Process b)
251−evalMatch (Match fp proc) msg =
252− let decoded = decode . messageEncoding $ msg in
253− if messageFingerprint msg == fp
254− then Just . proc $ decoded
255− else Nothing
256−evalMatch (MatchIf fp cond proc) msg =
257− let decoded = decode . messageEncoding $ msg in
258− if messageFingerprint msg == fp && cond decoded
259− then Just . proc $ decoded
260− else Nothing
261−
262260--------------------------------------------------------------------------------
263261-- Auxiliary API --
264262--------------------------------------------------------------------------------