[Migrate AsyncTests] part of 4173 Migrate ghcide tests to hls test ut…

…ils (#4199) * migrate AsyncTests to hls-test-utils
haskell · May 1, 2024 · 0e52d91 · 0e52d91
1 parent a339277
commit 0e52d91
Show file tree

Hide file tree

Showing 4 changed files with 15 additions and 7 deletions.
diff --git a/ghcide/test/exe/AsyncTests.hs b/ghcide/test/exe/AsyncTests.hs
@@ -15,17 +15,17 @@ import           Language.LSP.Protocol.Types   hiding
                                                 mkRange)
 import           Language.LSP.Test
 -- import Test.QuickCheck.Instances ()
+import           Config
 import           Development.IDE.Plugin.Test   (TestRequest (BlockSeconds),
                                                 blockCommandId)
 import           Test.Tasty
 import           Test.Tasty.HUnit
-import           TestUtils
 
 -- | Test if ghcide asynchronously handles Commands and user Requests
 tests :: TestTree
 tests = testGroup "async"
     [
-      testSession "command" $ do
+      testWithDummyPluginEmpty "command" $ do
             -- Execute a command that will block forever
             let req = ExecuteCommandParams Nothing blockCommandId Nothing
             void $ sendRequest SMethod_WorkspaceExecuteCommand req
@@ -38,7 +38,7 @@ tests = testGroup "async"
             codeLenses <- getAndResolveCodeLenses doc
             liftIO $ [ _title | CodeLens{_command = Just Command{_title}} <- codeLenses] @=?
               [ "foo :: a -> a" ]
-    , testSession "request" $ do
+    , testWithDummyPluginEmpty "request" $ do
             -- Execute a custom request that will block for 1000 seconds
             void $ sendRequest (SMethod_CustomMethod (Proxy @"test")) $ toJSON $ BlockSeconds 1000
             -- Load a file and check for code actions. Will only work if the request is run asynchronously

diff --git a/ghcide/test/exe/Config.hs b/ghcide/test/exe/Config.hs
@@ -31,5 +31,14 @@ testWithDummyPlugin caseName vfs = testCase caseName . runWithDummyPlugin vfs
 testWithDummyPlugin' :: String -> FS.VirtualFileTree -> (FileSystem -> Session ()) -> TestTree
 testWithDummyPlugin' caseName vfs = testCase caseName . runWithDummyPlugin' vfs
 
+runWithDummyPluginEmpty :: Session a -> IO a
+runWithDummyPluginEmpty = runWithDummyPlugin $ mkIdeTestFs []
+
+testWithDummyPluginEmpty :: String -> Session () -> TestTree
+testWithDummyPluginEmpty caseName = testWithDummyPlugin caseName $ mkIdeTestFs []
+
+testWithDummyPluginEmpty' :: String -> (FileSystem -> Session ()) -> TestTree
+testWithDummyPluginEmpty' caseName = testWithDummyPlugin' caseName $ mkIdeTestFs []
+
 pattern R :: UInt -> UInt -> UInt -> UInt -> Range
 pattern R x y x' y' = Range (Position x y) (Position x' y')
diff --git a/ghcide/test/exe/DependentFileTest.hs b/ghcide/test/exe/DependentFileTest.hs
@@ -20,7 +20,7 @@ import           Test.Tasty
 
 tests :: TestTree
 tests = testGroup "addDependentFile"
-    [testGroup "file-changed" [testWithDummyPlugin' "test" (mkIdeTestFs []) test]
+    [testGroup "file-changed" [testWithDummyPluginEmpty' "test" test]
     ]
     where
       test :: FileSystem -> Session ()

diff --git a/ghcide/test/exe/InitializeResponseTests.hs b/ghcide/test/exe/InitializeResponseTests.hs
@@ -11,8 +11,7 @@ import qualified Language.LSP.Protocol.Lens        as L
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Test
 
-import           Config                            (dummyPlugin, mkIdeTestFs,
-                                                    runWithDummyPlugin)
+import           Config
 import           Control.Lens                      ((^.))
 import           Development.IDE.Plugin.Test       (blockCommandId)
 import           Test.Hls
@@ -88,7 +87,7 @@ tests = withResource acquire release tests where
   innerCaps (TResponseMessage _ _ (Left _)) = error "Initialization error"
 
   acquire :: IO (TResponseMessage Method_Initialize)
-  acquire = runWithDummyPlugin (mkIdeTestFs []) initializeResponse
+  acquire = runWithDummyPluginEmpty initializeResponse
 
   release :: TResponseMessage Method_Initialize -> IO ()
   release = mempty