Skip to content

Commit 1ea6e98

Browse files
pepeiborrapepeiborra
committed
Support initial generic config for plugins
This enables opt-in plugins, i.e. plugins that are not enabled by default
1 parent b289e48 commit 1ea6e98

File tree

15 files changed

+100
-64
lines changed

15 files changed

+100
-64
lines changed

‎exe/Wrapper.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,7 @@ import Development.IDE.Types.Logger (Logger (Logger),
5454
makeDefaultStderrRecorder)
5555
import GHC.Stack.Types (emptyCallStack)
5656
import Ide.Plugin.Config (Config)
57+
import Ide.Types (IdePlugins (IdePlugins))
5758
import Language.LSP.Server (LspM)
5859
import qualified Language.LSP.Server as LSP
5960
import Language.LSP.Types (MessageActionItem (MessageActionItem),
@@ -276,7 +277,7 @@ launchErrorLSP errorMsg = do
276277

277278
let logger = Logger $ \p m -> logger_ recorder (WithPriority p emptyCallStack (pretty m))
278279

279-
let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) logger
280+
let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) logger (IdePlugins [])
280281

281282
inH <- Main.argsHandleIn defaultArguments
282283

‎ghcide/exe/Main.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -121,8 +121,8 @@ main = withTelemetryLogger $ \telemetryLogger -> do
121121

122122
let arguments =
123123
if argsTesting
124-
then IDEMain.testing (cmapWithPrio LogIDEMain recorder) logger
125-
else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger
124+
then IDEMain.testing (cmapWithPrio LogIDEMain recorder) logger hlsPlugins
125+
else IDEMain.defaultArguments (cmapWithPrio LogIDEMain recorder) logger hlsPlugins
126126

127127
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder) arguments
128128
{ IDEMain.argsProjectRoot = Just argsCwd

‎ghcide/src/Development/IDE/Core/Rules.hs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -157,7 +157,7 @@ import qualified Development.IDE.Core.Shake as Shake
157157
import qualified Development.IDE.Types.Logger as Logger
158158
import qualified Development.IDE.Types.Shake as Shake
159159
import Development.IDE.GHC.CoreFile
160-
import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)
160+
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
161161
import Control.Monad.IO.Unlift
162162
#if MIN_VERSION_ghc(9,3,0)
163163
import GHC.Unit.Module.Graph
@@ -344,7 +344,7 @@ getParsedModuleWithCommentsRule recorder =
344344
getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a
345345
getModifyDynFlags f = do
346346
opts <- getIdeOptions
347-
cfg <- getClientConfigAction def
347+
cfg <- getClientConfigAction
348348
pure $ f $ optModifyDynFlags opts cfg
349349

350350

@@ -1062,9 +1062,11 @@ getClientSettingsRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake
10621062

10631063
-- | Returns the client configurarion stored in the IdeState.
10641064
-- You can use this function to access it from shake Rules
1065-
getClientConfigAction :: Config -- ^ default value
1066-
-> Action Config
1067-
getClientConfigAction defValue = do
1065+
getClientConfigAction :: Action Config
1066+
getClientConfigAction = do
1067+
lspEnv <- lspEnv <$> getShakeExtras
1068+
currentConfig <- (`LSP.runLspT` LSP.getConfig) `traverse` lspEnv
1069+
let defValue = fromMaybe (defConfig mempty) currentConfig
10681070
mbVal <- unhashed <$> useNoFile_ GetClientSettings
10691071
case A.parse (parseConfig defValue) <$> mbVal of
10701072
Just (Success c) -> return c
@@ -1077,7 +1079,7 @@ usePropertyAction ::
10771079
Properties r ->
10781080
Action (ToHsType t)
10791081
usePropertyAction kn plId p = do
1080-
config <- getClientConfigAction def
1082+
config <- getClientConfigAction
10811083
let pluginConfig = configForPlugin config plId
10821084
pure $ useProperty kn p $ plcConfig pluginConfig
10831085

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 9 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -123,6 +123,7 @@ import Ide.Types (IdeCommand (IdeComman
123123
IdePlugins,
124124
PluginDescriptor (PluginDescriptor, pluginCli),
125125
PluginId (PluginId),
126+
defConfigForPlugins,
126127
ipMap, pluginId)
127128
import qualified Language.LSP.Server as LSP
128129
import qualified "list-t" ListT
@@ -249,21 +250,21 @@ data Arguments = Arguments
249250
, argsMonitoring :: IO Monitoring
250251
}
251252

