Skip to content

Commit 25a614f

Browse files
pepeiborrapepeiborra
committed
Sanitize the setup of the default Ide.Config
1 parent f17f425 commit 25a614f

File tree

5 files changed

+31
-50
lines changed

5 files changed

+31
-50
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/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

‎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{..} =

‎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)