************************************************************************

 -}

     logger <- getLogger

     name_ppr_ctx <- getNamePprCtx

 -- | Output a String message to the screen

 putMsgS :: String -> CoreM ()

 -- | Output a message to the screen

 putMsg :: SDoc -> CoreM ()

 diagnostic :: DiagnosticReason -> SDoc -> CoreM ()

 diagnostic reason doc = do

 -- | Output a fatal error to the screen. Does not cause the compiler to die.

 fatalErrorMsg :: SDoc -> CoreM ()

 -- | Output a string debugging message at verbosity level of @-v@ or higher

 debugTraceMsgS :: String -> CoreM ()

 -- | Outputs a debugging message at verbosity level of @-v@ or higher

 debugTraceMsg :: SDoc -> CoreM ()

 printMessage :: forall a. (Diagnostic a) => Logger -> DiagnosticOpts a -> DiagOpts -> MsgEnvelope a -> IO ()

 printMessage logger msg_opts opts message = do

   where

     logflags :: LogFlags

     logflags = logFlags logger

     doc :: SDoc

     doc = updSDocContext (\_ -> ctx) (messageWithHints diagnostic)

     style :: PprStyle

     style = mkErrStyle (errMsgContext message)

     severity :: Severity

     severity = errMsgSeverity message

     messageWithHints :: a -> SDoc

     messageWithHints e =

       let main_msg = formatBulleted $ diagnosticMessage msg_opts e

                hs  -> main_msg $$ hang (text "Suggested fixes:") 2

                                        (formatBulleted  $ mkDecorated . map ppr $ hs)

   where

     -- Pretty print the warning flag, if any (#10752)

     message :: SDoc

     addCaret :: IO SDoc

     addCaret = do

       caretDiagnostic <-

           if log_show_caret logflags

           else pure empty

       return $ getPprStyle $ \style ->

         withPprStyle (setStyleColoured True style)

     badInst ins | checkOverlap (overlapMode (is_flag ins))

                 = [formatLocMessage (nameSrcSpan $ getName $ is_dfun ins) $

                       ppr (overlapMode $ is_flag ins) <+>

                 | otherwise = []

 -- | Figure out the final correct safe haskell mode

     let deferDiagnostics _dflags !msg = do

           let action = logMsg logger msg

           case msg of

               -> atomicModifyIORef' warnings $ \(!i) -> (action: i, ())

               -> atomicModifyIORef' errors   $ \(!i) -> (action: i, ())

               -> atomicModifyIORef' fatals   $ \(!i) -> (action: i, ())

             _ -> action

         modifyLogger,

         pushLogHookM,

         popLogHookM,

         putLogMsgM,

         putMsgM,

         withTimingM,

 import GHC.Utils.Error

 import GHC.Utils.Logger

 import GHC.Types.SourceError

 import Control.Monad

 popLogHookM :: GhcMonad m => m ()

 popLogHookM  = modifyLogger popLogHook

 -- | Put a log message

 putMsgM :: GhcMonad m => SDoc -> m ()

 putMsgM doc = do

 import GHC.Types.Unique.DSet

 import GHC.Types.TyThing

 import GHC.Types.PkgQual

 import GHC.Unit.External

 import GHC.Unit.Module

                                    neverQualifyModules

                                    neverQualifyPackages

                                    alwaysPrintPromTick

       $ withPprStyle (mkDumpStyle name_ppr_ctx)

       $ pprModIface unit_state iface

 import GHC.Types.SrcLoc

 import GHC.Types.Unique.DSet

 import GHC.Types.Unique.DFM

 import GHC.Utils.Outputable

 import GHC.Utils.Panic

 maybePutSDoc :: Logger -> SDoc -> IO ()

 maybePutSDoc logger s

     = when (logVerbAtLeast logger 2) $

               MCInteractive

               $ withPprStyle defaultUserStyle s

    -- * Classifying Messages

    , Severity (..)

    , Diagnostic (..)

    , UnknownDiagnostic (..)

    , mapDecoratedSDoc

    , pprMessageBag

    , formatLocMessage

    , formatFatalLocMessage

    , formatDiagnostic

       -- See Note [Warnings controlled by multiple flags]

    } deriving (Functor, Foldable, Traversable)

 -- | The class for a diagnostic message. The main purpose is to classify a

 -- message within GHC, to distinguish it from a debug/dump message vs a proper

 -- diagnostic, for which we include a 'DiagnosticReason'.

     -- ^ Log message intended for compiler developers

     -- No file\/line\/column stuff

     -- ^ Log messages intended for end users.

     -- No file\/line\/column stuff.

     -- ^ Diagnostics from the compiler. This constructor is very powerful as

     -- arbitrary permutation of 'Severity' and 'DiagnosticReason'. As such,

     -- users are encouraged to use higher level primitives

     -- instead. Use this constructor directly only if you need to construct

     -- should always have a 'DiagnosticCode'. See Note [Diagnostic codes].

 {-# COMPLETE MCOutput, MCFatal, MCInteractive, MCDump, MCInfo, MCDiagnostic #-}

 {-

 Note [Suppressing Messages]

 pprMessageBag :: Bag SDoc -> SDoc

 pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs))

 formatFatalLocMessage :: SrcSpan -> SDoc -> SDoc

 formatFatalLocMessage locn msg = sdocOption sdocColScheme $ \col_scheme ->

       in formatLocMessageWarningGroups locn msg_title empty empty msg

 formatLocMessage :: SrcSpan -> SDoc -> SDoc

                    code_doc <+> warning_flag_doc

       in coloured (Col.sMessage col_scheme)

 getSeverityColour :: Severity -> Col.Scheme -> Col.PprColour

 getSeverityColour severity = case severity of

   SevWarning -> Col.sWarning

   SevIgnore -> const mempty

 getCaretDiagnostic _ (UnhelpfulSpan _) = pure empty

   caretDiagnostic <$> getSrcLine (srcSpanFile span) row

   where

     getSrcLine fn i =

     caretDiagnostic Nothing = empty

     caretDiagnostic (Just srcLineWithNewline) =

       sdocOption sdocColScheme$ \col_scheme ->

           marginColour = Col.sMargin col_scheme

       in

       coloured marginColour (text marginSpace) <>

         -- * Messages

         Diagnostic(..),

         MsgEnvelope(..),

         SDoc,

         DecoratedSDoc(unDecorated),

         Messages,

 fatalErrorMsg :: Logger -> SDoc -> IO ()

 fatalErrorMsg logger msg =

 compilationProgressMsg :: Logger -> SDoc -> IO ()

 compilationProgressMsg logger msg = do

   = logOutput logger (withUserStyle name_ppr_ctx AllTheWay msg)

 logInfo :: Logger -> SDoc -> IO ()

 -- | Like 'logInfo' but with 'SevOutput' rather then 'SevInfo'

 logOutput :: Logger -> SDoc -> IO ()

 prettyPrintGhcErrors :: ExceptionMonad m => Logger -> m a -> m a

     -- * Logger setup

     , initLogger

     , LogAction

     , DumpAction

     , TraceAction

     , DumpFormat (..)

     -- ** Hooks

     , popLogHook

     , pushLogHook

     , popDumpHook

     , pushDumpHook

     , popTraceHook

     , putLogMsg

     , defaultLogAction

     , defaultLogActionWithHandles

     , defaultLogActionHPrintDoc

     , defaultLogActionHPutStrDoc

     , logMsg

     , logDumpMsg

     -- * Dumping

 import qualified GHC.Utils.Ppr as Pretty

 import GHC.Utils.Outputable

 import GHC.Utils.Panic

 import GHC.Data.EnumSet (EnumSet)

 import qualified GHC.Data.EnumSet as EnumSet

               -> Message

               -> IO ()

 type DumpAction = LogFlags

                -> PprStyle

                -> DumpFlag

     { log_hook   :: [LogAction -> LogAction]

         -- ^ Log hooks stack

     , dump_hook  :: [DumpAction -> DumpAction]

         -- ^ Dump hooks stack

     dumps <- newMVar Map.empty

     return $ Logger

         { log_hook        = []

         , dump_hook       = []

         , trace_hook      = []

         , generated_dumps = dumps

 putLogMsg :: Logger -> LogAction

 putLogMsg logger = foldr ($) defaultLogAction (log_hook logger)

 -- | Dump something

 putDumpFile :: Logger -> DumpAction

 putDumpFile logger =

     []   -> panic "popLogHook: empty hook stack"

     _:hs -> logger { log_hook = hs }

 -- | Push a dump hook

 pushDumpHook :: (DumpAction -> DumpAction) -> Logger -> Logger

 pushDumpHook h logger = logger { dump_hook = h:dump_hook logger }

            $ pushTraceHook trc

            $ logger

 -- | The default 'LogAction' prints to 'stdout' and 'stderr'.

 --

 -- To replicate the default log action behaviour with different @out@ and @err@

 defaultLogActionWithHandles :: Handle {-^ Handle for standard output -} -> Handle {-^ Handle for standard errors -} -> LogAction

 defaultLogActionWithHandles out err logflags message

   = case message of

     where

       printOut   = defaultLogActionHPrintDoc  logflags False out

       printErrs  = defaultLogActionHPrintDoc  logflags False err

     -- write the dump to stdout

     writeDump Nothing = do

 -- | Run an action with the handle of a 'DumpFlag' if we are outputting to a

 logMsg :: Logger -> Message -> IO ()

 logMsg logger = putLogMsg logger (logFlags logger)

 -- | Dump something

 logDumpFile :: Logger -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()

 logDumpFile logger = putDumpFile logger (logFlags logger)

 -- | Log a dump message (not a dump file)

 logDumpMsg :: Logger -> String -> SDoc -> IO ()

   (withPprStyle defaultDumpStyle

   (mkDumpDoc hdr doc))

               dflags msg = do

     old_log_action dflags msg

     case msg of

             RealSrcSpan rsp _ -> modifyIORef lastErrLocations

                 (++ [(srcLocFile (realSrcSpanStart rsp), srcLocLine (realSrcSpanStart rsp))])

             _ -> return ()

     flags0 <- getSessionDynFlags

     let flags = flags0 {verbosity = 1 }

     setSessionDynFlags flags

           = handlerOutput $ GHC.showSDocForUser flags emptyUnitState alwaysQualify msg

         collectSrcError _ _

           = return ()