[Git][ghc/ghc][wip/structured-ghci-errors] Make UnknownDiagnostic parametric over the hint

Jade (@Jade) gitlab at gitlab.haskell.org
Thu Aug 1 19:53:45 UTC 2024



Jade pushed to branch wip/structured-ghci-errors at Glasgow Haskell Compiler / GHC


Commits:
eef86d2e by Jade at 2024-08-01T21:53:20+02:00
Make UnknownDiagnostic parametric over the hint

- - - - -


8 changed files:

- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/Parser/Errors/Types.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Types/Error.hs
- ghc/GHCi/UI/Exception.hs
- ghc/GHCi/UI/Info.hs


Changes:

=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -94,7 +94,7 @@ data GhcMessage where
   -- 'Diagnostic' constraint ensures that worst case scenario we can still
   -- render this into something which can be eventually converted into a
   -- 'DecoratedSDoc'.
-  GhcUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts GhcMessage) GhcHint) -> GhcMessage
+  GhcUnknownMessage :: (UnknownDiagnosticFor GhcMessage) -> GhcMessage
 
   deriving Generic
 
@@ -111,7 +111,7 @@ data GhcMessageOpts = GhcMessageOpts { psMessageOpts :: DiagnosticOpts PsMessage
 -- conversion can happen gradually. This function should not be needed within
 -- GHC, as it would typically be used by plugin or library authors (see
 -- comment for the 'GhcUnknownMessage' type constructor)
-ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ GhcHint, Diagnostic a, Typeable a) => a -> GhcMessage
+ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ DiagnosticHint GhcMessage, Diagnostic a, Typeable a) => a -> GhcMessage
 ghcUnknownMessage = GhcUnknownMessage . mkSimpleUnknownDiagnostic
 
 -- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on
@@ -130,7 +130,7 @@ type DriverMessages = Messages DriverMessage
 -- | A message from the driver.
 data DriverMessage where
   -- | Simply wraps a generic 'Diagnostic' message @a at .
-  DriverUnknownMessage :: UnknownDiagnostic (DiagnosticOpts DriverMessage) GhcHint -> DriverMessage
+  DriverUnknownMessage :: UnknownDiagnosticFor DriverMessage -> DriverMessage
 
   -- | A parse error in parsing a Haskell file header during dependency
   -- analysis


=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -484,7 +484,7 @@ mkBatchMsg hsc_env =
     then batchMultiMsg
     else batchMsg
 
-type AnyGhcDiagnostic = UnknownDiagnostic (DiagnosticOpts GhcMessage) GhcHint
+type AnyGhcDiagnostic = UnknownDiagnosticFor GhcMessage
 
 loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how to cache interfaces as we create them.
                             -> (GhcMessage -> AnyGhcDiagnostic) -- ^ How to wrap error messages before they are displayed to a user.


=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -31,7 +31,7 @@ type MaxPmCheckModels = Int
 -- | Diagnostics messages emitted during desugaring.
 data DsMessage
   -- | Simply wraps a generic 'Diagnostic' message.
-  = DsUnknownMessage (UnknownDiagnostic (DiagnosticOpts DsMessage) GhcHint)
+  = DsUnknownMessage (UnknownDiagnosticFor DsMessage)
 
     {-| DsEmptyEnumeration is a warning (controlled by the -Wempty-enumerations flag) that is
         emitted if an enumeration is empty.


=====================================
compiler/GHC/Parser/Errors/Types.hs
=====================================
@@ -68,7 +68,7 @@ data PsMessage
         arbitrary messages to be embedded. The typical use case would be GHC plugins
         willing to emit custom diagnostics.
     -}
-    PsUnknownMessage (UnknownDiagnostic (DiagnosticOpts PsMessage) GhcHint)
+    PsUnknownMessage (UnknownDiagnosticFor PsMessage)
 
     {-| A group of parser messages emitted in 'GHC.Parser.Header'.
         See Note [Messages from GHC.Parser.Header].


=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -285,7 +285,7 @@ data TcRnMessageDetailed
                         !TcRnMessage
   deriving Generic
 
-mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ GhcHint)
+mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ DiagnosticHint TcRnMessage)
                      => a -> TcRnMessage
 mkTcRnUnknownMessage diag = TcRnUnknownMessage (mkSimpleUnknownDiagnostic diag)
   -- Please don't use this function inside the GHC codebase;
@@ -299,7 +299,7 @@ data TcRnMessage where
   {-| Simply wraps an unknown 'Diagnostic' message @a at . It can be used by plugins
       to provide custom diagnostic messages originated during typechecking/renaming.
   -}
-  TcRnUnknownMessage :: (UnknownDiagnostic (DiagnosticOpts TcRnMessage) GhcHint) -> TcRnMessage
+  TcRnUnknownMessage :: UnknownDiagnosticFor TcRnMessage -> TcRnMessage
 
   {-| Wrap an 'IfaceMessage' to a 'TcRnMessage' for when we attempt to load interface
       files during typechecking but encounter an error. -}


