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>

ghcide/ghcide.cabal

@@ -58,7 +58,7 @@ library
         haskell-lsp-types == 0.23.*,
         haskell-lsp == 0.23.*,
         hie-compat,
-        hls-plugin-api >= 0.7,
+        hls-plugin-api >= 0.7.1,
         lens,
         hiedb == 0.3.0.1,
         mtl,

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

@@ -62,9 +62,8 @@ module Development.IDE.Core.Rules(
 
 import Fingerprint
 
-import Data.Aeson (fromJSON,toJSON, Result(Success), FromJSON)
+import Data.Aeson (toJSON, Result(Success))
 import Data.Binary hiding (get, put)
-import Data.Default
 import Data.Tuple.Extra
 import Control.Monad.Extra
 import Control.Monad.Trans.Class
@@ -136,6 +135,8 @@ import GHC.IO.Encoding
 import Data.ByteString.Encoding as T
 
 import qualified HieDb
+import Ide.Plugin.Config
+import qualified Data.Aeson.Types as A
 
 -- | This is useful for rules to convert rules that can only produce errors or
 -- a result into the more general IdeResult type that supports producing
@@ -1047,12 +1048,13 @@ getClientSettingsRule = defineEarlyCutOffNoFile $ \GetClientSettings -> do
 
 -- | Returns the client configurarion stored in the IdeState.
 -- You can use this function to access it from shake Rules
-getClientConfigAction :: (Default a, FromJSON a) => Action a
-getClientConfigAction = do
+getClientConfigAction :: Config -- ^ default value
+                      -> Action Config
+getClientConfigAction defValue = do
   mbVal <- unhashed <$> useNoFile_ GetClientSettings
-  case fromJSON <$> mbVal of
+  case A.parse (parseConfig defValue) <$> mbVal of
     Just (Success c) -> return c
-    _ -> return def
+    _ -> return defValue
 
 -- | For now we always use bytecode
 getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType)

ghcide/src/Development/IDE/Main.hs

@@ -4,9 +4,7 @@ import Control.Exception.Safe (
     Exception (displayException),
     catchAny,
  )
-import Control.Lens ((^.))
 import Control.Monad.Extra (concatMapM, unless, when)
-import qualified Data.Aeson as J
 import Data.Default (Default (def))
 import qualified Data.HashMap.Strict as HashMap
 import Data.List.Extra (
@@ -68,17 +66,14 @@ import Development.IDE.Types.Options (
 import Development.IDE.Types.Shake (Key (Key))
 import Development.Shake (action)
 import HIE.Bios.Cradle (findCradle)
-import Ide.Plugin.Config (CheckParents (NeverCheck), Config)
+import Ide.Plugin.Config (CheckParents (NeverCheck), Config, getInitialConfig, getConfigFromNotification)
 import Ide.PluginUtils (allLspCmdIds', getProcessID, pluginDescToIdePlugins)
 import Ide.Types (IdePlugins)
 import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.Messages (FromServerMessage)
 import Language.Haskell.LSP.Types (
-    DidChangeConfigurationNotification,
-    InitializeRequest,
     LspId (IdInt),
  )
-import Language.Haskell.LSP.Types.Lens (initializationOptions, params)
 import qualified System.Directory.Extra as IO
 import System.Exit (ExitCode (ExitFailure), exitWith)
 import System.FilePath (takeExtension, takeFileName)
@@ -99,8 +94,7 @@ data Arguments = Arguments
     , argsSessionLoadingOptions :: SessionLoadingOptions
     , argsIdeOptions :: Maybe Config -> Action IdeGhcSession -> IdeOptions
     , argsLspOptions :: LSP.Options
-    , argsGetInitialConfig :: InitializeRequest -> Either T.Text Config
-    , argsOnConfigChange :: DidChangeConfigurationNotification -> Either T.Text Config
+    , argsDefaultHlsConfig :: Config
     }
 
 defArguments :: HieDb -> IndexQueue -> Arguments
@@ -117,12 +111,7 @@ defArguments hiedb hiechan =
         , argsSessionLoadingOptions = defaultLoadingOptions
         , argsIdeOptions = const defaultIdeOptions
         , argsLspOptions = def {LSP.completionTriggerCharacters = Just "."}
-        , argsOnConfigChange = const $ Left "Updating Not supported"
-        , argsGetInitialConfig = \x -> case x ^. params . initializationOptions of
-            Nothing -> Right def
-            Just v -> case J.fromJSON v of
-                J.Error err -> Left $ T.pack err
-                J.Success a -> Right a
+        , argsDefaultHlsConfig = def
         }
 
 defaultMain :: Arguments -> IO ()
@@ -134,6 +123,8 @@ defaultMain Arguments{..} = do
         hlsCommands = allLspCmdIds' pid argsHlsPlugins
         plugins = hlsPlugin <> argsGhcidePlugin
         options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands }
