@@ -64,6 +64,7 @@ import Bag (isEmptyBag)
64
64
import qualified Data.HashSet as Set
65
65
import Control.Concurrent.Extra (threadDelay , readVar )
66
66
import Development.IDE.GHC.Util (printRdrName )
67
+ import Ide.PluginUtils (subRange )
67
68
68
69
plugin :: Plugin c
69
70
plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
@@ -107,7 +108,8 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
107
108
[ mkCA title [x] edit
108
109
| x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text x
109
110
, let edit = WorkspaceEdit (Just $ Map. singleton uri $ List tedit) Nothing
110
- ] <> caRemoveRedundantImports parsedModule text diag xs uri
111
+ ] <> caRemoveInvalidExports parsedModule text diag xs uri
112
+ <> caRemoveRedundantImports parsedModule text diag xs uri
111
113
112
114
actions' =
113
115
[mkCA title [x] edit
@@ -232,8 +234,8 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod
232
234
| Just [_, bindings] <- matchRegexUnifySpaces _message " The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
233
235
, Just (L _ impDecl) <- find (\ (L l _) -> srcSpanToRange l == Just _range ) hsmodImports
234
236
, Just c <- contents
235
- , ranges <- map (rangesForBinding impDecl . T. unpack) (T. splitOn " , " bindings)
236
- , ranges' <- extendAllToIncludeCommaIfPossible (indexedByPosition $ T. unpack c) (concat ranges)
237
+ , ranges <- map (rangesForBindingImport impDecl . T. unpack) (T. splitOn " , " bindings)
238
+ , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T. unpack c) (concat ranges)
237
239
, not (null ranges')
238
240
= [( " Remove " <> bindings <> " from import" , [ TextEdit r " " | r <- ranges' ] )]
239
241
@@ -269,6 +271,69 @@ caRemoveRedundantImports m contents digs ctxDigs uri
269
271
_edit = Just WorkspaceEdit {.. }
270
272
_command = Nothing
271
273
274
+ caRemoveInvalidExports :: Maybe ParsedModule -> Maybe T. Text -> [Diagnostic ] -> [Diagnostic ] -> Uri -> [CAResult ]
275
+ caRemoveInvalidExports m contents digs ctxDigs uri
276
+ | Just pm <- m,
277
+ Just txt <- contents,
278
+ txt' <- indexedByPosition $ T. unpack txt,
279
+ r <- mapMaybe (groupDiag pm) digs,
280
+ r' <- map (\ (t,d,rs) -> (t,d,extend txt' rs)) r,
281
+ caRemoveCtx <- mapMaybe removeSingle r',
282
+ allRanges <- nubOrd $ [ range | (_,_,ranges) <- r, range <- ranges],
283
+ allRanges' <- extend txt' allRanges,
284
+ Just caRemoveAll <- removeAll allRanges',
285
+ ctxEdits <- [ x | x@ (_, d, _) <- r, d `elem` ctxDigs],
286
+ not $ null ctxEdits
287
+ = caRemoveCtx ++ [caRemoveAll]
288
+ | otherwise = []
289
+ where
290
+ extend txt ranges = extendAllToIncludeCommaIfPossible True txt ranges
291
+
292
+ groupDiag pm dig
293
+ | Just (title, ranges) <- suggestRemoveRedundantExport pm dig
294
+ = Just (title, dig, ranges)
295
+ | otherwise = Nothing
296
+
297
+ removeSingle (_, _, [] ) = Nothing
298
+ removeSingle (title, diagnostic, ranges) = Just $ CACodeAction CodeAction {.. } where
299
+ tedit = concatMap (\ r -> [TextEdit r " " ]) $ nubOrd ranges
300
+ _changes = Just $ Map. singleton uri $ List tedit
301
+ _title = title
302
+ _kind = Just CodeActionQuickFix
303
+ _diagnostics = Just $ List [diagnostic]
304
+ _documentChanges = Nothing
305
+ _edit = Just WorkspaceEdit {.. }
306
+ _command = Nothing
307
+ removeAll [] = Nothing
308
+ removeAll ranges = Just $ CACodeAction CodeAction {.. } where
309
+ tedit = concatMap (\ r -> [TextEdit r " " ]) ranges
310
+ _changes = Just $ Map. singleton uri $ List tedit
311
+ _title = " Remove all redundant exports"
312
+ _kind = Just CodeActionQuickFix
313
+ _diagnostics = Nothing
314
+ _documentChanges = Nothing
315
+ _edit = Just WorkspaceEdit {.. }
316
+ _command = Nothing
317
+
318
+ suggestRemoveRedundantExport :: ParsedModule -> Diagnostic -> Maybe (T. Text , [Range ])
319
+ suggestRemoveRedundantExport ParsedModule {pm_parsed_source = L _ HsModule {.. }} Diagnostic {.. }
320
+ | msg <- unifySpaces _message
321
+ , Just export <- hsmodExports
322
+ , Just exportRange <- getLocatedRange export
323
+ , exports <- unLoc export
324
+ , Just (removeFromExport, ! ranges) <- fmap (getRanges exports . notInScope) (extractNotInScopeName msg)
325
+ <|> (,[_range]) <$> matchExportItem msg
326
+ <|> (,[_range]) <$> matchDupExport msg
327
+ , subRange _range exportRange
328
+ = Just (" Remove ‘" <> removeFromExport <> " ’ from export" , ranges)
329
+ where
330
+ matchExportItem msg = regexSingleMatch msg " The export item ‘([^’]+)’"
331
+ matchDupExport msg = regexSingleMatch msg " Duplicate ‘([^’]+)’ in export list"
332
+ getRanges exports txt = case smallerRangesForBindingExport exports (T. unpack txt) of
333
+ [] -> (txt, [_range])
334
+ ranges -> (txt, ranges)
335
+ suggestRemoveRedundantExport _ _ = Nothing
336
+
272
337
suggestDeleteUnusedBinding :: ParsedModule -> Maybe T. Text -> Diagnostic -> [(T. Text , [TextEdit ])]
273
338
suggestDeleteUnusedBinding
274
339
ParsedModule {pm_parsed_source = L _ HsModule {hsmodDecls}}
@@ -385,6 +450,9 @@ suggestDeleteUnusedBinding
385
450
data ExportsAs = ExportName | ExportPattern | ExportAll
386
451
deriving (Eq )
387
452
453
+ getLocatedRange :: Located a -> Maybe Range
454
+ getLocatedRange = srcSpanToRange . getLoc
455
+
388
456
suggestExportUnusedTopBinding :: Maybe T. Text -> ParsedModule -> Diagnostic -> [(T. Text , [TextEdit ])]
389
457
suggestExportUnusedTopBinding srcOpt ParsedModule {pm_parsed_source = L _ HsModule {.. }} Diagnostic {.. }
390
458
-- Foo.hs:4:1: warning: [-Wunused-top-binds] Defined but not used: ‘f’
@@ -425,9 +493,6 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
425
493
| T. head x `elem` opLetter = (if needsTypeKeyword then " type " else " " ) <> " (" <> x <> " )"
426
494
| otherwise = x
427
495
428
- getLocatedRange :: Located a -> Maybe Range
429
- getLocatedRange = srcSpanToRange . getLoc
430
-
431
496
matchWithDiagnostic :: Range -> Located (IdP GhcPs ) -> Bool
432
497
matchWithDiagnostic Range {_start= l,_end= r} x =
433
498
let loc = fmap _start . getLocatedRange $ x
@@ -1076,17 +1141,30 @@ textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
1076
1141
linesBeginningWithStartLine = drop startRow (T. splitOn " \n " text)
1077
1142
1078
1143
-- | Returns the ranges for a binding in an import declaration
1079
- rangesForBinding :: ImportDecl GhcPs -> String -> [Range ]
1080
- rangesForBinding ImportDecl {ideclHiding = Just (False , L _ lies)} b =
1144
+ rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range ]
1145
+ rangesForBindingImport ImportDecl {ideclHiding = Just (False , L _ lies)} b =
1081
1146
concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
1082
1147
where
1083
- b' = wrapOperatorInParens (unqualify b)
1148
+ b' = modifyBinding b
1149
+ rangesForBindingImport _ _ = []
1084
1150
1151
+ modifyBinding :: String -> String
1152
+ modifyBinding = wrapOperatorInParens . unqualify
1153
+ where
1085
1154
wrapOperatorInParens x = if isAlpha (head x) then x else " (" <> x <> " )"
1086
-
1087
1155
unqualify x = snd $ breakOnEnd " ." x
1088
1156
1089
- rangesForBinding _ _ = []
1157
+ smallerRangesForBindingExport :: [LIE GhcPs ] -> String -> [Range ]
1158
+ smallerRangesForBindingExport lies b =
1159
+ concatMap (mapMaybe srcSpanToRange . ranges') lies
1160
+ where
1161
+ b' = modifyBinding b
1162
+ ranges' (L _ (IEThingWith _ thing _ inners labels))
1163
+ | showSDocUnsafe (ppr thing) == b' = []
1164
+ | otherwise =
1165
+ [ l' | L l' x <- inners, showSDocUnsafe (ppr x) == b'] ++
1166
+ [ l' | L l' x <- labels, showSDocUnsafe (ppr x) == b']
1167
+ ranges' _ = []
1090
1168
1091
1169
rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan ]
1092
1170
rangesForBinding' b (L l x@ IEVar {}) | showSDocUnsafe (ppr x) == b = [l]
0 commit comments