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