205fc8b · distributed-process

git.iko.soy/distributed-process

on master help sign in

Pass on registration trace events to clients

205fc8bTim Watson14 years ago

src/Control/Distributed/Process/Internal/Trace/Tracer.hs+8−4

compare with master

unifiedsplit

@@ -257,18 +257,22 @@ applyTraceFlags :: TraceFlags -> TracerState -> Process TracerState

257applyTraceFlags flags' state = return state { flags = flags' }

258

259handleTrace :: TracerState -> Message -> TraceEvent -> Process TracerState

260−handleTrace st _ (TraceEvRegistered p n) =

260+handleTrace st msg ev@(TraceEvRegistered p n) =

261 let regNames' =

262 Map.insertWith (\_ ns -> Set.insert n ns) p

263 (Set.singleton n)

264 (regNames st)

265+ in do

266+ traceEv ev msg (traceRegistered (flags st)) st

265− in return st { regNames = regNames' }

267+ return st { regNames = regNames' }

266−handleTrace st _ (TraceEvUnRegistered p n) =

268+handleTrace st msg ev@(TraceEvUnRegistered p n) =

267 let f ns = case ns of

269 let f ns = case ns of

268 Nothing -> Nothing

270 Nothing -> Nothing

269 Just ns' -> Just (Set.delete n ns')

271 Just ns' -> Just (Set.delete n ns')

270 regNames' = Map.alter f p (regNames st)

272 regNames' = Map.alter f p (regNames st)

273+ in do

274+ traceEv ev msg (traceRegistered (flags st)) st

271− in return st { regNames = regNames' }

275+ return st { regNames = regNames' }

272handleTrace st msg ev@(TraceEvSpawned _) = do

276handleTrace st msg ev@(TraceEvSpawned _) = do

273 traceEv ev msg (traceSpawned (flags st)) st >> return st

277 traceEv ev msg (traceSpawned (flags st)) st >> return st

274handleTrace st msg ev@(TraceEvDied _ _) = do

278handleTrace st msg ev@(TraceEvDied _ _) = do

src/Control/Distributed/Process/Internal/Trace/Types.hs+4−2

@@ -91,6 +91,7 @@ data TraceSubject =

91data TraceFlags = TraceFlags {

92 traceSpawned :: !(Maybe TraceSubject) -- filter process spawned tracing

93 , traceDied :: !(Maybe TraceSubject) -- filter process died tracing

94+ , traceRegistered :: !(Maybe TraceSubject) -- filter process registration tracing

94 , traceSend :: !(Maybe TraceSubject) -- filter process/message tracing by sender

95 , traceSend :: !(Maybe TraceSubject) -- filter process/message tracing by sender

95 , traceRecv :: !(Maybe TraceSubject) -- filter process/message tracing by receiver

96 , traceRecv :: !(Maybe TraceSubject) -- filter process/message tracing by receiver

96 , traceNodes :: !Bool -- enable node status trace events

97 , traceNodes :: !Bool -- enable node status trace events

@@ -102,6 +103,7 @@ defaultTraceFlags =

102 TraceFlags {

103 TraceFlags {

103 traceSpawned = Nothing

104 traceSpawned = Nothing

104 , traceDied = Nothing

105 , traceDied = Nothing

106+ , traceRegistered = Nothing

105 , traceSend = Nothing

107 , traceSend = Nothing

106 , traceRecv = Nothing

108 , traceRecv = Nothing

107 , traceNodes = False

109 , traceNodes = False

@@ -178,8 +180,8 @@ instance Binary TraceSubject where

178 _ -> error "TraceSubject.get - invalid header"

180 _ -> error "TraceSubject.get - invalid header"

179

181

180instance Binary TraceFlags where

182instance Binary TraceFlags where

181− put (TraceFlags s d m r n c) = put s >> put d >> put m >> put r >> put n >> put c

183+ put (TraceFlags s d g m r n c) = put s >> put d >> put g >> put m >> put r >> put n >> put c

182− get = TraceFlags <$> get <*> get <*> get <*> get <*> get <*> get

184+ get = TraceFlags <$> get <*> get <*> get <*> get <*> get <*> get <*> get

183

185

184instance Binary TraceOk where

186instance Binary TraceOk where

185 put _ = return ()

187 put _ = return ()