ebd65bb · distributed-process

distributed-process/distributed-process.cabal+2−1

compare with master

unifiedsplit

@@ -61,6 +61,7 @@ Library

61 Control.Distributed.Process.Internal.Primitives,

62 Control.Distributed.Process.Internal.CQueue,

63 Control.Distributed.Process.Internal.Types,

64+ Control.Distributed.Process.Internal.Trace,

64 Control.Distributed.Process.Internal.Closure.BuiltIn,

65 Control.Distributed.Process.Internal.Closure.BuiltIn,

65 Control.Distributed.Process.Internal.Messaging,

66 Control.Distributed.Process.Internal.Messaging,

66 Control.Distributed.Process.Internal.StrictList,

67 Control.Distributed.Process.Internal.StrictList,

@@ -145,7 +146,7 @@ Test-Suite TestStats

145 ScopedTypeVariables,

146 ScopedTypeVariables,

146 DeriveDataTypeable,

147 DeriveDataTypeable,

147 GeneralizedNewtypeDeriving

148 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

149 HS-Source-Dirs: tests

150 HS-Source-Dirs: tests

150

151

152

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

227logEvent :: String -> IO ()

228logEvent = traceEventIO

229

230+logExit :: ProcessId -> DiedReason -> IO ()

231+logExit p r = logEvent $ (show p) ++ " exited: " ++ (show r)

232+

230-- | Force-close a local node

233-- | Force-close a local node

231--

234--

232-- TODO: for now we just close the associated endpoint

235-- TODO: for now we just close the associated endpoint

@@ -274,7 +277,7 @@ forkProcess node proc = modifyMVar (localState node) startProcess

274 (return . DiedException . (show :: SomeException -> String))

277 (return . DiedException . (show :: SomeException -> String))

275

278

276 -- [Issue #104]

279 -- [Issue #104]

277− logEvent (show reason)

280+ logExit pid reason

278

281

279 -- [Unified: Table 4, rules termination and exiting]

282 -- [Unified: Table 4, rules termination and exiting]

280 modifyMVar_ (localState node) (cleanupProcess pid)

283 modifyMVar_ (localState node) (cleanupProcess pid)