Skip to content

Commit 993f4a8

Browse files
aufargaufarg
committed
Use default config on missing configuration section
On serving initialize request, the deserialization of HIE configuration embedded in InitializeParam passed by client will result in an error if during the deserialization process the server cannot find HIE specific configuration key under initializationOptions. This commit changes the initializationOptions deserialization to return the default configuration if configuration key cannot be found under initializationOptions. Here, setting the key with a value of null will also be considered as part of not found condition to accommodate clients that fills missing user options as null.
1 parent 9f13e8f commit 993f4a8

File tree

2 files changed

+74
-46
lines changed

2 files changed

+74
-46
lines changed

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

+68-44
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,13 @@ module Ide.Plugin.Config
88
getInitialConfig
99
, getConfigFromNotification
1010
, Config(..)
11+
, hlintOn
12+
, diagnosticsOnChange
13+
, diagnosticsDebounceDuration
14+
, liquidOn
15+
, completionSnippetsOn
16+
, formatOnImportOn
17+
, formattingProvider
1118
) where
1219

1320
import Control.Applicative
@@ -41,48 +48,63 @@ getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions =
4148
-- | We (initially anyway) mirror the hie configuration, so that existing
4249
-- clients can simply switch executable and not have any nasty surprises. There
4350
-- will be surprises relating to config options being ignored, initially though.
44-
data Config =
45-
Config
46-
{ hlintOn :: Bool
47-
, diagnosticsOnChange :: Bool
48-
, maxNumberOfProblems :: Int
49-
, diagnosticsDebounceDuration :: Int
50-
, liquidOn :: Bool
51-
, completionSnippetsOn :: Bool
52-
, formatOnImportOn :: Bool
53-
, formattingProvider :: T.Text
54-
} deriving (Show,Eq)
51+
data Config
52+
= DefaultConfig
53+
| UserConfig Bool Bool Int Int Bool Bool Bool T.Text
54+
deriving (Show, Eq)
5555

5656
instance Default Config where
57-
def = Config
58-
{ hlintOn = True
59-
, diagnosticsOnChange = True
60-
, maxNumberOfProblems = 100
61-
, diagnosticsDebounceDuration = 350000
62-
, liquidOn = False
63-
, completionSnippetsOn = True
64-
, formatOnImportOn = True
65-
-- , formattingProvider = "brittany"
66-
, formattingProvider = "ormolu"
67-
-- , formattingProvider = "floskell"
68-
-- , formattingProvider = "stylish-haskell"
69-
}
57+
def = DefaultConfig
58+
59+
hlintOn :: Config -> Bool
60+
hlintOn DefaultConfig = True
61+
hlintOn (UserConfig h _ _ _ _ _ _ _) = h
62+
63+
diagnosticsOnChange :: Config -> Bool
64+
diagnosticsOnChange DefaultConfig = True
65+
diagnosticsOnChange (UserConfig _ diag _ _ _ _ _ _) = diag
66+
67+
maxNumberOfProblems :: Config -> Int
68+
maxNumberOfProblems DefaultConfig = 100
69+
maxNumberOfProblems (UserConfig _ _ m _ _ _ _ _) = m
70+
71+
diagnosticsDebounceDuration :: Config -> Int
72+
diagnosticsDebounceDuration DefaultConfig = 350000
73+
diagnosticsDebounceDuration (UserConfig _ _ _ d _ _ _ _) = d
74+
75+
liquidOn :: Config -> Bool
76+
liquidOn DefaultConfig = False
77+
liquidOn (UserConfig _ _ _ _ l _ _ _) = l
78+
79+
completionSnippetsOn :: Config -> Bool
80+
completionSnippetsOn DefaultConfig = True
81+
completionSnippetsOn (UserConfig _ _ _ _ _ c _ _) = c
82+
83+
formatOnImportOn :: Config -> Bool
84+
formatOnImportOn DefaultConfig = True
85+
formatOnImportOn (UserConfig _ _ _ _ _ _ f _) = f
86+
87+
formattingProvider :: Config -> T.Text
88+
formattingProvider DefaultConfig = "ormulu"
89+
formattingProvider (UserConfig _ _ _ _ _ _ _ fp) = fp
7090

