Skip to content

Commit 6742c20

Browse files
July541pepeiborraAilrun
authored
Unify showSDocUnsafe (#2830)
* Unify showSDocUnsafe * Fix dependency * Add missing instance * Add missing instance * Remove unused imports * Clean up unused code * Remove unnecessary exports & Rename * Unify use printOutputable * Remove redundant import * Replace show with unpack * Rerun tests * Rerun tests Co-authored-by: Pepe Iborra <pepeiborra@gmail.com> Co-authored-by: Junyoung "Clare" Jang <jjc9310@gmail.com>
1 parent 8f1a59c commit 6742c20

File tree

22 files changed

+152
-167
lines changed

22 files changed

+152
-167
lines changed

‎ghcide/src/Development/IDE/Core/Compile.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -1301,7 +1301,7 @@ getDocsBatch hsc_env _mod _names = do
13011301
#endif
13021302
Map.findWithDefault mempty name amap))
13031303
case res of
1304-
Just x -> return $ map (first $ T.unpack . showGhc) x
1304+
Just x -> return $ map (first $ T.unpack . printOutputable) x
13051305
Nothing -> throwErrors
13061306
#if MIN_VERSION_ghc(9,2,0)
13071307
$ Error.getErrorMessages msgs

‎ghcide/src/Development/IDE/GHC/Compat/Outputable.hs

+19-20
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,7 @@ module Development.IDE.GHC.Compat.Outputable (
88
showSDocForUser,
99
ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest,
1010
printSDocQualifiedUnsafe,
11-
printNameWithoutUniques,
12-
printSDocAllTheWay,
11+
printWithoutUniques,
1312
mkPrintUnqualified,
1413
mkPrintUnqualifiedDefault,
1514
PrintUnqualified(..),
@@ -68,14 +67,24 @@ import qualified Outputable as Out
6867
import SrcLoc
6968
#endif
7069

71-
printNameWithoutUniques :: Outputable a => a -> String
72-
printNameWithoutUniques =
70+
-- | A compatible function to print `Outputable` instances
71+
-- without unique symbols.
72+
--
73+
-- It print with a user-friendly style like: `a_a4ME` as `a`.
74+
printWithoutUniques :: Outputable a => a -> String
75+
printWithoutUniques =
7376
#if MIN_VERSION_ghc(9,2,0)
74-
renderWithContext (defaultSDocContext { sdocSuppressUniques = True }) . ppr
77+
renderWithContext (defaultSDocContext
78+
{
79+
sdocStyle = defaultUserStyle
80+
, sdocSuppressUniques = True
81+
, sdocCanUseUnicode = True
82+
}) . ppr
7583
#else
76-
printSDocAllTheWay dyn . ppr
77-
where
78-
dyn = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques
84+
go . ppr
85+
where
86+
go sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags neverQualify AllTheWay)
87+
dflags = unsafeGlobalDynFlags `gopt_set` Opt_SuppressUniques
7988
#endif
8089

8190
printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String
@@ -91,24 +100,15 @@ printSDocQualifiedUnsafe unqual doc =
91100
showSDocForUser unsafeGlobalDynFlags unqual doc
92101
#endif
93102

94-
printSDocAllTheWay :: DynFlags -> SDoc -> String
95-
#if MIN_VERSION_ghc(9,2,0)
96-
printSDocAllTheWay dflags sdoc = renderWithContext ctxt sdoc
97-
where
98-
ctxt = initSDocContext dflags (mkUserStyle neverQualify AllTheWay)
99-
#else
100-
printSDocAllTheWay dflags sdoc = oldRenderWithStyle dflags sdoc (oldMkUserStyle dflags Out.neverQualify Out.AllTheWay)
101-
102-
#if MIN_VERSION_ghc(9,0,0)
103+
#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0)
103104
oldRenderWithStyle dflags sdoc sty = Out.renderWithStyle (initSDocContext dflags sty) sdoc
104105
oldMkUserStyle _ = Out.mkUserStyle
105106
oldMkErrStyle _ = Out.mkErrStyle
106107

