module GHC.Driver.Errors (

     reportError

   , reportDiagnostic

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

     messageClass :: MessageClass

     style :: PprStyle

     style = mkErrStyle (errMsgContext message)

 {-# LANGUAGE MultiWayIf #-}

 {-# OPTIONS_GHC -fprof-auto-top #-}

 -------------------------------------------------------------------------------

 -- | Aspects of GHC.Driver.Main dealing with running particular passes.

     whyUnsafe' df = vcat [ quotes pprMod <+> text "has been inferred as unsafe!"

                          , text "Reason:"

                          , nest 4 $ (vcat $ badFlags df) $+$

                                     (vcat $ badInsts $ tcg_insts tcg_env)

                          ]

     badFlags df   = concatMap (badFlag df) unsafeFlagsForInfer

 import GHC.Runtime.Loader      ( initializePlugins )

 import GHC.Types.Basic        ( SuccessFlag(..), ForeignSrcLang(..) )

 import GHC.Types.ForeignStubs ( ForeignStubs (NoStubs) )

 import GHC.Types.Target

 import GHC.Types.SrcLoc

     to_driver_messages :: Messages GhcMessage -> Messages DriverMessage

     to_driver_messages msgs = case traverse to_driver_message msgs of

       Just msgs' -> msgs'

     to_driver_message = \case

          thing_inside

        ; case mb_ret of

            Just ret -> pure ret

 mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv

          -> TcMPluginsRun

 import GHC.Core.InstEnv

 import GHC.Core.TyCon

 import GHC.Utils.Misc

 import GHC.Utils.Outputable as O

 import GHC.Utils.Panic

                   hints

          -- This will be reported at runtime, so we always want "error:" in the report, never "warning:"

        ; dflags <- getDynFlags

        ; return $ evDelayedError ty err_str }

 reportDiagnostic :: MsgEnvelope TcRnMessage -> TcRn ()

 reportDiagnostic msg

          msgs     <- readTcRef errs_var ;

          writeTcRef errs_var (msg `addMessage` msgs) }

    -- * Classifying Messages

    , Severity (..)

    , Diagnostic (..)

    , UnknownDiagnostic (..)

     -- ^ 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 'MessageClass' with a completely

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

     -- 'GHC.Utils.Error'. In all the other circumstances, /especially/ when

     -- emitting compiler diagnostics, use higher level primitives.

     --

     -- The @Maybe 'DiagnosticCode'@ field carries a code (if available) for

     -- this diagnostic. If you are creating a message not tied to any

     -- error-message type, then use Nothing. In the long run, this really

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

 {-

 Note [Suppressing Messages]

 import GHC.Utils.Monad

 import GHC.Utils.Panic

 import GHC.Utils.Exception

 import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig)

 import GHC.Driver.DynFlags (DynFlags, HasDynFlags (getDynFlags))

   -- We implement 'Show' because it's required by the 'Exception' instance, but diagnostics

   -- shouldn't be shown via the 'Show' typeclass, but rather rendered using the ppr functions.

   -- This also explains why there is no 'Show' instance for a 'MsgEnvelope'.

 instance Exception SourceError

 {-# LANGUAGE ViewPatterns    #-}

 {-

 (c) The AQUA Project, Glasgow University, 1994-1998

         errorsFound, isEmptyMessages,

         -- ** Formatting

         -- ** Construction

         DiagOpts (..), emptyDiagOpts, diag_wopt, diag_fatal_wopt,

     msgs ctx = filter (not . Outputable.isEmpty ctx) docs

     starred = (bullet<+>)

                                     , errMsgDiagnostic = e

                                     , errMsgSeverity   = sev

                                     , errMsgContext    = name_ppr_ctx

                                     , errMsgReason     = reason })

   = withErrStyle name_ppr_ctx $

       mkLocMessage

         s

         (formatBulleted $ diagnosticMessage opts e)

   -- We implement 'Show' because it's required by the 'Exception' instance, but diagnostics

   -- shouldn't be shown via the 'Show' typeclass, but rather rendered using the ppr functions.

   -- This also explains why there is no 'Show' instance for a 'MsgEnvelope'.

 -- | Perform the given action and call the exception handler if the action

 -- throws a 'GhciCommandError'.  See 'GhciCommandError' for more information.

 parseOneFile libdir fileName = do

   res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName

   case res of

     Right (injectedComments, _dflags, pmod) -> do

       let !pmodWithComments = insertCppComments pmod injectedComments

       return (pmodWithComments, [])

 -- ---------------------------------------------------------------------

 exactprintWithChange :: FilePath -> Changer -> ParsedSource -> IO (String, ParsedSource)

       new_env = hsc_env { GHC.hsc_dflags = injectCppOptions cppOptions dfs }

   r <- GHC.liftIO $ GHC.preprocess new_env src_fn Nothing (Just (GHC.Cpp GHC.HsSrcFile))

   case r of

     Right (dflags', hspp_fn) -> do

       buf <- GHC.liftIO $ GHC.hGetStringBuffer hspp_fn

       txt <- GHC.liftIO $ readFileGhc hspp_fn

       return (txt, buf, dflags')

 injectCppOptions :: CppOptions -> GHC.DynFlags -> GHC.DynFlags

 injectCppOptions CppOptions{..} dflags = folded_opt

   where

       mast

         | M.size asts == 1 = snd <$> M.lookupMin asts

         | otherwise = M.lookup (HiePath (mkFastString file)) asts

       ast = fromMaybe (emptyHieAst fileFs) mast

       fullAst = recoverFullIfaceTypes sDocContext types ast

 import Control.Monad.Trans.Maybe

 import qualified Data.ByteString as BS

 import Data.List (isPrefixOf, isSuffixOf)

 import GHC.Data.FastString (mkFastString)

 import GHC.Data.StringBuffer (StringBuffer, atEnd)

 import GHC.Parser.Errors.Ppr ()

 import qualified GHC.Types.Error as E

 import GHC.Types.SourceText

 import GHC.Types.SrcLoc

 import Haddock.Backends.Hyperlinker.Types as T

 import Haddock.GhcUtils

 -- whitespace, and CPP).

 parse

   :: ParserOpts

   -> FilePath

   -- ^ Path to the source of this module

   -> BS.ByteString

   -- ^ Raw UTF-8 encoded source of this module

   -> [T.Token]

   POk _ toks -> reverse toks

   where

     initState = initParserState parserOpts buf start

     buf = stringBufferFromByteString bs