Skip to content
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.

Commit 61fd5c4

Browse files
soulomoonfendor
soulomoon
and
fendor
authoredMay 13, 2024
[Migrate diagnosticTests] part of #4173 Migrate ghcide tests to hls test utils (#4207)
* [x] migrate diagnosticTests, figure out how to pass `--test-no-kick`. * [x] migrate openCloseTests * [x] Lift a few functions from ghcide-test-utils to hls-test-utils * [x] fixed `deeply nested cyclic module dependency` * [x] modify `runSessionWithServer'` and ghcIde arguments to admit additional a switch for `no-kick`. --------- Co-authored-by: fendor <[email protected]>
1 parent 23005f8 commit 61fd5c4

File tree

17 files changed

+198
-186
lines changed

17 files changed

+198
-186
lines changed
 

‎ghcide/exe/Main.hs

Lines changed: 0 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -124,12 +124,7 @@ main = withTelemetryRecorder $ \telemetryRecorder -> do
124124
, IDEMain.argsHlsPlugins = IDEMain.argsHlsPlugins arguments <> pluginDescToIdePlugins [lspRecorderPlugin]
125125

126126
, IDEMain.argsRules = do
127-
-- install the main and ghcide-plugin rules
128127
mainRule (cmapWithPrio LogRules recorder) def
129-
-- install the kick action, which triggers a typecheck on every
130-
-- Shake database restart, i.e. on every user edit.
131-
unless argsDisableKick $
132-
action kick
133128

134129
, IDEMain.argsThreads = case argsThreads of 0 -> Nothing ; i -> Just (fromIntegral i)
135130

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -223,13 +223,14 @@ data Arguments = Arguments
223223
, argsHandleOut :: IO Handle
224224
, argsThreads :: Maybe Natural
225225
, argsMonitoring :: IO Monitoring
226+
, argsDisableKick :: Bool -- ^ flag to disable kick used for testing
226227
}
227228

228229
defaultArguments :: Recorder (WithPriority Log) -> IdePlugins IdeState -> Arguments
229230
defaultArguments recorder plugins = Arguments
230231
{ argsProjectRoot = Nothing
231232
, argCommand = LSP
232-
, argsRules = mainRule (cmapWithPrio LogRules recorder) def >> action kick
233+
, argsRules = mainRule (cmapWithPrio LogRules recorder) def
233234
, argsGhcidePlugin = mempty
234235
, argsHlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde recorder)) <> plugins
235236
, argsSessionLoadingOptions = def
@@ -258,6 +259,7 @@ defaultArguments recorder plugins = Arguments
258259
putStr " " >> hFlush stdout
259260
return newStdout
260261
, argsMonitoring = OpenTelemetry.monitoring
262+
, argsDisableKick = False
261263
}
262264

263265

@@ -293,7 +295,13 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
293295
plugins = hlsPlugin <> argsGhcidePlugin
294296
options = argsLspOptions { LSP.optExecuteCommandCommands = LSP.optExecuteCommandCommands argsLspOptions <> Just hlsCommands }
295297
argsParseConfig = getConfigFromNotification argsHlsPlugins
296-
rules = argsRules >> pluginRules plugins
298+
rules = do
299+
argsRules
300+
unless argsDisableKick $ action kick
301+
pluginRules plugins
302+
-- install the main and ghcide-plugin rules
303+
-- install the kick action, which triggers a typecheck on every
304+
-- Shake database restart, i.e. on every user edit.
297305

298306
debouncer <- argsDebouncer
299307
inH <- argsHandleIn

‎ghcide/test/exe/ClientSettingsTests.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import Language.LSP.Protocol.Types hiding
1414
SemanticTokensEdit (..),
1515
mkRange)
1616
import Language.LSP.Test
17+
import Test.Hls (waitForProgressDone)
1718
import Test.Tasty
1819
import TestUtils
1920

‎ghcide/test/exe/CodeLensTests.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -18,6 +18,7 @@ import Language.LSP.Protocol.Types hiding
1818
SemanticTokensEdit (..),
1919
mkRange)
2020
import Language.LSP.Test
21+
import Test.Hls (waitForProgressDone)
2122
import Test.Tasty
2223
import Test.Tasty.HUnit
2324
import TestUtils

‎ghcide/test/exe/CompletionTests.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -49,10 +49,10 @@ tests
4949
]
5050

5151
testSessionEmpty :: TestName -> Session () -> TestTree
52-
testSessionEmpty name = testCase name . runWithDummyPlugin (mkIdeTestFs [FS.directCradle ["A.hs"]])
52+
testSessionEmpty name = testWithDummyPlugin name (mkIdeTestFs [FS.directCradle ["A.hs"]])
5353

5454
testSessionEmptyWithCradle :: TestName -> T.Text -> Session () -> TestTree
55-
testSessionEmptyWithCradle name cradle = testCase name . runWithDummyPlugin (mkIdeTestFs [file "hie.yaml" (text cradle)])
55+
testSessionEmptyWithCradle name cradle = testWithDummyPlugin name (mkIdeTestFs [file "hie.yaml" (text cradle)])
5656

5757
testSessionSingleFile :: TestName -> FilePath -> T.Text -> Session () -> TestTree
5858
testSessionSingleFile testName fp txt session =

‎ghcide/test/exe/Config.hs

