@@ -16,7 +16,7 @@ module Development.IDE.Plugin.TypeLenses (
16
16
17
17
import Control.Concurrent.STM.Stats (atomically )
18
18
import Control.DeepSeq (rwhnf )
19
- import Control.Lens ((?~) )
19
+ import Control.Lens (to , (?~) , (^? ) )
20
20
import Control.Monad (mzero )
21
21
import Control.Monad.Extra (whenMaybe )
22
22
import Control.Monad.IO.Class (MonadIO (liftIO ))
@@ -25,13 +25,17 @@ import Data.Aeson.Types (toJSON)
25
25
import qualified Data.Aeson.Types as A
26
26
import Data.List (find )
27
27
import qualified Data.Map as Map
28
- import Data.Maybe (catMaybes , maybeToList )
28
+ import Data.Maybe (catMaybes , isJust ,
29
+ maybeToList )
29
30
import qualified Data.Text as T
30
31
import Development.IDE (FileDiagnostic (.. ),
31
32
GhcSession (.. ),
32
33
HscEnvEq (hscEnv ),
33
34
RuleResult , Rules , Uri ,
34
- define , srcSpanToRange ,
35
+ _SomeStructuredMessage ,
36
+ define ,
37
+ fdStructuredMessageL ,
38
+ srcSpanToRange ,
35
39
usePropertyAction )
36
40
import Development.IDE.Core.Compile (TcModuleResult (.. ))
37
41
import Development.IDE.Core.PluginUtils
@@ -45,6 +49,10 @@ import Development.IDE.Core.Shake (getHiddenDiagnostics,
45
49
use )
46
50
import qualified Development.IDE.Core.Shake as Shake
47
51
import Development.IDE.GHC.Compat
52
+ import Development.IDE.GHC.Compat.Error (_TcRnMessage ,
53
+ _TcRnMissingSignature ,
54
+ msgEnvelopeErrorL ,
55
+ stripTcRnMessageContext )
48
56
import Development.IDE.GHC.Util (printName )
49
57
import Development.IDE.Graph.Classes
50
58
import Development.IDE.Types.Location (Position (Position , _line ),
@@ -129,9 +137,9 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif
129
137
-- dummy type to make sure HLS resolves our lens
130
138
[ CodeLens _range Nothing (Just $ toJSON TypeLensesResolve )
131
139
| diag <- diags
132
- , let lspDiag @ Diagnostic {_range} = fdLspDiagnostic diag
140
+ , let Diagnostic {_range} = fdLspDiagnostic diag
133
141
, fdFilePath diag == nfp
134
- , isGlobalDiagnostic lspDiag ]
142
+ , isGlobalDiagnostic diag ]
135
143
-- The second option is to generate lenses from the GlobalBindingTypeSig
136
144
-- rule. This is the only type that needs to have the range adjusted
137
145
-- with PositionMapping.
@@ -200,22 +208,27 @@ commandHandler _ideState _ wedit = do
200
208
pure $ InR Null
201
209
202
210
--------------------------------------------------------------------------------
203
- suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> Diagnostic -> [(T. Text , TextEdit )]
211
+ suggestSignature :: Bool -> Maybe GlobalBindingTypeSigsResult -> FileDiagnostic -> [(T. Text , TextEdit )]
204
212
suggestSignature isQuickFix mGblSigs diag =
205
213
maybeToList (suggestGlobalSignature isQuickFix mGblSigs diag)
206
214
207
215
-- The suggestGlobalSignature is separated into two functions. The main function
208
216
-- works with a diagnostic, which then calls the secondary function with
209
217
-- whatever pieces of the diagnostic it needs. This allows the resolve function,
210
218
-- 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} }
213
221
| isGlobalDiagnostic diag =
214
222
suggestGlobalSignature' isQuickFix mGblSigs Nothing _range
215
223
| otherwise = Nothing
216
224
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
219
232
220
233
-- If a PositionMapping is supplied, this function will call
221
234
-- gblBindingTypeSigToEdit with it to create a TextEdit in the right location.
0 commit comments