Add code action for hiding shadowed identifiers from imports (#1322)

* Add code action for hiding shadowed identifiers from imports * Insert to the line above module decls if there are no existing import decls * Support handling multi imports * Remove trailing comma in processed import lists * Add tests * Make hlint happy * Fix macro * Fix a test suite * Update test * Minor refactor Co-authored-by: Javier Neira <[email protected]> Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
haskell · Feb 13, 2021 · a9b796c · a9b796c
1 parent fbb96e8
commit a9b796c
Show file tree

Hide file tree

Showing 5 changed files with 294 additions and 13 deletions.
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
@@ -58,6 +58,13 @@ import OccName
 import qualified GHC.LanguageExtensions as Lang
 import Control.Lens (alaf)
 import Data.Monoid (Ap(..))
+import TcRnTypes (TcGblEnv(..), ImportAvails(..))
+import HscTypes (ImportedModsVal(..), importedByUser)
+import RdrName (GlobalRdrElt(..), lookupGlobalRdrEnv)
+import SrcLoc (realSrcSpanStart)
+import Module (moduleEnvElts)
+import qualified Data.Map as M
+import qualified Data.Set as S
 
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId =
@@ -80,11 +87,13 @@ codeAction lsp state _ (TextDocumentIdentifier uri) _range CodeActionContext{_di
     let text = Rope.toText . (_text :: VirtualFile -> Rope.Rope) <$> contents
         mbFile = toNormalizedFilePath' <$> uriToFilePath uri
     diag <- fmap (\(_, _, d) -> d) . filter (\(p, _, _) -> mbFile == Just p) <$> getDiagnostics state
-    (ideOptions, join -> parsedModule, join -> env, join -> annotatedPS) <- runAction "CodeAction" state $
-      (,,,) <$> getIdeOptions
+    (ideOptions, join -> parsedModule, join -> env, join -> annotatedPS, join -> tcM, join -> har) <- runAction "CodeAction" state $
+      (,,,,,) <$> getIdeOptions
             <*> getParsedModule `traverse` mbFile
             <*> use GhcSession `traverse` mbFile
             <*> use GetAnnotatedParsedSource `traverse` mbFile
+            <*> use TypeCheck `traverse` mbFile
+            <*> use GetHieAst `traverse` mbFile
     -- This is quite expensive 0.6-0.7s on GHC
     pkgExports   <- maybe mempty envPackageExports env
     localExports <- readVar (exportsMap $ shakeExtras state)
@@ -93,7 +102,7 @@ codeAction lsp state _ (TextDocumentIdentifier uri) _range CodeActionContext{_di
       df = ms_hspp_opts . pm_mod_summary <$> parsedModule
       actions =
         [ mkCA title  [x] edit
-        | x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text df annotatedPS x
+        | x <- xs, (title, tedit) <- suggestAction exportsMap ideOptions parsedModule text df annotatedPS tcM har x
         , let edit = WorkspaceEdit (Just $ Map.singleton uri $ List tedit) Nothing
         ]
       actions' = caRemoveRedundantImports parsedModule text diag xs uri
@@ -123,9 +132,11 @@ suggestAction
   -> Maybe T.Text
   -> Maybe DynFlags
   -> Maybe (Annotated ParsedSource)
+  -> Maybe TcModuleResult
+  -> Maybe HieAstResult
   -> Diagnostic
   -> [(T.Text, [TextEdit])]
-suggestAction packageExports ideOptions parsedModule text df annSource diag =
+suggestAction packageExports ideOptions parsedModule text df annSource tcM har diag =
     concat
    -- Order these suggestions by priority
     [ suggestSignature True diag
@@ -140,6 +151,7 @@ suggestAction packageExports ideOptions parsedModule text df annSource diag =
     , suggestAddTypeAnnotationToSatisfyContraints text diag
     , rewrite df annSource $ \df ps -> suggestConstraint df ps diag
     , rewrite df annSource $ \_ ps -> suggestImplicitParameter ps diag
+    , rewrite df annSource $ \_ ps -> suggestHideShadow ps tcM har diag
     ] ++ concat
     [  suggestNewDefinition ideOptions pm text diag
     ++ suggestNewImport packageExports pm diag
@@ -169,6 +181,81 @@ findInstanceHead df instanceHead decls =
 findDeclContainingLoc :: Position -> [Located a] -> Maybe (Located a)
 findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` l)
 
+-- Single:
+-- This binding for ‘mod’ shadows the existing binding
+--   imported from ‘Prelude’ at haskell-language-server/ghcide/src/Development/IDE/Plugin/CodeAction.hs:10:8-40
+--   (and originally defined in ‘GHC.Real’)typecheck(-Wname-shadowing)
+-- Multi:
+--This binding for ‘pack’ shadows the existing bindings
+--  imported from ‘Data.ByteString’ at B.hs:6:1-22
+--  imported from ‘Data.ByteString.Lazy’ at B.hs:8:1-27
+--  imported from ‘Data.Text’ at B.hs:7:1-16
+suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Rewrite])]
+suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range}
+  | Just [identifier, modName, s] <-
+      matchRegexUnifySpaces
+        _message
+        "This binding for ‘([^`]+)’ shadows the existing binding imported from ‘([^`]+)’ at ([^ ]*)" =
+    suggests identifier modName s
+  | Just [identifier] <-
+      matchRegexUnifySpaces
+        _message
+        "This binding for ‘([^`]+)’ shadows the existing bindings",
+    Just matched <- allMatchRegexUnifySpaces _message "imported from ‘([^’]+)’ at ([^ ]*)",
+    mods <- [(modName, s) | [_, modName, s] <- matched],
+    result <- nubOrdBy (compare `on` fst) $ mods >>= uncurry (suggests identifier),
+    hideAll <- ("Hide " <> identifier <> " from all occurence imports", concat $ snd <$> result) =
+    result <> [hideAll]
+  | otherwise = []
+  where
+    suggests identifier modName s
+      | Just tcM <- mTcM,
+        Just har <- mHar,
+        [s'] <- [x | (x, "") <- readSrcSpan $ T.unpack s],
+        isUnusedImportedId tcM har (T.unpack identifier) (T.unpack modName) (RealSrcSpan s'),
+        mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName,
+        title <- "Hide " <> identifier <> " from " <> modName =
+        if modName == "Prelude" && null mDecl
+          then [(title, maybeToList $ hideImplicitPreludeSymbol (T.unpack identifier) pm)]
+          else maybeToList $ (title,) . pure . hideSymbol (T.unpack identifier) <$> mDecl
+      | otherwise = []
+
+findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs)
+findImportDeclByModuleName decls modName = flip find decls $ \case
+  (L _ ImportDecl {..}) -> modName == moduleNameString (unLoc ideclName)
+  _ -> error "impossible"
+
+isTheSameLine :: SrcSpan -> SrcSpan -> Bool
+isTheSameLine s1 s2
+  | Just sl1 <- getStartLine s1,
+    Just sl2 <- getStartLine s2 =
+    sl1 == sl2
+  | otherwise = False
+  where
+    getStartLine x = srcLocLine . realSrcSpanStart <$> realSpan x
+
+isUnusedImportedId :: TcModuleResult -> HieAstResult -> String -> String -> SrcSpan -> Bool
+isUnusedImportedId
+  TcModuleResult {tmrTypechecked = TcGblEnv {tcg_imports = ImportAvails {imp_mods}}}
+  HAR {refMap}
+  identifier
+  modName
+  importSpan
+    | occ <- mkVarOcc identifier,
+      impModsVals <- importedByUser . concat $ moduleEnvElts imp_mods,
+      Just rdrEnv <-
+        listToMaybe
+          [ imv_all_exports
+            | ImportedModsVal {..} <- impModsVals,
+              imv_name == mkModuleName modName,
+              isTheSameLine imv_span importSpan
+          ],
+      [GRE {..}] <- lookupGlobalRdrEnv rdrEnv occ,
+      importedIdentifier <- Right gre_name,
+      refs <- M.lookup importedIdentifier refMap =
+      maybe True (not . any (\(_, IdentifierDetails {..}) -> identInfo == S.singleton Use)) refs
+    | otherwise = False
+
 suggestDisableWarning :: ParsedModule -> Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]
 suggestDisableWarning pm contents Diagnostic{..}
     | Just (StringValue (T.stripPrefix "-W" -> Just w)) <- _code =

diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs
@@ -31,7 +31,7 @@ import Development.IDE.GHC.Compat hiding (parseExpr)
 import Development.IDE.GHC.ExactPrint
     ( Annotate, ASTElement(parseAST) )
 import FieldLabel (flLabel)
-import GhcPlugins (sigPrec)
+import GhcPlugins (sigPrec, mkRealSrcLoc)
 import Language.Haskell.GHC.ExactPrint
 import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey)
 import Language.Haskell.LSP.Types
@@ -40,9 +40,9 @@ import Outputable (ppr, showSDocUnsafe, showSDoc)
 import Retrie.GHC (rdrNameOcc, unpackFS, mkRealSrcSpan, realSrcSpanEnd)
 import Development.IDE.Spans.Common
 import Development.IDE.GHC.Error
-import Safe (lastMay)
 import Data.Generics (listify)
 import GHC.Exts (IsList (fromList))
+import Control.Monad.Extra (whenJust)
 
 ------------------------------------------------------------------------------
 
@@ -205,6 +205,7 @@ extendImport mparent identifier lDecl@(L l _) =
 -- extendImportTopLevel "foo" AST:
 --
 -- import A --> Error
+-- import A (foo) --> Error
 -- import A (bar) --> import A (bar, foo)
 extendImportTopLevel :: DynFlags -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs)
 extendImportTopLevel df idnetifier (L l it@ImportDecl {..})
