[Git][ghc/ghc][master] Change WarningWithFlag to plural WarningWithFlags

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Tue Jun 13 13:42:52 UTC 2023



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
a1f350e2 by Oleg Grenrus at 2023-06-13T09:42:16-04:00
Change WarningWithFlag to plural WarningWithFlags

Resolves #22825

Now each diagnostic can name multiple different warning flags for its reason.

There is currently one use case: missing signatures.
Currently we need to check which warning flags are enabled when
generating the diagnostic, which is against the declarative nature of
the diagnostic framework.

This patch allows a warning diagnostic to have multiple warning flags,
which makes setup more declarative.

The WarningWithFlag pattern synonym is added for backwards compatibility

The 'msgEnvReason' field is added to MsgEnvelope to store the
`ResolvedDiagnosticReason`, which accounts for the enabled flags, and
then that is used for pretty printing the diagnostic.

- - - - -


7 changed files:

- compiler/GHC/Driver/Errors.hs
- compiler/GHC/Rename/Names.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error.hs
- compiler/GHC/Utils/Error.hs
- testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs


Changes:

=====================================
compiler/GHC/Driver/Errors.hs
=====================================
@@ -17,11 +17,12 @@ printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOp
 printMessages logger msg_opts opts msgs
   = sequence_ [ let style = mkErrStyle name_ppr_ctx
                     ctx   = (diag_ppr_ctx opts) { sdocStyle = style }
-                in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $
+                in logMsg logger (MCDiagnostic sev reason (diagnosticCode dia)) s $
                    updSDocContext (\_ -> ctx) (messageWithHints dia)
               | MsgEnvelope { errMsgSpan       = s,
                               errMsgDiagnostic = dia,
                               errMsgSeverity   = sev,
+                              errMsgReason     = reason,
                               errMsgContext    = name_ppr_ctx }
                   <- sortMsgBag (Just opts) (getMessages msgs) ]
   where


=====================================
compiler/GHC/Rename/Names.hs
=====================================
@@ -1635,9 +1635,7 @@ There are four warning flags in play:
 -- inferred type of the function
 warnMissingSignatures :: TcGblEnv -> RnM ()
 warnMissingSignatures gbl_env
