Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Unify showSDocUnsafe #2830

Merged
merged 19 commits into from
Apr 27, 2022
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion ghcide/src/Development/IDE/Core/Compile.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
39 changes: 19 additions & 20 deletions ghcide/src/Development/IDE/GHC/Compat/Outputable.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..),
Expand Down Expand Up @@ -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
July541 marked this conversation as resolved.
Show resolved Hide resolved
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
Expand All @@ -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
July541 marked this conversation as resolved.
Show resolved Hide resolved
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

Expand All @@ -121,7 +121,6 @@ oldMkErrStyle = Out.mkErrStyle
oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
oldFormatErrDoc = Err.formatErrDoc
#endif
#endif

pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
pprWarning =
Expand Down
23 changes: 12 additions & 11 deletions ghcide/src/Development/IDE/GHC/Orphans.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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)
31 changes: 19 additions & 12 deletions ghcide/src/Development/IDE/GHC/Util.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,6 @@ module Development.IDE.GHC.Util(
modifyDynFlags,
evalGhcEnv,
-- * GHC wrappers
prettyPrint,
unsafePrintSDoc,
printRdrName,
Development.IDE.GHC.Util.printName,
ParseResult(..), runParser,
Expand All @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand All @@ -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 #-}
52 changes: 23 additions & 29 deletions ghcide/src/Development/IDE/LSP/Outline.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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),
Expand All @@ -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
}
Expand All @@ -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
)
Expand All @@ -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'
}
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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)
Expand All @@ -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
}

Expand All @@ -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

Expand All @@ -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" }
Expand All @@ -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)]
Expand Down
Loading