Enhance testing progress reporting

soulomoon · soulomoon · commit a8a7c0a2cc3b · 2025-09-07T06:03:55.000+08:00
- Introduce TestReporting style for progress reporting in IDE options.
diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml
@@ -114,18 +114,18 @@ jobs:
       - if: needs.pre_job.outputs.should_skip_ghcide != 'true' && matrix.test
         name: Test ghcide
         # run the tests without parallelism to avoid running out of memory
-        run: cabal test ghcide-tests || cabal test ghcide-tests
+        run: cabal test ghcide-tests
 
       - if: matrix.test
         name: Test hls-plugin-api
-        run: cabal test hls-plugin-api || cabal test hls-plugin-api
+        run: cabal test hls-plugin-api
 
       - if: matrix.test
         name: Test func-test suite
         env:
           HLS_TEST_EXE: hls
           HLS_WRAPPER_TEST_EXE: hls-wrapper
-        run: cabal test func-test || cabal test func-test
+        run: cabal test func-test
 
       - if: matrix.test
         name: Test wrapper-test suite
@@ -136,124 +136,124 @@ jobs:
 
       - if: matrix.test
         name: Test hls-refactor-plugin
-        run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests
+        run: cabal test hls-refactor-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-floskell-plugin
-        run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests
+        run: cabal test hls-floskell-plugin-tests
 
       - if: matrix.test
         name: Test hls-class-plugin
-        run: cabal test hls-class-plugin-tests || cabal test hls-class-plugin-tests
+        run: cabal test hls-class-plugin-tests
 
       - if: matrix.test
         name: Test hls-pragmas-plugin
-        run: cabal test hls-pragmas-plugin-tests || cabal test hls-pragmas-plugin-tests
+        run: cabal test hls-pragmas-plugin-tests
 
       - if: matrix.test
         name: Test hls-eval-plugin
-        run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests
+        run: cabal test hls-eval-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-splice-plugin
-        run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests
+        run: cabal test hls-splice-plugin-tests
 
       - if: matrix.test && matrix.ghc != '9.12'
         name: Test hls-stan-plugin
-        run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests
+        run: cabal test hls-stan-plugin-tests
 
       - if: matrix.test
         name: Test hls-stylish-haskell-plugin
-        run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests
+        run: cabal test hls-stylish-haskell-plugin-tests
 
       - if: matrix.test
         name: Test hls-ormolu-plugin
-        run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests
+        run: cabal test hls-ormolu-plugin-tests
 
       - if: matrix.test
         name: Test hls-fourmolu-plugin
-        run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests
+        run: cabal test hls-fourmolu-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-imports-plugin test suite
-        run: cabal test hls-explicit-imports-plugin-tests || cabal test hls-explicit-imports-plugin-tests
+        run: cabal test hls-explicit-imports-plugin-tests
 
       - if: matrix.test
         name: Test hls-call-hierarchy-plugin test suite
-        run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests
+        run: cabal test hls-call-hierarchy-plugin-tests
 
       - if: matrix.test && matrix.os != 'windows-latest'
         name: Test hls-rename-plugin test suite
-        run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests
+        run: cabal test hls-rename-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10'
         name: Test hls-hlint-plugin test suite
-        run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests
+        run: cabal test hls-hlint-plugin-tests
 
       - if: matrix.test
         name: Test hls-module-name-plugin test suite
-        run: cabal test hls-module-name-plugin-tests || cabal test hls-module-name-plugin-tests
+        run: cabal test hls-module-name-plugin-tests
 
       - if: matrix.test
         name: Test hls-alternate-number-format-plugin test suite
-        run: cabal test hls-alternate-number-format-plugin-tests || cabal test hls-alternate-number-format-plugin-tests
+        run: cabal test hls-alternate-number-format-plugin-tests
 
       - if: matrix.test
         name: Test hls-qualify-imported-names-plugin test suite
-        run: cabal test hls-qualify-imported-names-plugin-tests || cabal test hls-qualify-imported-names-plugin-tests
+        run: cabal test hls-qualify-imported-names-plugin-tests
 
       - if: matrix.test
         name: Test hls-code-range-plugin test suite
