{-# 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,
    -- * Parser errors
    PsWarning,
    PsError,
#if MIN_VERSION_ghc(9,5,0)
    defaultDiagnosticOpts,
    GhcMessage,
    DriverMessage,
    Messages,
    initDiagOpts,
    pprMessages,
#endif
    DiagnosticReason(..),
    renderDiagnosticMessageWithHints,
    pprMsgEnvelopeBagWithLoc,
    Error.getMessages,
    renderWithContext,
    defaultSDocContext,
    errMsgDiagnostic,
    unDecorated,
    diagnosticMessage,
    -- * Error infrastructure
    DecoratedSDoc,
    MsgEnvelope,
    ErrMsg,
    WarnMsg,
    SourceError(..),
    errMsgSpan,
    errMsgSeverity,
    formatErrorWithQual,
    mkWarnMsg,
    mkSrcErr,
    srcErrorMessages,
    textDoc,
    ) where

import           Data.Maybe
import           GHC.Driver.Config.Diagnostic
import           GHC.Driver.Env
import           GHC.Driver.Ppr
import           GHC.Driver.Session
import           GHC.Parser.Errors.Types
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.Error
import           GHC.Utils.Outputable         as Out
import           GHC.Utils.Panic

-- See Note [Guidelines For Using CPP In GHCIDE Import Statements]

#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

-- | 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 :: 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 =
  -- Taken from 'showSDocForUser'
  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



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)

pprNoLocMsgEnvelope :: MsgEnvelope DecoratedSDoc -> SDoc
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
#else
      SDocContext -> DecoratedSDoc -> SDoc
formatBulleted SDocContext
_ctx DecoratedSDoc
e
#endif



#if MIN_VERSION_ghc(9,5,0)
type ErrMsg  = MsgEnvelope GhcMessage
type WarnMsg  = MsgEnvelope GhcMessage
#else
type ErrMsg  = MsgEnvelope DecoratedSDoc
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 =
  -- GHC 9.2 version
  -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
  mkPrintUnqualified (hsc_unit_env env)
#endif

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)

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)

textDoc :: String -> SDoc
textDoc :: String -> SDoc
textDoc = String -> SDoc
forall doc. IsLine doc => String -> doc
text