Move traceAst

Author: wz1000

ghcide/ghcide.cabal

@@ -172,7 +172,6 @@ library
         Development.IDE.GHC.Compat.Util
         Development.IDE.Core.Compile
         Development.IDE.GHC.CoreFile
-        Development.IDE.GHC.Dump
         Development.IDE.GHC.Error
         Development.IDE.GHC.Orphans
         Development.IDE.GHC.Util

ghcide/src/Development/IDE/GHC/Dump.hs

@@ -2,6 +2,7 @@
 module Development.IDE.GHC.Dump(showAstDataHtml) where
 import           Data.Data                       hiding (Fixity)
 import           Development.IDE.GHC.Compat      hiding (NameAnn)
+import           Development.IDE.GHC.ExactPrint  hiding (NameAnn)
 #if MIN_VERSION_ghc(8,10,1)
 import           GHC.Hs.Dump
 #else
@@ -21,18 +22,18 @@ import           GhcPlugins
 import           Prelude                         hiding ((<>))
 
 -- | Show a GHC syntax tree in HTML.
+#if MIN_VERSION_ghc(9,2,1)
+showAstDataHtml :: (Data a, ExactPrint a, Outputable a) => a -> SDoc
+#else
 showAstDataHtml :: (Data a, Outputable a) => a -> SDoc
+#endif
 showAstDataHtml a0 = html $
     header $$
     body (tag' [("id",text (show @String "myUL"))] "ul" $ vcat
         [
--- #if MIN_VERSION_ghc(9,2,1)
-
--- #else
 #if MIN_VERSION_ghc(9,2,1)
---             li (pre $ text (exactPrint a0)),
---             li (showAstDataHtml' a0),
---             li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0)
+            li (pre $ text (exactPrint a0)),
+            li (showAstDataHtml' a0),
             li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan NoBlankEpAnnotations a0)
 #else
             li (nested "Raw" $ pre $ showAstData NoBlankSrcSpan a0)
@@ -56,7 +57,6 @@ showAstDataHtml a0 = html $
     header = tag "head" $ tag "style" $ text css
     html = tag "html"
     pre = tag "pre"
-{-
 #if MIN_VERSION_ghc(9,2,1)
     showAstDataHtml' :: Data a => a -> SDoc
     showAstDataHtml' =
@@ -282,7 +282,6 @@ showAstDataHtml a0 = html $
                 Nothing -> text "locatedAnn:unmatched" <+> tag
                            <+> (text (showConstr (toConstr ss)))
 #endif
--}
 
 
 normalize_newlines :: String -> String

ghcide/src/Development/IDE/GHC/Util.hs

@@ -26,7 +26,6 @@ module Development.IDE.GHC.Util(
     setHieDir,
     dontWriteHieFiles,
     disableWarningsAsErrors,
-    traceAst,
     printOutputable
     ) where
 
@@ -70,7 +69,6 @@ import           Debug.Trace
 import           Development.IDE.GHC.Compat        as GHC
 import qualified Development.IDE.GHC.Compat.Parser as Compat
 import qualified Development.IDE.GHC.Compat.Units  as Compat
-import           Development.IDE.GHC.Dump          (showAstDataHtml)
 import           Development.IDE.Types.Location
 import           Foreign.ForeignPtr
 import           Foreign.Ptr
@@ -281,36 +279,6 @@ ioe_dupHandlesNotCompatible h =
 --------------------------------------------------------------------------------
 -- Tracing exactprint terms
 
-{-# NOINLINE timestamp #-}
-timestamp :: POSIXTime
-timestamp = utcTimeToPOSIXSeconds $ unsafePerformIO getCurrentTime
-
-debugAST :: Bool
-debugAST = unsafePerformIO (getEnvDefault "GHCIDE_DEBUG_AST" "0") == "1"
-
--- | Prints an 'Outputable' value to stderr and to an HTML file for further inspection
-traceAst :: (Data a, Outputable a, HasCallStack) => String -> a -> a
-traceAst lbl x
-  | debugAST = trace doTrace x
-  | otherwise = x
-  where
-#if MIN_VERSION_ghc(9,2,0)
-    renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True}
-#else
-    renderDump = showSDocUnsafe . ppr
-#endif
-    htmlDump = showAstDataHtml x
-    doTrace = unsafePerformIO $ do
-        u <- U.newUnique
-        let htmlDumpFileName = printf "/tmp/hls/%s-%s-%d.html" (show timestamp) lbl (U.hashUnique u)
-        writeFile htmlDumpFileName $ renderDump htmlDump
-        return $ unlines
-            [prettyCallStack callStack ++ ":"
--- #if MIN_VERSION_ghc(9,2,0)
-            -- , exactPrint x
--- #endif
-            , "file://" ++ htmlDumpFileName]
-
 -- Should in `Development.IDE.GHC.Orphans`,
 -- leave it here to prevent cyclic module dependency
 #if !MIN_VERSION_ghc(8,10,0)

plugins/hls-refactor-plugin/hls-refactor-plugin.cabal

@@ -21,6 +21,8 @@ library
   exposed-modules:  Development.IDE.GHC.ExactPrint
                     Development.IDE.GHC.Compat.ExactPrint
                     Development.IDE.Plugin.CodeAction
+                    Development.IDE.Plugin.CodeAction.Util
+                    Development.IDE.GHC.Dump
   other-modules:    Development.IDE.Plugin.CodeAction.Args
                     Development.IDE.Plugin.CodeAction.ExactPrint
                     Development.IDE.Plugin.CodeAction.PositionIndexed
@@ -53,6 +55,7 @@ library
     , aeson
     , base                  >=4.12 && <5
     , ghc
+    , bytestring
     , ghc-boot
     , regex-tdfa
     , text-rope
@@ -73,6 +76,7 @@ library
     , mtl
     , lens
     , data-default
+    , time
   ghc-options: -Wall -Wno-name-shadowing
   default-language: Haskell2010
 

plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs

@@ -34,6 +34,8 @@ import           GHC.Stack                       (HasCallStack)
 import           Language.Haskell.GHC.ExactPrint
 import           Language.LSP.Types
 
+import           Development.IDE.Plugin.CodeAction.Util
+
 -- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports.
 #if MIN_VERSION_ghc(9,2,0)
 import           Control.Lens   (_head, _last, over)