-  = do { warn_binds    <- woptM Opt_WarnMissingSignatures
-       ; warn_pat_syns <- woptM Opt_WarnMissingPatternSynonymSignatures
-       ; let exports = availsToNameSet (tcg_exports gbl_env)
+  = do { let exports = availsToNameSet (tcg_exports gbl_env)
              sig_ns  = tcg_sigs gbl_env
                -- We use sig_ns to exclude top-level bindings that are generated by GHC
              binds    = collectHsBindsBinders CollNoDictBinders $ tcg_binds gbl_env
@@ -1652,7 +1650,7 @@ warnMissingSignatures gbl_env
                do { env <- liftZonkM $ tcInitTidyEnv -- Why not use emptyTidyEnv?
                   ; let (_, ty) = tidyOpenType env (idType id)
                         missing = MissingTopLevelBindingSig name ty
-                        diag = TcRnMissingSignature missing exported warn_binds
+                        diag = TcRnMissingSignature missing exported
                   ; addDiagnosticAt (getSrcSpan name) diag }
                where
                  name = idName id
@@ -1664,7 +1662,7 @@ warnMissingSignatures gbl_env
              add_patsyn_warn ps =
                when (not_ghc_generated name) $
                  addDiagnosticAt (getSrcSpan name)
-                  (TcRnMissingSignature missing exported warn_pat_syns)
+                  (TcRnMissingSignature missing exported)
                where
                  name = patSynName ps
                  missing = MissingPatSynSig ps
@@ -1700,7 +1698,7 @@ warnMissingKindSignatures gbl_env
         addDiagnosticAt (getSrcSpan name) diag
       where
         name = tyConName tyCon
-        diag = TcRnMissingSignature missing exported False
+        diag = TcRnMissingSignature missing exported
         missing = MissingTyConKindSig tyCon cusks_enabled
         exported = if name `elemNameSet` exports
                    then IsExported


=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -352,7 +352,7 @@ instance Diagnostic TcRnMessage where
               = sep [ quotes (ppr n), text "should really be", quotes (ppr rhs_ty) ]
               | otherwise
               = empty
-    TcRnMissingSignature what _ _ ->
+    TcRnMissingSignature what _ ->
       mkSimpleDecorated $
       case what of
         MissingPatSynSig p ->
@@ -1939,8 +1939,8 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnPartialTypeSigBadQuantifier{}
       -> ErrorWithoutFlag
-    TcRnMissingSignature what exported overridden
-      -> WarningWithFlag $ missingSignatureWarningFlag what exported overridden
+    TcRnMissingSignature what exported
+      -> WarningWithFlags $ missingSignatureWarningFlags what exported
     TcRnPolymorphicBinderMissingSig{}
       -> WarningWithFlag Opt_WarnMissingLocalSignatures
     TcRnOverloadedSig{}
@@ -3310,22 +3310,19 @@ formatExportItemError exportedThing reason =
        , quotes exportedThing
        , text reason ]
 
--- | What warning flag is associated with the given missing signature?
-missingSignatureWarningFlag :: MissingSignature -> Exported -> Bool -> WarningFlag
-missingSignatureWarningFlag (MissingTopLevelBindingSig {}) exported overridden
-  | IsExported <- exported
-  , not overridden
-  = Opt_WarnMissingExportedSignatures
-  | otherwise
-  = Opt_WarnMissingSignatures
-missingSignatureWarningFlag (MissingPatSynSig {}) exported overridden
-  | IsExported <- exported
-  , not overridden
-  = Opt_WarnMissingExportedPatternSynonymSignatures
-  | otherwise
-  = Opt_WarnMissingPatternSynonymSignatures
-missingSignatureWarningFlag (MissingTyConKindSig {}) _ _
-  = Opt_WarnMissingKindSignatures
+-- | What warning flags are associated with the given missing signature?
+missingSignatureWarningFlags :: MissingSignature -> Exported -> NonEmpty WarningFlag
+missingSignatureWarningFlags (MissingTopLevelBindingSig {}) exported
+  -- We prefer "bigger" warnings first: #14794
+  --
+  -- See Note [Warnings controlled by multiple flags]
+  = Opt_WarnMissingSignatures :|
+    [ Opt_WarnMissingExportedSignatures | IsExported == exported ]
+missingSignatureWarningFlags (MissingPatSynSig {}) exported
+  = Opt_WarnMissingPatternSynonymSignatures :|
+    [ Opt_WarnMissingExportedPatternSynonymSignatures | IsExported  == exported ]
+missingSignatureWarningFlags (MissingTyConKindSig {}) _
+  = Opt_WarnMissingKindSignatures :| []
 
 useDerivingStrategies :: GhcHint
 useDerivingStrategies =


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -941,8 +941,6 @@ data TcRnMessage where
   -}
   TcRnMissingSignature :: MissingSignature
                        -> Exported