Lines changed: 39 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,37 @@
11
{-# LANGUAGE PatternSynonyms #-}
22

3-
module Config where
4-
3+
module Config(
4+
-- * basic config for ghcIde testing
5+
mkIdeTestFs
6+
, dummyPlugin
7+
8+
-- * runners for testing with dummy plugin
9+
, runWithDummyPlugin
10+
, testWithDummyPlugin
11+
, testWithDummyPluginEmpty
12+
, testWithDummyPlugin'
13+
, testWithDummyPluginEmpty'
14+
, testWithDummyPluginAndCap'
15+
, runWithExtraFiles
16+
, testWithExtraFiles
17+
18+
-- * utilities for testing definition and hover
19+
, Expect(..)
20+
, pattern R
21+
, mkR
22+
, checkDefs
23+
, mkL
24+
, lspTestCaps
25+
, lspTestCapsNoFileWatches
26+
) where
27+
28+
import Control.Lens.Setter ((.~))
529
import Data.Foldable (traverse_)
30+
import Data.Function ((&))
631
import qualified Data.Text as T
732
import Development.IDE.Test (canonicalizeUri)
833
import Ide.Types (defaultPluginDescriptor)
34+
import qualified Language.LSP.Protocol.Lens as L
935
import Language.LSP.Protocol.Types (Null (..))
1036
import System.FilePath ((</>))
1137
import Test.Hls
@@ -28,22 +54,18 @@ runWithDummyPlugin = runSessionWithServerInTmpDir def dummyPlugin
2854
runWithDummyPlugin' :: FS.VirtualFileTree -> (FileSystem -> Session a) -> IO a
2955
runWithDummyPlugin' = runSessionWithServerInTmpDirCont' def dummyPlugin
3056

31-
runWithDummyPluginAndCap :: ClientCapabilities -> Session () -> IO ()
32-
runWithDummyPluginAndCap cap = runSessionWithServerAndCapsInTmpDir def dummyPlugin cap (mkIdeTestFs [])
57+
runWithDummyPluginAndCap' :: ClientCapabilities -> (FileSystem -> Session ()) -> IO ()
58+
runWithDummyPluginAndCap' cap = runSessionWithServerAndCapsInTmpDirCont def dummyPlugin cap (mkIdeTestFs [])
3359

34-
testWithDummyPluginAndCap :: String -> ClientCapabilities -> Session () -> TestTree
35-
testWithDummyPluginAndCap caseName cap = testCase caseName . runWithDummyPluginAndCap cap
60+
testWithDummyPluginAndCap' :: String -> ClientCapabilities -> (FileSystem -> Session ()) -> TestTree
61+
testWithDummyPluginAndCap' caseName cap = testCase caseName . runWithDummyPluginAndCap' cap
3662

37-
-- testSessionWithCorePlugin ::(TestRunner cont ()) => TestName -> FS.VirtualFileTree -> cont -> TestTree
3863
testWithDummyPlugin :: String -> FS.VirtualFileTree -> Session () -> TestTree
39-
testWithDummyPlugin caseName vfs = testCase caseName . runWithDummyPlugin vfs
64+
testWithDummyPlugin caseName vfs = testWithDummyPlugin' caseName vfs . const
4065

4166
testWithDummyPlugin' :: String -> FS.VirtualFileTree -> (FileSystem -> Session ()) -> TestTree
4267
testWithDummyPlugin' caseName vfs = testCase caseName . runWithDummyPlugin' vfs
4368

44-
runWithDummyPluginEmpty :: Session a -> IO a
45-
runWithDummyPluginEmpty = runWithDummyPlugin $ mkIdeTestFs []
46-
4769
testWithDummyPluginEmpty :: String -> Session () -> TestTree
4870
testWithDummyPluginEmpty caseName = testWithDummyPlugin caseName $ mkIdeTestFs []
4971

@@ -114,3 +136,9 @@ defToLocation (InL (Definition (InL l))) = [l]
114136
defToLocation (InL (Definition (InR ls))) = ls
115137
defToLocation (InR (InL defLink)) = (\(DefinitionLink LocationLink{_targetUri,_targetRange}) -> Location _targetUri _targetRange) <$> defLink
116138
defToLocation (InR (InR Null)) = []
139+
140+
lspTestCaps :: ClientCapabilities
141+
lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
142+
143+
lspTestCapsNoFileWatches :: ClientCapabilities
144+
lspTestCapsNoFileWatches = lspTestCaps & L.workspace . traverse . L.didChangeWatchedFiles .~ Nothing

‎ghcide/test/exe/DiagnosticTests.hs

Lines changed: 57 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -30,17 +30,24 @@ import System.Directory
3030
import System.FilePath
3131
import System.IO.Extra hiding (withTempDir)
3232

33+
import Config
3334
import Control.Lens ((^.))
3435
import Control.Monad.Extra (whenJust)
36+
import Data.Default (def)
3537
import Development.IDE.Plugin.Test (WaitForIdeRuleResult (..))
3638
import System.Time.Extra
39+
import Test.Hls (runSessionWithServer',
40+
runSessionWithServerInTmpDirCont,
41+
waitForProgressBegin,
42+
waitForTypecheck)
43+
import Test.Hls.FileSystem (directCradle, file, text,
44+
toAbsFp)
3745
import Test.Tasty
3846
import Test.Tasty.HUnit
39-
import TestUtils
4047

4148
tests :: TestTree
4249
tests = testGroup "diagnostics"
43-
[ testSessionWait "fix syntax error" $ do
50+
[ testWithDummyPluginEmpty "fix syntax error" $ do
4451
let content = T.unlines [ "module Testing wher" ]
4552
doc <- createDoc "Testing.hs" "haskell" content
4653
expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error")])]
@@ -51,7 +58,7 @@ tests = testGroup "diagnostics"
5158
}
5259
changeDoc doc [change]
5360
expectDiagnostics [("Testing.hs", [])]
54-
, testSessionWait "introduce syntax error" $ do
61+
, testWithDummyPluginEmpty "introduce syntax error" $ do
5562
let content = T.unlines [ "module Testing where" ]
5663
doc <- createDoc "Testing.hs" "haskell" content
5764
void $ skipManyTill anyMessage (message SMethod_WindowWorkDoneProgressCreate)
@@ -63,7 +70,7 @@ tests = testGroup "diagnostics"
6370
}
6471
changeDoc doc [change]
6572
expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "parse error")])]
66-
, testSessionWait "update syntax error" $ do
73+
, testWithDummyPluginEmpty "update syntax error" $ do
6774
let content = T.unlines [ "module Testing(missing) where" ]
6875
doc <- createDoc "Testing.hs" "haskell" content
6976
expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "Not in scope: 'missing'")])]
@@ -74,7 +81,7 @@ tests = testGroup "diagnostics"
7481
}
7582
changeDoc doc [change]
7683
expectDiagnostics [("Testing.hs", [(DiagnosticSeverity_Error, (0, 15), "Not in scope: 'lissing'")])]
77-
, testSessionWait "variable not in scope" $ do
84+
, testWithDummyPluginEmpty "variable not in scope" $ do
7885
let content = T.unlines
7986
[ "module Testing where"
8087
, "foo :: Int -> Int -> Int"
@@ -90,7 +97,7 @@ tests = testGroup "diagnostics"
9097
]
9198
)
9299
]
93-
, testSessionWait "type error" $ do
100+
, testWithDummyPluginEmpty "type error" $ do
94101
let content = T.unlines
95102
[ "module Testing where"
96103
, "foo :: Int -> String -> Int"
@@ -102,7 +109,7 @@ tests = testGroup "diagnostics"
102109
, [(DiagnosticSeverity_Error, (2, 14), "Couldn't match type '[Char]' with 'Int'")]
103110
)
104111
]
105-
, testSessionWait "typed hole" $ do
112+
, testWithDummyPluginEmpty "typed hole" $ do
106113
let content = T.unlines
107114
[ "module Testing where"
108115
, "foo :: Int -> String"
@@ -129,7 +136,7 @@ tests = testGroup "diagnostics"
129136
expectedDs aMessage =
130137
[ ("A.hs", [(DiagnosticSeverity_Error, (2,4), aMessage)])
131138
, ("B.hs", [(DiagnosticSeverity_Error, (3,4), bMessage)])]
132-
deferralTest title binding msg = testSessionWait title $ do
139+
deferralTest title binding msg = testWithDummyPluginEmpty title $ do
133140
_ <- createDoc "A.hs" "haskell" $ sourceA binding
134141
_ <- createDoc "B.hs" "haskell" sourceB
135142
expectDiagnostics $ expectedDs msg
@@ -139,7 +146,7 @@ tests = testGroup "diagnostics"
139146
, deferralTest "out of scope var" "unbound" "Variable not in scope"
140147
]
141148

