Unify showSDocUnsafe

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,20 @@ import qualified Outputable                      as Out
 import           SrcLoc
 #endif
 
-printNameWithoutUniques :: Outputable a => a -> String
-printNameWithoutUniques =
+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,14 +96,9 @@ 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)
 oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc
 oldMkUserStyle _ = Out.mkUserStyle

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,12 @@ module Development.IDE.GHC.Util(
     setHieDir,
     dontWriteHieFiles,
     disableWarningsAsErrors,
-    traceAst) where
+    traceAst,
+    showGhc,
+    showGhcWithUniques,
+    prettyPrint,
+    prettyPrintWithUniques
+    ) where
 
 #if MIN_VERSION_ghc(9,2,0)
 import           GHC.Data.FastString
@@ -130,16 +133,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 = prettyPrint $ parenSymOcc rn (ppr rn)
   where
     rn = rdrNameOcc name
 
@@ -304,7 +300,7 @@ traceAst lbl x
 #if MIN_VERSION_ghc(9,2,0)
     renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True}
 #else
-    renderDump = unsafePrintSDoc
+    renderDump = prettyPrintWithUniques
 #endif
     htmlDump = showAstDataHtml x
     doTrace = unsafePerformIO $ do
@@ -318,4 +314,45 @@ 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 by default `showSDocUnsafe`.
+--
+-- You may prefer `prettyPrint` unless you know what you are doing.
+--
+-- It internal using `unsafeGlobalDynFlags`.
+--
+-- `String` version of `showGhcWithUniques`.
+prettyPrintWithUniques :: Outputable a => a -> String
+prettyPrintWithUniques = showSDocUnsafe . ppr
+
+-- | 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 `unsafeGlobalDynFlags`.
+--
+-- `String` version of `showGhc`.
+prettyPrint :: Outputable a => a -> String
+prettyPrint = printWithoutUniques
+
+-- | Print a GHC value by default `showSDocUnsafe`.
+--
+-- You may prefer `showGhc` unless you know what you are doing.
+--
+-- It internal using `unsafeGlobalDynFlags`.
+showGhcWithUniques :: Outputable a => a -> T.Text
+showGhcWithUniques = T.pack . showSDocUnsafe . ppr
+
+-- | 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 `unsafeGlobalDynFlags`.
+showGhc :: Outputable a => a -> T.Text
+showGhc = T.pack . printWithoutUniques

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

@@ -13,14 +13,15 @@ import           Control.Monad.IO.Class
 import           Data.Functor
 import           Data.Generics
 import           Data.Maybe
