Provide explicit import in inlay hints

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

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

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

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

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])
 

plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs

@@ -6,10 +6,12 @@
 {-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE TypeFamilies       #-}
 {-# LANGUAGE ViewPatterns       #-}
+
 module Ide.Plugin.ExplicitImports
   ( descriptor
   , descriptorForModules
   , abbreviateImportTitle
+  , squashedAbbreviateImportTitle
   , Log(..)
   ) where
 
@@ -22,6 +24,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 +47,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 +102,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 +152,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 +173,36 @@ 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}, _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
+  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 = squashedAbbreviateImportTitle 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 +213,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,8 +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
@@ -444,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
 --------------------------------------------------------------------------------
 
 
@@ -462,10 +501,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

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