142-
, testSessionWait "remove required module" $ do
149+
, testWithDummyPluginEmpty "remove required module" $ do
143150
let contentA = T.unlines [ "module ModuleA where" ]
144151
docA <- createDoc "ModuleA.hs" "haskell" contentA
145152
let contentB = T.unlines
@@ -154,7 +161,7 @@ tests = testGroup "diagnostics"
154161
}
155162
changeDoc docA [change]
156163
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Error, (1, 0), "Could not find module")])]
157-
, testSessionWait "add missing module" $ do
164+
, testWithDummyPluginEmpty "add missing module" $ do
158165
let contentB = T.unlines
159166
[ "module ModuleB where"
160167
, "import ModuleA ()"
@@ -164,22 +171,21 @@ tests = testGroup "diagnostics"
164171
let contentA = T.unlines [ "module ModuleA where" ]
165172
_ <- createDoc "ModuleA.hs" "haskell" contentA
166173
expectDiagnostics [("ModuleB.hs", [])]
167-
, testCase "add missing module (non workspace)" $
174+
, testWithDummyPluginAndCap' "add missing module (non workspace)" lspTestCapsNoFileWatches $ \tmpDir -> do
168175
-- By default lsp-test sends FileWatched notifications for all files, which we don't want
169176
-- as non workspace modules will not be watched by the LSP server.
170177
-- To work around this, we tell lsp-test that our client doesn't have the
171178
-- FileWatched capability, which is enough to disable the notifications
172-
withTempDir $ \tmpDir -> runInDir'' lspTestCapsNoFileWatches tmpDir "." "." [] $ do
173179
let contentB = T.unlines
174180
[ "module ModuleB where"
175181
, "import ModuleA ()"
176182
]
177-
_ <- createDoc (tmpDir </> "ModuleB.hs") "haskell" contentB
178-
expectDiagnostics [(tmpDir </> "ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module")])]
183+
_ <- createDoc (tmpDir `toAbsFp` "ModuleB.hs") "haskell" contentB
184+
expectDiagnostics [(tmpDir `toAbsFp` "ModuleB.hs", [(DiagnosticSeverity_Error, (1, 7), "Could not find module")])]
179185
let contentA = T.unlines [ "module ModuleA where" ]
180-
_ <- createDoc (tmpDir </> "ModuleA.hs") "haskell" contentA
181-
expectDiagnostics [(tmpDir </> "ModuleB.hs", [])]
182-
, testSessionWait "cyclic module dependency" $ do
186+
_ <- createDoc (tmpDir `toAbsFp` "ModuleA.hs") "haskell" contentA
187+
expectDiagnostics [(tmpDir `toAbsFp` "ModuleB.hs", [])]
188+
, testWithDummyPluginEmpty "cyclic module dependency" $ do
183189
let contentA = T.unlines
184190
[ "module ModuleA where"
185191
, "import ModuleB"
@@ -198,28 +204,24 @@ tests = testGroup "diagnostics"
198204
, [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
199205
)
200206
]
201-
, testSession' "deeply nested cyclic module dependency" $ \path -> do
202-
let contentA = unlines
203-
[ "module ModuleA where" , "import ModuleB" ]
204-
let contentB = unlines
205-
[ "module ModuleB where" , "import ModuleA" ]
206-
let contentC = unlines
207-
[ "module ModuleC where" , "import ModuleB" ]
208-
let contentD = T.unlines
209-
[ "module ModuleD where" , "import ModuleC" ]
210-
cradle =
211-
"cradle: {direct: {arguments: [ModuleA, ModuleB, ModuleC, ModuleD]}}"
212-
liftIO $ writeFile (path </> "ModuleA.hs") contentA
213-
liftIO $ writeFile (path </> "ModuleB.hs") contentB
214-
liftIO $ writeFile (path </> "ModuleC.hs") contentC
215-
liftIO $ writeFile (path </> "hie.yaml") cradle
207+
, let contentA = T.unlines [ "module ModuleA where" , "import ModuleB" ]
208+
contentB = T.unlines [ "module ModuleB where" , "import ModuleA" ]
209+
contentC = T.unlines [ "module ModuleC where" , "import ModuleB" ]
210+
contentD = T.unlines [ "module ModuleD where" , "import ModuleC" ]
211+
cradle = directCradle ["ModuleA", "ModuleB", "ModuleC", "ModuleD"]
212+
in testWithDummyPlugin "deeply nested cyclic module dependency"
213+
(mkIdeTestFs [
214+
file "ModuleA.hs" (text contentA)
215+
,file "ModuleB.hs" (text contentB)
216+
,file "ModuleC.hs" (text contentC)
217+
,cradle
218+
]) $ do
216219
_ <- createDoc "ModuleD.hs" "haskell" contentD
217220
expectDiagnostics
218-
[ ( "ModuleB.hs"
219-
, [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")]
220-
)
221+
[ ( "ModuleB.hs" , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")])
222+
, ( "ModuleA.hs" , [(DiagnosticSeverity_Error, (1, 7), "Cyclic module dependency between ModuleA, ModuleB")])
221223
]
222-
, testSessionWait "cyclic module dependency with hs-boot" $ do
224+
, testWithDummyPluginEmpty "cyclic module dependency with hs-boot" $ do
223225
let contentA = T.unlines
224226
[ "module ModuleA where"
225227
, "import {-# SOURCE #-} ModuleB"
@@ -238,11 +240,9 @@ tests = testGroup "diagnostics"
238240
_ <- createDoc "ModuleB.hs" "haskell" contentB
239241
_ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
240242
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
241-
, testSession' "bidirectional module dependency with hs-boot" $ \path -> do
242-
let cradle = unlines
243-
[ "cradle:"
244-
, " direct: {arguments: [ModuleA, ModuleB]}"
245-
]
243+
, testWithDummyPlugin "bidirectional module dependency with hs-boot"
244+
(mkIdeTestFs [directCradle ["ModuleA", "ModuleB"]])
245+
$ do
246246
let contentA = T.unlines
247247
[ "module ModuleA where"
248248
, "import {-# SOURCE #-} ModuleB"
@@ -260,13 +260,12 @@ tests = testGroup "diagnostics"
260260
let contentAboot = T.unlines
261261
[ "module ModuleA where"
262262
]
263-
liftIO $ writeFile (path </> "hie.yaml") cradle
264263
_ <- createDoc "ModuleA.hs" "haskell" contentA
265264
_ <- createDoc "ModuleA.hs-boot" "haskell" contentAboot
266265
_ <- createDoc "ModuleB.hs" "haskell" contentB
267266
_ <- createDoc "ModuleB.hs-boot" "haskell" contentBboot
268267
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
269-
, testSessionWait "correct reference used with hs-boot" $ do
268+
, testWithDummyPluginEmpty "correct reference used with hs-boot" $ do
270269
let contentB = T.unlines
271270
[ "module ModuleB where"
272271
, "import {-# SOURCE #-} ModuleA()"
@@ -292,7 +291,7 @@ tests = testGroup "diagnostics"
292291
_ <- createDoc "ModuleA.hs-boot" "haskell" contentAboot
293292
_ <- createDoc "ModuleC.hs" "haskell" contentC
294293
expectDiagnostics [("ModuleC.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
295-
, testSessionWait "redundant import" $ do
294+
, testWithDummyPluginEmpty "redundant import" $ do
296295
let contentA = T.unlines ["module ModuleA where"]
297296
let contentB = T.unlines
298297
[ "{-# OPTIONS_GHC -Wunused-imports #-}"
@@ -306,7 +305,7 @@ tests = testGroup "diagnostics"
306305
, [(DiagnosticSeverity_Warning, (2, 0), "The import of 'ModuleA' is redundant", Just DiagnosticTag_Unnecessary)]
307306
)
308307
]
309-
, testSessionWait "redundant import even without warning" $ do
308+
, testWithDummyPluginEmpty "redundant import even without warning" $ do
310309
let contentA = T.unlines ["module ModuleA where"]
311310
let contentB = T.unlines
312311
[ "{-# OPTIONS_GHC -Wno-unused-imports -Wmissing-signatures #-}"
@@ -318,7 +317,7 @@ tests = testGroup "diagnostics"
318317
_ <- createDoc "ModuleA.hs" "haskell" contentA
319318
_ <- createDoc "ModuleB.hs" "haskell" contentB
320319
expectDiagnostics [("ModuleB.hs", [(DiagnosticSeverity_Warning, (3,0), "Top-level binding")])]
321-
, testSessionWait "package imports" $ do
320+
, testWithDummyPluginEmpty "package imports" $ do
322321
let thisDataListContent = T.unlines
323322
[ "module Data.List where"
324323
, "x :: Integer"
@@ -356,7 +355,7 @@ tests = testGroup "diagnostics"
356355
]
357356
)
358357
]
359-
, testSessionWait "unqualified warnings" $ do
358+
, testWithDummyPluginEmpty "unqualified warnings" $ do
360359
let fooContent = T.unlines
361360
[ "{-# OPTIONS_GHC -Wredundant-constraints #-}"
362361
, "module Foo where"
@@ -374,7 +373,7 @@ tests = testGroup "diagnostics"
374373
]
375374
)
376375
]
377-
, testSessionWait "lower-case drive" $ do
376+
, testWithDummyPluginEmpty "lower-case drive" $ do
378377
let aContent = T.unlines
379378
[ "module A.A where"
380379
, "import A.B ()"
@@ -407,7 +406,7 @@ tests = testGroup "diagnostics"
407406
liftIO $ unless ("redundant" `T.isInfixOf` msg) $
408407
assertFailure ("Expected redundant import but got " <> T.unpack msg)
409408
closeDoc a
410-
, testSessionWait "strip file path" $ do
409+
, testWithDummyPluginEmpty "strip file path" $ do
411410
let
412411
name = "Testing"
413412
content = T.unlines
@@ -426,9 +425,9 @@ tests = testGroup "diagnostics"
426425
Lens.filtered (T.isInfixOf ("/" <> name <> ".hs:"))
427426
failure msg = liftIO $ assertFailure $ "Expected file path to be stripped but got " <> T.unpack msg
428427
Lens.mapMOf_ offenders failure notification
429-
, testSession' "-Werror in cradle is ignored" $ \sessionDir -> do
430-
liftIO $ writeFile (sessionDir </> "hie.yaml")
431-
"cradle: {direct: {arguments: [\"-Wall\", \"-Werror\"]}}"
428+
, testWithDummyPlugin "-Werror in cradle is ignored"
429+
(mkIdeTestFs [directCradle ["-Wall", "-Werror"]])
430+
$ do
432431
let fooContent = T.unlines
433432
[ "module Foo where"
434433
, "foo = ()"
@@ -440,7 +439,7 @@ tests = testGroup "diagnostics"
440439
]
441440
)
442441
]
443-
, testSessionWait "-Werror in pragma is ignored" $ do
442+
, testWithDummyPluginEmpty "-Werror in pragma is ignored" $ do
444443
let fooContent = T.unlines
445444
[ "{-# OPTIONS_GHC -Wall -Werror #-}"
446445
, "module Foo() where"
@@ -455,9 +454,9 @@ tests = testGroup "diagnostics"
455454
)
456455
]
457456
, testCase "typecheck-all-parents-of-interest" $ runWithExtraFiles "recomp" $ \dir -> do
458-
let bPath = dir </> "B.hs"
459-
pPath = dir </> "P.hs"
460-
aPath = dir </> "A.hs"
457+
let bPath = dir `toAbsFp` "B.hs"
458+
pPath = dir `toAbsFp` "P.hs"
459+
aPath = dir `toAbsFp` "A.hs"
461460

462461
bSource <- liftIO $ readFileUtf8 bPath -- y :: Int
463462
pSource <- liftIO $ readFileUtf8 pPath -- bar = x :: Int
@@ -490,7 +489,7 @@ tests = testGroup "diagnostics"
490489
]
491490
expectNoMoreDiagnostics 1
492491

493-
, testSessionWait "deduplicate missing module diagnostics" $ do
492+
, testWithDummyPluginEmpty "deduplicate missing module diagnostics" $ do
494493
let fooContent = T.unlines [ "module Foo() where" , "import MissingModule" ]
495494
doc <- createDoc "Foo.hs" "haskell" fooContent
496495
expectDiagnostics [("Foo.hs", [(DiagnosticSeverity_Error, (1,7), "Could not find module 'MissingModule'")])]
@@ -578,8 +577,7 @@ cancellationTemplate (edit, undoEdit) mbKey = testCase (maybe "-" fst mbKey) $ r
578577
expectNoMoreDiagnostics 0.5
579578
where
580579
-- similar to run except it disables kick
581-
runTestNoKick s = withTempDir $ \dir -> runInDir' dir "." "." ["--test-no-kick"] s
582-
580+
runTestNoKick s = runSessionWithServerInTmpDirCont True dummyPlugin def def def (mkIdeTestFs []) (const s)
583581
typeCheck doc = do
584582
WaitForIdeRuleResult {..} <- waitForAction "TypeCheck" doc
585583
liftIO $ assertBool "The file should typecheck" ideResultSuccess

‎ghcide/test/exe/ExceptionTests.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ import Language.LSP.Protocol.Types hiding
3131
mkRange)
3232
import Language.LSP.Test
3333
import LogType (Log (..))
34+
import Test.Hls (waitForProgressDone)
3435
import Test.Tasty
3536
import Test.Tasty.HUnit
3637
import TestUtils

