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