252-
defaultArguments :: Recorder (WithPriority Log) -> Logger -> Arguments
253-
defaultArguments recorder logger = Arguments
253+
defaultArguments :: Recorder (WithPriority Log) -> Logger -> IdePlugins IdeState -> Arguments
254+
defaultArguments recorder logger plugins = Arguments
254255
{ argsProjectRoot = Nothing
255256
, argCommand = LSP
256257
, argsLogger = pure logger
257258
, argsRules = mainRule (cmapWithPrio LogRules recorder) def >> action kick
258259
, argsGhcidePlugin = mempty
259-
, argsHlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde recorder))
260+
, argsHlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde recorder)) <> plugins
260261
, argsSessionLoadingOptions = def
261262
, argsIdeOptions = \config ghcSession -> (defaultIdeOptions ghcSession)
262263
{ optCheckProject = pure $ checkProject config
263264
, optCheckParents = pure $ checkParents config
264265
}
265266
, argsLspOptions = def {LSP.completionTriggerCharacters = Just "."}
266-
, argsDefaultHlsConfig = def
267+
, argsDefaultHlsConfig = defConfigForPlugins plugins
267268
, argsGetHieDbLoc = getHieDbLoc
268269
, argsDebouncer = newAsyncDebouncer
269270
, argsThreads = Nothing
@@ -286,10 +287,11 @@ defaultArguments recorder logger = Arguments
286287
}
287288

288289

289-
testing :: Recorder (WithPriority Log) -> Logger -> Arguments
290-
testing recorder logger =
290+
testing :: Recorder (WithPriority Log) -> Logger -> IdePlugins IdeState -> Arguments
291+
testing recorder logger plugins =
291292
let
292-
arguments@Arguments{ argsHlsPlugins, argsIdeOptions } = defaultArguments recorder logger
293+
arguments@Arguments{ argsHlsPlugins, argsIdeOptions } =
294+
defaultArguments recorder logger plugins
293295
hlsPlugins = pluginDescToIdePlugins $
294296
idePluginsToPluginDesc argsHlsPlugins
295297
++ [Test.blockCommandDescriptor "block-command", Test.plugin]

‎ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ descriptor plId = (defaultPluginDescriptor plId)
5454
<> mkPluginHandler STextDocumentReferences (\ide _ params -> references ide params)
5555
<> mkPluginHandler SWorkspaceSymbol (\ide _ params -> wsSymbols ide params),
5656

57-
pluginConfigDescriptor = defaultConfigDescriptor {configEnableGenericConfig = False}
57+
pluginConfigDescriptor = defaultConfigDescriptor {configInitialGenericConfig = Nothing }
5858
}
5959

6060
-- ---------------------------------------------------------------------

‎ghcide/test/exe/Main.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3204,7 +3204,7 @@ unitTests recorder logger = do
32043204
] ++ Ghcide.descriptors (cmapWithPrio LogGhcIde recorder)
32053205
priorityPluginDescriptor i = (defaultPluginDescriptor $ fromString $ show i){pluginPriority = i}
32063206

3207-
testIde recorder (IDE.testing (cmapWithPrio LogIDEMain recorder) logger){IDE.argsHlsPlugins = plugins} $ do
3207+
testIde recorder (IDE.testing (cmapWithPrio LogIDEMain recorder) logger plugins) $ do
32083208
_ <- createDoc "A.hs" "haskell" "module A where"
32093209
waitForProgressDone
32103210
actualOrder <- liftIO $ reverse <$> readIORef orderRef