‎ghcide/test/exe/InitializeResponseTests.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -87,7 +87,7 @@ tests = withResource acquire release tests where
8787
innerCaps (TResponseMessage _ _ (Left _)) = error "Initialization error"
8888

8989
acquire :: IO (TResponseMessage Method_Initialize)
90-
acquire = runWithDummyPluginEmpty initializeResponse
90+
acquire = runWithDummyPlugin (mkIdeTestFs []) initializeResponse
9191

9292
release :: TResponseMessage Method_Initialize -> IO ()
9393
release = mempty

‎ghcide/test/exe/OpenCloseTest.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -6,11 +6,13 @@ import Control.Monad
66
import Language.LSP.Protocol.Message
77
import Language.LSP.Test
88
-- import Test.QuickCheck.Instances ()
9+
import Config (testWithDummyPluginEmpty)
10+
import Test.Hls (waitForProgressBegin,
11+
waitForProgressDone)
912
import Test.Tasty
10-
import TestUtils
1113

1214
tests :: TestTree
13-
tests = testSession "open close" $ do
15+
tests = testWithDummyPluginEmpty "open close" $ do
1416
doc <- createDoc "Testing.hs" "haskell" ""
1517
void (skipManyTill anyMessage $ message SMethod_WindowWorkDoneProgressCreate)
1618
waitForProgressBegin

