attempt to fix tactics test suite in Windows

Author: pepeiborra

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

@@ -22,7 +22,8 @@ module Test.Hls
     waitForAllProgressDone,
     PluginDescriptor,
     IdeState,
-  )
+    waitForBuildQueue
+    )
 where
 
 import           Control.Applicative.Combinators
@@ -31,6 +32,7 @@ import           Control.Concurrent.Extra
 import           Control.Exception.Base
 import           Control.Monad                     (unless)
 import           Control.Monad.IO.Class
+import           Data.Aeson                        (Value (Null), toJSON)
 import           Data.ByteString.Lazy              (ByteString)
 import           Data.Default                      (def)
 import qualified Data.Text                         as T
@@ -42,6 +44,7 @@ import           Development.IDE.Graph             (ShakeOptions (shakeThreads))
 import           Development.IDE.Main
 import qualified Development.IDE.Main              as Ghcide
 import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
+import           Development.IDE.Plugin.Test       (TestRequest (WaitForShakeQueue))
 import           Development.IDE.Types.Options
 import           GHC.IO.Handle
 import           Ide.Plugin.Config                 (Config, formattingProvider)
@@ -208,3 +211,14 @@ waitForAllProgressDone = loop
         _ -> Nothing
       done <- null <$> getIncompleteProgressSessions
       unless done loop
+
+-- | Wait for the build queue to be empty
+waitForBuildQueue :: Session Seconds
+waitForBuildQueue = do
+    let m = SCustomMethod "test"
+    waitId <- sendRequest m (toJSON WaitForShakeQueue)
+    (td, resp) <- duration $ skipManyTill anyMessage $ responseForId m waitId
+    case resp of
+        ResponseMessage{_result=Right Null} -> return td
+        -- assume a ghcide binary lacking the WaitForShakeQueue method
+        _                                   -> return 0

plugins/hls-tactics-plugin/test/Utils.hs

@@ -10,7 +10,7 @@ module Utils where
 import           Control.DeepSeq (deepseq)
 import qualified Control.Exception as E
 import           Control.Lens hiding (List, failing, (<.>), (.=))
-import           Control.Monad (unless)
+import           Control.Monad (unless, void)
 import           Control.Monad.IO.Class
 import           Data.Aeson
 import           Data.Foldable
@@ -108,8 +108,11 @@ mkGoldenTest eq tc occ line col input =
     resetGlobalHoleRef
     runSessionForTactics $ do
       doc <- openDoc (input <.> "hs") "haskell"
+      -- wait for diagnostics to start coming
       _ <- waitForDiagnostics
-      waitForAllProgressDone
+      -- wait for the entire build to finish, so that Tactics code actions that
+      -- use stale data will get uptodate stuff
+      void waitForBuildQueue
       actions <- getCodeActions doc $ pointRange line col
       case find ((== Just (tacticTitle tc occ)) . codeActionTitle) actions of
         Just (InR CodeAction {_command = Just c}) -> do
@@ -122,7 +125,7 @@ mkGoldenTest eq tc occ line col input =
                 T.writeFile expected_name edited
             expected <- liftIO $ T.readFile expected_name
             liftIO $ edited `eq` expected
-        other -> error $ show other
+        _ -> error $ show actions
 
 
 mkCodeLensTest