=====================================
compiler/GHC/Types/Error.hs
=====================================
@@ -31,6 +31,7 @@ module GHC.Types.Error
    , Severity (..)
    , Diagnostic (..)
    , UnknownDiagnostic (..)
+   , UnknownDiagnosticFor
    , mkSimpleUnknownDiagnostic
    , mkUnknownDiagnostic
    , embedUnknownDiagnostic
@@ -291,6 +292,8 @@ data UnknownDiagnostic opts hint where
                     -> a
                     -> UnknownDiagnostic opts hint
 
+type UnknownDiagnosticFor a = UnknownDiagnostic (DiagnosticOpts a) (DiagnosticHint a)
+
 instance (HasDefaultDiagnosticOpts opts, Outputable hint) => Diagnostic (UnknownDiagnostic opts hint) where
   type DiagnosticOpts (UnknownDiagnostic opts _) = opts
   type DiagnosticHint (UnknownDiagnostic _ hint) = hint
@@ -306,17 +309,17 @@ instance HasDefaultDiagnosticOpts NoDiagnosticOpts where
   defaultOpts = NoDiagnosticOpts
 
 -- | Make a "simple" unknown diagnostic which doesn't have any configuration options.
-mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts, DiagnosticHint a ~ GhcHint) =>
-  a -> UnknownDiagnostic b GhcHint
+mkSimpleUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
+  a -> UnknownDiagnostic b (DiagnosticHint a)
 mkSimpleUnknownDiagnostic = UnknownDiagnostic (const NoDiagnosticOpts) id
 
 -- | Make an unknown diagnostic which uses the same options as the context it will be embedded into.
-mkUnknownDiagnostic :: (Typeable a, Diagnostic a, DiagnosticHint a ~ GhcHint) =>
-  a -> UnknownDiagnostic (DiagnosticOpts a) GhcHint
+mkUnknownDiagnostic :: (Typeable a, Diagnostic a) =>
+  a -> UnknownDiagnosticFor a
 mkUnknownDiagnostic = UnknownDiagnostic id id
 
 -- | Embed a more complicated diagnostic which requires a potentially different options type.
-embedUnknownDiagnostic :: (Diagnostic a, Typeable a, DiagnosticHint a ~ GhcHint) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts GhcHint
+embedUnknownDiagnostic :: (Diagnostic a, Typeable a) => (opts -> DiagnosticOpts a) -> a -> UnknownDiagnostic opts (DiagnosticHint a)
 embedUnknownDiagnostic f = UnknownDiagnostic f id
 
 --------------------------------------------------------------------------------


=====================================
ghc/GHCi/UI/Exception.hs
=====================================
@@ -41,8 +41,9 @@ data GhciMessageOpts = GhciMessageOpts
   }
 
 data GhciMessage where
-  GhciCommandMessage :: GhciCommandMessage -> GhciMessage
-  GhciGhcMessage     :: GhcMessage         -> GhciMessage
+  GhciCommandMessage :: GhciCommandMessage               -> GhciMessage
+  GhciGhcMessage     :: GhcMessage                       -> GhciMessage
+  GhciUnknownMessage :: UnknownDiagnosticFor GhciMessage -> GhciMessage
 
 data GhciHint where
   GhciCommandHint :: GhciCommandHint -> GhciHint
@@ -65,18 +66,23 @@ instance Diagnostic GhciMessage where
   diagnosticMessage opts = \case
     GhciGhcMessage     m -> ghciDiagnosticMessage (ghcMessageOpts opts) m
     GhciCommandMessage m -> diagnosticMessage (ghciCommandMessageOpts opts) m
+    GhciUnknownMessage (UnknownDiagnostic f _ m)
+      -> diagnosticMessage (f opts) m
 
   diagnosticReason = \case
     GhciGhcMessage     m -> diagnosticReason m
     GhciCommandMessage m -> diagnosticReason m
+    GhciUnknownMessage m -> diagnosticReason m
 
   diagnosticHints = \case
     GhciGhcMessage     m -> map GhciGhcHint     (ghciDiagnosticHints m)
     GhciCommandMessage m -> map GhciCommandHint (diagnosticHints m)
+    GhciUnknownMessage m -> diagnosticHints m
 
   diagnosticCode = \case
     GhciGhcMessage     m -> diagnosticCode m
     GhciCommandMessage m -> diagnosticCode m
+    GhciUnknownMessage m -> diagnosticCode m
 
 
 -- | Modifications to hint messages which we want to display in GHCi.


=====================================
ghc/GHCi/UI/Info.hs
=====================================
@@ -194,9 +194,7 @@ resolveNameFromModule infos name = do
              nameModule_maybe name
 
      -- JADE_TODO
-     -- info <- maybe (throwE () return $
-     --        M.lookup (moduleName modL) infos
-     info <- maybe (throwE Foo) return $
+     info <- maybe (throwE $ Foo modL) return $
             M.lookup (moduleName modL) infos
 
      let all_names = modInfo_rdrs info



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/eef86d2eba0ae4c3072b2c87b5cb74eeeb37c135
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/20240801/be6da0fd/attachment-0001.html>


More information about the ghc-commits mailing list