7191
-- TODO: Add API for plugins to expose their own LSP config options
7292
instance A.FromJSON Config where
7393
parseJSON = A.withObject "Config" $ \v -> do
7494
-- Officially, we use "haskell" as the section name but for
7595
-- backwards compatibility we also accept "languageServerHaskell"
76-
s <- v .: "haskell" <|> v .: "languageServerHaskell"
77-
flip (A.withObject "Config.settings") s $ \o -> Config
78-
<$> o .:? "hlintOn" .!= hlintOn def
79-
<*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange def
80-
<*> o .:? "maxNumberOfProblems" .!= maxNumberOfProblems def
81-
<*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration def
82-
<*> o .:? "liquidOn" .!= liquidOn def
83-
<*> o .:? "completionSnippetsOn" .!= completionSnippetsOn def
84-
<*> o .:? "formatOnImportOn" .!= formatOnImportOn def
85-
<*> o .:? "formattingProvider" .!= formattingProvider def
96+
c <- v .:? "haskell" <|> v .:? "languageServerHaskell"
97+
case c of
98+
Nothing -> return def
99+
Just s -> flip (A.withObject "Config.settings") s $ \o -> UserConfig
100+
<$> o .:? "hlintOn" .!= hlintOn def
101+
<*> o .:? "diagnosticsOnChange" .!= diagnosticsOnChange def
102+
<*> o .:? "maxNumberOfProblems" .!= maxNumberOfProblems def
103+
<*> o .:? "diagnosticsDebounceDuration" .!= diagnosticsDebounceDuration def
104+
<*> o .:? "liquidOn" .!= liquidOn def
105+
<*> o .:? "completionSnippetsOn" .!= completionSnippetsOn def
106+
<*> o .:? "formatOnImportOn" .!= formatOnImportOn def
107+
<*> o .:? "formattingProvider" .!= formattingProvider def
86108

87109
-- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"haskell":{"maxNumberOfProblems":100,"hlintOn":true}}}}
88110
-- 2017-10-09 23:22:00.710667381 [ThreadId 15] - reactor:got didChangeConfiguration notification:
@@ -94,14 +116,16 @@ instance A.FromJSON Config where
94116
-- ,("maxNumberOfProblems",Number 100.0)]))])}}
95117

96118
instance A.ToJSON Config where
97-
toJSON (Config h diag m d l c f fp) = object [ "haskell" .= r ]
119+
toJSON conf = object [ "haskell" .= r conf ]
98120
where
99-
r = object [ "hlintOn" .= h
100-
, "diagnosticsOnChange" .= diag
101-
, "maxNumberOfProblems" .= m
102-
, "diagnosticsDebounceDuration" .= d
103-
, "liquidOn" .= l
104-
, "completionSnippetsOn" .= c
105-
, "formatOnImportOn" .= f
106-
, "formattingProvider" .= fp
107-
]
121+
r conf =
122+
object
123+
[ "hlintOn" .= hlintOn conf
124+
, "diagnosticsOnChange" .= diagnosticsOnChange conf
125+
, "maxNumberOfProblems" .= maxNumberOfProblems conf
126+
, "diagnosticsDebounceDuration" .= diagnosticsDebounceDuration conf
127+
, "liquidOn" .= liquidOn conf
128+
, "completionSnippetsOn" .= completionSnippetsOn conf
129+
, "formatOnImportOn" .= formatOnImportOn conf
130+
, "formattingProvider" .= formattingProvider conf
131+
]

‎src/Ide/Main.hs

+6-2
Original file line numberDiff line numberDiff line change
@@ -123,11 +123,15 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
123123
hPutStrLn stderr $ " in directory: " <> dir
124124
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
125125

126-
runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps wProg wIndefProg _getConfig _rootPath -> do
126+
runLanguageServer options (pluginHandler plugins) getInitialConfig getConfigFromNotification $ \getLspId event vfs caps wProg wIndefProg getConfig _rootPath -> do
127127
t <- t
128128
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
129129
sessionLoader <- loadSession dir
130-
-- config <- fromMaybe defaultLspConfig <$> getConfig
130+
config <- fromMaybe def <$> getConfig
131+
case config of
132+
DefaultConfig -> logInfo hlsLogger $ "No user configuration detected. Falling back to default configuration."
133+
_ -> return ()
134+
131135
let options = (defaultIdeOptions sessionLoader)
132136
{ optReportProgress = clientSupportsProgress caps
133137
, optShakeProfiling = argsShakeProfiling

0 commit comments

Comments
 (0)