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           GHC.Utils.Outputable
import           System.Environment.Blank              (getEnvDefault)
import           System.IO.Unsafe
import           Text.Printf
--------------------------------------------------------------------------------
-- 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 (UTCTime -> POSIXTime) -> UTCTime -> POSIXTime
forall a b. (a -> b) -> a -> b
$ IO UTCTime -> UTCTime
forall a. IO a -> a
unsafePerformIO IO UTCTime
getCurrentTime

debugAST :: Bool
debugAST :: Bool
debugAST = IO String -> String
forall a. IO a -> a
unsafePerformIO (String -> String -> IO String
getEnvDefault String
"GHCIDE_DEBUG_AST" String
"0") String -> String -> Bool
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, HasCallStack) => String -> a -> a
traceAst :: forall a. (Data a, ExactPrint a, HasCallStack) => String -> a -> a
traceAst String
lbl a
x
  | Bool
debugAST = String -> a -> a
forall a. String -> a -> a
trace String
doTrace a
x
  | Bool
otherwise = a
x
  where
    renderDump :: SDoc -> String
renderDump = SDocContext -> SDoc -> String
renderWithContext SDocContext
defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True}
    htmlDump :: SDoc
htmlDump = a -> SDoc
forall a. (Data a, ExactPrint a) => a -> SDoc
showAstDataHtml a
x
    doTrace :: String
doTrace = IO String -> String
forall a. IO a -> a
unsafePerformIO (IO String -> String) -> IO String -> String
forall a b. (a -> b) -> a -> b
$ do
        Unique
u <- IO Unique
U.newUnique
        let htmlDumpFileName :: String
htmlDumpFileName = String -> String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"/tmp/hls/%s-%s-%d.html" (POSIXTime -> String
forall a. Show a => a -> String
show POSIXTime
timestamp) String
lbl (Unique -> Int
U.hashUnique Unique
u)
        String -> String -> IO ()
writeFile String
htmlDumpFileName (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ SDoc -> String
renderDump SDoc
htmlDump
        String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
            [CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":"
            , a -> String
forall ast. ExactPrint ast => ast -> String
exactPrint a
x
            , String
"file://" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
htmlDumpFileName]