205fc8b · distributed-process

git.iko.soy/distributed-process

Pass on registration trace events to clients

commit205fc8bbc9bcd46e3d26a7e71ea3f36fd560227a authorTim Watson <tim@rabbitmq.com> dateThu 28 Mar 2013, 17:23 (14 years ago) parentc600749

2 files changed+12−6

compare with master

unifiedsplit

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

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

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

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

258258

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

260−handleTrace st _ (TraceEvRegistered p n) =

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

261261 let regNames' =

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

263263 (Set.singleton n)

264264 (regNames st)

265− in return st { regNames = regNames' }

266−handleTrace st _ (TraceEvUnRegistered p n) =

265+ in do

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

267+ return st { regNames = regNames' }

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

267269 let f ns = case ns of

268270 Nothing -> Nothing

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

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

271− in return st { regNames = regNames' }

273+ in do

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

275+ return st { regNames = regNames' }

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

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

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

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

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

9191data TraceFlags = TraceFlags {

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

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

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

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

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

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

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

102103 TraceFlags {

103104 traceSpawned = Nothing

104105 , traceDied = Nothing

106+ , traceRegistered = Nothing

105107 , traceSend = Nothing

106108 , traceRecv = Nothing

107109 , traceNodes = False

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

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

179181

180182instance Binary TraceFlags where

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

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

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

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

183185

184186instance Binary TraceOk where

185187 put _ = return ()