Skip to content

Commit 5a847ee

Browse files
author
Jan Vogt
committed
Use GHC structured diagnostics for missing signatures
1 parent 4271aae commit 5a847ee

File tree

1 file changed

+23
-10
lines changed

1 file changed

+23
-10
lines changed

ghcide/src/Development/IDE/Plugin/TypeLenses.hs

Lines changed: 23 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -16,7 +16,7 @@ module Development.IDE.Plugin.TypeLenses (
1616

1717
import Control.Concurrent.STM.Stats (atomically)
1818
import Control.DeepSeq (rwhnf)
19-
import Control.Lens ((?~))
19+
import Control.Lens (to, (?~), (^?))
2020
import Control.Monad (mzero)
2121
import Control.Monad.Extra (whenMaybe)
2222
import Control.Monad.IO.Class (MonadIO (liftIO))
@@ -25,13 +25,17 @@ import Data.Aeson.Types (toJSON)
2525
import qualified Data.Aeson.Types as A
2626
import Data.List (find)
2727
import qualified Data.Map as Map
28-
import Data.Maybe (catMaybes, maybeToList)
28+
import Data.Maybe (catMaybes, isJust,
29+
maybeToList)
2930
import qualified Data.Text as T
3031
import Development.IDE (FileDiagnostic (..),
3132
GhcSession (..),
3233
HscEnvEq (hscEnv),
3334
RuleResult, Rules, Uri,
34-
define, srcSpanToRange,
35+
_SomeStructuredMessage,
36+
define,
37+
fdStructuredMessageL,
38+
srcSpanToRange,
3539
usePropertyAction)
3640
import Development.IDE.Core.Compile (TcModuleResult (..))
3741
import Development.IDE.Core.PluginUtils
@@ -45,6 +49,10 @@ import Development.IDE.Core.Shake (getHiddenDiagnostics,
4549
use)
4650
import qualified Development.IDE.Core.Shake as Shake
4751
import Development.IDE.GHC.Compat
52+
import Development.IDE.GHC.Compat.Error (_TcRnMessage,
53+
_TcRnMissingSignature,
54+
msgEnvelopeErrorL,
55+
stripTcRnMessageContext)
4856
import Development.IDE.GHC.Util (printName)
4957
import Development.IDE.Graph.Classes
5058
import Development.IDE.Types.Location (Position (Position, _line),
@@ -129,9 +137,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
129137
-- dummy type to make sure HLS resolves our lens
130138
[ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve)
131139
| diag <- diags
132-
, let lspDiag@Diagnostic {_range} = fdLspDiagnostic diag
140+
, let Diagnostic {_range} = fdLspDiagnostic diag
133141
, fdFilePath diag == nfp
134-
, isGlobalDiagnostic lspDiag]
142+
, isGlobalDiagnostic diag]
135143
-- The second option is to generate lenses from the GlobalBindingTypeSig
136144
-- rule. This is the only type that needs to have the range adjusted
137145
-- with PositionMapping.
@@ -200,22 +208,27 @@ commandHandler _ideState _ wedit = do
200208
pure $ InR Null
201209

202210
--------------------------------------------------------------------------------
203-
suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T.Text, TextEdit)]
211+
suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> [(T.Text, TextEdit)]
204212
suggestSignature isQuickFix mGblSigs diag =
205213
maybeToList (suggestGlobalSignature isQuickFix mGblSigs diag)
206214

207215
-- The suggestGlobalSignature is separated into two functions. The main function
208216
-- works with a diagnostic, which then calls the secondary function with
209217
-- whatever pieces of the diagnostic it needs. This allows the resolve function,
210218
-- which no longer has the Diagnostic, to still call the secondary functions.
211-
suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> Maybe (T.Text, TextEdit)
212-
suggestGlobalSignature isQuickFix mGblSigs diag@Diagnostic{_range}
219+
suggestGlobalSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> Maybe (T.Text, TextEdit)
220+
suggestGlobalSignature isQuickFix mGblSigs diag@FileDiagnostic {fdLspDiagnostic = Diagnostic {_range}}
213221
| isGlobalDiagnostic diag =
214222
suggestGlobalSignature' isQuickFix mGblSigs Nothing _range
215223
| otherwise = Nothing
216224

217-
isGlobalDiagnostic :: Diagnostic -> Bool
218-
isGlobalDiagnostic Diagnostic{_message} = _message =~ ("(Top-level binding|Pattern synonym) with no type signature" :: T.Text)
225+
isGlobalDiagnostic :: FileDiagnostic -> Bool
226+
isGlobalDiagnostic diag = diag ^? fdStructuredMessageL
227+
. _SomeStructuredMessage
228+
. msgEnvelopeErrorL
229+
. _TcRnMessage
230+
. _TcRnMissingSignature
231+
& isJust
219232

220233
-- If a PositionMapping is supplied, this function will call
221234
-- gblBindingTypeSigToEdit with it to create a TextEdit in the right location.

0 commit comments

Comments
 (0)