From 5ccbfbf0a68243ec3d603a83f9529bbbb7d52cd6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Wiktor=20Czy=C5=BC?= Date: Wed, 19 Feb 2025 02:12:04 +0100 Subject: [PATCH] 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..383d17155f 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) + mapMaybe, listToMaybe) 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