{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE ExistentialQuantification  #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE GADTs  #-}
{-# LANGUAGE DeriveGeneric  #-}

-- | Tracing/Debugging support - Types
module Control.Distributed.Process.Management.Internal.Trace.Types
  ( SetTrace(..)
  , TraceSubject(..)
  , TraceFlags(..)
  , TraceArg(..)
  , TraceOk(..)
  , traceLog
  , traceLogFmt
  , traceEvent
  , traceMessage
  , defaultTraceFlags
  , enableTrace
  , enableTraceSync
  , disableTrace
  , disableTraceSync
  , getTraceFlags
  , setTraceFlags
  , setTraceFlagsSync
  , getCurrentTraceClient
  ) where

import Control.Distributed.Process.Internal.Types
  ( MxEventBus(..)
  , ProcessId
  , SendPort
  , unsafeCreateUnencodedMessage
  )
import Control.Distributed.Process.Management.Internal.Bus
  ( publishEvent
  )
import Control.Distributed.Process.Management.Internal.Types
  ( MxEvent(..)
  )
import Control.Distributed.Process.Serializable
import Data.Binary
import Data.List (intersperse)
import Data.Set (Set)
import Data.Typeable
import GHC.Generics

--------------------------------------------------------------------------------
-- Types                                                                      --
--------------------------------------------------------------------------------

data SetTrace = TraceEnable !ProcessId | TraceDisable
  deriving (Typeable, (forall x. SetTrace -> Rep SetTrace x)
-> (forall x. Rep SetTrace x -> SetTrace) -> Generic SetTrace
forall x. Rep SetTrace x -> SetTrace
forall x. SetTrace -> Rep SetTrace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SetTrace -> Rep SetTrace x
from :: forall x. SetTrace -> Rep SetTrace x
$cto :: forall x. Rep SetTrace x -> SetTrace
to :: forall x. Rep SetTrace x -> SetTrace
Generic, SetTrace -> SetTrace -> Bool
(SetTrace -> SetTrace -> Bool)
-> (SetTrace -> SetTrace -> Bool) -> Eq SetTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SetTrace -> SetTrace -> Bool
== :: SetTrace -> SetTrace -> Bool
$c/= :: SetTrace -> SetTrace -> Bool
/= :: SetTrace -> SetTrace -> Bool
Eq, Int -> SetTrace -> ShowS
[SetTrace] -> ShowS
SetTrace -> String
(Int -> SetTrace -> ShowS)
-> (SetTrace -> String) -> ([SetTrace] -> ShowS) -> Show SetTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SetTrace -> ShowS
showsPrec :: Int -> SetTrace -> ShowS
$cshow :: SetTrace -> String
show :: SetTrace -> String
$cshowList :: [SetTrace] -> ShowS
showList :: [SetTrace] -> ShowS
Show)
instance Binary SetTrace where

-- | Defines which processes will be traced by a given 'TraceFlag',
-- either by name, or @ProcessId@. Choosing @TraceAll@ is /by far/
-- the most efficient approach, as the tracer process therefore
-- avoids deciding whether or not a trace event is viable.
--
data TraceSubject =
    TraceAll                     -- enable tracing for all running processes
  | TraceProcs !(Set ProcessId)  -- enable tracing for a set of processes
  | TraceNames !(Set String)     -- enable tracing for a set of named/registered processes
  deriving (Typeable, (forall x. TraceSubject -> Rep TraceSubject x)
-> (forall x. Rep TraceSubject x -> TraceSubject)
-> Generic TraceSubject
forall x. Rep TraceSubject x -> TraceSubject
forall x. TraceSubject -> Rep TraceSubject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceSubject -> Rep TraceSubject x
from :: forall x. TraceSubject -> Rep TraceSubject x
$cto :: forall x. Rep TraceSubject x -> TraceSubject
to :: forall x. Rep TraceSubject x -> TraceSubject
Generic, Int -> TraceSubject -> ShowS
[TraceSubject] -> ShowS
TraceSubject -> String
(Int -> TraceSubject -> ShowS)
-> (TraceSubject -> String)
-> ([TraceSubject] -> ShowS)
-> Show TraceSubject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceSubject -> ShowS
showsPrec :: Int -> TraceSubject -> ShowS
$cshow :: TraceSubject -> String
show :: TraceSubject -> String
$cshowList :: [TraceSubject] -> ShowS
showList :: [TraceSubject] -> ShowS
Show)
instance Binary TraceSubject where

-- | Defines /what/ will be traced. Flags that control tracing of
-- @Process@ events, take a 'TraceSubject' controlling which processes
-- should generate trace events in the target process.
data TraceFlags = TraceFlags {
    TraceFlags -> Maybe TraceSubject
traceSpawned      :: !(Maybe TraceSubject) -- filter process spawned tracing
  , TraceFlags -> Maybe TraceSubject
traceDied         :: !(Maybe TraceSubject) -- filter process died tracing
  , TraceFlags -> Maybe TraceSubject
traceRegistered   :: !(Maybe TraceSubject) -- filter process registration tracing
  , TraceFlags -> Maybe TraceSubject
traceUnregistered :: !(Maybe TraceSubject) -- filter process un-registration
  , TraceFlags -> Maybe TraceSubject
traceSend         :: !(Maybe TraceSubject) -- filter process/message tracing by sender
  , TraceFlags -> Maybe TraceSubject
traceRecv         :: !(Maybe TraceSubject) -- filter process/message tracing by receiver
  , TraceFlags -> Bool
traceNodes        :: !Bool                 -- enable node status trace events
  , TraceFlags -> Bool
traceConnections  :: !Bool                 -- enable connection status trace events
  } deriving (Typeable, (forall x. TraceFlags -> Rep TraceFlags x)
-> (forall x. Rep TraceFlags x -> TraceFlags) -> Generic TraceFlags
forall x. Rep TraceFlags x -> TraceFlags
forall x. TraceFlags -> Rep TraceFlags x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceFlags -> Rep TraceFlags x
from :: forall x. TraceFlags -> Rep TraceFlags x
$cto :: forall x. Rep TraceFlags x -> TraceFlags
to :: forall x. Rep TraceFlags x -> TraceFlags
Generic, Int -> TraceFlags -> ShowS
[TraceFlags] -> ShowS
TraceFlags -> String
(Int -> TraceFlags -> ShowS)
-> (TraceFlags -> String)
-> ([TraceFlags] -> ShowS)
-> Show TraceFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TraceFlags -> ShowS
showsPrec :: Int -> TraceFlags -> ShowS
$cshow :: TraceFlags -> String
show :: TraceFlags -> String
$cshowList :: [TraceFlags] -> ShowS
showList :: [TraceFlags] -> ShowS
Show)
instance Binary TraceFlags where

defaultTraceFlags :: TraceFlags
defaultTraceFlags :: TraceFlags
defaultTraceFlags =
  TraceFlags {
    traceSpawned :: Maybe TraceSubject
traceSpawned      = Maybe TraceSubject
forall a. Maybe a
Nothing
  , traceDied :: Maybe TraceSubject
traceDied         = Maybe TraceSubject
forall a. Maybe a
Nothing
  , traceRegistered :: Maybe TraceSubject
traceRegistered   = Maybe TraceSubject
forall a. Maybe a
Nothing
  , traceUnregistered :: Maybe TraceSubject
traceUnregistered = Maybe TraceSubject
forall a. Maybe a
Nothing
  , traceSend :: Maybe TraceSubject
traceSend         = Maybe TraceSubject
forall a. Maybe a
Nothing
  , traceRecv :: Maybe TraceSubject
traceRecv         = Maybe TraceSubject
forall a. Maybe a
Nothing
  , traceNodes :: Bool
traceNodes        = Bool
False
  , traceConnections :: Bool
traceConnections  = Bool
False
  }

data TraceArg =
    TraceStr String
  | forall a. (Show a) => Trace a

-- | A generic 'ok' response from the trace coordinator.
data TraceOk = TraceOk
  deriving (Typeable, (forall x. TraceOk -> Rep TraceOk x)
-> (forall x. Rep TraceOk x -> TraceOk) -> Generic TraceOk
forall x. Rep TraceOk x -> TraceOk
forall x. TraceOk -> Rep TraceOk x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TraceOk -> Rep TraceOk x
from :: forall x. TraceOk -> Rep TraceOk x
$cto :: forall x. Rep TraceOk x -> TraceOk
to :: forall x. Rep TraceOk x -> TraceOk
Generic)
instance Binary TraceOk where

--------------------------------------------------------------------------------
-- Internal/Common API                                                        --
--------------------------------------------------------------------------------

traceLog :: MxEventBus -> String -> IO ()
traceLog :: MxEventBus -> String -> IO ()
traceLog MxEventBus
tr String
s = MxEventBus -> Message -> IO ()
publishEvent MxEventBus
tr (MxEvent -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage (MxEvent -> Message) -> MxEvent -> Message
forall a b. (a -> b) -> a -> b
$ String -> MxEvent
MxLog String
s)

traceLogFmt :: MxEventBus
            -> String
            -> [TraceArg]
            -> IO ()
traceLogFmt :: MxEventBus -> String -> [TraceArg] -> IO ()
traceLogFmt MxEventBus
t String
d [TraceArg]
ls =
  MxEventBus -> String -> IO ()
traceLog MxEventBus
t (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (String -> [String] -> [String]
forall a. a -> [a] -> [a]
intersperse String
d ((TraceArg -> String) -> [TraceArg] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TraceArg -> String
toS [TraceArg]
ls))
  where toS :: TraceArg -> String
        toS :: TraceArg -> String
toS (TraceStr String
s) = String
s
        toS (Trace    a
a) = a -> String
forall a. Show a => a -> String
show a
a

traceEvent :: MxEventBus -> MxEvent -> IO ()
traceEvent :: MxEventBus -> MxEvent -> IO ()
traceEvent MxEventBus
tr MxEvent
ev = MxEventBus -> Message -> IO ()
publishEvent MxEventBus
tr (MxEvent -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage MxEvent
ev)

traceMessage :: Serializable m => MxEventBus -> m -> IO ()
traceMessage :: forall m. Serializable m => MxEventBus -> m -> IO ()
traceMessage MxEventBus
tr m
msg = MxEventBus -> MxEvent -> IO ()
traceEvent MxEventBus
tr (Message -> MxEvent
MxUser (m -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage m
msg))

enableTrace :: MxEventBus -> ProcessId -> IO ()
enableTrace :: MxEventBus -> ProcessId -> IO ()
enableTrace MxEventBus
t ProcessId
p =
  MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t ((Maybe (SendPort TraceOk), SetTrace) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ((Maybe (SendPort TraceOk)
forall a. Maybe a
Nothing :: Maybe (SendPort TraceOk)),
                                                (ProcessId -> SetTrace
TraceEnable ProcessId
p)))

enableTraceSync :: MxEventBus -> SendPort TraceOk -> ProcessId -> IO ()
enableTraceSync :: MxEventBus -> SendPort TraceOk -> ProcessId -> IO ()
enableTraceSync MxEventBus
t SendPort TraceOk
s ProcessId
p =
  MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t ((Maybe (SendPort TraceOk), SetTrace) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage (SendPort TraceOk -> Maybe (SendPort TraceOk)
forall a. a -> Maybe a
Just SendPort TraceOk
s, ProcessId -> SetTrace
TraceEnable ProcessId
p))

disableTrace :: MxEventBus -> IO ()
disableTrace :: MxEventBus -> IO ()
disableTrace MxEventBus
t =
  MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t ((Maybe (SendPort TraceOk), SetTrace) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ((Maybe (SendPort TraceOk)
forall a. Maybe a
Nothing :: Maybe (SendPort TraceOk)),
                                     SetTrace
TraceDisable))

disableTraceSync :: MxEventBus -> SendPort TraceOk -> IO ()
disableTraceSync :: MxEventBus -> SendPort TraceOk -> IO ()
disableTraceSync MxEventBus
t SendPort TraceOk
s =
  MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t ((Maybe (SendPort TraceOk), SetTrace) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ((SendPort TraceOk -> Maybe (SendPort TraceOk)
forall a. a -> Maybe a
Just SendPort TraceOk
s), SetTrace
TraceDisable))

setTraceFlags :: MxEventBus -> TraceFlags -> IO ()
setTraceFlags :: MxEventBus -> TraceFlags -> IO ()
setTraceFlags MxEventBus
t TraceFlags
f =
  MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t ((Maybe (SendPort TraceOk), TraceFlags) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ((Maybe (SendPort TraceOk)
forall a. Maybe a
Nothing :: Maybe (SendPort TraceOk)), TraceFlags
f))

setTraceFlagsSync :: MxEventBus -> SendPort TraceOk -> TraceFlags -> IO ()
setTraceFlagsSync :: MxEventBus -> SendPort TraceOk -> TraceFlags -> IO ()
setTraceFlagsSync MxEventBus
t SendPort TraceOk
s TraceFlags
f =
  MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t ((Maybe (SendPort TraceOk), TraceFlags) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage ((SendPort TraceOk -> Maybe (SendPort TraceOk)
forall a. a -> Maybe a
Just SendPort TraceOk
s), TraceFlags
f))

getTraceFlags :: MxEventBus -> SendPort TraceFlags -> IO ()
getTraceFlags :: MxEventBus -> SendPort TraceFlags -> IO ()
getTraceFlags MxEventBus
t SendPort TraceFlags
s = MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t (SendPort TraceFlags -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage SendPort TraceFlags
s)

getCurrentTraceClient :: MxEventBus -> SendPort (Maybe ProcessId) -> IO ()
getCurrentTraceClient :: MxEventBus -> SendPort (Maybe ProcessId) -> IO ()
getCurrentTraceClient MxEventBus
t SendPort (Maybe ProcessId)
s = MxEventBus -> Message -> IO ()
publishEvent MxEventBus
t (SendPort (Maybe ProcessId) -> Message
forall a. Serializable a => a -> Message
unsafeCreateUnencodedMessage SendPort (Maybe ProcessId)
s)