diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 99938bd430..7cfbbc893f 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -1301,7 +1301,7 @@ getDocsBatch hsc_env _mod _names = do #endif Map.findWithDefault mempty name amap)) case res of - Just x -> return $ map (first $ T.unpack . showGhc) x + Just x -> return $ map (first $ T.unpack . printOutputable) x Nothing -> throwErrors #if MIN_VERSION_ghc(9,2,0) $ Error.getErrorMessages msgs diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index f1ace4693b..65189a90db 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -8,8 +8,7 @@ module Development.IDE.GHC.Compat.Outputable ( showSDocForUser, ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, printSDocQualifiedUnsafe, - printNameWithoutUniques, - printSDocAllTheWay, + printWithoutUniques, mkPrintUnqualified, mkPrintUnqualifiedDefault, PrintUnqualified(..), @@ -68,14 +67,24 @@ import qualified Outputable as Out import SrcLoc #endif -printNameWithoutUniques :: Outputable a => a -> String -printNameWithoutUniques = +-- | A compatible function to print `Outputable` instances +-- without unique symbols. +-- +-- It print with a user-friendly style like: `a_a4ME` as `a`. +printWithoutUniques :: Outputable a => a -> String +printWithoutUniques = #if MIN_VERSION_ghc(9,2,0) - renderWithContext (defaultSDocContext { sdocSuppressUniques = True }) . ppr + renderWithContext (defaultSDocContext + { + sdocStyle = defaultUserStyle + , sdocSuppressUniques = True + , sdocCanUseUnicode = True + }) . ppr #else - printSDocAllTheWay dyn . ppr - where - dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques + go . ppr + where + go sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags neverQualify AllTheWay) + dflags = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques #endif printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String @@ -91,15 +100,7 @@ printSDocQualifiedUnsafe unqual doc = showSDocForUser unsafeGlobalDynFlags unqual doc #endif -printSDocAllTheWay :: DynFlags -> SDoc -> String -#if MIN_VERSION_ghc(9,2,0) -printSDocAllTheWay dflags sdoc = renderWithContext ctxt sdoc - where - ctxt = initSDocContext dflags (mkUserStyle neverQualify AllTheWay) -#else -printSDocAllTheWay dflags sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags Out.neverQualify Out.AllTheWay) - -#if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc oldMkUserStyle _ = Out.mkUserStyle oldMkErrStyle _ = Out.mkErrStyle @@ -107,8 +108,7 @@ oldMkErrStyle _ = Out.mkErrStyle oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext where dummySDocContext = initSDocContext dflags Out.defaultUserStyle - -#else +#elif !MIN_VERSION_ghc(9,0,0) oldRenderWithStyle :: DynFlags -> Out.SDoc -> Out.PprStyle -> String oldRenderWithStyle = Out.renderWithStyle @@ -121,7 +121,6 @@ oldMkErrStyle = Out.mkErrStyle oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc oldFormatErrDoc = Err.formatErrDoc #endif -#endif pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc pprWarning = diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 4eae21c2a3..11905b22d1 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -39,6 +39,7 @@ import Data.Aeson import Data.Bifunctor (Bifunctor (..)) import Data.Hashable import Data.String (IsString (fromString)) +import Data.Text (unpack) #if MIN_VERSION_ghc(9,0,0) import GHC.ByteCode.Types #else @@ -46,27 +47,27 @@ import ByteCodeTypes #endif -- Orphan instances for types from the GHC API. -instance Show CoreModule where show = prettyPrint +instance Show CoreModule where show = unpack . printOutputable instance NFData CoreModule where rnf = rwhnf -instance Show CgGuts where show = prettyPrint . cg_module +instance Show CgGuts where show = unpack . printOutputable . cg_module instance NFData CgGuts where rnf = rwhnf instance Show ModDetails where show = const "" instance NFData ModDetails where rnf = rwhnf instance NFData SafeHaskellMode where rnf = rwhnf -instance Show Linkable where show = prettyPrint +instance Show Linkable where show = unpack . printOutputable instance NFData Linkable where rnf (LM a b c) = rnf a `seq` rnf b `seq` rnf c instance NFData Unlinked where rnf (DotO f) = rnf f rnf (DotA f) = rnf f rnf (DotDLL f) = rnf f rnf (BCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b -instance Show PackageFlag where show = prettyPrint -instance Show InteractiveImport where show = prettyPrint -instance Show PackageName where show = prettyPrint +instance Show PackageFlag where show = unpack . printOutputable +instance Show InteractiveImport where show = unpack . printOutputable +instance Show PackageName where show = unpack . printOutputable #if !MIN_VERSION_ghc(9,0,1) -instance Show ComponentId where show = prettyPrint -instance Show SourcePackageId where show = prettyPrint +instance Show ComponentId where show = unpack . printOutputable +instance Show SourcePackageId where show = unpack . printOutputable instance Show GhcPlugins.InstalledUnitId where show = installedUnitIdString @@ -76,7 +77,7 @@ instance NFData GhcPlugins.InstalledUnitId where rnf = rwhnf . installedUnitIdFS instance Hashable GhcPlugins.InstalledUnitId where hashWithSalt salt = hashWithSalt salt . installedUnitIdString #else -instance Show UnitId where show = prettyPrint +instance Show UnitId where show = unpack . printOutputable deriving instance Ord SrcSpan deriving instance Ord UnhelpfulSpanReason #endif @@ -86,7 +87,7 @@ instance NFData SB.StringBuffer where rnf = rwhnf instance Show Module where show = moduleNameString . moduleName -instance Outputable a => Show (GenLocated SrcSpan a) where show = prettyPrint +instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable instance (NFData l, NFData e) => NFData (GenLocated l e) where rnf (L l e) = rnf l `seq` rnf e @@ -207,5 +208,5 @@ instance (NFData (HsModule a)) where #endif rnf = rwhnf -instance Show OccName where show = prettyPrint +instance Show OccName where show = unpack . printOutputable instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n) diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 4e002b13ec..0ddd12faf6 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -7,8 +7,6 @@ module Development.IDE.GHC.Util( modifyDynFlags, evalGhcEnv, -- * GHC wrappers - prettyPrint, - unsafePrintSDoc, printRdrName, Development.IDE.GHC.Util.printName, ParseResult(..), runParser, @@ -28,7 +26,9 @@ module Development.IDE.GHC.Util( setHieDir, dontWriteHieFiles, disableWarningsAsErrors, - traceAst) where + traceAst, + printOutputable + ) where #if MIN_VERSION_ghc(9,2,0) import GHC.Data.FastString @@ -130,16 +130,9 @@ stringBufferToByteString StringBuffer{..} = PS buf cur len bytestringToStringBuffer :: ByteString -> StringBuffer bytestringToStringBuffer (PS buf cur len) = StringBuffer{..} --- | Pretty print a GHC value using 'unsafeGlobalDynFlags '. -prettyPrint :: Outputable a => a -> String -prettyPrint = unsafePrintSDoc . ppr - -unsafePrintSDoc :: SDoc -> String -unsafePrintSDoc sdoc = showSDocUnsafe sdoc - -- | Pretty print a 'RdrName' wrapping operators in parens printRdrName :: RdrName -> String -printRdrName name = showSDocUnsafe $ parenSymOcc rn (ppr rn) +printRdrName name = T.unpack $ printOutputable $ parenSymOcc rn (ppr rn) where rn = rdrNameOcc name @@ -304,7 +297,7 @@ traceAst lbl x #if MIN_VERSION_ghc(9,2,0) renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True} #else - renderDump = unsafePrintSDoc + renderDump = showSDocUnsafe . ppr #endif htmlDump = showAstDataHtml x doTrace = unsafePerformIO $ do @@ -318,4 +311,18 @@ traceAst lbl 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) +instance Outputable SDoc where + ppr = id +#endif +-- | Print a GHC value in `defaultUserStyle` without unique symbols. +-- +-- This is the most common print utility, will print with a user-friendly style like: `a_a4ME` as `a`. +-- +-- It internal using `showSDocUnsafe` with `unsafeGlobalDynFlags`. +printOutputable :: Outputable a => a -> T.Text +printOutputable = T.pack . printWithoutUniques +{-# INLINE printOutputable #-} diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 17d6622312..0a45688fef 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -13,7 +13,6 @@ import Control.Monad.IO.Class import Data.Functor import Data.Generics import Data.Maybe -import Data.Text (Text, pack) import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake @@ -21,6 +20,7 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (rangeToRealSrcSpan, realSrcSpanToRange) import Development.IDE.Types.Location +import Development.IDE.GHC.Util (printOutputable) import Language.LSP.Server (LspM) import Language.LSP.Types (DocumentSymbol (..), DocumentSymbolParams (DocumentSymbolParams, _textDocument), @@ -47,7 +47,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif moduleSymbol = hsmodName >>= \case (L (locA -> (RealSrcSpan l _)) m) -> Just $ (defDocumentSymbol l :: DocumentSymbol) - { _name = pprText m + { _name = printOutputable m , _kind = SkFile , _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0 } @@ -70,18 +70,18 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } })) = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName n - <> (case pprText fdTyVars of + { _name = printOutputable n + <> (case printOutputable fdTyVars of "" -> "" t -> " " <> t ) - , _detail = Just $ pprText fdInfo + , _detail = Just $ printOutputable fdInfo , _kind = SkFunction } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars })) = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName name - <> (case pprText tcdTyVars of + { _name = printOutputable name + <> (case printOutputable tcdTyVars of "" -> "" t -> " " <> t ) @@ -90,7 +90,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLNa , _children = Just $ List [ (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName n + { _name = printOutputable n , _kind = SkMethod , _selectionRange = realSrcSpanToRange l' } @@ -100,12 +100,12 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLNa } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } })) = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName name + { _name = printOutputable name , _kind = SkStruct , _children = Just $ List [ (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName n + { _name = printOutputable n , _kind = SkConstructor , _selectionRange = realSrcSpanToRange l' #if MIN_VERSION_ghc(9,2,0) @@ -123,7 +123,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam where cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol cvtFld (L (RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName (unLoc (rdrNameFieldOcc n)) + { _name = printOutputable (unLoc (rdrNameFieldOcc n)) , _kind = SkField } cvtFld _ = Nothing @@ -138,7 +138,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam -- | Extract the record fields of a constructor conArgRecordFields (RecCon (L _ lcdfs)) = Just $ List [ (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName n + { _name = printOutputable n , _kind = SkField } | L _ cdf <- lcdfs @@ -147,12 +147,12 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam conArgRecordFields _ = Nothing #endif documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ SynDecl { tcdLName = L (locA -> (RealSrcSpan l' _)) n })) = Just - (defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n + (defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable n , _kind = SkTypeParameter , _selectionRange = realSrcSpanToRange l' } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } })) - = Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty + = Just (defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable cid_poly_ty , _kind = SkInterface } #if MIN_VERSION_ghc(9,2,0) @@ -161,8 +161,8 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfi documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) #endif = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords - (map pprText feqn_pats) + { _name = printOutputable (unLoc feqn_tycon) <> " " <> T.unwords + (map printOutputable feqn_pats) , _kind = SkInterface } #if MIN_VERSION_ghc(9,2,0) @@ -171,24 +171,24 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_ documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } })) #endif = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords - (map pprText feqn_pats) + { _name = printOutputable (unLoc feqn_tycon) <> " " <> T.unwords + (map printOutputable feqn_pats) , _kind = SkInterface } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (DerivD _ DerivDecl { deriv_type })) = gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) -> - (defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs) + (defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable @(HsType GhcPs) name , _kind = SkInterface } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ FunBind{fun_id = L _ name})) = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = showRdrName name + { _name = printOutputable name , _kind = SkFunction } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ PatBind{pat_lhs})) = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = pprText pat_lhs + { _name = printOutputable pat_lhs , _kind = SkFunction } @@ -204,7 +204,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ForD _ x)) = Just ForeignExport{} -> Just "export" XForeignDecl{} -> Nothing } - where name = showRdrName $ unLoc $ fd_name x + where name = printOutputable $ unLoc $ fd_name x documentSymbolForDecl _ = Nothing @@ -228,7 +228,7 @@ documentSymbolForImportSummary importSymbols = documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol documentSymbolForImport (L (locA -> (RealSrcSpan l _)) ImportDecl { ideclName, ideclQualified }) = Just (defDocumentSymbol l :: DocumentSymbol) - { _name = "import " <> pprText ideclName + { _name = "import " <> printOutputable ideclName , _kind = SkModule #if MIN_VERSION_ghc(8,10,0) , _detail = case ideclQualified of { NotQualified -> Nothing; _ -> Just "qualified" } @@ -249,12 +249,6 @@ defDocumentSymbol l = DocumentSymbol { .. } where _children = Nothing _tags = Nothing -showRdrName :: RdrName -> Text -showRdrName = pprText - -pprText :: Outputable a => a -> Text -pprText = pack . showSDocUnsafe . ppr - -- the version of getConNames for ghc9 is restricted to only the renaming phase #if !MIN_VERSION_ghc(9,2,0) getConNames' :: ConDecl GhcPs -> [Located (IdP GhcPs)] diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 1585864279..b939c46538 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -48,15 +48,13 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint -import Development.IDE.GHC.Util (prettyPrint, +import Development.IDE.GHC.Util (printOutputable, printRdrName, - traceAst, - unsafePrintSDoc) + traceAst) import Development.IDE.Plugin.CodeAction.Args import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.CodeAction.PositionIndexed import Development.IDE.Plugin.TypeLenses (suggestSignature) -import Development.IDE.Spans.Common import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options @@ -546,7 +544,7 @@ suggestDeleteUnusedBinding isTheBinding span = srcSpanToRange span == Just _range isSameName :: IdP GhcPs -> String -> Bool - isSameName x name = showSDocUnsafe (ppr x) == name + isSameName x name = T.unpack (printOutputable x) == name data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll deriving (Eq) @@ -1013,7 +1011,7 @@ occursUnqualified symbol ImportDecl{..} occursUnqualified _ _ = False symbolOccursIn :: T.Text -> IE GhcPs -> Bool -symbolOccursIn symb = any ((== symb). showNameWithoutUniques) . ieNames +symbolOccursIn symb = any ((== symb). printOutputable) . ieNames targetModuleName :: ModuleTarget -> ModuleName targetModuleName ImplicitPrelude{} = mkModuleName "Prelude" @@ -1047,12 +1045,12 @@ disambiguateSymbol pm fileContents Diagnostic {..} (T.unpack -> symbol) = \case in Right <$> [ if parensed then Rewrite (rangeToSrcSpan "" _range) $ \df -> liftParseAST @(HsExpr GhcPs) df $ - prettyPrint $ + T.unpack $ printOutputable $ HsVar @GhcPs noExtField $ reLocA $ L (mkGeneralSrcSpan "") rdr else Rewrite (rangeToSrcSpan "" _range) $ \df -> liftParseAST @RdrName df $ - prettyPrint $ L (mkGeneralSrcSpan "") rdr + T.unpack $ printOutputable $ L (mkGeneralSrcSpan "") rdr ] findImportDeclByRange :: [LImportDecl GhcPs] -> Range -> Maybe (LImportDecl GhcPs) findImportDeclByRange xs range = find (\(L (locA -> l) _)-> srcSpanToRange l == Just range) xs @@ -1423,7 +1421,7 @@ newImport modName mSymbol mQual hiding = NewImport impStmt symImp | Just symbol <- mSymbol , symOcc <- mkVarOcc $ T.unpack symbol = - " (" <> T.pack (unsafePrintSDoc (parenSymOcc symOcc $ ppr symOcc)) <> ")" + " (" <> printOutputable (parenSymOcc symOcc $ ppr symOcc) <> ")" | otherwise = "" impStmt = "import " @@ -1617,32 +1615,32 @@ smallerRangesForBindingExport lies b = b' = wrapOperatorInParens . unqualify $ b #if !MIN_VERSION_ghc(9,2,0) ranges' (L _ (IEThingWith _ thing _ inners labels)) - | showSDocUnsafe (ppr thing) == b' = [] + | T.unpack (printOutputable thing) == b' = [] | otherwise = - [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b'] - ++ [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b'] + [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] + ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b'] #else ranges' (L _ (IEThingWith _ thing _ inners)) - | showSDocUnsafe (ppr thing) == b' = [] + | T.unpack (printOutputable thing) == b' = [] | otherwise = - [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b'] + [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] #endif ranges' _ = [] rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan] -rangesForBinding' b (L (locA -> l) x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l] -rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | showSDocUnsafe (ppr x) == b = [l] -rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | showSDocUnsafe (ppr x) == b = [l] +rangesForBinding' b (L (locA -> l) x@IEVar{}) | T.unpack (printOutputable x) == b = [l] +rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | T.unpack (printOutputable x) == b = [l] +rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | T.unpack (printOutputable x) == b = [l] #if !MIN_VERSION_ghc(9,2,0) rangesForBinding' b (L l (IEThingWith _ thing _ inners labels)) #else rangesForBinding' b (L (locA -> l) (IEThingWith _ thing _ inners)) #endif - | showSDocUnsafe (ppr thing) == b = [l] + | T.unpack (printOutputable thing) == b = [l] | otherwise = - [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b] + [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b] #if !MIN_VERSION_ghc(9,2,0) - ++ [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b] + ++ [ l' | L l' x <- labels, T.unpack (printOutputable x) == b] #endif rangesForBinding' _ _ = [] diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 18019b83f6..1e6675275d 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -355,8 +355,8 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) top <- uniqueSrcSpanT let rdr = reLocA $ L src $ mkRdrUnqual $ mkVarOcc thing let alreadyImported = - showNameWithoutUniques (occName (unLoc rdr)) - `elem` map (showNameWithoutUniques @OccName) (listify (const True) lies) + printOutputable (occName (unLoc rdr)) + `elem` map (printOutputable @OccName) (listify (const True) lies) when alreadyImported $ lift (Left $ thing <> " already imported") @@ -456,8 +456,8 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) childRdr <- pure $ setEntryDP childRdr $ SameLine $ if hasSibling then 1 else 0 #endif let alreadyImported = - showNameWithoutUniques (occName (unLoc childRdr)) - `elem` map (showNameWithoutUniques @OccName) (listify (const True) lies') + printOutputable (occName (unLoc childRdr)) + `elem` map (printOutputable @OccName) (listify (const True) lies') when alreadyImported $ lift (Left $ child <> " already included in " <> parent <> " imports") @@ -542,7 +542,7 @@ addCommaInImportList lies x = do #endif unIEWrappedName :: IEWrappedName (IdP GhcPs) -> String -unIEWrappedName (occName -> occ) = showSDocUnsafe $ parenSymOcc occ (ppr occ) +unIEWrappedName (occName -> occ) = T.unpack $ printOutputable $ parenSymOcc occ (ppr occ) hasParen :: String -> Bool hasParen ('(' : _) = True diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index edc656ada0..51eee11e27 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -27,7 +27,7 @@ import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Error (rangeToSrcSpan) import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) -import Development.IDE.GHC.Util (prettyPrint) +import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Graph import Development.IDE.Plugin.CodeAction (newImport, newImportToEdit) @@ -213,7 +213,7 @@ extendImportHandler ideState edit@ExtendImport {..} = do <> "’ from " <> importName <> " (at " - <> T.pack (prettyPrint srcSpan) + <> printOutputable srcSpan <> ")" void $ LSP.sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) return $ Right Null diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index b598fc3c46..1a2cb5304b 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -214,7 +214,7 @@ mkCompl pprLineCol :: SrcLoc -> T.Text pprLineCol (UnhelpfulLoc fs) = T.pack $ unpackFS fs pprLineCol (RealSrcLoc loc _) = - "line " <> ppr(srcLocLine loc) <> ", column " <> ppr(srcLocCol loc) + "line " <> printOutputable (srcLocLine loc) <> ", column " <> printOutputable (srcLocCol loc) mkAdditionalEditsCommand :: PluginId -> ExtendImport -> Command @@ -226,7 +226,7 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = where compKind = occNameToComKind typeText origName isTypeCompl = isTcOcc origName - label = stripPrefix $ showGhc origName + label = stripPrefix $ printOutputable origName insertText = case isInfix of Nothing -> case getArgText <$> thingType of Nothing -> label @@ -235,7 +235,7 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = Just Surrounded -> label typeText - | Just t <- thingType = Just . stripForall $ showGhc t + | Just t <- thingType = Just . stripForall $ printOutputable t | otherwise = Nothing additionalTextEdits = imp <&> \x -> @@ -244,7 +244,7 @@ mkNameCompItem doc thingParent origName provenance thingType isInfix docs !imp = thingParent, importName = showModName $ unLoc $ ideclName $ unLoc x, importQual = getImportQual x, - newThing = showNameWithoutUniques origName + newThing = printOutputable origName } stripForall :: T.Text -> T.Text @@ -295,7 +295,7 @@ showForSnippet x = T.pack $ renderWithContext ctxt $ GHC.ppr x -- FIXme where ctxt = defaultSDocContext{sdocStyle = mkUserStyle neverQualify AllTheWay} #else -showForSnippet x = showGhc x +showForSnippet x = printOutputable x #endif mkModCompl :: T.Text -> CompletionItem @@ -350,7 +350,7 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do let packageState = hscEnv env curModName = moduleName curMod - curModNameText = ppr curModName + curModNameText = printOutputable curModName importMap = Map.fromList [ (l, imp) | imp@(L (locA -> (RealSrcSpan l _)) _) <- limports ] @@ -384,9 +384,9 @@ cacheDataProducer uri env curMod globalEnv inScopeEnv limports = do -- we don't want to extend import if it's already in scope guard . null $ lookupGRE_Name inScopeEnv n -- or if it doesn't have a real location - loc <- realSpan $ is_dloc spec + loc <- realSpan $ is_dloc spec Map.lookup loc importMap - compItem <- toCompItem par curMod (ppr $ is_mod spec) n originalImportDecl + compItem <- toCompItem par curMod (printOutputable $ is_mod spec) n originalImportDecl let unqual | is_qual spec = [] | otherwise = compItem @@ -498,12 +498,12 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod findRecordCompl :: Uri -> ParsedModule -> Provenance -> TyClDecl GhcPs -> [CompItem] findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result where - result = [mkRecordSnippetCompItem uri (Just $ showNameWithoutUniques $ unLoc tcdLName) - (showGhc . unLoc $ con_name) field_labels mn doc Nothing + result = [mkRecordSnippetCompItem uri (Just $ printOutputable $ unLoc tcdLName) + (printOutputable . unLoc $ con_name) field_labels mn doc Nothing | ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn , Just con_details <- [getFlds con_args] , let field_names = concatMap extract con_details - , let field_labels = showGhc <$> field_names + , let field_labels = printOutputable <$> field_names , (not . List.null) field_labels ] doc = SpanDocText (getDocumentation [pmod] $ reLoc tcdLName) (SpanDocUris Nothing Nothing) @@ -528,9 +528,6 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result extract _ = [] findRecordCompl _ _ _ _ = [] -ppr :: Outputable a => a -> T.Text -ppr = T.pack . prettyPrint - toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem toggleSnippets ClientCapabilities {_textDocument} CompletionsConfig{..} = removeSnippetsWhen (not $ enableSnippets && supported) @@ -807,7 +804,7 @@ prefixes = safeTyThingForRecord :: TyThing -> Maybe (T.Text, [T.Text]) safeTyThingForRecord (AnId _) = Nothing safeTyThingForRecord (AConLike dc) = - let ctxStr = showGhc . occName . conLikeName $ dc + let ctxStr = printOutputable . occName . conLikeName $ dc field_names = T.pack . unpackFS . flLabel <$> conLikeFieldLabels dc in Just (ctxStr, field_names) diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 0bdff4aa9b..0ad8b86e9c 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -34,6 +34,7 @@ import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.Spans.Common import Development.IDE.Types.Options +import Development.IDE.GHC.Util (printOutputable) import Control.Applicative import Control.Monad.Extra @@ -229,13 +230,13 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p prettyNames :: [T.Text] prettyNames = map prettyName names prettyName (Right n, dets) = T.unlines $ - wrapHaskell (showNameWithoutUniques n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind)) + wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind)) : definedAt n ++ maybeToList (prettyPackageName n) ++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n ] - where maybeKind = fmap showGhc $ safeTyThingType =<< lookupNameEnv km n - prettyName (Left m,_) = showGhc m + where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n + prettyName (Left m,_) = printOutputable m prettyPackageName n = do m <- nameModule_maybe n @@ -247,15 +248,15 @@ atPoint IdeOptions{} (HAR _ hf _ _ kind) (DKMap dm km) env pos = listToMaybe $ p prettyTypes = map (("_ :: "<>) . prettyType) types prettyType t = case kind of - HieFresh -> showGhc t - HieFromDisk full_file -> showGhc $ hieTypeToIface $ recoverFullType t (hie_types full_file) + HieFresh -> printOutputable t + HieFromDisk full_file -> printOutputable $ hieTypeToIface $ recoverFullType t (hie_types full_file) definedAt name = -- do not show "at " and similar messages -- see the code of 'pprNameDefnLoc' for more information case nameSrcLoc name of UnhelpfulLoc {} | isInternalName name || isSystemName name -> [] - _ -> ["*Defined " <> T.pack (showSDocUnsafe $ pprNameDefnLoc name) <> "*"] + _ -> ["*Defined " <> printOutputable (pprNameDefnLoc name) <> "*"] typeLocationsAtPoint :: forall m @@ -380,7 +381,7 @@ toUri = fromNormalizedUri . filePathToUri' . toNormalizedFilePath' defRowToSymbolInfo :: Res DefRow -> Maybe SymbolInformation defRowToSymbolInfo (DefRow{..}:.(modInfoSrcFile -> Just srcFile)) - = Just $ SymbolInformation (showGhc defNameOcc) kind Nothing Nothing loc Nothing + = Just $ SymbolInformation (printOutputable defNameOcc) kind Nothing Nothing loc Nothing where kind | isVarOcc defNameOcc = SkVariable diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index fefde3edbd..7da8c70cd9 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -3,9 +3,7 @@ {-# LANGUAGE DerivingStrategies #-} module Development.IDE.Spans.Common ( - showGhc -, showNameWithoutUniques -, unqualIEWrapName + unqualIEWrapName , safeTyThingId , safeTyThingType , SpanDoc(..) @@ -34,18 +32,9 @@ import qualified Documentation.Haddock.Types as H type DocMap = NameEnv SpanDoc type KindMap = NameEnv TyThing -showGhc :: Outputable a => a -> T.Text -showGhc = showSD . withPprStyle defaultUserStyle . ppr - -showSD :: SDoc -> T.Text -showSD = T.pack . unsafePrintSDoc - -showNameWithoutUniques :: Outputable a => a -> T.Text -showNameWithoutUniques = T.pack . printNameWithoutUniques - -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier. unqualIEWrapName :: IEWrappedName RdrName -> T.Text -unqualIEWrapName = showNameWithoutUniques . rdrNameOcc . ieWrappedName +unqualIEWrapName = printOutputable . rdrNameOcc . ieWrappedName -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs safeTyThingType :: TyThing -> Maybe Type diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index ffa2a25c6e..c5a9190652 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -27,6 +27,7 @@ import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error +import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Spans.Common import System.Directory import System.FilePath @@ -92,8 +93,8 @@ getDocumentationsTryGhc env mod names = do src <- toFileUriText $ lookupSrcHtmlForModule env mod return (doc, src) Nothing -> pure (Nothing, Nothing) - let docUri = (<> "#" <> selector <> showNameWithoutUniques name) <$> docFu - srcUri = (<> "#" <> showNameWithoutUniques name) <$> srcFu + let docUri = (<> "#" <> selector <> printOutputable name) <$> docFu + srcUri = (<> "#" <> printOutputable name) <$> srcFu selector | isValName name = "v:" | otherwise = "t:" diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index f66167a688..faef7d9001 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -178,7 +178,7 @@ unpackAvail mn | otherwise = const [] where !mod = pack $ moduleNameString mn - f id@IdentInfo {..} = (pack (prettyPrint name), moduleNameText,[id]) + f id@IdentInfo {..} = (printOutputable name, moduleNameText,[id]) identInfoToKeyVal :: IdentInfo -> (ModuleNameText, IdentInfo) diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs index 7de639c13c..3d833a9cd5 100644 --- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs +++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs @@ -19,7 +19,7 @@ import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModul import Development.IDE.Core.Service (IdeState, runAction) import Development.IDE.Core.Shake (use) import Development.IDE.GHC.Compat -import Development.IDE.GHC.Util (prettyPrint) +import Development.IDE.GHC.Util (printOutputable) import Generics.SYB (extQ, something) import Ide.PluginUtils (getNormalizedFilePath, handleMaybeM, response) @@ -134,7 +134,7 @@ findSigLocOfStringDecl decls expectedType declName = something (const Nothing `e -- | Pretty Print the Type Signature (to validate GHC Error Message) sigToText :: Sig GhcPs -> Maybe Text sigToText = \case - ts@TypeSig {} -> Just $ stripSignature $ T.pack $ prettyPrint ts + ts@TypeSig {} -> Just $ stripSignature $ printOutputable ts _ -> Nothing stripSignature :: Text -> Text diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 64fbdace82..70d7c7d130 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -50,7 +50,7 @@ import Development.IDE (GetModSummary (..), NeedsCompilation (NeedsCompilation), evalGhcEnv, hscEnvWithImportPaths, - prettyPrint, runAction, + printOutputable, runAction, textToStringBuffer, toNormalizedFilePath', uriToFilePath', useNoFile_, @@ -98,7 +98,7 @@ import Ide.Plugin.Eval.Parse.Comments (commentsToSections) import Ide.Plugin.Eval.Parse.Option (parseSetFlags) import Ide.Plugin.Eval.Rules (queueForEvaluation) import Ide.Plugin.Eval.Types -import Ide.Plugin.Eval.Util (asS, gStrictTry, isLiterate, +import Ide.Plugin.Eval.Util (gStrictTry, isLiterate, logWith, response', timed) import Ide.PluginUtils (handleMaybe, handleMaybeM, response) @@ -283,7 +283,7 @@ runEvalCmd plId st EvalParams{..} = -- load the module in the interactive environment loadResult <- perf "loadModule" $ load LoadAllTargets - dbg "LOAD RESULT" $ asS loadResult + dbg "LOAD RESULT" $ printOutputable loadResult case loadResult of Failed -> liftIO $ do let err = "" @@ -522,7 +522,7 @@ evals mark_exception (st, fp) df stmts = do prettyWarn :: Warn -> String prettyWarn Warn{..} = - prettyPrint (SrcLoc.getLoc warnMsg) <> ": warning:\n" + T.unpack (printOutputable $ SrcLoc.getLoc warnMsg) <> ": warning:\n" <> " " <> SrcLoc.unLoc warnMsg runGetSession :: MonadIO m => IdeState -> NormalizedFilePath -> m HscEnv diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs index e5232759ce..68ea0a4050 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/GHC.hs @@ -16,12 +16,14 @@ module Ide.Plugin.Eval.GHC ( import Data.List (isPrefixOf) import Data.Maybe (mapMaybe) import Data.String (fromString) +import qualified Data.Text as T import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import qualified Development.IDE.GHC.Compat.Util as EnumSet +import Development.IDE.GHC.Util (printOutputable) import GHC.LanguageExtensions.Type (Extension (..)) -import Ide.Plugin.Eval.Util (asS, gStrictTry) +import Ide.Plugin.Eval.Util (gStrictTry) {- $setup >>> import GHC @@ -66,7 +68,7 @@ pkgNames_ = mapMaybe ( \case ExposePackage _ (PackageArg n) _ -> Just n - ExposePackage _ (UnitIdArg uid) _ -> Just $ asS uid + ExposePackage _ (UnitIdArg uid) _ -> Just $ T.unpack $ printOutputable uid _ -> Nothing ) @@ -147,7 +149,7 @@ deriving instance Read Extension -- Partial display of DynFlags contents, for testing purposes showDynFlags :: DynFlags -> String showDynFlags df = - showSDocUnsafe . vcat . map (\(n, d) -> text (n ++ ": ") <+> d) $ + T.unpack . printOutputable . vcat . map (\(n, d) -> text (n ++ ": ") <+> d) $ [ ("extensions", ppr . extensions $ df) , ("extensionFlags", ppr . EnumSet.toList . extensionFlags $ df) , ("importPaths", vList $ importPaths df) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index c33d6cbc68..a4acb19caf 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -4,7 +4,6 @@ -- |Debug utilities module Ide.Plugin.Eval.Util ( - asS, timed, isLiterate, response', @@ -20,8 +19,6 @@ import Data.String (IsString (fromString)) import qualified Data.Text as T import Development.IDE (IdeState, Priority (..), ideLogger, logPriority) -import Development.IDE.GHC.Compat (Outputable, ppr, - showSDocUnsafe) import Development.IDE.GHC.Compat.Util (MonadCatch, catch) import GHC.Exts (toList) import GHC.Stack (HasCallStack, callStack, @@ -33,9 +30,6 @@ import System.FilePath (takeExtension) import System.Time.Extra (duration, showDuration) import UnliftIO.Exception (catchAny) -asS :: Outputable a => a -> String -asS = showSDocUnsafe . ppr - timed :: MonadIO m => (t -> String -> m a) -> t -> m b -> m b timed out name op = do (secs, r) <- duration op diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index a453a65a1e..09743f7e0c 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -197,7 +197,7 @@ exportedModuleStrings :: ParsedModule -> [String] exportedModuleStrings ParsedModule{pm_parsed_source = L _ HsModule{..}} | Just export <- hsmodExports, exports <- unLoc export - = map prettyPrint exports + = map (T.unpack . printOutputable) exports exportedModuleStrings _ = [] minimalImportsRule :: Recorder (WithPriority Log) -> Rules () @@ -210,7 +210,7 @@ minimalImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \Minimal (imports, mbMinImports) <- liftIO $ extractMinimalImports hsc tmr let importsMap = Map.fromList - [ (realSrcSpanStart l, T.pack (prettyPrint i)) + [ (realSrcSpanStart l, printOutputable i) | L (locA -> RealSrcSpan l _) i <- fromMaybe [] mbMinImports ] res = diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index 8d3fdb2147..bb7a809744 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -42,7 +42,7 @@ import Development.IDE as D (Diagnostic (Diagnostic, Range (Range), Uri, getFileContents, getParsedModule, - prettyPrint, runAction, + printOutputable, runAction, srcSpanToRange, toNormalizedUri, uriToFilePath', @@ -151,7 +151,7 @@ suggestAddPragma mDynflags Diagnostic {_message} = genPragma _message disabled | Just dynFlags <- mDynflags = -- GHC does not export 'OnOff', so we have to view it as string - catMaybes $ T.stripPrefix "Off " . T.pack . prettyPrint <$> extensions dynFlags + catMaybes $ T.stripPrefix "Off " . printOutputable <$> extensions dynFlags | otherwise = -- When the module failed to parse, we don't have access to its -- dynFlags. In that case, simply don't disable any pragmas. diff --git a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs index 2519ce1366..582fba0a72 100644 --- a/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs +++ b/plugins/hls-refine-imports-plugin/src/Ide/Plugin/RefineImports.hs @@ -232,7 +232,7 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm let res = [ (i, Just . T.intercalate "\n" - . map (T.pack . prettyPrint . constructImport i) + . map (printOutputable . constructImport i) . Map.toList $ filteredInnerImports) -- for every minimal imports @@ -251,7 +251,7 @@ refineImportsRule recorder = define (cmapWithPrio LogShake recorder) $ \RefineIm -- Check if a name is exposed by AvailInfo (the available information of a module) containsAvail :: LIE GhcRn -> AvailInfo -> Bool containsAvail name avail = - any (\an -> prettyPrint an == (prettyPrint . ieName . unLoc $ name)) + any (\an -> printOutputable an == (printOutputable . ieName . unLoc $ name)) $ availNamesWithSelectors avail -------------------------------------------------------------------------------- diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index f452be189b..8075282807 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -167,7 +167,7 @@ runRetrieCmd state RunRetrieParams{originatingFile = uri, ..} = extractImports :: ModSummary -> [HsBindLR GhcRn GhcRn] -> RewriteSpec -> [ImportSpec] extractImports ModSummary{ms_mod} topLevelBinds (Unfold thing) | Just FunBind {fun_matches} - <- find (\case FunBind{fun_id = L _ n} -> prettyPrint n == thing ; _ -> False) topLevelBinds + <- find (\case FunBind{fun_id = L _ n} -> T.unpack (printOutputable n) == thing ; _ -> False) topLevelBinds , names <- listify p fun_matches = [ AddImport {..} @@ -249,8 +249,8 @@ suggestBindRewrites :: [(T.Text, CodeActionKind, RunRetrieParams)] suggestBindRewrites originatingFile pos ms_mod FunBind {fun_id = L l' rdrName} | pos `isInsideSrcSpan` l' = - let pprName = prettyPrint rdrName - pprNameText = T.pack pprName + let pprNameText = printOutputable rdrName + pprName = T.unpack pprNameText unfoldRewrite restrictToOriginatingFile = let rewrites = [Unfold (qualify ms_mod pprName)] description = "Unfold " <> pprNameText <> describeRestriction restrictToOriginatingFile @@ -273,8 +273,8 @@ suggestTypeRewrites :: TyClDecl pass -> [(T.Text, CodeActionKind, RunRetrieParams)] suggestTypeRewrites originatingFile ms_mod SynDecl {tcdLName = L _ rdrName} = - let pprName = prettyPrint rdrName - pprNameText = T.pack pprName + let pprNameText = printOutputable rdrName + pprName = T.unpack pprNameText unfoldRewrite restrictToOriginatingFile = let rewrites = [TypeForward (qualify ms_mod pprName)] description = "Unfold " <> pprNameText <> describeRestriction restrictToOriginatingFile @@ -330,7 +330,7 @@ suggestRuleRewrites originatingFile pos ms_mod (L _ HsRules {rds_rules}) = suggestRuleRewrites _ _ _ _ = [] qualify :: GHC.Module -> String -> String -qualify ms_mod x = prettyPrint ms_mod <> "." <> x +qualify ms_mod x = T.unpack (printOutputable ms_mod) <> "." <> x ------------------------------------------------------------------------------- -- Retrie driving code diff --git a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs index 4c2768255f..e637779824 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Debug.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Debug.hs @@ -18,8 +18,10 @@ module Wingman.Debug 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, showSDocUnsafe) +import Development.IDE.GHC.Compat (PlainGhcException, Outputable(..), SDoc) +import Development.IDE.GHC.Util (printOutputable) import System.IO.Unsafe (unsafePerformIO) ------------------------------------------------------------------------------ @@ -30,7 +32,7 @@ unsafeRender = unsafeRender' . ppr unsafeRender' :: SDoc -> String unsafeRender' sdoc = unsafePerformIO $ do - let z = showSDocUnsafe sdoc + let z = T.unpack $ printOutputable sdoc -- We might not have unsafeGlobalDynFlags (like during testing), in which -- case GHC panics. Instead of crashing, let's just fail to print. !res <- try @PlainGhcException $ evaluate $ deepseq z z