‎ghcide/test/exe/THTests.hs

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,8 @@ import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..),
1212
SemanticTokensEdit (..), mkRange)
1313
import Language.LSP.Test
1414
import System.FilePath
15+
import Test.Hls (waitForAllProgressDone,
16+
waitForProgressBegin)
1517
import Test.Tasty
1618
import Test.Tasty.HUnit
1719
import TestUtils

‎ghcide/test/exe/TestUtils.hs

Lines changed: 1 addition & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -40,33 +40,9 @@ import Test.Tasty
4040
import Test.Tasty.ExpectedFailure
4141
import Test.Tasty.HUnit
4242

43+
import Config (lspTestCaps)
4344
import LogType
4445

45-
-- | Wait for the next progress begin step
46-
waitForProgressBegin :: Session ()
47-
waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
48-
FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams _ v)) | Lens.is _workDoneProgressBegin v-> Just ()
49-
_ -> Nothing
50-
51-
-- | Wait for the first progress end step
52-
-- Also implemented in hls-test-utils Test.Hls
53-
waitForProgressDone :: Session ()
54-
waitForProgressDone = skipManyTill anyMessage $ satisfyMaybe $ \case
55-
FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams _ v)) | Lens.is _workDoneProgressEnd v -> Just ()
56-
_ -> Nothing
57-
58-
-- | Wait for all progress to be done
59-
-- Needs at least one progress done notification to return
60-
-- Also implemented in hls-test-utils Test.Hls
61-
waitForAllProgressDone :: Session ()
62-
waitForAllProgressDone = loop
63-
where
64-
loop = do
65-
~() <- skipManyTill anyMessage $ satisfyMaybe $ \case
66-
FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams _ v)) |Lens.is _workDoneProgressEnd v-> Just ()
67-
_ -> Nothing
68-
done <- null <$> getIncompleteProgressSessions
69-
unless done loop
7046

7147
run :: Session a -> IO a
7248
run s = run' (const s)
@@ -122,9 +98,6 @@ withTempDir f = System.IO.Extra.withTempDir $ \dir -> do
12298
dir' <- canonicalizePath dir
12399
f dir'
124100

125-
lspTestCaps :: ClientCapabilities
126-
lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }
127-
128101
getConfigFromEnv :: IO SessionConfig
129102
getConfigFromEnv = do
130103
logColor <- fromMaybe True <$> checkEnv "LSP_TEST_LOG_COLOR"
@@ -231,11 +204,6 @@ copyTestDataFiles dir prefix = do
231204
withLongTimeout :: IO a -> IO a
232205
withLongTimeout = bracket_ (setEnv "LSP_TIMEOUT" "120" True) (unsetEnv "LSP_TIMEOUT")
233206

234-
235-
236-
lspTestCapsNoFileWatches :: ClientCapabilities
237-
lspTestCapsNoFileWatches = lspTestCaps & L.workspace . Lens._Just . L.didChangeWatchedFiles .~ Nothing
238-
239207
testIde :: Recorder (WithPriority Log) -> IDE.Arguments -> Session () -> IO ()
240208
testIde recorder arguments session = do
241209
config <- getConfigFromEnv

‎ghcide/test/exe/UnitTests.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -30,6 +30,7 @@ import Network.URI
3030
import qualified Progress
3131
import System.IO.Extra hiding (withTempDir)
3232
import System.Mem (performGC)
33+
import Test.Hls (waitForProgressDone)
3334
import Test.Tasty
3435
import Test.Tasty.ExpectedFailure
3536
import Test.Tasty.HUnit

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

