b49566a · distributed-process

git.iko.soy/distributed-process

on master help sign in

deal with handles explicitly when tracing to a file

b49566aTim Watson14 years ago

distributed-process/src/Control/Distributed/Process/Internal/Trace.hs+31−14

compare with master

unifiedsplit

@@ -16,9 +16,19 @@ import Control.Concurrent.STM

16 , writeTQueue

17 , atomically

18 )

19−import Control.Distributed.Process.Internal.Types (forever', Tracer(..))

19+import Control.Distributed.Process.Internal.Types

20+ ( forever'

21+ , Tracer(..)

22+ )

23+import Control.Exception

24+ ( catch

25+ , throwTo

26+ , SomeException

20−import Control.Exception (catch, throwTo, AsyncException(ThreadKilled))

27+ , AsyncException(ThreadKilled)

28+ )

21import Data.List (intersperse)

29import Data.List (intersperse)

30+import Data.Time.Clock (getCurrentTime)

31+import Data.Time.Format (formatTime)

22import Debug.Trace (traceEventIO)

32import Debug.Trace (traceEventIO)

24import Prelude hiding (catch)

34import Prelude hiding (catch)

@@ -27,9 +37,13 @@ import System.Environment (getEnv)

27import System.IO

37import System.IO

28 ( Handle

38 ( Handle

29 , IOMode(AppendMode)

39 , IOMode(AppendMode)

30− , withFile

40+ , BufferMode(..)

31− , hPutStr

41+ , openFile

42+ , hClose

43+ , hPutStrLn

44+ , hSetBuffering

32 )

45 )

46+import System.Locale (defaultTimeLocale)

34defaultTracer :: IO Tracer

48defaultTracer :: IO Tracer

35defaultTracer = do

49defaultTracer = do

@@ -39,23 +53,26 @@ defaultTracer = do

39logfileTracer :: FilePath -> IO Tracer

53logfileTracer :: FilePath -> IO Tracer

40logfileTracer p = do

54logfileTracer p = do

41 q <- newTQueueIO

55 q <- newTQueueIO

42− tid <- forkIO $ withFile p AppendMode (\h -> logger h q)

56+ h <- openFile p AppendMode

57+ hSetBuffering h LineBuffering

58+ tid <- forkIO $ logger h q `catch` (\(_ :: SomeException) ->

59+ hClose h >> return ())

43− return $ LogFileTracer tid q

60+ return $ LogFileTracer tid q h

44 where logger :: Handle -> TQueue String -> IO ()

61 where logger :: Handle -> TQueue String -> IO ()

45 logger h q' = forever' $ do

62 logger h q' = forever' $ do

46 msg <- atomically $ readTQueue q'

63 msg <- atomically $ readTQueue q'

47− hPutStr h msg

64+ now <- getCurrentTime

48− logger h q'

65+ hPutStrLn h $ msg ++ (formatTime defaultTimeLocale " - %c" now)

50−-- TODO: compatibility layer (conditional compilation?) for GHC/base versions

67+-- TODO: compatibility layer for GHC/base versions (e.g., where's killThread?)

52−stopTracer :: Tracer -> IO ()

69+stopTracer :: Tracer -> IO () -- overzealous but harmless duplication of hClose

53−stopTracer (LogFileTracer tid _) = throwTo tid ThreadKilled -- cf killThread

70+stopTracer (LogFileTracer tid _ h) = throwTo tid ThreadKilled >> hClose h

54−stopTracer _ = return ()

71+stopTracer _ = return ()

56trace :: Tracer -> String -> IO ()

73trace :: Tracer -> String -> IO ()

57−trace (LogFileTracer _ q) msg = atomically $ writeTQueue q msg

74+trace (LogFileTracer _ q _) msg = atomically $ writeTQueue q msg

58−trace (EventLogTracer t) msg = t msg

75+trace (EventLogTracer t) msg = t msg

60traceFormat :: Tracer

77traceFormat :: Tracer

61 -> String

78 -> String

distributed-process/src/Control/Distributed/Process/Internal/Types.hs+3−2

@@ -110,6 +110,7 @@ import Control.Distributed.Process.Internal.StrictMVar (StrictMVar)

110import Control.Distributed.Process.Internal.WeakTQueue (TQueue)

111import Control.Distributed.Static (RemoteTable, Closure)

112import qualified Control.Distributed.Process.Internal.StrictContainerAccessors as DAC (mapMaybe)

113+import System.IO (Handle)

113

114

114--------------------------------------------------------------------------------

115--------------------------------------------------------------------------------

115-- Node and process identifiers --

116-- Node and process identifiers --

@@ -181,8 +182,8 @@ nullProcessId nid =

181

182

182-- | Required for system tracing in the node controller

183-- | Required for system tracing in the node controller

183data Tracer =

184data Tracer =

184− LogFileTracer ThreadId (STM.TQueue String)

185+ LogFileTracer !ThreadId !(STM.TQueue String) !Handle

185− | EventLogTracer (String -> IO ())

186+ | EventLogTracer !(String -> IO ())

186

187

187-- | Local nodes

188-- | Local nodes

188data LocalNode = LocalNode

189data LocalNode = LocalNode