git.iko.soy/distributed-process
on b3fa53c help sign in
distributed-process/src/Control/Distributed/Process/Internal/Trace/Primitives.hs
126 lines 3.7 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 , traceOnly
22 , traceOn
23 , traceOff
24 ) where
26import Control.Distributed.Process.Internal.CQueue (enqueue)
27import Control.Distributed.Process.Internal.Trace.Types
28 ( TraceArg(..)
29 , TraceEvent(..)
30 , SetTrace(..)
31 , TraceFlags(..)
32 , TraceOk(..)
33 , TraceSubject(..)
34 , defaultTraceFlags
35 )
36import Control.Distributed.Process.Internal.Types
37 ( Tracer(..)
38 , ProcessId
39 , Message
40 , SendPort
41 , createUnencodedMessage
42 )
43import Control.Distributed.Process.Serializable
44import Data.Foldable (forM_)
45import Data.List (intersperse)
46import qualified Data.Set as Set (fromList)
47import System.Mem.Weak (deRefWeak)
49--------------------------------------------------------------------------------
50-- Main API --
51--------------------------------------------------------------------------------
53traceLog :: Tracer -> String -> IO ()
54traceLog tr s = traceMessage tr (TraceEvLog s)
56traceLogFmt :: Tracer
57 -> String
58 -> [TraceArg]
59 -> IO ()
60traceLogFmt t d ls =
61 traceLog t $ concat (intersperse d (map toS ls))
62 where toS :: TraceArg -> String
63 toS (TraceStr s) = s
64 toS (Trace a) = show a
66traceEvent :: Tracer -> TraceEvent -> IO ()
67traceEvent tr ev = traceIt tr (createUnencodedMessage ev)
69traceMessage :: Serializable m => Tracer -> m -> IO ()
70traceMessage tr msg = traceEvent tr (TraceEvUser (createUnencodedMessage msg))
72enableTrace :: Tracer -> ProcessId -> IO ()
73enableTrace t p =
74 traceIt t (createUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
75 (TraceEnable p)))
77enableTraceSync :: Tracer -> SendPort TraceOk -> ProcessId -> IO ()
78enableTraceSync t s p =
79 traceIt t (createUnencodedMessage ((Just s), (TraceEnable p)))
81disableTrace :: Tracer -> IO ()
82disableTrace t =
83 traceIt t (createUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)),
84 TraceDisable))
86disableTraceSync :: Tracer -> SendPort TraceOk -> IO ()
87disableTraceSync t s =
88 traceIt t (createUnencodedMessage ((Just s), TraceDisable))
90setTraceFlags :: Tracer -> TraceFlags -> IO ()
91setTraceFlags t f =
92 traceIt t (createUnencodedMessage ((Nothing :: Maybe (SendPort TraceOk)), f))
94setTraceFlagsSync :: Tracer -> SendPort TraceOk -> TraceFlags -> IO ()
95setTraceFlagsSync t s f =
96 traceIt t (createUnencodedMessage ((Just s), f))
98getTraceFlags :: Tracer -> SendPort TraceFlags -> IO ()
99getTraceFlags t s = traceIt t (createUnencodedMessage s)
101-- aux API and utilities
103class Traceable a where
104 uod :: [a] -> TraceSubject
106instance Traceable ProcessId where
107 uod = TraceProcs . Set.fromList
109instance Traceable String where
110 uod = TraceNames . Set.fromList
112traceOnly :: Traceable a => [a] -> Maybe TraceSubject
113traceOnly = Just . uod
115traceOn :: Maybe TraceSubject
116traceOn = Just TraceAll
118traceOff :: Maybe TraceSubject
119traceOff = Nothing
121traceIt :: Tracer -> Message -> IO ()
122traceIt InactiveTracer _ = return ()
123traceIt (ActiveTracer _ wqRef) msg = do
124 mQueue <- deRefWeak wqRef
125 forM_ mQueue $ \queue -> enqueue queue msg