-                       -> Bool -- ^ True: -Wmissing-signatures overrides -Wmissing-exported-signatures,
-                               --     or -Wmissing-pattern-synonym-signatures overrides -Wmissing-exported-pattern-synonym-signatures
                        -> TcRnMessage
 
   {-| TcRnPolymorphicBinderMissingSig is a warning controlled by -Wmissing-local-signatures
@@ -4494,6 +4492,7 @@ data MissingSignature
 data Exported
   = IsNotExported
   | IsExported
+  deriving Eq
 
 instance Outputable Exported where
   ppr IsNotExported = text "IsNotExported"


=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -8,6 +8,7 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 module GHC.Types.Error
    ( -- * Messages
@@ -32,7 +33,8 @@ module GHC.Types.Error
    , mkUnknownDiagnostic
    , embedUnknownDiagnostic
    , DiagnosticMessage (..)
-   , DiagnosticReason (..)
+   , DiagnosticReason (WarningWithFlag, ..)
+   , ResolvedDiagnosticReason(..)
    , DiagnosticHint (..)
    , mkPlainDiagnostic
    , mkPlainError
@@ -103,6 +105,7 @@ import GHC.Unit.Module.Warnings (WarningCategory)
 
 import Data.Bifunctor
 import Data.Foldable    ( fold )
+import Data.List.NonEmpty ( NonEmpty (..) )
 import qualified Data.List.NonEmpty as NE
 import Data.List ( intercalate )
 import Data.Typeable ( Typeable )
@@ -159,7 +162,10 @@ instance Diagnostic e => Outputable (Messages e) where
   ppr msgs = braces (vcat (map ppr_one (bagToList (getMessages msgs))))
      where
        ppr_one :: MsgEnvelope e -> SDoc
-       ppr_one envelope = pprDiagnostic (errMsgDiagnostic envelope)
+       ppr_one envelope =
+        vcat [ text "Resolved:" <+> ppr (errMsgReason envelope),
+               pprDiagnostic (errMsgDiagnostic envelope)
+             ]
 
 {- Note [Discarding Messages]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -363,7 +369,7 @@ mkDecoratedError hints docs = DiagnosticMessage (mkDecorated docs) ErrorWithoutF
 data DiagnosticReason
   = WarningWithoutFlag
   -- ^ Born as a warning.
-  | WarningWithFlag !WarningFlag
+  | WarningWithFlags !(NE.NonEmpty WarningFlag)
   -- ^ Warning was enabled with the flag.
   | WarningWithCategory !WarningCategory
   -- ^ Warning was enabled with a custom category.
@@ -371,13 +377,67 @@ data DiagnosticReason
   -- ^ Born as an error.
   deriving (Eq, Show)
 
+-- | Like a 'DiagnosticReason', but resolved against a specific set of `DynFlags` to
+-- work out which warning flag actually enabled this warning.
+newtype ResolvedDiagnosticReason
+          = ResolvedDiagnosticReason { resolvedDiagnosticReason :: DiagnosticReason }
+
+-- | The single warning case 'DiagnosticReason' is very common.
+pattern WarningWithFlag :: WarningFlag -> DiagnosticReason
+pattern WarningWithFlag w = WarningWithFlags (w :| [])
+
+{-
+Note [Warnings controlled by multiple flags]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Diagnostics that started life as flag-controlled warnings have a
+'diagnosticReason' of 'WarningWithFlags', giving the flags that control the
+warning. Usually there is only one flag, but in a few cases multiple flags
+apply. Where there are more than one, they are listed highest-priority first.
+
+For example, the same exported binding may give rise to a warning if either
+`-Wmissing-signatures` or `-Wmissing-exported-signatures` is enabled. Here
+`-Wmissing-signatures` has higher priority, because we want to mention it if
+before are enabled.  See `missingSignatureWarningFlags` for the specific logic
+in this case.
+
+When reporting such a warning to the user, it is important to mention the
+correct flag (e.g. `-Wmissing-signatures` if it is enabled, or
+`-Wmissing-exported-signatures` if only the latter is enabled).  Thus
+`diag_reason_severity` filters the `DiagnosticReason` based on the currently
+active `DiagOpts`. For a `WarningWithFlags` it returns only the flags that are
+enabled; it leaves other `DiagnosticReason`s unchanged. This is then wrapped
+in a `ResolvedDiagnosticReason` newtype which records that this filtering has
+taken place.
+
+If we have `-Wmissing-signatures -Werror=missing-exported-signatures` we want
+the error to mention `-Werror=missing-exported-signatures` (even though
+`-Wmissing-signatures` would normally take precedence). Thus if there are any
+fatal warnings, `diag_reason_severity` returns those alone.
+
+The `MsgEnvelope` stores the filtered `ResolvedDiagnosticReason` listing only the
+relevant flags for subsequent display.
+
+
+Side note: we do not treat `-Wmissing-signatures` as a warning group that
+includes `-Wmissing-exported-signatures`, because
+
+  (a) this would require us to provide a flag for the complement, and
+
+  (b) currently, in `-Wmissing-exported-signatures -Wno-missing-signatures`, the
+      latter option does not switch off the former.
+-}
+
 instance Outputable DiagnosticReason where
   ppr = \case
     WarningWithoutFlag  -> text "WarningWithoutFlag"
-    WarningWithFlag wf  -> text ("WarningWithFlag " ++ show wf)
+    WarningWithFlags wf -> text ("WarningWithFlags " ++ show wf)
     WarningWithCategory cat -> text "WarningWithCategory" <+> ppr cat
     ErrorWithoutFlag    -> text "ErrorWithoutFlag"
 
+instance Outputable ResolvedDiagnosticReason where
+  ppr = ppr . resolvedDiagnosticReason
+
 -- | An envelope for GHC's facts about a running program, parameterised over the
 -- /domain-specific/ (i.e. parsing, typecheck-renaming, etc) diagnostics.
 --
@@ -392,6 +452,10 @@ data MsgEnvelope e = MsgEnvelope
    , errMsgContext     :: NamePprCtx
    , errMsgDiagnostic  :: e
    , errMsgSeverity    :: Severity
+   , errMsgReason      :: ResolvedDiagnosticReason
+      -- ^ The actual reason caused this message
+      --
+      -- See Note [Warnings controlled by multiple flags]
    } deriving (Functor, Foldable, Traversable)
 
 -- | The class for a diagnostic message. The main purpose is to classify a
@@ -410,7 +474,7 @@ data MessageClass
     -- ^ Log messages intended for end users.
     -- No file\/line\/column stuff.
 
-  | MCDiagnostic Severity DiagnosticReason (Maybe DiagnosticCode)
+  | MCDiagnostic Severity ResolvedDiagnosticReason (Maybe DiagnosticCode)
     -- ^ 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,
@@ -464,7 +528,7 @@ data Severity
   -- don't want to see. See Note [Suppressing Messages]
   | SevWarning
   | SevError
-  deriving (Eq, Show)
+  deriving (Eq, Ord, Show)
 
 instance Outputable Severity where
   ppr = \case
@@ -532,8 +596,9 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg
           warning_flag_doc =
             case msg_class of
               MCDiagnostic sev reason _code
-                | Just msg <- flag_msg sev reason -> brackets msg
-              _                                   -> empty
+                | Just msg <- flag_msg sev (resolvedDiagnosticReason reason)
+                  -> brackets msg
+              _   -> empty
 
           code_doc =
             case msg_class of
@@ -546,7 +611,7 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg
             -- in a log file, e.g. with -ddump-tc-trace. It should not
             -- happen otherwise, though.
           flag_msg SevError WarningWithoutFlag = Just (col "-Werror")
-          flag_msg SevError (WarningWithFlag wflag) =
+          flag_msg SevError (WarningWithFlags (wflag :| _)) =
             let name = NE.head (warnFlagNames wflag) in
             Just $ col ("-W" ++ name) <+> warn_flag_grp (smallestWarningGroups wflag)
                                       <> comma
@@ -558,7 +623,7 @@ mkLocMessageWarningGroups show_warn_groups msg_class locn msg
                        <+> coloured msg_colour (text "-Werror=" <> ppr cat)
           flag_msg SevError   ErrorWithoutFlag   = Nothing
           flag_msg SevWarning WarningWithoutFlag = Nothing
-          flag_msg SevWarning (WarningWithFlag wflag) =
+          flag_msg SevWarning (WarningWithFlags (wflag :| _)) =
             let name = NE.head (warnFlagNames wflag) in
             Just (col ("-W" ++ name) <+> warn_flag_grp (smallestWarningGroups wflag))
           flag_msg SevWarning (WarningWithCategory cat) =
@@ -689,7 +754,7 @@ later classify and report them appropriately (in the driver).
 -- | Returns 'True' if this is, intrinsically, a failure. See
 -- Note [Intrinsic And Extrinsic Failures].
 isIntrinsicErrorMessage :: Diagnostic e => MsgEnvelope e -> Bool
-isIntrinsicErrorMessage = (==) ErrorWithoutFlag . diagnosticReason . errMsgDiagnostic
+isIntrinsicErrorMessage = (==) ErrorWithoutFlag . resolvedDiagnosticReason . errMsgReason
 
 isWarningMessage :: Diagnostic e => MsgEnvelope e -> Bool
 isWarningMessage = not . isIntrinsicErrorMessage


=====================================
compiler/GHC/Utils/Error.hs
=====================================
@@ -90,6 +90,8 @@ import Control.Monad.IO.Class
 import Control.Monad.Catch as MC (handle)
 import GHC.Conc         ( getAllocationCounter )
 import System.CPUTime
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.List.NonEmpty as NE
 
 data DiagOpts = DiagOpts
   { diag_warning_flags       :: !(EnumSet WarningFlag) -- ^ Enabled warnings
@@ -132,32 +134,49 @@ diag_fatal_wopt_custom wflag opts = wflag `elemWarningCategorySet` diag_fatal_cu
 -- i.e. with a 'DiagOpts \"snapshot\" taken as close as possible to where a
 -- particular diagnostic message is built, otherwise the computed 'Severity' might
 -- not be correct, due to the mutable nature of the 'DynFlags' in GHC.
+--
+--
 diagReasonSeverity :: DiagOpts -> DiagnosticReason -> Severity
-diagReasonSeverity opts reason = case reason of
-  WarningWithFlag wflag
-    | not (diag_wopt wflag opts) -> SevIgnore
-    | diag_fatal_wopt wflag opts -> SevError
-    | otherwise                  -> SevWarning
+diagReasonSeverity opts reason = fst (diag_reason_severity opts reason)
+
+-- Like the diagReasonSeverity but the second half of the pair is a small
+-- ReasolvedDiagnosticReason which would cause the diagnostic to be triggered with the
+-- same severity.
+--
+-- See Note [Warnings controlled by multiple flags]
+--
+diag_reason_severity :: DiagOpts -> DiagnosticReason -> (Severity, ResolvedDiagnosticReason)
+diag_reason_severity opts reason = fmap ResolvedDiagnosticReason $ case reason of
+  WarningWithFlags wflags -> case wflags' of
+    []     -> (SevIgnore, reason)
+    w : ws -> case wflagsE of
+      []     -> (SevWarning, WarningWithFlags (w :| ws))
+      e : es -> (SevError, WarningWithFlags (e :| es))
+    where
+      wflags' = NE.filter (\wflag -> diag_wopt wflag opts) wflags
+      wflagsE = filter (\wflag -> diag_fatal_wopt wflag opts) wflags'
+
   WarningWithCategory wcat
-    | not (diag_wopt_custom wcat opts) -> SevIgnore
-    | diag_fatal_wopt_custom wcat opts -> SevError
-    | otherwise                        -> SevWarning
+    | not (diag_wopt_custom wcat opts) -> (SevIgnore, reason)
+    | diag_fatal_wopt_custom wcat opts -> (SevError, reason)
+    | otherwise                        -> (SevWarning, reason)
   WarningWithoutFlag
-    | diag_warn_is_error opts -> SevError
-    | otherwise             -> SevWarning
+    | diag_warn_is_error opts -> (SevError, reason)
+    | otherwise             -> (SevWarning, reason)
   ErrorWithoutFlag
-    -> SevError
-
+    -> (SevError, reason)
 
 -- | Make a 'MessageClass' for a given 'DiagnosticReason', consulting the
--- 'DiagOpts.
+-- 'DiagOpts'.
 mkMCDiagnostic :: DiagOpts -> DiagnosticReason -> Maybe DiagnosticCode -> MessageClass
-mkMCDiagnostic opts reason code = MCDiagnostic (diagReasonSeverity opts reason) reason code
+mkMCDiagnostic opts reason code = MCDiagnostic sev reason' code
+  where
+    (sev, reason') = diag_reason_severity opts reason
 
 -- | Varation of 'mkMCDiagnostic' which can be used when we are /sure/ the
 -- input 'DiagnosticReason' /is/ 'ErrorWithoutFlag' and there is no diagnostic code.
 errorDiagnostic :: MessageClass
-errorDiagnostic = MCDiagnostic SevError ErrorWithoutFlag Nothing
+errorDiagnostic = MCDiagnostic SevError (ResolvedDiagnosticReason ErrorWithoutFlag) Nothing
 
 --
 -- Creating MsgEnvelope(s)
@@ -168,13 +187,15 @@ mk_msg_envelope
   => Severity
   -> SrcSpan
   -> NamePprCtx
+  -> ResolvedDiagnosticReason
   -> e
   -> MsgEnvelope e
-mk_msg_envelope severity locn name_ppr_ctx err
+mk_msg_envelope severity locn name_ppr_ctx reason err
  = MsgEnvelope { errMsgSpan = locn
                , errMsgContext = name_ppr_ctx
                , errMsgDiagnostic = err
                , errMsgSeverity = severity
+               , errMsgReason = reason
                }
 
 -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location.
@@ -188,7 +209,9 @@ mkMsgEnvelope
   -> e
   -> MsgEnvelope e
 mkMsgEnvelope opts locn name_ppr_ctx err
- = mk_msg_envelope (diagReasonSeverity opts (diagnosticReason err)) locn name_ppr_ctx err
+ = mk_msg_envelope sev locn name_ppr_ctx reason err
+  where
+    (sev, reason) = diag_reason_severity opts (diagnosticReason err)
 
 -- | Wrap a 'Diagnostic' in a 'MsgEnvelope', recording its location.
 -- Precondition: the diagnostic is, in fact, an error. That is,
@@ -199,7 +222,7 @@ mkErrorMsgEnvelope :: Diagnostic e
                    -> e
                    -> MsgEnvelope e
 mkErrorMsgEnvelope locn name_ppr_ctx msg =
- assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn name_ppr_ctx msg
+ assert (diagnosticReason msg == ErrorWithoutFlag) $ mk_msg_envelope SevError locn name_ppr_ctx (ResolvedDiagnosticReason ErrorWithoutFlag) msg
 
 -- | Variant that doesn't care about qualified/unqualified names.
 mkPlainMsgEnvelope :: Diagnostic e
@@ -217,7 +240,7 @@ mkPlainErrorMsgEnvelope :: Diagnostic e
                         -> e
                         -> MsgEnvelope e
 mkPlainErrorMsgEnvelope locn msg =
-  mk_msg_envelope SevError locn alwaysQualify msg
+  mk_msg_envelope SevError locn alwaysQualify (ResolvedDiagnosticReason ErrorWithoutFlag) msg
 
 -------------------------
 data Validity' a
@@ -273,10 +296,11 @@ pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc
 pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan      = s
                                , errMsgDiagnostic = e
                                , errMsgSeverity  = sev
-                               , errMsgContext   = name_ppr_ctx })
+                               , errMsgContext   = name_ppr_ctx
+                               , errMsgReason    = reason })
   = withErrStyle name_ppr_ctx $
       mkLocMessage
