{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE CPP              #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# OPTIONS_GHC -Wno-unused-imports #-}
module Wingman.Debug
  ( unsafeRender
  , unsafeRender'
  , traceM
  , traceShowId
  , trace
  , traceX
  , traceIdX
  , traceMX
  , traceFX
  ) where

import           Control.DeepSeq
import           Control.Exception
import           Data.Either (fromRight)
import qualified Data.Text as T
import qualified Debug.Trace
import           Development.IDE.GHC.Compat (PlainGhcException, Outputable(..), SDoc)
import           Development.IDE.GHC.Util (printOutputable)
import           System.IO.Unsafe  (unsafePerformIO)

------------------------------------------------------------------------------
-- | 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 = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SDoc -> Text
forall a. Outputable a => a -> Text
printOutputable 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 PlainGhcException String
res <- forall a.
Exception PlainGhcException =>
IO a -> IO (Either PlainGhcException a)
forall e a. Exception e => IO a -> IO (Either e a)
try @PlainGhcException (IO String -> IO (Either PlainGhcException String))
-> IO String -> IO (Either PlainGhcException 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
$ String -> Either PlainGhcException String -> String
forall b a. b -> Either a b -> b
fromRight String
"<unsafeRender'>" Either PlainGhcException 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

traceFX :: String -> (a -> String) -> a -> a
traceFX :: String -> (a -> String) -> a -> a
traceFX String
str a -> String
f 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
f a
a) a
a

traceM :: Applicative f => String -> f ()
trace :: String -> a -> a
traceShowId :: Show a => a -> a
#ifdef DEBUG
traceM = Debug.Trace.traceM
trace = Debug.Trace.trace
traceShowId = Debug.Trace.traceShowId
#else
traceM :: String -> f ()
traceM String
_ = () -> f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
trace :: String -> a -> a
trace String
_ = a -> a
forall a. a -> a
id
traceShowId :: a -> a
traceShowId = a -> a
forall a. a -> a
id
#endif