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.11.0.0 +version: 2.12.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at @@ -60,13 +60,13 @@ , data-default , dependent-map , dependent-sum >=0.7 - , Diff ^>=0.5 + , Diff ^>=0.5 || ^>=1.0.0 , dlist , extra , filepath , ghc , hashable - , hls-graph == 2.11.0.0 + , hls-graph == 2.12.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 @@ -72,6 +72,7 @@ <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ <*> o .:? "hoverOn" .!= plcHoverOn def <*> o .:? "symbolsOn" .!= plcSymbolsOn def + <*> o .:? "signatureHelpOn" .!= plcSignatureHelpOn def <*> o .:? "completionOn" .!= plcCompletionOn def <*> o .:? "renameOn" .!= plcRenameOn def <*> o .:? "selectionRangeOn" .!= plcSelectionRangeOn 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 @@ -3,7 +3,11 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -module Ide.Plugin.ConfigUtils where +module Ide.Plugin.ConfigUtils ( + pluginsToDefaultConfig, + pluginsToVSCodeExtensionSchema, + pluginsCustomConfigToMarkdownTables + ) where import Control.Lens (at, (&), (?~)) import qualified Data.Aeson as A @@ -15,8 +19,15 @@ import Data.List.Extra (nubOrd) import Data.String (IsString (fromString)) import qualified Data.Text as T +import GHC.TypeLits (symbolVal) import Ide.Plugin.Config -import Ide.Plugin.Properties (toDefaultJSON, +import Ide.Plugin.Properties (KeyNameProxy, MetaData (..), + PluginCustomConfig (..), + PluginCustomConfigParam (..), + Properties (..), + SPropertyKey (..), + SomePropertyKeyWithMetaData (..), + toDefaultJSON, toVSCodeExtensionSchema) import Ide.Types import Language.LSP.Protocol.Message @@ -31,10 +42,10 @@ pluginsToDefaultConfig IdePlugins {..} = -- Use '_Object' and 'at' to get at the "plugin" key -- and actually set it. - A.toJSON defaultConfig & _Object . at "plugin" ?~ elems + A.toJSON defaultConfig & _Object . at "plugin" ?~ pluginSpecificDefaultConfigs where - defaultConfig@Config {} = def - elems = A.object $ mconcat $ singlePlugin <$> ipMap + defaultConfig = def :: Config + pluginSpecificDefaultConfigs = A.object $ mconcat $ singlePlugin <$> ipMap -- Splice genericDefaultConfig and dedicatedDefaultConfig -- Example: -- @@ -48,6 +59,7 @@ -- } -- } -- } + singlePlugin :: PluginDescriptor ideState -> [A.Pair] singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = let x = genericDefaultConfig <> dedicatedDefaultConfig in [fromString (T.unpack pId) A..= A.object x | not $ null x] @@ -66,8 +78,8 @@ <> nubOrd (mconcat (handlersToGenericDefaultConfig configInitialGenericConfig <$> handlers)) in case x of - -- if the plugin has only one capability, we produce globalOn instead of the specific one; - -- otherwise we don't produce globalOn at all + -- If the plugin has only one capability, we produce globalOn instead of the specific one; + -- otherwise we omit globalOn [_] -> ["globalOn" A..= plcGlobalOn configInitialGenericConfig] _ -> x -- Example: @@ -92,6 +104,7 @@ SMethod_TextDocumentRename -> ["renameOn" A..= plcRenameOn] SMethod_TextDocumentHover -> ["hoverOn" A..= plcHoverOn] SMethod_TextDocumentDocumentSymbol -> ["symbolsOn" A..= plcSymbolsOn] + SMethod_TextDocumentSignatureHelp -> ["signatureHelpOn" A..= plcSignatureHelpOn] SMethod_TextDocumentCompletion -> ["completionOn" A..= plcCompletionOn] SMethod_TextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn] SMethod_TextDocumentSemanticTokensFull -> ["semanticTokensOn" A..= plcSemanticTokensOn] @@ -125,6 +138,7 @@ SMethod_TextDocumentRename -> [toKey' "renameOn" A..= schemaEntry "rename" plcRenameOn] SMethod_TextDocumentHover -> [toKey' "hoverOn" A..= schemaEntry "hover" plcHoverOn] SMethod_TextDocumentDocumentSymbol -> [toKey' "symbolsOn" A..= schemaEntry "symbols" plcSymbolsOn] + SMethod_TextDocumentSignatureHelp -> [toKey' "signatureHelpOn" A..= schemaEntry "signature help" plcSignatureHelpOn] SMethod_TextDocumentCompletion -> [toKey' "completionOn" A..= schemaEntry "completions" plcCompletionOn] SMethod_TextDocumentPrepareCallHierarchy -> [toKey' "callHierarchyOn" A..= schemaEntry "call hierarchy" plcCallHierarchyOn] SMethod_TextDocumentSemanticTokensFull -> [toKey' "semanticTokensOn" A..= schemaEntry "semantic tokens" plcSemanticTokensOn] @@ -139,3 +153,92 @@ ] withIdPrefix x = "haskell.plugin." <> pId <> "." <> x toKey' = fromString . T.unpack . withIdPrefix + + +-- | Generates markdown tables for custom config +pluginsCustomConfigToMarkdownTables :: IdePlugins a -> T.Text +pluginsCustomConfigToMarkdownTables IdePlugins {..} = T.unlines + $ map renderCfg + $ filter (\(PluginCustomConfig _ params) -> not $ null params) + $ map toPluginCustomConfig ipMap + where + toPluginCustomConfig :: PluginDescriptor ideState -> PluginCustomConfig + toPluginCustomConfig PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {configCustomConfig = c}, pluginId = PluginId pId} = + PluginCustomConfig { pcc'Name = pId, pcc'Params = toPluginCustomConfigParams c} + toPluginCustomConfigParams :: CustomConfig -> [PluginCustomConfigParam] + toPluginCustomConfigParams (CustomConfig p) = toPluginCustomConfigParams' p + toPluginCustomConfigParams' :: Properties r -> [PluginCustomConfigParam] + toPluginCustomConfigParams' EmptyProperties = [] + toPluginCustomConfigParams' (ConsProperties (keyNameProxy :: KeyNameProxy s) (k :: SPropertyKey k) (m :: MetaData t) xs) = + toEntry (SomePropertyKeyWithMetaData k m) : toPluginCustomConfigParams' xs + where + toEntry :: SomePropertyKeyWithMetaData -> PluginCustomConfigParam + toEntry (SomePropertyKeyWithMetaData SNumber MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData SInteger MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData SString MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData SBoolean MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData (SObject _) MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = "TODO: nested object", -- T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData (SArray _) MetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = "TODO: Array values", -- T.pack $ show defaultValue, + pccp'EnumValues = [] + } + toEntry (SomePropertyKeyWithMetaData (SEnum _) EnumMetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = map (T.pack . show) enumValues + } + toEntry (SomePropertyKeyWithMetaData SProperties PropertiesMetaData {..}) = + PluginCustomConfigParam { + pccp'Name = T.pack $ symbolVal keyNameProxy, + pccp'Description = description, + pccp'Default = T.pack $ show defaultValue, + pccp'EnumValues = [] + } + renderCfg :: PluginCustomConfig -> T.Text + renderCfg (PluginCustomConfig pId pccParams) = + T.unlines (pluginHeader : tableHeader : rows pccParams) + where + pluginHeader = "## " <> pId + tableHeader = + "| Property | Description | Default | Allowed values |" <> "\n" <> + "| --- | --- | --- | --- |" + rows = map renderRow + renderRow PluginCustomConfigParam {..} = + "| `" <> pccp'Name <> "` | " <> pccp'Description <> " | `" <> pccp'Default <> "` | " <> renderEnum pccp'EnumValues <> " |" + renderEnum [] = "   " -- Placeholder to prevent missing cells + renderEnum vs = "" diff --git a/src/Ide/Plugin/Properties.hs b/src/Ide/Plugin/Properties.hs --- a/src/Ide/Plugin/Properties.hs +++ b/src/Ide/Plugin/Properties.hs @@ -21,9 +21,10 @@ MetaData (..), PropertyKey (..), SPropertyKey (..), + SomePropertyKeyWithMetaData (..), KeyNameProxy (..), KeyNamePath (..), - Properties, + Properties(..), HasProperty, HasPropertyByPath, emptyProperties, @@ -42,6 +43,8 @@ usePropertyByPathEither, usePropertyByPath, (&), + PluginCustomConfig(..), + PluginCustomConfigParam(..), ) where @@ -516,3 +519,15 @@ ] (SomePropertyKeyWithMetaData SProperties PropertiesMetaData {..}) -> map (first Just) $ toVSCodeExtensionSchema' childrenProperties + +data PluginCustomConfig = PluginCustomConfig { + pcc'Name :: T.Text, + pcc'Params :: [PluginCustomConfigParam] +} +data PluginCustomConfigParam = PluginCustomConfigParam { + pccp'Name :: T.Text, + pccp'Description :: T.Text, + pccp'Default :: T.Text, + pccp'EnumValues :: [T.Text] +} + diff --git a/src/Ide/Types.hs b/src/Ide/Types.hs --- a/src/Ide/Types.hs +++ b/src/Ide/Types.hs @@ -263,6 +263,7 @@ , plcDiagnosticsOn :: !Bool , plcHoverOn :: !Bool , plcSymbolsOn :: !Bool + , plcSignatureHelpOn :: !Bool , plcCompletionOn :: !Bool , plcRenameOn :: !Bool , plcSelectionRangeOn :: !Bool @@ -281,6 +282,7 @@ , plcDiagnosticsOn = True , plcHoverOn = True , plcSymbolsOn = True + , plcSignatureHelpOn = True , plcCompletionOn = True , plcRenameOn = True , plcSelectionRangeOn = True @@ -290,7 +292,7 @@ } instance ToJSON PluginConfig where - toJSON (PluginConfig g ch ca ih cl d h s c rn sr fr st cfg) = r + toJSON (PluginConfig g ch ca ih cl d h s sh c rn sr fr st cfg) = r where r = object [ "globalOn" .= g , "callHierarchyOn" .= ch @@ -300,6 +302,7 @@ , "diagnosticsOn" .= d , "hoverOn" .= h , "symbolsOn" .= s + , "signatureHelpOn" .= sh , "completionOn" .= c , "renameOn" .= rn , "selectionRangeOn" .= sr @@ -541,6 +544,9 @@ instance PluginMethod Request Method_TextDocumentDocumentSymbol where handlesRequest = pluginEnabledWithFeature plcSymbolsOn +instance PluginMethod Request Method_TextDocumentSignatureHelp where + handlesRequest = pluginEnabledWithFeature plcSignatureHelpOn + instance PluginMethod Request Method_CompletionItemResolve where -- See Note [Resolve in PluginHandlers] handlesRequest = pluginEnabledResolve plcCompletionOn @@ -763,6 +769,9 @@ name' = ds ^. L.name si = SymbolInformation name' (ds ^. L.kind) Nothing parent (ds ^. L.deprecated) loc in [si] <> children' + +instance PluginRequestMethod Method_TextDocumentSignatureHelp where + combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_CompletionItemResolve where -- A resolve request should only have one response.