{-# LANGUAGE CPP #-}

module Development.IDE.GHC.Compat.Outputable (
    SDoc,
    Outputable,
    showSDoc,
    showSDocUnsafe,
    showSDocForUser,
    ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest,
    printSDocQualifiedUnsafe,
    printWithoutUniques,
    mkPrintUnqualified,
    mkPrintUnqualifiedDefault,
    PrintUnqualified(..),
    defaultUserStyle,
    withPprStyle,
    -- * Parser errors
    PsWarning,
    PsError,
    pprWarning,
    pprError,
    -- * Error infrastructure
    DecoratedSDoc,
    MsgEnvelope,
    errMsgSpan,
    errMsgSeverity,
    formatErrorWithQual,
    mkWarnMsg,
    mkSrcErr,
    srcErrorMessages,
    ) where


#if MIN_VERSION_ghc(9,2,0)
import           GHC.Driver.Env
import           GHC.Driver.Ppr
import           GHC.Driver.Session
import           GHC.Parser.Errors
import qualified GHC.Parser.Errors.Ppr           as Ppr
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                 hiding (mkWarnMsg)
import           GHC.Utils.Outputable            as Out hiding (defaultUserStyle)
import qualified GHC.Utils.Outputable            as Out
import           GHC.Utils.Panic
#elif MIN_VERSION_ghc(9,0,0)
import           GHC.Driver.Session
import           GHC.Driver.Types                as HscTypes
import           GHC.Types.Name.Reader           (GlobalRdrEnv)
import           GHC.Types.SrcLoc
import           GHC.Utils.Error                 as Err hiding (mkWarnMsg)
import qualified GHC.Utils.Error                 as Err
import           GHC.Utils.Outputable            as Out hiding (defaultUserStyle)
import qualified GHC.Utils.Outputable            as Out
#else
import           Development.IDE.GHC.Compat.Core (GlobalRdrEnv)
import           DynFlags
import           ErrUtils                        hiding (mkWarnMsg)
import qualified ErrUtils                        as Err
import           HscTypes
import           Outputable                      as Out hiding (defaultUserStyle)
import qualified Outputable                      as Out
import           SrcLoc
#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 :: a -> String
printWithoutUniques =
#if MIN_VERSION_ghc(9,2,0)
  renderWithContext (defaultSDocContext
    {
      sdocStyle = defaultUserStyle
    , sdocSuppressUniques = True
    , sdocCanUseUnicode = True
    }) . ppr
#else
  SDoc -> String
go (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
    where
      go :: SDoc -> String
go SDoc
sdoc = DynFlags -> SDoc -> PprStyle -> String
oldRenderWithStyle DynFlags
dflags SDoc
sdoc (DynFlags -> PrintUnqualified -> Depth -> PprStyle
oldMkUserStyle DynFlags
dflags PrintUnqualified
neverQualify Depth
AllTheWay)
      dflags :: DynFlags
dflags = DynFlags
unsafeGlobalDynFlags DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_SuppressUniques
#endif

printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String
#if MIN_VERSION_ghc(9,2,0)
printSDocQualifiedUnsafe unqual doc =
  -- Taken from 'showSDocForUser'
  renderWithContext (defaultSDocContext { sdocStyle = sty }) doc'
  where
    sty  = mkUserStyle unqual AllTheWay
    doc' = pprWithUnitState emptyUnitState doc
#else
printSDocQualifiedUnsafe :: PrintUnqualified -> SDoc -> String
printSDocQualifiedUnsafe PrintUnqualified
unqual SDoc
doc =
    DynFlags -> PrintUnqualified -> SDoc -> String
showSDocForUser DynFlags
unsafeGlobalDynFlags PrintUnqualified
unqual SDoc
doc
#endif

#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
#elif !MIN_VERSION_ghc(9,0,0)
oldRenderWithStyle :: DynFlags -> Out.SDoc -> Out.PprStyle -> String
oldRenderWithStyle :: DynFlags -> SDoc -> PprStyle -> String
oldRenderWithStyle = DynFlags -> SDoc -> PprStyle -> String
Out.renderWithStyle

oldMkUserStyle :: DynFlags -> Out.PrintUnqualified -> Out.Depth -> Out.PprStyle
oldMkUserStyle :: DynFlags -> PrintUnqualified -> Depth -> PprStyle
oldMkUserStyle = DynFlags -> PrintUnqualified -> Depth -> PprStyle
Out.mkUserStyle

oldMkErrStyle :: DynFlags -> Out.PrintUnqualified -> Out.PprStyle
oldMkErrStyle :: DynFlags -> PrintUnqualified -> PprStyle
oldMkErrStyle = DynFlags -> PrintUnqualified -> PprStyle
Out.mkErrStyle

oldFormatErrDoc :: DynFlags -> Err.ErrDoc -> Out.SDoc
oldFormatErrDoc :: DynFlags -> ErrDoc -> SDoc
oldFormatErrDoc = DynFlags -> ErrDoc -> SDoc
Err.formatErrDoc
#endif

pprWarning :: PsWarning -> MsgEnvelope DecoratedSDoc
pprWarning :: PsWarning -> PsWarning
pprWarning =
#if MIN_VERSION_ghc(9,2,0)
  Ppr.pprWarning
#else
  PsWarning -> PsWarning
forall a. a -> a
id
#endif

pprError :: PsError -> MsgEnvelope DecoratedSDoc
pprError :: PsWarning -> PsWarning
pprError =
#if MIN_VERSION_ghc(9,2,0)
  Ppr.pprError
#else
  PsWarning -> PsWarning
forall a. a -> a
id
#endif

formatErrorWithQual :: DynFlags -> MsgEnvelope DecoratedSDoc -> String
formatErrorWithQual :: DynFlags -> PsWarning -> String
formatErrorWithQual DynFlags
dflags PsWarning
e =
#if MIN_VERSION_ghc(9,2,0)
  showSDoc dflags (pprNoLocMsgEnvelope e)

pprNoLocMsgEnvelope :: Error.RenderableDiagnostic e => MsgEnvelope e -> SDoc
pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e
                                 , errMsgContext   = unqual })
  = sdocWithContext $ \ctx ->
    withErrStyle unqual $
      (formatBulleted ctx $ Error.renderDiagnostic e)