107108
oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
108109
oldFormatErrDoc dflags = Err.formatErrDoc dummySDocContext
109110
where dummySDocContext = initSDocContext dflags Out.defaultUserStyle
110-
111-
#else
111+
#elif !MIN_VERSION_ghc(9,0,0)
112112
oldRenderWithStyle :: DynFlags -> Out.SDoc -> Out.PprStyle -> String
113113
oldRenderWithStyle = Out.renderWithStyle
114114

@@ -121,7 +121,6 @@ oldMkErrStyle = Out.mkErrStyle
121121
oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
122122
oldFormatErrDoc = Err.formatErrDoc
123123
#endif
124-
#endif
125124

126125
pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
127126
pprWarning =

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

+12-11
Original file line numberDiff line numberDiff line change
@@ -39,34 +39,35 @@ import Data.Aeson
3939
import Data.Bifunctor (Bifunctor (..))
4040
import Data.Hashable
4141
import Data.String (IsString (fromString))
42+
import Data.Text (unpack)
4243
#if MIN_VERSION_ghc(9,0,0)
4344
import GHC.ByteCode.Types
4445
#else
4546
import ByteCodeTypes
4647
#endif
4748

4849
-- Orphan instances for types from the GHC API.
49-
instance Show CoreModule where show = prettyPrint
50+
instance Show CoreModule where show = unpack . printOutputable
5051
instance NFData CoreModule where rnf = rwhnf
51-
instance Show CgGuts where show = prettyPrint . cg_module
52+
instance Show CgGuts where show = unpack . printOutputable . cg_module
5253
instance NFData CgGuts where rnf = rwhnf
5354
instance Show ModDetails where show = const "<moddetails>"
5455
instance NFData ModDetails where rnf = rwhnf
5556
instance NFData SafeHaskellMode where rnf = rwhnf
56-
instance Show Linkable where show = prettyPrint
57+
instance Show Linkable where show = unpack . printOutputable
5758
instance NFData Linkable where rnf (LM a b c) = rnf a `seq` rnf b `seq` rnf c
5859
instance NFData Unlinked where
5960
rnf (DotO f) = rnf f
6061
rnf (DotA f) = rnf f
6162
rnf (DotDLL f) = rnf f
6263
rnf (BCOs a b) = seqCompiledByteCode a `seq` liftRnf rwhnf b
63-
instance Show PackageFlag where show = prettyPrint
64-
instance Show InteractiveImport where show = prettyPrint
65-
instance Show PackageName where show = prettyPrint
64+
instance Show PackageFlag where show = unpack . printOutputable
65+
instance Show InteractiveImport where show = unpack . printOutputable
66+
instance Show PackageName where show = unpack . printOutputable
6667

6768
#if !MIN_VERSION_ghc(9,0,1)
68-
instance Show ComponentId where show = prettyPrint
69-
instance Show SourcePackageId where show = prettyPrint
69+
instance Show ComponentId where show = unpack . printOutputable
70+
instance Show SourcePackageId where show = unpack . printOutputable
7071

7172
instance Show GhcPlugins.InstalledUnitId where
7273
show = installedUnitIdString
@@ -76,7 +77,7 @@ instance NFData GhcPlugins.InstalledUnitId where rnf = rwhnf . installedUnitIdFS
7677
instance Hashable GhcPlugins.InstalledUnitId where
7778
hashWithSalt salt = hashWithSalt salt . installedUnitIdString
7879
#else
79-
instance Show UnitId where show = prettyPrint
80+
instance Show UnitId where show = unpack . printOutputable
8081
deriving instance Ord SrcSpan
8182
deriving instance Ord UnhelpfulSpanReason
8283
#endif
@@ -86,7 +87,7 @@ instance NFData SB.StringBuffer where rnf = rwhnf
8687
instance Show Module where
8788
show = moduleNameString . moduleName
8889

89-
instance Outputable a => Show (GenLocated SrcSpan a) where show = prettyPrint
90+
instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable
9091

9192
instance (NFData l, NFData e) => NFData (GenLocated l e) where
9293
rnf (L l e) = rnf l `seq` rnf e
@@ -207,5 +208,5 @@ instance (NFData (HsModule a)) where
207208
#endif
208209
rnf = rwhnf
209210

