module RIO.Prelude.Trace
  ( -- ** Trace
    -- *** Text
    trace
  , traceId
  , traceIO
  , traceM
  , traceEvent
  , traceEventIO
  , traceMarker
  , traceMarkerIO
  , traceStack
    -- *** Show
  , traceShow
  , traceShowId
  , traceShowIO
  , traceShowM
  , traceShowEvent
  , traceShowEventIO
  , traceShowMarker
  , traceShowMarkerIO
  , traceShowStack
    -- *** Display
  , traceDisplay
  , traceDisplayId
  , traceDisplayIO
  , traceDisplayM
  , traceDisplayEvent
  , traceDisplayEventIO
  , traceDisplayMarker
  , traceDisplayMarkerIO
  , traceDisplayStack
  ) where

import qualified Debug.Trace as Trace

import           Control.Monad.IO.Class(MonadIO(..))
import           RIO.Prelude.Display
import           RIO.Text         (Text)
import qualified RIO.Text as Text

----------------------------------------------------
-- Text
----------------------------------------------------

{-# WARNING trace "Trace statement left in code" #-}
-- | @since 0.1.0.0
trace :: Text -> a -> a
trace :: Text -> a -> a
trace = String -> a -> a
forall a. String -> a -> a
Trace.trace (String -> a -> a) -> (Text -> String) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceId "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceId :: Text -> Text
traceId :: Text -> Text
traceId Text
str = String -> Text -> Text
forall a. String -> a -> a
Trace.trace (Text -> String
Text.unpack Text
str) Text
str

{-# WARNING traceIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceIO :: MonadIO m => Text -> m ()
traceIO :: Text -> m ()
traceIO = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Trace.traceIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceM "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceM :: Applicative f => Text -> f ()
traceM :: Text -> f ()
traceM = String -> f ()
forall (f :: * -> *). Applicative f => String -> f ()
Trace.traceM (String -> f ()) -> (Text -> String) -> Text -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceEvent "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceEvent :: Text -> a -> a
traceEvent :: Text -> a -> a
traceEvent = String -> a -> a
forall a. String -> a -> a
Trace.traceEvent (String -> a -> a) -> (Text -> String) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceEventIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceEventIO :: MonadIO m => Text -> m ()
traceEventIO :: Text -> m ()
traceEventIO = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Trace.traceEventIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceMarker "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceMarker :: Text -> a -> a
traceMarker :: Text -> a -> a
traceMarker = String -> a -> a
forall a. String -> a -> a
Trace.traceMarker (String -> a -> a) -> (Text -> String) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceMarkerIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceMarkerIO :: MonadIO m => Text -> m ()
traceMarkerIO :: Text -> m ()
traceMarkerIO = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Trace.traceMarkerIO (String -> IO ()) -> (Text -> String) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

{-# WARNING traceStack "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceStack :: Text -> a -> a
traceStack :: Text -> a -> a
traceStack = String -> a -> a
forall a. String -> a -> a
Trace.traceStack (String -> a -> a) -> (Text -> String) -> Text -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack

----------------------------------------------------
-- Show
----------------------------------------------------

{-# WARNING traceShow "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShow :: Show a => a -> b -> b
traceShow :: a -> b -> b
traceShow = a -> b -> b
forall a b. Show a => a -> b -> b
Trace.traceShow

{-# WARNING traceShowId "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowId :: Show a => a -> a
traceShowId :: a -> a
traceShowId = a -> a
forall a. Show a => a -> a
Trace.traceShowId

{-# WARNING traceShowIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowIO :: (Show a, MonadIO m) => a -> m ()
traceShowIO :: a -> m ()
traceShowIO = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Trace.traceIO (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# WARNING traceShowM "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowM :: (Show a, Applicative f) => a -> f ()
traceShowM :: a -> f ()
traceShowM = String -> f ()
forall (f :: * -> *). Applicative f => String -> f ()
Trace.traceM (String -> f ()) -> (a -> String) -> a -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# WARNING traceShowEvent "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowEvent :: Show a => a -> b -> b
traceShowEvent :: a -> b -> b
traceShowEvent = String -> b -> b
forall a. String -> a -> a
Trace.traceEvent (String -> b -> b) -> (a -> String) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# WARNING traceShowEventIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowEventIO :: (Show a, MonadIO m) => a -> m ()
traceShowEventIO :: a -> m ()
traceShowEventIO = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Trace.traceEventIO (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# WARNING traceShowMarker "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowMarker :: Show a => a -> b -> b
traceShowMarker :: a -> b -> b
traceShowMarker = String -> b -> b
forall a. String -> a -> a
Trace.traceMarker (String -> b -> b) -> (a -> String) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# WARNING traceShowMarkerIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowMarkerIO :: (Show a, MonadIO m) => a -> m ()
traceShowMarkerIO :: a -> m ()
traceShowMarkerIO = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
Trace.traceMarkerIO (String -> IO ()) -> (a -> String) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

{-# WARNING traceShowStack "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceShowStack :: Show a => a -> b -> b
traceShowStack :: a -> b -> b
traceShowStack = String -> b -> b
forall a. String -> a -> a
Trace.traceStack (String -> b -> b) -> (a -> String) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

----------------------------------------------------
-- Display
----------------------------------------------------

{-# WARNING traceDisplay "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplay :: Display a => a -> b -> b
traceDisplay :: a -> b -> b
traceDisplay = Text -> b -> b
forall a. Text -> a -> a
trace (Text -> b -> b) -> (a -> Text) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayId "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayId :: Display a => a -> a
traceDisplayId :: a -> a
traceDisplayId a
x = a -> a -> a
forall a b. Display a => a -> b -> b
traceDisplay a
x a
x

{-# WARNING traceDisplayIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayIO :: (Display a, MonadIO m) => a -> m ()
traceDisplayIO :: a -> m ()
traceDisplayIO = Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
traceIO (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayM "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayM :: (Display a, Applicative f) => a -> f ()
traceDisplayM :: a -> f ()
traceDisplayM = Text -> f ()
forall (f :: * -> *). Applicative f => Text -> f ()
traceM (Text -> f ()) -> (a -> Text) -> a -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayEvent "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayEvent :: Display a => a -> b -> b
traceDisplayEvent :: a -> b -> b
traceDisplayEvent = Text -> b -> b
forall a. Text -> a -> a
traceEvent (Text -> b -> b) -> (a -> Text) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayEventIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayEventIO :: (Display a, MonadIO m) => a -> m ()
traceDisplayEventIO :: a -> m ()
traceDisplayEventIO = Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
traceEventIO (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayMarker "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayMarker :: Display a => a -> b -> b
traceDisplayMarker :: a -> b -> b
traceDisplayMarker = Text -> b -> b
forall a. Text -> a -> a
traceMarker (Text -> b -> b) -> (a -> Text) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayMarkerIO "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayMarkerIO :: (Display a, MonadIO m) => a -> m ()
traceDisplayMarkerIO :: a -> m ()
traceDisplayMarkerIO = Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
traceMarkerIO (Text -> m ()) -> (a -> Text) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display

{-# WARNING traceDisplayStack "Trace statement left in code" #-}
-- | @since 0.1.0.0
traceDisplayStack :: Display a => a -> b -> b
traceDisplayStack :: a -> b -> b
traceDisplayStack = Text -> b -> b
forall a. Text -> a -> a
traceStack (Text -> b -> b) -> (a -> Text) -> a -> b -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Utf8Builder -> Text
utf8BuilderToText (Utf8Builder -> Text) -> (a -> Utf8Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Utf8Builder
forall a. Display a => a -> Utf8Builder
display