@@ -137,7 +137,10 @@ import Control.Distributed.Process.Internal.Messaging
137137 , closeImplicitReconnections
138138 , impliesDeathOf
139139 )
140−import Control.Distributed.Process.Internal.Primitives (expect, register, finally)
140+import Control.Distributed.Process.Internal.Primitives
141+ (register, finally, receiveWait, match, sendChan)
142+import Control.Distributed.Process.Internal.Types
143+ (SendPort)
141144import qualified Control.Distributed.Process.Internal.Closure.BuiltIn as BuiltIn (remoteTable)
142145import Control.Distributed.Process.Internal.WeakTQueue (writeTQueue)
143146import qualified Control.Distributed.Process.Internal.StrictContainerAccessors as DAC
@@ -193,10 +196,17 @@ forever' a = let a' = a >> a' in a'
193196-- (for now, this is only the logger)
194197startServiceProcesses :: LocalNode -> IO ()
195198startServiceProcesses node = do
196− logger <- forkProcess node . forever' $ do
197− (time, pid, string) <- expect :: Process (String, ProcessId, String)
198− liftIO . hPutStrLn stderr $ time ++ " " ++ show pid ++ ": " ++ string
199+ logger <- forkProcess node loop
199200 runProcess node $ register "logger" logger
201+ where
202+ loop = do
203+ receiveWait
204+ [ match $ \((time, pid, string) ::(String, ProcessId, String)) -> do
205+ liftIO . hPutStrLn stderr $ time ++ " " ++ show pid ++ ": " ++ string
206+ loop
207+ , match $ \(ch :: SendPort ()) -> -- a shutdown request
208+ sendChan ch ()
209+ ]
200210
201211-- | Force-close a local node
202212--