Skip to content

Commit 2eb7fdb

Browse files
committed
Remove invalid exports
1 parent 50854ca commit 2eb7fdb

File tree

4 files changed

+311
-31
lines changed

4 files changed

+311
-31
lines changed

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

Lines changed: 89 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -64,6 +64,7 @@ import Bag (isEmptyBag)
6464
import qualified Data.HashSet as Set
6565
import Control.Concurrent.Extra (threadDelay, readVar)
6666
import Development.IDE.GHC.Util (printRdrName)
67+
import Ide.PluginUtils (subRange)
6768

6869
plugin :: Plugin c
6970
plugin = codeActionPluginWithRules rules codeAction <> Plugin mempty setHandlersCodeLens
@@ -107,7 +108,8 @@ codeAction lsp state (TextDocumentIdentifier uri) _range CodeActionContext{_diag
107108
[ mkCA title [x] edit
108109
| x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text x
109110
, 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
111113

112114
actions' =
113115
[mkCA title [x] edit
@@ -232,8 +234,8 @@ suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmod
232234
| Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant"
233235
, Just (L _ impDecl) <- find (\(L l _) -> srcSpanToRange l == Just _range ) hsmodImports
234236
, 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)
237239
, not (null ranges')
238240
= [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )]
239241

@@ -269,6 +271,69 @@ caRemoveRedundantImports m contents digs ctxDigs uri
269271
_edit = Just WorkspaceEdit{..}
270272
_command = Nothing
271273

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+
272337
suggestDeleteUnusedBinding :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
273338
suggestDeleteUnusedBinding
274339
ParsedModule{pm_parsed_source = L _ HsModule{hsmodDecls}}
@@ -385,6 +450,9 @@ suggestDeleteUnusedBinding
385450
data ExportsAs = ExportName | ExportPattern | ExportAll
386451
deriving (Eq)
387452

453+
getLocatedRange :: Located a -> Maybe Range
454+
getLocatedRange = srcSpanToRange . getLoc
455+
388456
suggestExportUnusedTopBinding :: Maybe T.Text -> ParsedModule -> Diagnostic -> [(T.Text, [TextEdit])]
389457
suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModule{..}} Diagnostic{..}
390458
-- 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
425493
| T.head x `elem` opLetter = (if needsTypeKeyword then "type " else "") <> "(" <> x <>")"
426494
| otherwise = x
427495

428-
getLocatedRange :: Located a -> Maybe Range
429-
getLocatedRange = srcSpanToRange . getLoc
430-
431496
matchWithDiagnostic :: Range -> Located (IdP GhcPs) -> Bool
432497
matchWithDiagnostic Range{_start=l,_end=r} x =
433498
let loc = fmap _start . getLocatedRange $ x
@@ -1076,17 +1141,30 @@ textInRange (Range (Position startRow startCol) (Position endRow endCol)) text =
10761141
linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text)
10771142

10781143
-- | 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 =
10811146
concatMap (mapMaybe srcSpanToRange . rangesForBinding' b') lies
10821147
where
1083-
b' = wrapOperatorInParens (unqualify b)
1148+
b' = modifyBinding b
1149+
rangesForBindingImport _ _ = []
10841150

1151+
modifyBinding :: String -> String
1152+
modifyBinding = wrapOperatorInParens . unqualify
1153+
where
10851154
wrapOperatorInParens x = if isAlpha (head x) then x else "(" <> x <> ")"
1086-
10871155
unqualify x = snd $ breakOnEnd "." x
10881156

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' _ = []
10901168

10911169
rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan]
10921170
rangesForBinding' b (L l x@IEVar{}) | showSDocUnsafe (ppr x) == b = [l]

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

Lines changed: 14 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -83,20 +83,27 @@ mergeRanges other = other
8383
-- a, b, |c| ===> a, b|, c|
8484
-- a, |b|, |c| ===> a|, b||, c|
8585
-- @
86-
extendAllToIncludeCommaIfPossible :: PositionIndexedString -> [Range] -> [Range]
87-
extendAllToIncludeCommaIfPossible indexedString =
86+
--
87+
-- If 'acceptNoComma' is enabled, additional ranges are returned
88+
--
89+
-- @
90+
-- |a| ===> |a|
91+
-- |a|, |b| ===> |a,| |b|
92+
-- @
93+
extendAllToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> [Range] -> [Range]
94+
extendAllToIncludeCommaIfPossible acceptNoComma indexedString =
8895
mergeRanges . go indexedString . sortOn _start
8996
where
9097
go _ [] = []
9198
go input (r : rr)
92-
| r' : _ <- extendToIncludeCommaIfPossible input r
99+
| r' : _ <- extendToIncludeCommaIfPossible acceptNoComma input r
93100
, Just input' <- stripRange r' input
94101
= r' : go input' rr
95102
| otherwise
96103
= go input rr
97104

98-
extendToIncludeCommaIfPossible :: PositionIndexedString -> Range -> [Range]
99-
extendToIncludeCommaIfPossible indexedString range
105+
extendToIncludeCommaIfPossible :: Bool -> PositionIndexedString -> Range -> [Range]
106+
extendToIncludeCommaIfPossible acceptNoComma indexedString range
100107
| Just (before, _, after) <- unconsRange range indexedString
101108
, after' <- dropWhile (isSpace . snd) after
102109
, before' <- dropWhile (isSpace . snd) (reverse before)
@@ -109,6 +116,8 @@ extendToIncludeCommaIfPossible indexedString range
109116
| (_, ',') : rest <- [after']
110117
, (end', _) : _ <- pure $ dropWhile (isSpace . snd) rest
111118
]
119+
++
120+
([range | acceptNoComma])
112121
| otherwise
113122
= [range]
114123

0 commit comments

Comments
 (0)