{-# LANGUAGE CPP #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
module Debug.Trace.ByteString
( traceEvent
, traceEventIO
, traceMarker
, traceMarkerIO
, unsafeTraceEvent
, unsafeTraceEventIO
, unsafeTraceMarker
, unsafeTraceMarkerIO
) where
import Control.Monad (when)
import GHC.Exts (Ptr(..), traceEvent#, traceMarker#)
import GHC.IO (IO(..))
import qualified GHC.RTS.Flags as Flags
import qualified System.IO.Unsafe as Unsafe
import qualified Data.ByteString as B
import qualified Data.ByteString.Unsafe as BU
import Debug.Trace.Flags (userTracingEnabled)
traceEvent :: B.ByteString -> a -> a
traceEvent :: ByteString -> a -> a
traceEvent message :: ByteString
message a :: a
a
| Bool
userTracingEnabled = IO a -> a
forall a. IO a -> a
Unsafe.unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO ()
traceEventIO ByteString
message
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = a
a
{-# NOINLINE traceEvent #-}
traceEventIO :: B.ByteString -> IO ()
traceEventIO :: ByteString -> IO ()
traceEventIO message :: ByteString
message = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
userTracingEnabled (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
message ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr p :: Addr#
p) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case Addr# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> State# d -> State# d
traceEvent# Addr#
p State# RealWorld
s of
s' :: State# RealWorld
s' -> (# State# RealWorld
s', () #)
traceMarker :: B.ByteString -> a -> a
traceMarker :: ByteString -> a -> a
traceMarker message :: ByteString
message a :: a
a
| Bool
userTracingEnabled = IO a -> a
forall a. IO a -> a
Unsafe.unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO ()
traceMarkerIO ByteString
message
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = a
a
{-# NOINLINE traceMarker #-}
traceMarkerIO :: B.ByteString -> IO ()
traceMarkerIO :: ByteString -> IO ()
traceMarkerIO message :: ByteString
message = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
userTracingEnabled (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString ByteString
message ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr p :: Addr#
p) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case Addr# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> State# d -> State# d
traceMarker# Addr#
p State# RealWorld
s of
s' :: State# RealWorld
s' -> (# State# RealWorld
s', () #)
unsafeTraceEvent :: B.ByteString -> a -> a
unsafeTraceEvent :: ByteString -> a -> a
unsafeTraceEvent message :: ByteString
message a :: a
a
| Bool
userTracingEnabled = IO a -> a
forall a. IO a -> a
Unsafe.unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO ()
unsafeTraceEventIO ByteString
message
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = a
a
{-# NOINLINE unsafeTraceEvent #-}
unsafeTraceEventIO :: B.ByteString -> IO ()
unsafeTraceEventIO :: ByteString -> IO ()
unsafeTraceEventIO message :: ByteString
message = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
userTracingEnabled (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
message ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr p :: Addr#
p) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case Addr# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> State# d -> State# d
traceEvent# Addr#
p State# RealWorld
s of
s' :: State# RealWorld
s' -> (# State# RealWorld
s', () #)
unsafeTraceMarker :: B.ByteString -> a -> a
unsafeTraceMarker :: ByteString -> a -> a
unsafeTraceMarker message :: ByteString
message a :: a
a
| Bool
userTracingEnabled = IO a -> a
forall a. IO a -> a
Unsafe.unsafeDupablePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO ()
unsafeTraceEventIO ByteString
message
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
| Bool
otherwise = a
a
{-# NOINLINE unsafeTraceMarker #-}
unsafeTraceMarkerIO :: B.ByteString -> IO ()
unsafeTraceMarkerIO :: ByteString -> IO ()
unsafeTraceMarkerIO message :: ByteString
message = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
userTracingEnabled (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
message ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr p :: Addr#
p) -> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a. (State# RealWorld -> (# State# RealWorld, a #)) -> IO a
IO ((State# RealWorld -> (# State# RealWorld, () #)) -> IO ())
-> (State# RealWorld -> (# State# RealWorld, () #)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \s :: State# RealWorld
s ->
case Addr# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> State# d -> State# d
traceMarker# Addr#
p State# RealWorld
s of
s' :: State# RealWorld
s' -> (# State# RealWorld
s', () #)