Skip to content

Commit 57b78e7

Browse files
pepeiborramergify[bot]
pepeiborra
and
mergify[bot]
authored
Sanitize the setup of the default Ide.Config (#1361)
* Sanitize the setup of the default Ide.Config * fix getClientConfigAction * fix Hlint * update hls-plugin-api min bound * Drop update config test Co-authored-by: mergify[bot] <37929162+mergify[bot]@users.noreply.github.com>
1 parent 11f6bae commit 57b78e7

File tree

9 files changed

+43
-64
lines changed

9 files changed

+43
-64
lines changed

‎ghcide/ghcide.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -58,7 +58,7 @@ library
5858
haskell-lsp-types == 0.23.*,
5959
haskell-lsp == 0.23.*,
6060
hie-compat,
61-
hls-plugin-api >= 0.7,
61+
hls-plugin-api >= 0.7.1,
6262
lens,
6363
hiedb == 0.3.0.1,
6464
mtl,

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

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -62,9 +62,8 @@ module Development.IDE.Core.Rules(
6262

6363
import Fingerprint
6464

65-
import Data.Aeson (fromJSON,toJSON, Result(Success), FromJSON)
65+
import Data.Aeson (toJSON, Result(Success))
6666
import Data.Binary hiding (get, put)
67-
import Data.Default
6867
import Data.Tuple.Extra
6968
import Control.Monad.Extra
7069
import Control.Monad.Trans.Class
@@ -136,6 +135,8 @@ import GHC.IO.Encoding
136135
import Data.ByteString.Encoding as T
137136

138137
import qualified HieDb
138+
import Ide.Plugin.Config
139+
import qualified Data.Aeson.Types as A
139140

140141
-- | This is useful for rules to convert rules that can only produce errors or
141142
-- a result into the more general IdeResult type that supports producing
@@ -1047,12 +1048,13 @@ getClientSettingsRule = defineEarlyCutOffNoFile $ \GetClientSettings -> do
10471048

10481049
-- | Returns the client configurarion stored in the IdeState.
10491050
-- You can use this function to access it from shake Rules
1050-
getClientConfigAction :: (Default a, FromJSON a) => Action a
1051-
getClientConfigAction = do
1051+
getClientConfigAction :: Config -- ^ default value
1052+
-> Action Config
1053+
getClientConfigAction defValue = do
10521054
mbVal <- unhashed <$> useNoFile_ GetClientSettings
1053-
case fromJSON <$> mbVal of
1055+
case A.parse (parseConfig defValue) <$> mbVal of
10541056
Just (Success c) -> return c
1055-
_ -> return def
1057+
_ -> return defValue
10561058

10571059
-- | For now we always use bytecode
10581060
getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)

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

Lines changed: 5 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,7 @@ import Control.Exception.Safe (
44
Exception (displayException),
55
catchAny,
66
)
7-
import Control.Lens ((^.))
87
import Control.Monad.Extra (concatMapM, unless, when)
9-
import qualified Data.Aeson as J
108
import Data.Default (Default (def))
119
import qualified Data.HashMap.Strict as HashMap
1210
import Data.List.Extra (
@@ -68,17 +66,14 @@ import Development.IDE.Types.Options (
6866
import Development.IDE.Types.Shake (Key (Key))
6967
import Development.Shake (action)
7068
import HIE.Bios.Cradle (findCradle)
71-
import Ide.Plugin.Config (CheckParents (NeverCheck), Config)
69+
import Ide.Plugin.Config (CheckParents (NeverCheck), Config, getInitialConfig, getConfigFromNotification)
7270
import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins)
7371
import Ide.Types (IdePlugins)
7472
import qualified Language.Haskell.LSP.Core as LSP
7573
import Language.Haskell.LSP.Messages (FromServerMessage)
7674
import Language.Haskell.LSP.Types (
77-
DidChangeConfigurationNotification,
78-
InitializeRequest,
7975
LspId (IdInt),
8076
)
81-
import Language.Haskell.LSP.Types.Lens (initializationOptions, params)
8277
import qualified System.Directory.Extra as IO
8378
import System.Exit (ExitCode (ExitFailure), exitWith)
8479
import System.FilePath (takeExtension, takeFileName)
@@ -99,8 +94,7 @@ data Arguments = Arguments
9994
, argsSessionLoadingOptions :: SessionLoadingOptions
10095
, argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions
10196
, argsLspOptions :: LSP.Options
102-
, argsGetInitialConfig :: InitializeRequest -> Either T.Text Config
103-
, argsOnConfigChange :: DidChangeConfigurationNotification -> Either T.Text Config
97+
, argsDefaultHlsConfig :: Config
10498
}
10599

106100
defArguments :: HieDb -> IndexQueue -> Arguments
@@ -117,12 +111,7 @@ defArguments hiedb hiechan =
117111
, argsSessionLoadingOptions = defaultLoadingOptions
118112
, argsIdeOptions = const defaultIdeOptions
119113
, argsLspOptions = def {LSP.completionTriggerCharacters = Just "."}
120-
, argsOnConfigChange = const $ Left "Updating Not supported"
121-
, argsGetInitialConfig = \x -> case x ^. params . initializationOptions of
122-
Nothing -> Right def
123-
Just v -> case J.fromJSON v of
124-
J.Error err -> Left $ T.pack err
125-
J.Success a -> Right a
114+
, argsDefaultHlsConfig = def
126115
}
127116