210-
instance Show OccName where show = prettyPrint
211+
instance Show OccName where show = unpack . printOutputable
211212
instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n)

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

+19-12
Original file line numberDiff line numberDiff line change
@@ -7,8 +7,6 @@ module Development.IDE.GHC.Util(
77
modifyDynFlags,
88
evalGhcEnv,
99
-- * GHC wrappers
10-
prettyPrint,
11-
unsafePrintSDoc,
1210
printRdrName,
1311
Development.IDE.GHC.Util.printName,
1412
ParseResult(..), runParser,
@@ -28,7 +26,9 @@ module Development.IDE.GHC.Util(
2826
setHieDir,
2927
dontWriteHieFiles,
3028
disableWarningsAsErrors,
31-
traceAst) where
29+
traceAst,
30+
printOutputable
31+
) where
3232

3333
#if MIN_VERSION_ghc(9,2,0)
3434
import GHC.Data.FastString
@@ -130,16 +130,9 @@ stringBufferToByteString StringBuffer{..} = PS buf cur len
130130
bytestringToStringBuffer :: ByteString -> StringBuffer
131131
bytestringToStringBuffer (PS buf cur len) = StringBuffer{..}
132132

133-
-- | Pretty print a GHC value using 'unsafeGlobalDynFlags '.
134-
prettyPrint :: Outputable a => a -> String
135-
prettyPrint = unsafePrintSDoc . ppr
136-
137-
unsafePrintSDoc :: SDoc -> String
138-
unsafePrintSDoc sdoc = showSDocUnsafe sdoc
139-
140133
-- | Pretty print a 'RdrName' wrapping operators in parens
141134
printRdrName :: RdrName -> String
142-
printRdrName name = showSDocUnsafe $ parenSymOcc rn (ppr rn)
135+
printRdrName name = T.unpack $ printOutputable $ parenSymOcc rn (ppr rn)
143136
where
144137
rn = rdrNameOcc name
145138

@@ -304,7 +297,7 @@ traceAst lbl x
304297
#if MIN_VERSION_ghc(9,2,0)
305298
renderDump = renderWithContext defaultSDocContext{sdocStyle = defaultDumpStyle, sdocPprDebug = True}
306299
#else
307-
renderDump = unsafePrintSDoc
300+
renderDump = showSDocUnsafe . ppr
308301
#endif
309302
htmlDump = showAstDataHtml x
310303
doTrace = unsafePerformIO $ do
@@ -318,4 +311,18 @@ traceAst lbl x
318311
#endif
319312
, "file://" ++ htmlDumpFileName]
320313

314+
-- Should in `Development.IDE.GHC.Orphans`,
315+
-- leave it here to prevent cyclic module dependency
316+
#if !MIN_VERSION_ghc(8,10,0)
317+
instance Outputable SDoc where
318+
ppr = id
319+
#endif
321320