@@ -382,6 +383,8 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ =do
         lidecl' = L l $ idecl
             { ideclHiding = Just (False, edited)
             }
+    -- avoid import A (foo,)
+    whenJust (lastMaybe deletedLies) removeTrailingCommaT
     when (not (null lies) && null deletedLies) $ do
         transferAnn llies edited id
         addSimpleAnnT edited dp00
@@ -408,13 +411,16 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ =do
                   (filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds)
         killLie v = Just v
 
+-- | Insert a import declaration hiding a symbole from Prelude
 hideImplicitPreludeSymbol
     :: String -> ParsedSource -> Maybe Rewrite
 hideImplicitPreludeSymbol symbol (L _ HsModule{..}) = do
-    existingImp <- lastMay hsmodImports
-    exisImpSpan <- realSpan $ getLoc existingImp
-    let indentation = srcSpanStartCol exisImpSpan
-        beg = realSrcSpanEnd exisImpSpan
+    let predLine old = mkRealSrcLoc (srcLocFile old) (srcLocLine old - 1) (srcLocCol old)
+        existingImpSpan =  (fmap (id,) . realSpan . getLoc) =<< lastMaybe hsmodImports
+        existingDeclSpan = (fmap (predLine, ) . realSpan . getLoc) =<< headMaybe hsmodDecls
+    (f, s) <- existingImpSpan <|> existingDeclSpan
+    let beg = f $ realSrcSpanEnd s
+        indentation = srcSpanStartCol s
         ran = RealSrcSpan $ mkRealSrcSpan beg beg
     pure $ Rewrite ran $ \df -> do
         let symOcc = mkVarOcc symbol
