Unify showSDocUnsafe

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

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,24 +100,15 @@ 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
 
 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 =

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

@@ -39,34 +39,35 @@ 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
 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 "<moddetails>"
 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)

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 #-}

ghcide/src/Development/IDE/LSP/Outline.hs

@@ -13,14 +13,14 @@ 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
 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)]