128117
defaultMain :: Arguments -> IO ()
@@ -134,6 +123,8 @@ defaultMain Arguments{..} = do
134123
hlsCommands = allLspCmdIds' pid argsHlsPlugins
135124
plugins = hlsPlugin <> argsGhcidePlugin
136125
options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands }
126+
argsOnConfigChange = getConfigFromNotification argsDefaultHlsConfig
127+
argsGetInitialConfig = getInitialConfig argsDefaultHlsConfig
137128

138129
case argFiles of
139130
Nothing -> do

‎ghcide/test/exe/Main.hs

Lines changed: 1 addition & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -4762,12 +4762,7 @@ asyncTests = testGroup "async"
47624762

47634763
clientSettingsTest :: TestTree
47644764
clientSettingsTest = testGroup "client settings handling"
4765-
[
4766-
testSession "ghcide does not support update config" $ do
4767-
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON ("" :: String)))
4768-
logNot <- skipManyTill anyMessage loggingNotification
4769-
isMessagePresent "Updating Not supported" [getLogMessage logNot]
4770-
, testSession "ghcide restarts shake session on config changes" $ do
4765+
[ testSession "ghcide restarts shake session on config changes" $ do
47714766
void $ skipManyTill anyMessage $ message @RegisterCapabilityRequest
47724767
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON ("" :: String)))
47734768
nots <- skipManyTill anyMessage $ count 3 loggingNotification

‎hls-plugin-api/hls-plugin-api.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.2
22
name: hls-plugin-api
3-
version: 0.7.0.0
3+
version: 0.7.1.0
44
synopsis: Haskell Language Server API for plugin communication
55
description:
66
Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>

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

Lines changed: 24 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -10,12 +10,14 @@ module Ide.Plugin.Config
1010
getInitialConfig
1111
, getConfigFromNotification
1212
, Config(..)
13+
, parseConfig
1314
, PluginConfig(..)
1415
, CheckParents(..)
1516
) where
1617

1718
import Control.Applicative
1819
import qualified Data.Aeson as A
20+
import qualified Data.Aeson.Types as A
1921
import Data.Aeson hiding ( Error )
2022
import Data.Default
2123
import qualified Data.Text as T
@@ -27,18 +29,18 @@ import GHC.Generics (Generic)
2729

2830
-- | Given a DidChangeConfigurationNotification message, this function returns the parsed
2931
-- Config object if possible.
30-
getConfigFromNotification :: DidChangeConfigurationNotification -> Either T.Text Config
31-
getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams p)) =
32-
case fromJSON p of
32+
getConfigFromNotification :: Config -> DidChangeConfigurationNotification -> Either T.Text Config
33+
getConfigFromNotification defaultValue (NotificationMessage _ _ (DidChangeConfigurationParams p)) =
34+
case A.parse (parseConfig defaultValue) p of
3335
A.Success c -> Right c
3436
A.Error err -> Left $ T.pack err
3537

3638
-- | Given an InitializeRequest message, this function returns the parsed
3739
-- Config object if possible. Otherwise, it returns the default configuration
38-
getInitialConfig :: InitializeRequest -> Either T.Text Config
39-
getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right def
40-
getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) =
41-
case fromJSON opts of
40+
getInitialConfig :: Config -> InitializeRequest -> Either T.Text Config
41+
getInitialConfig defaultValue (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right defaultValue
42+
getInitialConfig defaultValue (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) =
43+
case A.parse (parseConfig defaultValue) opts of
4244
A.Success c -> Right c
4345
A.Error err -> Left $ T.pack err
4446

@@ -93,35 +95,26 @@ instance Default Config where
9395
}
9496

