Skip to content

Commit aba2644

Browse files
wz1000wz1000
committed
Fixes
1 parent ea593a2 commit aba2644

File tree

3 files changed

+59
-51
lines changed

3 files changed

+59
-51
lines changed

‎ghcide/test/exe/Main.hs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1688,7 +1688,7 @@ localCompletionTests = [
16881688

16891689
nonLocalCompletionTests :: [TestTree]
16901690
nonLocalCompletionTests =
1691-
[ completionTest
1691+
[ brokenForWinGhc $ completionTest
16921692
"variable"
16931693
["module A where", "f = hea"]
16941694
(Position 1 7)
@@ -1699,7 +1699,7 @@ nonLocalCompletionTests =
16991699
(Position 2 8)
17001700
[ ("True", CiConstructor, "True", True, True, Nothing)
17011701
],
1702-
completionTest
1702+
brokenForWinGhc $ completionTest
17031703
"type"
17041704
["{-# OPTIONS_GHC -Wall #-}", "module A () where", "f :: Boo", "f = True"]
17051705
(Position 2 8)
@@ -1745,6 +1745,8 @@ nonLocalCompletionTests =
17451745
(Position 0 13)
17461746
[]
17471747
]
1748+
where
1749+
brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94]) "Windows has strange things in scope for some reason"
17481750

