module Development.IDE.Plugin.CodeAction.Util where

import           Data.Data                             (Data)
import           Data.Time.Clock.POSIX                 (POSIXTime,
                                                        getCurrentTime,
                                                        utcTimeToPOSIXSeconds)
import qualified Data.Unique                           as U
import           Debug.Trace
import           Development.IDE.GHC.Compat.ExactPrint as GHC
import           Development.IDE.GHC.Dump              (showAstDataHtml)
import           GHC.Stack
import           System.Environment.Blank              (getEnvDefault)
import           System.IO.Unsafe
import           Text.Printf
#if MIN_VERSION_ghc(9,2,0)
import           GHC.Utils.Outputable
#else
import           Development.IDE.GHC.Compat
import           Development.IDE.GHC.Compat.Util
import           Development.IDE.GHC.Util
#endif
--------------------------------------------------------------------------------
-- Tracing exactprint terms

-- Should in `Development.IDE.GHC.Orphans`,
-- leave it here to prevent cyclic module dependency

{-# NOINLINE timestamp #-}
timestamp :: POSIXTime
timestamp :: POSIXTime
timestamp = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds forall a b. (a -> b) -> a -> b
$ forall a. IO a -> a
unsafePerformIO IO UTCTime
getCurrentTime

debugAST :: Bool
debugAST :: Bool
debugAST = forall a. IO a -> a
unsafePerformIO (String -> String -> IO String
getEnvDefault String
"GHCIDE_DEBUG_AST" String
"0") forall a. Eq a => a -> a -> Bool
== String
"1"

-- | Prints an 'Outputable' value to stderr and to an HTML file for further inspection
traceAst :: (Data a, ExactPrint a, Outputable a, HasCallStack) => String -> a -> a
traceAst :: forall a.
(Data a, ExactPrint a, Outputable a, HasCallStack) =>
String -> a -> a
traceAst String
lbl a
x
  | Bool
debugAST = forall a. String -> a -> a
trace String
doTrace a
x
  | Bool
otherwise = a
x
  where
#if MIN_VERSION_ghc(9,2,0)
    renderDump :: SDoc -> String
renderDump = SDocContext -> SDoc -> String
renderWithContext SDocContext
defaultSDocContext{sdocStyle :: PprStyle
sdocStyle = PprStyle
defaultDumpStyle, sdocPprDebug :: Bool
sdocPprDebug = Bool
True}
#else
    renderDump = showSDocUnsafe . ppr
#endif
    htmlDump :: SDoc
htmlDump = forall a. (Data a, ExactPrint a, Outputable a) => a -> SDoc
showAstDataHtml a
x
    doTrace :: String
doTrace = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
        Unique
u <- IO Unique
U.newUnique
        let htmlDumpFileName :: String
htmlDumpFileName = forall r. PrintfType r => String -> r
printf String
"/tmp/hls/%s-%s-%d.html" (forall a. Show a => a -> String
show POSIXTime
timestamp) String
lbl (Unique -> Int
U.hashUnique Unique
u)
        String -> String -> IO ()
writeFile String
htmlDumpFileName forall a b. (a -> b) -> a -> b
$ SDoc -> String
renderDump SDoc
htmlDump
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
            [CallStack -> String
prettyCallStack HasCallStack => CallStack
callStack forall a. [a] -> [a] -> [a]
++ String
":"
#if MIN_VERSION_ghc(9,2,0)
            , forall ast. ExactPrint ast => ast -> String
exactPrint a
x
#endif
            , String
"file://" forall a. [a] -> [a] -> [a]
++ String
htmlDumpFileName]