diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 4d1758d866..547f99d154 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -43,7 +43,8 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util (prettyPrint, - printRdrName) + printRdrName, + unsafePrintSDoc) import Development.IDE.Plugin.CodeAction.Args import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.CodeAction.PositionIndexed @@ -71,7 +72,8 @@ import Outputable (Outputable, import RdrName (GlobalRdrElt (..), lookupGlobalRdrEnv) import Safe (atMay) -import SrcLoc (realSrcSpanStart) +import SrcLoc (realSrcSpanEnd, + realSrcSpanStart) import TcRnTypes (ImportAvails (..), TcGblEnv (..)) import Text.Regex.TDFA (mrAfter, @@ -179,8 +181,8 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` l) -- 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} +suggestHideShadow :: ParsedSource -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] +suggestHideShadow ps@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_message, _range} | Just [identifier, modName, s] <- matchRegexUnifySpaces _message @@ -205,8 +207,8 @@ suggestHideShadow pm@(L _ HsModule {hsmodImports}) mTcM mHar Diagnostic {_messag 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 + then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps + else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl | otherwise = [] findImportDeclByModuleName :: [LImportDecl GhcPs] -> String -> Maybe (LImportDecl GhcPs) @@ -808,7 +810,7 @@ suggestImportDisambiguation :: Maybe T.Text -> ParsedSource -> Diagnostic -> - [(T.Text, [Rewrite])] + [(T.Text, [Either TextEdit Rewrite])] suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) diag@Diagnostic {..} | Just [ambiguous] <- matchRegexUnifySpaces @@ -897,23 +899,23 @@ disambiguateSymbol :: Diagnostic -> T.Text -> HidingMode -> - [Rewrite] + [Either TextEdit Rewrite] disambiguateSymbol pm Diagnostic {..} (T.unpack -> symbol) = \case (HideOthers hiddens0) -> - [ hideSymbol symbol idecl + [ Right $ hideSymbol symbol idecl | ExistingImp idecls <- hiddens0 , idecl <- NE.toList idecls ] ++ mconcat [ if null imps - then maybeToList $ hideImplicitPreludeSymbol symbol pm - else hideSymbol symbol <$> imps + then maybeToList $ Left . snd <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) pm + else Right . hideSymbol symbol <$> imps | ImplicitPrelude imps <- hiddens0 ] (ToQualified parensed qualMod) -> let occSym = mkVarOcc symbol rdr = Qual qualMod occSym - in [ if parensed + in Right <$> [ if parensed then Rewrite (rangeToSrcSpan "" _range) $ \df -> liftParseAST @(HsExpr GhcPs) df $ prettyPrint $ @@ -1136,7 +1138,7 @@ removeRedundantConstraints mContents Diagnostic{..} ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Rewrite])] +suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message} | Just [methodName, className] <- matchRegexUnifySpaces @@ -1155,22 +1157,24 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps Diagnostic {_message -- extend Just decl -> [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText, - [uncurry extendImport (unImportStyle style) decl] + [Right $ uncurry extendImport (unImportStyle style) decl] ) | style <- importStyle ] -- new - _ -> - [ ( "Import " <> moduleNameText <> " with " <> rendered, - maybeToList $ newUnqualImport (T.unpack moduleNameText) (T.unpack rendered) False ps - ) + _ + | Just (range, indent) <- newImportInsertRange ps + -> + (\(unNewImport -> x) -> (x, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$> + [ newUnqualImport moduleNameText rendered False | style <- importStyle, let rendered = renderImportStyle style ] - <> maybeToList (("Import " <> moduleNameText,) <$> fmap pure (newImportAll (T.unpack moduleNameText) ps)) + <> [newImportAll moduleNameText] + | otherwise -> [] -suggestNewImport :: ExportsMap -> ParsedModule -> Diagnostic -> [(T.Text, TextEdit)] -suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule {..}} Diagnostic{_message} +suggestNewImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, TextEdit)] +suggestNewImport packageExportsMap ps@(L _ HsModule {..}) Diagnostic{_message} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg @@ -1179,23 +1183,16 @@ suggestNewImport packageExportsMap ParsedModule {pm_parsed_source = L _ HsModule >>= (findImportDeclByModuleName hsmodImports . T.unpack) >>= ideclAs . unLoc <&> T.pack . moduleNameString . unLoc - , Just insertLine <- case hsmodImports of - [] -> case srcSpanStart $ getLoc (head hsmodDecls) of - RealSrcLoc s -> Just $ srcLocLine s - 1 - _ -> Nothing - _ -> case srcSpanEnd $ getLoc (last hsmodImports) of - RealSrcLoc s -> Just $ srcLocLine s - _ -> Nothing - , insertPos <- Position insertLine 0 + , Just (range, indent) <- newImportInsertRange ps , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" - = [(imp, TextEdit (Range insertPos insertPos) (imp <> "\n")) - | imp <- sort $ constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions + = sortOn fst [(imp, TextEdit range (imp <> "\n" <> T.replicate indent " ")) + | (unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions ] suggestNewImport _ _ _ = [] constructNewImportSuggestions - :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [T.Text] + :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [NewImport] constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrd [ suggestion | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] @@ -1205,18 +1202,74 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = , suggestion <- renderNewImport identInfo ] where - renderNewImport :: IdentInfo -> [T.Text] + renderNewImport :: IdentInfo -> [NewImport] renderNewImport identInfo | Just q <- qual - , asQ <- if q == m then "" else " as " <> q - = ["import qualified " <> m <> asQ] + = [newQualImport m q] | otherwise - = ["import " <> m <> " (" <> renderImportStyle importStyle <> ")" + = [newUnqualImport m (renderImportStyle importStyle) False | importStyle <- NE.toList $ importStyles identInfo] ++ - ["import " <> m ] + [newImportAll m] where m = moduleNameText identInfo +newtype NewImport = NewImport {unNewImport :: T.Text} + deriving (Show, Eq, Ord) + +newImportToEdit :: NewImport -> ParsedSource -> Maybe (T.Text, TextEdit) +newImportToEdit (unNewImport -> imp) ps + | Just (range, indent) <- newImportInsertRange ps + = Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " ")) + | otherwise = Nothing + +newImportInsertRange :: ParsedSource -> Maybe (Range, Int) +newImportInsertRange (L _ HsModule {..}) + | Just (uncurry Position -> insertPos, col) <- case hsmodImports of + [] -> case getLoc (head hsmodDecls) of + RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1 + in Just ((srcLocLine (realSrcSpanStart s) - 1, col), col) + _ -> Nothing + _ -> case getLoc (last hsmodImports) of + RealSrcSpan s -> let col = srcLocCol (realSrcSpanStart s) - 1 + in Just ((srcLocLine $ realSrcSpanEnd s,col), col) + _ -> Nothing + = Just (Range insertPos insertPos, col) + | otherwise = Nothing + +-- | Construct an import declaration with at most one symbol +newImport + :: T.Text -- ^ module name + -> Maybe T.Text -- ^ the symbol + -> Maybe T.Text -- ^ qualified name + -> Bool -- ^ the symbol is to be imported or hidden + -> NewImport +newImport modName mSymbol mQual hiding = NewImport impStmt + where + symImp + | Just symbol <- mSymbol + , symOcc <- mkVarOcc $ T.unpack symbol = + " (" <> T.pack (unsafePrintSDoc (parenSymOcc symOcc $ ppr symOcc)) <> ")" + | otherwise = "" + impStmt = + "import " + <> maybe "" (const "qualified ") mQual + <> modName + <> (if hiding then " hiding" else "") + <> symImp + <> maybe "" (\qual -> if modName == qual then "" else " as " <> qual) mQual + +newQualImport :: T.Text -> T.Text -> NewImport +newQualImport modName qual = newImport modName Nothing (Just qual) False + +newUnqualImport :: T.Text -> T.Text -> Bool -> NewImport +newUnqualImport modName symbol = newImport modName (Just symbol) Nothing + +newImportAll :: T.Text -> NewImport +newImportAll modName = newImport modName Nothing Nothing False + +hideImplicitPreludeSymbol :: T.Text -> NewImport +hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True + canUseIdent :: NotInScope -> IdentInfo -> Bool canUseIdent NotInScopeDataConstructor{} = isDatacon canUseIdent _ = const True diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index 0481f42386..167d237519 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -25,8 +25,12 @@ import Language.LSP.Types (CodeActionKind (C import Retrie (Annotated (astA)) import Retrie.ExactPrint (annsA) +type CodeActionTitle = T.Text + +type CodeActionPreferred = Bool + -- | A compact representation of 'Language.LSP.Types.CodeAction's -type GhcideCodeActions = [(T.Text, Maybe CodeActionKind, Maybe Bool, [TextEdit])] +type GhcideCodeActions = [(CodeActionTitle, Maybe CodeActionKind, Maybe CodeActionPreferred, [TextEdit])] class ToTextEdit a where toTextEdit :: CodeActionArgs -> a -> [TextEdit] @@ -105,16 +109,16 @@ instance ToCodeAction a => ToCodeAction [a] where instance ToCodeAction a => ToCodeAction (Maybe a) where toCodeAction caa = maybe [] (toCodeAction caa) -instance ToTextEdit a => ToCodeAction (T.Text, a) where +instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where toCodeAction caa (title, te) = [(title, Just CodeActionQuickFix, Nothing, toTextEdit caa te)] -instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, a) where +instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, a) where toCodeAction caa (title, kind, te) = [(title, Just kind, Nothing, toTextEdit caa te)] -instance ToTextEdit a => ToCodeAction (T.Text, Bool, a) where +instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionPreferred, a) where toCodeAction caa (title, isPreferred, te) = [(title, Nothing, Just isPreferred, toTextEdit caa te)] -instance ToTextEdit a => ToCodeAction (T.Text, CodeActionKind, Bool, a) where +instance ToTextEdit a => ToCodeAction (CodeActionTitle, CodeActionKind, CodeActionPreferred, a) where toCodeAction caa (title, kind, isPreferred, te) = [(title, Just kind, Just isPreferred, toTextEdit caa te)] ------------------------------------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 7f591a47d4..403c318f8e 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -12,12 +12,8 @@ module Development.IDE.Plugin.CodeAction.ExactPrint ( -- * Utilities appendConstraint, extendImport, - hideImplicitPreludeSymbol, hideSymbol, liftParseAST, - newImport, - newUnqualImport, - newImportAll, ) where import Control.Applicative @@ -39,20 +35,14 @@ import Development.IDE.GHC.ExactPrint (ASTElement (parseAST), import Development.IDE.Spans.Common import FieldLabel (flLabel) import GHC.Exts (IsList (fromList)) -import GhcPlugins (mkRealSrcLoc, - realSrcSpanStart, - sigPrec) +import GhcPlugins (sigPrec) import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Types (DeltaPos (DP), KeywordId (G), mkAnnKey) import Language.LSP.Types import OccName -import Outputable (ppr, showSDoc, - showSDocUnsafe) -import Retrie.GHC (mkRealSrcSpan, - rdrNameOcc, - realSrcSpanEnd, - unpackFS) +import Outputable (ppr, showSDocUnsafe) +import Retrie.GHC (rdrNameOcc, unpackFS) ------------------------------------------------------------------------------ @@ -432,69 +422,3 @@ deleteFromImport (T.pack -> symbol) (L l idecl) llies@(L lieLoc lies) _ = do (filter ((/= symbol) . unqualIEWrapName . unLoc) cons) (filter ((/= symbol) . T.pack . unpackFS . flLabel . unLoc) flds) killLie v = Just v - --- | Insert a import declaration with at most one symbol - --- newImport "A" (Just "Bar(Cons)") Nothing False --> import A (Bar(Cons)) --- newImport "A" (Just "foo") Nothing True --> import A hiding (foo) --- newImport "A" Nothing (Just "Q") False --> import qualified A as Q --- --- Wrong combinations will result in parse error --- Returns Nothing if there is no imports and declarations -newImport :: - -- | module name - String -> - -- | the symbol - Maybe String -> - -- | whether to be qualified - Maybe String -> - -- | the symbol is to be imported or hidden - Bool -> - ParsedSource -> - Maybe Rewrite -newImport modName mSymbol mQual hiding (L _ HsModule{..}) = do - -- TODO (berberman): if the previous line is module name and there is no other imports, - -- 'AnnWhere' will be crowded out to the next line, which is a bug - let predLine old = - mkRealSrcLoc - (srcLocFile old) - (srcLocLine old - 1) - (srcLocCol old) - existingImpSpan = (fmap (realSrcSpanEnd,) . realSpan . getLoc) =<< lastMaybe hsmodImports - existingDeclSpan = (fmap (predLine . realSrcSpanStart,) . realSpan . getLoc) =<< headMaybe hsmodDecls - (f, s) <- existingImpSpan <|> existingDeclSpan - let beg = f s - indentation = srcSpanStartCol s - ran = RealSrcSpan $ mkRealSrcSpan beg beg - pure $ - Rewrite ran $ \df -> do - let symImp - | Just symbol <- mSymbol - , symOcc <- mkVarOcc symbol = - "(" <> showSDoc df (parenSymOcc symOcc $ ppr symOcc) <> ")" - | otherwise = "" - impStmt = - "import " - <> maybe "" (const "qualified ") mQual - <> modName - <> (if hiding then " hiding " else " ") - <> symImp - <> maybe "" (" as " <>) mQual - -- Re-labeling is needed to reflect annotations correctly - L _ idecl0 <- liftParseAST @(ImportDecl GhcPs) df impStmt - let idecl = L ran idecl0 - addSimpleAnnT - idecl - (DP (1, indentation - 1)) - [(G AnnImport, DP (1, indentation - 1))] - pure idecl - -newUnqualImport :: String -> String -> Bool -> ParsedSource -> Maybe Rewrite -newUnqualImport modName symbol = newImport modName (Just symbol) Nothing - -newImportAll :: String -> ParsedSource -> Maybe Rewrite -newImportAll modName = newImport modName Nothing Nothing False - --- | Insert "import Prelude hiding (symbol)" -hideImplicitPreludeSymbol :: String -> ParsedSource -> Maybe Rewrite -hideImplicitPreludeSymbol symbol = newUnqualImport "Prelude" symbol True diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 4e3d71cc27..bad6169da6 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1434,38 +1434,17 @@ suggesImportClassMethodTests = [ testGroup "new" [ testSession "via parent" $ - template - [ "module A where", - "" - ] - (Range (Position 5 2) (Position 5 8)) - "Import Data.Semigroup with Semigroup(stimes)" - [ "module A where", - "", - "import Data.Semigroup (Semigroup(stimes))" - ], + template' + "import Data.Semigroup (Semigroup(stimes))" + (Range (Position 5 2) (Position 5 8)), testSession "top level" $ - template - [ "module A where", - "" - ] - (Range (Position 5 2) (Position 5 8)) - "Import Data.Semigroup with stimes" - [ "module A where", - "", - "import Data.Semigroup (stimes)" - ], + template' + "import Data.Semigroup (stimes)" + (Range (Position 5 2) (Position 5 8)), testSession "all" $ - template - [ "module A where", - "" - ] + template' + "import Data.Semigroup" (Range (Position 5 2) (Position 5 8)) - "Import Data.Semigroup" - [ "module A where", - "", - "import Data.Semigroup" - ] ], testGroup "extend" @@ -1513,6 +1492,7 @@ suggesImportClassMethodTests = executeCodeAction $ fromJust $ find (\CodeAction {_title} -> _title == executeTitle) actions' content <- documentContents doc liftIO $ T.unlines (expectedContent <> decls) @=? content + template' executeTitle range = let c = ["module A where", ""] in template c range executeTitle $ c <> [executeTitle] suggestImportTests :: TestTree suggestImportTests = testGroup "suggest import actions"