git.iko.soy/distributed-process
on aa41971 help sign in
distributed-process/src/Control/Distributed/Process/Internal/Trace/Remote.hs
80 lines 2.0 kB history raw
1module Control.Distributed.Process.Internal.Trace.Remote
2 ( -- * Configuring A Tracer
3 setTraceFlagsRemote
4 , startTraceRelay
5 -- * Remote Table
6 , remoteTable
7 ) where
9import Control.Applicative ((<$>))
10import Control.Distributed.Process.Internal.Closure.BuiltIn
11 ( cpEnableTraceRemote
12 )
13import Control.Distributed.Process.Internal.Primitives
14 ( proxy
15 , finally
16 , die
17 , whereis
18 , send
19 , newChan
20 , receiveChan
21 , receiveWait
22 , matchIf
23 , finally
24 , try
25 , monitor
26 , getSelfPid
27 , relay
28 , nsendRemote
29 , say
30 )
31import Control.Distributed.Process.Internal.Trace.Types
32 ( TraceFlags(..)
33 , TraceOk(..)
34 , TraceSubject(..)
35 , defaultTraceFlags
36 )
37import Control.Distributed.Process.Internal.Trace.Primitives
38 ( withRegisteredTracer
39 , enableTrace
40 )
41import Control.Distributed.Process.Internal.Spawn
42 ( spawn
43 )
44import Control.Distributed.Process.Internal.Types
45 ( Process
46 , ProcessId
47 , SendPort
48 , NodeId
49 )
50import Control.Distributed.Process.Serializable
51import Control.Distributed.Static
52 ( RemoteTable
53 , registerStatic
54 )
55import Data.Rank1Dynamic (toDynamic)
56import qualified Data.Set as Set (fromList)
58-- | Remote Table.
59remoteTable :: RemoteTable -> RemoteTable
60remoteTable = registerStatic "$enableTraceRemote" (toDynamic enableTraceRemote)
62enableTraceRemote :: ProcessId -> Process ()
63enableTraceRemote pid =
64 getSelfPid >>= enableTrace >> relay pid
66-- | Starts a /trace relay/ process on the remote node, that forwards all trace
67-- events to the registered tracer on /this/ (the calling process') node.
68startTraceRelay :: NodeId -> Process ProcessId
69startTraceRelay nodeId = do
70 withRegisteredTracer $ \pid ->
71 -- TODO: move cpEnableTraceRemote here?
72 spawn nodeId $ cpEnableTraceRemote pid
74-- | Set the given flags for a remote node (asynchronous).
75setTraceFlagsRemote :: TraceFlags -> NodeId -> Process ()
76setTraceFlagsRemote flags node = do
77 nsendRemote node
78 "trace.controller"
79 ((Nothing :: Maybe (SendPort TraceOk)), flags)