name_ppr_ctx <- getNamePprCtx

     let m = case msg of

                 MCDump doc -> MCDump (dump_sty doc)

                 MCOutput doc -> MCOutput (user_sty doc)

                 MCFatal doc -> MCFatal (user_sty doc)

                 MCInteractive doc -> MCInteractive (user_sty doc)

 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)

     let deferDiagnostics _dflags !msg = do

           let action = logMsg logger msg

           case msg of

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

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

             MCFatal _

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

         modifyLogger,

         pushLogHookM,

         popLogHookM,

         putLogMsgM,

         putMsgM,

         withTimingM,

 popLogHookM :: GhcMonad m => m ()

 popLogHookM  = modifyLogger popLogHook

 -- | Put a log message

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

 putMsgM doc = do

    , mapDecoratedSDoc

    , pprMessageBag

    , formatLocMessage

    , formatFatalLocMessage

    , formatDiagnostic

     -- ^ Log messages intended for end users.

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

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

     -- it allows the construction of a 'Message' with a completely

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

     -- 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

       in coloured (Col.sMessage col_scheme)

                   $ hang (coloured (Col.sHeader col_scheme) header) 4 msg

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

 getSeverityColour severity = case severity of

   SevError -> Col.sError

   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) <>

     -- * 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@

       MCInteractive msg -> putStrSDoc msg

       MCInfo msg -> printErrs msg

       MCFatal msg -> printErrs msg

     where

       printOut   = defaultLogActionHPrintDoc  logflags False out

       printErrs  = defaultLogActionHPrintDoc  logflags False err

 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)

               dflags msg = do

     old_log_action dflags msg

     case msg of

             RealSrcSpan rsp _ -> modifyIORef lastErrLocations

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

             _ -> return ()