module Control.Distributed.Process.Management.Internal.Trace.Remote
  ( -- * Configuring A Remote Tracer
    setTraceFlagsRemote
  , startTraceRelay
    -- * Remote Table
  , remoteTable
  ) where

import Control.Distributed.Process.Internal.Closure.BuiltIn
  ( cpEnableTraceRemote
  )
import Control.Distributed.Process.Internal.Primitives
  ( getSelfPid
  , relay
  , nsendRemote
  )
import Control.Distributed.Process.Management.Internal.Trace.Types
  ( TraceFlags(..)
  , TraceOk(..)
  )
import Control.Distributed.Process.Management.Internal.Trace.Primitives
  ( withRegisteredTracer
  , enableTrace
  )
import Control.Distributed.Process.Internal.Spawn
  ( spawn
  )
import Control.Distributed.Process.Internal.Types
  ( Process
  , ProcessId
  , SendPort
  , NodeId
  )
import Control.Distributed.Static
  ( RemoteTable
  , registerStatic
  )
import Data.Rank1Dynamic (toDynamic)

-- | Remote Table.
remoteTable :: RemoteTable -> RemoteTable
remoteTable :: RemoteTable -> RemoteTable
remoteTable = String -> Dynamic -> RemoteTable -> RemoteTable
registerStatic String
"$enableTraceRemote" ((ProcessId -> Process ()) -> Dynamic
forall a. Typeable a => a -> Dynamic
toDynamic ProcessId -> Process ()
enableTraceRemote)

enableTraceRemote :: ProcessId -> Process ()
enableTraceRemote :: ProcessId -> Process ()
enableTraceRemote ProcessId
pid =
  Process ProcessId
getSelfPid Process ProcessId -> (ProcessId -> Process ()) -> Process ()
forall a b. Process a -> (a -> Process b) -> Process b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ProcessId -> Process ()
enableTrace Process () -> Process () -> Process ()
forall a b. Process a -> Process b -> Process b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ProcessId -> Process ()
relay ProcessId
pid

-- | Starts a /trace relay/ process on the remote node, which forwards all trace
-- events to the registered tracer on /this/ (the calling process') node.
startTraceRelay :: NodeId -> Process ProcessId
startTraceRelay :: NodeId -> Process ProcessId
startTraceRelay NodeId
nodeId = do
  (ProcessId -> Process ProcessId) -> Process ProcessId
forall a. (ProcessId -> Process a) -> Process a
withRegisteredTracer ((ProcessId -> Process ProcessId) -> Process ProcessId)
-> (ProcessId -> Process ProcessId) -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ \ProcessId
pid ->
    NodeId -> Closure (Process ()) -> Process ProcessId
spawn NodeId
nodeId (Closure (Process ()) -> Process ProcessId)
-> Closure (Process ()) -> Process ProcessId
forall a b. (a -> b) -> a -> b
$ ProcessId -> Closure (Process ())
cpEnableTraceRemote ProcessId
pid

-- | Set the given flags for a remote node (asynchronous).
setTraceFlagsRemote :: TraceFlags -> NodeId -> Process ()
setTraceFlagsRemote :: TraceFlags -> NodeId -> Process ()
setTraceFlagsRemote TraceFlags
flags NodeId
node = do
  NodeId
-> String -> (Maybe (SendPort TraceOk), TraceFlags) -> Process ()
forall a. Serializable a => NodeId -> String -> a -> Process ()
nsendRemote NodeId
node
              String
"trace.controller"
              ((Maybe (SendPort TraceOk)
forall a. Maybe a
Nothing :: Maybe (SendPort TraceOk)), TraceFlags
flags)