git.iko.soy/distributed-process
on 205fc8b help sign in
distributed-process/src/Control/Distributed/Process/Internal/Trace/Primitives.hs
130 lines 3.9 kB history raw
1-- | Keeps the tracing API calls separate from the Tracer implementation,
2-- which allows us to avoid a nasty import cycle between tracing and
3-- the messaging primitives that rely on it
4module Control.Distributed.Process.Internal.Trace.Primitives
5 ( Tracer
6 , TraceEvent(..)
7 -- * Sending Trace Data
8 , traceLog
9 , traceLogFmt
10 , traceEvent
11 , traceMessage
12 -- * Configuring A Tracer
13 , defaultTraceFlags
14 , enableTrace
15 , enableTraceSync
16 , disableTrace
17 , disableTraceSync
18 , getTraceFlags
19 , setTraceFlags
20 , setTraceFlagsSync
21 , getCurrentTraceClient
22 , traceOnly
23 , traceOn
24 , traceOff
25 ) where
27import Control.Distributed.Process.Internal.CQueue (enqueue)
28import Control.Distributed.Process.Internal.Trace.Types
29 ( TraceArg(..)
30 , TraceEvent(..)
31 , SetTrace(..)
32 , TraceFlags(..)
33 , TraceOk(..)
34 , TraceSubject(..)
35 , defaultTraceFlags
36 )
37import Control.Distributed.Process.Internal.Types
38 ( Tracer(..)
39 , ProcessId
40 , Message
41 , SendPort
42 , createUnencodedMessage
43 )
44import Control.Distributed.Process.Serializable
45import Data.Foldable (forM_)
46import Data.List (intersperse)
47import qualified Data.Set as Set (fromList)
48import System.Mem.Weak (deRefWeak)
50--------------------------------------------------------------------------------
51-- Main API --
52--------------------------------------------------------------------------------
54traceLog :: Tracer -> String -> IO ()
55traceLog tr s = traceMessage tr (TraceEvLog s)
57traceLogFmt :: Tracer
58 -> String
59 -> [TraceArg]
60 -> IO ()
61traceLogFmt t d ls =
62 traceLog t $ concat (intersperse d (map toS ls))
63 where toS :: TraceArg -> String
64 toS (TraceStr s) = s
65 toS (Trace a) = show a
67traceEvent :: Tracer -> TraceEvent -> IO ()
68traceEvent tr ev = traceIt tr (createUnencodedMessage ev)
70traceMessage :: Serializable m => Tracer -> m -> IO ()
71traceMessage tr msg = traceEvent tr (TraceEvUser (createUnencodedMessage msg))
73enableTrace :: Tracer -> ProcessId -> IO ()
74enableTrace t p =
75 traceIt t (createUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
76 (TraceEnable p)))
78enableTraceSync :: Tracer -> SendPort TraceOk -> ProcessId -> IO ()
79enableTraceSync t s p =
80 traceIt t (createUnencodedMessage ((Just s), (TraceEnable p)))
82disableTrace :: Tracer -> IO ()
83disableTrace t =
84 traceIt t (createUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
85 TraceDisable))
87disableTraceSync :: Tracer -> SendPort TraceOk -> IO ()
88disableTraceSync t s =
89 traceIt t (createUnencodedMessage ((Just s), TraceDisable))
91setTraceFlags :: Tracer -> TraceFlags -> IO ()
92setTraceFlags t f =
93 traceIt t (createUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)), f))
95setTraceFlagsSync :: Tracer -> SendPort TraceOk -> TraceFlags -> IO ()
96setTraceFlagsSync t s f =
97 traceIt t (createUnencodedMessage ((Just s), f))
99getTraceFlags :: Tracer -> SendPort TraceFlags -> IO ()
100getTraceFlags t s = traceIt t (createUnencodedMessage s)
102getCurrentTraceClient :: Tracer -> SendPort (Maybe ProcessId) -> IO ()
103getCurrentTraceClient t s = traceIt t (createUnencodedMessage s)
105-- aux API and utilities
107class Traceable a where
108 uod :: [a] -> TraceSubject
110instance Traceable ProcessId where
111 uod = TraceProcs . Set.fromList
113instance Traceable String where
114 uod = TraceNames . Set.fromList
116traceOnly :: Traceable a => [a] -> Maybe TraceSubject
117traceOnly = Just . uod
119traceOn :: Maybe TraceSubject
120traceOn = Just TraceAll
122traceOff :: Maybe TraceSubject
123traceOff = Nothing
125traceIt :: Tracer -> Message -> IO ()
126traceIt InactiveTracer _ = return ()
127traceIt (ActiveTracer _ wqRef) msg = do
128 mQueue <- deRefWeak wqRef
129 forM_ mQueue $ \queue -> enqueue queue msg