@@ -74,7 +74,7 @@ import Language.LSP.Types hiding
74
74
SemanticTokensEdit (_start ),
75
75
mkRange )
76
76
import Language.LSP.Types.Capabilities
77
- import qualified Language.LSP.Types.Lens as Lens (label )
77
+ import qualified Language.LSP.Types.Lens as Lens (label , insertText )
78
78
import qualified Language.LSP.Types.Lens as Lsp (diagnostics ,
79
79
message ,
80
80
params )
@@ -4819,11 +4819,8 @@ completionNoCommandTest name src pos wanted = testSession name $ do
4819
4819
docId <- createDoc " A.hs" " haskell" (T. unlines src)
4820
4820
_ <- waitForDiagnostics
4821
4821
compls <- getCompletions docId pos
4822
- let wantedC = find ( \ case
4823
- CompletionItem {_insertText = Just x} -> wanted `T.isPrefixOf` x
4824
- _ -> False
4825
- ) compls
4826
- case wantedC of
4822
+ let isPrefixOfInsertOrLabel ci = any (wanted `T.isPrefixOf` ) [fromMaybe " " (ci ^. Lens. insertText), ci ^. Lens. label]
4823
+ case find isPrefixOfInsertOrLabel compls of
4827
4824
Nothing ->
4828
4825
liftIO $ assertFailure $ " Cannot find expected completion in: " <> show [_label | CompletionItem {_label} <- compls]
4829
4826
Just CompletionItem {.. } -> liftIO . assertBool (" Expected no command but got: " <> show _command) $ null _command
@@ -5080,6 +5077,19 @@ nonLocalCompletionTests =
5080
5077
" join"
5081
5078
[" {-# LANGUAGE NoImplicitPrelude #-}" ,
5082
5079
" module A where" , " import Control.Monad as M ()" , " import Control.Monad as N (join)" , " f = N.joi" ]
5080
+ -- Failing test for https://github.com/haskell/haskell-language-server/issues/2824
5081
+ , expectFailBecause " known broken #2824" $ completionNoCommandTest
5082
+ " explicit qualified"
5083
+ [" {-# LANGUAGE NoImplicitPrelude #-}" ,
5084
+ " module A where" , " import qualified Control.Monad as M (j)" ]
5085
+ (Position 2 38 )
5086
+ " join"
5087
+ , completionNoCommandTest
5088
+ " explicit qualified post"
5089
+ [" {-# LANGUAGE NoImplicitPrelude, ImportQualifiedPost #-}" ,
5090
+ " module A where" , " import Control.Monad qualified as M (j)" ]
5091
+ (Position 2 38 )
5092
+ " join"
5083
5093
]
5084
5094
, testGroup " Data constructor"
5085
5095
[ completionCommandTest
0 commit comments