{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-|
'T.Text' variant of the tracing functions in "Debug.Trace".
-}
module Debug.Trace.Text
  ( traceEvent
  , traceEventIO

  , traceMarker
  , traceMarkerIO
  ) where
import Control.Monad (when)
import Foreign.C.String (CString)
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.Text as T
import qualified Data.Text.Encoding as TE

import Debug.Trace.Flags (userTracingEnabled)

-- | 'T.Text' variant of 'Debug.Trace.traceEvent'.
--
-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and
-- convert it into a null-terminated 'Foreign.C.Types.CString'.
--
-- Note that this function doesn't evaluate the 'T.Text' if user tracing
-- in eventlog is disabled.
--
-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS
-- generates a broken eventlog.
traceEvent :: T.Text -> a -> a
traceEvent :: Text -> a -> a
traceEvent Text
message 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
    Text -> IO ()
traceEventIO Text
message
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  | Bool
otherwise = a
a
{-# NOINLINE traceEvent #-}

-- | 'T.Text' variant of 'Debug.Trace.traceEventIO'.
--
-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and
-- convert it into a null-terminated 'Foreign.C.Types.CString'.
--
-- Note that this function doesn't evaluate the 'T.Text' if user tracing
-- in eventlog is disabled.
--
-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS
-- generates a broken eventlog.
traceEventIO :: T.Text -> IO ()
traceEventIO :: Text -> IO ()
traceEventIO Text
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
$
  Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
message ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr 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
$ \State# RealWorld
s ->
    case Addr# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> State# d -> State# d
traceEvent# Addr#
p State# RealWorld
s of
      State# RealWorld
s' -> (# State# RealWorld
s', () #)

-- | 'T.Text' variant of 'Debug.Trace.traceMarker'.
--
-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and
-- convert it into a null-terminated 'Foreign.C.Types.CString'.
--
-- Note that this function doesn't evaluate the 'T.Text' if user tracing
-- in eventlog is disabled.
--
-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS
-- generates a broken eventlog.
traceMarker :: T.Text -> a -> a
traceMarker :: Text -> a -> a
traceMarker Text
message 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
    Text -> IO ()
traceMarkerIO Text
message
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
  | Bool
otherwise = a
a
{-# NOINLINE traceMarker #-}

-- | 'T.Text' variant of 'Debug.Trace.traceMarkerIO'.
--
-- \(O(n)\) This function marshals the 'T.Text' into a 'B.ByteString' and
-- convert it into a null-terminated 'Foreign.C.Types.CString'.
--
-- Note that this function doesn't evaluate the 'T.Text' if user tracing
-- in eventlog is disabled.
--
-- The input should be shorter than \(2^{16}\) bytes. Otherwise the RTS
-- generates a broken eventlog.
traceMarkerIO :: T.Text -> IO ()
traceMarkerIO :: Text -> IO ()
traceMarkerIO Text
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
$
  Text -> (CString -> IO ()) -> IO ()
forall a. Text -> (CString -> IO a) -> IO a
withCString Text
message ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr 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
$ \State# RealWorld
s ->
    case Addr# -> State# RealWorld -> State# RealWorld
forall d. Addr# -> State# d -> State# d
traceMarker# Addr#
p State# RealWorld
s of
      State# RealWorld
s' -> (# State# RealWorld
s', () #)

withCString :: T.Text -> (CString -> IO a) -> IO a
withCString :: Text -> (CString -> IO a) -> IO a
withCString Text
text = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
B.useAsCString (Text -> ByteString
TE.encodeUtf8 Text
text)