Lines changed: 67 additions & 51 deletions
Original file line numberDiff line numberDiff line change
@@ -34,14 +34,17 @@ module Test.Hls
3434
runSessionWithServer',
3535
runSessionWithServerInTmpDir',
3636
-- continuation version that take a FileSystem
37+
runSessionWithServerInTmpDirCont,
3738
runSessionWithServerInTmpDirCont',
39+
runSessionWithServerAndCapsInTmpDirCont,
3840
-- * Helpful re-exports
3941
PluginDescriptor,
4042
IdeState,
4143
-- * Assertion helper functions
4244
waitForProgressDone,
4345
waitForAllProgressDone,
4446
waitForBuildQueue,
47+
waitForProgressBegin,
4548
waitForTypecheck,
4649
waitForAction,
4750
hlsConfigToClientConfig,
@@ -51,7 +54,7 @@ module Test.Hls
5154
waitForKickStart,
5255
-- * Plugin descriptor helper functions for tests
5356
PluginTestDescriptor,
54-
pluginTestRecorder,
57+
hlsPluginTestRecorder,
5558
mkPluginTestDescriptor,
5659
mkPluginTestDescriptor',
5760
-- * Re-export logger types
@@ -322,9 +325,28 @@ mkPluginTestDescriptor'
322325
-> PluginTestDescriptor b
323326
mkPluginTestDescriptor' pluginDesc plId _recorder = IdePlugins [pluginDesc plId]
324327