9597
-- TODO: Add API for plugins to expose their own LSP config options
96-
instance A.FromJSON Config where
97-
parseJSON = A.withObject "Config" $ \v -> do
98+
parseConfig :: Config -> Value -> A.Parser Config
99+
parseConfig defValue = A.withObject "Config" $ \v -> do
98100
-- Officially, we use "haskell" as the section name but for
99101
-- backwards compatibility we also accept "languageServerHaskell"
100102
c <- v .: "haskell" <|> v .:? "languageServerHaskell"
101103
case c of
102-
Nothing -> return def
104+
Nothing -> return defValue
103105
Just s -> flip (A.withObject "Config.settings") s $ \o -> Config
104-
<$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents def
105-
<*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject def
106-
<*> o .:? "hlintOn" .!= hlintOn def
107-
<*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange def
108-
<*> o .:? "maxNumberOfProblems" .!= maxNumberOfProblems def
109-
<*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration def
110-
<*> o .:? "liquidOn" .!= liquidOn def
111-
<*> o .:? "completionSnippetsOn" .!= completionSnippetsOn def
112-
<*> o .:? "formatOnImportOn" .!= formatOnImportOn def
113-
<*> o .:? "formattingProvider" .!= formattingProvider def
114-
<*> o .:? "maxCompletions" .!= maxCompletions def
115-
<*> o .:? "plugin" .!= plugins def
116-
117-
-- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"haskell":{"maxNumberOfProblems":100,"hlintOn":true}}}}
118-
-- 2017-10-09 23:22:00.710667381 [ThreadId 15] - reactor:got didChangeConfiguration notification:
119-
-- NotificationMessage
120-
-- {_jsonrpc = "2.0"
121-
-- , _method = WorkspaceDidChangeConfiguration
122-
-- , _params = DidChangeConfigurationParams
123-
-- {_settings = Object (fromList [("haskell",Object (fromList [("hlintOn",Bool True)
124-
-- ,("maxNumberOfProblems",Number 100.0)]))])}}
106+
<$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue
107+
<*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue
108+
<*> o .:? "hlintOn" .!= hlintOn defValue
109+
<*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange defValue
110+
<*> o .:? "maxNumberOfProblems" .!= maxNumberOfProblems defValue
111+
<*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration defValue
112+
<*> o .:? "liquidOn" .!= liquidOn defValue
113+
<*> o .:? "completionSnippetsOn" .!= completionSnippetsOn defValue
114+
<*> o .:? "formatOnImportOn" .!= formatOnImportOn defValue
115+
<*> o .:? "formattingProvider" .!= formattingProvider defValue
116+
<*> o .:? "maxCompletions" .!= maxCompletions defValue
117+
<*> o .:? "plugin" .!= plugins defValue
125118

126119
instance A.ToJSON Config where
127120
toJSON Config{..} =

‎plugins/hls-hlint-plugin/hls-hlint-plugin.cabal

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ library
4343
, hashable
4444
, haskell-lsp
4545
, hlint >=3.2
46-
, hls-plugin-api >=0.7.0.0
46+
, hls-plugin-api >=0.7.1.0
4747
, hslogger
4848
, lens
4949
, regex-tdfa

‎plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,7 @@ import Control.Monad.IO.Class
2424
import Control.Monad.Trans.Except
2525
import Data.Aeson.Types (ToJSON(..), FromJSON(..), Value(..))
2626
import Data.Binary
27+
import Data.Default
2728
import Data.Hashable
2829
import qualified Data.HashMap.Strict as Map
2930
import Data.Maybe
@@ -102,7 +103,7 @@ type instance RuleResult GetHlintDiagnostics = ()
102103
rules :: PluginId -> Rules ()
103104
rules plugin = do
104105
define $ \GetHlintDiagnostics file -> do
105-
config <- getClientConfigAction
106+
config <- getClientConfigAction def
106107
let pluginConfig = configForPlugin config plugin
107108
let hlintOn' = hlintOn config && pluginEnabled pluginConfig plcDiagnosticsOn
108109
ideas <- if hlintOn' then getIdeas file else return (Right [])

‎src/Ide/Main.hs

Lines changed: 0 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,6 @@ import HieDb.Run
3131
import qualified Development.IDE.Main as Main
3232
import qualified Development.IDE.Types.Options as Ghcide
3333
import Development.Shake (ShakeOptions(shakeThreads))
34-
import Ide.Plugin.Config (getInitialConfig, getConfigFromNotification)
3534

3635
defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
3736
defaultMain args idePlugins = do
@@ -100,8 +99,6 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
10099
{ Main.argFiles = if argLSP then Nothing else Just []
101100
, Main.argsHlsPlugins = idePlugins
102101
, Main.argsLogger = hlsLogger
103-
, Main.argsGetInitialConfig = getInitialConfig
104-
, Main.argsOnConfigChange = getConfigFromNotification
105102
, Main.argsIdeOptions = \_config sessionLoader ->
106103
let defOptions = Ghcide.defaultIdeOptions sessionLoader
107104
in defOptions

0 commit comments

Comments
 (0)