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