@@ -16,9 +16,19 @@ import Control.Concurrent.STM
1616 , writeTQueue
1717 , atomically
1818 )
19−import Control.Distributed.Process.Internal.Types (forever', Tracer(..))
20−import Control.Exception (catch, throwTo, AsyncException(ThreadKilled))
19+import Control.Distributed.Process.Internal.Types
20+ ( forever'
21+ , Tracer(..)
22+ )
23+import Control.Exception
24+ ( catch
25+ , throwTo
26+ , SomeException
27+ , AsyncException(ThreadKilled)
28+ )
2129import Data.List (intersperse)
30+import Data.Time.Clock (getCurrentTime)
31+import Data.Time.Format (formatTime)
2232import Debug.Trace (traceEventIO)
2333
2434import Prelude hiding (catch)
@@ -27,9 +37,13 @@ import System.Environment (getEnv)
2737import System.IO
2838 ( Handle
2939 , IOMode(AppendMode)
30− , withFile
31− , hPutStr
40+ , BufferMode(..)
41+ , openFile
42+ , hClose
43+ , hPutStrLn
44+ , hSetBuffering
3245 )
46+import System.Locale (defaultTimeLocale)
3347
3448defaultTracer :: IO Tracer
3549defaultTracer = do
@@ -39,23 +53,26 @@ defaultTracer = do
3953logfileTracer :: FilePath -> IO Tracer
4054logfileTracer p = do
4155 q <- newTQueueIO
42− tid <- forkIO $ withFile p AppendMode (\h -> logger h q)
43− return $ LogFileTracer tid q
56+ h <- openFile p AppendMode
57+ hSetBuffering h LineBuffering
58+ tid <- forkIO $ logger h q `catch` (\(_ :: SomeException) ->
59+ hClose h >> return ())
60+ return $ LogFileTracer tid q h
4461 where logger :: Handle -> TQueue String -> IO ()
4562 logger h q' = forever' $ do
4663 msg <- atomically $ readTQueue q'
47− hPutStr h msg
48− logger h q'
64+ now <- getCurrentTime
65+ hPutStrLn h $ msg ++ (formatTime defaultTimeLocale " - %c" now)
4966
50−-- TODO: compatibility layer (conditional compilation?) for GHC/base versions
67+-- TODO: compatibility layer for GHC/base versions (e.g., where's killThread?)
5168
52−stopTracer :: Tracer -> IO ()
53−stopTracer (LogFileTracer tid _) = throwTo tid ThreadKilled -- cf killThread
54−stopTracer _ = return ()
69+stopTracer :: Tracer -> IO () -- overzealous but harmless duplication of hClose
70+stopTracer (LogFileTracer tid _ h) = throwTo tid ThreadKilled >> hClose h
71+stopTracer _ = return ()
5572
5673trace :: Tracer -> String -> IO ()
57−trace (LogFileTracer _ q) msg = atomically $ writeTQueue q msg
58−trace (EventLogTracer t) msg = t msg
74+trace (LogFileTracer _ q _) msg = atomically $ writeTQueue q msg
75+trace (EventLogTracer t) msg = t msg
5976
6077traceFormat :: Tracer
6178 -> String