From c26a6ec936c0b8b0f051e26fd1d212f6ee6357b9 Mon Sep 17 00:00:00 2001
From: Sean D Gillespie <sean@mistersg.net>
Date: Wed, 11 Jun 2025 14:19:20 -0400
Subject: [PATCH 1/4] Migrate change-type-signature-plugin to use structured
diagnostics
---
haskell-language-server.cabal | 3 +
.../src/Ide/Plugin/ChangeTypeSignature.hs | 213 +++++++++++++-----
.../test/Main.hs | 60 ++---
.../test/testdata/TExpectedActual.txt | 8 +
.../test/testdata/TLocalBinding.txt | 8 +
.../test/testdata/TLocalBindingShadow1.txt | 4 +
.../test/testdata/TLocalBindingShadow2.txt | 9 +
.../test/testdata/TRigidType.txt | 5 +
.../test/testdata/TRigidType2.txt | 6 +
.../test/testdata/error1.txt | 6 -
.../test/testdata/error2.txt | 6 -
.../test/testdata/error3.txt | 10 -
.../test/testdata/error4.txt | 19 --
.../test/testdata/error5.txt | 15 --
src/HlsPlugins.hs | 2 +-
15 files changed, 223 insertions(+), 151 deletions(-)
create mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt
create mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt
create mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt
create mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt
create mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt
create mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt
delete mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/error1.txt
delete mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/error2.txt
delete mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/error3.txt
delete mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/error4.txt
delete mode 100644 plugins/hls-change-type-signature-plugin/test/testdata/error5.txt
diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal
index 42e8d11b60..ec397952cb 100644
--- a/haskell-language-server.cabal
+++ b/haskell-language-server.cabal
@@ -1173,12 +1173,14 @@ library hls-change-type-signature-plugin
build-depends:
, ghcide == 2.11.0.0
, hls-plugin-api == 2.11.0.0
+ , lens
, lsp-types
, regex-tdfa
, syb
, text
, transformers
, containers
+ , ghc
default-extensions:
DataKinds
ExplicitNamespaces
@@ -1196,6 +1198,7 @@ test-suite hls-change-type-signature-plugin-tests
build-depends:
, filepath
, haskell-language-server:hls-change-type-signature-plugin
+ , hls-plugin-api
, hls-test-utils == 2.11.0.0
, regex-tdfa
, text
diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
index df776e6d15..41129ea9ae 100644
--- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
+++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
@@ -1,47 +1,91 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
-- | An HLS plugin to provide code actions to change type signatures
module Ide.Plugin.ChangeTypeSignature (descriptor
-- * For Unit Tests
+ , Log(..)
, errorMessageRegexes
) where
-import Control.Monad (guard)
-import Control.Monad.IO.Class (MonadIO)
-import Control.Monad.Trans.Except (ExceptT)
-import Data.Foldable (asum)
-import qualified Data.Map as Map
-import Data.Maybe (mapMaybe)
-import Data.Text (Text)
-import qualified Data.Text as T
-import Development.IDE (realSrcSpanToRange)
+import Control.Lens
+import Control.Monad (guard)
+import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Trans.Class (MonadTrans (lift))
+import Control.Monad.Trans.Except (ExceptT (..))
+import Control.Monad.Trans.Maybe (MaybeT (..), hoistMaybe)
+import Data.Foldable (asum)
+import qualified Data.Map as Map
+import Data.Maybe (catMaybes)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Development.IDE (FileDiagnostic,
+ IdeState (..), Pretty (..),
+ Priority (..), Recorder,
+ WithPriority,
+ fdLspDiagnosticL,
+ fdStructuredMessageL,
+ logWith, realSrcSpanToRange)
import Development.IDE.Core.PluginUtils
-import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule))
-import Development.IDE.Core.Service (IdeState)
-import Development.IDE.GHC.Compat
-import Development.IDE.GHC.Util (printOutputable)
-import Generics.SYB (extQ, something)
-import Ide.Plugin.Error (PluginError,
- getNormalizedFilePathE)
-import Ide.Types (PluginDescriptor (..),
- PluginId (PluginId),
- PluginMethodHandler,
- defaultPluginDescriptor,
- mkPluginHandler)
+import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule))
+import Development.IDE.GHC.Compat hiding (vcat)
+import Development.IDE.GHC.Compat.Error (_TcRnMessage,
+ msgEnvelopeErrorL)
+import Development.IDE.GHC.Util (printOutputable)
+import Development.IDE.Types.Diagnostics (_SomeStructuredMessage)
+import Generics.SYB (extQ, something)
+import GHC.Tc.Errors.Types (ErrInfo (..),
+ MismatchMsg (..),
+ SolverReportWithCtxt (..),
+ TcRnMessage (..),
+ TcRnMessageDetailed (..),
+ TcSolverReportMsg (..))
+import qualified Ide.Logger as Logger
+import Ide.Plugin.Error (PluginError,
+ getNormalizedFilePathE)
+import Ide.Types (Config, HandlerM,
+ PluginDescriptor (..),
+ PluginId (PluginId),
+ PluginMethodHandler,
+ defaultPluginDescriptor,
+ mkPluginHandler)
import Language.LSP.Protocol.Message
import Language.LSP.Protocol.Types
-import Text.Regex.TDFA ((=~))
+import Text.Regex.TDFA ((=~))
-descriptor :: PluginId -> PluginDescriptor IdeState
-descriptor plId = (defaultPluginDescriptor plId "Provides a code action to change the type signature of a binding if it is wrong")
- { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeActionHandler plId) }
+data Log
+ = LogErrInfoCtxt ErrInfo
+ | LogFindSigLocFailure DeclName
-codeActionHandler :: PluginId -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
-codeActionHandler plId ideState _ CodeActionParams {_textDocument = TextDocumentIdentifier uri, _context = CodeActionContext diags _ _} = do
- nfp <- getNormalizedFilePathE uri
- decls <- getDecls plId ideState nfp
- let actions = mapMaybe (generateAction plId uri decls) diags
- pure $ InL actions
+instance Pretty Log where
+ pretty = \case
+ LogErrInfoCtxt (ErrInfo ctxt suppl) ->
+ Logger.vcat [fromSDoc ctxt, fromSDoc suppl]
+ LogFindSigLocFailure name ->
+ pretty ("Lookup signature location failure: " <> name)
+ where
+ fromSDoc = pretty . printOutputable
+
+descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
+descriptor recorder plId =
+ (defaultPluginDescriptor plId "Provides a code action to change the type signature of a binding if it is wrong")
+ { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction (codeActionHandler recorder plId)
+ }
+
+codeActionHandler
+ :: Recorder (WithPriority Log)
+ -> PluginId
+ -> PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
+codeActionHandler recorder plId ideState _ CodeActionParams{_textDocument, _range} = do
+ let TextDocumentIdentifier uri = _textDocument
+ nfp <- getNormalizedFilePathE uri
+ decls <- getDecls plId ideState nfp
+
+ activeDiagnosticsInRange (shakeExtras ideState) nfp _range >>= \case
+ Nothing -> pure (InL [])
+ Just fileDiags -> do
+ actions <- lift $ mapM (generateAction recorder plId uri decls) fileDiags
+ pure (InL (catMaybes actions))
getDecls :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT PluginError m [LHsDecl GhcPs]
getDecls (PluginId changeTypeSignatureId) state =
@@ -67,39 +111,104 @@ data ChangeSignature = ChangeSignature {
-- | the location of the declaration signature
, declSrcSpan :: RealSrcSpan
-- | the diagnostic to solve
- , diagnostic :: Diagnostic
+ , diagnostic :: FileDiagnostic
}
-- | Create a CodeAction from a Diagnostic
-generateAction :: PluginId -> Uri -> [LHsDecl GhcPs] -> Diagnostic -> Maybe (Command |? CodeAction)
-generateAction plId uri decls diag = changeSigToCodeAction plId uri <$> diagnosticToChangeSig decls diag
+generateAction
+ :: Recorder (WithPriority Log)
+ -> PluginId
+ -> Uri
+ -> [LHsDecl GhcPs]
+ -> FileDiagnostic
+ -> HandlerM Config (Maybe (Command |? CodeAction))
+generateAction recorder plId uri decls fileDiag = do
+ changeSig <- diagnosticToChangeSig recorder decls fileDiag
+ pure $
+ changeSigToCodeAction plId uri <$> changeSig
-- | Convert a diagnostic into a ChangeSignature and add the proper SrcSpan
-diagnosticToChangeSig :: [LHsDecl GhcPs] -> Diagnostic -> Maybe ChangeSignature
-diagnosticToChangeSig decls diagnostic = do
- -- regex match on the GHC Error Message
- (expectedType, actualType, declName) <- matchingDiagnostic diagnostic
- -- Find the definition and it's location
- declSrcSpan <- findSigLocOfStringDecl decls expectedType (T.unpack declName)
- pure $ ChangeSignature{..}
+diagnosticToChangeSig
+ :: Recorder (WithPriority Log)
+ -> [LHsDecl GhcPs]
+ -> FileDiagnostic
+ -> HandlerM Config (Maybe ChangeSignature)
+diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do
+ -- Extract expected, actual, and extra error info
+ (expectedType, actualType, errInfo) <- hoistMaybe $ do
+ msg <- diagnostic ^. fdStructuredMessageL ^? _SomeStructuredMessage
+ tcRnMsg <- msg ^. msgEnvelopeErrorL ^? _TcRnMessage
+ (solverReport, errInfo) <- findSolverReport tcRnMsg
+ mismatch <- findMismatchMessage solverReport
+ (expectedType', actualType') <- findTypeEqMismatch mismatch
+ errInfo' <- errInfo
+
+ pure (showType expectedType', showType actualType', errInfo')
+
+ logWith recorder Debug (LogErrInfoCtxt errInfo)
+
+ -- Extract the declName from the extra error text
+ declName <- hoistMaybe (matchingDiagnostic errInfo)
+ -- Look up location of declName. If it fails, log it
+ declSrcSpan <-
+ case findSigLocOfStringDecl decls expectedType (T.unpack declName) of
+ Just x -> pure x
+ Nothing -> do
+ logWith recorder Debug (LogFindSigLocFailure declName)
+ hoistMaybe Nothing
+
+ pure ChangeSignature{..}
+ where
+ showType :: Type -> Text
+ showType = T.pack . showSDocUnsafe . pprTidiedType
+
+-- TODO: Make this a prism?
+findSolverReport :: TcRnMessage -> Maybe (TcSolverReportMsg, Maybe ErrInfo)
+findSolverReport (TcRnMessageWithInfo _ (TcRnMessageDetailed errInfo msg)) =
+ case findSolverReport msg of
+ Just (mismatch, _) -> Just (mismatch, Just errInfo)
+ _ -> Nothing
+#if MIN_VERSION_ghc(9,10,0)
+findSolverReport (TcRnSolverReport (SolverReportWithCtxt _ mismatch) _) =
+ Just (mismatch, Nothing)
+#else
+findSolverReport (TcRnSolverReport (SolverReportWithCtxt _ mismatch) _ _) =
+ Just (mismatch, Nothing)
+#endif
+findSolverReport _ = Nothing
+
+-- TODO: Make this a prism?
+findMismatchMessage :: TcSolverReportMsg -> Maybe MismatchMsg
+findMismatchMessage (Mismatch m _ _ _) = Just m
+findMismatchMessage (CannotUnifyVariable m _) = Just m
+findMismatchMessage _ = Nothing
+
+-- TODO: Make this a prism?
+findTypeEqMismatch :: MismatchMsg -> Maybe (Type, Type)
+#if MIN_VERSION_ghc(9,12,0)
+findTypeEqMismatch (TypeEqMismatch _ _ _ expected actual _ _) = Just (expected, actual)
+#else
+findTypeEqMismatch (TypeEqMismatch _ _ _ _ expected actual _ _) = Just (expected, actual)
+#endif
+findTypeEqMismatch _ = Nothing
-- | If a diagnostic has the proper message create a ChangeSignature from it
-matchingDiagnostic :: Diagnostic -> Maybe (ExpectedSig, ActualSig, DeclName)
-matchingDiagnostic Diagnostic{_message} = asum $ map (unwrapMatch . (=~) _message) errorMessageRegexes
+matchingDiagnostic :: ErrInfo -> Maybe DeclName
+matchingDiagnostic ErrInfo{errInfoContext} =
+ asum $ map (unwrapMatch . (=~) errInfoTxt) errorMessageRegexes
where
- unwrapMatch :: (Text, Text, Text, [Text]) -> Maybe (ExpectedSig, ActualSig, DeclName)
- -- due to using (.|\n) in regex we have to drop the erroneous, but necessary ("." doesn't match newlines), match
- unwrapMatch (_, _, _, [expect, actual, _, name]) = Just (expect, actual, name)
- unwrapMatch _ = Nothing
+ unwrapMatch :: (Text, Text, Text, [Text]) -> Maybe DeclName
+ unwrapMatch (_, _, _, [name]) = Just name
+ unwrapMatch _ = Nothing
+
+ errInfoTxt = printOutputable errInfoContext
-- | List of regexes that match various Error Messages
errorMessageRegexes :: [Text]
errorMessageRegexes = [ -- be sure to add new Error Messages Regexes at the bottom to not fail any existing tests
- "Expected type: (.+)\n +Actual type: (.+)\n(.|\n)+In an equation for ‘(.+)’"
- , "Couldn't match expected type ‘(.+)’ with actual type ‘(.+)’\n(.|\n)+In an equation for ‘(.+)’"
- -- GHC >9.2 version of the first error regex
- , "Expected: (.+)\n +Actual: (.+)\n(.|\n)+In an equation for ‘(.+)’"
+ "In an equation for ‘(.+)’:" -- TODO: Check if this is useful only for tests
+ , "In an equation for `(.+)':"
]
-- | Given a String with the name of a declaration, GHC's "Expected Type", find the declaration that matches
@@ -147,7 +256,7 @@ changeSigToCodeAction :: PluginId -> Uri -> ChangeSignature -> Command |? CodeAc
changeSigToCodeAction (PluginId changeTypeSignatureId) uri ChangeSignature{..} =
InR CodeAction { _title = mkChangeSigTitle declName actualType
, _kind = Just (CodeActionKind_Custom ("quickfix." <> changeTypeSignatureId))
- , _diagnostics = Just [diagnostic]
+ , _diagnostics = Just [diagnostic ^. fdLspDiagnosticL ]
, _isPreferred = Nothing
, _disabled = Nothing
, _edit = Just $ mkChangeSigEdit uri declSrcSpan (mkNewSignature declName actualType)
diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs
index cd1b152c0b..72a2ab780e 100644
--- a/plugins/hls-change-type-signature-plugin/test/Main.hs
+++ b/plugins/hls-change-type-signature-plugin/test/Main.hs
@@ -5,7 +5,7 @@ import Data.Either (rights)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
-import Ide.Plugin.ChangeTypeSignature (errorMessageRegexes)
+import Ide.Plugin.ChangeTypeSignature (Log (..), errorMessageRegexes)
import qualified Ide.Plugin.ChangeTypeSignature as ChangeTypeSignature
import System.FilePath ((<.>), (</>))
import Test.Hls (CodeAction (..), Command,
@@ -21,8 +21,7 @@ import Test.Hls (CodeAction (..), Command,
getCodeActions,
goldenWithHaskellDoc,
knownBrokenForGhcVersions,
- liftIO,
- mkPluginTestDescriptor',
+ liftIO, mkPluginTestDescriptor,
openDoc, runSessionWithServer,
testCase, testGroup, toEither,
type (|?), waitForBuildQueue,
@@ -32,16 +31,19 @@ import Text.Regex.TDFA ((=~))
main :: IO ()
main = defaultTestRunner test
-changeTypeSignaturePlugin :: PluginTestDescriptor ()
-changeTypeSignaturePlugin = mkPluginTestDescriptor' ChangeTypeSignature.descriptor "changeTypeSignature"
+changeTypeSignaturePlugin :: PluginTestDescriptor Log
+changeTypeSignaturePlugin =
+ mkPluginTestDescriptor
+ ChangeTypeSignature.descriptor
+ "changeTypeSignature"
test :: TestTree
test = testGroup "changeTypeSignature" [
testRegexes
, codeActionTest "TExpectedActual" 4 11
- , knownBrokenForGhcVersions [GHC96 .. GHC912] "Error Message in 9.2+ does not provide enough info" $
+ , knownBrokenForGhcVersions [GHC96 .. GHC912] "Error Message in 9.6+ does not provide enough info" $
codeActionTest "TRigidType" 4 14
- , codeActionTest "TRigidType2" 4 6
+ , codeActionTest "TRigidType2" 4 8
, codeActionTest "TLocalBinding" 7 22
, codeActionTest "TLocalBindingShadow1" 11 8
, codeActionTest "TLocalBindingShadow2" 7 22
@@ -50,43 +52,17 @@ test = testGroup "changeTypeSignature" [
testRegexes :: TestTree
testRegexes = testGroup "Regex Testing" [
- testRegexOne
- , testRegexTwo
- , testRegex921One
- ]
-
-testRegexOne :: TestTree
-testRegexOne = testGroup "Regex One" [
- regexTest "error1.txt" regex True
- , regexTest "error2.txt" regex True
- , regexTest "error3.txt" regex False
- , regexTest "error4.txt" regex True
- , regexTest "error5.txt" regex True
+ regexTest "TExpectedActual.txt" regex True
+ , regexTest "TLocalBinding.txt" regex True
+ , regexTest "TLocalBindingShadow1.txt" regex True
+ , regexTest "TLocalBindingShadow2.txt" regex True
+ -- Error message from GHC currently does not not provide enough info
+ , regexTest "TRigidType.txt" regex False
+ , regexTest "TRigidType2.txt" regex True
]
where
regex = errorMessageRegexes !! 0
-testRegexTwo :: TestTree
-testRegexTwo = testGroup "Regex Two" [
- regexTest "error1.txt" regex False
- , regexTest "error2.txt" regex False
- , regexTest "error3.txt" regex True
- , regexTest "error4.txt" regex False
- , regexTest "error5.txt" regex False
- ]
- where
- regex = errorMessageRegexes !! 1
-
--- test ghc-9.2 error message regex
-testRegex921One :: TestTree
-testRegex921One = testGroup "Regex One" [
- regexTest "ghc921-error1.txt" regex True
- , regexTest "ghc921-error2.txt" regex True
- , regexTest "ghc921-error3.txt" regex True
- ]
- where
- regex = errorMessageRegexes !! 2
-
testDataDir :: FilePath
testDataDir = "plugins" </> "hls-change-type-signature-plugin" </> "test" </> "testdata"
@@ -123,8 +99,8 @@ regexTest :: FilePath -> Text -> Bool -> TestTree
regexTest fp regex shouldPass = testCase fp $ do
msg <- TIO.readFile (testDataDir </> fp)
case (msg =~ regex :: (Text, Text, Text, [Text]), shouldPass) of
- ((_, _, _, [_, _, _, _]), True) -> pure ()
- ((_, _, _, [_, _, _, _]), False) -> assertFailure $ "Unexpected match: " <> fp <> " with " <> T.unpack regex
+ ((_, _, _, [_]), True) -> pure ()
+ ((_, _, _, [_]), False) -> assertFailure $ "Unexpected match: " <> fp <> " with " <> T.unpack regex
(_, True) -> assertFailure $ "Failed to match: " <> fp <> " with " <> T.unpack regex
(_, False) -> pure ()
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt
new file mode 100644
index 0000000000..6a8246a921
--- /dev/null
+++ b/plugins/hls-change-type-signature-plugin/test/testdata/TExpectedActual.txt
@@ -0,0 +1,8 @@
+In the expression: go
+In an equation for ‘fullSig’:
+fullSig
+ = go
+ where
+ go = head . reverse
+
+
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt
new file mode 100644
index 0000000000..3f31dc48b9
--- /dev/null
+++ b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBinding.txt
@@ -0,0 +1,8 @@
+Probable cause: ‘forM’ is applied to too few arguments
+In the expression: forM
+In an equation for ‘test’: test = forM
+In the expression:
+ let
+ test :: Int -> Int
+ test = forM
+ in x + 1
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt
new file mode 100644
index 0000000000..ef782e8aec
--- /dev/null
+++ b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow1.txt
@@ -0,0 +1,4 @@
+Probable cause: ‘forM’ is applied to too few arguments
+In the expression: forM
+In an equation for ‘test’: test = forM
+
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt
new file mode 100644
index 0000000000..bea2526eb9
--- /dev/null
+++ b/plugins/hls-change-type-signature-plugin/test/testdata/TLocalBindingShadow2.txt
@@ -0,0 +1,9 @@
+Probable cause: ‘forM’ is applied to too few arguments
+In the expression: forM
+In an equation for ‘test’: test = forM
+In the expression:
+ let
+ test :: Int -> Int
+ test = forM
+ in test x [GHC-83865]
+
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt
new file mode 100644
index 0000000000..f9e78c97ae
--- /dev/null
+++ b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.txt
@@ -0,0 +1,5 @@
+In the expression: go . head . reverse
+Relevant bindings include
+ test :: a -> Int
+ (bound at /home/sgillespie/dev/haskell/haskell-language-server/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType.hs:4:1) [GHC-25897]
+
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt
new file mode 100644
index 0000000000..343129a942
--- /dev/null
+++ b/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.txt
@@ -0,0 +1,6 @@
+In the expression: head
+In an equation for ‘test’: test = head
+Relevant bindings include
+ test :: a -> Int
+ (bound at /home/sgillespie/dev/haskell/haskell-language-server/plugins/hls-change-type-signature-plugin/test/testdata/TRigidType2.hs:4:1) [GHC-25897]
+
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error1.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error1.txt
deleted file mode 100644
index 37f0aa4a81..0000000000
--- a/plugins/hls-change-type-signature-plugin/test/testdata/error1.txt
+++ /dev/null
@@ -1,6 +0,0 @@
- • Couldn't match type ‘Int’
- with ‘Data.HashSet.Internal.HashSet Int’
- Expected type: Int -> Int
- Actual type: Data.HashSet.Internal.HashSet Int -> Int
- • In the expression: head . toList
- In an equation for ‘test’: test = head . toList
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error2.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error2.txt
deleted file mode 100644
index 497f8350a5..0000000000
--- a/plugins/hls-change-type-signature-plugin/test/testdata/error2.txt
+++ /dev/null
@@ -1,6 +0,0 @@
- • Couldn't match type ‘b0 -> t0 a0 -> b0’ with ‘Int’
- Expected type: Int -> Int
- Actual type: (b0 -> a0 -> b0) -> b0 -> t0 a0 -> b0
- • Probable cause: ‘foldl’ is applied to too few arguments
- In the expression: foldl
- In an equation for ‘test’: test = foldl
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error3.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error3.txt
deleted file mode 100644
index 0cbddad7c4..0000000000
--- a/plugins/hls-change-type-signature-plugin/test/testdata/error3.txt
+++ /dev/null
@@ -1,10 +0,0 @@
- • Couldn't match expected type ‘Int’ with actual type ‘[Int]’
- • In the expression: map (+ x) [1, 2, 3]
- In an equation for ‘test’:
- test x
- = map (+ x) [1, 2, 3]
- where
- go = head . reverse
- |
-152 | test x = map (+ x) [1,2,3]
- | ^^^^^^^^^^^^^^^^^
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error4.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error4.txt
deleted file mode 100644
index 323cf7d4db..0000000000
--- a/plugins/hls-change-type-signature-plugin/test/testdata/error4.txt
+++ /dev/null
@@ -1,19 +0,0 @@
- • Couldn't match type ‘a’ with ‘[[Int]]’
- ‘a’ is a rigid type variable bound by
- the type signature for:
- test :: forall a. Ord a => a -> Int
- at src/Ide/Plugin/ChangeTypeSignature.hs:154:1-25
- Expected type: a -> Int
- Actual type: [[Int]] -> Int
- • In the expression: go . head . reverse
- In an equation for ‘test’:
- test
- = go . head . reverse
- where
- go = head . reverse
- • Relevant bindings include
- test :: a -> Int
- (bound at src/Ide/Plugin/ChangeTypeSignature.hs:155:1)
- |
-155 | test = go . head . reverse
- | ^^^^^^^^^^^^^^^^^^^
diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/error5.txt b/plugins/hls-change-type-signature-plugin/test/testdata/error5.txt
deleted file mode 100644
index a7a5d9a20b..0000000000
--- a/plugins/hls-change-type-signature-plugin/test/testdata/error5.txt
+++ /dev/null
@@ -1,15 +0,0 @@
- • Couldn't match type ‘(a0 -> m0 b0) -> m0 (t0 b0)’ with ‘Int’
- Expected type: Int -> Int
- Actual type: t0 a0 -> (a0 -> m0 b0) -> m0 (t0 b0)
- • Probable cause: ‘forM’ is applied to too few arguments
- In the expression: forM
- In an equation for ‘test’: test = forM
- In an equation for ‘implicit’:
- implicit
- = return OpTEmpty
- where
- test :: Int -> Int
- test = forM
- |
-82 | test = forM
- | ^^^^
diff --git a/src/HlsPlugins.hs b/src/HlsPlugins.hs
index 87a1af7392..4c135fc48b 100644
--- a/src/HlsPlugins.hs
+++ b/src/HlsPlugins.hs
@@ -224,7 +224,7 @@ idePlugins recorder = pluginDescToIdePlugins allPlugins
let pId = "codeRange" in CodeRange.descriptor (pluginRecorder pId) pId:
#endif
#if hls_changeTypeSignature
- ChangeTypeSignature.descriptor "changeTypeSignature" :
+ let pId = "changeTypeSignature" in ChangeTypeSignature.descriptor (pluginRecorder pId) pId :
#endif
#if hls_gadt
GADT.descriptor "gadt" :
From fc362415743507a78cba48f2b3b560d6d6f5731b Mon Sep 17 00:00:00 2001
From: Sean D Gillespie <sean@mistersg.net>
Date: Tue, 17 Jun 2025 22:30:27 -0400
Subject: [PATCH 2/4] Refactor: Turn some getter functions into
Lenses/Treversals
---
.../src/Ide/Plugin/ChangeTypeSignature.hs | 69 +++++++++++--------
1 file changed, 41 insertions(+), 28 deletions(-)
diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
index 41129ea9ae..30d48067ba 100644
--- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
+++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
@@ -138,12 +138,13 @@ diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do
(expectedType, actualType, errInfo) <- hoistMaybe $ do
msg <- diagnostic ^. fdStructuredMessageL ^? _SomeStructuredMessage
tcRnMsg <- msg ^. msgEnvelopeErrorL ^? _TcRnMessage
- (solverReport, errInfo) <- findSolverReport tcRnMsg
- mismatch <- findMismatchMessage solverReport
- (expectedType', actualType') <- findTypeEqMismatch mismatch
- errInfo' <- errInfo
+ TcRnMessageDetailed errInfo tcRnMsg' <- tcRnMsg ^? _TcRnMessageDetailed
+ solverReport <- tcRnMsg' ^? _TcRnSolverReport . tcSolverReportMsgL
+ mismatch <- solverReport ^? _MismatchMessage
+ expectedType <- mismatch ^? _TypeEqMismatchExpected
+ actualType <- mismatch ^? _TypeEqMismatchActual
- pure (showType expectedType', showType actualType', errInfo')
+ pure (showType expectedType, showType actualType, errInfo)
logWith recorder Debug (LogErrInfoCtxt errInfo)
@@ -163,35 +164,48 @@ diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do
showType :: Type -> Text
showType = T.pack . showSDocUnsafe . pprTidiedType
--- TODO: Make this a prism?
-findSolverReport :: TcRnMessage -> Maybe (TcSolverReportMsg, Maybe ErrInfo)
-findSolverReport (TcRnMessageWithInfo _ (TcRnMessageDetailed errInfo msg)) =
- case findSolverReport msg of
- Just (mismatch, _) -> Just (mismatch, Just errInfo)
- _ -> Nothing
+_TcRnMessageDetailed :: Traversal' TcRnMessage TcRnMessageDetailed
+_TcRnMessageDetailed focus (TcRnMessageWithInfo errInfo detailed) =
+ (\detailed' -> TcRnMessageWithInfo errInfo detailed') <$> focus detailed
+_TcRnMessageDetailed _ msg = pure msg
+
+_TcRnSolverReport :: Traversal' TcRnMessage SolverReportWithCtxt
#if MIN_VERSION_ghc(9,10,0)
-findSolverReport (TcRnSolverReport (SolverReportWithCtxt _ mismatch) _) =
- Just (mismatch, Nothing)
+_TcRnSolverReport focus (TcRnSolverReport report reason) =
+ (\report' -> TcRnSolverReport report' reason) <$> focus report
#else
-findSolverReport (TcRnSolverReport (SolverReportWithCtxt _ mismatch) _ _) =
- Just (mismatch, Nothing)
+_TcRnSolverReport focus (TcRnSolverReport report reason hints) =
+ (\report' -> TcRnSolverReport report' reason hints) <$> focus report
#endif
-findSolverReport _ = Nothing
+_TcRnSolverReport _ msg = pure msg
+
+tcSolverReportMsgL :: Lens' SolverReportWithCtxt TcSolverReportMsg
+tcSolverReportMsgL = lens reportContent (\report content' -> report { reportContent = content' })
+
+_MismatchMessage :: Traversal' TcSolverReportMsg MismatchMsg
+_MismatchMessage focus (Mismatch msg t a c) = (\msg' -> Mismatch msg' t a c) <$> focus msg
+_MismatchMessage focus (CannotUnifyVariable msg a) = flip CannotUnifyVariable a <$> focus msg
+_MismatchMessage _ report = pure report
--- TODO: Make this a prism?
-findMismatchMessage :: TcSolverReportMsg -> Maybe MismatchMsg
-findMismatchMessage (Mismatch m _ _ _) = Just m
-findMismatchMessage (CannotUnifyVariable m _) = Just m
-findMismatchMessage _ = Nothing
+_TypeEqMismatchExpected :: Traversal' MismatchMsg Type
+#if MIN_VERSION_ghc(9,12,0)
+_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ expected _ _ _) =
+ (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected
+#else
+_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ _ expected _ _ _) =
+ (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected
+#endif
+_TypeEqMismatchExpected _ mismatch = pure mismatch
--- TODO: Make this a prism?
-findTypeEqMismatch :: MismatchMsg -> Maybe (Type, Type)
+_TypeEqMismatchActual :: Traversal' MismatchMsg Type
#if MIN_VERSION_ghc(9,12,0)
-findTypeEqMismatch (TypeEqMismatch _ _ _ expected actual _ _) = Just (expected, actual)
+_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ actual _ _) =
+ (\actual' -> mismatch { teq_mismatch_actual = actual' }) <$> focus actual
#else
-findTypeEqMismatch (TypeEqMismatch _ _ _ _ expected actual _ _) = Just (expected, actual)
+_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ _ actual _ _) =
+ (\actual' -> mismatch { teq_mismatch_expected = actual' }) <$> focus actual
#endif
-findTypeEqMismatch _ = Nothing
+_TypeEqMismatchActual _ mismatch = pure mismatch
-- | If a diagnostic has the proper message create a ChangeSignature from it
matchingDiagnostic :: ErrInfo -> Maybe DeclName
@@ -207,8 +221,7 @@ matchingDiagnostic ErrInfo{errInfoContext} =
-- | List of regexes that match various Error Messages
errorMessageRegexes :: [Text]
errorMessageRegexes = [ -- be sure to add new Error Messages Regexes at the bottom to not fail any existing tests
- "In an equation for ‘(.+)’:" -- TODO: Check if this is useful only for tests
- , "In an equation for `(.+)':"
+ "In an equation for ‘(.+)’:"
]
-- | Given a String with the name of a declaration, GHC's "Expected Type", find the declaration that matches
From b87513ea44903e1de7da3b201551126c47abac9e Mon Sep 17 00:00:00 2001
From: Sean D Gillespie <sean@mistersg.net>
Date: Wed, 18 Jun 2025 10:08:47 -0400
Subject: [PATCH 3/4] fix: Use updated traversal for error messages
_TcRnMessage -> _TcRnMessageWithCtx
---
.../src/Ide/Plugin/ChangeTypeSignature.hs | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
index 30d48067ba..2f3a1f21a6 100644
--- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
+++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
@@ -29,7 +29,7 @@ import Development.IDE (FileDiagnostic,
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule))
import Development.IDE.GHC.Compat hiding (vcat)
-import Development.IDE.GHC.Compat.Error (_TcRnMessage,
+import Development.IDE.GHC.Compat.Error (_TcRnMessageWithCtx,
msgEnvelopeErrorL)
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Types.Diagnostics (_SomeStructuredMessage)
@@ -137,7 +137,7 @@ diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do
-- Extract expected, actual, and extra error info
(expectedType, actualType, errInfo) <- hoistMaybe $ do
msg <- diagnostic ^. fdStructuredMessageL ^? _SomeStructuredMessage
- tcRnMsg <- msg ^. msgEnvelopeErrorL ^? _TcRnMessage
+ tcRnMsg <- msg ^. msgEnvelopeErrorL ^? _TcRnMessageWithCtx
TcRnMessageDetailed errInfo tcRnMsg' <- tcRnMsg ^? _TcRnMessageDetailed
solverReport <- tcRnMsg' ^? _TcRnSolverReport . tcSolverReportMsgL
mismatch <- solverReport ^? _MismatchMessage
From 6f1dcc771664082ee9bfbc7210d43d7038d26875 Mon Sep 17 00:00:00 2001
From: Sean D Gillespie <sean@mistersg.net>
Date: Fri, 20 Jun 2025 22:41:58 -0400
Subject: [PATCH 4/4] Refactor: Extract additional Prisms/Lenses into a common
module
---
.../src/Development/IDE/GHC/Compat/Error.hs | 43 ++++++++++++-
.../src/Ide/Plugin/ChangeTypeSignature.hs | 63 ++++---------------
2 files changed, 53 insertions(+), 53 deletions(-)
diff --git a/ghcide/src/Development/IDE/GHC/Compat/Error.hs b/ghcide/src/Development/IDE/GHC/Compat/Error.hs
index 0255886726..01abbf1a66 100644
--- a/ghcide/src/Development/IDE/GHC/Compat/Error.hs
+++ b/ghcide/src/Development/IDE/GHC/Compat/Error.hs
@@ -17,16 +17,24 @@ module Development.IDE.GHC.Compat.Error (
DriverMessage (..),
-- * General Diagnostics
Diagnostic(..),
- -- * Prisms for error selection
+ -- * Prisms and lenses for error selection
_TcRnMessage,
_TcRnMessageWithCtx,
_GhcPsMessage,
_GhcDsMessage,
_GhcDriverMessage,
_TcRnMissingSignature,
+ _TcRnSolverReport,
+ _TcRnMessageWithInfo,
+ reportContextL,
+ reportContentL,
+ _MismatchMessage,
+ _TypeEqMismatchActual,
+ _TypeEqMismatchExpected,
) where
import Control.Lens
+import Development.IDE.GHC.Compat (Type)
import GHC.Driver.Errors.Types
import GHC.HsToCore.Errors.Types
import GHC.Tc.Errors.Types
@@ -82,3 +90,36 @@ msgEnvelopeErrorL :: Lens' (MsgEnvelope e) e
msgEnvelopeErrorL = lens errMsgDiagnostic (\envelope e -> envelope { errMsgDiagnostic = e } )
makePrisms ''TcRnMessage
+
+makeLensesWith
+ (lensRules & lensField .~ mappingNamer (pure . (++ "L")))
+ ''SolverReportWithCtxt
+
+-- | Focus 'MismatchMsg' from 'TcSolverReportMsg'. Currently, 'MismatchMsg' can be
+-- extracted from 'CannotUnifyVariable' and 'Mismatch' constructors.
+_MismatchMessage :: Traversal' TcSolverReportMsg MismatchMsg
+_MismatchMessage focus (Mismatch msg t a c) = (\msg' -> Mismatch msg' t a c) <$> focus msg
+_MismatchMessage focus (CannotUnifyVariable msg a) = flip CannotUnifyVariable a <$> focus msg
+_MismatchMessage _ report = pure report
+
+-- | Focus 'teq_mismatch_expected' from 'TypeEqMismatch'.
+_TypeEqMismatchExpected :: Traversal' MismatchMsg Type
+#if MIN_VERSION_ghc(9,12,0)
+_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ expected _ _ _) =
+ (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected
+#else
+_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ _ expected _ _ _) =
+ (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected
+#endif
+_TypeEqMismatchExpected _ mismatch = pure mismatch
+
+-- | Focus 'teq_mismatch_actual' from 'TypeEqMismatch'.
+_TypeEqMismatchActual :: Traversal' MismatchMsg Type
+#if MIN_VERSION_ghc(9,12,0)
+_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ actual _ _) =
+ (\actual' -> mismatch { teq_mismatch_actual = actual' }) <$> focus actual
+#else
+_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ _ actual _ _) =
+ (\actual' -> mismatch { teq_mismatch_expected = actual' }) <$> focus actual
+#endif
+_TypeEqMismatchActual _ mismatch = pure mismatch
diff --git a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
index 2f3a1f21a6..8b8b7e7d3a 100644
--- a/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
+++ b/plugins/hls-change-type-signature-plugin/src/Ide/Plugin/ChangeTypeSignature.hs
@@ -29,17 +29,19 @@ import Development.IDE (FileDiagnostic,
import Development.IDE.Core.PluginUtils
import Development.IDE.Core.RuleTypes (GetParsedModule (GetParsedModule))
import Development.IDE.GHC.Compat hiding (vcat)
-import Development.IDE.GHC.Compat.Error (_TcRnMessageWithCtx,
- msgEnvelopeErrorL)
+import Development.IDE.GHC.Compat.Error (_MismatchMessage,
+ _TcRnMessageWithCtx,
+ _TcRnMessageWithInfo,
+ _TcRnSolverReport,
+ _TypeEqMismatchActual,
+ _TypeEqMismatchExpected,
+ msgEnvelopeErrorL,
+ reportContentL)
import Development.IDE.GHC.Util (printOutputable)
import Development.IDE.Types.Diagnostics (_SomeStructuredMessage)
import Generics.SYB (extQ, something)
import GHC.Tc.Errors.Types (ErrInfo (..),
- MismatchMsg (..),
- SolverReportWithCtxt (..),
- TcRnMessage (..),
- TcRnMessageDetailed (..),
- TcSolverReportMsg (..))
+ TcRnMessageDetailed (..))
import qualified Ide.Logger as Logger
import Ide.Plugin.Error (PluginError,
getNormalizedFilePathE)
@@ -138,8 +140,8 @@ diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do
(expectedType, actualType, errInfo) <- hoistMaybe $ do
msg <- diagnostic ^. fdStructuredMessageL ^? _SomeStructuredMessage
tcRnMsg <- msg ^. msgEnvelopeErrorL ^? _TcRnMessageWithCtx
- TcRnMessageDetailed errInfo tcRnMsg' <- tcRnMsg ^? _TcRnMessageDetailed
- solverReport <- tcRnMsg' ^? _TcRnSolverReport . tcSolverReportMsgL
+ (_, TcRnMessageDetailed errInfo tcRnMsg') <- tcRnMsg ^? _TcRnMessageWithInfo
+ solverReport <- tcRnMsg' ^? _TcRnSolverReport . _1 . reportContentL
mismatch <- solverReport ^? _MismatchMessage
expectedType <- mismatch ^? _TypeEqMismatchExpected
actualType <- mismatch ^? _TypeEqMismatchActual
@@ -164,49 +166,6 @@ diagnosticToChangeSig recorder decls diagnostic = runMaybeT $ do
showType :: Type -> Text
showType = T.pack . showSDocUnsafe . pprTidiedType
-_TcRnMessageDetailed :: Traversal' TcRnMessage TcRnMessageDetailed
-_TcRnMessageDetailed focus (TcRnMessageWithInfo errInfo detailed) =
- (\detailed' -> TcRnMessageWithInfo errInfo detailed') <$> focus detailed
-_TcRnMessageDetailed _ msg = pure msg
-
-_TcRnSolverReport :: Traversal' TcRnMessage SolverReportWithCtxt
-#if MIN_VERSION_ghc(9,10,0)
-_TcRnSolverReport focus (TcRnSolverReport report reason) =
- (\report' -> TcRnSolverReport report' reason) <$> focus report
-#else
-_TcRnSolverReport focus (TcRnSolverReport report reason hints) =
- (\report' -> TcRnSolverReport report' reason hints) <$> focus report
-#endif
-_TcRnSolverReport _ msg = pure msg
-
-tcSolverReportMsgL :: Lens' SolverReportWithCtxt TcSolverReportMsg
-tcSolverReportMsgL = lens reportContent (\report content' -> report { reportContent = content' })
-
-_MismatchMessage :: Traversal' TcSolverReportMsg MismatchMsg
-_MismatchMessage focus (Mismatch msg t a c) = (\msg' -> Mismatch msg' t a c) <$> focus msg
-_MismatchMessage focus (CannotUnifyVariable msg a) = flip CannotUnifyVariable a <$> focus msg
-_MismatchMessage _ report = pure report
-
-_TypeEqMismatchExpected :: Traversal' MismatchMsg Type
-#if MIN_VERSION_ghc(9,12,0)
-_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ expected _ _ _) =
- (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected
-#else
-_TypeEqMismatchExpected focus mismatch@(TypeEqMismatch _ _ _ _ expected _ _ _) =
- (\expected' -> mismatch { teq_mismatch_expected = expected' }) <$> focus expected
-#endif
-_TypeEqMismatchExpected _ mismatch = pure mismatch
-
-_TypeEqMismatchActual :: Traversal' MismatchMsg Type
-#if MIN_VERSION_ghc(9,12,0)
-_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ actual _ _) =
- (\actual' -> mismatch { teq_mismatch_actual = actual' }) <$> focus actual
-#else
-_TypeEqMismatchActual focus mismatch@(TypeEqMismatch _ _ _ _ _ actual _ _) =
- (\actual' -> mismatch { teq_mismatch_expected = actual' }) <$> focus actual
-#endif
-_TypeEqMismatchActual _ mismatch = pure mismatch
-
-- | If a diagnostic has the proper message create a ChangeSignature from it
matchingDiagnostic :: ErrInfo -> Maybe DeclName
matchingDiagnostic ErrInfo{errInfoContext} =