diff --git a/ghcide/test/exe/AsyncTests.hs b/ghcide/test/exe/AsyncTests.hs index 4f72a00f18..f341ab504b 100644 --- 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 index fa33ccefd8..4ec7901bf3 100644 --- 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 index 00fed1916b..dc55ff80d3 100644 --- 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 index 5fa7dade0c..bccf124c09 100644 --- 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