{-# LANGUAGE Unsafe #-}
{-# LANGUAGE MagicHash, UnboxedTuples #-}
module Debug.Trace (
trace,
traceId,
traceShow,
traceShowId,
traceStack,
traceIO,
traceM,
traceShowM,
putTraceMsg,
traceEvent,
traceEventIO,
traceMarker,
traceMarkerIO,
) where
import Prelude
import System.IO.Unsafe
import Control.Monad
import Foreign.C.String
import GHC.Base
import qualified GHC.Foreign
import GHC.IO.Encoding
import GHC.Ptr
import GHC.Stack
traceIO :: String -> IO ()
traceIO msg = do
withCString "%s\n" $ \cfmt ->
withCString msg $ \cmsg ->
debugBelch cfmt cmsg
foreign import ccall unsafe "HsBase.h debugBelch2"
debugBelch :: CString -> CString -> IO ()
putTraceMsg :: String -> IO ()
putTraceMsg = traceIO
{-# DEPRECATED putTraceMsg "Use 'Debug.Trace.traceIO'" #-}
{-# NOINLINE trace #-}
trace :: String -> a -> a
trace string expr = unsafePerformIO $ do
traceIO string
return expr
traceId :: String -> String
traceId a = trace a a
traceShow :: (Show a) => a -> b -> b
traceShow = trace . show
traceShowId :: (Show a) => a -> a
traceShowId a = trace (show a) a
traceM :: (Monad m) => String -> m ()
traceM string = trace string $ return ()
traceShowM :: (Show a, Monad m) => a -> m ()
traceShowM = traceM . show
traceStack :: String -> a -> a
traceStack str expr = unsafePerformIO $ do
traceIO str
stack <- currentCallStack
when (not (null stack)) $ traceIO (renderStack stack)
return expr
{-# NOINLINE traceEvent #-}
traceEvent :: String -> a -> a
traceEvent msg expr = unsafeDupablePerformIO $ do
traceEventIO msg
return expr
traceEventIO :: String -> IO ()
traceEventIO msg =
GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
case traceEvent# p s of s' -> (# s', () #)
{-# NOINLINE traceMarker #-}
traceMarker :: String -> a -> a
traceMarker msg expr = unsafeDupablePerformIO $ do
traceMarkerIO msg
return expr
traceMarkerIO :: String -> IO ()
traceMarkerIO msg =
GHC.Foreign.withCString utf8 msg $ \(Ptr p) -> IO $ \s ->
case traceMarker# p s of s' -> (# s', () #)