{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
module TextShow.Debug.Trace (
tracet
, tracetl
, tracetId
, tracetlId
, traceTextShow
, traceTextShowId
, tracetStack
, tracetlStack
, tracetIO
, tracetlIO
, tracetM
, tracetlM
, traceTextShowM
, tracetEvent
, tracetlEvent
, tracetEventIO
, tracetlEventIO
#if MIN_VERSION_base(4,7,0)
, tracetMarker
, tracetlMarker
, tracetMarkerIO
, tracetlMarkerIO
#endif
) where
import Control.Monad (unless)
import qualified Data.ByteString as BS (null, partition)
import Data.ByteString (ByteString, useAsCString)
import qualified Data.ByteString.Char8 as BS (pack)
import Data.ByteString.Internal (c2w)
import qualified Data.Text as TS (Text, unpack)
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Lazy as TL (Text, unpack)
import Data.Text.Lazy (toStrict)
import Debug.Trace
import Foreign.C.String (CString)
import GHC.Stack (currentCallStack, renderStack)
import Prelude ()
import Prelude.Compat
import System.IO.Unsafe (unsafePerformIO)
import TextShow.Classes (TextShow(..))
import TextShow.Instances ()
tracetIO :: TS.Text -> IO ()
tracetIO :: Text -> IO ()
tracetIO = ByteString -> IO ()
traceIOByteString (ByteString -> IO ()) -> (Text -> ByteString) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
tracetlIO :: TL.Text -> IO ()
tracetlIO :: Text -> IO ()
tracetlIO = Text -> IO ()
tracetIO (Text -> IO ()) -> (Text -> Text) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
traceIOByteString :: ByteString -> IO ()
traceIOByteString :: ByteString -> IO ()
traceIOByteString ByteString
msg = ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
"%s\n" ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cfmt -> do
let (ByteString
nulls, ByteString
msg') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.partition (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\0') ByteString
msg
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
msg' ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cmsg ->
CString -> CString -> IO ()
debugBelch CString
cfmt CString
cmsg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
BS.null ByteString
nulls) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
"WARNING: previous trace message had null bytes" ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
cmsg ->
CString -> CString -> IO ()
debugBelch CString
cfmt CString
cmsg
foreign import ccall unsafe "HsBase.h debugBelch2"
debugBelch :: CString -> CString -> IO ()
tracet :: TS.Text -> a -> a
tracet :: Text -> a -> a
tracet = ByteString -> a -> a
forall a. ByteString -> a -> a
traceByteString (ByteString -> a -> a) -> (Text -> ByteString) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
tracetl :: TL.Text -> a -> a
tracetl :: Text -> a -> a
tracetl = Text -> a -> a
forall a. Text -> a -> a
tracet (Text -> a -> a) -> (Text -> Text) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
{-# NOINLINE traceByteString #-}
traceByteString :: ByteString -> a -> a
traceByteString :: ByteString -> a -> a
traceByteString ByteString
bs a
expr = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO ()
traceIOByteString ByteString
bs
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
expr
tracetId :: TS.Text -> TS.Text
tracetId :: Text -> Text
tracetId Text
a = Text -> Text -> Text
forall a. Text -> a -> a
tracet Text
a Text
a
tracetlId :: TL.Text -> TL.Text
tracetlId :: Text -> Text
tracetlId Text
a = Text -> Text -> Text
forall a. Text -> a -> a
tracetl Text
a Text
a
traceTextShow :: TextShow a => a -> b -> b
traceTextShow :: a -> b -> b
traceTextShow = Text -> b -> b
forall a. Text -> a -> a
tracet (Text -> b -> b) -> (a -> Text) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. TextShow a => a -> Text
showt
traceTextShowId :: TextShow a => a -> a
traceTextShowId :: a -> a
traceTextShowId a
a = Text -> a -> a
forall a. Text -> a -> a
tracet (a -> Text
forall a. TextShow a => a -> Text
showt a
a) a
a
tracetM :: Applicative f => TS.Text -> f ()
tracetM :: Text -> f ()
tracetM Text
text = Text -> f () -> f ()
forall a. Text -> a -> a
tracet Text
text (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
tracetlM :: Applicative f => TL.Text -> f ()
tracetlM :: Text -> f ()
tracetlM Text
text = Text -> f () -> f ()
forall a. Text -> a -> a
tracetl Text
text (f () -> f ()) -> f () -> f ()
forall a b. (a -> b) -> a -> b
$ () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
traceTextShowM :: (TextShow a, Applicative f) => a -> f ()
traceTextShowM :: a -> f ()
traceTextShowM = Text -> f ()
forall (f :: * -> *). Applicative f => Text -> f ()
tracetM (Text -> f ()) -> (a -> Text) -> a -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. TextShow a => a -> Text
showt
tracetStack :: TS.Text -> a -> a
tracetStack :: Text -> a -> a
tracetStack = ByteString -> a -> a
forall a. ByteString -> a -> a
traceStackByteString (ByteString -> a -> a) -> (Text -> ByteString) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
tracetlStack :: TL.Text -> a -> a
tracetlStack :: Text -> a -> a
tracetlStack = Text -> a -> a
forall a. Text -> a -> a
tracetStack (Text -> a -> a) -> (Text -> Text) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toStrict
traceStackByteString :: ByteString -> a -> a
traceStackByteString :: ByteString -> a -> a
traceStackByteString ByteString
bs a
expr = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO ()
traceIOByteString ByteString
bs
[String]
stack <- IO [String]
currentCallStack
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
stack) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
traceIOByteString (ByteString -> IO ()) -> (String -> ByteString) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
BS.pack (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
renderStack [String]
stack
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
expr
tracetEvent :: TS.Text -> a -> a
tracetEvent :: Text -> a -> a
tracetEvent = String -> a -> a
forall a. String -> a -> a
traceEvent (String -> a -> a) -> (Text -> String) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TS.unpack
tracetlEvent :: TL.Text -> a -> a
tracetlEvent :: Text -> a -> a
tracetlEvent = String -> a -> a
forall a. String -> a -> a
traceEvent (String -> a -> a) -> (Text -> String) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
tracetEventIO :: TS.Text -> IO ()
tracetEventIO :: Text -> IO ()
tracetEventIO = String -> IO ()
traceEventIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TS.unpack
tracetlEventIO :: TL.Text -> IO ()
tracetlEventIO :: Text -> IO ()
tracetlEventIO = String -> IO ()
traceEventIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
#if MIN_VERSION_base(4,7,0)
tracetMarker :: TS.Text -> a -> a
tracetMarker :: Text -> a -> a
tracetMarker Text
msg = String -> a -> a
forall a. String -> a -> a
traceMarker (String -> a -> a) -> String -> a -> a
forall a b. (a -> b) -> a -> b
$ Text -> String
TS.unpack Text
msg
tracetlMarker :: TL.Text -> a -> a
tracetlMarker :: Text -> a -> a
tracetlMarker Text
msg = String -> a -> a
forall a. String -> a -> a
traceMarker (String -> a -> a) -> String -> a -> a
forall a b. (a -> b) -> a -> b
$ Text -> String
TL.unpack Text
msg
tracetMarkerIO :: TS.Text -> IO ()
tracetMarkerIO :: Text -> IO ()
tracetMarkerIO = String -> IO ()
traceMarkerIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TS.unpack
tracetlMarkerIO :: TL.Text -> IO ()
tracetlMarkerIO :: Text -> IO ()
tracetlMarkerIO = String -> IO ()
traceMarkerIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
TL.unpack
#endif