@@ -424,6 +430,6 @@ hideImplicitPreludeSymbol symbol (L _ HsModule{..}) = do
         -- Re-labeling is needed to reflect annotations correctly
         L _ idecl0 <- liftParseAST @(ImportDecl GhcPs) df $ T.unpack impStmt
         let idecl = L ran idecl0
-        addSimpleAnnT idecl (DP (1,indentation - 1))
+        addSimpleAnnT idecl (DP (1, indentation - 1))
             [(G AnnImport, DP (1, indentation - 1))]
         pure idecl
diff --git a/ghcide/test/data/hiding/HideFunction.expected.append.E.hs b/ghcide/test/data/hiding/HideFunction.expected.append.E.hs
@@ -1,7 +1,7 @@
 module HideFunction where
 
 import AVec (fromList)
-import BVec (fromList,)
+import BVec (fromList)
 import CVec hiding ((++), cons)
 import DVec hiding ((++), cons, snoc)
 import EVec as E

diff --git a/ghcide/test/data/hiding/HideFunction.expected.append.Prelude.hs b/ghcide/test/data/hiding/HideFunction.expected.append.Prelude.hs
@@ -1,7 +1,7 @@
 module HideFunction where
 
 import AVec (fromList)
-import BVec (fromList,)
+import BVec (fromList)
 import CVec hiding ((++), cons)
 import DVec hiding ((++), cons, snoc)
 import EVec as E hiding ((++))