+        argsOnConfigChange = getConfigFromNotification argsDefaultHlsConfig
+        argsGetInitialConfig = getInitialConfig argsDefaultHlsConfig
 
     case argFiles of
         Nothing -> do

ghcide/test/exe/Main.hs

@@ -4762,12 +4762,7 @@ asyncTests = testGroup "async"
 
 clientSettingsTest :: TestTree
 clientSettingsTest = testGroup "client settings handling"
-    [
-        testSession "ghcide does not support update config" $ do
-            sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON ("" :: String)))
-            logNot <- skipManyTill anyMessage loggingNotification
-            isMessagePresent "Updating Not supported" [getLogMessage logNot]
-    ,   testSession "ghcide restarts shake session on config changes" $ do
+    [ testSession "ghcide restarts shake session on config changes" $ do
             void $ skipManyTill anyMessage $ message @RegisterCapabilityRequest
             sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (toJSON ("" :: String)))
             nots <- skipManyTill anyMessage $ count 3 loggingNotification

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

@@ -1,6 +1,6 @@
 cabal-version: 2.2
 name:          hls-plugin-api
-version:       0.7.0.0
+version:       0.7.1.0
 synopsis:      Haskell Language Server API for plugin communication
 description:
   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>

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

@@ -10,12 +10,14 @@ module Ide.Plugin.Config
       getInitialConfig
     , getConfigFromNotification
     , Config(..)
+    , parseConfig
     , PluginConfig(..)
     , CheckParents(..)
     ) where
 
 import           Control.Applicative
 import qualified Data.Aeson                    as A
+import qualified Data.Aeson.Types              as A
 import           Data.Aeson              hiding ( Error )
 import           Data.Default
 import qualified Data.Text                     as T
@@ -27,18 +29,18 @@ import GHC.Generics (Generic)
 
 -- | Given a DidChangeConfigurationNotification message, this function returns the parsed
 -- Config object if possible.
-getConfigFromNotification :: DidChangeConfigurationNotification -> Either T.Text Config
-getConfigFromNotification (NotificationMessage _ _ (DidChangeConfigurationParams p)) =
-  case fromJSON p of
+getConfigFromNotification :: Config -> DidChangeConfigurationNotification -> Either T.Text Config
+getConfigFromNotification defaultValue (NotificationMessage _ _ (DidChangeConfigurationParams p)) =
+  case A.parse (parseConfig defaultValue) p of
     A.Success c -> Right c
     A.Error err -> Left $ T.pack err
 
 -- | Given an InitializeRequest message, this function returns the parsed
 -- Config object if possible. Otherwise, it returns the default configuration
-getInitialConfig :: InitializeRequest -> Either T.Text Config
-getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right def
-getInitialConfig (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) =
-  case fromJSON opts of
+getInitialConfig :: Config -> InitializeRequest -> Either T.Text Config
+getInitialConfig defaultValue (RequestMessage _ _ _ InitializeParams{_initializationOptions = Nothing }) = Right defaultValue
+getInitialConfig defaultValue (RequestMessage _ _ _ InitializeParams{_initializationOptions = Just opts}) =
+  case A.parse (parseConfig defaultValue) opts of
     A.Success c -> Right c
     A.Error err -> Left $ T.pack err
 
@@ -93,35 +95,26 @@ instance Default Config where
     }
 
 -- TODO: Add API for plugins to expose their own LSP config options
