Test lsp-test changes

cabal.project

@@ -42,3 +42,11 @@ constraints:
   -- We want to be able to benefit from the performance optimisations
   -- in the future, thus: TODO: remove this flag.
   bitvec -simd
+
+source-repository-package
+  type:git
+  location: https://github.com/jhrcek/lsp
+  tag: 97a47d963b602ac66bfd91cab7b3b1892c88a206 
+  subdir: lsp
+  subdir: lsp-test
+  subdir: lsp-types

ghcide-bench/src/Experiments.hs

@@ -579,15 +579,16 @@ badRun :: BenchRun
 badRun = BenchRun 0 0 0 0 0 0 0 0 0 0 0 0 0 False
 
 waitForProgressStart :: Session ()
-waitForProgressStart = void $ do
-    skipManyTill anyMessage $ satisfy $ \case
+waitForProgressStart = do
+    setIgnoringProgressNotifications False
+    void $ skipManyTill anyMessage $ satisfy $ \case
       FromServerMess SMethod_WindowWorkDoneProgressCreate _ -> True
       _                                              -> False
 
 -- | Wait for all progress to be done
 -- Needs at least one progress done notification to return
 waitForProgressDone :: Session ()
-waitForProgressDone = loop
+waitForProgressDone = setIgnoringProgressNotifications False >> loop
   where
     loop = do
       ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case

ghcide/test/exe/TestUtils.hs

@@ -49,26 +49,30 @@ import           LogType
 
 -- | Wait for the next progress begin step
 waitForProgressBegin :: Session ()
-waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
-  FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) | Lens.is _workDoneProgressBegin v-> Just ()
-  _ -> Nothing
+waitForProgressBegin = do
+  setIgnoringProgressNotifications False
+  skipManyTill anyMessage $ satisfyMaybe $ \case
+    FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) | Lens.is _workDoneProgressBegin v -> Just ()
+    _ -> Nothing
 
 -- | Wait for the first progress end step
 -- Also implemented in hls-test-utils Test.Hls
 waitForProgressDone :: Session ()
-waitForProgressDone = skipManyTill anyMessage $ satisfyMaybe $ \case
-  FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) | Lens.is _workDoneProgressEnd v -> Just ()
-  _ -> Nothing
+waitForProgressDone = do
+  setIgnoringProgressNotifications False
+  skipManyTill anyMessage $ satisfyMaybe $ \case
+    FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) | Lens.is _workDoneProgressEnd v -> Just ()
+    _ -> Nothing
 
 -- | Wait for all progress to be done
 -- Needs at least one progress done notification to return
 -- Also implemented in hls-test-utils Test.Hls
 waitForAllProgressDone :: Session ()
-waitForAllProgressDone = loop
+waitForAllProgressDone = setIgnoringProgressNotifications False >> loop
   where
     loop = do
       ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case
-        FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) |Lens.is _workDoneProgressEnd v-> Just ()
+        FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) |Lens.is _workDoneProgressEnd v -> Just ()
         _ -> Nothing
       done <- null <$> getIncompleteProgressSessions
       unless done loop
@@ -136,6 +140,7 @@ getConfigFromEnv = do
   timeoutOverride <- fmap read <$> getEnv "LSP_TIMEOUT"
   return defaultConfig
     { messageTimeout = fromMaybe (messageTimeout defaultConfig) timeoutOverride
+    --, ignoreProgressNotifications = False
     , logColor
     }
   where

hls-test-utils/src/Test/Hls.hs

@@ -651,14 +651,16 @@ runSessionWithServer' plugins conf sconf caps root s =  withLock lock $ keepCurr
 
 -- | Wait for the next progress end step
 waitForProgressDone :: Session ()
-waitForProgressDone = skipManyTill anyMessage $ satisfyMaybe $ \case
-  FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) | is _workDoneProgressEnd v-> Just ()
-  _ -> Nothing
+waitForProgressDone = do
+  setIgnoringProgressNotifications False
+  skipManyTill anyMessage $ satisfyMaybe $ \case
+    FromServerMess  SMethod_Progress  (TNotificationMessage _ _ (ProgressParams _ v)) | is _workDoneProgressEnd v -> Just ()
+    _ -> Nothing
 
 -- | Wait for all progress to be done
 -- Needs at least one progress done notification to return
 waitForAllProgressDone :: Session ()
-waitForAllProgressDone = loop
+waitForAllProgressDone = setIgnoringProgressNotifications False >> loop
   where
     loop = do
       ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case

test/functional/Progress.hs

@@ -26,12 +26,12 @@ tests =
     testGroup
         "window/workDoneProgress"
         [ testCase "sends indefinite progress notifications" $
-            runSession hlsLspCommand progressCaps "test/testdata/diagnostics" $ do
+            runSessionWithConfig (def {ignoreProgressNotifications = False}) hlsLspCommand progressCaps "test/testdata/diagnostics" $ do
                 let path = "Foo.hs"
                 _ <- openDoc path "haskell"
                 expectProgressMessages [pack ("Setting up diagnostics (for " ++ path ++ ")"), "Processing", "Indexing"] []
         , requiresEvalPlugin $ testCase "eval plugin sends progress reports" $
-            runSession hlsLspCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do
+            runSessionWithConfig (def {ignoreProgressNotifications = False}) hlsLspCommand progressCaps "plugins/hls-eval-plugin/test/testdata" $ do
               doc <- openDoc "T1.hs" "haskell"
               lspId <- sendRequest SMethod_TextDocumentCodeLens (CodeLensParams Nothing Nothing doc)
 
@@ -55,15 +55,15 @@ tests =
                       expectProgressMessages ["Evaluating"] activeProgressTokens
                   _ -> error $ "Unexpected response result: " ++ show response
         , requiresOrmoluPlugin $ testCase "ormolu plugin sends progress notifications" $ do
-            runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsLspCommand progressCaps "test/testdata/format" $ do
+            runSessionWithConfig (def { ignoreConfigurationRequests = False, ignoreProgressNotifications = False }) hlsLspCommand progressCaps "test/testdata/format" $ do
                 void configurationRequest
                 setHlsConfig (formatLspConfig "ormolu")
                 doc <- openDoc "Format.hs" "haskell"
                 expectProgressMessages ["Setting up format (for Format.hs)", "Processing", "Indexing"] []
                 _ <- sendRequest SMethod_TextDocumentFormatting $ DocumentFormattingParams Nothing doc (FormattingOptions 2 True Nothing Nothing Nothing)
                 expectProgressMessages ["Formatting Format.hs"] []
         , requiresFourmoluPlugin $ testCase "fourmolu plugin sends progress notifications" $ do
-            runSessionWithConfig (def { ignoreConfigurationRequests = False }) hlsLspCommand progressCaps "test/testdata/format" $ do
+            runSessionWithConfig (def { ignoreConfigurationRequests = False, ignoreProgressNotifications = False }) hlsLspCommand progressCaps "test/testdata/format" $ do
                 void configurationRequest
                 setHlsConfig (formatLspConfig "fourmolu")
                 doc <- openDoc "Format.hs" "haskell"