325-
-- | Initialise a recorder that can be instructed to write to stderr by
326-
-- setting the environment variable "HLS_TEST_PLUGIN_LOG_STDERR=1" before
327-
-- running the tests.
328+
-- | Initialize a recorder that can be instructed to write to stderr by
329+
-- setting one of the environment variables:
330+
--
331+
-- * HLS_TEST_HARNESS_STDERR=1
332+
-- * HLS_TEST_LOG_STDERR=1
333+
--
334+
-- "HLS_TEST_LOG_STDERR" is intended to enable all logging for the server and the plugins
335+
-- under test.
336+
hlsHelperTestRecorder :: Pretty a => IO (Recorder (WithPriority a))
337+
hlsHelperTestRecorder = initializeTestRecorder ["HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
338+
339+
340+
-- | Initialize a recorder that can be instructed to write to stderr by
341+
-- setting one of the environment variables:
342+
--
343+
-- * HLS_TEST_PLUGIN_LOG_STDERR=1
344+
-- * HLS_TEST_LOG_STDERR=1
345+
--
346+
-- before running the tests.
347+
--
348+
-- "HLS_TEST_LOG_STDERR" is intended to enable all logging for the server and the plugins
349+
-- under test.
328350
--
329351
-- On the cli, use for example:
330352
--
@@ -337,11 +359,10 @@ mkPluginTestDescriptor' pluginDesc plId _recorder = IdePlugins [pluginDesc plId]
337359
-- @
338360
-- HLS_TEST_LOG_STDERR=1 cabal test <test-suite-of-plugin>
339361
-- @
340-
pluginTestRecorder :: Pretty a => IO (Recorder (WithPriority a))
341-
pluginTestRecorder = do
342-
initialiseTestRecorder ["HLS_TEST_PLUGIN_LOG_STDERR", "HLS_TEST_LOG_STDERR"]
362+
hlsPluginTestRecorder :: Pretty a => IO (Recorder (WithPriority a))
363+
hlsPluginTestRecorder = initializeTestRecorder ["HLS_TEST_PLUGIN_LOG_STDERR", "HLS_TEST_LOG_STDERR"]
343364

344-
-- | Generic recorder initialisation for plugins and the HLS server for test-cases.
365+
-- | Generic recorder initialization for plugins and the HLS server for test-cases.
345366
--
346367
-- The created recorder writes to stderr if any of the given environment variables
347368
-- have been set to a value different to @0@.
@@ -350,11 +371,11 @@ pluginTestRecorder = do
350371
--
351372
-- We have to return the base logger function for HLS server logging initialisation.
352373
-- See 'runSessionWithServer'' for details.
353-
initialiseTestRecorder :: Pretty a => [String] -> IO (Recorder (WithPriority a))
354-
initialiseTestRecorder envVars = do
374+
initializeTestRecorder :: Pretty a => [String] -> IO (Recorder (WithPriority a))
375+
initializeTestRecorder envVars = do
355376
docWithPriorityRecorder <- makeDefaultStderrRecorder (Just $ ThreadIdColumn : defaultLoggingColumns)
356377
-- There are potentially multiple environment variables that enable this logger
357-
definedEnvVars <- forM envVars (\var -> fromMaybe "0" <$> lookupEnv var)
378+
definedEnvVars <- forM envVars (fmap (fromMaybe "0") . lookupEnv)
358379
let logStdErr = any (/= "0") definedEnvVars
359380

360381
docWithFilteredPriorityRecorder =
@@ -374,28 +395,24 @@ runSessionWithServerAndCapsInTmpDir config plugin caps tree act = runSessionWith
374395

375396
runSessionWithServerInTmpDirCont' :: Pretty b => Config -> PluginTestDescriptor b -> VirtualFileTree -> (FileSystem -> Session a) -> IO a
376397
runSessionWithServerInTmpDirCont' config plugin tree act = do
377-
recorder <- pluginTestRecorder
378-
runSessionWithServerInTmpDirCont (plugin recorder) config def fullCaps tree act
398+
runSessionWithServerInTmpDirCont False plugin config def fullCaps tree act
379399

380400
runSessionWithServerAndCapsInTmpDirCont :: Pretty b => Config -> PluginTestDescriptor b -> ClientCapabilities -> VirtualFileTree -> (FileSystem -> Session a) -> IO a
381401
runSessionWithServerAndCapsInTmpDirCont config plugin caps tree act = do
382-
recorder <- pluginTestRecorder
383-
runSessionWithServerInTmpDirCont (plugin recorder) config def caps tree act
402+
runSessionWithServerInTmpDirCont False plugin config def caps tree act
384403

385404
runSessionWithServerInTmpDir' ::
405+
Pretty b =>
386406
-- | Plugins to load on the server.
387-
--
388-
-- For improved logging, make sure these plugins have been initalised with
389-
-- the recorder produced by @pluginTestRecorder@.
390-
IdePlugins IdeState ->
407+
PluginTestDescriptor b ->
391408
-- | lsp config for the server
392409
Config ->
393410
-- | config for the test session
394411
SessionConfig ->
395412
ClientCapabilities ->
396413
VirtualFileTree ->
397414
Session a -> IO a
398-
runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = runSessionWithServerInTmpDirCont plugins conf sessConf caps tree (const act)
415+
runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = runSessionWithServerInTmpDirCont False plugins conf sessConf caps tree (const act)
399416

400417
-- | Host a server, and run a test session on it.
401418
--
@@ -419,22 +436,21 @@ runSessionWithServerInTmpDir' plugins conf sessConf caps tree act = runSessionWi
419436
--
420437
-- Note: cwd will be shifted into a temporary directory in @Session a@
421438
runSessionWithServerInTmpDirCont ::
439+
Pretty b =>
440+
-- | whether we disable the kick action or not
441+
Bool ->
422442
-- | Plugins to load on the server.
423-
--
424-
-- For improved logging, make sure these plugins have been initalised with
425-
-- the recorder produced by @pluginTestRecorder@.
426-
IdePlugins IdeState ->
443+
PluginTestDescriptor b ->
427444
-- | lsp config for the server
428445
Config ->
429446
-- | config for the test session
430447
SessionConfig ->
431448
ClientCapabilities ->
432449
VirtualFileTree ->
433450
(FileSystem -> Session a) -> IO a
434-
runSessionWithServerInTmpDirCont plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
451+
runSessionWithServerInTmpDirCont disableKick plugins conf sessConf caps tree act = withLock lockForTempDirs $ do
435452
testRoot <- setupTestEnvironment
436-
recorder <- initialiseTestRecorder
437-
["LSP_TEST_LOG_STDERR", "HLS_TEST_HARNESS_STDERR", "HLS_TEST_LOG_STDERR"]
453+
helperRecorder <- hlsHelperTestRecorder
438454

439455
-- Do not clean up the temporary directory if this variable is set to anything but '0'.
440456
-- Aids debugging.
@@ -443,32 +459,30 @@ runSessionWithServerInTmpDirCont plugins conf sessConf caps tree act = withLock
443459
Just val | val /= "0" -> do
444460
(tempDir, _) <- newTempDirWithin testRoot
445461
a <- action tempDir
446-
logWith recorder Debug LogNoCleanup
462+
logWith helperRecorder Debug LogNoCleanup
447463
pure a
448464

449465
_ -> do
450466
(tempDir, cleanup) <- newTempDirWithin testRoot
451467
a <- action tempDir `finally` cleanup
452-
logWith recorder Debug LogCleanup
468+
logWith helperRecorder Debug LogCleanup
453469
pure a
454470

455471
runTestInDir $ \tmpDir' -> do
456472
-- we canonicalize the path, so that we do not need to do
457473
-- cannibalization during the test when we compare two paths
458474
tmpDir <- canonicalizePath tmpDir'
459-
logWith recorder Info $ LogTestDir tmpDir
475+
logWith helperRecorder Info $ LogTestDir tmpDir
460476
fs <- FS.materialiseVFT tmpDir tree
461-
runSessionWithServer' plugins conf sessConf caps tmpDir (act fs)
477+
runSessionWithServer' disableKick plugins conf sessConf caps tmpDir (act fs)
462478

463479
runSessionWithServer :: Pretty b => Config -> PluginTestDescriptor b -> FilePath -> Session a -> IO a
464480
runSessionWithServer config plugin fp act = do
465-
recorder <- pluginTestRecorder
466-
runSessionWithServer' (plugin recorder) config def fullCaps fp act
481+
runSessionWithServer' False plugin config def fullCaps fp act
467482

468483
runSessionWithServerAndCaps :: Pretty b => Config -> PluginTestDescriptor b -> ClientCapabilities -> FilePath -> Session a -> IO a
469484
runSessionWithServerAndCaps config plugin caps fp act = do
470-
recorder <- pluginTestRecorder
471-
runSessionWithServer' (plugin recorder) config def caps fp act
485+
runSessionWithServer' False plugin config def caps fp act
472486

473487

474488
-- | Setup the test environment for isolated tests.
@@ -605,11 +619,11 @@ lockForTempDirs = unsafePerformIO newLock
605619
-- | Host a server, and run a test session on it
606620
-- Note: cwd will be shifted into @root@ in @Session a@
607621
runSessionWithServer' ::
608-
-- | Plugins to load on the server.
609-
--
610-
-- For improved logging, make sure these plugins have been initalised with
611-
-- the recorder produced by @pluginTestRecorder@.
612-
IdePlugins IdeState ->
622+
(Pretty b) =>
623+
-- | whether we disable the kick action or not
624+
Bool ->
625+
-- | Plugin to load on the server.
626+
PluginTestDescriptor b ->
613627
-- | lsp config for the server
614628
Config ->
615629
-- | config for the test session
@@ -618,26 +632,21 @@ runSessionWithServer' ::
618632
FilePath ->
619633
Session a ->
620634
IO a
621-
runSessionWithServer' plugins conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
635+
runSessionWithServer' disableKick pluginsDp conf sconf caps root s = withLock lock $ keepCurrentDirectory $ do
622636
(inR, inW) <- createPipe
623637
(outR, outW) <- createPipe
624638

625-
-- Allow three environment variables, because "LSP_TEST_LOG_STDERR" has been used before,
626-
-- (thus, backwards compatibility) and "HLS_TEST_SERVER_LOG_STDERR" because it
627-
-- uses a more descriptive name.
628-
-- It is also in better accordance with 'pluginTestRecorder' which uses "HLS_TEST_PLUGIN_LOG_STDERR".
629-
-- At last, "HLS_TEST_LOG_STDERR" is intended to enable all logging for the server and the plugins
630-
-- under test.
631-
recorder <- initialiseTestRecorder
632-
["LSP_TEST_LOG_STDERR", "HLS_TEST_SERVER_LOG_STDERR", "HLS_TEST_LOG_STDERR"]
639+
recorder <- hlsPluginTestRecorder
640+
let plugins = pluginsDp recorder
641+
recorderIde <- hlsHelperTestRecorder
633642

634643
let
635644
sconf' = sconf { lspConfig = hlsConfigToClientConfig conf }
636645

637646
hlsPlugins = IdePlugins [Test.blockCommandDescriptor "block-command"] <> plugins
638647

639648
arguments@Arguments{ argsIdeOptions } =
640-
testing (cmapWithPrio LogIDEMain recorder) hlsPlugins
649+
testing (cmapWithPrio LogIDEMain recorderIde) hlsPlugins
641650

642651
ideOptions config ghcSession =
643652
let defIdeOptions = argsIdeOptions config ghcSession
@@ -647,13 +656,14 @@ runSessionWithServer' plugins conf sconf caps root s = withLock lock $ keepCurr
647656
}
648657

