{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE CPP              #-}
{-# LANGUAGE TypeApplications #-}

module Ide.Plugin.Tactic.Debug
  ( unsafeRender
  , unsafeRender'
  , traceM
  , traceShowId
  , trace
  , traceX
  , traceIdX
  , traceMX
  ) where

import Control.DeepSeq
import Control.Exception
import Debug.Trace
import DynFlags (unsafeGlobalDynFlags)
import Outputable hiding ((<>))
import System.IO.Unsafe (unsafePerformIO)

#if __GLASGOW_HASKELL__ >= 808
import PlainPanic (PlainGhcException)
type GHC_EXCEPTION = PlainGhcException
#else
import Panic (GhcException)
type GHC_EXCEPTION = GhcException
#endif


------------------------------------------------------------------------------
-- | Print something
unsafeRender :: Outputable a => a -> String
unsafeRender :: a -> String
unsafeRender = SDoc -> String
unsafeRender' (SDoc -> String) -> (a -> SDoc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
ppr


unsafeRender' :: SDoc -> String
unsafeRender' :: SDoc -> String
unsafeRender' SDoc
sdoc = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
  let z :: String
z = DynFlags -> SDoc -> String
showSDoc DynFlags
unsafeGlobalDynFlags SDoc
sdoc
  -- We might not have unsafeGlobalDynFlags (like during testing), in which
  -- case GHC panics. Instead of crashing, let's just fail to print.
  !Either GHC_EXCEPTION String
res <- forall a.
Exception GHC_EXCEPTION =>
IO a -> IO (Either GHC_EXCEPTION a)
forall e a. Exception e => IO a -> IO (Either e a)
try @GHC_EXCEPTION (IO String -> IO (Either GHC_EXCEPTION String))
-> IO String -> IO (Either GHC_EXCEPTION String)
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a b. NFData a => a -> b -> b
deepseq String
z String
z
  String -> IO String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ (GHC_EXCEPTION -> String)
-> (String -> String) -> Either GHC_EXCEPTION String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> GHC_EXCEPTION -> String
forall a b. a -> b -> a
const String
"<unsafeRender'>") String -> String
forall a. a -> a
id Either GHC_EXCEPTION String
res
{-# NOINLINE unsafeRender' #-}

traceMX :: (Monad m, Show a) => String -> a -> m ()
traceMX :: String -> a -> m ()
traceMX String
str a
a = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall a. Monoid a => a -> a -> a
mappend (String
"!!!" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a

traceX :: (Show a) => String -> a -> b -> b
traceX :: String -> a -> b -> b
traceX String
str a
a = String -> b -> b
forall a. String -> a -> a
trace (String -> String -> String
forall a. Monoid a => a -> a -> a
mappend (String
"!!!" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a)

traceIdX :: (Show a) => String -> a -> a
traceIdX :: String -> a -> a
traceIdX String
str a
a = String -> a -> a
forall a. String -> a -> a
trace (String -> String -> String
forall a. Monoid a => a -> a -> a
mappend (String
"!!!" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
str String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": ") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a) a
a