diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index ff63fa5fb50..aa1252c87e8 100644 --- a/ghcide/ghcide.cabal +++ b/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 diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index bafd74f1e78..4776626aa68 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/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) diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 051c56d494e..9461819f089 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/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 diff --git a/ghcide/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs similarity index 98% rename from ghcide/src/Development/IDE/GHC/Dump.hs rename to plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index 8368a291259..abaaa81cfb1 100644 --- a/ghcide/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/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.Compat.ExactPrint #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 diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 94a1a6831b8..57da3ee2f61 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/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) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs new file mode 100644 index 00000000000..553ea676b2d --- /dev/null +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs @@ -0,0 +1,60 @@ +module Development.IDE.Plugin.CodeAction.Util where + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Utils.Outputable +#else +import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Compat +#endif +import Data.Data (Data) +import qualified Data.Unique as U +import Debug.Trace +import Development.IDE.GHC.Compat.ExactPrint as GHC +import GHC.Stack +import System.Environment.Blank (getEnvDefault) +import System.IO.Unsafe +import Text.Printf +import Development.IDE.GHC.Dump (showAstDataHtml) +import Data.Time.Clock.POSIX (POSIXTime, getCurrentTime, + utcTimeToPOSIXSeconds) +-------------------------------------------------------------------------------- +-- Tracing exactprint terms + +-- Should in `Development.IDE.GHC.Orphans`, +-- leave it here to prevent cyclic module dependency + +#if !MIN_VERSION_ghc(8,10,0) +instance Outputable SDoc where + ppr = id +#endif + +{-# 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, ExactPrint 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] +