-import           Data.Text                      (Text, pack)
+import           Data.Text                      (Text)
 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       (showGhc)
 import           Language.LSP.Server            (LspM)
 import           Language.LSP.Types             (DocumentSymbol (..),
                                                  DocumentSymbolParams (DocumentSymbolParams, _textDocument),
@@ -47,7 +48,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif
                moduleSymbol = hsmodName >>= \case
                  (L (locA -> (RealSrcSpan l _)) m) -> Just $
                    (defDocumentSymbol l :: DocumentSymbol)
-                     { _name  = pprText m
+                     { _name  = showGhc m
                      , _kind  = SkFile
                      , _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
                      }
@@ -71,17 +72,17 @@ 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
+                  <> (case showGhc fdTyVars of
                        "" -> ""
                        t  -> " " <> t
                      )
-    , _detail = Just $ pprText fdInfo
+    , _detail = Just $ showGhc 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
+                    <> (case showGhc tcdTyVars of
                          "" -> ""
                          t  -> " " <> t
                        )
@@ -152,7 +153,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ SynDecl { tcdLName
                                           , _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 = showGhc cid_poly_ty
                                                  , _kind = SkInterface
                                                  }
 #if MIN_VERSION_ghc(9,2,0)
@@ -162,7 +163,7 @@ documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = D
 #endif
   = Just (defDocumentSymbol l :: DocumentSymbol)
     { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
-                (map pprText feqn_pats)
+                (map showGhc feqn_pats)
     , _kind = SkInterface
     }
 #if MIN_VERSION_ghc(9,2,0)
@@ -172,12 +173,12 @@ documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyF
 #endif
   = Just (defDocumentSymbol l :: DocumentSymbol)
     { _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
-                (map pprText feqn_pats)
+                (map showGhc 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 = showGhc @(HsType GhcPs)
                                               name
                                             , _kind = SkInterface
                                             }
@@ -188,7 +189,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ FunBind{fun_id = L
       }
 documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ PatBind{pat_lhs})) = Just
     (defDocumentSymbol l :: DocumentSymbol)
-      { _name   = pprText pat_lhs
+      { _name   = showGhc pat_lhs
       , _kind   = SkFunction
       }
 
@@ -228,7 +229,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 " <> showGhc ideclName
     , _kind   = SkModule
 #if MIN_VERSION_ghc(8,10,0)
     , _detail = case ideclQualified of { NotQualified -> Nothing; _ -> Just "qualified" }
@@ -250,10 +251,7 @@ defDocumentSymbol l = DocumentSymbol { .. } where
   _tags           = Nothing
 
 showRdrName :: RdrName -> Text
-showRdrName = pprText
-
-pprText :: Outputable a => a -> Text
-pprText = pack . showSDocUnsafe . ppr
+showRdrName = showGhc
 
 -- the version of getConNames for ghc9 is restricted to only the renaming phase
 #if !MIN_VERSION_ghc(9,2,0)

ghcide/src/Development/IDE/Plugin/CodeAction.hs

@@ -51,12 +51,11 @@ import           Development.IDE.GHC.ExactPrint
 import           Development.IDE.GHC.Util                          (prettyPrint,
                                                                     printRdrName,
                                                                     traceAst,
-                                                                    unsafePrintSDoc)
+                                                                    showGhc)
 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 +545,7 @@ suggestDeleteUnusedBinding
       isTheBinding span = srcSpanToRange span == Just _range
 
       isSameName :: IdP GhcPs -> String -> Bool
-      isSameName x name = showSDocUnsafe (ppr x) == name
+      isSameName x name = prettyPrint x == name
 
 data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll
   deriving (Eq)
@@ -1013,7 +1012,7 @@ occursUnqualified symbol ImportDecl{..}
 occursUnqualified _ _ = False
 
 symbolOccursIn :: T.Text -> IE GhcPs -> Bool
-symbolOccursIn symb = any ((== symb). showNameWithoutUniques) . ieNames
+symbolOccursIn symb = any ((== symb). showGhc) . ieNames
 
 targetModuleName :: ModuleTarget -> ModuleName
 targetModuleName ImplicitPrelude{} = mkModuleName "Prelude"
@@ -1423,7 +1422,7 @@ newImport modName mSymbol mQual hiding = NewImport impStmt
      symImp
             | Just symbol <- mSymbol
               , symOcc <- mkVarOcc $ T.unpack symbol =
-              " (" <> T.pack (unsafePrintSDoc (parenSymOcc symOcc $ ppr symOcc)) <> ")"
+              " (" <> showGhc (parenSymOcc symOcc $ ppr symOcc) <> ")"
             | otherwise = ""
      impStmt =
        "import "
@@ -1617,32 +1616,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' = []
+      | prettyPrint 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, prettyPrint x == b']
+          ++ [ l' | L l' x <- labels, prettyPrint x == b']
 #else
     ranges' (L _ (IEThingWith _ thing _  inners))
-      | showSDocUnsafe (ppr thing) == b' = []
+      | prettyPrint thing == b' = []
       | otherwise =
-          [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b']
+          [ locA l' | L l' x <- inners, prettyPrint 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{}) | prettyPrint x == b = [l]
+rangesForBinding' b (L (locA -> l) x@IEThingAbs{}) | prettyPrint x == b = [l]
+rangesForBinding' b (L (locA -> l) (IEThingAll _ x)) | prettyPrint 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]
+    | prettyPrint thing == b = [l]
     | otherwise =
-        [ locA l' | L l' x <- inners, showSDocUnsafe (ppr x) == b]
+        [ locA l' | L l' x <- inners, prettyPrint x == b]
 #if !MIN_VERSION_ghc(9,2,0)
-        ++ [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b]
+        ++ [ l' | L l' x <- labels, prettyPrint x == b]
 #endif
 rangesForBinding' _ _ = []
 

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)
+          showGhc (occName (unLoc rdr))
+            `elem` map (showGhc @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')
+              showGhc (occName (unLoc childRdr))
+                `elem` map (showGhc @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) = prettyPrint $ parenSymOcc occ (ppr occ)
 
 hasParen :: String -> Bool
 hasParen ('(' : _) = True

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                     (showGhc)
 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)
+          <> showGhc srcSpan
           <> ")"
     void $ LSP.sendRequest SWorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ())
   return $ Right Null