diff --git a/hls-plugin-api.cabal b/hls-plugin-api.cabal --- a/hls-plugin-api.cabal +++ b/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-plugin-api -version: 2.9.0.1 +version: 2.10.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at @@ -66,7 +66,7 @@ , filepath , ghc , hashable - , hls-graph == 2.9.0.1 + , hls-graph == 2.10.0.0 , lens , lens-aeson , lsp ^>=2.7 diff --git a/src/Ide/Plugin/Config.hs b/src/Ide/Plugin/Config.hs --- a/src/Ide/Plugin/Config.hs +++ b/src/Ide/Plugin/Config.hs @@ -63,19 +63,20 @@ -- --------------------------------------------------------------------- parsePluginConfig :: PluginConfig -> Value -> A.Parser PluginConfig -parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig +parsePluginConfig def = A.withObject "PluginConfig" $ \o -> PluginConfig <$> o .:? "globalOn" .!= plcGlobalOn def <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def - <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def <*> o .:? "codeLensOn" .!= plcCodeLensOn def + <*> o .:? "inlayHintsOn" .!= plcInlayHintsOn def <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ <*> o .:? "hoverOn" .!= plcHoverOn def <*> o .:? "symbolsOn" .!= plcSymbolsOn def <*> o .:? "completionOn" .!= plcCompletionOn def <*> o .:? "renameOn" .!= plcRenameOn def <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn def - <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def + <*> o .:? "foldingRangeOn" .!= plcFoldingRangeOn def + <*> o .:? "semanticTokensOn" .!= plcSemanticTokensOn def <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- diff --git a/src/Ide/Plugin/ConfigUtils.hs b/src/Ide/Plugin/ConfigUtils.hs --- a/src/Ide/Plugin/ConfigUtils.hs +++ b/src/Ide/Plugin/ConfigUtils.hs @@ -88,6 +88,7 @@ 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 @@ 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/src/Ide/Plugin/RangeMap.hs b/src/Ide/Plugin/RangeMap.hs --- a/src/Ide/Plugin/RangeMap.hs +++ b/src/Ide/Plugin/RangeMap.hs @@ -13,6 +13,7 @@ fromList, fromList', filterByRange, + elementsInRange, ) where import Development.IDE.Graph.Classes (NFData) @@ -65,6 +66,14 @@ filterByRange range = map snd . IM.dominators (rangeToInterval range) . unRangeMap #else filterByRange range = map snd . filter (isSubrangeOf range . fst) . unRangeMap +#endif + +-- | Extracts all elements from a 'RangeMap' that fall within a given 'Range'. +elementsInRange :: Range -> RangeMap a -> [a] +#ifdef USE_FINGERTREE +elementsInRange range = map snd . IM.intersections (rangeToInterval range) . unRangeMap +#else +elementsInRange range = map snd . filter (flip isSubrangeOf range . fst) . unRangeMap #endif #ifdef USE_FINGERTREE diff --git a/src/Ide/PluginUtils.hs b/src/Ide/PluginUtils.hs --- a/src/Ide/PluginUtils.hs +++ b/src/Ide/PluginUtils.hs @@ -28,6 +28,7 @@ allLspCmdIds', installSigUsr1Handler, subRange, + rangesOverlap, positionInRange, usePropertyLsp, -- * Escape @@ -276,6 +277,21 @@ subRange :: Range -> Range -> Bool subRange = isSubrangeOf + + +-- | Check whether the two 'Range's overlap in any way. +-- +-- >>> rangesOverlap (mkRange 1 0 1 4) (mkRange 1 2 1 5) +-- True +-- >>> rangesOverlap (mkRange 1 2 1 5) (mkRange 1 0 1 4) +-- True +-- >>> rangesOverlap (mkRange 1 0 1 6) (mkRange 1 2 1 4) +-- True +-- >>> rangesOverlap (mkRange 1 2 1 4) (mkRange 1 0 1 6) +-- True +rangesOverlap :: Range -> Range -> Bool +rangesOverlap r1 r2 = + r1 ^. L.start <= r2 ^. L.end && r2 ^. L.start <= r1 ^. L.end -- --------------------------------------------------------------------- diff --git a/src/Ide/Types.hs b/src/Ide/Types.hs --- a/src/Ide/Types.hs +++ b/src/Ide/Types.hs @@ -26,12 +26,12 @@ , ConfigDescriptor(..), defaultConfigDescriptor, configForPlugin , CustomConfig(..), mkCustomConfig , FallbackCodeActionParams(..) -, FormattingType(..), FormattingMethod, FormattingHandler, mkFormattingHandlers +, FormattingType(..), FormattingMethod, FormattingHandler , HasTracing(..) , PluginCommand(..), CommandId(..), CommandFunction, mkLspCommand, mkLspCmdId , PluginId(..) , PluginHandler(..), mkPluginHandler -, HandlerM, runHandlerM, pluginGetClientCapabilities, pluginGetVirtualFile, pluginGetVersionedTextDoc, pluginSendNotification, pluginSendRequest, pluginWithIndefiniteProgress +, HandlerM, runHandlerM, pluginGetClientCapabilities, pluginSendNotification, pluginSendRequest, pluginWithIndefiniteProgress , PluginHandlers(..) , PluginMethod(..) , PluginMethodHandler @@ -64,7 +64,6 @@ import Control.Monad (void) import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class (MonadIO) -import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT, runExceptT) import Data.Aeson hiding (Null, defaultOptions) import qualified Data.Aeson.Types as A @@ -260,6 +259,7 @@ , plcCallHierarchyOn :: !Bool , plcCodeActionsOn :: !Bool , plcCodeLensOn :: !Bool + , plcInlayHintsOn :: !Bool , plcDiagnosticsOn :: !Bool , plcHoverOn :: !Bool , plcSymbolsOn :: !Bool @@ -277,6 +277,7 @@ , plcCallHierarchyOn = True , plcCodeActionsOn = True , plcCodeLensOn = True + , plcInlayHintsOn = True , plcDiagnosticsOn = True , plcHoverOn = True , plcSymbolsOn = True @@ -289,12 +290,13 @@ } 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 @@ -501,6 +503,9 @@ instance PluginMethod Request Method_TextDocumentTypeDefinition where handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc +instance PluginMethod Request Method_TextDocumentImplementation where + handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc + instance PluginMethod Request Method_TextDocumentDocumentHighlight where handlesRequest _ msgParams pluginDesc _ = pluginSupportsFileType msgParams pluginDesc @@ -511,6 +516,12 @@ -- 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 @@ -688,6 +699,11 @@ | Just (Just True) <- caps ^? (L.textDocument . _Just . L.typeDefinition . _Just . L.linkSupport) = foldl' mergeDefinitions x xs | otherwise = downgradeLinks $ foldl' mergeDefinitions x xs +instance PluginRequestMethod Method_TextDocumentImplementation where + combineResponses _ _ caps _ (x :| xs) + | Just (Just True) <- caps ^? (L.textDocument . _Just . L.implementation . _Just . L.linkSupport) = foldl' mergeDefinitions x xs + | otherwise = downgradeLinks $ foldl' mergeDefinitions x xs + instance PluginRequestMethod Method_TextDocumentDocumentHighlight where instance PluginRequestMethod Method_TextDocumentReferences where @@ -711,7 +727,7 @@ combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentHover where - combineResponses _ _ _ _ (mapMaybe nullToMaybe . toList -> hs :: [Hover]) = + combineResponses _ _ _ _ (mapMaybe nullToMaybe . toList -> (hs :: [Hover])) = if null hs then InR Null else InL $ Hover (InL mcontent) r @@ -810,6 +826,9 @@ 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]) @@ -899,29 +918,15 @@ -- | Restricted version of 'LspM' specific to plugins. -- --- We plan to use this monad for running plugins instead of 'LspM', since there --- are parts of the LSP server state which plugins should not access directly, --- but instead only via the build system. Note that this restriction of the LSP --- server state has not yet been implemented. See 'pluginGetVirtualFile'. +-- We use this monad for running plugins instead of 'LspM', since there are +-- parts of the LSP server state which plugins should not access directly, but +-- instead only via the build system. newtype HandlerM config a = HandlerM { _runHandlerM :: LspM config a } deriving newtype (Applicative, Functor, Monad, MonadIO, MonadUnliftIO) runHandlerM :: HandlerM config a -> LspM config a runHandlerM = _runHandlerM --- | Wrapper of 'getVirtualFile' for HandlerM --- --- TODO: To be replaced by a lookup of the Shake build graph -pluginGetVirtualFile :: NormalizedUri -> HandlerM config (Maybe VirtualFile) -pluginGetVirtualFile uri = HandlerM $ getVirtualFile uri - --- | Version of 'getVersionedTextDoc' for HandlerM --- --- TODO: Should use 'pluginGetVirtualFile' instead of wrapping 'getVersionedTextDoc'. --- At the time of writing, 'getVersionedTextDoc' of the "lsp" package is implemented with 'getVirtualFile'. -pluginGetVersionedTextDoc :: TextDocumentIdentifier -> HandlerM config VersionedTextDocumentIdentifier -pluginGetVersionedTextDoc = HandlerM . getVersionedTextDoc - -- | Wrapper of 'getClientCapabilities' for HandlerM pluginGetClientCapabilities :: HandlerM config ClientCapabilities pluginGetClientCapabilities = HandlerM getClientCapabilities @@ -1183,30 +1188,7 @@ -> FormattingOptions -> ExceptT PluginError (HandlerM Config) ([TextEdit] |? Null) -mkFormattingHandlers :: forall a. FormattingHandler a -> PluginHandlers a -mkFormattingHandlers f = mkPluginHandler SMethod_TextDocumentFormatting ( provider SMethod_TextDocumentFormatting) - <> mkPluginHandler SMethod_TextDocumentRangeFormatting (provider SMethod_TextDocumentRangeFormatting) - where - provider :: forall m. FormattingMethod m => SMethod m -> PluginMethodHandler a m - provider m ide _pid params - | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - mf <- lift $ pluginGetVirtualFile $ toNormalizedUri uri - case mf of - Just vf -> do - let (typ, mtoken) = case m of - SMethod_TextDocumentFormatting -> (FormatText, params ^. L.workDoneToken) - SMethod_TextDocumentRangeFormatting -> (FormatRange (params ^. L.range), params ^. L.workDoneToken) - _ -> Prelude.error "mkFormattingHandlers: impossible" - f ide mtoken typ (virtualFileText vf) nfp opts - Nothing -> throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: could not get file contents for " ++ show uri - - | otherwise = throwError $ PluginInvalidParams $ T.pack $ "Formatter plugin: uriToFilePath failed for: " ++ show uri - where - uri = params ^. L.textDocument . L.uri - opts = params ^. L.options - -- --------------------------------------------------------------------- - data FallbackCodeActionParams = FallbackCodeActionParams