-        run: cabal test hls-code-range-plugin-tests || cabal test hls-code-range-plugin-tests
+        run: cabal test hls-code-range-plugin-tests
 
       - if: matrix.test
         name: Test hls-change-type-signature test suite
-        run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests
+        run: cabal test hls-change-type-signature-plugin-tests
 
       - if: matrix.test
         name: Test hls-gadt-plugin test suit
-        run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests
+        run: cabal test hls-gadt-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-fixity-plugin test suite
-        run: cabal test hls-explicit-fixity-plugin-tests || cabal test hls-explicit-fixity-plugin-tests
+        run: cabal test hls-explicit-fixity-plugin-tests
 
       - if: matrix.test
         name: Test hls-explicit-record-fields-plugin test suite
-        run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests
+        run: cabal test hls-explicit-record-fields-plugin-tests
 
       # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-cabal-fmt-plugin test suite
-        run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
+        run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests
 
       - if: matrix.test && matrix.ghc != '9.12'
         name: Test hls-cabal-gild-plugin test suite
-        run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
+        run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests
 
       - if: matrix.test
         name: Test hls-cabal-plugin test suite
-        run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests
+        run: cabal test hls-cabal-plugin-tests
 
       # TODO enable when it supports 9.10
       - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12'
         name: Test hls-retrie-plugin test suite
-        run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests
+        run: cabal test hls-retrie-plugin-tests
 
       - if: matrix.test
         name: Test hls-overloaded-record-dot-plugin test suite
-        run: cabal test hls-overloaded-record-dot-plugin-tests || cabal test hls-overloaded-record-dot-plugin-tests
+        run: cabal test hls-overloaded-record-dot-plugin-tests
 
       - if: matrix.test
         name: Test hls-semantic-tokens-plugin test suite
-        run: cabal test hls-semantic-tokens-plugin-tests || cabal test hls-semantic-tokens-plugin-tests
+        run: cabal test hls-semantic-tokens-plugin-tests
 
       - if: matrix.test
         name: Test hls-notes-plugin test suite
-        run: cabal test hls-notes-plugin-tests || cabal test hls-notes-plugin-tests
+        run: cabal test hls-notes-plugin-tests
 
       # The plugin tutorial is only compatible with 9.6 and 9.8.
       # No particular reason, just to avoid excessive CPP.
diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs
@@ -23,24 +23,31 @@ import           Control.Concurrent.STM         (STM)
 import           Control.Concurrent.STM.Stats   (TVar, atomically,
                                                  atomicallyNamed, modifyTVar',
                                                  newTVarIO, readTVar, retry)
-import           Control.Concurrent.Strict      (modifyVar_, newVar,
-                                                 threadDelay)
+import           Control.Concurrent.Strict      (modifyVar_, newBarrier, newVar,
+                                                 signalBarrier, threadDelay,
+                                                 waitBarrier)
 import           Control.Monad.Extra            hiding (loop)
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Class      (lift)
+import qualified Data.Aeson                     as J
 import           Data.Functor                   (($>))
 import qualified Data.Text                      as T
+import           Data.Unique                    (hashUnique, newUnique)
 import           Development.IDE.GHC.Orphans    ()
 import           Development.IDE.Types.Location
 import           Development.IDE.Types.Options
 import qualified Focus
