Provide explicit import in inlay hints

hls-plugin-api/src/Ide/Plugin/Config.hs

@@ -63,19 +63,20 @@ parsePlugins (IdePlugins plugins) = A.withObject "Config.plugins" $ \o -> do
 -- ---------------------------------------------------------------------
 
 parsePluginConfig :: PluginConfig -> Value -> A.Parser PluginConfig
-parsePluginConfig def = A.withObject "PluginConfig" $ \o  -> PluginConfig
+parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig
       <$> o .:? "globalOn"         .!= plcGlobalOn def
       <*> o .:? "callHierarchyOn"  .!= plcCallHierarchyOn def
-      <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def
       <*> o .:? "codeActionsOn"    .!= plcCodeActionsOn def
       <*> o .:? "codeLensOn"       .!= plcCodeLensOn    def
+      <*> o .:? "inlayHintsOn"     .!= plcInlayHintsOn  def
       <*> o .:? "diagnosticsOn"    .!= plcDiagnosticsOn def -- AZ
       <*> o .:? "hoverOn"          .!= plcHoverOn       def
       <*> o .:? "symbolsOn"        .!= plcSymbolsOn     def
       <*> o .:? "completionOn"     .!= plcCompletionOn  def
       <*> o .:? "renameOn"         .!= plcRenameOn      def
       <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def
-      <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def
+      <*> o .:? "foldingRangeOn"   .!= plcFoldingRangeOn def
+      <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def
       <*> o .:? "config"           .!= plcConfig        def
 
 -- ---------------------------------------------------------------------

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]

hls-plugin-api/src/Ide/Types.hs

@@ -260,6 +260,7 @@ data PluginConfig =
       , plcCallHierarchyOn  :: !Bool
       , plcCodeActionsOn    :: !Bool
       , plcCodeLensOn       :: !Bool
+      , plcInlayHintsOn     :: !Bool
       , plcDiagnosticsOn    :: !Bool
       , plcHoverOn          :: !Bool
       , plcSymbolsOn        :: !Bool
@@ -277,6 +278,7 @@ instance Default PluginConfig where
       , plcCallHierarchyOn  = True
       , plcCodeActionsOn    = True
       , plcCodeLensOn       = True
+      , plcInlayHintsOn     = True
       , plcDiagnosticsOn    = True
       , plcHoverOn          = True
       , plcSymbolsOn        = True
@@ -289,12 +291,13 @@ instance Default PluginConfig where
       }
 
 instance ToJSON PluginConfig where
