-- | Functions for initialising error message printing configuration from the
-- GHC session flags.
module GHC.Driver.Config.Diagnostic
  ( initDiagOpts
  , initPrintConfig
  , initPsMessageOpts
  , initDsMessageOpts
  , initTcMessageOpts
  , initDriverMessageOpts
  )
where

import GHC.Driver.Flags
import GHC.Driver.Session

import GHC.Utils.Outputable
import GHC.Utils.Error (DiagOpts (..))
import GHC.Driver.Errors.Types (GhcMessage, GhcMessageOpts (..), PsMessage, DriverMessage, DriverMessageOpts (..))
import GHC.Driver.Errors.Ppr ()
import GHC.Tc.Errors.Types
import GHC.HsToCore.Errors.Types
import GHC.Types.Error
import GHC.Tc.Errors.Ppr

-- | Initialise the general configuration for printing diagnostic messages
-- For example, this configuration controls things like whether warnings are
-- treated like errors.
initDiagOpts :: DynFlags -> DiagOpts
initDiagOpts :: DynFlags -> DiagOpts
initDiagOpts DynFlags
dflags = DiagOpts
  { diag_warning_flags :: EnumSet WarningFlag
diag_warning_flags       = DynFlags -> EnumSet WarningFlag
warningFlags DynFlags
dflags
  , diag_fatal_warning_flags :: EnumSet WarningFlag
diag_fatal_warning_flags = DynFlags -> EnumSet WarningFlag
fatalWarningFlags DynFlags
dflags
  , diag_warn_is_error :: Bool
diag_warn_is_error       = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_WarnIsError DynFlags
dflags
  , diag_reverse_errors :: Bool
diag_reverse_errors      = DynFlags -> Bool
reverseErrors DynFlags
dflags
  , diag_max_errors :: Maybe Int
diag_max_errors          = DynFlags -> Maybe Int
maxErrors DynFlags
dflags
  , diag_ppr_ctx :: SDocContext
diag_ppr_ctx             = DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflags PprStyle
defaultErrStyle
  }

-- | Initialise the configuration for printing specific diagnostic messages
initPrintConfig :: DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig :: DynFlags -> DiagnosticOpts GhcMessage
initPrintConfig DynFlags
dflags =
  GhcMessageOpts { psMessageOpts :: DiagnosticOpts PsMessage
psMessageOpts = DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts DynFlags
dflags
                 , tcMessageOpts :: DiagnosticOpts TcRnMessage
tcMessageOpts = DynFlags -> DiagnosticOpts TcRnMessage
initTcMessageOpts DynFlags
dflags
                 , dsMessageOpts :: DiagnosticOpts DsMessage
dsMessageOpts = DynFlags -> DiagnosticOpts DsMessage
initDsMessageOpts DynFlags
dflags
                 , driverMessageOpts :: DiagnosticOpts DriverMessage
driverMessageOpts= DynFlags -> DiagnosticOpts DriverMessage
initDriverMessageOpts DynFlags
dflags }

initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts DynFlags
_ = NoDiagnosticOpts
NoDiagnosticOpts

initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage
initTcMessageOpts DynFlags
dflags = TcRnMessageOpts { tcOptsShowContext :: Bool
tcOptsShowContext = GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_ShowErrorContext DynFlags
dflags }

initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage
initDsMessageOpts DynFlags
_ = NoDiagnosticOpts
NoDiagnosticOpts

initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage
initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage
initDriverMessageOpts DynFlags
dflags = DiagnosticOpts PsMessage -> DriverMessageOpts
DriverMessageOpts (DynFlags -> DiagnosticOpts PsMessage
initPsMessageOpts DynFlags
dflags)