‎ghcide/test/src/Development/IDE/Test.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,6 @@ import Control.Monad.IO.Class
4040
import Data.Aeson (toJSON)
4141
import qualified Data.Aeson as A
4242
import Data.Bifunctor (second)
43-
import Data.Default
4443
import qualified Data.Map.Strict as Map
4544
import Data.Maybe (fromJust)
4645
import Data.Text (Text)
@@ -49,7 +48,8 @@ import Development.IDE.Plugin.Test (TestRequest (..),
4948
WaitForIdeRuleResult,
5049
ideResultSuccess)
5150
import Development.IDE.Test.Diagnostic
52-
import Ide.Plugin.Config (CheckParents, checkProject)
51+
import Ide.Plugin.Config (CheckParents, checkProject,
52+
defConfig)
5353
import Language.LSP.Test hiding (message)
5454
import qualified Language.LSP.Test as LspTest
5555
import Language.LSP.Types hiding
@@ -244,7 +244,7 @@ configureCheckProject :: Bool -> Session ()
244244
configureCheckProject overrideCheckProject =
245245
sendNotification SWorkspaceDidChangeConfiguration
246246
(DidChangeConfigurationParams $ toJSON
247-
def{checkProject = overrideCheckProject})
247+
(defConfig mempty){checkProject = overrideCheckProject})
248248

249249
-- | Pattern match a message from ghcide indicating that a file has been indexed
250250
isReferenceReady :: FilePath -> Session ()

‎haskell-language-server.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -270,7 +270,7 @@ common splice
270270
cpp-options: -Dhls_splice
271271

272272
common alternateNumberFormat
273-
if flag(alternateNumberFormat)
273+
if flag(alternateNumberFormat)
274274
build-depends: hls-alternate-number-format-plugin ^>= 1.2
275275
cpp-options: -Dhls_alternateNumberFormat
276276

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