#else
  DynFlags -> SDoc -> String
Out.showSDoc DynFlags
dflags
  (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ PprStyle -> SDoc -> SDoc
Out.withPprStyle (DynFlags -> PrintUnqualified -> PprStyle
oldMkErrStyle DynFlags
dflags (PrintUnqualified -> PprStyle) -> PrintUnqualified -> PprStyle
forall a b. (a -> b) -> a -> b
$ PsWarning -> PrintUnqualified
errMsgContext PsWarning
e)
  (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ DynFlags -> ErrDoc -> SDoc
oldFormatErrDoc DynFlags
dflags
  (ErrDoc -> SDoc) -> ErrDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ PsWarning -> ErrDoc
Err.errMsgDoc PsWarning
e
#endif

#if !MIN_VERSION_ghc(9,2,0)
type DecoratedSDoc = ()
type MsgEnvelope e = ErrMsg

type PsWarning = ErrMsg
type PsError = ErrMsg
#endif

mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified
mkPrintUnqualifiedDefault HscEnv
env =
#if MIN_VERSION_ghc(9,2,0)
  -- GHC 9.2 version
  -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
  mkPrintUnqualified (hsc_unit_env env)
#else
  DynFlags -> GlobalRdrEnv -> PrintUnqualified
HscTypes.mkPrintUnqualified (HscEnv -> DynFlags
hsc_dflags HscEnv
env)
#endif

mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
mkWarnMsg :: DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> PsWarning
mkWarnMsg =
#if MIN_VERSION_ghc(9,2,0)
  const Error.mkWarnMsg
#else
  DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> PsWarning
Err.mkWarnMsg
#endif

defaultUserStyle :: PprStyle
#if MIN_VERSION_ghc(9,0,0)
defaultUserStyle = Out.defaultUserStyle
#else
defaultUserStyle :: PprStyle
defaultUserStyle = DynFlags -> PprStyle
Out.defaultUserStyle DynFlags
unsafeGlobalDynFlags
#endif