Use default config on missing configuration section

On serving initialize request, deserializing HIE configuration embedded
in InitializeParam passed by client will result in an error if during
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.

Author: aufarg

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

@@ -97,20 +97,22 @@ instance A.FromJSON Config where
   parseJSON = A.withObject "Config" $ \v -> do
     -- Officially, we use "haskell" as the section name but for
     -- backwards compatibility we also accept "languageServerHaskell"
-    s <- v .: "haskell" <|> v .: "languageServerHaskell"
-    flip (A.withObject "Config.settings") s $ \o -> Config
-      <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents def
-      <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject def
-      <*> o .:? "hlintOn"                                 .!= hlintOn def
-      <*> o .:? "diagnosticsOnChange"                     .!= diagnosticsOnChange def
-      <*> o .:? "maxNumberOfProblems"                     .!= maxNumberOfProblems def
-      <*> o .:? "diagnosticsDebounceDuration"             .!= diagnosticsDebounceDuration def
-      <*> o .:? "liquidOn"                                .!= liquidOn def
-      <*> o .:? "completionSnippetsOn"                    .!= completionSnippetsOn def
-      <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn def
-      <*> o .:? "formattingProvider"                      .!= formattingProvider def
-      <*> o .:? "maxCompletions"                          .!= maxCompletions def
-      <*> o .:? "plugin"                                  .!= plugins def
+    c <- v .:? "haskell" <|> v .:? "languageServerHaskell"
+    case c of
+      Nothing -> return def
+      Just s -> flip (A.withObject "Config.settings") s $ \o -> Config
+        <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents def
+        <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject def
+        <*> o .:? "hlintOn"                                 .!= hlintOn def
+        <*> o .:? "diagnosticsOnChange"                     .!= diagnosticsOnChange def
+        <*> o .:? "maxNumberOfProblems"                     .!= maxNumberOfProblems def
+        <*> o .:? "diagnosticsDebounceDuration"             .!= diagnosticsDebounceDuration def
+        <*> o .:? "liquidOn"                                .!= liquidOn def
+        <*> o .:? "completionSnippetsOn"                    .!= completionSnippetsOn def
+        <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn def
+        <*> o .:? "formattingProvider"                      .!= formattingProvider def
+        <*> o .:? "maxCompletions"                          .!= maxCompletions def
+        <*> o .:? "plugin"                                  .!= plugins def
 
 -- 2017-10-09 23:22:00.710515298 [ThreadId 11] - ---> {"jsonrpc":"2.0","method":"workspace/didChangeConfiguration","params":{"settings":{"haskell":{"maxNumberOfProblems":100,"hlintOn":true}}}}
 -- 2017-10-09 23:22:00.710667381 [ThreadId 15] - reactor:got didChangeConfiguration notification:

test/functional/Config.hs

@@ -3,6 +3,7 @@
 module Config (tests) where
 
 import           Control.Lens hiding (List)
+import           Control.Applicative.Combinators (skipManyTill)
 import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Default
@@ -24,6 +25,7 @@ tests = testGroup "plugin config" [
       -- Note: because the flag is treated generically in the plugin handler, we
       -- do not have to test each individual plugin
       hlintTests
+    , configTests
     ]
 
 hlintTests :: TestTree
@@ -71,6 +73,21 @@ hlintTests = testGroup "hlint plugin enables" [
             diags <- waitForDiagnosticsFromSource doc "hlint"
             liftIO $ length diags > 0 @? "There are hlint diagnostics"
 
+configTests :: TestTree
+configTests = testGroup "config parsing" [
+      testCase "empty object as user configuration should not send error logMessage" $ runConfigSession "" $ do
+        let config = object []
+        sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON config))
+
+        logNot <- skipManyTill Test.anyMessage Test.message :: Session LogMessageNotification
+
+        liftIO $ (logNot ^. L.params . L.xtype) > MtError @? "Server sends logMessage with MessageType = Error"
+    ]
+    where
+        runConfigSession :: FilePath -> Session a -> IO a
+        runConfigSession subdir  =
+            failIfSessionTimeout . runSession hlsCommand fullCaps ("test/testdata" </> subdir)
+
 pluginGlobalOn :: Config -> T.Text -> Bool -> Config
 pluginGlobalOn config pid state = config'
   where