diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 24c1b0c376..4fee92c309 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -63,19 +63,20 @@ parsePlugins (IdePlugins plugins) = A.withObject "Config.plugins" $ \o -> do -- --------------------------------------------------------------------- parsePluginConfig :: PluginConfig -> Value -> A.Parser PluginConfig -parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig +parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig <$> o .:? "globalOn" .!= plcGlobalOn def <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def - <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def <*> o .:? "codeLensOn" .!= plcCodeLensOn def + <*> o .:? "inlayHintsOn" .!= plcInlayHintsOn def <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ <*> o .:? "hoverOn" .!= plcHoverOn def <*> o .:? "symbolsOn" .!= plcSymbolsOn def <*> o .:? "completionOn" .!= plcCompletionOn def <*> o .:? "renameOn" .!= plcRenameOn def <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def - <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def + <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def + <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs index 1dbc97a202..8ee6110d29 100644 --- a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs +++ b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs @@ -88,6 +88,7 @@ pluginsToDefaultConfig IdePlugins {..} = handlersToGenericDefaultConfig PluginConfig{..} (IdeMethod m DSum.:=> _) = case m of SMethod_TextDocumentCodeAction -> ["codeActionsOn" A..= plcCodeActionsOn] SMethod_TextDocumentCodeLens -> ["codeLensOn" A..= plcCodeLensOn] + SMethod_TextDocumentInlayHint -> ["inlayHintsOn" A..= plcInlayHintsOn] SMethod_TextDocumentRename -> ["renameOn" A..= plcRenameOn] SMethod_TextDocumentHover -> ["hoverOn" A..= plcHoverOn] SMethod_TextDocumentDocumentSymbol -> ["symbolsOn" A..= plcSymbolsOn] @@ -120,6 +121,7 @@ pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlug handlersToGenericSchema PluginConfig{..} (IdeMethod m DSum.:=> _) = case m of SMethod_TextDocumentCodeAction -> [toKey' "codeActionsOn" A..= schemaEntry "code actions" plcCodeActionsOn] SMethod_TextDocumentCodeLens -> [toKey' "codeLensOn" A..= schemaEntry "code lenses" plcCodeLensOn] + SMethod_TextDocumentInlayHint -> [toKey' "inlayHintsOn" A..= schemaEntry "inlay hints" plcInlayHintsOn] SMethod_TextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename" plcRenameOn] SMethod_TextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover" plcHoverOn] SMethod_TextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols" plcSymbolsOn] diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index f786b6aac9..fac6cd6b6b 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -260,6 +260,7 @@ data PluginConfig = , plcCallHierarchyOn :: !Bool , plcCodeActionsOn :: !Bool , plcCodeLensOn :: !Bool + , plcInlayHintsOn :: !Bool , plcDiagnosticsOn :: !Bool , plcHoverOn :: !Bool , plcSymbolsOn :: !Bool @@ -277,6 +278,7 @@ instance Default PluginConfig where , plcCallHierarchyOn = True , plcCodeActionsOn = True , plcCodeLensOn = True + , plcInlayHintsOn = True , plcDiagnosticsOn = True , plcHoverOn = True , plcSymbolsOn = True @@ -289,12 +291,13 @@ instance Default PluginConfig where } instance ToJSON PluginConfig where - toJSON (PluginConfig g ch ca cl d h s c rn sr fr st cfg) = r + toJSON (PluginConfig g ch ca ih cl d h s c rn sr fr st cfg) = r where r = object [ "globalOn" .= g , "callHierarchyOn" .= ch , "codeActionsOn" .= ca , "codeLensOn" .= cl + , "inlayHintsOn" .= ih , "diagnosticsOn" .= d , "hoverOn" .= h , "symbolsOn" .= s @@ -511,6 +514,12 @@ instance PluginMethod Request Method_WorkspaceSymbol where -- Unconditionally enabled, but should it really be? handlesRequest _ _ _ _ = HandlesRequest +instance PluginMethod Request Method_TextDocumentInlayHint where + handlesRequest = pluginEnabledWithFeature plcInlayHintsOn + +instance PluginMethod Request Method_InlayHintResolve where + handlesRequest = pluginEnabledResolve plcInlayHintsOn + instance PluginMethod Request Method_TextDocumentCodeLens where handlesRequest = pluginEnabledWithFeature plcCodeLensOn @@ -810,6 +819,9 @@ instance PluginRequestMethod Method_TextDocumentSemanticTokensFull where instance PluginRequestMethod Method_TextDocumentSemanticTokensFullDelta where combineResponses _ _ _ _ (x :| _) = x +instance PluginRequestMethod Method_TextDocumentInlayHint where + combineResponses _ _ _ _ x = sconcat x + takeLefts :: [a |? b] -> [a] takeLefts = mapMaybe (\x -> [res | (InL res) <- Just x]) diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index eaba6c595b..d0621ebe3a 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -7,6 +7,7 @@ module Test.Hls.Util ( -- * Test Capabilities codeActionResolveCaps , codeActionNoResolveCaps + , codeActionNoInlayHintsCaps , codeActionSupportCaps , expectCodeAction -- * Environment specifications @@ -107,6 +108,12 @@ codeActionNoResolveCaps :: ClientCapabilities codeActionNoResolveCaps = Test.fullLatestClientCaps & (L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport) .~ Nothing & (L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just) .~ False + +codeActionNoInlayHintsCaps :: ClientCapabilities +codeActionNoInlayHintsCaps = Test.fullLatestClientCaps + & (L.textDocument . _Just . L.codeAction . _Just . L.resolveSupport) .~ Nothing + & (L.textDocument . _Just . L.codeAction . _Just . L.dataSupport . _Just) .~ False + & (L.textDocument . _Just . L.inlayHint) .~ Nothing -- --------------------------------------------------------------------- -- Environment specification for ignoring tests -- --------------------------------------------------------------------- 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 f4ac94e1f9..611c02fc78 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -6,15 +6,17 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} + module Ide.Plugin.ExplicitImports ( descriptor , descriptorForModules , abbreviateImportTitle + , abbreviateImportTitleWithoutModule , Log(..) ) where import Control.DeepSeq -import Control.Lens ((&), (?~)) +import Control.Lens (_Just, (&), (?~), (^?)) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) @@ -22,14 +24,19 @@ import Control.Monad.Trans.Except (ExceptT) import Control.Monad.Trans.Maybe import qualified Data.Aeson as A (ToJSON (toJSON)) import Data.Aeson.Types (FromJSON) +import Data.Char (isSpace) +import Data.Functor ((<&>)) import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) import Data.IORef (readIORef) +import Data.List (singleton) import qualified Data.Map.Strict as Map -import Data.Maybe (isNothing, mapMaybe) +import Data.Maybe (isJust, isNothing, + mapMaybe) import qualified Data.Set as S import Data.String (fromString) import qualified Data.Text as T +import qualified Data.Text as Text import Data.Traversable (for) import qualified Data.Unique as U (hashUnique, newUnique) @@ -44,11 +51,14 @@ import GHC.Generics (Generic) import Ide.Plugin.Error (PluginError (..), getNormalizedFilePathE, handleMaybe) -import Ide.Plugin.RangeMap (filterByRange) -import qualified Ide.Plugin.RangeMap as RM (RangeMap, fromList) +import qualified Ide.Plugin.RangeMap as RM (RangeMap, + filterByRange, + fromList) import Ide.Plugin.Resolve import Ide.PluginUtils import Ide.Types +import Language.LSP.Protocol.Lens (HasInlayHint (inlayHint), + HasTextDocument (textDocument)) import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types @@ -97,17 +107,23 @@ descriptorForModules recorder modFilter plId = -- This plugin provides code lenses mkPluginHandler SMethod_TextDocumentCodeLens (lensProvider recorder) <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder) - -- This plugin provides code actions + -- This plugin provides inlay hints + <> mkPluginHandler SMethod_TextDocumentInlayHint (inlayHintProvider recorder) + -- This plugin provides code actions <> codeActionHandlers - } +isInlayHintsSupported :: IdeState -> Bool +isInlayHintsSupported ideState = + let clientCaps = Shake.clientCapabilities $ shakeExtras ideState + in isJust $ clientCaps ^? textDocument . _Just . inlayHint . _Just + -- | The actual command handler runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData runImportCommand recorder ideState _ eird@(ResolveOne _ _) = do wedit <- resolveWTextEdit ideState eird _ <- lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) logErrors - return $ InR Null + return $ InR Null where logErrors (Left re) = do logWith recorder Error (LogWAEResponseError re) pure () @@ -129,12 +145,18 @@ runImportCommand _ _ _ rd = do -- the provider should produce one code lens associated to the import statement: -- > Refine imports to import Control.Monad.IO.Class (liftIO) lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens -lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do +lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do nfp <- getNormalizedFilePathE _uri (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp let lens = [ generateLens _uri newRange int - | (range, int) <- forLens - , Just newRange <- [toCurrentRange pm range]] + -- provide ExplicitImport only if the client does not support inlay hints + | not (isInlayHintsSupported state) + , (range, (int, ExplicitImport)) <- forLens + , Just newRange <- [toCurrentRange pm range]] <> + -- RefineImport is always provided because inlay hints cannot + [ generateLens _uri newRange int + | (range, (int, RefineImport)) <- forLens + , Just newRange <- [toCurrentRange pm range]] pure $ InL lens where -- because these are non resolved lenses we only need the range and a -- unique id to later resolve them with. These are for both refine @@ -145,12 +167,13 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier { , _range = range , _command = Nothing } + lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do nfp <- getNormalizedFilePathE uri (ImportActionsResult{forResolve}, _) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp target <- handleMaybe PluginStaleResolve $ forResolve IM.!? uid - let updatedCodeLens = cl & L.command ?~ mkCommand plId target + let updatedCodeLens = cl & L.command ?~ mkCommand plId target pure updatedCodeLens where mkCommand :: PluginId -> ImportEdit -> Command mkCommand pId (ImportEdit{ieResType, ieText}) = @@ -165,6 +188,53 @@ lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do lensResolveProvider _ _ _ _ _ rd = do throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for lens resolve handler: " <> show rd) + +-- | Provide explicit imports in inlay hints. +-- Applying textEdits can make the import explicit. +-- There is currently no need to resolve inlay hints, +-- as no tooltips or commands are provided in the label. +inlayHintProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint +inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}, _range = visibleRange} = + if isInlayHintsSupported state + then do + nfp <- getNormalizedFilePathE _uri + (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let inlayHints = [ inlayHint + | (range, (int, _)) <- forLens + , Just newRange <- [toCurrentRange pm range] + , isSubrangeOf newRange visibleRange + , Just ie <- [forResolve IM.!? int] + , Just inlayHint <- [generateInlayHints newRange ie pm]] + pure $ InL inlayHints + -- When the client does not support inlay hints, fallback to the code lens, + -- so there is nothing to response here. + -- `[]` is no different from `null`, we chose to use all `[]` to indicate "no information" + else pure $ InL [] + where + -- The appropriate and intended position for the hint hints to begin + -- is the end of the range for the code lens. + -- import Data.Char (isSpace) + -- |--- range ----|-- IH ---| + -- |^-_paddingLeft + -- ^-_position + generateInlayHints :: Range -> ImportEdit -> PositionMapping -> Maybe InlayHint + generateInlayHints (Range _ end) ie pm = mkLabel ie <&> \label -> + InlayHint { _position = end + , _label = InL label + , _kind = Nothing -- neither a type nor a parameter + , _textEdits = fmap singleton $ toTEdit pm ie + , _tooltip = Just $ InL "Make this import explicit" -- simple enough, no need to resolve + , _paddingLeft = Just True -- show an extra space before the inlay hint + , _paddingRight = Nothing + , _data_ = Nothing + } + mkLabel :: ImportEdit -> Maybe T.Text + mkLabel (ImportEdit{ieResType, ieText}) = + let title ExplicitImport = Just $ abbreviateImportTitleWithoutModule ieText + title RefineImport = Nothing -- does not provide imports statements that can be refined via inlay hints + in title ieResType + + -- |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 @@ -175,7 +245,7 @@ codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier nfp <- getNormalizedFilePathE _uri (ImportActionsResult{forCodeActions}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp newRange <- toCurrentRangeE pm range - let relevantCodeActions = filterByRange newRange forCodeActions + let relevantCodeActions = RM.filterByRange newRange forCodeActions allExplicit = [InR $ mkCodeAction "Make all imports explicit" (Just $ A.toJSON $ ExplicitAll _uri) -- We should only provide this code action if there are any code @@ -231,12 +301,14 @@ resolveWTextEdit ideState (RefineAll uri) = do pure $ mkWorkspaceEdit uri edits pm mkWorkspaceEdit :: Uri -> [ImportEdit] -> PositionMapping -> WorkspaceEdit mkWorkspaceEdit uri edits pm = - WorkspaceEdit {_changes = Just $ Map.singleton uri (mapMaybe toWEdit edits) + WorkspaceEdit {_changes = Just $ Map.singleton uri (mapMaybe (toTEdit pm) edits) , _documentChanges = Nothing , _changeAnnotations = Nothing} - where toWEdit ImportEdit{ieRange, ieText} = - let newRange = toCurrentRange pm ieRange - in (\r -> TextEdit r ieText) <$> newRange + +toTEdit :: PositionMapping -> ImportEdit -> Maybe TextEdit +toTEdit pm ImportEdit{ieRange, ieText} = + let newRange = toCurrentRange pm ieRange + in (\r -> TextEdit r ieText) <$> newRange data ImportActions = ImportActions deriving (Show, Generic, Eq, Ord) @@ -254,7 +326,7 @@ data ImportActionsResult = ImportActionsResult { -- |For providing the code lenses we need to have a range, and a unique id -- that is later resolved to the new text for each import. It is stored in -- a list, because we always need to provide all the code lens in a file. - forLens :: [(Range, Int)] + forLens :: [(Range, (Int, ResultType))] -- |For the code actions we have the same data as for the code lenses, but -- we store it in a RangeMap, because that allows us to filter on a specific -- range with better performance, and code actions are almost always only @@ -346,7 +418,7 @@ minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogSha pure (u, rt) let rangeAndUnique = [ ImportAction r u rt | (u, (r, (_, rt))) <- uniqueAndRangeAndText ] pure ImportActionsResult - { forLens = (\ImportAction{..} -> (iaRange, iaUniqueId)) <$> rangeAndUnique + { forLens = (\ImportAction{..} -> (iaRange, (iaUniqueId, iaResType))) <$> rangeAndUnique , forCodeActions = RM.fromList iaRange rangeAndUnique , forResolve = IM.fromList ((\(u, (r, (te, ty))) -> (u, ImportEdit r te ty)) <$> uniqueAndRangeAndText) } @@ -413,8 +485,6 @@ isExplicitImport _ = False maxColumns :: Int maxColumns = 120 - --- | The title of the command is ideally the minimal explicit import decl, but -- we don't want to create a really massive code lens (and the decl can be extremely large!). -- So we abbreviate it to fit a max column size, and indicate how many more items are in the list -- after the abbreviation @@ -422,7 +492,8 @@ abbreviateImportTitle :: T.Text -> T.Text abbreviateImportTitle input = let -- For starters, we only want one line in the title - oneLineText = T.unwords $ T.lines input + -- we also need to compress multiple spaces into one + oneLineText = T.unwords $ filter (not . T.null) $ T.split isSpace input -- Now, split at the max columns, leaving space for the summary text we're going to add -- (conservatively assuming we won't need to print a number larger than 100) (prefix, suffix) = T.splitAt (maxColumns - T.length (summaryText 100)) oneLineText @@ -447,6 +518,11 @@ abbreviateImportTitle input = else actualPrefix <> suffixText in title +-- Create an import abbreviate title without module for inlay hints +abbreviateImportTitleWithoutModule :: Text.Text -> Text.Text +abbreviateImportTitleWithoutModule = abbreviateImportTitle . T.dropWhile (/= '(') + +-- | The title of the command is ideally the minimal explicit import decl, but -------------------------------------------------------------------------------- @@ -465,7 +541,6 @@ filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)}) else Nothing where importedNames = S.fromList $ map (ieName . unLoc) names res = Map.filter (any (any (`S.member` importedNames) . getAvailNames)) avails - allFilteredAvailsNames = S.fromList $ concatMap getAvailNames $ mconcat diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 0fd94a807c..440010bad2 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -26,18 +26,33 @@ main = defaultTestRunner $ testGroup "import-actions" [testGroup "Refine Imports" [ codeActionGoldenTest "RefineWithOverride" 3 1 - , codeLensGoldenTest isRefineImports "RefineUsualCase" 1 - , codeLensGoldenTest isRefineImports "RefineQualified" 0 - , codeLensGoldenTest isRefineImports "RefineQualifiedExplicit" 0 + -- Although the client has inlay hints caps, refine is always provided by the code lens + , codeLensGoldenTest codeActionNoResolveCaps isRefineImports "RefineUsualCase" 1 + , codeLensGoldenTest codeActionNoResolveCaps isRefineImports "RefineQualified" 0 + , codeLensGoldenTest codeActionNoResolveCaps isRefineImports "RefineQualifiedExplicit" 0 ], testGroup "Make imports explicit" [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0 , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0 + , inlayHintsTestWithCap "ExplicitUsualCase" 2 $ (@=?) + [mkInlayHint (Position 2 16) "( a1 )" + (TextEdit (Range (Position 2 0) (Position 2 16)) "import ExplicitA ( a1 )")] + , inlayHintsTestWithoutCap "ExplicitUsualCase" 2 $ (@=?) [] , codeActionOnlyGoldenTest "ExplicitOnlyThis" 3 0 , codeActionOnlyResolveGoldenTest "ExplicitOnlyThis" 3 0 - , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0 + , inlayHintsTestWithCap "ExplicitOnlyThis" 3 $ (@=?) + [mkInlayHint (Position 3 16) "( b1 )" + (TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitB ( b1 )")] + , inlayHintsTestWithoutCap "ExplicitOnlyThis" 3 $ (@=?) [] + -- Only when the client does not support inlay hints, explicit will be provided by code lens + , codeLensGoldenTest codeActionNoInlayHintsCaps notRefineImports "ExplicitUsualCase" 0 + , expectFail $ codeLensGoldenTest codeActionNoResolveCaps notRefineImports "ExplicitUsualCase" 0 , codeActionBreakFile "ExplicitBreakFile" 4 0 + , inlayHintsTestWithCap "ExplicitBreakFile" 3 $ (@=?) + [mkInlayHint (Position 3 16) "( a1 )" + (TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitA ( a1 )")] + , inlayHintsTestWithoutCap "ExplicitBreakFile" 3 $ (@=?) [] , codeActionStaleAction "ExplicitStaleAction" 4 0 , testCase "No CodeAction when exported" $ runSessionWithServer def explicitImportsPlugin testDataDir $ do @@ -49,6 +64,11 @@ main = defaultTestRunner $ testGroup "import-actions" doc <- openDoc "ExplicitExported.hs" "haskell" lenses <- getCodeLenses doc liftIO $ lenses @?= [] + , testCase "No InlayHints when exported" $ + runSessionWithServer def explicitImportsPlugin testDataDir $ do + doc <- openDoc "ExplicitExported.hs" "haskell" + inlayHints <- getInlayHints doc (pointRange 3 0) + liftIO $ inlayHints @?= [] , testGroup "Title abbreviation" [ testCase "not abbreviated" $ let i = "import " <> T.replicate 70 "F" <> " (Athing, Bthing, Cthing)" @@ -72,6 +92,20 @@ main = defaultTestRunner $ testGroup "import-actions" o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))" in ExplicitImports.abbreviateImportTitle i @?= o ] + , testGroup "Title abbreviation without module" + [ testCase "not abbreviated" $ + let i = "import M (" <> T.replicate 70 "F" <> ", Athing, Bthing, Cthing)" + o = "(FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF, Athing, Bthing, Cthing)" + in ExplicitImports.abbreviateImportTitleWithoutModule i @?= o + , testCase "abbreviated that drop module name" $ + let i = "import " <> T.replicate 120 "F" <> " (Athing, Bthing, Cthing)" + o = "(Athing, Bthing, Cthing)" + in ExplicitImports.abbreviateImportTitleWithoutModule i @?= o + , testCase "abbreviated in import list" $ + let i = "import M (Athing, Bthing, " <> T.replicate 100 "F" <> ", Cthing, Dthing, Ething)" + o = "(Athing, Bthing, ... (4 items))" + in ExplicitImports.abbreviateImportTitleWithoutModule i @?= o + ] ]] -- code action tests @@ -84,7 +118,9 @@ codeActionAllGoldenTest fp l c = goldenWithImportActions " code action" fp codeA _ -> liftIO $ assertFailure "Unable to find CodeAction" codeActionBreakFile :: FilePath -> Int -> Int -> TestTree -codeActionBreakFile fp l c = goldenWithImportActions " code action" fp codeActionNoResolveCaps $ \doc -> do +-- If use `codeActionNoResolveCaps` instead of `codeActionNoInlayHintsCaps` here, +-- we will get a puzzling error: https://github.com/haskell/haskell-language-server/pull/4235#issuecomment-2189048997 +codeActionBreakFile fp l c = goldenWithImportActions " code action" fp codeActionNoInlayHintsCaps $ \doc -> do _ <- getCodeLenses doc changeDoc doc [edit] actions <- getCodeActions doc (pointRange l c) @@ -150,8 +186,8 @@ caTitle _ = Nothing -- code lens tests -codeLensGoldenTest :: (CodeLens -> Bool) -> FilePath -> Int -> TestTree -codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoResolveCaps $ \doc -> do +codeLensGoldenTest :: ClientCapabilities -> (CodeLens -> Bool) -> FilePath -> Int -> TestTree +codeLensGoldenTest caps predicate fp i = goldenWithImportActions " code lens" fp caps $ \doc -> do codeLenses <- getCodeLenses doc resolvedCodeLenses <- for codeLenses resolveCodeLens (CodeLens {_command = Just c}) <- pure (filter predicate resolvedCodeLenses !! i) @@ -162,6 +198,42 @@ notRefineImports (CodeLens _ (Just (Command text _ _)) _) | "Refine imports to" `T.isPrefixOf` text = False notRefineImports _ = True +-- inlay hints tests + +inlayHintsTest :: ClientCapabilities -> String -> FilePath -> UInt -> ([InlayHint] -> Assertion) -> TestTree +inlayHintsTest configCaps postfix fp line assert = testCase (fp ++ postfix) $ run $ \_ -> do + doc <- openDoc (fp ++ ".hs") "haskell" + inlayHints <- getInlayHints doc (lineRange line) + liftIO $ assert inlayHints + where + -- zero-based position + lineRange line = Range (Position line 0) (Position line 1000) + run = runSessionWithTestConfig def + { testDirLocation = Left testDataDir + , testPluginDescriptor = explicitImportsPlugin + , testConfigCaps = configCaps + } + +inlayHintsTestWithCap :: FilePath -> UInt -> ([InlayHint] -> Assertion) -> TestTree +inlayHintsTestWithCap = inlayHintsTest fullLatestClientCaps " inlay hints with client caps" + +inlayHintsTestWithoutCap :: FilePath -> UInt -> ([InlayHint] -> Assertion) -> TestTree +inlayHintsTestWithoutCap = inlayHintsTest codeActionNoInlayHintsCaps " inlay hints without client caps" + + +mkInlayHint :: Position -> Text -> TextEdit -> InlayHint +mkInlayHint pos label textEdit = + InlayHint + { _position = pos + , _label = InL label + , _kind = Nothing + , _textEdits = Just [textEdit] + , _tooltip = Just $ InL "Make this import explicit" + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + -- Execute command and wait for result executeCmd :: Command -> Session () executeCmd cmd = do diff --git a/test/testdata/schema/ghc94/default-config.golden.json b/test/testdata/schema/ghc94/default-config.golden.json index 2859e3d720..2612bdba87 100644 --- a/test/testdata/schema/ghc94/default-config.golden.json +++ b/test/testdata/schema/ghc94/default-config.golden.json @@ -93,7 +93,8 @@ }, "importLens": { "codeActionsOn": true, - "codeLensOn": true + "codeLensOn": true, + "inlayHintsOn": true }, "moduleName": { "globalOn": true diff --git a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json index d113264901..03371d21e7 100644 --- a/test/testdata/schema/ghc94/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc94/vscode-extension-schema.golden.json @@ -213,6 +213,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.importLens.inlayHintsOn": { + "default": true, + "description": "Enables importLens inlay hints", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.moduleName.globalOn": { "default": true, "description": "Enables moduleName plugin", diff --git a/test/testdata/schema/ghc96/default-config.golden.json b/test/testdata/schema/ghc96/default-config.golden.json index 2859e3d720..2612bdba87 100644 --- a/test/testdata/schema/ghc96/default-config.golden.json +++ b/test/testdata/schema/ghc96/default-config.golden.json @@ -93,7 +93,8 @@ }, "importLens": { "codeActionsOn": true, - "codeLensOn": true + "codeLensOn": true, + "inlayHintsOn": true }, "moduleName": { "globalOn": true diff --git a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json index d113264901..03371d21e7 100644 --- a/test/testdata/schema/ghc96/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc96/vscode-extension-schema.golden.json @@ -213,6 +213,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.importLens.inlayHintsOn": { + "default": true, + "description": "Enables importLens inlay hints", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.moduleName.globalOn": { "default": true, "description": "Enables moduleName plugin", diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 2859e3d720..2612bdba87 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -93,7 +93,8 @@ }, "importLens": { "codeActionsOn": true, - "codeLensOn": true + "codeLensOn": true, + "inlayHintsOn": true }, "moduleName": { "globalOn": true diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index d113264901..03371d21e7 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -213,6 +213,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.importLens.inlayHintsOn": { + "default": true, + "description": "Enables importLens inlay hints", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.moduleName.globalOn": { "default": true, "description": "Enables moduleName plugin",