diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 33d3cb8fbd..ad67a5f2f4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -47,7 +47,7 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginRules = produceCompletions , pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP , pluginCommands = [extendImportCommand] - , pluginCustomConfig = mkCustomConfig properties + , pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} } produceCompletions :: Rules () diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index 9d6892bf75..4d9a6b3877 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -33,7 +33,8 @@ descriptors = descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) { pluginHandlers = mkPluginHandler STextDocumentHover hover' - <> mkPluginHandler STextDocumentDocumentSymbol symbolsProvider + <> mkPluginHandler STextDocumentDocumentSymbol symbolsProvider, + pluginConfigDescriptor = defaultConfigDescriptor {configEnableGenericConfig = False} } -- --------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 0b117b9fcc..a638b75801 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -17,8 +17,8 @@ import Control.DeepSeq (rwhnf) import Control.Monad (mzero) import Control.Monad.Extra (whenMaybe) import Control.Monad.IO.Class (MonadIO (liftIO)) -import qualified Data.Aeson.Types as A import Data.Aeson.Types (Value (..), toJSON) +import qualified Data.Aeson.Types as A import qualified Data.HashMap.Strict as Map import Data.List (find) import Data.Maybe (catMaybes, fromJust) @@ -60,6 +60,8 @@ import Ide.Types (CommandFunction, PluginCommand (PluginCommand), PluginDescriptor (..), PluginId, + configCustomConfig, + defaultConfigDescriptor, defaultPluginDescriptor, mkCustomConfig, mkPluginHandler) @@ -90,7 +92,7 @@ descriptor plId = { pluginHandlers = mkPluginHandler STextDocumentCodeLens codeLensProvider , pluginCommands = [PluginCommand (CommandId typeLensCommandId) "adds a signature" commandHandler] , pluginRules = rules - , pluginCustomConfig = mkCustomConfig properties + , pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} } properties :: Properties '[ 'PropertyKey "mode" ('TEnum Mode)] @@ -212,8 +214,8 @@ data Mode deriving (Eq, Ord, Show, Read, Enum) instance A.ToJSON Mode where - toJSON Always = "always" - toJSON Exported = "exported" + toJSON Always = "always" + toJSON Exported = "exported" toJSON Diagnostics = "diagnostics" instance A.FromJSON Mode where diff --git a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs index 4badc44d43..2deb8872a6 100644 --- a/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs +++ b/hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs @@ -5,14 +5,16 @@ module Ide.Plugin.ConfigUtils where -import qualified Data.Aeson as A -import qualified Data.Aeson.Types as A -import Data.Default (def) -import qualified Data.Dependent.Map as DMap -import qualified Data.Dependent.Sum as DSum -import qualified Data.HashMap.Lazy as HMap +import qualified Data.Aeson as A +import qualified Data.Aeson.Types as A +import Data.Containers.ListUtils (nubOrd) +import Data.Default (def) +import qualified Data.Dependent.Map as DMap +import qualified Data.Dependent.Sum as DSum +import qualified Data.HashMap.Lazy as HMap import Ide.Plugin.Config -import Ide.Plugin.Properties (toDefaultJSON, toVSCodeExtensionSchema) +import Ide.Plugin.Properties (toDefaultJSON, + toVSCodeExtensionSchema) import Ide.Types import Language.LSP.Types @@ -49,7 +51,7 @@ pluginsToDefaultConfig IdePlugins {..} = -- } -- } -- } - singlePlugin PluginDescriptor {..} = + singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = let x = genericDefaultConfig <> dedicatedDefaultConfig in [pId A..= A.object x | not $ null x] where @@ -58,20 +60,17 @@ pluginsToDefaultConfig IdePlugins {..} = -- Example: -- -- { - -- "globalOn": true, -- "codeActionsOn": true, -- "codeLensOn": true -- } -- - -- we don't generate the config section if the plugin doesn't register any of the following six methods, - -- which avoids producing trivial configuration for formatters: - -- - -- "stylish-haskell": { - -- "globalOn": true - -- } genericDefaultConfig = - let x = mconcat (handlersToGenericDefaultConfig <$> handlers) - in ["globalOn" A..= True | not $ null x] <> x + let x = ["diagnosticsOn" A..= True | configHasDiagnostics] <> nubOrd (mconcat (handlersToGenericDefaultConfig <$> 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 + [_] -> ["globalOn" A..= True] + _ -> x -- Example: -- -- { @@ -80,7 +79,7 @@ pluginsToDefaultConfig IdePlugins {..} = -- } --} dedicatedDefaultConfig = - let x = customConfigToDedicatedDefaultConfig pluginCustomConfig + let x = customConfigToDedicatedDefaultConfig configCustomConfig in ["config" A..= A.object x | not $ null x] (PluginId pId) = pluginId @@ -101,13 +100,21 @@ pluginsToDefaultConfig IdePlugins {..} = pluginsToVSCodeExtensionSchema :: IdePlugins a -> A.Value pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlugin <$> map snd ipMap where - singlePlugin PluginDescriptor {..} = genericSchema <> dedicatedSchema + singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = genericSchema <> dedicatedSchema where (PluginHandlers (DMap.toList -> handlers)) = pluginHandlers customConfigToDedicatedSchema (CustomConfig p) = toVSCodeExtensionSchema (withIdPrefix "config.") p (PluginId pId) = pluginId - genericSchema = withIdPrefix "globalOn" A..= schemaEntry "plugin" : mconcat (handlersToGenericSchema <$> handlers) - dedicatedSchema = customConfigToDedicatedSchema pluginCustomConfig + genericSchema = + let x = + [withIdPrefix "diagnosticsOn" A..= schemaEntry "diagnostics" | configHasDiagnostics] + <> nubOrd (mconcat (handlersToGenericSchema <$> 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 + [_] -> [withIdPrefix "globalOn" A..= schemaEntry "plugin"] + _ -> x + dedicatedSchema = customConfigToDedicatedSchema configCustomConfig handlersToGenericSchema (IdeMethod m DSum.:=> _) = case m of STextDocumentCodeAction -> [withIdPrefix "codeActionsOn" A..= schemaEntry "code actions"] STextDocumentCodeLens -> [withIdPrefix "codeLensOn" A..= schemaEntry "code lenses"] diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index 4622707621..c17171b2f0 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -63,19 +63,47 @@ data PluginDescriptor ideState = , pluginRules :: !(Rules ()) , pluginCommands :: ![PluginCommand ideState] , pluginHandlers :: PluginHandlers ideState - , pluginCustomConfig :: CustomConfig + , pluginConfigDescriptor :: ConfigDescriptor , pluginNotificationHandlers :: PluginNotificationHandlers ideState } --- | An existential wrapper of 'Properties', used only for documenting and generating config templates +-- | An existential wrapper of 'Properties' data CustomConfig = forall r. CustomConfig (Properties r) -emptyCustomConfig :: CustomConfig -emptyCustomConfig = CustomConfig emptyProperties +-- | Describes the configuration a plugin. +-- A plugin may be configurable in such form: +-- @ +-- { +-- "plugin-id": { +-- "globalOn": true, +-- "codeActionsOn": true, +-- "codeLensOn": true, +-- "config": { +-- "property1": "foo" +-- } +-- } +-- } +-- @ +-- @globalOn@, @codeActionsOn@, and @codeLensOn@ etc. are called generic configs, +-- which can be inferred from handlers registered by the plugin. +-- @config@ is called custom config, which is defined using 'Properties'. +data ConfigDescriptor = ConfigDescriptor { + -- | Whether or not to generate generic configs. + configEnableGenericConfig :: Bool, + -- | Whether or not to generate @diagnosticsOn@ config. + -- Diagnostics emit in arbitrary shake rules, + -- so we can't know statically if the plugin produces diagnostics + configHasDiagnostics :: Bool, + -- | Custom config. + configCustomConfig :: CustomConfig +} mkCustomConfig :: Properties r -> CustomConfig mkCustomConfig = CustomConfig +defaultConfigDescriptor :: ConfigDescriptor +defaultConfigDescriptor = ConfigDescriptor True False (mkCustomConfig emptyProperties) + -- | Methods that can be handled by plugins. -- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method -- Only methods for which we know how to combine responses can be instances of 'PluginMethod' @@ -267,7 +295,7 @@ defaultPluginDescriptor plId = mempty mempty mempty - emptyCustomConfig + defaultConfigDescriptor mempty newtype CommandId = CommandId T.Text diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 4877b7b7b8..993c889775 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -96,6 +96,7 @@ descriptor plId = (defaultPluginDescriptor plId) , PluginCommand "applyAll" "Apply all hints to the file" applyAllCmd ] , pluginHandlers = mkPluginHandler STextDocumentCodeAction codeActionProvider + , pluginConfigDescriptor = defaultConfigDescriptor {configHasDiagnostics = True} } -- This rule only exists for generating file diagnostics diff --git a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs index ab758cc91d..f1753739e2 100644 --- a/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs +++ b/plugins/hls-tactics-plugin/src/Wingman/Plugin.hs @@ -60,8 +60,8 @@ descriptor plId = (defaultPluginDescriptor plId) , mkPluginHandler STextDocumentCodeLens codeLensProvider ] , pluginRules = wingmanRules plId - , pluginCustomConfig = - mkCustomConfig properties + , pluginConfigDescriptor = + defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} }