649658
server <- async $
650-
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorder)
659+
IDEMain.defaultMain (cmapWithPrio LogIDEMain recorderIde)
651660
arguments
652661
{ argsHandleIn = pure inR
653662
, argsHandleOut = pure outW
654663
, argsDefaultHlsConfig = conf
655664
, argsIdeOptions = ideOptions
656665
, argsProjectRoot = Just root
666+
, argsDisableKick = disableKick
657667
}
658668

659669
x <- runSessionWithHandles inW outR sconf' caps root s
@@ -666,6 +676,12 @@ runSessionWithServer' plugins conf sconf caps root s = withLock lock $ keepCurr
666676
putStrLn $ "Finishing canceling (took " <> showDuration t <> "s)"
667677
pure x
668678

679+
-- | Wait for the next progress begin step
680+
waitForProgressBegin :: Session ()
681+
waitForProgressBegin = skipManyTill anyMessage $ satisfyMaybe $ \case
682+
FromServerMess SMethod_Progress (TNotificationMessage _ _ (ProgressParams _ v)) | is _workDoneProgressBegin v-> Just ()
683+
_ -> Nothing
684+
669685
-- | Wait for the next progress end step
670686
waitForProgressDone :: Session ()
671687
waitForProgressDone = skipManyTill anyMessage $ satisfyMaybe $ \case

‎plugins/hls-refactor-plugin/test/Main.hs

Lines changed: 9 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,6 @@ import Development.IDE.Plugin.Completions.Types (extendImportCommandId
2727
import Development.IDE.Test
2828
import Development.IDE.Types.Location
2929
import Development.Shake (getDirectoryFilesIO)
30-
import Ide.Types
3130
import qualified Language.LSP.Protocol.Lens as L
3231
import Language.LSP.Protocol.Message
3332
import Language.LSP.Protocol.Types hiding
@@ -48,24 +47,21 @@ import Text.Regex.TDFA ((=~))
4847
import Development.IDE.Plugin.CodeAction (matchRegExMultipleImports)
4948
import Test.Hls
5049

50+
import qualified Development.IDE.GHC.ExactPrint
5151
import qualified Development.IDE.Plugin.CodeAction as Refactor
52-
import qualified Development.IDE.Plugin.HLS.GhcIde as GhcIde
5352
import qualified Test.AddArgument
5453

5554
main :: IO ()
5655
main = defaultTestRunner tests
5756

58-
refactorPlugin :: IO (IdePlugins IdeState)
57+
refactorPlugin :: PluginTestDescriptor Development.IDE.GHC.ExactPrint.Log
5958
refactorPlugin = do
60-
exactprintLog <- pluginTestRecorder
61-
ghcideLog <- pluginTestRecorder
62-
pure $ IdePlugins $
63-
[ Refactor.iePluginDescriptor exactprintLog "ghcide-code-actions-imports-exports"
64-
, Refactor.typeSigsPluginDescriptor exactprintLog "ghcide-code-actions-type-signatures"
65-
, Refactor.bindingsPluginDescriptor exactprintLog "ghcide-code-actions-bindings"
66-
, Refactor.fillHolePluginDescriptor exactprintLog "ghcide-code-actions-fill-holes"
67-
, Refactor.extendImportPluginDescriptor exactprintLog "ghcide-completions-1"
68-
] ++ GhcIde.descriptors ghcideLog
59+
mkPluginTestDescriptor Refactor.iePluginDescriptor "ghcide-code-actions-imports-exports"
60+
<> mkPluginTestDescriptor Refactor.typeSigsPluginDescriptor "ghcide-code-actions-type-signatures"
61+
<> mkPluginTestDescriptor Refactor.bindingsPluginDescriptor "ghcide-code-actions-bindings"
62+
<> mkPluginTestDescriptor Refactor.fillHolePluginDescriptor "ghcide-code-actions-fill-holes"
63+
<> mkPluginTestDescriptor Refactor.extendImportPluginDescriptor "ghcide-completions-1"
64+
6965

7066
tests :: TestTree
7167
tests =
@@ -3755,9 +3751,7 @@ run' :: (FilePath -> Session a) -> IO a
37553751
run' s = withTempDir $ \dir -> runInDir dir (s dir)
37563752

37573753
runInDir :: FilePath -> Session a -> IO a
3758-
runInDir dir act = do
3759-
plugin <- refactorPlugin
3760-
runSessionWithServer' plugin def def lspTestCaps dir act
3754+
runInDir dir act = runSessionWithServerAndCaps def refactorPlugin lspTestCaps dir act
37613755

37623756
lspTestCaps :: ClientCapabilities
37633757
lspTestCaps = fullCaps { _window = Just $ WindowClientCapabilities (Just True) Nothing Nothing }

‎plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,6 @@ import Test.Hls (HasCallStack,
4040
documentContents, fullCaps,
4141
goldenGitDiff,
4242
mkPluginTestDescriptor,
43-
pluginTestRecorder,
4443
runSessionWithServerInTmpDir,
4544
runSessionWithServerInTmpDir',
4645
testCase, testGroup,
@@ -157,9 +156,8 @@ semanticTokensConfigTest =
157156
var :: String
158157
var = "variable"
159158
do
160-
recorder <- pluginTestRecorder
161159
Test.Hls.runSessionWithServerInTmpDir'
162-
(semanticTokensPlugin recorder)
160+
semanticTokensPlugin
163161
(mkSemanticConfig funcVar)
164162
def {ignoreConfigurationRequests = False}
165163
fullCaps

‎test/functional/Config.hs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -68,8 +68,7 @@ genericConfigTests = testGroup "generic plugin config"
6868
testPluginDiagnostics = [("Foo.hs", [(DiagnosticSeverity_Error, (0,0), "testplugin")])]
6969

7070
runConfigSession subdir session = do
71-
recorder <- pluginTestRecorder
72-
failIfSessionTimeout $ runSessionWithServer' @() (plugin recorder) def (def {ignoreConfigurationRequests=False}) fullCaps ("test/testdata" </> subdir) session
71+
failIfSessionTimeout $ runSessionWithServer' @() False plugin def (def {ignoreConfigurationRequests=False}) fullCaps ("test/testdata" </> subdir) session
7372

7473
testPluginId = "testplugin"
7574
-- A disabled-by-default plugin that creates diagnostics

0 commit comments

Comments
 (0)
Please sign in to comment.