From b7da1f5700a28032bc1ecc2fc194e3951ac08d5c Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Thu, 16 May 2024 19:34:48 +0800 Subject: [PATCH 01/35] Provide explicit import in inlay hints --- hls-plugin-api/src/Ide/Types.hs | 12 +++++ .../src/Ide/Plugin/ExplicitImports.hs | 53 +++++++++++++++---- 2 files changed, 54 insertions(+), 11 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 5212b2c6da..3699e13d89 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -504,6 +504,12 @@ instance PluginMethod Request Method_WorkspaceSymbol where -- Unconditionally enabled, but should it really be? handlesRequest _ _ _ _ = HandlesRequest +instance PluginMethod Request Method_TextDocumentInlayHint where + handlesRequest _ _ _ _ = HandlesRequest + +instance PluginMethod Request Method_InlayHintResolve where + handlesRequest _ _ _ _ = HandlesRequest + instance PluginMethod Request Method_TextDocumentCodeLens where handlesRequest = pluginEnabledWithFeature plcCodeLensOn @@ -803,6 +809,12 @@ instance PluginRequestMethod Method_TextDocumentSemanticTokensFull where instance PluginRequestMethod Method_TextDocumentSemanticTokensFullDelta where combineResponses _ _ _ _ (x :| _) = x +instance PluginRequestMethod Method_TextDocumentInlayHint where + combineResponses _ _ _ _ (x :| _) = x + +instance PluginRequestMethod Method_InlayHintResolve where + combineResponses _ _ _ _ (x :| _) = x + takeLefts :: [a |? b] -> [a] takeLefts = mapMaybe (\x -> [res | (InL res) <- Just x]) 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 2c599b5b6b..9eaa213655 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -6,6 +6,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} + module Ide.Plugin.ExplicitImports ( descriptor , descriptorForModules @@ -22,6 +23,7 @@ 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 qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) import Data.IORef (readIORef) @@ -44,8 +46,9 @@ 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 @@ -98,9 +101,11 @@ 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) + -- <> mkResolveHandler SMethod_InlayHintResolve (inlayHintResolveProvider recorder) + -- This plugin provides code actions <> codeActionHandlers - } -- | The actual command handler @@ -146,12 +151,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}) = @@ -166,6 +172,35 @@ lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do lensResolveProvider _ _ _ _ _ rd = do throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for lens resolve handler: " <> show rd) + +inlayHintProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint +inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}} = do + nfp <- getNormalizedFilePathE _uri + (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let inlayHints = [ generateInlayHints newRange ie + | (range, int) <- forLens + , Just newRange <- [toCurrentRange pm range] + , Just ie <- [forResolve IM.!? int]] + pure $ InL inlayHints + where + generateInlayHints :: Range -> ImportEdit -> InlayHint + generateInlayHints Range {_end} ie = + InlayHint { _position = _end + , _label = mkLabel ie + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } + mkLabel :: ImportEdit -> T.Text |? [InlayHintLabelPart] + mkLabel (ImportEdit{ieResType, ieText}) = + let title ExplicitImport = abbreviateImportTitle $ (T.intercalate " " . filter (not . T.null) . T.split isSpace . T.dropWhile (/= '(')) ieText + title RefineImport = T.intercalate ", " (T.lines ieText) + in InL $ 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 @@ -176,7 +211,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 @@ -410,7 +445,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 @@ -462,10 +496,7 @@ filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)}) else Nothing where importedNames = S.fromList $ map (ieName . unLoc) names res = flip Map.filter avails $ \a -> - any (`S.member` importedNames) - $ concatMap - getAvailNames - a + any (any (`S.member` importedNames) . getAvailNames) a allFilteredAvailsNames = S.fromList $ concatMap getAvailNames $ mconcat From 3305973b76a3892da6bba64217ff65ce3527036f Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Fri, 14 Jun 2024 20:36:26 +0800 Subject: [PATCH 02/35] Filter explict imports inlay hints by visible range --- .../src/Ide/Plugin/ExplicitImports.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 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 9eaa213655..ef170adef8 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -11,6 +11,7 @@ module Ide.Plugin.ExplicitImports ( descriptor , descriptorForModules , abbreviateImportTitle + , squashedAbbreviateImportTitle , Log(..) ) where @@ -174,11 +175,12 @@ lensResolveProvider _ _ _ _ _ rd = do inlayHintProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint -inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}} = do +inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}, _range = visibleRange} = do nfp <- getNormalizedFilePathE _uri (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp let inlayHints = [ generateInlayHints newRange ie | (range, int) <- forLens + , range < visibleRange , Just newRange <- [toCurrentRange pm range] , Just ie <- [forResolve IM.!? int]] pure $ InL inlayHints @@ -194,10 +196,10 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , _paddingRight = Nothing , _data_ = Nothing } - mkLabel :: ImportEdit -> T.Text |? [InlayHintLabelPart] + mkLabel :: ImportEdit -> T.Text |? [InlayHintLabelPart] mkLabel (ImportEdit{ieResType, ieText}) = - let title ExplicitImport = abbreviateImportTitle $ (T.intercalate " " . filter (not . T.null) . T.split isSpace . T.dropWhile (/= '(')) ieText - title RefineImport = T.intercalate ", " (T.lines ieText) + let title ExplicitImport = squashedAbbreviateImportTitle ieText + title RefineImport = T.intercalate ", " (T.lines ieText) in InL $ title ieResType @@ -445,7 +447,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 @@ -478,6 +479,10 @@ abbreviateImportTitle input = else actualPrefix <> suffixText in title +squashedAbbreviateImportTitle :: T.Text -> T.Text +squashedAbbreviateImportTitle ieText = abbreviateImportTitle $ (T.intercalate " " . filter (not . T.null) . T.split isSpace . T.dropWhile (/= '(')) ieText + +-- | The title of the command is ideally the minimal explicit import decl, but -------------------------------------------------------------------------------- From 245049a58078d7271912a3e12aa16936e6028a11 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Fri, 14 Jun 2024 20:38:46 +0800 Subject: [PATCH 03/35] Update lsp dep by source-repository-package to writing test before new release of haskell/lsp. --- cabal.project | 18 ++++++++++++++++++ ghcide/ghcide.cabal | 2 +- haskell-language-server.cabal | 14 +++++++------- hls-plugin-api/hls-plugin-api.cabal | 2 +- 4 files changed, 27 insertions(+), 9 deletions(-) diff --git a/cabal.project b/cabal.project index d7339b4d80..2eb1371a74 100644 --- a/cabal.project +++ b/cabal.project @@ -16,6 +16,24 @@ benchmarks: True write-ghc-environment-files: never +source-repository-package + type: git + location: https://github.com/jetjinser/lsp + tag: e6d5c5d5b62d4ce4fbdf8cb41d2347507886dd0f + subdir: lsp-test + +source-repository-package + type: git + location: https://github.com/jetjinser/lsp + tag: e6d5c5d5b62d4ce4fbdf8cb41d2347507886dd0f + subdir: lsp + +source-repository-package + type: git + location: https://github.com/jetjinser/lsp + tag: e6d5c5d5b62d4ce4fbdf8cb41d2347507886dd0f + subdir: lsp-types + -- Many of our tests only work single-threaded, and the only way to -- ensure tasty runs everything purely single-threaded is to pass -- this at the top-level diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 0d70f31bb7..2b5be914d4 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -88,7 +88,7 @@ library , implicit-hie >= 0.1.4.0 && < 0.1.5 , lens , list-t - , lsp ^>=2.5.0.0 + , lsp ^>=2.6.0.0 , lsp-types ^>=2.2.0.0 , mtl , opentelemetry >=0.6.1 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 5f673caafe..92bcc694ab 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -258,7 +258,7 @@ library hls-cabal-plugin , hls-plugin-api == 2.8.0.0 , hls-graph == 2.8.0.0 , lens - , lsp ^>=2.5 + , lsp ^>=2.6 , lsp-types ^>=2.2 , regex-tdfa ^>=1.3.1 , text @@ -389,7 +389,7 @@ library hls-call-hierarchy-plugin , hiedb ^>= 0.6.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.5 + , lsp >=2.6 , sqlite-simple , text @@ -1002,7 +1002,7 @@ library hls-alternate-number-format-plugin , hls-graph , hls-plugin-api == 2.8.0.0 , lens - , lsp ^>=2.5 + , lsp ^>=2.6 , mtl , regex-tdfa , syb @@ -1232,7 +1232,7 @@ library hls-gadt-plugin , hls-plugin-api == 2.8.0.0 , haskell-language-server:hls-refactor-plugin , lens - , lsp >=2.5 + , lsp >=2.6 , mtl , text , transformers @@ -1281,7 +1281,7 @@ library hls-explicit-fixity-plugin , ghcide == 2.8.0.0 , hashable , hls-plugin-api == 2.8.0.0 - , lsp >=2.5 + , lsp >=2.6 , text default-extensions: DataKinds @@ -1736,7 +1736,7 @@ library hls-semantic-tokens-plugin , ghcide == 2.8.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.5 + , lsp >=2.6 , text , transformers , bytestring @@ -1804,7 +1804,7 @@ library hls-notes-plugin , hls-graph == 2.8.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.5 + , lsp >=2.6 , mtl >= 2.2 , regex-tdfa >= 1.3.1 , text diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index 4e8bb6742c..eef8a7038c 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -69,7 +69,7 @@ library , hls-graph == 2.8.0.0 , lens , lens-aeson - , lsp ^>=2.5 + , lsp ^>=2.6 , megaparsec >=9.0 , mtl , opentelemetry >=0.4 From 059813866f354fab7e4ff8d31b5857f542d81970 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Fri, 14 Jun 2024 20:40:41 +0800 Subject: [PATCH 04/35] Add test for hls-explicit-imports-plugin inlay hints --- .../hls-explicit-imports-plugin/test/Main.hs | 48 +++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 0fd94a807c..6ef8731e7c 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -34,10 +34,33 @@ main = defaultTestRunner $ testGroup "import-actions" "Make imports explicit" [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0 , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0 + , inlayHintsTest "ExplicitUsualCase" 3 0 $ (@=?) + [InlayHint + { _position = Position {_line = 2, _character = 16} + , _label = InL "( a1 )" + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + }] , codeActionOnlyGoldenTest "ExplicitOnlyThis" 3 0 , codeActionOnlyResolveGoldenTest "ExplicitOnlyThis" 3 0 + , inlayHintsTest "ExplicitOnlyThis" 3 0 $ (@?=) + [InlayHint + { _position = Position {_line = 2, _character = 16} + , _label = InL "( a1 )" + , _kind = Nothing + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + }] , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0 , codeActionBreakFile "ExplicitBreakFile" 4 0 + , inlayHintsTest "ExplicitBreakFile" 3 0 $ (@=?) [] , codeActionStaleAction "ExplicitStaleAction" 4 0 , testCase "No CodeAction when exported" $ runSessionWithServer def explicitImportsPlugin testDataDir $ do @@ -49,6 +72,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 +100,20 @@ main = defaultTestRunner $ testGroup "import-actions" o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))" in ExplicitImports.abbreviateImportTitle i @?= o ] + , testGroup "Title abbreviation squashed" + [ testCase "not abbreviated squashed" $ + let i = "import M (" <> T.replicate 70 "F" <> ", Athing, Bthing, Cthing)" + o = "(FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF, Athing, Bthing, Cthing)" + in ExplicitImports.squashedAbbreviateImportTitle i @?= o + , testCase "abbreviated squashed that drop module name" $ + let i = "import " <> T.replicate 120 "F" <> " (Athing, Bthing, Cthing)" + o = "(Athing, Bthing, Cthing)" + in ExplicitImports.squashedAbbreviateImportTitle i @?= o + , testCase "abbreviated squashed in import list" $ + let i = "import M (Athing, Bthing, " <> T.replicate 100 "F" <> ", Cthing, Dthing, Ething)" + o = "(Athing, Bthing, ... (4 items))" + in ExplicitImports.squashedAbbreviateImportTitle i @?= o + ] ]] -- code action tests @@ -162,6 +204,12 @@ notRefineImports (CodeLens _ (Just (Command text _ _)) _) | "Refine imports to" `T.isPrefixOf` text = False notRefineImports _ = True +inlayHintsTest :: FilePath -> Int -> Int -> ([InlayHint] -> Assertion) -> TestTree +inlayHintsTest fp l c assert = testCase (fp ++ " inlay hints") $ runSessionWithServer def explicitImportsPlugin testDataDir $ do + doc <- openDoc (fp ++ ".hs") "haskell" + inlayHints <- getInlayHints doc (pointRange l c) + liftIO $ assert inlayHints + -- Execute command and wait for result executeCmd :: Command -> Session () executeCmd cmd = do From a27c5c81e4102b9672cd85b9c13511f734f26dfd Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 17 Jun 2024 19:59:06 +0800 Subject: [PATCH 05/35] Comment inlay hints start position --- .../src/Ide/Plugin/ExplicitImports.hs | 6 ++++++ 1 file changed, 6 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 ef170adef8..bd2c94768a 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -185,6 +185,12 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , Just ie <- [forResolve IM.!? int]] pure $ InL inlayHints 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 ---| + -- |^-padding + -- ^-_position generateInlayHints :: Range -> ImportEdit -> InlayHint generateInlayHints Range {_end} ie = InlayHint { _position = _end From 6b3e5aaeb066346fc0b409eefef2d59e781ed8ee Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 17 Jun 2024 20:01:41 +0800 Subject: [PATCH 06/35] Use `isSubrangeOf` to test if the range is visible --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 bd2c94768a..12d96f6622 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -180,7 +180,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp let inlayHints = [ generateInlayHints newRange ie | (range, int) <- forLens - , range < visibleRange + , isSubrangeOf range visibleRange , Just newRange <- [toCurrentRange pm range] , Just ie <- [forResolve IM.!? int]] pure $ InL inlayHints From f9f12076c0e619b8c57f3d5adf9f36b689eed46c Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 17 Jun 2024 20:03:26 +0800 Subject: [PATCH 07/35] Remove inlayHintsResolveProvider placeholder for now --- .../src/Ide/Plugin/ExplicitImports.hs | 1 - 1 file changed, 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 12d96f6622..d51fbffb53 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -104,7 +104,6 @@ descriptorForModules recorder modFilter plId = <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder) -- This plugin provides inlay hints <> mkPluginHandler SMethod_TextDocumentInlayHint (inlayHintProvider recorder) - -- <> mkResolveHandler SMethod_InlayHintResolve (inlayHintResolveProvider recorder) -- This plugin provides code actions <> codeActionHandlers } From 8e2807652d7375cfe6afcfc2d8dc4b1487dbb1a5 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 17 Jun 2024 20:08:08 +0800 Subject: [PATCH 08/35] Use explicit InlayHintKind_Type --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 d51fbffb53..cac0fbec6e 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -194,7 +194,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif generateInlayHints Range {_end} ie = InlayHint { _position = _end , _label = mkLabel ie - , _kind = Nothing + , _kind = Just InlayHintKind_Type -- for type annotations , _textEdits = Nothing , _tooltip = Nothing , _paddingLeft = Just True From d0f27c28fd44da0278c8cba7fc2aac81489fed48 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 17 Jun 2024 20:16:08 +0800 Subject: [PATCH 09/35] Revert "Update lsp dep by source-repository-package" This reverts commit 245049a58078d7271912a3e12aa16936e6028a11. --- cabal.project | 18 ------------------ ghcide/ghcide.cabal | 2 +- haskell-language-server.cabal | 14 +++++++------- hls-plugin-api/hls-plugin-api.cabal | 2 +- 4 files changed, 9 insertions(+), 27 deletions(-) diff --git a/cabal.project b/cabal.project index 2eb1371a74..d7339b4d80 100644 --- a/cabal.project +++ b/cabal.project @@ -16,24 +16,6 @@ benchmarks: True write-ghc-environment-files: never -source-repository-package - type: git - location: https://github.com/jetjinser/lsp - tag: e6d5c5d5b62d4ce4fbdf8cb41d2347507886dd0f - subdir: lsp-test - -source-repository-package - type: git - location: https://github.com/jetjinser/lsp - tag: e6d5c5d5b62d4ce4fbdf8cb41d2347507886dd0f - subdir: lsp - -source-repository-package - type: git - location: https://github.com/jetjinser/lsp - tag: e6d5c5d5b62d4ce4fbdf8cb41d2347507886dd0f - subdir: lsp-types - -- Many of our tests only work single-threaded, and the only way to -- ensure tasty runs everything purely single-threaded is to pass -- this at the top-level diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 2b5be914d4..0d70f31bb7 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -88,7 +88,7 @@ library , implicit-hie >= 0.1.4.0 && < 0.1.5 , lens , list-t - , lsp ^>=2.6.0.0 + , lsp ^>=2.5.0.0 , lsp-types ^>=2.2.0.0 , mtl , opentelemetry >=0.6.1 diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 92bcc694ab..5f673caafe 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -258,7 +258,7 @@ library hls-cabal-plugin , hls-plugin-api == 2.8.0.0 , hls-graph == 2.8.0.0 , lens - , lsp ^>=2.6 + , lsp ^>=2.5 , lsp-types ^>=2.2 , regex-tdfa ^>=1.3.1 , text @@ -389,7 +389,7 @@ library hls-call-hierarchy-plugin , hiedb ^>= 0.6.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.6 + , lsp >=2.5 , sqlite-simple , text @@ -1002,7 +1002,7 @@ library hls-alternate-number-format-plugin , hls-graph , hls-plugin-api == 2.8.0.0 , lens - , lsp ^>=2.6 + , lsp ^>=2.5 , mtl , regex-tdfa , syb @@ -1232,7 +1232,7 @@ library hls-gadt-plugin , hls-plugin-api == 2.8.0.0 , haskell-language-server:hls-refactor-plugin , lens - , lsp >=2.6 + , lsp >=2.5 , mtl , text , transformers @@ -1281,7 +1281,7 @@ library hls-explicit-fixity-plugin , ghcide == 2.8.0.0 , hashable , hls-plugin-api == 2.8.0.0 - , lsp >=2.6 + , lsp >=2.5 , text default-extensions: DataKinds @@ -1736,7 +1736,7 @@ library hls-semantic-tokens-plugin , ghcide == 2.8.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.6 + , lsp >=2.5 , text , transformers , bytestring @@ -1804,7 +1804,7 @@ library hls-notes-plugin , hls-graph == 2.8.0.0 , hls-plugin-api == 2.8.0.0 , lens - , lsp >=2.6 + , lsp >=2.5 , mtl >= 2.2 , regex-tdfa >= 1.3.1 , text diff --git a/hls-plugin-api/hls-plugin-api.cabal b/hls-plugin-api/hls-plugin-api.cabal index eef8a7038c..4e8bb6742c 100644 --- a/hls-plugin-api/hls-plugin-api.cabal +++ b/hls-plugin-api/hls-plugin-api.cabal @@ -69,7 +69,7 @@ library , hls-graph == 2.8.0.0 , lens , lens-aeson - , lsp ^>=2.6 + , lsp ^>=2.5 , megaparsec >=9.0 , mtl , opentelemetry >=0.4 From 3e9d5a13ddfbc36f98a36b80f75780063ea1256c Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 17 Jun 2024 21:15:15 +0800 Subject: [PATCH 10/35] Combine InlayHints by sconcat them and remove `instance PluginRequestMethod Method_InlayHintResolve` since have not decide how to combine. --- hls-plugin-api/src/Ide/Types.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 3699e13d89..e7dfc06f75 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -810,10 +810,7 @@ instance PluginRequestMethod Method_TextDocumentSemanticTokensFullDelta where combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentInlayHint where - combineResponses _ _ _ _ (x :| _) = x - -instance PluginRequestMethod Method_InlayHintResolve where - combineResponses _ _ _ _ (x :| _) = x + combineResponses _ _ _ _ x = sconcat x takeLefts :: [a |? b] -> [a] takeLefts = mapMaybe (\x -> [res | (InL res) <- Just x]) From dbd7508467983bdb263e03de3da349bcf653d994 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 23 Jun 2024 00:03:35 +0800 Subject: [PATCH 11/35] compress multiple spaces in abbr import tilte --- .../src/Ide/Plugin/ExplicitImports.hs | 3 ++- 1 file changed, 2 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 1b7d46e128..05634cfb95 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -462,7 +462,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 From d0fe221ea1d555957f9e9c9e1bb7f317a1604603 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 23 Jun 2024 00:04:49 +0800 Subject: [PATCH 12/35] update test to match inlay hints kind --- .../hls-explicit-imports-plugin/test/Main.hs | 33 +++++++++++++------ 1 file changed, 23 insertions(+), 10 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 6ef8731e7c..12f6087f10 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -34,11 +34,11 @@ main = defaultTestRunner $ testGroup "import-actions" "Make imports explicit" [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0 , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0 - , inlayHintsTest "ExplicitUsualCase" 3 0 $ (@=?) + , inlayHintsTest "ExplicitUsualCase" 2 $ (@=?) [InlayHint { _position = Position {_line = 2, _character = 16} , _label = InL "( a1 )" - , _kind = Nothing + , _kind = Just InlayHintKind_Type , _textEdits = Nothing , _tooltip = Nothing , _paddingLeft = Just True @@ -47,11 +47,11 @@ main = defaultTestRunner $ testGroup "import-actions" }] , codeActionOnlyGoldenTest "ExplicitOnlyThis" 3 0 , codeActionOnlyResolveGoldenTest "ExplicitOnlyThis" 3 0 - , inlayHintsTest "ExplicitOnlyThis" 3 0 $ (@?=) + , inlayHintsTest "ExplicitOnlyThis" 3 $ (@=?) [InlayHint - { _position = Position {_line = 2, _character = 16} - , _label = InL "( a1 )" - , _kind = Nothing + { _position = Position {_line = 3, _character = 16} + , _label = InL "( b1 )" + , _kind = Just InlayHintKind_Type , _textEdits = Nothing , _tooltip = Nothing , _paddingLeft = Just True @@ -60,7 +60,17 @@ main = defaultTestRunner $ testGroup "import-actions" }] , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0 , codeActionBreakFile "ExplicitBreakFile" 4 0 - , inlayHintsTest "ExplicitBreakFile" 3 0 $ (@=?) [] + , inlayHintsTest "ExplicitBreakFile" 3 $ (@=?) + [InlayHint + { _position = Position {_line = 3, _character = 16} + , _label = InL "( a1 )" + , _kind = Just InlayHintKind_Type + , _textEdits = Nothing + , _tooltip = Nothing + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + }] , codeActionStaleAction "ExplicitStaleAction" 4 0 , testCase "No CodeAction when exported" $ runSessionWithServer def explicitImportsPlugin testDataDir $ do @@ -204,11 +214,14 @@ notRefineImports (CodeLens _ (Just (Command text _ _)) _) | "Refine imports to" `T.isPrefixOf` text = False notRefineImports _ = True -inlayHintsTest :: FilePath -> Int -> Int -> ([InlayHint] -> Assertion) -> TestTree -inlayHintsTest fp l c assert = testCase (fp ++ " inlay hints") $ runSessionWithServer def explicitImportsPlugin testDataDir $ do +inlayHintsTest :: FilePath -> UInt -> ([InlayHint] -> Assertion) -> TestTree +inlayHintsTest fp line assert = testCase (fp ++ " inlay hints") $ runSessionWithServer def explicitImportsPlugin testDataDir $ do doc <- openDoc (fp ++ ".hs") "haskell" - inlayHints <- getInlayHints doc (pointRange l c) + inlayHints <- getInlayHints doc (lineRange line) liftIO $ assert inlayHints + where + -- zero-based position + lineRange line = Range (Position line 0) (Position line 1000) -- Execute command and wait for result executeCmd :: Command -> Session () From 75b0ecb37a7f6cbf8650154d46744ece718aa106 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 23 Jun 2024 00:11:34 +0800 Subject: [PATCH 13/35] rename squashedAbbreviateImportTitle to abbreviateImportTitleWithoutModule --- .../src/Ide/Plugin/ExplicitImports.hs | 7 ++++--- plugins/hls-explicit-imports-plugin/test/Main.hs | 14 +++++++------- 2 files changed, 11 insertions(+), 10 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 05634cfb95..8a753fa03f 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -11,7 +11,7 @@ module Ide.Plugin.ExplicitImports ( descriptor , descriptorForModules , abbreviateImportTitle - , squashedAbbreviateImportTitle + , abbreviateImportTitleWithoutModule , Log(..) ) where @@ -488,8 +488,9 @@ abbreviateImportTitle input = else actualPrefix <> suffixText in title -squashedAbbreviateImportTitle :: T.Text -> T.Text -squashedAbbreviateImportTitle ieText = abbreviateImportTitle $ (T.intercalate " " . filter (not . T.null) . T.split isSpace . T.dropWhile (/= '(')) ieText +-- 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 -------------------------------------------------------------------------------- diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 12f6087f10..c531e5fd5b 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -110,19 +110,19 @@ main = defaultTestRunner $ testGroup "import-actions" o = "import " <> T.replicate 80 "F" <> " (Athing, Bthing, ... (3 items))" in ExplicitImports.abbreviateImportTitle i @?= o ] - , testGroup "Title abbreviation squashed" - [ testCase "not abbreviated squashed" $ + , 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.squashedAbbreviateImportTitle i @?= o - , testCase "abbreviated squashed that drop module name" $ + 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.squashedAbbreviateImportTitle i @?= o - , testCase "abbreviated squashed in import list" $ + 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.squashedAbbreviateImportTitle i @?= o + in ExplicitImports.abbreviateImportTitleWithoutModule i @?= o ] ]] From e0543b9f1721922f012c21613640118805cd23c3 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 23 Jun 2024 00:18:47 +0800 Subject: [PATCH 14/35] Request inlay hints with testEdits --- .../src/Ide/Plugin/ExplicitImports.hs | 40 +++++++++++-------- .../hls-explicit-imports-plugin/test/Main.hs | 6 +-- 2 files changed, 27 insertions(+), 19 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 8a753fa03f..feffd3a6b1 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -28,11 +28,13 @@ import Data.Char (isSpace) 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 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) @@ -112,7 +114,7 @@ runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IARe 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 () @@ -172,14 +174,18 @@ 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} = do nfp <- getNormalizedFilePathE _uri (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp - let inlayHints = [ generateInlayHints newRange ie + let inlayHints = [ generateInlayHints newRange ie pm | (range, int) <- forLens - , isSubrangeOf range visibleRange , Just newRange <- [toCurrentRange pm range] + , isSubrangeOf newRange visibleRange , Just ie <- [forResolve IM.!? int]] pure $ InL inlayHints where @@ -189,22 +195,22 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif -- |--- range ----|-- IH ---| -- |^-padding -- ^-_position - generateInlayHints :: Range -> ImportEdit -> InlayHint - generateInlayHints Range {_end} ie = - InlayHint { _position = _end - , _label = mkLabel ie + generateInlayHints :: Range -> ImportEdit -> PositionMapping -> InlayHint + generateInlayHints (Range _ end) ie pm = + InlayHint { _position = end + , _label = InL $ mkLabel ie , _kind = Just InlayHintKind_Type -- for type annotations - , _textEdits = Nothing + , _textEdits = fmap singleton $ toTEdit pm ie , _tooltip = Nothing , _paddingLeft = Just True , _paddingRight = Nothing , _data_ = Nothing } - mkLabel :: ImportEdit -> T.Text |? [InlayHintLabelPart] + mkLabel :: ImportEdit -> T.Text mkLabel (ImportEdit{ieResType, ieText}) = - let title ExplicitImport = squashedAbbreviateImportTitle ieText - title RefineImport = T.intercalate ", " (T.lines ieText) - in InL $ title ieResType + let title ExplicitImport = abbreviateImportTitle . T.dropWhile (/= '(') $ ieText + title RefineImport = "Refine imports to " <> T.intercalate ", " (T.lines ieText) + in title ieResType -- |For explicit imports: If there are any implicit imports, provide both one @@ -273,12 +279,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) diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index c531e5fd5b..2467302b91 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -39,7 +39,7 @@ main = defaultTestRunner $ testGroup "import-actions" { _position = Position {_line = 2, _character = 16} , _label = InL "( a1 )" , _kind = Just InlayHintKind_Type - , _textEdits = Nothing + , _textEdits = Just [TextEdit (Range (Position 2 0) (Position 2 16)) "import ExplicitA ( a1 )"] , _tooltip = Nothing , _paddingLeft = Just True , _paddingRight = Nothing @@ -52,7 +52,7 @@ main = defaultTestRunner $ testGroup "import-actions" { _position = Position {_line = 3, _character = 16} , _label = InL "( b1 )" , _kind = Just InlayHintKind_Type - , _textEdits = Nothing + , _textEdits = Just [TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitB ( b1 )"] , _tooltip = Nothing , _paddingLeft = Just True , _paddingRight = Nothing @@ -65,7 +65,7 @@ main = defaultTestRunner $ testGroup "import-actions" { _position = Position {_line = 3, _character = 16} , _label = InL "( a1 )" , _kind = Just InlayHintKind_Type - , _textEdits = Nothing + , _textEdits = Just [TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitA ( a1 )"] , _tooltip = Nothing , _paddingLeft = Just True , _paddingRight = Nothing From a6b755601a86fd05067337765f3ab23d84c9fcd5 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 23 Jun 2024 05:02:47 +0800 Subject: [PATCH 15/35] ExplicitImports fallback to codelens when inlay hints not support --- .../src/Ide/Plugin/ExplicitImports.hs | 57 ++++++++++++++----- 1 file changed, 42 insertions(+), 15 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 feffd3a6b1..8297ae15fa 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -58,6 +58,8 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types +import qualified Language.LSP.Protocol.Types as LSP +import qualified Language.LSP.Server as LSP -- This plugin is named explicit-imports for historical reasons. Besides -- providing code actions and lenses to make imports explicit it also provides @@ -109,6 +111,23 @@ descriptorForModules recorder modFilter plId = <> codeActionHandlers } +isInlayHintsSupported :: MonadIO m => IdeState -> m Bool +isInlayHintsSupported state = do + Shake.ShakeExtras{lspEnv} <- liftIO $ runAction "" state Shake.getShakeExtras + case lspEnv of + Just env -> liftIO $ LSP.runLspT env s + Nothing -> pure False + where + s = do + clientCapabilities <- LSP.getClientCapabilities + pure $ case () of + _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities + , Just LSP.WorkspaceClientCapabilities{_inlayHint} <- _workspace + , Just _ <- _inlayHint + -> True + | otherwise -> False + + -- | The actual command handler runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData runImportCommand recorder ideState _ eird@(ResolveOne _ _) = do @@ -136,13 +155,17 @@ 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 - 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]] - pure $ InL lens +lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do + isIHSupported <- liftIO $ isInlayHintsSupported state + if isIHSupported + then do pure $ InR Null + else 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]] + 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 -- import lenses and for explicit import lenses. @@ -180,14 +203,18 @@ lensResolveProvider _ _ _ _ _ rd = do -- 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} = do - nfp <- getNormalizedFilePathE _uri - (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp - let inlayHints = [ generateInlayHints newRange ie pm - | (range, int) <- forLens - , Just newRange <- [toCurrentRange pm range] - , isSubrangeOf newRange visibleRange - , Just ie <- [forResolve IM.!? int]] - pure $ InL inlayHints + isIHSupported <- liftIO $ isInlayHintsSupported state + if isIHSupported + then do + nfp <- getNormalizedFilePathE _uri + (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let inlayHints = [ generateInlayHints newRange ie pm + | (range, int) <- forLens + , Just newRange <- [toCurrentRange pm range] + , isSubrangeOf newRange visibleRange + , Just ie <- [forResolve IM.!? int]] + pure $ InL inlayHints + else do pure $ InR Null where -- The appropriate and intended position for the hint hints to begin -- is the end of the range for the code lens. From 2085635778d2339d3171acaf89231ca9a5ca16e9 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Mon, 24 Jun 2024 05:52:29 +0800 Subject: [PATCH 16/35] fix explicitImports inlayHints test --- hls-test-utils/src/Test/Hls/Util.hs | 7 +++++++ .../src/Ide/Plugin/ExplicitImports.hs | 4 ++-- plugins/hls-explicit-imports-plugin/test/Main.hs | 2 +- 3 files changed, 10 insertions(+), 3 deletions(-) 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 8297ae15fa..c0bd2a756f 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -121,8 +121,8 @@ isInlayHintsSupported state = do s = do clientCapabilities <- LSP.getClientCapabilities pure $ case () of - _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities - , Just LSP.WorkspaceClientCapabilities{_inlayHint} <- _workspace + _ | LSP.ClientCapabilities{_textDocument} <- clientCapabilities + , Just LSP.TextDocumentClientCapabilities{_inlayHint} <- _textDocument , Just _ <- _inlayHint -> True | otherwise -> False diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 2467302b91..9da3dc71d0 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -203,7 +203,7 @@ caTitle _ = Nothing -- code lens tests codeLensGoldenTest :: (CodeLens -> Bool) -> FilePath -> Int -> TestTree -codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoResolveCaps $ \doc -> do +codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoInlayHintsCaps $ \doc -> do codeLenses <- getCodeLenses doc resolvedCodeLenses <- for codeLenses resolveCodeLens (CodeLens {_command = Just c}) <- pure (filter predicate resolvedCodeLenses !! i) From ccf2d8fec435c5b843047f9344f146fc3f635847 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 25 Jun 2024 17:39:02 +0800 Subject: [PATCH 17/35] simplify isInlayHintsSupported --- .../src/Ide/Plugin/ExplicitImports.hs | 22 +++++-------------- 1 file changed, 6 insertions(+), 16 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 c0bd2a756f..3d132a593c 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -111,22 +111,12 @@ descriptorForModules recorder modFilter plId = <> codeActionHandlers } -isInlayHintsSupported :: MonadIO m => IdeState -> m Bool -isInlayHintsSupported state = do - Shake.ShakeExtras{lspEnv} <- liftIO $ runAction "" state Shake.getShakeExtras - case lspEnv of - Just env -> liftIO $ LSP.runLspT env s - Nothing -> pure False - where - s = do - clientCapabilities <- LSP.getClientCapabilities - pure $ case () of - _ | LSP.ClientCapabilities{_textDocument} <- clientCapabilities - , Just LSP.TextDocumentClientCapabilities{_inlayHint} <- _textDocument - , Just _ <- _inlayHint - -> True - | otherwise -> False - +isInlayHintsSupported :: Applicative f => IdeState -> f Bool +isInlayHintsSupported ideState = do + let clientCaps = clientCapabilities $ shakeExtras ideState + pure $ case clientCaps of + LSP.ClientCapabilities{_textDocument = Just LSP.TextDocumentClientCapabilities{_inlayHint = Just _}} -> True + _ -> False -- | The actual command handler runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData From fb52cee39fc2a8fa1c3d36559217f09f493e082c Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 25 Jun 2024 17:55:17 +0800 Subject: [PATCH 18/35] comment fallback --- .../src/Ide/Plugin/ExplicitImports.hs | 4 ++++ 1 file changed, 4 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 3d132a593c..0c9b8972fb 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -146,6 +146,8 @@ runImportCommand _ _ _ rd = do -- > Refine imports to import Control.Monad.IO.Class (liftIO) lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do + -- Code lens are not provided when the client supports inlay hints, + -- otherwise it will be provided as a fallback isIHSupported <- liftIO $ isInlayHintsSupported state if isIHSupported then do pure $ InR Null @@ -204,6 +206,8 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , isSubrangeOf newRange visibleRange , Just ie <- [forResolve IM.!? int]] pure $ InL inlayHints + -- When the client does not support inlay hints, fallback to the code lens, + -- so this is Null else do pure $ InR Null where -- The appropriate and intended position for the hint hints to begin From 6e5f746b3f13b7c84c1d11d75bca133c8dd5c310 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 25 Jun 2024 18:38:10 +0800 Subject: [PATCH 19/35] empty list instead of null codeLens --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 0c9b8972fb..deb9f0db31 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -150,7 +150,7 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_ -- otherwise it will be provided as a fallback isIHSupported <- liftIO $ isInlayHintsSupported state if isIHSupported - then do pure $ InR Null + then do pure $ InL [] else do nfp <- getNormalizedFilePathE _uri (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp From f4c2ea24c78138b62827786467fb6b987db0daf6 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 25 Jun 2024 18:39:21 +0800 Subject: [PATCH 20/35] clearify name `paddingLeft` --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 deb9f0db31..dea783bc85 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -214,7 +214,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif -- is the end of the range for the code lens. -- import Data.Char (isSpace) -- |--- range ----|-- IH ---| - -- |^-padding + -- |^-paddingLeft -- ^-_position generateInlayHints :: Range -> ImportEdit -> PositionMapping -> InlayHint generateInlayHints (Range _ end) ie pm = From 62a51cec885d3e4317df00c2762c5cd33903e773 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 25 Jun 2024 18:45:09 +0800 Subject: [PATCH 21/35] fix clientCapabilities --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 dea783bc85..0c3e229641 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -113,7 +113,7 @@ descriptorForModules recorder modFilter plId = isInlayHintsSupported :: Applicative f => IdeState -> f Bool isInlayHintsSupported ideState = do - let clientCaps = clientCapabilities $ shakeExtras ideState + let clientCaps = Shake.clientCapabilities $ shakeExtras ideState pure $ case clientCaps of LSP.ClientCapabilities{_textDocument = Just LSP.TextDocumentClientCapabilities{_inlayHint = Just _}} -> True _ -> False From f70e402ea92383645412108d900e57c4414512ed Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 25 Jun 2024 21:59:01 +0800 Subject: [PATCH 22/35] add test for inlay hints without its client caps --- .../hls-explicit-imports-plugin/test/Main.hs | 76 ++++++++++--------- 1 file changed, 41 insertions(+), 35 deletions(-) diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 9da3dc71d0..fc3a8f4692 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -34,43 +34,22 @@ main = defaultTestRunner $ testGroup "import-actions" "Make imports explicit" [ codeActionAllGoldenTest "ExplicitUsualCase" 3 0 , codeActionAllResolveGoldenTest "ExplicitUsualCase" 3 0 - , inlayHintsTest "ExplicitUsualCase" 2 $ (@=?) - [InlayHint - { _position = Position {_line = 2, _character = 16} - , _label = InL "( a1 )" - , _kind = Just InlayHintKind_Type - , _textEdits = Just [TextEdit (Range (Position 2 0) (Position 2 16)) "import ExplicitA ( a1 )"] - , _tooltip = Nothing - , _paddingLeft = Just True - , _paddingRight = Nothing - , _data_ = Nothing - }] + , 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 - , inlayHintsTest "ExplicitOnlyThis" 3 $ (@=?) - [InlayHint - { _position = Position {_line = 3, _character = 16} - , _label = InL "( b1 )" - , _kind = Just InlayHintKind_Type - , _textEdits = Just [TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitB ( b1 )"] - , _tooltip = Nothing - , _paddingLeft = Just True - , _paddingRight = Nothing - , _data_ = Nothing - }] + , inlayHintsTestWithCap "ExplicitOnlyThis" 3 $ (@=?) + [mkInlayHint (Position 3 16) "( b1 )" + (TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitB ( b1 )")] + , inlayHintsTestWithoutCap "ExplicitOnlyThis" 3 $ (@=?) [] , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0 , codeActionBreakFile "ExplicitBreakFile" 4 0 - , inlayHintsTest "ExplicitBreakFile" 3 $ (@=?) - [InlayHint - { _position = Position {_line = 3, _character = 16} - , _label = InL "( a1 )" - , _kind = Just InlayHintKind_Type - , _textEdits = Just [TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitA ( a1 )"] - , _tooltip = Nothing - , _paddingLeft = Just True - , _paddingRight = Nothing - , _data_ = Nothing - }] + , 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 @@ -214,14 +193,41 @@ notRefineImports (CodeLens _ (Just (Command text _ _)) _) | "Refine imports to" `T.isPrefixOf` text = False notRefineImports _ = True -inlayHintsTest :: FilePath -> UInt -> ([InlayHint] -> Assertion) -> TestTree -inlayHintsTest fp line assert = testCase (fp ++ " inlay hints") $ runSessionWithServer def explicitImportsPlugin testDataDir $ do +-- 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 = Just InlayHintKind_Type + , _textEdits = Just [textEdit] + , _tooltip = Nothing + , _paddingLeft = Just True + , _paddingRight = Nothing + , _data_ = Nothing + } -- Execute command and wait for result executeCmd :: Command -> Session () From 57ef0db59e55525e73ea6bead344d3c92544236a Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Fri, 28 Jun 2024 19:28:26 +0800 Subject: [PATCH 23/35] use codeActionNoInlayHintsCaps to avoid error --- plugins/hls-explicit-imports-plugin/test/Main.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index fc3a8f4692..0fcc494830 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -115,7 +115,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) From f8b19930addf7104167b45f78f29ac6371570b9a Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 30 Jun 2024 03:35:02 +0800 Subject: [PATCH 24/35] simplify isInlayHintSupported --- .../src/Ide/Plugin/ExplicitImports.hs | 23 ++++++++----------- 1 file changed, 10 insertions(+), 13 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 0c3e229641..f591277a30 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -16,7 +16,7 @@ module Ide.Plugin.ExplicitImports ) 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) @@ -30,7 +30,8 @@ import qualified Data.IntMap as IM (IntMap, elems, 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 @@ -55,11 +56,11 @@ import qualified Ide.Plugin.RangeMap as RM (RangeMap, 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 -import qualified Language.LSP.Protocol.Types as LSP -import qualified Language.LSP.Server as LSP -- This plugin is named explicit-imports for historical reasons. Besides -- providing code actions and lenses to make imports explicit it also provides @@ -111,12 +112,10 @@ descriptorForModules recorder modFilter plId = <> codeActionHandlers } -isInlayHintsSupported :: Applicative f => IdeState -> f Bool -isInlayHintsSupported ideState = do +isInlayHintsSupported :: IdeState -> Bool +isInlayHintsSupported ideState = let clientCaps = Shake.clientCapabilities $ shakeExtras ideState - pure $ case clientCaps of - LSP.ClientCapabilities{_textDocument = Just LSP.TextDocumentClientCapabilities{_inlayHint = Just _}} -> True - _ -> False + in isJust $ clientCaps ^? textDocument . _Just . inlayHint . _Just -- | The actual command handler runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData @@ -148,8 +147,7 @@ lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Met lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do -- Code lens are not provided when the client supports inlay hints, -- otherwise it will be provided as a fallback - isIHSupported <- liftIO $ isInlayHintsSupported state - if isIHSupported + if isInlayHintsSupported state then do pure $ InL [] else do nfp <- getNormalizedFilePathE _uri @@ -195,8 +193,7 @@ lensResolveProvider _ _ _ _ _ rd = do -- 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} = do - isIHSupported <- liftIO $ isInlayHintsSupported state - if isIHSupported + if isInlayHintsSupported state then do nfp <- getNormalizedFilePathE _uri (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp From a50b148593d96cd7f25ac56e097220929f1fd616 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 30 Jun 2024 04:04:03 +0800 Subject: [PATCH 25/35] comment about paddingLeft --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 f591277a30..fd9709deae 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -220,7 +220,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , _kind = Just InlayHintKind_Type -- for type annotations , _textEdits = fmap singleton $ toTEdit pm ie , _tooltip = Nothing - , _paddingLeft = Just True + , _paddingLeft = Just True -- show an extra space before the inlay hint , _paddingRight = Nothing , _data_ = Nothing } From af635f70e08db91480517d2e1d60657a6732d3c0 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 30 Jun 2024 04:10:34 +0800 Subject: [PATCH 26/35] use null as inlay hints kind --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- plugins/hls-explicit-imports-plugin/test/Main.hs | 2 +- 2 files changed, 2 insertions(+), 2 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 fd9709deae..40226b1373 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -217,7 +217,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif generateInlayHints (Range _ end) ie pm = InlayHint { _position = end , _label = InL $ mkLabel ie - , _kind = Just InlayHintKind_Type -- for type annotations + , _kind = Nothing -- neither a type nor a parameter , _textEdits = fmap singleton $ toTEdit pm ie , _tooltip = Nothing , _paddingLeft = Just True -- show an extra space before the inlay hint diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 0fcc494830..9c11525dcc 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -223,7 +223,7 @@ mkInlayHint pos label textEdit = InlayHint { _position = pos , _label = InL label - , _kind = Just InlayHintKind_Type + , _kind = Nothing , _textEdits = Just [textEdit] , _tooltip = Nothing , _paddingLeft = Just True From 0fab728b76260c8bb75c13b10e12b20bd53383df Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 30 Jun 2024 04:24:16 +0800 Subject: [PATCH 27/35] add tooltip for explicit imports inlay hints to improve UX --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- plugins/hls-explicit-imports-plugin/test/Main.hs | 2 +- 2 files changed, 2 insertions(+), 2 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 40226b1373..e7ceb91f85 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -219,7 +219,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , _label = InL $ mkLabel ie , _kind = Nothing -- neither a type nor a parameter , _textEdits = fmap singleton $ toTEdit pm ie - , _tooltip = Nothing + , _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 diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index 9c11525dcc..a4004cb319 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -225,7 +225,7 @@ mkInlayHint pos label textEdit = , _label = InL label , _kind = Nothing , _textEdits = Just [textEdit] - , _tooltip = Nothing + , _tooltip = Just $ InL "Make this import explicit" , _paddingLeft = Just True , _paddingRight = Nothing , _data_ = Nothing From 4c7313d509c7e6b537af716cd1594e1d1a1e6f3e Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 30 Jun 2024 04:25:01 +0800 Subject: [PATCH 28/35] chore comments --- .../src/Ide/Plugin/ExplicitImports.hs | 2 +- 1 file changed, 1 insertion(+), 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 e7ceb91f85..7b3a85706e 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -211,7 +211,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif -- is the end of the range for the code lens. -- import Data.Char (isSpace) -- |--- range ----|-- IH ---| - -- |^-paddingLeft + -- |^-_paddingLeft -- ^-_position generateInlayHints :: Range -> ImportEdit -> PositionMapping -> InlayHint generateInlayHints (Range _ end) ie pm = From ffdb94c8750f8abbaacecce69ceab0c774a74b4c Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sun, 30 Jun 2024 04:42:35 +0800 Subject: [PATCH 29/35] refactor --- .../src/Ide/Plugin/ExplicitImports.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 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 7b3a85706e..d467a9ea59 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -148,7 +148,7 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_ -- Code lens are not provided when the client supports inlay hints, -- otherwise it will be provided as a fallback if isInlayHintsSupported state - then do pure $ InL [] + then pure $ InL [] else do nfp <- getNormalizedFilePathE _uri (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp @@ -192,7 +192,7 @@ lensResolveProvider _ _ _ _ _ rd = do -- 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} = do +inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}, _range = visibleRange} = if isInlayHintsSupported state then do nfp <- getNormalizedFilePathE _uri @@ -205,7 +205,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif pure $ InL inlayHints -- When the client does not support inlay hints, fallback to the code lens, -- so this is Null - else do pure $ InR Null + else pure $ InR Null where -- The appropriate and intended position for the hint hints to begin -- is the end of the range for the code lens. @@ -226,7 +226,7 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif } mkLabel :: ImportEdit -> T.Text mkLabel (ImportEdit{ieResType, ieText}) = - let title ExplicitImport = abbreviateImportTitle . T.dropWhile (/= '(') $ ieText + let title ExplicitImport = abbreviateImportTitleWithoutModule ieText title RefineImport = "Refine imports to " <> T.intercalate ", " (T.lines ieText) in title ieResType From 0a876c3f09de3ad4a13d7f1151ba97a3e59da705 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 2 Jul 2024 02:23:22 +0800 Subject: [PATCH 30/35] comment InL [] to indicate no info --- .../src/Ide/Plugin/ExplicitImports.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 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 d467a9ea59..8abdc5933b 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -148,6 +148,7 @@ lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_ -- Code lens are not provided when the client supports inlay hints, -- otherwise it will be provided as a fallback if isInlayHintsSupported state + -- `[]` is no different from `null`, we chose to use all `[]` to indicate "no information" then pure $ InL [] else do nfp <- getNormalizedFilePathE _uri @@ -204,8 +205,8 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , Just ie <- [forResolve IM.!? int]] pure $ InL inlayHints -- When the client does not support inlay hints, fallback to the code lens, - -- so this is Null - else pure $ InR Null + -- so there is nothing to response here, return `[]` 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. From c11e3562424a4a6147214b06933bf83e22ef0c1b Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 2 Jul 2024 02:32:17 +0800 Subject: [PATCH 31/35] ignore refine inlay hints --- .../src/Ide/Plugin/ExplicitImports.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 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 8abdc5933b..fbd06c405c 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -25,6 +25,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.Functor ((<&>)) import qualified Data.IntMap as IM (IntMap, elems, fromList, (!?)) import Data.IORef (readIORef) @@ -198,11 +199,12 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif then do nfp <- getNormalizedFilePathE _uri (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp - let inlayHints = [ generateInlayHints newRange ie pm + let inlayHints = [ inlayHint | (range, int) <- forLens , Just newRange <- [toCurrentRange pm range] , isSubrangeOf newRange visibleRange - , Just ie <- [forResolve IM.!? int]] + , 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, return `[]` to indicate "no information" @@ -214,10 +216,10 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif -- |--- range ----|-- IH ---| -- |^-_paddingLeft -- ^-_position - generateInlayHints :: Range -> ImportEdit -> PositionMapping -> InlayHint - generateInlayHints (Range _ end) ie pm = + generateInlayHints :: Range -> ImportEdit -> PositionMapping -> Maybe InlayHint + generateInlayHints (Range _ end) ie pm = mkLabel ie <&> \label -> InlayHint { _position = end - , _label = InL $ mkLabel ie + , _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 @@ -225,10 +227,10 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif , _paddingRight = Nothing , _data_ = Nothing } - mkLabel :: ImportEdit -> T.Text + mkLabel :: ImportEdit -> Maybe T.Text mkLabel (ImportEdit{ieResType, ieText}) = - let title ExplicitImport = abbreviateImportTitleWithoutModule ieText - title RefineImport = "Refine imports to " <> T.intercalate ", " (T.lines 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 From 599ebcf06c9cb8a09302d7be452657a4204870f6 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 2 Jul 2024 05:06:14 +0800 Subject: [PATCH 32/35] add plcInlayHintsOn config --- hls-plugin-api/src/Ide/Plugin/Config.hs | 5 +++-- hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs | 2 ++ hls-plugin-api/src/Ide/Types.hs | 9 ++++++--- 3 files changed, 11 insertions(+), 5 deletions(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 24c1b0c376..019b552b52 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 .:? "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 46d2e35e37..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 @@ -512,10 +515,10 @@ instance PluginMethod Request Method_WorkspaceSymbol where handlesRequest _ _ _ _ = HandlesRequest instance PluginMethod Request Method_TextDocumentInlayHint where - handlesRequest _ _ _ _ = HandlesRequest + handlesRequest = pluginEnabledWithFeature plcInlayHintsOn instance PluginMethod Request Method_InlayHintResolve where - handlesRequest _ _ _ _ = HandlesRequest + handlesRequest = pluginEnabledResolve plcInlayHintsOn instance PluginMethod Request Method_TextDocumentCodeLens where handlesRequest = pluginEnabledWithFeature plcCodeLensOn From 3e5b88f7a26292fa5d5af2c1cea6c7163855ff7e Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 2 Jul 2024 13:59:39 +0800 Subject: [PATCH 33/35] update func-test --- test/testdata/schema/ghc94/default-config.golden.json | 3 ++- .../schema/ghc94/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc96/default-config.golden.json | 3 ++- .../schema/ghc96/vscode-extension-schema.golden.json | 6 ++++++ test/testdata/schema/ghc98/default-config.golden.json | 3 ++- .../schema/ghc98/vscode-extension-schema.golden.json | 6 ++++++ 6 files changed, 24 insertions(+), 3 deletions(-) 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", From 6cfafd5a11e5f06e30249c857e6425ae19870090 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Tue, 2 Jul 2024 15:05:07 +0800 Subject: [PATCH 34/35] keep order to make Parser works --- hls-plugin-api/src/Ide/Plugin/Config.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/hls-plugin-api/src/Ide/Plugin/Config.hs b/hls-plugin-api/src/Ide/Plugin/Config.hs index 019b552b52..4fee92c309 100644 --- a/hls-plugin-api/src/Ide/Plugin/Config.hs +++ b/hls-plugin-api/src/Ide/Plugin/Config.hs @@ -66,7 +66,6 @@ parsePluginConfig :: PluginConfig -> Value -> A.Parser 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 @@ -77,6 +76,7 @@ parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig <*> o .:? "renameOn" .!= plcRenameOn def <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def + <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- From ce761e72062792b59446c694bc6c0eb34239ad87 Mon Sep 17 00:00:00 2001 From: Jinser Kafka Date: Sat, 6 Jul 2024 00:46:44 +0800 Subject: [PATCH 35/35] always provide refine in code lens --- .../src/Ide/Plugin/ExplicitImports.hs | 33 ++++++++++--------- .../hls-explicit-imports-plugin/test/Main.hs | 15 +++++---- 2 files changed, 26 insertions(+), 22 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 56e695f4b9..611c02fc78 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -146,18 +146,18 @@ runImportCommand _ _ _ rd = do -- > Refine imports to import Control.Monad.IO.Class (liftIO) lensProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentCodeLens lensProvider _ state _ CodeLensParams {_textDocument = TextDocumentIdentifier {_uri}} = do - -- Code lens are not provided when the client supports inlay hints, - -- otherwise it will be provided as a fallback - if isInlayHintsSupported state - -- `[]` is no different from `null`, we chose to use all `[]` to indicate "no information" - then pure $ InL [] - else 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]] - pure $ InL lens + nfp <- getNormalizedFilePathE _uri + (ImportActionsResult{forLens}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp + let lens = [ generateLens _uri newRange int + -- 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 -- import lenses and for explicit import lenses. @@ -200,14 +200,15 @@ inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentif nfp <- getNormalizedFilePathE _uri (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp let inlayHints = [ inlayHint - | (range, int) <- forLens + | (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, return `[]` to indicate "no information" + -- 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 @@ -325,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 @@ -417,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) } diff --git a/plugins/hls-explicit-imports-plugin/test/Main.hs b/plugins/hls-explicit-imports-plugin/test/Main.hs index a4004cb319..440010bad2 100644 --- a/plugins/hls-explicit-imports-plugin/test/Main.hs +++ b/plugins/hls-explicit-imports-plugin/test/Main.hs @@ -26,9 +26,10 @@ 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" @@ -44,7 +45,9 @@ main = defaultTestRunner $ testGroup "import-actions" [mkInlayHint (Position 3 16) "( b1 )" (TextEdit (Range (Position 3 0) (Position 3 16)) "import ExplicitB ( b1 )")] , inlayHintsTestWithoutCap "ExplicitOnlyThis" 3 $ (@=?) [] - , codeLensGoldenTest notRefineImports "ExplicitUsualCase" 0 + -- 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 )" @@ -183,8 +186,8 @@ caTitle _ = Nothing -- code lens tests -codeLensGoldenTest :: (CodeLens -> Bool) -> FilePath -> Int -> TestTree -codeLensGoldenTest predicate fp i = goldenWithImportActions " code lens" fp codeActionNoInlayHintsCaps $ \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)