diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 61a679d287..c37ea47587 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -341,7 +341,7 @@ pattern PFailedWithErrorMessages msgs mkPlainErrMsgIfPFailed (PFailed _ pst err) = Just (\dflags -> mkPlainErrMsg dflags pst err) mkPlainErrMsgIfPFailed _ = Nothing #endif -{-# COMPLETE PFailedWithErrorMessages #-} +{-# COMPLETE PFailedWithErrorMessages, POk #-} supportsHieFiles :: Bool supportsHieFiles = True diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 1585864279..abd76bc0a3 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -13,21 +13,23 @@ module Development.IDE.Plugin.CodeAction typeSigsPluginDescriptor, bindingsPluginDescriptor, fillHolePluginDescriptor, - newImport, - newImportToEdit -- * For testing - , matchRegExMultipleImports + matchRegExMultipleImports ) where import Control.Applicative ((<|>)) import Control.Arrow (second, (>>>)) import Control.Concurrent.STM.Stats (atomically) -import Control.Monad (guard, join, - msum) +import Control.Monad (forM_, + guard, join, + msum, (>=>)) import Control.Monad.IO.Class import Data.Char import qualified Data.DList as DL +import Data.Either.Extra (lefts, + maybeToEither, + rights) import Data.Function import Data.Functor import qualified Data.HashMap.Strict as Map @@ -44,14 +46,13 @@ import Data.Tuple.Extra (fst3) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Rules import Development.IDE.Core.Service -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding + (Logger) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error -import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util (prettyPrint, printRdrName, - traceAst, - unsafePrintSDoc) + traceAst) import Development.IDE.Plugin.CodeAction.Args import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.CodeAction.PositionIndexed @@ -59,6 +60,9 @@ import Development.IDE.Plugin.TypeLenses (suggestSigna import Development.IDE.Spans.Common import Development.IDE.Types.Exports import Development.IDE.Types.Location +import Development.IDE.Types.Logger (Logger, + logError, + logWarning) import Development.IDE.Types.Options import qualified GHC.LanguageExtensions as Lang import Ide.PluginUtils (subRange) @@ -74,7 +78,7 @@ import Language.LSP.Types (CodeAction ( ResponseError, SMethod (STextDocumentCodeAction), TextDocumentIdentifier (TextDocumentIdentifier), - TextEdit (TextEdit), + TextEdit (..), UInt, WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), type (|?) (InR), @@ -230,7 +234,7 @@ findInstanceHead df instanceHead decls = #if MIN_VERSION_ghc(9,2,0) findDeclContainingLoc :: Foldable t => Position -> t (GenLocated (SrcSpanAnn' a) e) -> Maybe (GenLocated (SrcSpanAnn' a) e) #else --- TODO populate this type signature for GHC versions <9.2 +findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e) #endif findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) @@ -269,7 +273,7 @@ suggestHideShadow ps@(L _ HsModule {hsmodImports}) fileContents mTcM mHar Diagno mDecl <- findImportDeclByModuleName hsmodImports $ T.unpack modName, title <- "Hide " <> identifier <> " from " <> modName = if modName == "Prelude" && null mDecl - then maybeToList $ (\(_, te) -> (title, [Left te])) <$> newImportToEdit (hideImplicitPreludeSymbol identifier) ps fileContents + then maybeToList $ (\(_, te) -> (title, [Left te])) <$> undefined -- newImportToEdit (hideImplicitPreludeSymbol identifier) ps fileContents else maybeToList $ (title,) . pure . pure . hideSymbol (T.unpack identifier) <$> mDecl | otherwise = [] @@ -1037,7 +1041,7 @@ disambiguateSymbol pm fileContents Diagnostic {..} (T.unpack -> symbol) = \case ] ++ mconcat [ if null imps - then maybeToList $ Left . snd <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) pm fileContents + then maybeToList $ Left . snd <$> undefined -- newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) pm fileContents else Right . hideSymbol symbol <$> imps | ImplicitPrelude imps <- hiddens0 ] @@ -1267,8 +1271,13 @@ removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..} ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] -suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnostic {_message} +suggestNewOrExtendImportForClassMethod :: ExportsMap + -> Annotated ParsedSource + -> T.Text -- ^ file contents + -> Diagnostic + -> DynFlags -> IdeState + -> IO [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] +suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnostic {_message} dynFlags ideState | Just [methodName, className] <- matchRegexUnifySpaces _message @@ -1276,174 +1285,116 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos idents <- maybe [] (Set.toList . Set.filter (\x -> parent x == Just className)) $ Map.lookup methodName $ getExportsMap packageExportsMap = - mconcat $ suggest <$> idents - | otherwise = [] + mconcat <$> traverse suggest idents + | otherwise = pure [] where + suggest :: IdentInfo -> IO [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] suggest identInfo@IdentInfo {moduleNameText} | importStyle <- NE.toList $ importStyles identInfo, - mImportDecl <- findImportDeclByModuleName (hsmodImports $ unLoc ps) (T.unpack moduleNameText) = + mImportDecl <- findImportDeclByModuleName (hsmodImports $ unLoc (astA ps)) (T.unpack moduleNameText) = case mImportDecl of -- extend Just decl -> - [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText, + pure $ [ ( "Add " <> renderImportStyle style <> " to the import list of " <> moduleNameText, quickFixImportKind' "extend" style, [Right $ uncurry extendImport (unImportStyle style) decl] ) | style <- importStyle ] -- new - _ - | Just (range, indent) <- newImportInsertRange ps fileContents - -> - (\(kind, unNewImport -> x) -> (x, kind, [Left $ TextEdit range (x <> "\n" <> T.replicate indent " ")])) <$> - [ (quickFixImportKind' "new" style, newUnqualImport moduleNameText rendered False) - | style <- importStyle, - let rendered = renderImportStyle style - ] - <> [(quickFixImportKind "new.all", newImportAll moduleNameText)] - | otherwise -> [] - -suggestNewImport :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport packageExportsMap ps@(L _ HsModule {..}) fileContents Diagnostic{_message} + _ -> + let ctx = NewImportContext { + nicFileContents = fileContents, + nicParsedSource = ps, + nicDynFlags = dynFlags, + nicModuleName = T.unpack moduleNameText + } + suggestions = constructNewImportSuggestions' ctx importStyle Nothing + wrapTextEdit :: ImportSuggestion -> (CodeActionTitle, CodeActionKind, [Either TextEdit Rewrite]) + wrapTextEdit (title, kind, edit) = (title, kind, [Left edit]) + in fmap wrapTextEdit <$> checkImportSuggestions (ideLogger ideState) suggestions + +type ImportSuggestion = (CodeActionTitle, CodeActionKind, TextEdit) + +suggestNewImport :: ExportsMap + -> Annotated ParsedSource + -> DynFlags + -> T.Text + -> Diagnostic + -> IdeState + -> IO [ImportSuggestion] +suggestNewImport packageExportsMap parsedSource dynFlags fileContents Diagnostic{_message} ideState | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg + , (L _ HsModule {..}) <- astA parsedSource , qual' <- extractDoesNotExportModuleName msg >>= (findImportDeclByModuleName hsmodImports . T.unpack) >>= ideclAs . unLoc <&> T.pack . moduleNameString . unLoc - , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" - = sortOn fst3 [(imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " ")) - | (kind, unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions + = checkImportSuggestions (ideLogger ideState) $ + constructNewImportSuggestions packageExportsMap parsedSource dynFlags fileContents + (qual <|> qual', thingMissing) extendImportSuggestions +suggestNewImport _ _ _ _ _ _ = pure [] + +checkImportSuggestions :: Logger -> [Either String ImportSuggestion] -> IO [ImportSuggestion] +checkImportSuggestions logger suggestionsEither = do + forM_ (lefts suggestionsEither) $ \err -> logWarning logger ("[suggestNewImport] " <> T.pack err) + pure . sortOn fst3 . rights $ suggestionsEither + +constructNewImportSuggestions :: ExportsMap + -> Annotated ParsedSource + -> DynFlags + -> T.Text + -> (Maybe T.Text, NotInScope) + -> Maybe [T.Text] + -> [Either String ImportSuggestion] +constructNewImportSuggestions exportsMap parsedSource dynFlags fileContents (qual, thingMissing) notTheseModules = + [ suggestion + | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] + , identInfo <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap) + , canUseIdent thingMissing identInfo + , moduleNameText identInfo `notElem` fromMaybe [] notTheseModules + , suggestion <- let newImportContext = + NewImportContext + { nicFileContents = fileContents, + nicParsedSource = parsedSource, + nicDynFlags = dynFlags, + nicModuleName = T.unpack (moduleNameText identInfo) + } + in constructNewImportSuggestions' newImportContext (NE.toList (importStyles identInfo)) qual ] -suggestNewImport _ _ _ _ = [] - -constructNewImportSuggestions - :: ExportsMap -> (Maybe T.Text, NotInScope) -> Maybe [T.Text] -> [(CodeActionKind, NewImport)] -constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = nubOrdOn snd - [ suggestion - | Just name <- [T.stripPrefix (maybe "" (<> ".") qual) $ notInScope thingMissing] - , identInfo <- maybe [] Set.toList $ Map.lookup name (getExportsMap exportsMap) - , canUseIdent thingMissing identInfo - , moduleNameText identInfo `notElem` fromMaybe [] notTheseModules - , suggestion <- renderNewImport identInfo - ] - where - renderNewImport :: IdentInfo -> [(CodeActionKind, NewImport)] - renderNewImport identInfo - | Just q <- qual - = [(quickFixImportKind "new.qualified", newQualImport m q)] - | otherwise - = [(quickFixImportKind' "new" importStyle, newUnqualImport m (renderImportStyle importStyle) False) - | importStyle <- NE.toList $ importStyles identInfo] ++ - [(quickFixImportKind "new.all", newImportAll m)] - where - m = moduleNameText identInfo - -newtype NewImport = NewImport {unNewImport :: T.Text} - deriving (Show, Eq, Ord) - -newImportToEdit :: NewImport -> ParsedSource -> T.Text -> Maybe (T.Text, TextEdit) -newImportToEdit (unNewImport -> imp) ps fileContents - | Just (range, indent) <- newImportInsertRange ps fileContents - = Just (imp, TextEdit range (imp <> "\n" <> T.replicate indent " ")) - | otherwise = Nothing - --- | Finds the next valid position for inserting a new import declaration --- * If the file already has existing imports it will be inserted under the last of these, --- it is assumed that the existing last import declaration is in a valid position --- * If the file does not have existing imports, but has a (module ... where) declaration, --- the new import will be inserted directly under this declaration (accounting for explicit exports) --- * If the file has neither existing imports nor a module declaration, --- the import will be inserted at line zero if there are no pragmas, --- * otherwise inserted one line after the last file-header pragma -newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) -newImportInsertRange (L _ HsModule {..}) fileContents - | Just ((l, c), col) <- case hsmodImports of - [] -> findPositionNoImports (fmap reLoc hsmodName) (fmap reLoc hsmodExports) fileContents - _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last True - , let insertPos = Position (fromIntegral l) (fromIntegral c) - = Just (Range insertPos insertPos, col) - | otherwise = Nothing - --- | Insert the import under the Module declaration exports if they exist, otherwise just under the module declaration. --- If no module declaration exists, then no exports will exist either, in that case --- insert the import after any file-header pragmas or at position zero if there are no pragmas -findPositionNoImports :: Maybe (Located ModuleName) -> Maybe (Located [LIE name]) -> T.Text -> Maybe ((Int, Int), Int) -findPositionNoImports Nothing _ fileContents = findNextPragmaPosition fileContents -findPositionNoImports _ (Just hsmodExports) _ = findPositionFromImportsOrModuleDecl hsmodExports id False -findPositionNoImports (Just hsmodName) _ _ = findPositionFromImportsOrModuleDecl hsmodName id False - -findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int) -findPositionFromImportsOrModuleDecl hsField f hasImports = case getLoc (f hsField) of - RealSrcSpan s _ -> - let col = calcCol s - in Just ((srcLocLine (realSrcSpanEnd s), col), col) - _ -> Nothing - where calcCol s = if hasImports then srcLocCol (realSrcSpanStart s) - 1 else 0 - --- | Find the position one after the last file-header pragma --- Defaults to zero if there are no pragmas in file -findNextPragmaPosition :: T.Text -> Maybe ((Int, Int), Int) -findNextPragmaPosition contents = Just ((lineNumber, 0), 0) - where - lineNumber = afterLangPragma . afterOptsGhc $ afterShebang - afterLangPragma = afterPragma "LANGUAGE" contents' - afterOptsGhc = afterPragma "OPTIONS_GHC" contents' - afterShebang = lastLineWithPrefix (T.isPrefixOf "#!") contents' 0 - contents' = T.lines contents -afterPragma :: T.Text -> [T.Text] -> Int -> Int -afterPragma name contents lineNum = lastLineWithPrefix (checkPragma name) contents lineNum - -lastLineWithPrefix :: (T.Text -> Bool) -> [T.Text] -> Int -> Int -lastLineWithPrefix p contents lineNum = max lineNum next - where - next = maybe lineNum succ $ listToMaybe . reverse $ findIndices p contents - -checkPragma :: T.Text -> T.Text -> Bool -checkPragma name = check - where - check l = isPragma l && getName l == name - getName l = T.take (T.length name) $ T.dropWhile isSpace $ T.drop 3 l - isPragma = T.isPrefixOf "{-#" - --- | 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 +constructNewImportSuggestions' :: NewImportContext + -> [ImportStyle] + -> Maybe T.Text -- ^ qualified name + -> [Either String (CodeActionTitle, CodeActionKind, TextEdit)] +constructNewImportSuggestions' ctx styles qual = + fmap (toEdit >=> buildSuggestionText) $ case qual of + Just q -> [(quickFixImportKind "new.qualified", NewQualifiedImport (T.unpack q))] + Nothing -> + [(quickFixImportKind' "new" importStyle, newImportByStyle importStyle) + | importStyle <- styles] ++ + [(quickFixImportKind "new.all", NewUnqualifiedImportForAll)] 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 + toEdit :: (CodeActionKind, NewImport) -> Either String (CodeActionKind, TextEdit) + toEdit = traverse (newImportToEdit ctx) + + buildSuggestionText :: (CodeActionKind, TextEdit) -> Either String ImportSuggestion + buildSuggestionText (codeActionKind, edit) = do + let TextEdit{_newText = newText} = edit + suggestionText = T.strip newText + if "import" `T.isPrefixOf` suggestionText + then pure (suggestionText, codeActionKind, edit) + else Left "new import code action should begin with 'import'" + +newImportByStyle :: ImportStyle -> NewImport +newImportByStyle (ImportTopLevel identifier) = NewUnqualifiedImportForIdentifier Nothing (T.unpack identifier) False +newImportByStyle (ImportViaParent identifier parent) = + NewUnqualifiedImportForIdentifier (Just . T.unpack $ parent) (T.unpack identifier) False canUseIdent :: NotInScope -> IdentInfo -> Bool canUseIdent NotInScopeDataConstructor{} = isDatacon @@ -1763,8 +1714,8 @@ renderImportStyle (ImportAllConstructors p) = p <> "(..)" -- | Used for extending import lists unImportStyle :: ImportStyle -> (Maybe String, String) -unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x) -unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x) +unImportStyle (ImportTopLevel x) = (Nothing, T.unpack x) +unImportStyle (ImportViaParent x y) = (Just $ T.unpack y, T.unpack x) unImportStyle (ImportAllConstructors x) = (Just $ T.unpack x, wildCardSymbol) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs index 85f100ca66..4be0d20e6d 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/Args.hs @@ -77,6 +77,7 @@ runGhcideCodeAction state (CodeActionParams _ _ (TextDocumentIdentifier uri) _ra caaHar <- onceIO $ runRule GetHieAst caaBindings <- onceIO $ runRule GetBindings caaGblSigs <- onceIO $ runRule GetGlobalBindingTypeSigs + let caaIdeState = state liftIO $ concat <$> sequence @@ -121,7 +122,7 @@ instance ToTextEdit Rewrite where df <- MaybeT caaDf #if !MIN_VERSION_ghc(9,2,0) ps <- MaybeT caaAnnSource - let r = rewriteToEdit df (annsA ps) rw + let r = (:[]) <$> rewriteToEdit df (annsA ps) rw #else let r = rewriteToEdit df rw #endif @@ -150,7 +151,8 @@ data CodeActionArgs = CodeActionArgs caaHar :: IO (Maybe HieAstResult), caaBindings :: IO (Maybe Bindings), caaGblSigs :: IO (Maybe GlobalBindingTypeSigsResult), - caaDiagnostic :: Diagnostic + caaDiagnostic :: Diagnostic, + caaIdeState :: IdeState } -- | There's no concurrency in each provider, @@ -186,6 +188,9 @@ instance ToCodeAction a => ToCodeAction [a] where instance ToCodeAction a => ToCodeAction (Maybe a) where toCodeAction = maybe (pure []) toCodeAction +instance ToCodeAction a => ToCodeAction (IO a) where + toCodeAction action = liftIO action >>= toCodeAction + instance ToTextEdit a => ToCodeAction (CodeActionTitle, a) where toCodeAction (title, te) = ReaderT $ \caa -> pure . (title,Just CodeActionQuickFix,Nothing,) <$> toTextEdit caa te @@ -281,3 +286,6 @@ instance ToCodeAction r => ToCodeAction (Maybe HscEnvEq -> r) where instance ToCodeAction r => ToCodeAction (Maybe HscEnv -> r) where toCodeAction = toCodeAction1 ((fmap.fmap.fmap) hscEnv caaGhcSession) + +instance ToCodeAction r => ToCodeAction (IdeState -> r) where + toCodeAction = toCodeAction3 (pure . caaIdeState) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 18019b83f6..9597a10243 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -16,6 +16,9 @@ module Development.IDE.Plugin.CodeAction.ExactPrint ( -- * Utilities appendConstraint, removeConstraint, + NewImportContext(..), + NewImport(..), + newImportToEdit, extendImport, hideSymbol, liftParseAST, @@ -55,9 +58,9 @@ import GHC (AddEpAnn (..), AnnContext (..), AnnParen (..), #endif import Language.LSP.Types import Development.IDE.GHC.Util -import Data.Bifunctor (first) -import Control.Lens (_head, _last, over) import GHC.Stack (HasCallStack) +import Ide.PluginUtils (fullRange, makeDiffTextEdit) +import Development.IDE.GHC.Compat.Util (unpackFS) ------------------------------------------------------------------------------ @@ -98,7 +101,7 @@ rewriteToEdit :: HasCallStack => Anns -> #endif Rewrite -> - Either String [TextEdit] + Either String TextEdit rewriteToEdit dflags #if !MIN_VERSION_ghc(9,2,0) anns @@ -115,14 +118,13 @@ rewriteToEdit dflags #else pure $ traceAst "REWRITE_result" $ resetEntryDP ast #endif - let editMap = - [ TextEdit (fromJust $ srcSpanToRange dst) $ + let edit = + TextEdit (fromJust $ srcSpanToRange dst) $ T.pack $ exactPrint ast #if !MIN_VERSION_ghc(9,2,0) (fst anns) #endif - ] - pure editMap + pure edit -- | Convert a 'Rewrite' into a 'WorkspaceEdit' rewriteToWEdit :: DynFlags @@ -137,14 +139,14 @@ rewriteToWEdit dflags uri anns #endif r = do - edits <- rewriteToEdit dflags + edit <- rewriteToEdit dflags #if !MIN_VERSION_ghc(9,2,0) anns #endif r return $ WorkspaceEdit - { _changes = Just (fromList [(uri, List edits)]) + { _changes = Just (fromList [(uri, List [edit])]) , _documentChanges = Nothing , _changeAnnotations = Nothing } @@ -312,7 +314,6 @@ transferAnn la lb f = do newKey = mkAnnKey lb oldValue <- liftMaybe "Unable to find ann" $ Map.lookup oldKey anns putAnnsT $ Map.delete oldKey $ Map.insert newKey (f oldValue) anns - #endif headMaybe :: [a] -> Maybe a @@ -327,10 +328,105 @@ liftMaybe :: String -> Maybe a -> TransformT (Either String) a liftMaybe _ (Just x) = return x liftMaybe s _ = lift $ Left s +------------------------------------------------------------------------------ +data NewImport + = NewQualifiedImport + { newImportQualifiedModuleName :: !String + } + | NewUnqualifiedImportForIdentifier + { newImportParent :: !(Maybe String), + newImportIdentifier :: !String, + newImportHidden :: !Bool + } + | NewUnqualifiedImportForAll + +data NewImportContext = NewImportContext + { nicFileContents :: T.Text + , nicParsedSource :: Annotated ParsedSource + , nicDynFlags :: DynFlags + , nicModuleName :: String + } + +newImportToEdit :: NewImportContext + -> NewImport + -> Either String TextEdit +newImportToEdit (NewImportContext fileContents parsedSource dynFlags moduleName) newImport = do + let rewrite = newImportToRewrite fileContents (astA parsedSource) moduleName newImport + TextEdit{_newText = newText} <- rewriteToEdit dynFlags (annsA parsedSource) rewrite + let List diffTextEdit = makeDiffTextEdit fileContents newText + case diffTextEdit of + [edit] -> pure edit + edits -> Left $ "when adding new import, there should be exactly 1 TextEdit, but got: " <> show edits + <> "\nnew text edit: " <> T.unpack newText + +newImportToRewrite :: T.Text -- ^ file contents + -> ParsedSource + -> String -- ^ module name + -> NewImport + -> Rewrite +newImportToRewrite fileContents lMod@(L _ mod) moduleName newImport = + -- The 'SrcSpan' attached to 'lMod' is just a single point at line 1, column 1. + -- So we need to use file contents to calculate an correct range for 'Rewrite'. + Rewrite (fixModuleSpan lMod) $ \df -> do + moduleNameSrcSpan <- uniqueSrcSpanT + srcSpan <- uniqueSrcSpanT + qualifiedModuleNameSrcSpan <- uniqueSrcSpanT + itemsSrcSpan <- uniqueSrcSpanT + + let lModuleName :: Located ModuleName = L moduleNameSrcSpan (mkModuleName moduleName) + lQualifiedModuleName :: Maybe (Located ModuleName) = + fmap (L qualifiedModuleNameSrcSpan . mkModuleName) qualifiedModuleName + lItems :: Located [LIE GhcPs] = L itemsSrcSpan [] :: Located [LIE GhcPs] + lDecl :: LImportDecl GhcPs = L srcSpan $ + ImportDecl { + ideclExt = NoExtField, + ideclSourceSrc = NoSourceText, + ideclName = lModuleName, + ideclPkgQual = Nothing, + ideclSource = False, + ideclSafe = False, + ideclQualified = NotQualified, + ideclImplicit = False, + ideclAs = lQualifiedModuleName, + ideclHiding = fmap (const (hidden, lItems)) identifier + } + precedingLines :: Int = if null (hsmodImports mod) then 2 else 1 + qualifiedImportKeywords :: [(KeywordId, DeltaPos)]= + maybe [] (const [(G AnnQualified, DP (0, 1)), (G AnnAs, DP (0, 1))]) lQualifiedModuleName + + addSimpleAnnT lDecl (DP (precedingLines, 0)) ((G AnnImport, DP (0, 0)) : qualifiedImportKeywords) + addSimpleAnnT lModuleName (DP (0, 1)) [(G AnnVal, DP (0, 0))] + maybe (pure ()) (\n -> addSimpleAnnT n (DP (0, 1)) [(G AnnVal, DP (0, 0))]) lQualifiedModuleName + maybe (pure ()) + (const $ addSimpleAnnT lItems (DP (0, 1)) [(G AnnOpenP, DP (0, 0)), (G AnnCloseP, DP (0, 0))]) + identifier + + lDecl' <- maybe (pure lDecl) (\identifier' -> extendImport' df parent identifier' lDecl) identifier + pure $ fmap (\mod -> mod {hsmodImports = hsmodImports mod ++ [lDecl']}) lMod + where + qualifiedModuleName :: Maybe String + parent :: Maybe String + identifier :: Maybe String + hidden :: Bool + (qualifiedModuleName, parent, identifier, hidden) = + case newImport of + NewQualifiedImport qm -> (Just qm, Nothing, Nothing, False) + NewUnqualifiedImportForIdentifier parent identifier hidden -> (Nothing, parent, Just identifier, hidden) + NewUnqualifiedImportForAll -> (Nothing, Nothing, Nothing, False) + + fixModuleSpan :: Located (HsModule GhcPs) -> SrcSpan + fixModuleSpan (L (RealSrcSpan l _) _) = rangeToSrcSpan nfp (fullRange fileContents) + where + nfp = toNormalizedFilePath . unpackFS $ srcSpanFile l + fixModuleSpan (L l _) = locA l + ------------------------------------------------------------------------------ extendImport :: Maybe String -> String -> LImportDecl GhcPs -> Rewrite extendImport mparent identifier lDecl@(L l _) = - Rewrite (locA l) $ \df -> do + Rewrite (locA l) $ \df -> extendImport' df mparent identifier lDecl + +extendImport' :: DynFlags -> Maybe String -> String -> LImportDecl GhcPs -> TransformT (Either String) (LImportDecl GhcPs) +extendImport' df mparent identifier lDecl = case mparent of -- This will also work for `ImportAllConstructors` Just parent -> extendImportViaParent df parent identifier lDecl diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index edc656ada0..321e3c847f 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -29,8 +29,6 @@ import Development.IDE.GHC.Error (rangeToSrcSpan) import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource)) import Development.IDE.GHC.Util (prettyPrint) import Development.IDE.Graph -import Development.IDE.Plugin.CodeAction (newImport, - newImportToEdit) import Development.IDE.Plugin.CodeAction.ExactPrint import Development.IDE.Plugin.Completions.Logic import Development.IDE.Plugin.Completions.Types @@ -42,7 +40,9 @@ import Development.IDE.Types.Location import Development.IDE.Types.Logger (Pretty (pretty), Recorder, WithPriority, - cmapWithPrio) + cmapWithPrio, + logDebug, + logInfo) import GHC.Exts (fromList, toList) import Ide.Plugin.Config (Config) import Ide.Types @@ -230,11 +230,14 @@ extendImportHandler' ideState ExtendImport {..} msr <- MaybeT $ use GetModSummaryWithoutTimestamps nfp ps <- MaybeT $ use GetAnnotatedParsedSource nfp (_, contents) <- MaybeT $ use GetFileContents nfp - return (msr, ps, contents) + return (msr, ps, fromMaybe "" contents) let df = ms_hspp_opts msrModSummary wantedModule = mkModuleName (T.unpack importName) wantedQual = mkModuleName . T.unpack <$> importQual existingImport = find (isWantedModule wantedModule wantedQual) msrImports + thingParent' = T.unpack <$> thingParent + newThing' = T.unpack newThing + importQual' = T.unpack <$> importQual case existingImport of Just imp -> do fmap (nfp,) $ liftEither $ @@ -243,18 +246,28 @@ extendImportHandler' ideState ExtendImport {..} (annsA ps) #endif $ - extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) + extendImport thingParent' newThing' (makeDeltaAst imp) Nothing -> do - let n = newImport importName sym importQual False - sym = if isNothing importQual then Just it else Nothing - it = case thingParent of - Nothing -> newThing - Just p -> p <> "(" <> newThing <> ")" - t <- liftMaybe $ snd <$> newImportToEdit - n - (astA ps) - (fromMaybe "" contents) - return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) + let newImport = maybe (NewUnqualifiedImportForIdentifier thingParent' newThing' False) + NewQualifiedImport importQual' + editE = newImportToEdit NewImportContext + { nicFileContents = contents, + nicParsedSource = ps, + nicDynFlags = df, + nicModuleName = T.unpack importName + } newImport + case editE of + Left errMsg -> do + liftIO $ logError (ideLogger ideState) $ "[extendImport] error: " <> T.pack errMsg + mzero + Right edit -> do + let workspaceEdit = WorkspaceEdit + { _changes = Just (fromList [(doc, List[edit])]), + _documentChanges = Nothing, + _changeAnnotations = Nothing + } + liftIO $ logDebug (ideLogger ideState) $ "[extendImport] workspace edit: " <> T.pack (show workspaceEdit) + pure (nfp, workspaceEdit) | otherwise = mzero @@ -265,9 +278,6 @@ isWantedModule wantedModule (Just qual) (L _ ImportDecl{ideclAs, ideclName, idec unLoc ideclName == wantedModule && (wantedModule == qual || (unLoc . reLoc <$> ideclAs) == Just qual) isWantedModule _ _ _ = False -liftMaybe :: Monad m => Maybe a -> MaybeT m a -liftMaybe a = MaybeT $ pure a - liftEither :: Monad m => Either e a -> MaybeT m a liftEither (Left _) = mzero liftEither (Right x) = return x