{-# options_haddock prune #-}

-- |Utility functions for trace-printing values prefixed with the current source location.
module Incipit.Debug where

import qualified Data.Text as Text
import Data.Text (Text)
import GHC.Stack (CallStack, SrcLoc (..), callStack, getCallStack)
import System.IO.Unsafe (unsafePerformIO)

import Incipit.Base (
  Applicative (pure),
  Functor ((<$)),
  HasCallStack,
  IO,
  Monad,
  Semigroup ((<>)),
  Show,
  error,
  fromMaybe,
  putStrLn,
  )
import Incipit.List (last)
import Incipit.String.Conversion (ToString (toString), ToText (toText), show)

srcLoc :: CallStack -> SrcLoc
srcLoc :: CallStack -> SrcLoc
srcLoc = \case
  (CallStack -> [([Char], SrcLoc)]
getCallStack -> ([Char]
_, SrcLoc
loc) : [([Char], SrcLoc)]
_) -> SrcLoc
loc
  CallStack
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"Debug.srcLoc: empty CallStack"

debugPrint ::
  SrcLoc ->
  Text ->
  IO ()
debugPrint :: SrcLoc -> Text -> IO ()
debugPrint SrcLoc {srcLocModule :: SrcLoc -> [Char]
srcLocModule = (forall a. ToText a => a -> Text
toText -> Text
slm), Int
srcLocStartLine :: SrcLoc -> Int
srcLocStartLine :: Int
srcLocStartLine} !Text
msg =
  [Char] -> IO ()
putStrLn (forall a. ToString a => a -> [Char]
toString Text
moduleName forall a. Semigroup a => a -> a -> a
<> [Char]
":" forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show Int
srcLocStartLine forall a. Semigroup a => a -> a -> a
<> [Char]
" " forall a. Semigroup a => a -> a -> a
<> forall a. ToString a => a -> [Char]
toString Text
msg)
  where
    moduleName :: Text
moduleName =
      forall a. a -> Maybe a -> a
fromMaybe Text
slm (forall a. [a] -> Maybe a
last (Text -> Text -> [Text]
Text.splitOn Text
"." Text
slm))

debugPrintWithLoc ::
  Monad m =>
  SrcLoc ->
  Text ->
  m ()
debugPrintWithLoc :: forall (m :: * -> *). Monad m => SrcLoc -> Text -> m ()
debugPrintWithLoc SrcLoc
loc Text
msg = do
  () <- forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  () <- forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. IO a -> a
unsafePerformIO (SrcLoc -> Text -> IO ()
debugPrint SrcLoc
loc Text
msg))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- |Print a 'Text' in an arbitrary 'Monad'.
dbg ::
  HasCallStack =>
  Monad m =>
  Text ->
  m ()
dbg :: forall (m :: * -> *). (HasCallStack, Monad m) => Text -> m ()
dbg =
  forall (m :: * -> *). Monad m => SrcLoc -> Text -> m ()
debugPrintWithLoc (CallStack -> SrcLoc
srcLoc HasCallStack => CallStack
callStack)
{-# noinline dbg #-}

-- |Print a value with a 'Show' instance in an arbitrary 'Monad'.
dbgs ::
  ∀ a m .
  HasCallStack =>
  Monad m =>
  Show a =>
  a ->
  m ()
dbgs :: forall a (m :: * -> *).
(HasCallStack, Monad m, Show a) =>
a -> m ()
dbgs a
a =
  forall (m :: * -> *). Monad m => SrcLoc -> Text -> m ()
debugPrintWithLoc (CallStack -> SrcLoc
srcLoc HasCallStack => CallStack
callStack) (forall b a. (Show a, IsString b) => a -> b
show a
a)
{-# noinline dbgs_ #-}

-- |Print a value with a 'Show' instance in an arbitrary 'Monad', returning the value.
dbgs_ ::
  ∀ a m .
  HasCallStack =>
  Monad m =>
  Show a =>
  a ->
  m a
dbgs_ :: forall a (m :: * -> *). (HasCallStack, Monad m, Show a) => a -> m a
dbgs_ a
a =
  a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). Monad m => SrcLoc -> Text -> m ()
debugPrintWithLoc (CallStack -> SrcLoc
srcLoc HasCallStack => CallStack
callStack) (forall b a. (Show a, IsString b) => a -> b
show a
a)
{-# noinline dbgs #-}

-- |Like 'Debug.Trace.trace', but with 'Text' and with source location prefix.
tr ::
  HasCallStack =>
  Text ->
  a ->
  a
tr :: forall a. HasCallStack => Text -> a -> a
tr Text
msg a
a =
  forall a. IO a -> a
unsafePerformIO (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SrcLoc -> Text -> IO ()
debugPrint (CallStack -> SrcLoc
srcLoc HasCallStack => CallStack
callStack) Text
msg)
{-# noinline tr #-}

-- |Like 'Debug.Trace.traceShow', but with source location prefix.
trs ::
  ∀ b a .
  Show b =>
  HasCallStack =>
  b ->
  a ->
  a
trs :: forall b a. (Show b, HasCallStack) => b -> a -> a
trs b
b a
a =
  forall a. IO a -> a
unsafePerformIO (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SrcLoc -> Text -> IO ()
debugPrint (CallStack -> SrcLoc
srcLoc HasCallStack => CallStack
callStack) (forall b a. (Show a, IsString b) => a -> b
show b
b))
{-# noinline trs #-}

-- |Like 'Debug.Trace.traceShowId', but with source location prefix.
trsi ::
  Show a =>
  HasCallStack =>
  a ->
  a
trsi :: forall a. (Show a, HasCallStack) => a -> a
trsi a
a =
  forall a. IO a -> a
unsafePerformIO (a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ SrcLoc -> Text -> IO ()
debugPrint (CallStack -> SrcLoc
srcLoc HasCallStack => CallStack
callStack) (forall b a. (Show a, IsString b) => a -> b
show a
a))
{-# noinline trsi #-}