From ceddd183035ba14170b52f243f53bcd52f6560e8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Wed, 19 Feb 2025 13:53:26 +0100 Subject: [PATCH 1/9] First iteration of inlay hints for package imports --- .../src/Ide/Plugin/ExplicitImports.hs | 73 ++++++++++++++++++- 1 file changed, 72 insertions(+), 1 deletion(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 611c02fc78..ac607e28f9 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -17,6 +17,7 @@ module Ide.Plugin.ExplicitImports import Control.DeepSeq import Control.Lens (_Just, (&), (?~), (^?)) +import Control.Monad (guard) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) @@ -25,6 +26,7 @@ import Control.Monad.Trans.Maybe import qualified Data.Aeson as A (ToJSON (toJSON)) import Data.Aeson.Types (FromJSON) import Data.Char (isSpace) +import Data.Either (lefts) import Data.Functor ((<&>)) import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) @@ -32,7 +34,7 @@ import Data.IORef (readIORef) import Data.List (singleton) import qualified Data.Map.Strict as Map import Data.Maybe (isJust, isNothing, - mapMaybe) + listToMaybe, mapMaybe) import qualified Data.Set as S import Data.String (fromString) import qualified Data.Text as T @@ -46,6 +48,7 @@ import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding ((<+>)) +import Development.IDE.GHC.Compat.Util (mkFastString) import Development.IDE.Graph.Classes import GHC.Generics (Generic) import Ide.Plugin.Error (PluginError (..), @@ -109,6 +112,7 @@ descriptorForModules recorder modFilter plId = <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder) -- This plugin provides inlay hints <> mkPluginHandler SMethod_TextDocumentInlayHint (inlayHintProvider recorder) + <> mkPluginHandler SMethod_TextDocumentInlayHint (importPackageInlayHintProvider recorder) -- This plugin provides code actions <> codeActionHandlers } @@ -234,6 +238,73 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif title RefineImport = Nothing -- does not provide imports statements that can be refined via inlay hints in title ieResType +-- | Provide inlay hints that show which package a module is imported from. +importPackageInlayHintProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint +importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}, _range = visibleRange} = + if isInlayHintsSupported state + then do + nfp <- getNormalizedFilePathE _uri + (hscEnvEq, _) <- runActionE "ImportPackageInlayHint.GhcSessionDeps" state $ useWithStaleE GhcSessionDeps nfp + (HAR {hieAst, hieModule}, pmap) <- runActionE "ImportPackageInlayHint.GetHieAst" state $ useWithStaleE GetHieAst nfp + ast <- handleMaybe + (PluginRuleFailed "GetHieAst") + (getAsts hieAst Map.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp) + hintsInfo <- liftIO $ getAllImportedPackagesHints (hscEnv hscEnvEq) (moduleName hieModule) ast + -- Filter out empty package names + let selectedHintsInfo = hintsInfo & filter (\(_, mbPkg) -> (not . T.null) mbPkg) + let inlayHints = [ generateInlayHint newRange txt + | (range, txt) <- selectedHintsInfo + , Just newRange <- [toCurrentRange pmap range] + , isSubrangeOf newRange visibleRange] + pure $ InL inlayHints + -- When the client does not support inlay hints, do not display anything + else pure $ InL [] + where + generateInlayHint :: Range -> T.Text -> InlayHint + generateInlayHint (Range start _) txt = + InlayHint { _position = start + , _label = InL txt + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Nothing + , _paddingRight = Just True + , _data_ = Nothing + } + + -- | Get inlay hints information for all imported packages + getAllImportedPackagesHints :: HscEnv -> ModuleName -> HieAST a -> IO [(Range, T.Text)] + getAllImportedPackagesHints env currentModuleName = go + where + go :: HieAST a -> IO [(Range, T.Text)] + go ast = do + let range = realSrcSpanToRange $ nodeSpan ast + childrenResults <- traverse go (nodeChildren ast) + mbPackage <- getImportedPackage ast + return $ case mbPackage of + Nothing -> mconcat childrenResults + Just package -> (range, package) : mconcat childrenResults + + getImportedPackage :: HieAST a -> IO (Maybe T.Text) + getImportedPackage ast = runMaybeT $ do + nodeInfo <- MaybeT $ return $ sourceNodeInfo ast + moduleName <- MaybeT $ return $ + nodeIdentifiers nodeInfo + & Map.keys + & lefts + & listToMaybe + filteredModuleName <- MaybeT $ return $ + guard (moduleName /= currentModuleName) >> Just moduleName + txt <- MaybeT $ packageNameForModuleName filteredModuleName + return $ "\"" <> txt <> "\"" + + packageNameForModuleName :: ModuleName -> IO (Maybe T.Text) + packageNameForModuleName modName = runMaybeT $ do + mod <- MaybeT $ findImportedModule env modName + let pid = moduleUnit mod + conf <- MaybeT $ return $ lookupUnit env pid + return $ T.pack $ unitPackageNameString conf + -- |For explicit imports: If there are any implicit imports, provide both one -- code action per import to make that specific import explicit, and one code From 0ad92e725818d579f35775576f45214b9cdf2dbc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Thu, 20 Feb 2025 01:37:03 +0100 Subject: [PATCH 2/9] Show only one inlay hint in each line --- .../src/Ide/Plugin/ExplicitImports.hs | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index ac607e28f9..10d9efaa72 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -31,7 +31,8 @@ import Data.Functor ((<&>)) import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) import Data.IORef (readIORef) -import Data.List (singleton) +import Data.List (singleton, sortBy) +import Data.List.NonEmpty (groupBy, head) import qualified Data.Map.Strict as Map import Data.Maybe (isJust, isNothing, listToMaybe, mapMaybe) @@ -250,8 +251,13 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo (PluginRuleFailed "GetHieAst") (getAsts hieAst Map.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp) hintsInfo <- liftIO $ getAllImportedPackagesHints (hscEnv hscEnvEq) (moduleName hieModule) ast - -- Filter out empty package names - let selectedHintsInfo = hintsInfo & filter (\(_, mbPkg) -> (not . T.null) mbPkg) + -- Sort the hints by position and group them by line + -- Show only first hint in each line + let selectedHintsInfo = hintsInfo + & sortBy (\(Range (Position l1 c1) _, _) (Range (Position l2 c2) _, _) -> + compare l1 l2 <> compare c1 c2) + & groupBy (\(Range (Position l1 _) _, _) (Range (Position l2 _) _, _) -> l1 == l2) + & map Data.List.NonEmpty.head let inlayHints = [ generateInlayHint newRange txt | (range, txt) <- selectedHintsInfo , Just newRange <- [toCurrentRange pmap range] From 1e5b404ae1e86ceb2e522360d8077930c1015900 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sat, 22 Feb 2025 22:14:01 +0100 Subject: [PATCH 3/9] Hide inlay hint when using package import --- .../src/Ide/Plugin/ExplicitImports.hs | 24 +++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 10d9efaa72..86b5073526 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -52,6 +52,11 @@ import Development.IDE.GHC.Compat hiding ((<+>)) import Development.IDE.GHC.Compat.Util (mkFastString) import Development.IDE.Graph.Classes import GHC.Generics (Generic) +import GHC.Num (integerFromInt) +import GHC.Parser.Annotation (EpAnn (entry), + HasLoc (getHasLoc), + realSrcSpan) +import GHC.Types.PkgQual (RawPkgQual (NoRawPkgQual)) import Ide.Plugin.Error (PluginError (..), getNormalizedFilePathE, handleMaybe) @@ -250,6 +255,23 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo ast <- handleMaybe (PluginRuleFailed "GetHieAst") (getAsts hieAst Map.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp) + parsedModule <- runActionE "GADT.GetParsedModuleWithComments" state $ useE GetParsedModule nfp + let (L _ hsImports) = hsmodImports <$> pm_parsed_source parsedModule + + let isPackageImport :: ImportDecl GhcPs -> Bool + isPackageImport ImportDecl{ideclPkgQual = NoRawPkgQual} = False + isPackageImport _ = True + + annotationToLineNumber :: EpAnn a -> Integer + annotationToLineNumber = integerFromInt . srcSpanEndLine . realSrcSpan . getHasLoc . entry + + packageImportLineNumbers :: S.Set Integer + packageImportLineNumbers = + S.fromList $ + hsImports + & filter (\(L _ importDecl) -> isPackageImport importDecl) + & map (\(L annotation _) -> annotationToLineNumber annotation) + hintsInfo <- liftIO $ getAllImportedPackagesHints (hscEnv hscEnvEq) (moduleName hieModule) ast -- Sort the hints by position and group them by line -- Show only first hint in each line @@ -258,6 +280,8 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo compare l1 l2 <> compare c1 c2) & groupBy (\(Range (Position l1 _) _, _) (Range (Position l2 _) _, _) -> l1 == l2) & map Data.List.NonEmpty.head + -- adding 1 because RealSrcLoc begins with 1 + & filter (\(Range (Position l _) _, _) -> S.notMember (toInteger l + 1) packageImportLineNumbers) let inlayHints = [ generateInlayHint newRange txt | (range, txt) <- selectedHintsInfo , Just newRange <- [toCurrentRange pmap range] From 79fbbaa9766a61f22f0ce45e1d0e1905481e5762 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sun, 2 Mar 2025 02:53:37 +0100 Subject: [PATCH 4/9] Display inlay hint after import/import qualified --- .../src/Ide/Plugin/ExplicitImports.hs | 133 +++++++----------- 1 file changed, 53 insertions(+), 80 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 86b5073526..9cccdf1bbb 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -16,8 +16,8 @@ module Ide.Plugin.ExplicitImports ) where import Control.DeepSeq -import Control.Lens (_Just, (&), (?~), (^?)) -import Control.Monad (guard) +import Control.Lens (_Just, (&), (?~), (^.), + (^?)) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) @@ -26,16 +26,14 @@ import Control.Monad.Trans.Maybe import qualified Data.Aeson as A (ToJSON (toJSON)) import Data.Aeson.Types (FromJSON) import Data.Char (isSpace) -import Data.Either (lefts) import Data.Functor ((<&>)) import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) import Data.IORef (readIORef) -import Data.List (singleton, sortBy) -import Data.List.NonEmpty (groupBy, head) +import Data.List (singleton) import qualified Data.Map.Strict as Map -import Data.Maybe (isJust, isNothing, - listToMaybe, mapMaybe) +import Data.Maybe (catMaybes, isJust, + isNothing, mapMaybe) import qualified Data.Set as S import Data.String (fromString) import qualified Data.Text as T @@ -49,11 +47,9 @@ import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding ((<+>)) -import Development.IDE.GHC.Compat.Util (mkFastString) import Development.IDE.Graph.Classes import GHC.Generics (Generic) -import GHC.Num (integerFromInt) -import GHC.Parser.Annotation (EpAnn (entry), +import GHC.Parser.Annotation (EpAnn (anns), HasLoc (getHasLoc), realSrcSpan) import GHC.Types.PkgQual (RawPkgQual (NoRawPkgQual)) @@ -251,89 +247,66 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo then do nfp <- getNormalizedFilePathE _uri (hscEnvEq, _) <- runActionE "ImportPackageInlayHint.GhcSessionDeps" state $ useWithStaleE GhcSessionDeps nfp - (HAR {hieAst, hieModule}, pmap) <- runActionE "ImportPackageInlayHint.GetHieAst" state $ useWithStaleE GetHieAst nfp - ast <- handleMaybe - (PluginRuleFailed "GetHieAst") - (getAsts hieAst Map.!? (HiePath . mkFastString . fromNormalizedFilePath) nfp) - parsedModule <- runActionE "GADT.GetParsedModuleWithComments" state $ useE GetParsedModule nfp - let (L _ hsImports) = hsmodImports <$> pm_parsed_source parsedModule + (parsedModule, pmap) <- runActionE "ImportPackageInlayHint.GetParsedModuleWithComments" state $ useWithStaleE GetParsedModule nfp - let isPackageImport :: ImportDecl GhcPs -> Bool - isPackageImport ImportDecl{ideclPkgQual = NoRawPkgQual} = False - isPackageImport _ = True + let moduleNamePositions = getModuleNamePositions parsedModule + env = hscEnv hscEnvEq + + packagePositions <- fmap catMaybes $ for moduleNamePositions $ \(pos, moduleName) -> do + packageName <- liftIO $ packageNameForModuleName moduleName env + case packageName of + Nothing -> pure Nothing + Just packageName -> pure $ Just (pos, packageName) - annotationToLineNumber :: EpAnn a -> Integer - annotationToLineNumber = integerFromInt . srcSpanEndLine . realSrcSpan . getHasLoc . entry - - packageImportLineNumbers :: S.Set Integer - packageImportLineNumbers = - S.fromList $ - hsImports - & filter (\(L _ importDecl) -> isPackageImport importDecl) - & map (\(L annotation _) -> annotationToLineNumber annotation) - - hintsInfo <- liftIO $ getAllImportedPackagesHints (hscEnv hscEnvEq) (moduleName hieModule) ast - -- Sort the hints by position and group them by line - -- Show only first hint in each line - let selectedHintsInfo = hintsInfo - & sortBy (\(Range (Position l1 c1) _, _) (Range (Position l2 c2) _, _) -> - compare l1 l2 <> compare c1 c2) - & groupBy (\(Range (Position l1 _) _, _) (Range (Position l2 _) _, _) -> l1 == l2) - & map Data.List.NonEmpty.head - -- adding 1 because RealSrcLoc begins with 1 - & filter (\(Range (Position l _) _, _) -> S.notMember (toInteger l + 1) packageImportLineNumbers) - let inlayHints = [ generateInlayHint newRange txt - | (range, txt) <- selectedHintsInfo - , Just newRange <- [toCurrentRange pmap range] - , isSubrangeOf newRange visibleRange] + let inlayHints = [ generateInlayHint newPos txt + | (pos, txt) <- packagePositions + , Just newPos <- [toCurrentPosition pmap pos] + , positionInRange newPos visibleRange] pure $ InL inlayHints -- When the client does not support inlay hints, do not display anything else pure $ InL [] where - generateInlayHint :: Range -> T.Text -> InlayHint - generateInlayHint (Range start _) txt = - InlayHint { _position = start + generateInlayHint :: Position -> T.Text -> InlayHint + generateInlayHint pos txt = + InlayHint { _position = pos , _label = InL txt , _kind = Nothing , _textEdits = Nothing , _tooltip = Nothing - , _paddingLeft = Nothing - , _paddingRight = Just True + , _paddingLeft = Just True + , _paddingRight = Nothing , _data_ = Nothing } - -- | Get inlay hints information for all imported packages - getAllImportedPackagesHints :: HscEnv -> ModuleName -> HieAST a -> IO [(Range, T.Text)] - getAllImportedPackagesHints env currentModuleName = go - where - go :: HieAST a -> IO [(Range, T.Text)] - go ast = do - let range = realSrcSpanToRange $ nodeSpan ast - childrenResults <- traverse go (nodeChildren ast) - mbPackage <- getImportedPackage ast - return $ case mbPackage of - Nothing -> mconcat childrenResults - Just package -> (range, package) : mconcat childrenResults - - getImportedPackage :: HieAST a -> IO (Maybe T.Text) - getImportedPackage ast = runMaybeT $ do - nodeInfo <- MaybeT $ return $ sourceNodeInfo ast - moduleName <- MaybeT $ return $ - nodeIdentifiers nodeInfo - & Map.keys - & lefts - & listToMaybe - filteredModuleName <- MaybeT $ return $ - guard (moduleName /= currentModuleName) >> Just moduleName - txt <- MaybeT $ packageNameForModuleName filteredModuleName - return $ "\"" <> txt <> "\"" - - packageNameForModuleName :: ModuleName -> IO (Maybe T.Text) - packageNameForModuleName modName = runMaybeT $ do - mod <- MaybeT $ findImportedModule env modName - let pid = moduleUnit mod - conf <- MaybeT $ return $ lookupUnit env pid - return $ T.pack $ unitPackageNameString conf + packageNameForModuleName :: ModuleName -> HscEnv -> IO (Maybe T.Text) + packageNameForModuleName modName env = runMaybeT $ do + mod <- MaybeT $ findImportedModule env modName + let pid = moduleUnit mod + conf <- MaybeT $ return $ lookupUnit env pid + let packageName = T.pack $ unitPackageNameString conf + return $ "\"" <> packageName <> "\"" + + getModuleNamePositions :: ParsedModule -> [(Position, ModuleName)] + getModuleNamePositions parsedModule = + let isPackageImport :: ImportDecl GhcPs -> Bool + isPackageImport ImportDecl{ideclPkgQual = NoRawPkgQual} = False + isPackageImport _ = True + + (L _ hsImports) = hsmodImports <$> pm_parsed_source parsedModule + + srcSpanToPosition :: SrcSpan -> Position + srcSpanToPosition srcSpan = (realSrcSpanToRange . realSrcSpan $ srcSpan) ^. L.end + + annToPosition :: EpAnnImportDecl -> Position + annToPosition ann = case importDeclAnnQualified ann of + Just loc -> (srcSpanToPosition $ getHasLoc loc) + _ -> (srcSpanToPosition $ getHasLoc $ importDeclAnnImport ann) + + in hsImports + & filter (\(L _ importDecl) -> not $ isPackageImport importDecl) + & map (\(L _ importDecl) -> + (annToPosition $ anns $ ideclAnn $ ideclExt importDecl, unLoc $ ideclName importDecl)) + -- |For explicit imports: If there are any implicit imports, provide both one From 1a7a370db5f75a8d3f1149dfc2816c75c8d24998 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sun, 2 Mar 2025 17:31:07 +0100 Subject: [PATCH 5/9] Tests: hint location, package import, qualified import --- .../hls-explicit-imports-plugin/test/Main.hs | 35 ++++++++++++++++++- .../test/testdata/ImportUsual.hs | 15 ++++++++ .../test/testdata/ImportWithPackageImport.hs | 16 +++++++++ 3 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 plugins/hls-explicit-imports-plugin/test/testdata/ImportUsual.hs create mode 100644 plugins/hls-explicit-imports-plugin/test/testdata/ImportWithPackageImport.hs diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 01fe1d469e..2f1470bb5b 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -107,7 +107,27 @@ main = defaultTestRunner $ testGroup "import-actions" o = "(Athing, Bthing, ... (4 items))" in ExplicitImports.abbreviateImportTitleWithoutModule i @?= o ] - ]] + ], + testGroup + "Import package inlay hints" + [ testGroup "Without package imports" + [ inlayHintsTestWithCap "ImportUsual" 2 $ (@=?) + [mkInlayHintNoTextEdit (Position 2 6) "\"base\""] + , inlayHintsTestWithCap "ImportUsual" 3 $ (@=?) + [mkInlayHintNoTextEdit (Position 3 16) "\"containers\""] + , inlayHintsTestWithCap "ImportUsual" 4 $ (@=?) [] + , inlayHintsTestWithoutCap "ImportUsual" 2 $ (@=?) [] + , inlayHintsTestWithoutCap "ImportUsual" 3 $ (@=?) [] + , inlayHintsTestWithoutCap "ImportUsual" 4 $ (@=?) [] + ], testGroup "With package imports" + [ inlayHintsTestWithCap "ImportWithPackageImport" 3 $ (@=?) [] + , inlayHintsTestWithCap "ImportWithPackageImport" 4 $ (@=?) + [mkInlayHintNoTextEdit (Position 4 16) "\"containers\""] + , inlayHintsTestWithCap "ImportWithPackageImport" 5 $ (@=?) [] + , inlayHintsTestWithoutCap "ImportWithPackageImport" 3 $ (@=?) [] + , inlayHintsTestWithoutCap "ImportWithPackageImport" 4 $ (@=?) [] + , inlayHintsTestWithoutCap "ImportWithPackageImport" 5 $ (@=?) [] + ]]] -- code action tests @@ -252,6 +272,19 @@ mkInlayHint pos label textEdit = , _data_ = Nothing } +mkInlayHintNoTextEdit :: Position -> Text -> InlayHint +mkInlayHintNoTextEdit pos label = + InlayHint + { _position = pos + , _label = InL label + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + -- Execute command and wait for result executeCmd :: Command -> Session () executeCmd cmd = do diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ImportUsual.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ImportUsual.hs new file mode 100644 index 0000000000..2355265c16 --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ImportUsual.hs @@ -0,0 +1,15 @@ +module ImportUsual where + +import Data.List (intersperse) +import qualified Data.Map as Map +import ExplicitA ( a1, a2 ) + +ordinaryMap :: Map.Map String String +ordinaryMap = Map.fromList [(a1, a2)] + +main :: IO () +main = + putStrLn (concat (intersperse " " ["hello", "world", name, "!"])) + where + name = + Map.findWithDefault "default" a1 ordinaryMap diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ImportWithPackageImport.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ImportWithPackageImport.hs new file mode 100644 index 0000000000..fdb080b316 --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ImportWithPackageImport.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE PackageImports #-} +module ImportWithPackageImport where + +import "base" Data.List (intersperse) +import qualified Data.Map as Map +import ExplicitA ( a1, a2 ) + +ordinaryMap :: Map.Map String String +ordinaryMap = Map.fromList [(a1, a2)] + +main :: IO () +main = + putStrLn (concat (intersperse " " ["hello", "world", name, "!"])) + where + name = + Map.findWithDefault "default" a1 ordinaryMap From 20be97d79b36240c550eba34320bd4429872b677 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sun, 2 Mar 2025 17:37:13 +0100 Subject: [PATCH 6/9] Cleanup whitespaces --- .../src/Ide/Plugin/ExplicitImports.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 9cccdf1bbb..17e7a79014 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -301,14 +301,11 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo annToPosition ann = case importDeclAnnQualified ann of Just loc -> (srcSpanToPosition $ getHasLoc loc) _ -> (srcSpanToPosition $ getHasLoc $ importDeclAnnImport ann) - in hsImports & filter (\(L _ importDecl) -> not $ isPackageImport importDecl) & map (\(L _ importDecl) -> (annToPosition $ anns $ ideclAnn $ ideclExt importDecl, unLoc $ ideclName importDecl)) - - -- |For explicit imports: If there are any implicit imports, provide both one -- code action per import to make that specific import explicit, and one code -- action to turn them all into explicit imports. For refine imports: If there From 8f7313288f4b4d9da167ab35362a37ba7933802d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sun, 2 Mar 2025 20:14:25 +0100 Subject: [PATCH 7/9] Display hint after when using ImportQualifiedPost --- .../src/Ide/Plugin/ExplicitImports.hs | 19 ++++--- .../hls-explicit-imports-plugin/test/Main.hs | 50 ++++++++++++------- .../test/testdata/ImportWithQualifiedPost.hs | 16 ++++++ 3 files changed, 62 insertions(+), 23 deletions(-) create mode 100644 plugins/hls-explicit-imports-plugin/test/testdata/ImportWithQualifiedPost.hs diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 17e7a79014..b1ddced290 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -292,19 +292,26 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo isPackageImport ImportDecl{ideclPkgQual = NoRawPkgQual} = False isPackageImport _ = True - (L _ hsImports) = hsmodImports <$> pm_parsed_source parsedModule + L _ hsImports = hsmodImports <$> pm_parsed_source parsedModule srcSpanToPosition :: SrcSpan -> Position srcSpanToPosition srcSpan = (realSrcSpanToRange . realSrcSpan $ srcSpan) ^. L.end - annToPosition :: EpAnnImportDecl -> Position - annToPosition ann = case importDeclAnnQualified ann of - Just loc -> (srcSpanToPosition $ getHasLoc loc) - _ -> (srcSpanToPosition $ getHasLoc $ importDeclAnnImport ann) + hintPosition :: ImportDecl GhcPs -> Position + hintPosition importDecl = + let importAnn = anns $ ideclAnn $ ideclExt importDecl + importPosition = srcSpanToPosition $ getHasLoc $ importDeclAnnImport $ importAnn + moduleNamePosition = srcSpanToPosition $ getHasLoc $ ideclName importDecl + maybeQualifiedPosition = srcSpanToPosition . getHasLoc <$> importDeclAnnQualified importAnn + in case maybeQualifiedPosition of + Just qualifiedPosition -> if qualifiedPosition < moduleNamePosition + then qualifiedPosition + else importPosition + Nothing -> importPosition in hsImports & filter (\(L _ importDecl) -> not $ isPackageImport importDecl) & map (\(L _ importDecl) -> - (annToPosition $ anns $ ideclAnn $ ideclExt importDecl, unLoc $ ideclName importDecl)) + (hintPosition importDecl, unLoc $ ideclName importDecl)) -- |For explicit imports: If there are any implicit imports, provide both one -- code action per import to make that specific import explicit, and one code diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 2f1470bb5b..d749c49af5 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -111,23 +111,39 @@ main = defaultTestRunner $ testGroup "import-actions" testGroup "Import package inlay hints" [ testGroup "Without package imports" - [ inlayHintsTestWithCap "ImportUsual" 2 $ (@=?) - [mkInlayHintNoTextEdit (Position 2 6) "\"base\""] - , inlayHintsTestWithCap "ImportUsual" 3 $ (@=?) - [mkInlayHintNoTextEdit (Position 3 16) "\"containers\""] - , inlayHintsTestWithCap "ImportUsual" 4 $ (@=?) [] - , inlayHintsTestWithoutCap "ImportUsual" 2 $ (@=?) [] - , inlayHintsTestWithoutCap "ImportUsual" 3 $ (@=?) [] - , inlayHintsTestWithoutCap "ImportUsual" 4 $ (@=?) [] - ], testGroup "With package imports" - [ inlayHintsTestWithCap "ImportWithPackageImport" 3 $ (@=?) [] - , inlayHintsTestWithCap "ImportWithPackageImport" 4 $ (@=?) - [mkInlayHintNoTextEdit (Position 4 16) "\"containers\""] - , inlayHintsTestWithCap "ImportWithPackageImport" 5 $ (@=?) [] - , inlayHintsTestWithoutCap "ImportWithPackageImport" 3 $ (@=?) [] - , inlayHintsTestWithoutCap "ImportWithPackageImport" 4 $ (@=?) [] - , inlayHintsTestWithoutCap "ImportWithPackageImport" 5 $ (@=?) [] - ]]] + (let testWithCap = inlayHintsTestWithCap "ImportUsual" + testWithoutCap = inlayHintsTestWithoutCap "ImportUsual" + in + [ testWithCap 2 $ (@=?) [mkInlayHintNoTextEdit (Position 2 6) "\"base\""] + , testWithCap 3 $ (@=?) [mkInlayHintNoTextEdit (Position 3 16) "\"containers\""] + , testWithCap 4 $ (@=?) [] + , testWithoutCap 2 $ (@=?) [] + , testWithoutCap 3 $ (@=?) [] + , testWithoutCap 4 $ (@=?) [] + ]) + , testGroup "With package imports" + (let testWithCap = inlayHintsTestWithCap "ImportWithPackageImport" + testWithoutCap = inlayHintsTestWithoutCap "ImportWithPackageImport" + in + [ testWithCap 3 $ (@=?) [] + , testWithCap 4 $ (@=?) [mkInlayHintNoTextEdit (Position 4 16) "\"containers\""] + , testWithCap 5 $ (@=?) [] + , testWithoutCap 3 $ (@=?) [] + , testWithoutCap 4 $ (@=?) [] + , testWithoutCap 5 $ (@=?) [] + ]) + , testGroup "When using ImportQualifiedPost" + (let testWithCap = inlayHintsTestWithCap "ImportWithQualifiedPost" + testWithoutCap = inlayHintsTestWithoutCap "ImportWithQualifiedPost" + in + [ testWithCap 3 $ (@=?) [mkInlayHintNoTextEdit (Position 3 6) "\"base\""] + , testWithCap 4 $ (@=?) [mkInlayHintNoTextEdit (Position 4 6) "\"containers\""] + , testWithCap 5 $ (@=?) [] + , testWithoutCap 3 $ (@=?) [] + , testWithoutCap 4 $ (@=?) [] + , testWithoutCap 5 $ (@=?) [] + ]) + ]] -- code action tests diff --git a/plugins/hls-explicit-imports-plugin/test/testdata/ImportWithQualifiedPost.hs b/plugins/hls-explicit-imports-plugin/test/testdata/ImportWithQualifiedPost.hs new file mode 100644 index 0000000000..4def627d0f --- /dev/null +++ b/plugins/hls-explicit-imports-plugin/test/testdata/ImportWithQualifiedPost.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE ImportQualifiedPost #-} +module ImportWithQualifiedPost where + +import Data.List (intersperse) +import Data.Map qualified as Map +import ExplicitA ( a1, a2 ) + +ordinaryMap :: Map.Map String String +ordinaryMap = Map.fromList [(a1, a2)] + +main :: IO () +main = + putStrLn (concat (intersperse " " ["hello", "world", name, "!"])) + where + name = + Map.findWithDefault "default" a1 ordinaryMap From be67eed210f480e31e0706abd9ad17b492b5f934 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sun, 2 Mar 2025 20:29:27 +0100 Subject: [PATCH 8/9] Fix compatibility issues: obtaining Position from RealSrcSpan --- .../src/Ide/Plugin/ExplicitImports.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index b1ddced290..d32f6e3ed7 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -50,7 +50,7 @@ import Development.IDE.GHC.Compat hiding ((<+>)) import Development.IDE.Graph.Classes import GHC.Generics (Generic) import GHC.Parser.Annotation (EpAnn (anns), - HasLoc (getHasLoc), + epaLocationRealSrcSpan, realSrcSpan) import GHC.Types.PkgQual (RawPkgQual (NoRawPkgQual)) import Ide.Plugin.Error (PluginError (..), @@ -294,15 +294,15 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo L _ hsImports = hsmodImports <$> pm_parsed_source parsedModule - srcSpanToPosition :: SrcSpan -> Position - srcSpanToPosition srcSpan = (realSrcSpanToRange . realSrcSpan $ srcSpan) ^. L.end + realSrcSpanToEndPosition :: RealSrcSpan -> Position + realSrcSpanToEndPosition realSrcSpan = realSrcSpanToRange realSrcSpan ^. L.end hintPosition :: ImportDecl GhcPs -> Position hintPosition importDecl = let importAnn = anns $ ideclAnn $ ideclExt importDecl - importPosition = srcSpanToPosition $ getHasLoc $ importDeclAnnImport $ importAnn - moduleNamePosition = srcSpanToPosition $ getHasLoc $ ideclName importDecl - maybeQualifiedPosition = srcSpanToPosition . getHasLoc <$> importDeclAnnQualified importAnn + importPosition = realSrcSpanToEndPosition . epaLocationRealSrcSpan $ importDeclAnnImport importAnn + moduleNamePosition = realSrcSpanToEndPosition $ realSrcSpan $ getLoc $ ideclName importDecl + maybeQualifiedPosition = realSrcSpanToEndPosition . epaLocationRealSrcSpan <$> importDeclAnnQualified importAnn in case maybeQualifiedPosition of Just qualifiedPosition -> if qualifiedPosition < moduleNamePosition then qualifiedPosition From 3ab746dce03f618a6b584c97fbc2a7a9dc03af72 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Sun, 2 Mar 2025 21:36:16 +0100 Subject: [PATCH 9/9] Fix compatibility issue: Obtaining from --- .../src/Ide/Plugin/ExplicitImports.hs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index d32f6e3ed7..4c497507d8 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -297,9 +297,16 @@ importPackageInlayHintProvider _ state _ InlayHintParams {_textDocument = TextDo realSrcSpanToEndPosition :: RealSrcSpan -> Position realSrcSpanToEndPosition realSrcSpan = realSrcSpanToRange realSrcSpan ^. L.end + importAnnotation :: ImportDecl GhcPs -> EpAnnImportDecl +#if MIN_VERSION_ghc(9,5,0) + importAnnotation = anns . ideclAnn . ideclExt +#else + importAnnotation = anns . ideclExt +#endif + hintPosition :: ImportDecl GhcPs -> Position hintPosition importDecl = - let importAnn = anns $ ideclAnn $ ideclExt importDecl + let importAnn = importAnnotation importDecl importPosition = realSrcSpanToEndPosition . epaLocationRealSrcSpan $ importDeclAnnImport importAnn moduleNamePosition = realSrcSpanToEndPosition $ realSrcSpan $ getLoc $ ideclName importDecl maybeQualifiedPosition = realSrcSpanToEndPosition . epaLocationRealSrcSpan <$> importDeclAnnQualified importAnn