Lines changed: 28 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -5,21 +5,28 @@
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE RecordWildCards #-}
77
{-# LANGUAGE TypeFamilies #-}
8+
{-# LANGUAGE ViewPatterns #-}
89
module Ide.Plugin.Config
910
( getConfigFromNotification
1011
, Config(..)
12+
, defConfig
1113
, parseConfig
1214
, PluginConfig(..)
1315
, CheckParents(..)
1416
) where
1517

1618
import Control.Applicative
19+
import Control.Lens (preview)
1720
import Data.Aeson hiding (Error)
1821
import qualified Data.Aeson as A
22+
import Data.Aeson.Lens (_String)
23+
import Data.Aeson.Types (explicitParseFieldMaybe)
1924
import qualified Data.Aeson.Types as A
2025
import Data.Default
2126
import qualified Data.Map as Map
27+
import Data.Maybe (fromMaybe)
2228
import qualified Data.Text as T
29+
import GHC.Exts (toList)
2330
import GHC.Generics (Generic)
2431

2532
-- ---------------------------------------------------------------------
@@ -54,18 +61,22 @@ data Config =
5461
, plugins :: !(Map.Map T.Text PluginConfig)
5562
} deriving (Show,Eq)
5663

57-
instance Default Config where
58-
def = Config
64+
-- | Default configuration values
65+
defConfig :: Map.Map T.Text PluginConfig -> Config
66+
defConfig defPlugins = Config
5967
{ checkParents = CheckOnSave
6068
, checkProject = True
6169
-- , formattingProvider = "brittany"
6270
, formattingProvider = "ormolu"
6371
-- , formattingProvider = "floskell"
6472
-- , formattingProvider = "stylish-haskell"
6573
, maxCompletions = 40
66-
, plugins = Map.empty
74+
, plugins = defPlugins
6775
}
6876

77+
instance Default Config where
78+
def = defConfig mempty
79+
6980
-- TODO: Add API for plugins to expose their own LSP config options
7081
parseConfig :: Config -> Value -> A.Parser Config
7182
parseConfig defValue = A.withObject "Config" $ \v -> do
@@ -79,7 +90,18 @@ parseConfig defValue = A.withObject "Config" $ \v -> do
7990
<*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue
8091
<*> o .:? "formattingProvider" .!= formattingProvider defValue
8192
<*> o .:? "maxCompletions" .!= maxCompletions defValue
82-
<*> o .:? "plugin" .!= plugins defValue
93+
<*> explicitParseFieldMaybe (parsePlugins $ plugins defValue) o "plugin" .!= plugins defValue
94+
95+
parsePlugins :: Map.Map T.Text PluginConfig -> Value -> A.Parser (Map.Map T.Text PluginConfig)
96+
parsePlugins defValue = A.withObject "Config.plugins" $ \o -> do
97+
let -- parseOne :: Key -> Value -> A.Parser (T.Text, PluginConfig)
98+
parseOne (preview _String . toJSON -> Just pId) pConfig = do
99+
let defPluginConfig = fromMaybe def $ Map.lookup pId defValue
100+
pConfig' <- parsePluginConfig defPluginConfig pConfig
101+
return (pId, pConfig')
102+
parseOne _ _ = fail "Expected plugin id to be a string"
103+
plugins <- mapM (uncurry parseOne) (toList o)
104+
return $ Map.fromList plugins
83105

84106
instance A.ToJSON Config where
85107
toJSON Config{..} =
@@ -147,8 +169,8 @@ instance A.ToJSON PluginConfig where
147169
, "config" .= cfg
148170
]
149171

150-
instance A.FromJSON PluginConfig where
151-
parseJSON = A.withObject "PluginConfig" $ \o -> PluginConfig
172+
parsePluginConfig :: PluginConfig -> Value -> A.Parser PluginConfig
173+
parsePluginConfig def= A.withObject "PluginConfig" $ \o -> PluginConfig
152174
<$> o .:? "globalOn" .!= plcGlobalOn def
153175
<*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def
154176
<*> o .:? "codeActionsOn" .!= plcCodeActionsOn def

‎hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs

Lines changed: 16 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ import Control.Lens (at, ix, (&), (?~))
99
import qualified Data.Aeson as A
1010
import Data.Aeson.Lens (_Object)
1111
import qualified Data.Aeson.Types as A
12-
import Data.Default (def)
1312
import qualified Data.Dependent.Map as DMap
1413
import qualified Data.Dependent.Sum as DSum
1514
import Data.List (nub)
@@ -27,13 +26,13 @@ import Language.LSP.Types
2726

2827
-- | Generates a default 'Config', but remains only effective items
2928
pluginsToDefaultConfig :: IdePlugins a -> A.Value
30-
pluginsToDefaultConfig IdePlugins {..} =
29+
pluginsToDefaultConfig plugins@IdePlugins {..} =
3130
-- Use 'ix' to look at all the "haskell" keys in the outer value (since we're not
3231
-- setting it if missing), then we use '_Object' and 'at' to get at the "plugin" key
3332
-- and actually set it.
3433
A.toJSON defaultConfig & ix "haskell" . _Object . at "plugin" ?~ elems
3534
where
36-
defaultConfig@Config {} = def
35+
defaultConfig@Config {} = defConfigForPlugins plugins
3736
elems = A.object $ mconcat $ singlePlugin <$> ipMap
3837
-- Splice genericDefaultConfig and dedicatedDefaultConfig
3938
-- Example:
@@ -61,12 +60,14 @@ pluginsToDefaultConfig IdePlugins {..} =
6160
-- "codeLensOn": true
6261
-- }
6362
--
64-
genericDefaultConfig =
65-
let x = ["diagnosticsOn" A..= True | configHasDiagnostics] <> nub (mconcat (handlersToGenericDefaultConfig <$> handlers))
63+
genericDefaultConfig
64+
| Nothing <- configInitialGenericConfig = []
65+
| Just config <- configInitialGenericConfig =
66+
let x = ["diagnosticsOn" A..= True | configHasDiagnostics] <> nub (mconcat (handlersToGenericDefaultConfig config <$> handlers))
6667
in case x of
6768
-- if the plugin has only one capability, we produce globalOn instead of the specific one;
6869
-- otherwise we don't produce globalOn at all
69-
[_] -> ["globalOn" A..= True]
70+
[_] -> ["globalOn" A..= plcGlobalOn config]
7071
_ -> x
7172
-- Example:
7273
--
@@ -82,15 +83,15 @@ pluginsToDefaultConfig IdePlugins {..} =
8283
(PluginId pId) = pluginId
8384

