diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 1fba6b67e5..54fc99d7ac 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -22,6 +22,8 @@ import Control.Arrow (second, (&&&), (>>>)) import Control.Concurrent.STM.Stats (atomically) +import Control.Lens hiding (List, + uncons, use) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Except (ExceptT (ExceptT)) @@ -29,7 +31,6 @@ import Control.Monad.Trans.Maybe import Data.Char import qualified Data.DList as DL import Data.Function -import Data.Functor import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set import Data.List.Extra @@ -49,6 +50,9 @@ import Development.IDE.Core.Service import Development.IDE.Core.Shake hiding (Log) import Development.IDE.GHC.Compat hiding (ImplicitPrelude) +import Development.IDE.GHC.Compat.Error (TcRnMessage (..), + _TcRnMessage, + msgEnvelopeErrorL) #if !MIN_VERSION_ghc(9,11,0) import Development.IDE.GHC.Compat.Util #endif @@ -78,6 +82,8 @@ import GHC (DeltaPos (.. import GHC.Iface.Ext.Types (ContextInfo (..), IdentifierDetails (..)) import qualified GHC.LanguageExtensions as Lang +import GHC.Tc.Errors.Types (UnusedImportName (..), + UnusedImportReason (..)) import Ide.Logger hiding (group) import Ide.PluginUtils (extendToFullLines, @@ -138,12 +144,12 @@ codeAction state _ (CodeActionParams _ _ (TextDocumentIdentifier uri) range _) = contents <- liftIO $ runAction "hls-refactor-plugin.codeAction.getUriContents" state $ getUriContents $ toNormalizedUri uri liftIO $ do let mbFile = toNormalizedFilePath' <$> uriToFilePath uri - allDiags <- atomically $ fmap fdLspDiagnostic . filter (\d -> mbFile == Just (fdFilePath d)) <$> getDiagnostics state + allDiags <- atomically $ filter (\d -> mbFile == Just (fdFilePath d)) <$> getDiagnostics state (join -> parsedModule) <- runAction "GhcideCodeActions.getParsedModule" state $ getParsedModule `traverse` mbFile let textContents = fmap Rope.toText contents actions = caRemoveRedundantImports parsedModule textContents allDiags range uri - <> caRemoveInvalidExports parsedModule textContents allDiags range uri + <> caRemoveInvalidExports parsedModule textContents (fdLspDiagnostic <$> allDiags) range uri pure $ InL actions ------------------------------------------------------------------------------------------------- @@ -447,33 +453,28 @@ isUnusedImportedId maybe True (not . any (\(_, IdentifierDetails {..}) -> identInfo == S.singleton Use)) refs | otherwise = False -suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] -suggestRemoveRedundantImport ParsedModule{pm_parsed_source = L _ HsModule{hsmodImports}} contents Diagnostic{_range=_range,..} --- The qualified import of ‘many’ from module ‘Control.Applicative’ is redundant - | Just [_, bindings] <- matchRegexUnifySpaces _message "The( qualified)? import of ‘([^’]*)’ from module [^ ]* is redundant" - , Just (L _ impDecl) <- find (\(L (locA -> l) _) -> _start _range `isInsideSrcSpan` l && _end _range `isInsideSrcSpan` l ) hsmodImports - , Just c <- contents - , ranges <- map (rangesForBindingImport impDecl . T.unpack) (T.splitOn ", " bindings >>= trySplitIntoOriginalAndRecordField) +suggestRemoveRedundantImport :: ParsedModule -> Maybe T.Text -> FileDiagnostic -> [(T.Text, [TextEdit])] +suggestRemoveRedundantImport _ contents + FileDiagnostic{fdStructuredMessage,fdLspDiagnostic=Diagnostic{_range=_range}} + | Just (TcRnUnusedImport impDecl (UnusedImportSome names)) <- fdStructuredMessage ^? _SomeStructuredMessage. msgEnvelopeErrorL . _TcRnMessage + , Just c <- contents + , let bindings = names >>= bindingsInImp + , ranges <- map (rangesForBindingImport impDecl . T.unpack) bindings , ranges' <- extendAllToIncludeCommaIfPossible False (indexedByPosition $ T.unpack c) (concat ranges) , not (null ranges') - = [( "Remove " <> bindings <> " from import" , [ TextEdit r "" | r <- ranges' ] )] - --- File.hs:16:1: warning: --- The import of `Data.List' is redundant --- except perhaps to import instances from `Data.List' --- To import instances alone, use: import Data.List() - | _message =~ ("The( qualified)? import of [^ ]* is redundant" :: String) - = [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])] + = [( "Remove " <> T.intercalate ", " (pprBinding <$> names) <> " from import" , [ TextEdit r "" | r <- ranges' ] )] + | Just (TcRnUnusedImport _ UnusedImportNone) <- fdStructuredMessage ^? _SomeStructuredMessage. msgEnvelopeErrorL . _TcRnMessage = + [("Remove import", [TextEdit (extendToWholeLineIfPossible contents _range) ""])] | otherwise = [] where - -- In case of an unused record field import, the binding from the message will not match any import directly - -- In this case, we try if we can additionally extract a record field name - -- Example: The import of ‘B(b2)’ from module ‘ModuleB’ is redundant - trySplitIntoOriginalAndRecordField :: T.Text -> [T.Text] - trySplitIntoOriginalAndRecordField binding = - case matchRegexUnifySpaces binding "([^ ]+)\\(([^)]+)\\)" of - Just [_, fields] -> [binding, fields] - _ -> [binding] + bindingsInImp ::UnusedImportName -> [T.Text] + bindingsInImp (UnusedImportNameRecField NoParent name) = [printOutputable name] + bindingsInImp b@(UnusedImportNameRecField (ParentIs _) field) = [pprBinding b,printOutputable field] + bindingsInImp (UnusedImportNameRegular name) = [printOutputable name] + pprBinding ::UnusedImportName -> T.Text + pprBinding (UnusedImportNameRecField NoParent name) = printOutputable $ occName name + pprBinding (UnusedImportNameRecField (ParentIs parent) field) = printOutputable parent <> "("<> printOutputable field <> ")" + pprBinding (UnusedImportNameRegular name) = printOutputable name diagInRange :: Diagnostic -> Range -> Bool diagInRange Diagnostic {_range = dr} r = dr `subRange` extendedRange @@ -488,19 +489,19 @@ diagInRange Diagnostic {_range = dr} r = dr `subRange` extendedRange -- is likely to be removed and less likely the warning will be disabled. -- Therefore actions to remove a single or all redundant imports should be -- preferred, so that the client can prioritize them higher. -caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [Diagnostic] -> Range -> Uri -> [Command |? CodeAction] +caRemoveRedundantImports :: Maybe ParsedModule -> Maybe T.Text -> [FileDiagnostic] -> Range -> Uri -> [Command |? CodeAction] caRemoveRedundantImports m contents allDiags contextRange uri | Just pm <- m, r <- join $ map (\d -> repeat d `zip` suggestRemoveRedundantImport pm contents d) allDiags, allEdits <- [ e | (_, (_, edits)) <- r, e <- edits], caRemoveAll <- removeAll allEdits, - ctxEdits <- [ x | x@(d, _) <- r, d `diagInRange` contextRange], + ctxEdits <- [ x | x@(d, _) <- r, fdLspDiagnostic d `diagInRange` contextRange], not $ null ctxEdits, caRemoveCtx <- map (\(d, (title, tedit)) -> removeSingle title tedit d) ctxEdits = caRemoveCtx ++ [caRemoveAll] | otherwise = [] where - removeSingle title tedit diagnostic = mkCA title (Just CodeActionKind_QuickFix) Nothing [diagnostic] WorkspaceEdit{..} where + removeSingle title tedit diagnostic = mkCA title (Just CodeActionKind_QuickFix) Nothing [fdLspDiagnostic diagnostic] WorkspaceEdit{..} where _changes = Just $ M.singleton uri tedit _documentChanges = Nothing _changeAnnotations = Nothing @@ -1946,7 +1947,7 @@ textInRange (Range (Position (fromIntegral -> startRow) (fromIntegral -> startCo linesBeginningWithStartLine = drop startRow (T.splitOn "\n" text) -- | Returns the ranges for a binding in an import declaration -rangesForBindingImport :: ImportDecl GhcPs -> String -> [Range] +rangesForBindingImport :: ImportDecl GhcRn -> String -> [Range] rangesForBindingImport ImportDecl{ ideclImportList = Just (Exactly, L _ lies) } b = @@ -1988,7 +1989,7 @@ smallerRangesForBindingExport lies b = [ locA l' | L l' x <- inners, T.unpack (printOutputable x) == b'] ranges' _ = [] -rangesForBinding' :: String -> LIE GhcPs -> [SrcSpan] +rangesForBinding' :: String -> LIE GhcRn -> [SrcSpan] #if MIN_VERSION_ghc(9,9,0) rangesForBinding' b (L (locA -> l) (IEVar _ nm _)) #else