Handle receiving messages in between the initialize sequence

And check that they are legal

diff --git a/lsp-test.cabal b/lsp-test.cabal
index 0d436112883ceee892ae03dfd2e51e7522636b2d..88c6f764604e988787e3db8570b349c11483232a 100644 (file)
--- a/lsp-test.cabal
+++ b/lsp-test.cabal
@@ -50,7 +50,7 @@ library
                      , filepath
                      , lens
                      , mtl
-                     , parser-combinators
+                     , parser-combinators >= 1.2
                      , process >= 1.6
                      , text
                      , transformers

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 3ad7b2f042b34d3a3fd4f18530fbc256ac8e9b7c..b3f535f3ca59f1616cee0bfb1dc1898ff68e1472 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -153,7 +153,12 @@ runSessionWithConfig config' serverExe caps rootDir session = do
   withServer serverExe (logStdErr config) $ \serverIn serverOut serverProc ->
     runSessionWithHandles serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
       -- Wrap the session around initialize and shutdown calls
-      initRspMsg <- request Initialize initializeParams :: Session InitializeResponse
+      -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
+      initReqId <- sendRequest Initialize initializeParams
+
+      -- Because messages can be sent in between the request and response,
+      -- collect them and then...
+      (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId)
 
       liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRspMsg ^. LSP.error)
 
@@ -165,6 +170,12 @@ runSessionWithConfig config' serverExe caps rootDir session = do
         Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg)
         Nothing -> return ()
 
+      -- ... relay them back to the user Session so they can match on them!
+      -- As long as they are allowed.
+      forM_ inBetween checkLegalBetweenMessage
+      msgChan <- asks messageChan
+      liftIO $ writeList2Chan msgChan (ServerMessage <$> inBetween)
+
       -- Run the actual test
       session
   where
@@ -187,6 +198,16 @@ runSessionWithConfig config' serverExe caps rootDir session = do
       (RspShutdown _) -> return ()
       _               -> listenServer serverOut context
 
+  -- | Is this message allowed to be sent by the server between the intialize
+  -- request and response?
+  -- https://microsoft.github.io/language-server-protocol/specifications/specification-3-15/#initialize
+  checkLegalBetweenMessage :: FromServerMessage -> Session ()
+  checkLegalBetweenMessage (NotShowMessage _) = pure ()
+  checkLegalBetweenMessage (NotLogMessage _) = pure ()
+  checkLegalBetweenMessage (NotTelemetry _) = pure ()
+  checkLegalBetweenMessage (ReqShowMessage _) = pure ()
+  checkLegalBetweenMessage msg = throw (IllegalInitSequenceMessage msg)
+
   -- | Check environment variables to override the config
   envOverrideConfig :: SessionConfig -> IO SessionConfig
   envOverrideConfig cfg = do

diff --git a/src/Language/Haskell/LSP/Test/Exceptions.hs b/src/Language/Haskell/LSP/Test/Exceptions.hs
index 713b25f101a23429668a1f29207e8f2c4a63645e..afb48dfd4ff883962c804549f969bf71fc92a8fe 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Exceptions.hs
+++ b/src/Language/Haskell/LSP/Test/Exceptions.hs
@@ -19,6 +19,7 @@ data SessionException = Timeout (Maybe FromServerMessage)
                       | IncorrectApplyEditRequest String
                       | UnexpectedResponseError LspIdRsp ResponseError
                       | UnexpectedServerTermination
+                      | IllegalInitSequenceMessage FromServerMessage
   deriving Eq
 
 instance Exception SessionException
@@ -50,6 +51,9 @@ instance Show SessionException where
   show (UnexpectedResponseError lid e) = "Received an exepected error in a response for id " ++ show lid ++ ":\n"
                                           ++ show e
   show UnexpectedServerTermination = "Language server unexpectedly terminated"
+  show (IllegalInitSequenceMessage msg) =
+    "Received an illegal message between the initialize request and response:\n"
+      ++  B.unpack (encodePretty msg)
 
 -- | A predicate that matches on any 'SessionException'
 anySessionException :: SessionException -> Bool