-instance A.FromJSON Config where
-  parseJSON = A.withObject "Config" $ \v -> do
+parseConfig :: Config -> Value -> A.Parser Config
+parseConfig defValue = A.withObject "Config" $ \v -> do
     -- Officially, we use "haskell" as the section name but for
     -- backwards compatibility we also accept "languageServerHaskell"
     c <- v .: "haskell" <|> v .:? "languageServerHaskell"
     case c of
-      Nothing -> return def
+      Nothing -> return defValue
       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:
--- NotificationMessage
---   {_jsonrpc = "2.0"
---   , _method = WorkspaceDidChangeConfiguration
---   , _params = DidChangeConfigurationParams
---                 {_settings = Object (fromList [("haskell",Object (fromList [("hlintOn",Bool True)
---                                                                            ,("maxNumberOfProblems",Number 100.0)]))])}}
+        <$> (o .:? "checkParents" <|> v .:? "checkParents") .!= checkParents defValue
+        <*> (o .:? "checkProject" <|> v .:? "checkProject") .!= checkProject defValue
+        <*> o .:? "hlintOn"                                 .!= hlintOn defValue
+        <*> o .:? "diagnosticsOnChange"                     .!= diagnosticsOnChange defValue
+        <*> o .:? "maxNumberOfProblems"                     .!= maxNumberOfProblems defValue
+        <*> o .:? "diagnosticsDebounceDuration"             .!= diagnosticsDebounceDuration defValue
+        <*> o .:? "liquidOn"                                .!= liquidOn defValue
+        <*> o .:? "completionSnippetsOn"                    .!= completionSnippetsOn defValue
+        <*> o .:? "formatOnImportOn"                        .!= formatOnImportOn defValue
+        <*> o .:? "formattingProvider"                      .!= formattingProvider defValue
+        <*> o .:? "maxCompletions"                          .!= maxCompletions defValue
+        <*> o .:? "plugin"                                  .!= plugins defValue
 
 instance A.ToJSON Config where
   toJSON Config{..} =

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

@@ -43,7 +43,7 @@ library
     , hashable
     , haskell-lsp
     , hlint                    >=3.2
-    , hls-plugin-api           >=0.7.0.0
+    , hls-plugin-api           >=0.7.1.0
     , hslogger
     , lens
     , regex-tdfa

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

@@ -24,6 +24,7 @@ import Control.Monad.IO.Class
 import Control.Monad.Trans.Except
 import Data.Aeson.Types (ToJSON(..), FromJSON(..), Value(..))
 import Data.Binary
+import Data.Default
 import Data.Hashable
 import qualified Data.HashMap.Strict as Map
 import Data.Maybe
@@ -102,7 +103,7 @@ type instance RuleResult GetHlintDiagnostics = ()
 rules :: PluginId -> Rules ()
 rules plugin = do
   define $ \GetHlintDiagnostics file -> do
-    config <- getClientConfigAction
+    config <- getClientConfigAction def
     let pluginConfig = configForPlugin config plugin
     let hlintOn' = hlintOn config && pluginEnabled pluginConfig plcDiagnosticsOn
     ideas <- if hlintOn' then getIdeas file else return (Right [])

src/Ide/Main.hs

@@ -31,7 +31,6 @@ import HieDb.Run
 import qualified Development.IDE.Main as Main
 import qualified Development.IDE.Types.Options as Ghcide
 import Development.Shake (ShakeOptions(shakeThreads))
-import Ide.Plugin.Config (getInitialConfig, getConfigFromNotification)
 
 defaultMain :: Arguments -> IdePlugins IdeState -> IO ()
 defaultMain args idePlugins = do
@@ -100,8 +99,6 @@ runLspMode lspArgs@LspArguments{..} idePlugins = do
           { Main.argFiles = if argLSP then Nothing else Just []
           , Main.argsHlsPlugins = idePlugins
           , Main.argsLogger = hlsLogger
-          , Main.argsGetInitialConfig = getInitialConfig
-          , Main.argsOnConfigChange = getConfigFromNotification
           , Main.argsIdeOptions = \_config sessionLoader ->
             let defOptions = Ghcide.defaultIdeOptions sessionLoader
             in defOptions