+import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
-import           Language.LSP.Server            (ProgressAmount (..),
+import qualified Language.LSP.Protocol.Types    as L
+import           Language.LSP.Server            (MonadLsp, ProgressAmount (..),
                                                  ProgressCancellable (..),
+                                                 sendNotification, sendRequest,
                                                  withProgress)
 import qualified Language.LSP.Server            as LSP
 import qualified StmContainers.Map              as STM
 import           UnliftIO                       (Async, async, bracket, cancel)
+import qualified UnliftIO.Exception             as UE
 
 data ProgressEvent
   = ProgressNewStarted
@@ -168,7 +175,7 @@ progressReportingNoTrace todo done (Just lspEnv) title optProgressStyle = do
   let _progressUpdate event = liftIO $ updateStateVar $ Event event
       _progressStop = updateStateVar StopProgress
       updateStateVar = modifyVar_ progressState . updateState (progressCounter lspEnv title optProgressStyle todo done)
-  return ProgressReporting {..}
+  return ProgressReporting {_progressUpdate, _progressStop}
 
 -- | `progressReporting` initiates a new progress reporting session.
 -- It necessitates the active tracking of progress using the `inProgress` function.
@@ -196,6 +203,25 @@ progressReporting (Just lspEnv) title optProgressStyle = do
 
         f = recordProgress inProgress file
 
+withProgressDummy ::
+  forall c m a.
+  MonadLsp c m =>
+  T.Text ->
+  Maybe ProgressToken ->
+  ProgressCancellable ->
+  ((ProgressAmount -> m ()) -> m a) ->
+  m a
+withProgressDummy title _ _ f = do
+    t <- L.ProgressToken . L.InR . T.pack . show . hashUnique <$> liftIO newUnique
+    r <- liftIO newBarrier
+    _ <- sendRequest SMethod_WindowWorkDoneProgressCreate (WorkDoneProgressCreateParams t) $
+        \_ -> liftIO $ signalBarrier r ()
+    -- liftIO $ waitBarrier r
+    sendProgressReport t $ WorkDoneProgressBegin L.AString title Nothing Nothing Nothing
+    f (const $ return ()) `UE.finally` sendProgressReport t (WorkDoneProgressEnd L.AString Nothing)
+  where
+    sendProgressReport token report = sendNotification SMethod_Progress $ ProgressParams token $ J.toJSON report
+
 -- Kill this to complete the progress session
 progressCounter ::
   LSP.LanguageContextEnv c ->
@@ -205,8 +231,12 @@ progressCounter ::
   STM Int ->
   IO ()
 progressCounter lspEnv title optProgressStyle getTodo getDone =
-  LSP.runLspT lspEnv $ withProgress title Nothing NotCancellable $ \update -> loop update 0
+  LSP.runLspT lspEnv $ withProgressChoice title Nothing NotCancellable $ \update -> loop update 0
   where
+    withProgressChoice = case optProgressStyle of
+        TestReporting -> withProgressDummy
+        _             -> withProgress
+
     loop _ _ | optProgressStyle == NoProgress = forever $ liftIO $ threadDelay maxBound
     loop update prevPct = do
       (todo, done, nextPct) <- liftIO $ atomically $ do
diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs
@@ -77,8 +77,9 @@ import           Development.IDE.Types.Location           (NormalizedUri,
                                                            toNormalizedFilePath')
 import           Development.IDE.Types.Monitoring         (Monitoring)
 import           Development.IDE.Types.Options            (IdeGhcSession,
-                                                           IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset),
+                                                           IdeOptions (..),
                                                            IdeTesting (IdeTesting),
+                                                           ProgressReportingStyle (TestReporting),
                                                            clientSupportsProgress,
                                                            defaultIdeOptions,
                                                            optModifyDynFlags,
@@ -276,7 +277,10 @@ testing recorder projectRoot plugins =
       let
         defOptions = argsIdeOptions config sessionLoader
       in
-        defOptions{ optTesting = IdeTesting True }
+        defOptions{
+            optTesting = IdeTesting True
+            , optProgressStyle = TestReporting
+            }
     lspOptions = argsLspOptions { LSP.optProgressStartDelay = 0, LSP.optProgressUpdateDelay = 0 }
   in
     arguments
diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs
@@ -107,6 +107,7 @@ newtype IdeOTMemoryProfiling = IdeOTMemoryProfiling    Bool
 data ProgressReportingStyle
     = Percentage -- ^ Report using the LSP @_percentage@ field
     | Explicit   -- ^ Report using explicit 123/456 text
+    | TestReporting -- ^ Special mode for testing, reports only start/stop
     | NoProgress -- ^ Do not report any percentage
     deriving Eq
 