-        (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e))
+        (MCDiagnostic sev reason (diagnosticCode e))
         s
         (formatBulleted $ diagnosticMessage opts e)
 


=====================================
testsuite/tests/plugins/T20803-plugin/AddErrorPlugin.hs
=====================================
@@ -7,6 +7,7 @@ module AddErrorPlugin where
 
 import GHC.Plugins
 import GHC.Types.Error
+import GHC.Utils.Error
 import GHC.Hs
 import GHC.Data.Bag
 import GHC.Parser.Errors.Types
@@ -25,9 +26,7 @@ parsedAction _ _ (ParsedResult pm msgs) = do
   liftIO $ hFlush stdout
   pure (ParsedResult pm msgs{psErrors = mkMessages $ unitBag err})
   where
-    err = MsgEnvelope
-      { errMsgSpan = UnhelpfulSpan UnhelpfulNoLocationInfo
-      , errMsgContext = alwaysQualify
-      , errMsgDiagnostic = PsErrEmptyLambda
-      , errMsgSeverity = SevError
-      }
+    err = mkErrorMsgEnvelope
+      (UnhelpfulSpan UnhelpfulNoLocationInfo)
+      alwaysQualify
+      PsErrEmptyLambda



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1f350e24733e28465c53ed3f5c2b5481b97dc69

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a1f350e24733e28465c53ed3f5c2b5481b97dc69
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230613/fe1421d5/attachment-0001.html>


More information about the ghc-commits mailing list