321+
-- | Print a GHC value in `defaultUserStyle` without unique symbols.
322+
--
323+
-- This is the most common print utility, will print with a user-friendly style like: `a_a4ME` as `a`.
324+
--
325+
-- It internal using `showSDocUnsafe` with `unsafeGlobalDynFlags`.
326+
printOutputable :: Outputable a => a -> T.Text
327+
printOutputable = T.pack . printWithoutUniques
328+
{-# INLINE printOutputable #-}

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

+23-29
Original file line numberDiff line numberDiff line change
@@ -13,14 +13,14 @@ import Control.Monad.IO.Class
1313
import Data.Functor
1414
import Data.Generics
1515
import Data.Maybe
16-
import Data.Text (Text, pack)
1716
import qualified Data.Text as T
1817
import Development.IDE.Core.Rules
1918
import Development.IDE.Core.Shake
2019
import Development.IDE.GHC.Compat
2120
import Development.IDE.GHC.Error (rangeToRealSrcSpan,
2221
realSrcSpanToRange)
2322
import Development.IDE.Types.Location
23+
import Development.IDE.GHC.Util (printOutputable)
2424
import Language.LSP.Server (LspM)
2525
import Language.LSP.Types (DocumentSymbol (..),
2626
DocumentSymbolParams (DocumentSymbolParams, _textDocument),
@@ -47,7 +47,7 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif
4747
moduleSymbol = hsmodName >>= \case
4848
(L (locA -> (RealSrcSpan l _)) m) -> Just $
4949
(defDocumentSymbol l :: DocumentSymbol)
50-
{ _name = pprText m
50+
{ _name = printOutputable m
5151
, _kind = SkFile
5252
, _range = Range (Position 0 0) (Position maxBound 0) -- _ltop is 0 0 0 0
5353
}
@@ -70,18 +70,18 @@ moduleOutline ideState DocumentSymbolParams{ _textDocument = TextDocumentIdentif
7070
documentSymbolForDecl :: LHsDecl GhcPs -> Maybe DocumentSymbol
7171
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ FamDecl { tcdFam = FamilyDecl { fdLName = L _ n, fdInfo, fdTyVars } }))
7272
= Just (defDocumentSymbol l :: DocumentSymbol)
73-
{ _name = showRdrName n
74-
<> (case pprText fdTyVars of
73+
{ _name = printOutputable n
74+
<> (case printOutputable fdTyVars of
7575
"" -> ""
7676
t -> " " <> t
7777
)
78-
, _detail = Just $ pprText fdInfo
78+
, _detail = Just $ printOutputable fdInfo
7979
, _kind = SkFunction
8080
}
8181
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLName = L _ name, tcdSigs, tcdTyVars }))
8282
= Just (defDocumentSymbol l :: DocumentSymbol)
83-
{ _name = showRdrName name
84-
<> (case pprText tcdTyVars of
83+
{ _name = printOutputable name
84+
<> (case printOutputable tcdTyVars of
8585
"" -> ""
8686
t -> " " <> t
8787
)
@@ -90,7 +90,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLNa
9090
, _children =
9191
Just $ List
9292
[ (defDocumentSymbol l :: DocumentSymbol)
93-
{ _name = showRdrName n
93+
{ _name = printOutputable n
9494
, _kind = SkMethod
9595
, _selectionRange = realSrcSpanToRange l'
9696
}
@@ -100,12 +100,12 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLNa
100100
}
101101
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } }))
102102
= Just (defDocumentSymbol l :: DocumentSymbol)
103-
{ _name = showRdrName name
103+
{ _name = printOutputable name
104104
, _kind = SkStruct
105105
, _children =
106106
Just $ List
107107
[ (defDocumentSymbol l :: DocumentSymbol)
108-
{ _name = showRdrName n
108+
{ _name = printOutputable n
109109
, _kind = SkConstructor
110110
, _selectionRange = realSrcSpanToRange l'
111111
#if MIN_VERSION_ghc(9,2,0)
@@ -123,7 +123,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam
123123
where
124124
cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol
125125
cvtFld (L (RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol)
126-
{ _name = showRdrName (unLoc (rdrNameFieldOcc n))
126+
{ _name = printOutputable (unLoc (rdrNameFieldOcc n))
127127
, _kind = SkField
128128
}
129129
cvtFld _ = Nothing
@@ -138,7 +138,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam
138138
-- | Extract the record fields of a constructor
139139
conArgRecordFields (RecCon (L _ lcdfs)) = Just $ List
140140
[ (defDocumentSymbol l :: DocumentSymbol)
141-
{ _name = showRdrName n
141+
{ _name = printOutputable n
142142
, _kind = SkField
143143
}
144144
| L _ cdf <- lcdfs
@@ -147,12 +147,12 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam
147147
conArgRecordFields _ = Nothing
148148
#endif
149149
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ SynDecl { tcdLName = L (locA -> (RealSrcSpan l' _)) n })) = Just
150-
(defDocumentSymbol l :: DocumentSymbol) { _name = showRdrName n
150+
(defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable n
151151
, _kind = SkTypeParameter
152152
, _selectionRange = realSrcSpanToRange l'
153153
}
154154
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ ClsInstD { cid_inst = ClsInstDecl { cid_poly_ty } }))
155-
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = pprText cid_poly_ty
155+
= Just (defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable cid_poly_ty
156156
, _kind = SkInterface
157157
}
158158
#if MIN_VERSION_ghc(9,2,0)
@@ -161,8 +161,8 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ DataFamInstD { dfi
161161
documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ DataFamInstD { dfid_inst = DataFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
162162
#endif
163163
= Just (defDocumentSymbol l :: DocumentSymbol)
164-
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
165-
(map pprText feqn_pats)
164+
{ _name = printOutputable (unLoc feqn_tycon) <> " " <> T.unwords
165+
(map printOutputable feqn_pats)
166166
, _kind = SkInterface
167167
}
168168
#if MIN_VERSION_ghc(9,2,0)
@@ -171,24 +171,24 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (InstD _ TyFamInstD { tfid_
171171
documentSymbolForDecl (L (RealSrcSpan l _) (InstD _ TyFamInstD { tfid_inst = TyFamInstDecl HsIB { hsib_body = FamEqn { feqn_tycon, feqn_pats } } }))
172172
#endif
173173
= Just (defDocumentSymbol l :: DocumentSymbol)
174-
{ _name = showRdrName (unLoc feqn_tycon) <> " " <> T.unwords
175-
(map pprText feqn_pats)
174+
{ _name = printOutputable (unLoc feqn_tycon) <> " " <> T.unwords
175+
(map printOutputable feqn_pats)
176176
, _kind = SkInterface
177177
}
178178
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (DerivD _ DerivDecl { deriv_type })) =
179179
gfindtype deriv_type <&> \(L (_ :: SrcSpan) name) ->
180-
(defDocumentSymbol l :: DocumentSymbol) { _name = pprText @(HsType GhcPs)
180+
(defDocumentSymbol l :: DocumentSymbol) { _name = printOutputable @(HsType GhcPs)
181181
name
182182
, _kind = SkInterface
183183
}
184184
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ FunBind{fun_id = L _ name})) = Just
185185
(defDocumentSymbol l :: DocumentSymbol)
186-
{ _name = showRdrName name
186+
{ _name = printOutputable name
187187
, _kind = SkFunction
188188
}
189189
documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ValD _ PatBind{pat_lhs})) = Just
190190
(defDocumentSymbol l :: DocumentSymbol)
191-
{ _name = pprText pat_lhs
191+
{ _name = printOutputable pat_lhs
192192
, _kind = SkFunction
193193
}
194194

@@ -204,7 +204,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (ForD _ x)) = Just
204204
ForeignExport{} -> Just "export"
205205
XForeignDecl{} -> Nothing
206206
}
207-
where name = showRdrName $ unLoc $ fd_name x
207+
where name = printOutputable $ unLoc $ fd_name x
208208

209209
documentSymbolForDecl _ = Nothing
210210

@@ -228,7 +228,7 @@ documentSymbolForImportSummary importSymbols =
228228
documentSymbolForImport :: LImportDecl GhcPs -> Maybe DocumentSymbol
229229
documentSymbolForImport (L (locA -> (RealSrcSpan l _)) ImportDecl { ideclName, ideclQualified }) = Just
230230
(defDocumentSymbol l :: DocumentSymbol)
231-
{ _name = "import " <> pprText ideclName
231+
{ _name = "import " <> printOutputable ideclName
232232
, _kind = SkModule
233233
#if MIN_VERSION_ghc(8,10,0)
234234
, _detail = case ideclQualified of { NotQualified -> Nothing; _ -> Just "qualified" }
@@ -249,12 +249,6 @@ defDocumentSymbol l = DocumentSymbol { .. } where
249249
_children = Nothing
250250
_tags = Nothing
251251

252-
showRdrName :: RdrName -> Text
253-
showRdrName = pprText
254-
255-
pprText :: Outputable a => a -> Text
256-
pprText = pack . showSDocUnsafe . ppr
257-
258252
-- the version of getConNames for ghc9 is restricted to only the renaming phase
259253
#if !MIN_VERSION_ghc(9,2,0)
260254
getConNames' :: ConDecl GhcPs -> [Located (IdP GhcPs)]

0 commit comments

Comments
 (0)