{-# LANGUAGE CPP #-}
module Development.IDE.GHC.Compat.Outputable (
SDoc,
Outputable,
showSDoc,
showSDocUnsafe,
showSDocForUser,
ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate,
printSDocQualifiedUnsafe,
printWithoutUniques,
mkPrintUnqualifiedDefault,
PrintUnqualified,
defaultUserStyle,
withPprStyle,
PsWarning,
PsError,
#if MIN_VERSION_ghc(9,5,0)
defaultDiagnosticOpts,
GhcMessage,
DriverMessage,
Messages,
initDiagOpts,
pprMessages,
#endif
#if MIN_VERSION_ghc(9,3,0)
DiagnosticReason(..),
renderDiagnosticMessageWithHints,
pprMsgEnvelopeBagWithLoc,
Error.getMessages,
renderWithContext,
defaultSDocContext,
errMsgDiagnostic,
unDecorated,
diagnosticMessage,
#else
pprWarning,
pprError,
#endif
DecoratedSDoc,
MsgEnvelope,
ErrMsg,
WarnMsg,
SourceError(..),
errMsgSpan,
errMsgSeverity,
formatErrorWithQual,
mkWarnMsg,
mkSrcErr,
srcErrorMessages,
textDoc,
) where
import GHC.Driver.Env
import GHC.Driver.Ppr
import GHC.Driver.Session
import qualified GHC.Types.Error as Error
import GHC.Types.Name.Ppr
import GHC.Types.Name.Reader
import GHC.Types.SourceError
import GHC.Types.SrcLoc
import GHC.Unit.State
import GHC.Utils.Outputable as Out
import GHC.Utils.Panic
#if !MIN_VERSION_ghc(9,3,0)
import GHC.Parser.Errors
import qualified GHC.Parser.Errors.Ppr as Ppr
import GHC.Utils.Error hiding (mkWarnMsg)
#endif
#if MIN_VERSION_ghc(9,3,0)
import Data.Maybe
import GHC.Driver.Config.Diagnostic
import GHC.Parser.Errors.Types
import GHC.Utils.Error
#endif
#if MIN_VERSION_ghc(9,5,0)
import GHC.Driver.Errors.Types (DriverMessage, GhcMessage)
#endif
#if MIN_VERSION_ghc(9,7,0)
import GHC.Types.Error (defaultDiagnosticOpts)
#endif
#if MIN_VERSION_ghc(9,5,0)
type PrintUnqualified = NamePprCtx
#endif
printWithoutUniques :: Outputable a => a -> String
printWithoutUniques :: forall a. Outputable a => a -> String
printWithoutUniques =
SDocContext -> SDoc -> String
renderWithContext (SDocContext
defaultSDocContext
{
sdocStyle = defaultUserStyle
, sdocSuppressUniques = True
, sdocCanUseUnicode = True
}) (SDoc -> String) -> (a -> SDoc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> SDoc
forall a. Outputable a => a -> SDoc
ppr
printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String
printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String
printSDocQualifiedUnsafe PrintUnqualified
unqual SDoc
doc =
SDocContext -> SDoc -> String
renderWithContext (SDocContext
defaultSDocContext { sdocStyle = sty }) SDoc
doc'
where
sty :: PprStyle
sty = PrintUnqualified -> Depth -> PprStyle
mkUserStyle PrintUnqualified
unqual Depth
AllTheWay
doc' :: SDoc
doc' = UnitState -> SDoc -> SDoc
pprWithUnitState UnitState
emptyUnitState SDoc
doc
#if !MIN_VERSION_ghc(9,3,0)
pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
pprWarning =
Ppr.pprWarning
pprError :: PsError -> MsgEnvelope DecoratedSDoc
pprError =
Ppr.pprError
#endif
formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String
formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String
formatErrorWithQual DynFlags
dflags MsgEnvelope DecoratedSDoc
e =
DynFlags -> SDoc -> String
showSDoc DynFlags
dflags (MsgEnvelope DecoratedSDoc -> SDoc
pprNoLocMsgEnvelope MsgEnvelope DecoratedSDoc
e)
#if MIN_VERSION_ghc(9,3,0)
pprNoLocMsgEnvelope :: MsgEnvelope DecoratedSDoc -> SDoc
#else
pprNoLocMsgEnvelope :: Error.RenderableDiagnostic e => MsgEnvelope e -> SDoc
#endif
pprNoLocMsgEnvelope :: MsgEnvelope DecoratedSDoc -> SDoc
pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic :: forall e. MsgEnvelope e -> e
errMsgDiagnostic = DecoratedSDoc
e
, errMsgContext :: forall e. MsgEnvelope e -> PrintUnqualified
errMsgContext = PrintUnqualified
unqual })
= (SDocContext -> SDoc) -> SDoc
sdocWithContext ((SDocContext -> SDoc) -> SDoc) -> (SDocContext -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
_ctx ->
PrintUnqualified -> SDoc -> SDoc
withErrStyle PrintUnqualified
unqual (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
#if MIN_VERSION_ghc(9,7,0)
formatBulleted e
#elif MIN_VERSION_ghc(9,3,0)
SDocContext -> DecoratedSDoc -> SDoc
formatBulleted SDocContext
_ctx (DecoratedSDoc -> SDoc) -> DecoratedSDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ DecoratedSDoc
e
#else
formatBulleted _ctx $ Error.renderDiagnostic e
#endif
type ErrMsg = MsgEnvelope DecoratedSDoc
#if MIN_VERSION_ghc(9,3,0)
type WarnMsg = MsgEnvelope DecoratedSDoc
#endif
mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
#if MIN_VERSION_ghc(9,5,0)
mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualifiedDefault HscEnv
env =
PromotionTickContext -> UnitEnv -> GlobalRdrEnv -> PrintUnqualified
mkNamePprCtx PromotionTickContext
ptc (HscEnv -> UnitEnv
hsc_unit_env HscEnv
env)
where
ptc :: PromotionTickContext
ptc = DynFlags -> PromotionTickContext
initPromotionTickContext (HscEnv -> DynFlags
hsc_dflags HscEnv
env)
#else
mkPrintUnqualifiedDefault env =
mkPrintUnqualified (hsc_unit_env env)
#endif
#if MIN_VERSION_ghc(9,3,0)
renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc
renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc
renderDiagnosticMessageWithHints a
a = DecoratedSDoc -> DecoratedSDoc -> DecoratedSDoc
Error.unionDecoratedSDoc
(DiagnosticOpts a -> a -> DecoratedSDoc
forall a. Diagnostic a => DiagnosticOpts a -> a -> DecoratedSDoc
diagnosticMessage
#if MIN_VERSION_ghc(9,5,0)
(forall a. Diagnostic a => DiagnosticOpts a
defaultDiagnosticOpts @a)
#endif
a
a) ([SDoc] -> DecoratedSDoc
mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ (GhcHint -> SDoc) -> [GhcHint] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map GhcHint -> SDoc
forall a. Outputable a => a -> SDoc
ppr ([GhcHint] -> [SDoc]) -> [GhcHint] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ a -> [GhcHint]
forall a. Diagnostic a => a -> [GhcHint]
diagnosticHints a
a)
#endif
#if MIN_VERSION_ghc(9,3,0)
mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
mkWarnMsg :: forall b.
DynFlags
-> Maybe DiagnosticReason
-> b
-> SrcSpan
-> PrintUnqualified
-> SDoc
-> MsgEnvelope DecoratedSDoc
mkWarnMsg DynFlags
df Maybe DiagnosticReason
reason b
_logFlags SrcSpan
l PrintUnqualified
st SDoc
doc = (DiagnosticMessage -> DecoratedSDoc)
-> MsgEnvelope DiagnosticMessage -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> MsgEnvelope a -> MsgEnvelope b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DiagnosticMessage -> DecoratedSDoc
forall a. Diagnostic a => a -> DecoratedSDoc
renderDiagnosticMessageWithHints (MsgEnvelope DiagnosticMessage -> MsgEnvelope DecoratedSDoc)
-> MsgEnvelope DiagnosticMessage -> MsgEnvelope DecoratedSDoc
forall a b. (a -> b) -> a -> b
$ DiagOpts
-> SrcSpan
-> PrintUnqualified
-> DiagnosticMessage
-> MsgEnvelope DiagnosticMessage
forall e.
Diagnostic e =>
DiagOpts -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
mkMsgEnvelope (DynFlags -> DiagOpts
initDiagOpts DynFlags
df) SrcSpan
l PrintUnqualified
st (DiagnosticReason -> [GhcHint] -> SDoc -> DiagnosticMessage
mkPlainDiagnostic (DiagnosticReason -> Maybe DiagnosticReason -> DiagnosticReason
forall a. a -> Maybe a -> a
fromMaybe DiagnosticReason
WarningWithoutFlag Maybe DiagnosticReason
reason) [] SDoc
doc)
#else
mkWarnMsg :: a -> b -> DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
mkWarnMsg _ _ =
const Error.mkWarnMsg
#endif
textDoc :: String -> SDoc
textDoc :: String -> SDoc
textDoc = String -> SDoc
forall doc. IsLine doc => String -> doc
text