8485
-- This function captures ide methods registered by the plugin, and then converts it to kv pairs
85-
handlersToGenericDefaultConfig :: DSum.DSum IdeMethod f -> [A.Pair]
86-
handlersToGenericDefaultConfig (IdeMethod m DSum.:=> _) = case m of
87-
STextDocumentCodeAction -> ["codeActionsOn" A..= True]
88-
STextDocumentCodeLens -> ["codeLensOn" A..= True]
89-
STextDocumentRename -> ["renameOn" A..= True]
90-
STextDocumentHover -> ["hoverOn" A..= True]
91-
STextDocumentDocumentSymbol -> ["symbolsOn" A..= True]
92-
STextDocumentCompletion -> ["completionOn" A..= True]
93-
STextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= True]
86+
handlersToGenericDefaultConfig :: PluginConfig -> DSum.DSum IdeMethod f -> [A.Pair]
87+
handlersToGenericDefaultConfig PluginConfig{..} (IdeMethod m DSum.:=> _) = case m of
88+
STextDocumentCodeAction -> ["codeActionsOn" A..= plcCodeActionsOn]
89+
STextDocumentCodeLens -> ["codeLensOn" A..= plcCodeLensOn]
90+
STextDocumentRename -> ["renameOn" A..= plcRenameOn]
91+
STextDocumentHover -> ["hoverOn" A..= plcHoverOn]
92+
STextDocumentDocumentSymbol -> ["symbolsOn" A..= plcSymbolsOn]
93+
STextDocumentCompletion -> ["completionOn" A..= plcCompletionOn]
94+
STextDocumentPrepareCallHierarchy -> ["callHierarchyOn" A..= plcCallHierarchyOn]
9495
_ -> []
9596

9697
-- | Generates json schema used in haskell vscode extension

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

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,7 @@ module Ide.Types
4646
, installSigUsr1Handler
4747
, responseError
4848
, lookupCommandProvider
49+
, defConfigForPlugins
4950
)
5051
where
5152

@@ -220,21 +221,22 @@ data CustomConfig = forall r. CustomConfig (Properties r)
220221
-- which can be inferred from handlers registered by the plugin.
221222
-- @config@ is called custom config, which is defined using 'Properties'.
222223
data ConfigDescriptor = ConfigDescriptor {
223-
-- | Whether or not to generate generic configs.
224-
configEnableGenericConfig :: Bool,
224+
-- | Initial values for the generic config, if the plugin admits one
225+
configInitialGenericConfig :: Maybe PluginConfig,
225226
-- | Whether or not to generate @diagnosticsOn@ config.
226227
-- Diagnostics emit in arbitrary shake rules,
227228
-- so we can't know statically if the plugin produces diagnostics
228-
configHasDiagnostics :: Bool,
229+
configHasDiagnostics :: Bool,
229230
-- | Custom config.
230-
configCustomConfig :: CustomConfig
231+
configCustomConfig :: CustomConfig
231232
}
232233

233234
mkCustomConfig :: Properties r -> CustomConfig
234235
mkCustomConfig = CustomConfig
235236

236237
defaultConfigDescriptor :: ConfigDescriptor
237-
defaultConfigDescriptor = ConfigDescriptor True False (mkCustomConfig emptyProperties)
238+
defaultConfigDescriptor =
239+
ConfigDescriptor (Just Data.Default.def) False (mkCustomConfig emptyProperties)
238240

239241
-- | Methods that can be handled by plugins.
240242
-- 'ExtraParams' captures any extra data the IDE passes to the handlers for this method
@@ -737,6 +739,7 @@ newtype PluginId = PluginId T.Text
737739
instance IsString PluginId where
738740
fromString = PluginId . T.pack
739741

742+
-- | Lookup the current config for a plugin
740743
configForPlugin :: Config -> PluginId -> PluginConfig
741744
configForPlugin config (PluginId plugin)
742745
= Map.findWithDefault Data.Default.def plugin (plugins config)
@@ -748,6 +751,16 @@ pluginEnabledConfig f pid config = plcGlobalOn pluginConfig && f pluginConfig
748751
where
749752
pluginConfig = configForPlugin config pid
750753

754+
defConfigForPlugins :: IdePlugins ideState -> Config
755+
defConfigForPlugins (IdePlugins pp) = defConfig $ Map.fromList
756+
[ (pId, config)
757+
| PluginDescriptor
758+
{ pluginId = PluginId pId
759+
, pluginConfigDescriptor =
760+
ConfigDescriptor{configInitialGenericConfig = Just config}
761+
} <- pp
762+
]
763+
751764
-- ---------------------------------------------------------------------
752765

753766
-- | Format the given Text as a whole or only a @Range@ of it.

0 commit comments

Comments
 (0)