[project @ 2004-08-13 13:29:00 by simonmar]
[ghc.git] / libraries / base / 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 #ifdef __GLASGOW_HASKELL__
16 #include "ghcconfig.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 Data.IORef
38 import System.IO.Unsafe
39 import System.IO
40
41 #ifdef mingw32_TARGET_OS
42 import Foreign.C.String
43 #endif
44
45 {-# NOINLINE tracers #-}
46 tracers :: IORef [(String, String -> IO ())]
47 tracers = unsafePerformIO (newIORef [("defaultTracer", fileTracer stderr)])
48
49 -- | A tracer function that outputs the message to a file
50 fileTracer :: Handle -- ^ file handle
51 -> String -- ^ trace message
52 -> IO ()
53 fileTracer handle msg = do
54 hPutStr handle msg
55 hPutChar handle '\n'
56
57 #ifdef mingw32_TARGET_OS
58 -- | A tracer function that outputs the message to the debuger (Windows only)
59 winDebugTracer :: String -- ^ trace message
60 -> IO ()
61 winDebugTracer msg = do
62 withCString (msg++"\n") outputDebugString
63
64 foreign import ccall unsafe "OutputDebugStringA"
65 outputDebugString :: CString -> IO ()
66 #endif
67
68 -- | Registering a new tracer
69 addTracer :: String -- ^ the tracer name
70 -> (String -> IO ()) -- ^ tracer
71 -> IO ()
72 addTracer name tracer = do
73 ts <- readIORef tracers
74 writeIORef tracers ((name,tracer):filter (\(n,l) -> n /= name) ts)
75
76 -- | Removing the tracer with the given name
77 removeTracer :: String -> IO ()
78 removeTracer name = do
79 ts <- readIORef tracers
80 writeIORef tracers (filter (\(n,l) -> n /= name) ts)
81
82 -- | 'putTraceMsg' function outputs the trace message from IO monad.
83 putTraceMsg :: String -> IO ()
84 putTraceMsg msg = do
85 ts <- readIORef tracers
86 mapM_ (\(n,l) -> l msg) ts
87
88 {-# NOINLINE trace #-}
89 {-|
90 When called, 'trace' outputs the string in its first argument using the
91 installed tracers, before returning the second argument as its result.
92 The 'trace' function is not referentially transparent, and should only
93 be used for debugging, or for monitoring execution. Some
94 implementations of 'trace' may decorate the string that\'s output to
95 indicate that you\'re tracing.
96 -}
97 trace :: String -> a -> a
98 trace string expr = unsafePerformIO $ do
99 putTraceMsg string
100 return expr