17491751
otherCompletionTests :: [TestTree]
17501752
otherCompletionTests = [

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

Lines changed: 6 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -217,19 +217,19 @@ completionTests =
217217
"not imported"
218218
["module A where", "import Text.Printf ()", "FormatParse"]
219219
(Position 2 10)
220-
"FormatParse {"
221-
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
220+
"FormatParse"
221+
["module A where", "import Text.Printf (FormatParse)", "FormatParse"]
222222
, completionCommandTest
223223
"parent imported"
224224
["module A where", "import Text.Printf (FormatParse)", "FormatParse"]
225225
(Position 2 10)
226-
"FormatParse {"
226+
"FormatParse"
227227
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
228228
, completionNoCommandTest
229229
"already imported"
230230
["module A where", "import Text.Printf (FormatParse (FormatParse))", "FormatParse"]
231231
(Position 2 10)
232-
"FormatParse {"
232+
"FormatParse"
233233
]
234234
, testGroup "Package completion"
235235
[ completionCommandTest
@@ -260,7 +260,8 @@ completionCommandTest name src pos wanted expected = testSession name $ do
260260
_ <- waitForDiagnostics
261261
compls <- skipManyTill anyMessage (getCompletions docId pos)
262262
let wantedC = find ( \case
263-
CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
263+
CompletionItem {_insertText = Just x
264+
,_command = Just _} -> wanted `T.isPrefixOf` x
264265
_ -> False
265266
) compls
266267
case wantedC of

‎test/functional/Completion.hs

Lines changed: 49 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE ScopedTypeVariables #-}
33
module Completion(tests) where
44

5+
import Control.Monad
56
import Control.Lens hiding ((.=))
67
import Data.Aeson (object, (.=))
78
import Data.Foldable (find)
@@ -11,6 +12,15 @@ import Language.LSP.Types.Lens hiding (applyEdit)
1112
import Test.Hls
1213
import Test.Hls.Command
1314

15+
getResolvedCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem]
16+
getResolvedCompletions doc pos = do
17+
xs <- getCompletions doc pos
18+
forM xs $ \item -> do
19+
rsp <- request SCompletionItemResolve item
20+
case rsp ^. result of
21+
Left err -> liftIO $ assertFailure ("completionItem/resolve failed with: " <> show err)
22+
Right x -> pure x
23+
1424
tests :: TestTree
1525
tests = testGroup "completions" [
1626
testCase "works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
@@ -19,34 +29,29 @@ tests = testGroup "completions" [
1929
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"
2030
_ <- applyEdit doc te
2131

22-
compls <- getCompletions doc (Position 5 9)
32+
compls <- getResolvedCompletions doc (Position 5 9)
2333
item <- getCompletionByLabel "putStrLn" compls
2434
liftIO $ do
2535
item ^. label @?= "putStrLn"
2636
item ^. kind @?= Just CiFunction
27-
item ^. detail @?= Just ":: String -> IO ()"
37+
item ^. detail @?= Just ":: String -> IO ()\nfrom Prelude"
2838
item ^. insertTextFormat @?= Just Snippet
29-
item ^. insertText @?= Just "putStrLn ${1:String}"
39+
item ^. insertText @?= Just "putStrLn"
3040

31-
, ignoreTestBecause "no support for itemCompletion/resolve requests"
32-
$ testCase "itemCompletion/resolve works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
41+
, testCase "itemCompletion/resolve works" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
3342
doc <- openDoc "Completion.hs" "haskell"
3443

3544
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "put"
3645
_ <- applyEdit doc te
3746

38-
compls <- getCompletions doc (Position 5 9)
47+
compls <- getResolvedCompletions doc (Position 5 9)
3948
item <- getCompletionByLabel "putStrLn" compls
40-
resolvedRes <- request SCompletionItemResolve item
41-
let eResolved = resolvedRes ^. result
42-
case eResolved of
43-
Right resolved -> liftIO $ do
44-
resolved ^. label @?= "putStrLn"
45-
resolved ^. kind @?= Just CiFunction
46-
resolved ^. detail @?= Just "String -> IO ()\nPrelude"
47-
resolved ^. insertTextFormat @?= Just Snippet
48-
resolved ^. insertText @?= Just "putStrLn ${1:String}"
49-
_ -> error $ "Unexpected resolved value: " ++ show eResolved
49+
liftIO $ do
50+
item ^. label @?= "putStrLn"
51+
item ^. kind @?= Just CiFunction
52+
item ^. detail @?= Just ":: String -> IO ()\nfrom Prelude"
53+
item ^. insertTextFormat @?= Just Snippet
54+
item ^. insertText @?= Just "putStrLn"
5055

5156
, testCase "completes imports" $ runSession (hlsCommand <> " --test") fullCaps "test/testdata/completion" $ do
5257
doc <- openDoc "Completion.hs" "haskell"
@@ -56,7 +61,7 @@ tests = testGroup "completions" [
5661
let te = TextEdit (Range (Position 1 17) (Position 1 26)) "Data.M"
5762
_ <- applyEdit doc te
5863

59-
compls <- getCompletions doc (Position 1 23)
64+
compls <- getResolvedCompletions doc (Position 1 23)
6065
item <- getCompletionByLabel "Maybe" compls
6166
liftIO $ do
6267
item ^. label @?= "Maybe"
@@ -71,7 +76,7 @@ tests = testGroup "completions" [
7176
let te = TextEdit (Range (Position 2 17) (Position 2 25)) "Data.L"
7277
_ <- applyEdit doc te
7378

74-
compls <- getCompletions doc (Position 2 24)
79+
compls <- getResolvedCompletions doc (Position 2 24)
7580
item <- getCompletionByLabel "List" compls
7681
liftIO $ do
7782
item ^. label @?= "List"
@@ -81,7 +86,7 @@ tests = testGroup "completions" [
8186
, testCase "completes with no prefix" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
8287
doc <- openDoc "Completion.hs" "haskell"
8388

84-
compls <- getCompletions doc (Position 5 7)
89+
compls <- getResolvedCompletions doc (Position 5 7)
8590
liftIO $ assertBool "Expected completions" $ not $ null compls
8691

8792
, expectFailIfBeforeGhc92 "record dot syntax is introduced in GHC 9.2"
@@ -92,7 +97,7 @@ tests = testGroup "completions" [
9297
let te = TextEdit (Range (Position 25 0) (Position 25 5)) "z = x.a"
9398
_ <- applyEdit doc te
9499

95-
compls <- getCompletions doc (Position 25 6)
100+
compls <- getResolvedCompletions doc (Position 25 6)
96101
item <- getCompletionByLabel "a" compls
97102

98103
liftIO $ do
@@ -103,7 +108,7 @@ tests = testGroup "completions" [
103108
let te = TextEdit (Range (Position 27 0) (Position 27 8)) "z2 = x.c.z"
104109
_ <- applyEdit doc te
105110

106-
compls <- getCompletions doc (Position 27 9)
111+
compls <- getResolvedCompletions doc (Position 27 9)
107112
item <- getCompletionByLabel "z" compls
108113

109114
liftIO $ do
@@ -117,7 +122,7 @@ tests = testGroup "completions" [
117122
let te = TextEdit (Range (Position 5 0) (Position 5 2)) "acc"
118123
_ <- applyEdit doc te
119124

120-
compls <- getCompletions doc (Position 5 4)
125+
compls <- getResolvedCompletions doc (Position 5 4)
121126
item <- getCompletionByLabel "accessor" compls
122127
liftIO $ do
123128
item ^. label @?= "accessor"
@@ -127,25 +132,25 @@ tests = testGroup "completions" [
127132

128133
let te = TextEdit (Range (Position 5 7) (Position 5 9)) "id"
129134
_ <- applyEdit doc te
130-
compls <- getCompletions doc (Position 5 9)
135+
compls <- getResolvedCompletions doc (Position 5 9)
131136
item <- getCompletionByLabel "id" compls
132137
liftIO $ do
133-
item ^. detail @?= Just ":: a -> a"
138+
item ^. detail @?= Just ":: a -> a\nfrom Prelude"
134139

135140
, testCase "have implicit foralls with multiple type variables" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
136141
doc <- openDoc "Completion.hs" "haskell"
137142

138143
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "flip"
139144
_ <- applyEdit doc te
140-
compls <- getCompletions doc (Position 5 11)
145+
compls <- getResolvedCompletions doc (Position 5 11)
141146
item <- getCompletionByLabel "flip" compls
142147
liftIO $
143-
item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c"
148+
item ^. detail @?= Just ":: (a -> b -> c) -> b -> a -> c\nfrom Prelude"
144149

145150
, testCase "maxCompletions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
146151
doc <- openDoc "Completion.hs" "haskell"
147152

148-
compls <- getCompletions doc (Position 5 7)
153+
compls <- getResolvedCompletions doc (Position 5 7)
149154
liftIO $ length compls @?= maxCompletions def
150155

151156
, testCase "import function completions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
@@ -154,7 +159,7 @@ tests = testGroup "completions" [
154159
let te = TextEdit (Range (Position 0 30) (Position 0 41)) "A"
155160
_ <- applyEdit doc te
156161

157-
compls <- getCompletions doc (Position 0 31)
162+
compls <- getResolvedCompletions doc (Position 0 31)
158163
item <- getCompletionByLabel "Alternative" compls
159164
liftIO $ do
160165
item ^. label @?= "Alternative"
@@ -167,7 +172,7 @@ tests = testGroup "completions" [
167172
let te = TextEdit (Range (Position 0 39) (Position 0 39)) ", l"
168173
_ <- applyEdit doc te
169174

170-
compls <- getCompletions doc (Position 0 42)
175+
compls <- getResolvedCompletions doc (Position 0 42)
171176
item <- getCompletionByLabel "liftA" compls
172177
liftIO $ do
173178
item ^. label @?= "liftA"
@@ -177,7 +182,7 @@ tests = testGroup "completions" [
177182
, testCase "completes locally defined associated type family" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
178183
doc <- openDoc "AssociatedTypeFamily.hs" "haskell"
179184

180-
compls <- getCompletions doc (Position 5 20)
185+
compls <- getResolvedCompletions doc (Position 5 20)
181186
item <- getCompletionByLabel "Fam" compls
182187
liftIO $ do
183188
item ^. label @?= "Fam"
@@ -195,7 +200,7 @@ snippetTests = testGroup "snippets" [
195200
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "Nothing"
196201
_ <- applyEdit doc te
197202

198-
compls <- getCompletions doc (Position 5 14)
203+
compls <- getResolvedCompletions doc (Position 5 14)
199204
item <- getCompletionByLabel "Nothing" compls
200205
liftIO $ do
201206
item ^. insertTextFormat @?= Just Snippet
@@ -207,35 +212,35 @@ snippetTests = testGroup "snippets" [
207212
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"
208213
_ <- applyEdit doc te
209214

210-
compls <- getCompletions doc (Position 5 11)
215+
compls <- getResolvedCompletions doc (Position 5 11)
211216
item <- getCompletionByLabel "foldl" compls
212217
liftIO $ do
213218
item ^. label @?= "foldl"
214219
item ^. kind @?= Just CiFunction
215220
item ^. insertTextFormat @?= Just Snippet
216-
item ^. insertText @?= Just "foldl ${1:(b -> a -> b)} ${2:b} ${3:(t a)}"
221+
item ^. insertText @?= Just "foldl"
217222

218223
, testCase "work for complex types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
219224
doc <- openDoc "Completion.hs" "haskell"
220225

221226
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "mapM"
222227
_ <- applyEdit doc te
223228

224-
compls <- getCompletions doc (Position 5 11)
229+
compls <- getResolvedCompletions doc (Position 5 11)
225230
item <- getCompletionByLabel "mapM" compls
226231
liftIO $ do
227232
item ^. label @?= "mapM"
228233
item ^. kind @?= Just CiFunction
229234
item ^. insertTextFormat @?= Just Snippet
230-
item ^. insertText @?= Just "mapM ${1:(a -> m b)} ${2:(t a)}"
235+
item ^. insertText @?= Just "mapM"
231236

232237
, testCase "work for infix functions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
233238
doc <- openDoc "Completion.hs" "haskell"
234239

235240
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte"
236241
_ <- applyEdit doc te
237242

238-
compls <- getCompletions doc (Position 5 18)
243+
compls <- getResolvedCompletions doc (Position 5 18)
239244
item <- getCompletionByLabel "filter" compls
240245
liftIO $ do
241246
item ^. label @?= "filter"
@@ -249,7 +254,7 @@ snippetTests = testGroup "snippets" [
249254
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "even `filte`"
250255
_ <- applyEdit doc te
251256

252-
compls <- getCompletions doc (Position 5 18)
257+
compls <- getResolvedCompletions doc (Position 5 18)
253258
item <- getCompletionByLabel "filter" compls
254259
liftIO $ do
255260
item ^. label @?= "filter"
@@ -263,7 +268,7 @@ snippetTests = testGroup "snippets" [
263268
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe"
264269
_ <- applyEdit doc te
265270

266-
compls <- getCompletions doc (Position 5 29)
271+
compls <- getResolvedCompletions doc (Position 5 29)
267272
item <- getCompletionByLabel "intersperse" compls
268273
liftIO $ do
269274
item ^. label @?= "intersperse"
@@ -277,7 +282,7 @@ snippetTests = testGroup "snippets" [
277282
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "\"\" `Data.List.interspe`"
278283
_ <- applyEdit doc te
279284

280-
compls <- getCompletions doc (Position 5 29)
285+
compls <- getResolvedCompletions doc (Position 5 29)
281286
item <- getCompletionByLabel "intersperse" compls
282287
liftIO $ do
283288
item ^. label @?= "intersperse"
@@ -304,7 +309,7 @@ snippetTests = testGroup "snippets" [
304309
let te = TextEdit (Range (Position 1 0) (Position 1 2)) "MkF"
305310
_ <- applyEdit doc te
306311

307-
compls <- getCompletions doc (Position 1 6)
312+
compls <- getResolvedCompletions doc (Position 1 6)
308313
item <- case find (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls of
309314
Just c -> pure c
310315
Nothing -> liftIO . assertFailure $ "Completion with label 'MkFoo' and insertText starting with 'MkFoo {' not found among " <> show compls
@@ -317,7 +322,7 @@ snippetTests = testGroup "snippets" [
317322
let te = TextEdit (Range (Position 5 7) (Position 5 24)) "fold"
318323
_ <- applyEdit doc te
319324

320-
compls <- getCompletions doc (Position 5 11)
325+
compls <- getResolvedCompletions doc (Position 5 11)
321326
item <- getCompletionByLabel "foldl" compls
322327
liftIO $ do
323328
item ^. label @?= "foldl"
@@ -342,23 +347,23 @@ contextTests = testGroup "contexts" [
342347
testCase "only provides type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
343348
doc <- openDoc "Context.hs" "haskell"
344349

345-
compls <- getCompletions doc (Position 2 17)
350+
compls <- getResolvedCompletions doc (Position 2 17)
346351
liftIO $ do
347352
compls `shouldContainCompl` "Integer"
348353
compls `shouldNotContainCompl` "interact"
349354

350355
, testCase "only provides value suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
351356
doc <- openDoc "Context.hs" "haskell"
352357

353-
compls <- getCompletions doc (Position 3 10)
358+
compls <- getResolvedCompletions doc (Position 3 10)
354359
liftIO $ do
355360
compls `shouldContainCompl` "abs"
356361
compls `shouldNotContainCompl` "Applicative"
357362

358363
, testCase "completes qualified type suggestions" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
359364
doc <- openDoc "Context.hs" "haskell"
360365

361-
compls <- getCompletions doc (Position 2 26)
366+
compls <- getResolvedCompletions doc (Position 2 26)
362367
liftIO $ do
363368
compls `shouldNotContainCompl` "forkOn"
364369
compls `shouldContainCompl` "MVar"

0 commit comments

Comments
 (0)