Skip to content

Commit b805746

Browse files
authored
Make type lenses plugin configurable (#1491)
* Retrieve Type from typecheck result for type lenses * Fix pattern synonym, add tests * Add tests * Add config for type lenses plugin * HLint * Remove Disabled mode * Update tests * Add FromJSON instance for mode
1 parent 15cc5d1 commit b805746

File tree

5 files changed

+319
-135
lines changed

5 files changed

+319
-135
lines changed

ghcide/src/Development/IDE/Core/Compile.hs

Lines changed: 1 addition & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -168,8 +168,7 @@ typecheckModule (IdeDefer defer) hsc keep_lbls pm = do
168168

169169
modSummary' <- initPlugins hsc modSummary
170170
(warnings, tcm) <- withWarnings "typecheck" $ \tweak ->
171-
tcRnModule hsc keep_lbls $ enableTopLevelWarnings
172-
$ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
171+
tcRnModule hsc keep_lbls $ demoteIfDefer pm{pm_mod_summary = tweak modSummary'}
173172
let errorPipeline = unDefer . hideDiag dflags . tagDiag
174173
diags = map errorPipeline warnings
175174
deferedError = any fst diags
@@ -390,14 +389,6 @@ demoteTypeErrorsToWarnings =
390389
. (`gopt_set` Opt_DeferTypedHoles)
391390
. (`gopt_set` Opt_DeferOutOfScopeVariables)
392391

393-
enableTopLevelWarnings :: ParsedModule -> ParsedModule
394-
enableTopLevelWarnings =
395-
(update_pm_mod_summary . update_hspp_opts)
396-
((`wopt_set` Opt_WarnMissingPatternSynonymSignatures) .
397-
(`wopt_set` Opt_WarnMissingSignatures))
398-
-- the line below would show also warnings for let bindings without signature
399-
-- ((`wopt_set` Opt_WarnMissingSignatures) . (`wopt_set` Opt_WarnMissingLocalSignatures)))
400-
401392
update_hspp_opts :: (DynFlags -> DynFlags) -> ModSummary -> ModSummary
402393
update_hspp_opts up ms = ms{ms_hspp_opts = up $ ms_hspp_opts ms}
403394

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

Lines changed: 13 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -49,8 +49,11 @@ import Development.IDE.GHC.Util (prettyPrint,
4949
printRdrName)
5050
import Development.IDE.Plugin.CodeAction.ExactPrint
5151
import Development.IDE.Plugin.CodeAction.PositionIndexed
52-
import Development.IDE.Plugin.TypeLenses (suggestSignature)
52+
import Development.IDE.Plugin.TypeLenses (GetGlobalBindingTypeSigs (GetGlobalBindingTypeSigs),
53+
GlobalBindingTypeSigsResult,
54+
suggestSignature)
5355
import Development.IDE.Spans.Common
56+
import Development.IDE.Spans.LocalBindings (Bindings)
5457
import Development.IDE.Types.Exports
5558
import Development.IDE.Types.HscEnvEq
5659
import Development.IDE.Types.Location
@@ -97,13 +100,15 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
97100
let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
98101
mbFile = toNormalizedFilePath' <$> uriToFilePath uri
99102
diag <- fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
100-
(ideOptions, join -> parsedModule, join -> env, join -> annotatedPS, join -> tcM, join -> har) <- runAction "CodeAction" state $
101-
(,,,,,) <$> getIdeOptions
103+
(ideOptions, join -> parsedModule, join -> env, join -> annotatedPS, join -> tcM, join -> har, join -> bindings, join -> gblSigs) <- runAction "CodeAction" state $
104+
(,,,,,,,) <$> getIdeOptions
102105
<*> getParsedModule `traverse` mbFile
103106
<*> use GhcSession `traverse` mbFile
104107
<*> use GetAnnotatedParsedSource `traverse` mbFile
105108
<*> use TypeCheck `traverse` mbFile
106109
<*> use GetHieAst `traverse` mbFile
110+
<*> use GetBindings `traverse` mbFile
111+
<*> use GetGlobalBindingTypeSigs `traverse` mbFile
107112
-- This is quite expensive 0.6-0.7s on GHC
108113
pkgExports <- maybe mempty envPackageExports env
109114
localExports <- readVar (exportsMap $ shakeExtras state)
@@ -112,7 +117,7 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) _range Cod
112117
df = ms_hspp_opts . pm_mod_summary <$> parsedModule
113118
actions =
114119
[ mkCA title [x] edit
115-
| x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text df annotatedPS tcM har x
120+
| x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text df annotatedPS tcM har bindings gblSigs x
116121
, let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
117122
]
118123
actions' = caRemoveRedundantImports parsedModule text diag xs uri
@@ -144,12 +149,14 @@ suggestAction
144149
-> Maybe (Annotated ParsedSource)
145150
-> Maybe TcModuleResult
146151
-> Maybe HieAstResult
152+
-> Maybe Bindings
153+
-> Maybe GlobalBindingTypeSigsResult
147154
-> Diagnostic
148155
-> [(T.Text, [TextEdit])]
149-
suggestAction packageExports ideOptions parsedModule text df annSource tcM har diag =
156+
suggestAction packageExports ideOptions parsedModule text df annSource tcM har bindings gblSigs diag =
150157
concat
151158
-- Order these suggestions by priority
152-
[ suggestSignature True diag
159+
[ suggestSignature True gblSigs tcM bindings diag
153160
, rewrite df annSource $ \_ ps -> suggestExtendImport packageExports ps diag
154161
, rewrite df annSource $ \df ps ->
155162
suggestImportDisambiguation df text ps diag

0 commit comments

Comments
 (0)