[project @ 2004-02-15 13:04:47 by krasimir]
[packages/base.git] / Debug / Trace.hs
1 -----------------------------------------------------------------------------
2 -- |
3 -- Module : Debug.Trace
4 -- Copyright : (c) The University of Glasgow 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : provisional
9 -- Portability : portable
10 --
11 -- The 'trace' function.
12 --
13 -----------------------------------------------------------------------------
14
15 #ifndef __HUGS__
16 #include "config.h"
17 #endif
18
19 module Debug.Trace (
20 -- * Tracing
21
22 -- ** Tracers
23 -- | The tracer is a function that monitors the trace messages.
24 fileTracer, -- :: Handle -> String -> IO ()
25 #ifdef mingw32_TARGET_OS
26 winDebugTracer, -- :: String -> IO ()
27 #endif
28 addTracer, -- :: String -> (String -> IO ()) -> IO ()
29 removeTracer, -- :: String -> IO ()
30
31 -- ** Messages
32 putTraceMsg, -- :: String -> IO ()
33 trace -- :: String -> a -> a
34 ) where
35
36 import Prelude
37 import System.IO.Unsafe
38 import System.IO
39
40 #ifdef __GLASGOW_HASKELL__
41 import GHC.IOBase
42 import GHC.Handle
43 #endif
44
45 import Foreign.C.String
46
47 {-# NOINLINE tracers #-}
48 tracers :: IORef [(String, String -> IO ())]
49 tracers = unsafePerformIO (newIORef [("defaultTracer", fileTracer stderr)])
50
51 -- | A tracer function that outputs the message to a file
52 fileTracer :: Handle -- ^ file handle
53 -> String -- ^ trace message
54 -> IO ()
55 fileTracer handle msg = do
56 hPutStr handle msg
57 hPutChar handle '\n'
58
59 #ifdef mingw32_TARGET_OS
60 -- | A tracer function that outputs the message to the debuger (Windows only)
61 winDebugTracer :: String -- ^ trace message
62 -> IO ()
63 winDebugTracer msg = do
64 withCString (msg++"\n") outputDebugString
65
66 foreign import ccall unsafe "OutputDebugStringA"
67 outputDebugString :: CString -> IO ()
68 #endif
69
70 -- | Registering a new tracer
71 addTracer :: String -- ^ the tracer name
72 -> (String -> IO ()) -- ^ tracer
73 -> IO ()
74 addTracer name tracer = do
75 ts <- readIORef tracers
76 writeIORef tracers ((name,tracer):filter (\(n,l) -> n /= name) ts)
77
78 -- | Removing the tracer with the given name
79 removeTracer :: String -> IO ()
80 removeTracer name = do
81 ts <- readIORef tracers
82 writeIORef tracers (filter (\(n,l) -> n /= name) ts)
83
84 -- | 'putTraceMsg' function outputs the trace message from IO monad.
85 putTraceMsg :: String -> IO ()
86 putTraceMsg msg = do
87 ts <- readIORef tracers
88 mapM_ (\(n,l) -> l msg) ts
89
90 {-# NOINLINE trace #-}
91 {-|
92 When called, 'trace' outputs the string in its first argument using the
93 installed tracers, before returning the second argument as its result.
94 The 'trace' function is not referentially transparent, and should only
95 be used for debugging, or for monitoring execution. Some
96 implementations of 'trace' may decorate the string that\'s output to
97 indicate that you\'re tracing.
98 -}
99 trace :: String -> a -> a
100 trace string expr = unsafePerformIO $ do
101 putTraceMsg string
102 return expr