From 89993425cc4fbbc90073f0c53961775cdd53c83a Mon Sep 17 00:00:00 2001 From: kokobd Date: Wed, 22 Jun 2022 15:23:12 +0800 Subject: [PATCH 1/6] #2414 fix new import position --- .../src/Development/IDE/Plugin/CodeAction.hs | 67 +++++++++++++++---- ghcide/test/exe/Main.hs | 45 ++++++------- 2 files changed, 73 insertions(+), 39 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 267c51c398..b5d0436efb 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -19,8 +19,8 @@ module Development.IDE.Plugin.CodeAction import Control.Applicative ((<|>)) import Control.Arrow (second, - (>>>), - (&&&)) + (&&&), + (>>>)) import Control.Concurrent.STM.Stats (atomically) import Control.Monad (guard, join, msum) @@ -41,6 +41,7 @@ import qualified Data.Rope.UTF16 as Rope import qualified Data.Set as S import qualified Data.Text as T import Data.Tuple.Extra (fst3) +import Debug.Trace import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -58,6 +59,12 @@ import Development.IDE.Plugin.TypeLenses (suggestSigna import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options +import GHC (AddEpAnn (AddEpAnn), + Anchor (anchor), + AnnsModule (am_main), + DeltaPos (..), + EpAnn (..), + EpaLocation (..)) import qualified GHC.LanguageExtensions as Lang import Ide.PluginUtils (subRange) import Ide.Types @@ -1386,10 +1393,10 @@ newImportToEdit (unNewImport -> imp) ps fileContents -- 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 +newImportInsertRange ps@(L _ HsModule {..}) fileContents | Just ((l, c), col) <- case hsmodImports of - [] -> findPositionNoImports (fmap reLoc hsmodName) (fmap reLoc hsmodExports) fileContents - _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last True + [] -> (\line -> ((line, 0), 0)) <$> findPositionNoImports ps fileContents + _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last , let insertPos = Position (fromIntegral l) (fromIntegral c) = Just (Range insertPos insertPos, col) | otherwise = Nothing @@ -1397,23 +1404,55 @@ newImportInsertRange (L _ HsModule {..}) fileContents -- | 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 +findPositionNoImports :: ParsedSource -> T.Text -> Maybe Int +findPositionNoImports (L _ HsModule {..}) fileContents = + case hsmodName of + Nothing -> Just $ findNextPragmaPosition fileContents + Just hsmodName' -> case hsmodAnn of + EpAnn _ annsModule _ -> + let prevSrcSpan = maybe (getLoc hsmodName') getLoc hsmodExports + in do + whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule + epaLocationToLine prevSrcSpan whereLocation + EpAnnNotUsed -> Nothing + where + filterWhere (AddEpAnn AnnWhere loc) = Just loc + filterWhere _ = Nothing + + epaLocationToLine :: SrcSpan -> EpaLocation -> Maybe Int + epaLocationToLine _ (EpaSpan sp) = + let loc = realSrcSpanEnd sp + in Just $ srcLocLine loc + epaLocationToLine (UnhelpfulSpan _) _ = Nothing + epaLocationToLine (RealSrcSpan prevSrcSpan _) (EpaDelta deltaPos _) = + case deltaPos of + SameLine _ -> Just prevEndLine + DifferentLine line _ -> Just $ prevEndLine + line + where + prevEndLine = srcLocLine (realSrcSpanEnd prevSrcSpan) + +showAddEpAnns :: [AddEpAnn] -> String +showAddEpAnns = unlines . fmap showAddEpAnn + +showAddEpAnn :: AddEpAnn -> String +showAddEpAnn (AddEpAnn keywordId loc) = show keywordId ++ "," ++ showEpaLocation loc + +showEpaLocation :: EpaLocation -> String +showEpaLocation (EpaDelta pos _) = show pos +showEpaLocation _ = error "should not be EpaSpan" -findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Bool -> Maybe ((Int, Int), Int) -findPositionFromImportsOrModuleDecl hsField f hasImports = case getLoc (f hsField) of +findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) +findPositionFromImportsOrModuleDecl hsField f = 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 + where calcCol s = srcLocCol (realSrcSpanStart s) - 1 -- | 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) +findNextPragmaPosition :: T.Text -> Int +findNextPragmaPosition contents = lineNumber where lineNumber = afterLangPragma . afterOptsGhc $ afterShebang afterLangPragma = afterPragma "LANGUAGE" contents' diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index f19b732cdc..45743b2e78 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -85,9 +85,9 @@ import System.Environment.Blank (getEnv, setEnv, unsetEnv) import System.Exit (ExitCode (ExitSuccess)) import System.FilePath -import System.IO.Extra hiding (withTempDir) -import qualified System.IO.Extra import System.Info.Extra (isMac, isWindows) +import qualified System.IO.Extra +import System.IO.Extra hiding (withTempDir) import System.Mem (performGC) import System.Process.Extra (CreateProcess (cwd), createPipe, proc, @@ -95,7 +95,7 @@ import System.Process.Extra (CreateProcess (cwd), import Test.QuickCheck -- import Test.QuickCheck.Instances () import Control.Concurrent.Async -import Control.Lens (to, (^.), (.~)) +import Control.Lens (to, (.~), (^.)) import Control.Monad.Extra (whenJust) import Data.Function ((&)) import Data.IORef @@ -123,8 +123,9 @@ import qualified HieDbRetry import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types import qualified Language.LSP.Types as LSP +import Language.LSP.Types.Lens (didChangeWatchedFiles, + workspace) import qualified Language.LSP.Types.Lens as L -import Language.LSP.Types.Lens (workspace, didChangeWatchedFiles) import qualified Progress import System.Time.Extra import Test.Tasty @@ -901,22 +902,16 @@ watchedFilesTests = testGroup "watched files" insertImportTests :: TestTree insertImportTests = testGroup "insert import" - [ expectFailBecause - ("'findPositionFromImportsOrModuleDecl' function adds import directly under line with module declaration, " - ++ "not accounting for case when 'where' keyword is placed on lower line") - (checkImport - "module where keyword lower in file no exports" - "WhereKeywordLowerInFileNoExports.hs" - "WhereKeywordLowerInFileNoExports.expected.hs" - "import Data.Int") - , expectFailBecause - ("'findPositionFromImportsOrModuleDecl' function adds import directly under line with module exports list, " - ++ "not accounting for case when 'where' keyword is placed on lower line") - (checkImport - "module where keyword lower in file with exports" - "WhereDeclLowerInFile.hs" - "WhereDeclLowerInFile.expected.hs" - "import Data.Int") + [ checkImport + "module where keyword lower in file no exports" + "WhereKeywordLowerInFileNoExports.hs" + "WhereKeywordLowerInFileNoExports.expected.hs" + "import Data.Int" + , checkImport + "module where keyword lower in file with exports" + "WhereDeclLowerInFile.hs" + "WhereDeclLowerInFile.expected.hs" + "import Data.Int" , expectFailBecause "'findNextPragmaPosition' function doesn't account for case when shebang is not placed at top of file" (checkImport @@ -5467,7 +5462,7 @@ completionDocTests = -- We ignore doc uris since it points to the local path which determined by specific machines case mn of Nothing -> txt - Just n -> T.take n txt + Just n -> T.take n txt | CompletionItem {_documentation = Just (CompletionDocMarkup (MarkupContent MkMarkdown txt)), ..} <- compls , _label == label ] @@ -5767,13 +5762,13 @@ knownBrokenFor = knownIssueFor Broken knownIssueFor :: IssueSolution -> BrokenTarget -> String -> TestTree -> TestTree knownIssueFor solution = go . \case BrokenSpecific bos vers -> isTargetOS bos && isTargetGhc vers - BrokenForOS bos -> isTargetOS bos - BrokenForGHC vers -> isTargetGhc vers + BrokenForOS bos -> isTargetOS bos + BrokenForGHC vers -> isTargetGhc vers where isTargetOS = \case Windows -> isWindows - MacOS -> isMac - Linux -> not isWindows && not isMac + MacOS -> isMac + Linux -> not isWindows && not isMac isTargetGhc = elem ghcVersion From 04041b3e70d5fee76ba9a238bce6f91de3678003 Mon Sep 17 00:00:00 2001 From: kokobd Date: Thu, 23 Jun 2022 16:49:17 +0800 Subject: [PATCH 2/6] fix auto import for ghc version < 9.2 --- .../src/Development/IDE/Plugin/CodeAction.hs | 142 +++++++++++------- .../src/Development/IDE/Plugin/Completions.hs | 5 +- 2 files changed, 86 insertions(+), 61 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index b5d0436efb..b55faae9c5 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -22,8 +22,7 @@ import Control.Arrow (second, (&&&), (>>>)) import Control.Concurrent.STM.Stats (atomically) -import Control.Monad (guard, join, - msum) +import Control.Monad (guard, join) import Control.Monad.IO.Class import Data.Char import qualified Data.DList as DL @@ -34,21 +33,19 @@ import qualified Data.HashSet as Set import Data.List.Extra import Data.List.NonEmpty (NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE -import qualified Data.Map as M +import qualified Data.Map.Strict as M import Data.Maybe import Data.Ord (comparing) import qualified Data.Rope.UTF16 as Rope import qualified Data.Set as S import qualified Data.Text as T import Data.Tuple.Extra (fst3) -import Debug.Trace import Development.IDE.Core.Rules import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error -import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util (printOutputable, printRdrName, traceAst) @@ -59,12 +56,6 @@ import Development.IDE.Plugin.TypeLenses (suggestSigna import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options -import GHC (AddEpAnn (AddEpAnn), - Anchor (anchor), - AnnsModule (am_main), - DeltaPos (..), - EpAnn (..), - EpaLocation (..)) import qualified GHC.LanguageExtensions as Lang import Ide.PluginUtils (subRange) import Ide.Types @@ -87,6 +78,22 @@ import Language.LSP.Types (CodeAction ( import Language.LSP.VFS import Text.Regex.TDFA (mrAfter, (=~), (=~~)) +#if MIN_VERSION_ghc(9,2,0) +import GHC (AddEpAnn (AddEpAnn), + AnnsModule (am_main), + DeltaPos (..), + EpAnn (..), + EpaLocation (..), + LocatedA) + +import Control.Monad (msum) +#else +import Language.Haskell.GHC.ExactPrint.Types (Annotation (annsDP), + DeltaPos, + KeywordId (G), + deltaRow, + mkAnnKey) +#endif ------------------------------------------------------------------------------------------------- @@ -234,10 +241,8 @@ 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) -#elif MIN_VERSION_ghc(8,10,0) -findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e) #else --- TODO populate this type signature for GHC versions <8.10 +findDeclContainingLoc :: Foldable t => Position -> t (GenLocated SrcSpan e) -> Maybe (GenLocated SrcSpan e) #endif findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA l) @@ -250,8 +255,8 @@ findDeclContainingLoc loc = find (\(L l _) -> loc `isInsideSrcSpan` locA 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 -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] -suggestHideShadow ps@(L _ HsModule {hsmodImports}) fileContents mTcM mHar Diagnostic {_message, _range} +suggestHideShadow :: Annotated ParsedSource -> T.Text -> Maybe TcModuleResult -> Maybe HieAstResult -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] +suggestHideShadow ps fileContents mTcM mHar Diagnostic {_message, _range} | Just [identifier, modName, s] <- matchRegexUnifySpaces _message @@ -268,6 +273,8 @@ suggestHideShadow ps@(L _ HsModule {hsmodImports}) fileContents mTcM mHar Diagno result <> [hideAll] | otherwise = [] where + L _ HsModule {hsmodImports} = astA ps + suggests identifier modName s | Just tcM <- mTcM, Just har <- mHar, @@ -947,11 +954,11 @@ isPreludeImplicit = xopt Lang.ImplicitPrelude suggestImportDisambiguation :: DynFlags -> Maybe T.Text -> - ParsedSource -> + Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, [Either TextEdit Rewrite])] -suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) fileContents diag@Diagnostic {..} +suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..} | Just [ambiguous] <- matchRegexUnifySpaces _message @@ -963,6 +970,8 @@ suggestImportDisambiguation df (Just txt) ps@(L _ HsModule {hsmodImports}) fileC suggestions ambiguous modules (isJust local) | otherwise = [] where + L _ HsModule {hsmodImports} = astA ps + locDic = fmap (NE.fromList . DL.toList) $ Map.fromListWith (<>) $ @@ -1055,13 +1064,13 @@ targetModuleName (ExistingImp _) = error "Cannot happen!" disambiguateSymbol :: - ParsedSource -> + Annotated ParsedSource -> T.Text -> Diagnostic -> T.Text -> HidingMode -> [Either TextEdit Rewrite] -disambiguateSymbol pm fileContents Diagnostic {..} (T.unpack -> symbol) = \case +disambiguateSymbol ps fileContents Diagnostic {..} (T.unpack -> symbol) = \case (HideOthers hiddens0) -> [ Right $ hideSymbol symbol idecl | ExistingImp idecls <- hiddens0 @@ -1069,7 +1078,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 <$> newImportToEdit (hideImplicitPreludeSymbol $ T.pack symbol) ps fileContents else Right . hideSymbol symbol <$> imps | ImplicitPrelude imps <- hiddens0 ] @@ -1299,7 +1308,7 @@ removeRedundantConstraints df (L _ HsModule {hsmodDecls}) Diagnostic{..} ------------------------------------------------------------------------------------------------- -suggestNewOrExtendImportForClassMethod :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] +suggestNewOrExtendImportForClassMethod :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, [Either TextEdit Rewrite])] suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnostic {_message} | Just [methodName, className] <- matchRegexUnifySpaces @@ -1313,7 +1322,7 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos where 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 -> @@ -1335,8 +1344,8 @@ suggestNewOrExtendImportForClassMethod packageExportsMap ps fileContents Diagnos <> [(quickFixImportKind "new.all", newImportAll moduleNameText)] | otherwise -> [] -suggestNewImport :: ExportsMap -> ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] -suggestNewImport packageExportsMap ps@(L _ HsModule {..}) fileContents Diagnostic{_message} +suggestNewImport :: ExportsMap -> Annotated ParsedSource -> T.Text -> Diagnostic -> [(T.Text, CodeActionKind, TextEdit)] +suggestNewImport packageExportsMap ps fileContents Diagnostic{_message} | msg <- unifySpaces _message , Just thingMissing <- extractNotInScopeName msg , qual <- extractQualifiedModuleName msg @@ -1351,6 +1360,8 @@ suggestNewImport packageExportsMap ps@(L _ HsModule {..}) fileContents Diagnosti = sortOn fst3 [(imp, kind, TextEdit range (imp <> "\n" <> T.replicate indent " ")) | (kind, unNewImport -> imp) <- constructNewImportSuggestions packageExportsMap (qual <|> qual', thingMissing) extendImportSuggestions ] + where + L _ HsModule {..} = astA ps suggestNewImport _ _ _ _ = [] constructNewImportSuggestions @@ -1378,7 +1389,7 @@ constructNewImportSuggestions exportsMap (qual, thingMissing) notTheseModules = newtype NewImport = NewImport {unNewImport :: T.Text} deriving (Show, Eq, Ord) -newImportToEdit :: NewImport -> ParsedSource -> T.Text -> Maybe (T.Text, TextEdit) +newImportToEdit :: NewImport -> Annotated 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 " ")) @@ -1392,54 +1403,71 @@ newImportToEdit (unNewImport -> imp) ps fileContents -- * 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 +#if MIN_VERSION_ghc(9,2,0) newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange ps@(L _ HsModule {..}) fileContents +#else +newImportInsertRange :: Annotated ParsedSource -> T.Text -> Maybe (Range, Int) +newImportInsertRange ps fileContents +#endif | Just ((l, c), col) <- case hsmodImports of [] -> (\line -> ((line, 0), 0)) <$> findPositionNoImports ps fileContents _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last , let insertPos = Position (fromIntegral l) (fromIntegral c) = Just (Range insertPos insertPos, col) | otherwise = Nothing + where + L _ HsModule {..} = astA ps -- | 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 :: ParsedSource -> T.Text -> Maybe Int -findPositionNoImports (L _ HsModule {..}) fileContents = - case hsmodName of - Nothing -> Just $ findNextPragmaPosition fileContents - Just hsmodName' -> case hsmodAnn of - EpAnn _ annsModule _ -> - let prevSrcSpan = maybe (getLoc hsmodName') getLoc hsmodExports - in do - whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule - epaLocationToLine prevSrcSpan whereLocation - EpAnnNotUsed -> Nothing +findPositionNoImports :: Annotated ParsedSource -> T.Text -> Maybe Int +findPositionNoImports ps fileContents = + maybe (Just (findNextPragmaPosition fileContents)) (findPositionAfterModuleName ps) hsmodName where - filterWhere (AddEpAnn AnnWhere loc) = Just loc - filterWhere _ = Nothing + L _ HsModule {..} = astA ps - epaLocationToLine :: SrcSpan -> EpaLocation -> Maybe Int - epaLocationToLine _ (EpaSpan sp) = - let loc = realSrcSpanEnd sp - in Just $ srcLocLine loc - epaLocationToLine (UnhelpfulSpan _) _ = Nothing - epaLocationToLine (RealSrcSpan prevSrcSpan _) (EpaDelta deltaPos _) = - case deltaPos of - SameLine _ -> Just prevEndLine - DifferentLine line _ -> Just $ prevEndLine + line - where - prevEndLine = srcLocLine (realSrcSpanEnd prevSrcSpan) +#if MIN_VERSION_ghc(9,2,0) +findPositionAfterModuleName :: ParsedSource -> LocatedA ModuleName -> Maybe Int +#else +findPositionAfterModuleName :: Annotated ParsedSource -> Located ModuleName -> Maybe Int +#endif +findPositionAfterModuleName ps hsmodName' = do + lineOffset <- whereKeywordLineOffset + case prevSrcSpan of + UnhelpfulSpan _ -> Nothing + (RealSrcSpan prevSrcSpan' _) -> + Just $ srcLocLine (realSrcSpanEnd prevSrcSpan') + lineOffset + where + L _ HsModule {..} = astA ps -showAddEpAnns :: [AddEpAnn] -> String -showAddEpAnns = unlines . fmap showAddEpAnn + prevSrcSpan = maybe (getLoc hsmodName') getLoc hsmodExports -showAddEpAnn :: AddEpAnn -> String -showAddEpAnn (AddEpAnn keywordId loc) = show keywordId ++ "," ++ showEpaLocation loc + whereKeywordLineOffset :: Maybe Int +#if MIN_VERSION_ghc(9,2,0) + whereKeywordLineOffset = case hsmodAnn of + EpAnn _ annsModule _ -> do + whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule + epaLocationToLine whereLocation + EpAnnNotUsed -> Nothing + filterWhere (AddEpAnn AnnWhere loc) = Just loc + filterWhere _ = Nothing -showEpaLocation :: EpaLocation -> String -showEpaLocation (EpaDelta pos _) = show pos -showEpaLocation _ = error "should not be EpaSpan" + epaLocationToLine :: EpaLocation -> Maybe Int + epaLocationToLine (EpaSpan sp) = Just . srcLocLine . realSrcSpanEnd $ sp + epaLocationToLine (EpaDelta (SameLine _) _) = Just 0 + epaLocationToLine (EpaDelta (DifferentLine line _) _) = Just line +#else + whereKeywordLineOffset = do + ann <- annsA ps M.!? mkAnnKey (astA ps) + deltaPos <- fmap NE.head . NE.nonEmpty .mapMaybe filterWhere $ annsDP ann + pure $ deltaRow deltaPos + + filterWhere :: (KeywordId, DeltaPos) -> Maybe DeltaPos + filterWhere (keywordId, deltaPos) = + if keywordId == G AnnWhere then Just deltaPos else Nothing +#endif findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) findPositionFromImportsOrModuleDecl hsField f = case getLoc (f hsField) of diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 51eee11e27..c0a76bc360 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -250,10 +250,7 @@ extendImportHandler' ideState ExtendImport {..} it = case thingParent of Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" - t <- liftMaybe $ snd <$> newImportToEdit - n - (astA ps) - (fromMaybe "" contents) + t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents) return (nfp, WorkspaceEdit {_changes=Just (fromList [(doc,List [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero From 923797228d69c8c8edcfa387c7a0151d348cf03a Mon Sep 17 00:00:00 2001 From: kokobd Date: Thu, 23 Jun 2022 17:34:08 +0800 Subject: [PATCH 3/6] re-fix it for ghc-9.2 --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index b55faae9c5..b4be12dcde 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1403,13 +1403,8 @@ newImportToEdit (unNewImport -> imp) ps fileContents -- * 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 -#if MIN_VERSION_ghc(9,2,0) -newImportInsertRange :: ParsedSource -> T.Text -> Maybe (Range, Int) -newImportInsertRange ps@(L _ HsModule {..}) fileContents -#else newImportInsertRange :: Annotated ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange ps fileContents -#endif | Just ((l, c), col) <- case hsmodImports of [] -> (\line -> ((line, 0), 0)) <$> findPositionNoImports ps fileContents _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last @@ -1428,11 +1423,13 @@ findPositionNoImports ps fileContents = where L _ HsModule {..} = astA ps +findPositionAfterModuleName :: Annotated ParsedSource #if MIN_VERSION_ghc(9,2,0) -findPositionAfterModuleName :: ParsedSource -> LocatedA ModuleName -> Maybe Int + -> LocatedA ModuleName #else -findPositionAfterModuleName :: Annotated ParsedSource -> Located ModuleName -> Maybe Int + -> Located ModuleName #endif + -> Maybe Int findPositionAfterModuleName ps hsmodName' = do lineOffset <- whereKeywordLineOffset case prevSrcSpan of From d16866721aff14c2cee8a8844e084b936ed5e7b4 Mon Sep 17 00:00:00 2001 From: kokobd Date: Thu, 23 Jun 2022 18:38:45 +0800 Subject: [PATCH 4/6] handle comments --- .../src/Development/IDE/Plugin/CodeAction.hs | 15 ++++++++++++-- ...owerInFileWithCommentsBeforeIt.expected.hs | 20 +++++++++++++++++++ ...hereDeclLowerInFileWithCommentsBeforeIt.hs | 19 ++++++++++++++++++ ghcide/test/exe/Main.hs | 5 +++++ 4 files changed, 57 insertions(+), 2 deletions(-) create mode 100644 ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs create mode 100644 ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.hs diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index b4be12dcde..e513089902 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -80,10 +80,13 @@ import Text.Regex.TDFA (mrAfter, (=~), (=~~)) #if MIN_VERSION_ghc(9,2,0) import GHC (AddEpAnn (AddEpAnn), + Anchor (anchor_op), + AnchorOperation (..), AnnsModule (am_main), DeltaPos (..), EpAnn (..), EpaLocation (..), + LEpaComment, LocatedA) import Control.Monad (msum) @@ -1453,8 +1456,16 @@ findPositionAfterModuleName ps hsmodName' = do epaLocationToLine :: EpaLocation -> Maybe Int epaLocationToLine (EpaSpan sp) = Just . srcLocLine . realSrcSpanEnd $ sp - epaLocationToLine (EpaDelta (SameLine _) _) = Just 0 - epaLocationToLine (EpaDelta (DifferentLine line _) _) = Just line + epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments + epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments) + + sumCommentsOffset :: [LEpaComment] -> Int + sumCommentsOffset = sum . fmap (\(L anchor _) -> anchorOpLine (anchor_op anchor)) + + anchorOpLine :: AnchorOperation -> Int + anchorOpLine UnchangedAnchor = 0 + anchorOpLine (MovedAnchor (SameLine _)) = 0 + anchorOpLine (MovedAnchor (DifferentLine line _)) = line #else whereKeywordLineOffset = do ann <- annsA ps M.!? mkAnnKey (astA ps) diff --git a/ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs b/ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs new file mode 100644 index 0000000000..9ea40643c9 --- /dev/null +++ b/ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs @@ -0,0 +1,20 @@ +module Asdf + (f + , where') +-- hello +-- world + + where +import Data.Int + + + +f :: Int64 -> Int64 +f = id' + where id' = id + +g :: Int -> Int +g = id + +where' :: Int -> Int +where' = id diff --git a/ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.hs b/ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.hs new file mode 100644 index 0000000000..d79ea57f21 --- /dev/null +++ b/ghcide/test/data/import-placement/WhereDeclLowerInFileWithCommentsBeforeIt.hs @@ -0,0 +1,19 @@ +module Asdf + (f + , where') +-- hello +-- world + + where + + + +f :: Int64 -> Int64 +f = id' + where id' = id + +g :: Int -> Int +g = id + +where' :: Int -> Int +where' = id diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 45743b2e78..ff08d250ad 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -912,6 +912,11 @@ insertImportTests = testGroup "insert import" "WhereDeclLowerInFile.hs" "WhereDeclLowerInFile.expected.hs" "import Data.Int" + , checkImport + "module where keyword lower in file with comments before it" + "WhereDeclLowerInFileWithCommentsBeforeIt.hs" + "WhereDeclLowerInFileWithCommentsBeforeIt.expected.hs" + "import Data.Int" , expectFailBecause "'findNextPragmaPosition' function doesn't account for case when shebang is not placed at top of file" (checkImport From e097cdbc0266594432808ac1d94b2da49be885d9 Mon Sep 17 00:00:00 2001 From: kokobd Date: Sat, 25 Jun 2022 09:15:11 +0800 Subject: [PATCH 5/6] add more comments --- .../src/Development/IDE/Plugin/CodeAction.hs | 24 +++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index e513089902..a515cdd743 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1409,8 +1409,9 @@ newImportToEdit (unNewImport -> imp) ps fileContents newImportInsertRange :: Annotated ParsedSource -> T.Text -> Maybe (Range, Int) newImportInsertRange ps fileContents | Just ((l, c), col) <- case hsmodImports of + -- When there is no existing imports, we only cares about the line number, setting column and indent to zero. [] -> (\line -> ((line, 0), 0)) <$> findPositionNoImports ps fileContents - _ -> findPositionFromImportsOrModuleDecl (map reLoc hsmodImports) last + _ -> findPositionFromImports (map reLoc hsmodImports) last , let insertPos = Position (fromIntegral l) (fromIntegral c) = Just (Range insertPos insertPos, col) | otherwise = Nothing @@ -1426,6 +1427,7 @@ findPositionNoImports ps fileContents = where L _ HsModule {..} = astA ps +-- | find line number right after module ... where findPositionAfterModuleName :: Annotated ParsedSource #if MIN_VERSION_ghc(9,2,0) -> LocatedA ModuleName @@ -1434,20 +1436,30 @@ findPositionAfterModuleName :: Annotated ParsedSource #endif -> Maybe Int findPositionAfterModuleName ps hsmodName' = do - lineOffset <- whereKeywordLineOffset + -- Note that 'where' keyword and comments are not part of the AST. They belongs to + -- the exact-print information. To locate it, we need to find the previous AST node, + -- calculate the gap between it and 'where', then add them up to produce the absolute + -- position of 'where'. + + lineOffset <- whereKeywordLineOffset -- Calculate the gap before 'where' keyword. case prevSrcSpan of UnhelpfulSpan _ -> Nothing (RealSrcSpan prevSrcSpan' _) -> + -- add them up produce the absolute location of 'where' keyword Just $ srcLocLine (realSrcSpanEnd prevSrcSpan') + lineOffset where L _ HsModule {..} = astA ps + -- The last AST node before 'where' keyword. Might be module name or export list. prevSrcSpan = maybe (getLoc hsmodName') getLoc hsmodExports + -- The relative position of 'where' keyword (in lines, relative to the previous AST node). + -- The exact-print API changed a lot in ghc-9.2, so we need to handle it seperately for different compiler versions. whereKeywordLineOffset :: Maybe Int #if MIN_VERSION_ghc(9,2,0) whereKeywordLineOffset = case hsmodAnn of EpAnn _ annsModule _ -> do + -- Find the first 'where' whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule epaLocationToLine whereLocation EpAnnNotUsed -> Nothing @@ -1457,6 +1469,9 @@ findPositionAfterModuleName ps hsmodName' = do epaLocationToLine :: EpaLocation -> Maybe Int epaLocationToLine (EpaSpan sp) = Just . srcLocLine . realSrcSpanEnd $ sp epaLocationToLine (EpaDelta (SameLine _) priorComments) = Just $ sumCommentsOffset priorComments + -- 'priorComments' contains the comments right before the current EpaLocation + -- Summing line offset of priorComments is necessary, as 'line' is the gap between the last comment and + -- the current AST node epaLocationToLine (EpaDelta (DifferentLine line _) priorComments) = Just (line + sumCommentsOffset priorComments) sumCommentsOffset :: [LEpaComment] -> Int @@ -1472,13 +1487,14 @@ findPositionAfterModuleName ps hsmodName' = do deltaPos <- fmap NE.head . NE.nonEmpty .mapMaybe filterWhere $ annsDP ann pure $ deltaRow deltaPos + -- Before ghc 9.2, DeltaPos doesn't take comment into acccount, so we don't need to sum line offset of comments. filterWhere :: (KeywordId, DeltaPos) -> Maybe DeltaPos filterWhere (keywordId, deltaPos) = if keywordId == G AnnWhere then Just deltaPos else Nothing #endif -findPositionFromImportsOrModuleDecl :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) -findPositionFromImportsOrModuleDecl hsField f = case getLoc (f hsField) of +findPositionFromImports :: HasSrcSpan a => t -> (t -> a) -> Maybe ((Int, Int), Int) +findPositionFromImports hsField f = case getLoc (f hsField) of RealSrcSpan s _ -> let col = calcCol s in Just ((srcLocLine (realSrcSpanEnd s), col), col) From 6e15bfc8bf86ecb3f7bda430379b5bd943a35f44 Mon Sep 17 00:00:00 2001 From: kokobd Date: Sat, 25 Jun 2022 10:01:55 +0800 Subject: [PATCH 6/6] reword comments of findPositionNoImports --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index a515cdd743..a3eb4f4774 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -1418,9 +1418,9 @@ newImportInsertRange ps fileContents where L _ HsModule {..} = astA ps --- | 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 +-- | Find the position for a new import when there isn't an existing one. +-- * If there is a module declaration, a new import should be inserted under the module declaration (including exports list) +-- * Otherwise, a new import should be inserted after any file-header pragma. findPositionNoImports :: Annotated ParsedSource -> T.Text -> Maybe Int findPositionNoImports ps fileContents = maybe (Just (findNextPragmaPosition fileContents)) (findPositionAfterModuleName ps) hsmodName