From 3df9c3c1fa27f3bc40149eb4f23dd3c697ac36da Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Mon, 30 Dec 2019 16:50:22 +0000 Subject: [PATCH] Remove onInitialConfiguration from InitializeCallbacks MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Thr Initialize request does not include the initial configuration, so parsing it to generate a configuration does not make sense. If necessary, the server can request config on startup, if it is not supplied, using ‘workspace/configuration’. Closes #210 --- haskell-lsp.cabal | 1 - src/Language/Haskell/LSP/Core.hs | 50 ++++++++++-------------- test/InitialConfigurationSpec.hs | 65 -------------------------------- test/WorkspaceFoldersSpec.hs | 1 - 4 files changed, 19 insertions(+), 98 deletions(-) delete mode 100644 test/InitialConfigurationSpec.hs diff --git a/haskell-lsp.cabal b/haskell-lsp.cabal index c345e0de1..1f98f942e 100644 --- a/haskell-lsp.cabal +++ b/haskell-lsp.cabal @@ -111,7 +111,6 @@ test-suite haskell-lsp-test VspSpec WorkspaceEditSpec WorkspaceFoldersSpec - InitialConfigurationSpec build-depends: base , QuickCheck , aeson diff --git a/src/Language/Haskell/LSP/Core.hs b/src/Language/Haskell/LSP/Core.hs index bc152cd32..0755496b2 100644 --- a/src/Language/Haskell/LSP/Core.hs +++ b/src/Language/Haskell/LSP/Core.hs @@ -210,12 +210,7 @@ data LspFuncs c = -- specific configuration data the language server needs to use. data InitializeCallbacks config = InitializeCallbacks - { onInitialConfiguration :: J.InitializeRequest -> Either T.Text config - -- ^ Invoked on the first message from the language client, containg the client configuration - -- This callback should return either the parsed configuration data or an error indicating - -- what went wrong. The parsed configuration object will be stored internally and passed to - -- hanlder functions as context. - , onConfigurationChange :: J.DidChangeConfigurationNotification-> Either T.Text config + { onConfigurationChange :: J.DidChangeConfigurationNotification-> Either T.Text config -- ^ Invoked whenever the clients sends a message with a changed client configuration. -- This callback should return either the parsed configuration data or an error indicating -- what went wrong. The parsed configuration object will be stored internally and passed to @@ -434,13 +429,21 @@ handleInitialConfig -> TVar (LanguageContextData config) -> J.Value -> IO () -handleInitialConfig (InitializeCallbacks { onInitialConfiguration, onStartup }) mh tvarDat json - = handleMessageWithConfigChange ReqInitialize - onInitialConfiguration - (Just $ initializeRequestHandler' onStartup mh tvarDat) - tvarDat - json +handleInitialConfig (InitializeCallbacks { onStartup }) mh tvarDat json + = case J.fromJSON json of + J.Success req -> do + ctx <- readTVarIO tvarDat + captureFromClient (ReqInitialize req) (resCaptureFile ctx) + + initializeRequestHandler' onStartup mh tvarDat req + J.Error err -> do + let msg = + T.pack + $ unwords + $ ["haskell-lsp:parse error.", show json, show err] + ++ _ERR_MSG_URL + sendErrorLog tvarDat msg hc :: (Show config) @@ -450,29 +453,13 @@ hc -> J.Value -> IO () hc (InitializeCallbacks { onConfigurationChange }) mh tvarDat json = - handleMessageWithConfigChange NotDidChangeConfiguration - onConfigurationChange - mh - tvarDat - json - -handleMessageWithConfigChange - :: (J.FromJSON reqParams, Show reqParams, Show err) - => (reqParams -> FromClientMessage) -- ^ The notification message from the client to expect - -> (reqParams -> Either err config) -- ^ A function to parse the config out of the request - -> Maybe (reqParams -> IO ()) -- ^ The upstream handler for the client request - -> TVar (LanguageContextData config) -- ^ The context data containing the current configuration - -> J.Value -- ^ The raw reqeust data - -> IO () -handleMessageWithConfigChange notification parseConfig mh tvarDat json = - -- logs $ "haskell-lsp:hc DidChangeConfigurationNotification entered" case J.fromJSON json of J.Success req -> do ctx <- readTVarIO tvarDat - captureFromClient (notification req) (resCaptureFile ctx) + captureFromClient (NotDidChangeConfiguration req) (resCaptureFile ctx) - case parseConfig req of + case onConfigurationChange req of Left err -> do let msg = @@ -493,7 +480,8 @@ handleMessageWithConfigChange notification parseConfig mh tvarDat json = sendErrorLog tvarDat msg -- | Updates the list of workspace folders and then delegates back to 'hh' -hwf :: Maybe (Handler J.DidChangeWorkspaceFoldersNotification) -> TVar (LanguageContextData config) -> J.Value -> IO () +hwf :: Maybe (Handler J.DidChangeWorkspaceFoldersNotification) + -> TVar (LanguageContextData config) -> J.Value -> IO () hwf h tvarDat json = do case J.fromJSON json :: J.Result J.DidChangeWorkspaceFoldersNotification of J.Success (J.NotificationMessage _ _ params) -> atomically $ do diff --git a/test/InitialConfigurationSpec.hs b/test/InitialConfigurationSpec.hs deleted file mode 100644 index 38f760888..000000000 --- a/test/InitialConfigurationSpec.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module InitialConfigurationSpec where - -import Control.Concurrent.MVar -import Control.Concurrent.STM -import Data.Aeson -import Data.Default -import Language.Haskell.LSP.Core -import Language.Haskell.LSP.Types -import Language.Haskell.LSP.VFS -import Language.Haskell.LSP.Types.Capabilities -import Test.Hspec - -spec :: Spec -spec = - describe "initial configuration" $ it "stores initial configuration data" $ initVFS $ \vfs -> do - - lfVar <- newEmptyMVar - - let - initialConfigHandler (RequestMessage _ _ Initialize InitializeParams{_initializationOptions = Just opts}) = - case (fromJSON opts :: Result String) of - Success s -> Right s - _ -> Left "Could not decode configuration" - initialConfigHandler _ = - error "Got the wrong request for the onInitialConfiguration callback" - - initCb :: InitializeCallbacks String - initCb = InitializeCallbacks - initialConfigHandler - (const $ Left "") - (\lf -> putMVar lfVar lf >> return Nothing) - - handlers = def - - tvarLspId <- newTVarIO 0 - tvarCtx <- newTVarIO $ defaultLanguageContextData handlers - def - undefined - tvarLspId - (const $ return ()) - Nothing - vfs - - let putMsg msg = - let jsonStr = encode msg in handleMessage initCb tvarCtx jsonStr - - let - initParams = InitializeParams - Nothing - Nothing - (Just (Uri "/foo")) - (Just (Data.Aeson.String "configuration")) - fullCaps - Nothing - Nothing - - initMsg :: InitializeRequest - initMsg = RequestMessage "2.0" (IdInt 0) Initialize initParams - - putMsg initMsg - contents <- readTVarIO tvarCtx - resConfig contents `shouldBe` Just "configuration" - diff --git a/test/WorkspaceFoldersSpec.hs b/test/WorkspaceFoldersSpec.hs index 2886612e9..2eaf689d2 100644 --- a/test/WorkspaceFoldersSpec.hs +++ b/test/WorkspaceFoldersSpec.hs @@ -20,7 +20,6 @@ spec = let initCb :: InitializeCallbacks () initCb = InitializeCallbacks - (const $ Left "") (const $ Left "") (\lf -> putMVar lfVar lf >> return Nothing) handlers = def