git.iko.soy/distributed-process
on master help sign in
provide a simple API for choosing debug/trace modes
commitebd65bbc8595544787357b4df3bc39e770067e41 authorTim Watson <tim@rabbitmq.com> dateThu 24 Jan 2013, 17:41 (14 years ago) parent297458f
3 files changed+59−2
compare with master
unifiedsplit
distributed-process/distributed-process.cabal+2−1 distributed-process/src/Control/Distributed/Process/Internal/Trace.hs+53 distributed-process/src/Control/Distributed/Process/Node.hs+4−1
distributed-process/distributed-process.cabal+2−1
@@ -61,6 +61,7 @@ Library
6161 Control.Distributed.Process.Internal.Primitives,
6262 Control.Distributed.Process.Internal.CQueue,
6363 Control.Distributed.Process.Internal.Types,
64+ Control.Distributed.Process.Internal.Trace,
6465 Control.Distributed.Process.Internal.Closure.BuiltIn,
6566 Control.Distributed.Process.Internal.Messaging,
6667 Control.Distributed.Process.Internal.StrictList,
@@ -145,7 +146,7 @@ Test-Suite TestStats
145146 ScopedTypeVariables,
146147 DeriveDataTypeable,
147148 GeneralizedNewtypeDeriving
148− ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
149+ ghc-options: -Wall -debug -eventlog -threaded -rtsopts -with-rtsopts=-N -fno-warn-unused-do-bind
149150 HS-Source-Dirs: tests
150151
151152
distributed-process/src/Control/Distributed/Process/Internal/Trace.hsnew file+53
@@ -0,0 +1,53 @@
1+
2+module Control.Distributed.Process.Internal.Trace
3+ ( Tracer
4+ , trace -- :: String -> IO ()
5+ , traceFormat -- :: (Show a) => (a -> a -> String) -> [a] -> IO ()
6+ , eventlog
7+ , console
8+ ) where
9+
10+import Control.Concurrent
11+ ( ThreadId
12+ , forkIO
13+ )
14+import Control.Concurrent.STM
15+ ( TQueue
16+ , newTQueueIO
17+ , readTQueue
18+ , writeTQueue
19+ , atomically
20+ )
21+import Data.List (foldl')
22+import Debug.Trace
23+ ( traceEventIO
24+ )
25+
26+data Tracer =
27+ ConsoleTracer ThreadId (TQueue String)
28+ | EventLogTracer (String -> IO ())
29+
30+eventlog :: IO Tracer
31+eventlog = return $ EventLogTracer traceEventIO
32+
33+console :: IO Tracer
34+console = do
35+ q <- newTQueueIO
36+ tid <- forkIO $ logger q
37+ return $ ConsoleTracer tid q
38+ where logger q' = do
39+ msg <- atomically $ readTQueue q'
40+ putStrLn msg
41+ logger q'
42+
43+trace :: Tracer -> String -> IO ()
44+trace (ConsoleTracer _ q) msg = atomically $ writeTQueue q msg
45+trace (EventLogTracer t) msg = t msg
46+
47+traceFormat :: (Show a)
48+ => Tracer
49+ -> (String -> String -> String)
50+ -> [a]
51+ -> IO ()
52+traceFormat t f xs =
53+ trace t $ foldl' (\e a -> ((show e) `f` (show a))) "" xs
distributed-process/src/Control/Distributed/Process/Node.hs+4−1
@@ -227,6 +227,9 @@ startServiceProcesses node = do
227227logEvent :: String -> IO ()
228228logEvent = traceEventIO
229229
230+logExit :: ProcessId -> DiedReason -> IO ()
231+logExit p r = logEvent $ (show p) ++ " exited: " ++ (show r)
232+
230233-- | Force-close a local node
231234--
232235-- TODO: for now we just close the associated endpoint
@@ -274,7 +277,7 @@ forkProcess node proc = modifyMVar (localState node) startProcess
274277 (return . DiedException . (show :: SomeException -> String))
275278
276279 -- [Issue #104]
277− logEvent (show reason)
280+ logExit pid reason
278281
279282 -- [Unified: Table 4, rules termination and exiting]
280283 modifyMVar_ (localState node) (cleanupProcess pid)