-    toJSON (PluginConfig g ch ca cl d h s c rn sr fr st cfg) = r
+    toJSON (PluginConfig g ch ca ih cl d h s c rn sr fr st cfg) = r
       where
         r = object [ "globalOn"         .= g
                    , "callHierarchyOn"  .= ch
                    , "codeActionsOn"    .= ca
                    , "codeLensOn"       .= cl
+                   , "inlayHintsOn"     .= ih
                    , "diagnosticsOn"    .= d
                    , "hoverOn"          .= h
                    , "symbolsOn"        .= s
@@ -511,6 +514,12 @@ instance PluginMethod Request Method_WorkspaceSymbol where
   -- Unconditionally enabled, but should it really be?
   handlesRequest _ _ _ _ = HandlesRequest
 
+instance PluginMethod Request Method_TextDocumentInlayHint where
+  handlesRequest = pluginEnabledWithFeature plcInlayHintsOn
+
+instance PluginMethod Request Method_InlayHintResolve where
+  handlesRequest = pluginEnabledResolve plcInlayHintsOn
+
 instance PluginMethod Request Method_TextDocumentCodeLens where
   handlesRequest = pluginEnabledWithFeature plcCodeLensOn
 
@@ -810,6 +819,9 @@ instance PluginRequestMethod Method_TextDocumentSemanticTokensFull where
 instance PluginRequestMethod Method_TextDocumentSemanticTokensFullDelta where
   combineResponses _ _ _ _ (x :| _) = x
 
+instance PluginRequestMethod Method_TextDocumentInlayHint where
+  combineResponses _ _ _ _ x = sconcat x
+
 takeLefts :: [a |? b] -> [a]
 takeLefts = mapMaybe (\x -> [res | (InL res) <- Just x])
 

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

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

@@ -6,30 +6,37 @@
 {-# LANGUAGE RecordWildCards    #-}
 {-# LANGUAGE TypeFamilies       #-}
 {-# LANGUAGE ViewPatterns       #-}
+
 module Ide.Plugin.ExplicitImports
   ( descriptor
   , descriptorForModules
   , abbreviateImportTitle
+  , abbreviateImportTitleWithoutModule
   , Log(..)
   ) where
 
 import           Control.DeepSeq
-import           Control.Lens                         ((&), (?~))
+import           Control.Lens                         (_Just, (&), (?~), (^?))
 import           Control.Monad.Error.Class            (MonadError (throwError))
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class            (lift)
 import           Control.Monad.Trans.Except           (ExceptT)
 import           Control.Monad.Trans.Maybe
 import qualified Data.Aeson                           as A (ToJSON (toJSON))
 import           Data.Aeson.Types                     (FromJSON)
+import           Data.Char                            (isSpace)
+import           Data.Functor                         ((<&>))
 import qualified Data.IntMap                          as IM (IntMap, elems,
                                                              fromList, (!?))
 import           Data.IORef                           (readIORef)
+import           Data.List                            (singleton)
 import qualified Data.Map.Strict                      as Map
-import           Data.Maybe                           (isNothing, mapMaybe)
+import           Data.Maybe                           (isJust, isNothing,
+                                                       mapMaybe)
 import qualified Data.Set                             as S
 import           Data.String                          (fromString)
 import qualified Data.Text                            as T
+import qualified Data.Text                            as Text
 import           Data.Traversable                     (for)
 import qualified Data.Unique                          as U (hashUnique,
                                                             newUnique)
@@ -44,11 +51,14 @@ import           GHC.Generics                         (Generic)
 import           Ide.Plugin.Error                     (PluginError (..),
                                                        getNormalizedFilePathE,
                                                        handleMaybe)
-import           Ide.Plugin.RangeMap                  (filterByRange)
-import qualified Ide.Plugin.RangeMap                  as RM (RangeMap, fromList)
+import qualified Ide.Plugin.RangeMap                  as RM (RangeMap,
+                                                             filterByRange,
+                                                             fromList)
 import           Ide.Plugin.Resolve
 import           Ide.PluginUtils
 import           Ide.Types
+import           Language.LSP.Protocol.Lens           (HasInlayHint (inlayHint),
+                                                       HasTextDocument (textDocument))
 import qualified Language.LSP.Protocol.Lens           as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
@@ -97,17 +107,23 @@ descriptorForModules recorder modFilter plId =
          -- This plugin provides code lenses
            mkPluginHandler SMethod_TextDocumentCodeLens (lensProvider recorder)
         <> mkResolveHandler SMethod_CodeLensResolve (lensResolveProvider recorder)
-          -- This plugin provides code actions
+        -- This plugin provides inlay hints
+        <> mkPluginHandler SMethod_TextDocumentInlayHint (inlayHintProvider recorder)
+        -- This plugin provides code actions
         <> codeActionHandlers
-
     }
 
+isInlayHintsSupported :: IdeState -> Bool
+isInlayHintsSupported ideState =
+  let clientCaps = Shake.clientCapabilities $ shakeExtras ideState
+   in isJust $ clientCaps ^? textDocument . _Just . inlayHint . _Just
+
 -- | The actual command handler
 runImportCommand :: Recorder (WithPriority Log) -> CommandFunction IdeState IAResolveData
 runImportCommand recorder ideState _ eird@(ResolveOne _ _) = do
   wedit <- resolveWTextEdit ideState eird
   _ <- lift $ pluginSendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) logErrors
-  return $ InR  Null
+  return $ InR Null
   where logErrors (Left re) = do
           logWith recorder Error (LogWAEResponseError re)
           pure ()
@@ -129,13 +145,19 @@ 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
+    -- 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
   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.
@@ -145,12 +167,13 @@ lensProvider _  state _ CodeLensParams {_textDocument = TextDocumentIdentifier {
                    , _range = range
                    , _command = Nothing }
 
+
 lensResolveProvider :: Recorder (WithPriority Log) -> ResolveFunction IdeState IAResolveData 'Method_CodeLensResolve
 lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do
     nfp <- getNormalizedFilePathE uri
     (ImportActionsResult{forResolve}, _) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp
     target <- handleMaybe PluginStaleResolve $ forResolve IM.!? uid
-    let updatedCodeLens = cl & L.command ?~  mkCommand plId target
+    let updatedCodeLens = cl & L.command ?~ mkCommand plId target
     pure updatedCodeLens
   where mkCommand ::  PluginId -> ImportEdit -> Command
         mkCommand pId (ImportEdit{ieResType, ieText}) =
@@ -165,6 +188,52 @@ lensResolveProvider _ ideState plId cl uri rd@(ResolveOne _ uid) = do
 lensResolveProvider _ _ _ _ _ rd = do
    throwError $ PluginInvalidParams (T.pack $ "Unexpected argument for lens resolve handler: " <> show rd)
 
+
+-- | Provide explicit imports in inlay hints.
+-- Applying textEdits can make the import explicit.
+-- There is currently no need to resolve inlay hints,
+-- as no tooltips or commands are provided in the label.
+inlayHintProvider :: Recorder (WithPriority Log) -> PluginMethodHandler IdeState 'Method_TextDocumentInlayHint
+inlayHintProvider _ state _ InlayHintParams {_textDocument = TextDocumentIdentifier {_uri}, _range = visibleRange} =
+    if isInlayHintsSupported state
+    then do
+        nfp <- getNormalizedFilePathE _uri
+        (ImportActionsResult {forLens, forResolve}, pm) <- runActionE "ImportActions" state $ useWithStaleE ImportActions nfp
+        let inlayHints = [ inlayHint
+                         | (range, int) <- forLens
+                         , Just newRange <- [toCurrentRange pm range]
+                         , isSubrangeOf newRange visibleRange
+                         , Just ie <- [forResolve IM.!? int]
+                         , Just inlayHint <- [generateInlayHints newRange ie pm]]
+        pure $ InL inlayHints
+    -- When the client does not support inlay hints, fallback to the code lens,
+    -- so there is nothing to response here, 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.
+    --   import Data.Char (isSpace)
+    --   |--- range ----|-- IH ---|
+    --                  |^-_paddingLeft
+    --                  ^-_position
+    generateInlayHints :: Range -> ImportEdit -> PositionMapping -> Maybe InlayHint
+    generateInlayHints (Range _ end) ie pm = mkLabel ie <&> \label ->
+      InlayHint { _position = end
+                , _label = InL label
+                , _kind = Nothing -- neither a type nor a parameter
+                , _textEdits = fmap singleton $ toTEdit pm ie
+                , _tooltip = Just $ InL "Make this import explicit" -- simple enough, no need to resolve
+                , _paddingLeft = Just True -- show an extra space before the inlay hint
+                , _paddingRight = Nothing
+                , _data_ = Nothing
+                }
+    mkLabel :: ImportEdit -> Maybe T.Text
+    mkLabel (ImportEdit{ieResType, ieText}) =
+      let title ExplicitImport = Just $ abbreviateImportTitleWithoutModule ieText
+          title RefineImport   = Nothing -- does not provide imports statements that can be refined via inlay hints
+      in title ieResType
+
+
 -- |For explicit imports: If there are any implicit imports, provide both one
 -- code action per import to make that specific import explicit, and one code
 -- action to turn them all into explicit imports. For refine imports: If there
@@ -175,7 +244,7 @@ codeActionProvider _ ideState _pId (CodeActionParams _ _ TextDocumentIdentifier
     nfp <- getNormalizedFilePathE _uri
     (ImportActionsResult{forCodeActions}, pm) <- runActionE "ImportActions" ideState $ useWithStaleE ImportActions nfp
     newRange <- toCurrentRangeE pm range
-    let relevantCodeActions = filterByRange newRange forCodeActions
+    let relevantCodeActions = RM.filterByRange newRange forCodeActions
         allExplicit =
           [InR $ mkCodeAction "Make all imports explicit" (Just $ A.toJSON $ ExplicitAll _uri)
           -- We should only provide this code action if there are any code
@@ -231,12 +300,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)
@@ -413,16 +484,15 @@ 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
 abbreviateImportTitle :: T.Text -> T.Text
 abbreviateImportTitle input =
   let
       -- For starters, we only want one line in the title
-      oneLineText = T.unwords $ T.lines input
+      -- we also need to compress multiple spaces into one
+      oneLineText = T.unwords $ filter (not . T.null) $ T.split isSpace input
       -- Now, split at the max columns, leaving space for the summary text we're going to add
       -- (conservatively assuming we won't need to print a number larger than 100)
       (prefix, suffix) = T.splitAt (maxColumns - T.length (summaryText 100)) oneLineText
@@ -447,6 +517,11 @@ abbreviateImportTitle input =
           else actualPrefix <> suffixText
   in title
 
+-- Create an import abbreviate title without module for inlay hints
+abbreviateImportTitleWithoutModule :: Text.Text -> Text.Text
+abbreviateImportTitleWithoutModule = abbreviateImportTitle . T.dropWhile (/= '(')
+
+-- | The title of the command is ideally the minimal explicit import decl, but
 --------------------------------------------------------------------------------
 
 
@@ -465,7 +540,6 @@ filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)})
     else Nothing
   where importedNames = S.fromList $ map (ieName . unLoc) names
         res = Map.filter (any (any (`S.member` importedNames) . getAvailNames)) avails
-
         allFilteredAvailsNames = S.fromList
           $ concatMap getAvailNames
           $ mconcat