From 0071f14d265b5fd51091f15cc42b47b14706e06a Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Sat, 7 Jun 2025 18:04:59 +0200 Subject: [PATCH 1/3] Fix completion for record dot syntax when record isn't known --- ghcide-test/exe/CompletionTests.hs | 31 ++++++++++++++++++- .../IDE/Plugin/Completions/Logic.hs | 2 +- 2 files changed, 31 insertions(+), 2 deletions(-) diff --git a/ghcide-test/exe/CompletionTests.hs b/ghcide-test/exe/CompletionTests.hs index a980d47233..e726e4e97a 100644 --- a/ghcide-test/exe/CompletionTests.hs +++ b/ghcide-test/exe/CompletionTests.hs @@ -211,7 +211,36 @@ localCompletionTests = [ compls <- getCompletions doc (Position 0 15) liftIO $ filter ("AAA" `T.isPrefixOf`) (mapMaybe _insertText compls) @?= ["AAAAA"] - pure () + pure (), + completionTest + "polymorphic record dot completion" + [ "{-# LANGUAGE OverloadedRecordDot #-}" + , "module A () where" + , "data Record = Record" + , " { field1 :: Int" + , " , field2 :: Int" + , " }" + , "foo record = record.f" + ] + (Position 6 21) + [("field1", CompletionItemKind_Function, "field1", True, False, Nothing) + ,("field2", CompletionItemKind_Function, "field2", True, False, Nothing) + ], + completionTest + "qualified polymorphic record dot completion" + [ "{-# LANGUAGE OverloadedRecordDot #-}" + , "module A () where" + , "data Record = Record" + , " { field1 :: Int" + , " , field2 :: Int" + , " }" + , "someValue = undefined" + , "foo = A.someValue.f" + ] + (Position 7 19) + [("field1", CompletionItemKind_Function, "field1", True, False, Nothing) + ,("field2", CompletionItemKind_Function, "field2", True, False, Nothing) + ] ] nonLocalCompletionTests :: [TestTree] diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 9fdc196cd5..75c1d0d397 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -912,7 +912,7 @@ getCompletionPrefixFromRope pos@(Position l c) ropetext = [] -> Nothing (x:xs) -> do let modParts = reverse $ filter (not .T.null) xs - modName = T.intercalate "." modParts + modName = if all (isUpper . T.head) modParts then T.intercalate "." modParts else "" return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos } completionPrefixPos :: PosPrefixInfo -> Position From 384807f204da8f092f84da5a208dc6f79a9d9061 Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Sun, 8 Jun 2025 11:43:33 +0200 Subject: [PATCH 2/3] Comment fix, fix test --- ghcide-test/exe/CompletionTests.hs | 7 ++++++- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 2 ++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/ghcide-test/exe/CompletionTests.hs b/ghcide-test/exe/CompletionTests.hs index e726e4e97a..dfa1042cfd 100644 --- a/ghcide-test/exe/CompletionTests.hs +++ b/ghcide-test/exe/CompletionTests.hs @@ -33,6 +33,8 @@ import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit +import System.IO + tests :: TestTree tests @@ -61,6 +63,7 @@ completionTest :: HasCallStack => String -> [T.Text] -> Position -> [(T.Text, Co completionTest name src pos expected = testSessionSingleFile name "A.hs" (T.unlines src) $ do docId <- openDoc "A.hs" "haskell" _ <- waitForDiagnostics + compls <- getAndResolveCompletions docId pos let compls' = [ (_label, _kind, _insertText, _additionalTextEdits) | CompletionItem{..} <- compls] let emptyToMaybe x = if T.null x then Nothing else Just x @@ -220,9 +223,11 @@ localCompletionTests = [ , " { field1 :: Int" , " , field2 :: Int" , " }" + , -- Without the following, this file doesn't trigger any diagnostics, so completionTest waits forever + "triggerDiag :: UnknownType" , "foo record = record.f" ] - (Position 6 21) + (Position 7 21) [("field1", CompletionItemKind_Function, "field1", True, False, Nothing) ,("field2", CompletionItemKind_Function, "field2", True, False, Nothing) ], diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 75c1d0d397..211747c72f 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -912,6 +912,8 @@ getCompletionPrefixFromRope pos@(Position l c) ropetext = [] -> Nothing (x:xs) -> do let modParts = reverse $ filter (not .T.null) xs + -- Must check the prefix is a valid module name, else record dot accesses treat + -- the record name as a qualName for search and generated imports modName = if all (isUpper . T.head) modParts then T.intercalate "." modParts else "" return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos } From 320c03bf7349b742e08afa487d66ea7b8f3b642f Mon Sep 17 00:00:00 2001 From: Samuel Williams Date: Sun, 8 Jun 2025 12:17:09 +0200 Subject: [PATCH 3/3] Appease pre-commit --- ghcide-test/exe/CompletionTests.hs | 3 --- ghcide/src/Development/IDE/Plugin/Completions/Logic.hs | 2 +- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/ghcide-test/exe/CompletionTests.hs b/ghcide-test/exe/CompletionTests.hs index 1d658e920a..8c44173bd6 100644 --- a/ghcide-test/exe/CompletionTests.hs +++ b/ghcide-test/exe/CompletionTests.hs @@ -33,9 +33,6 @@ import Test.Hls.Util import Test.Tasty import Test.Tasty.HUnit -import System.IO - - tests :: TestTree tests = testGroup "completion" diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d207c2ef89..a00705ba39 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -878,7 +878,7 @@ getCompletionPrefixFromRope pos@(Position l c) ropetext = [] -> Nothing (x:xs) -> do let modParts = reverse $ filter (not .T.null) xs - -- Must check the prefix is a valid module name, else record dot accesses treat + -- Must check the prefix is a valid module name, else record dot accesses treat -- the record name as a qualName for search and generated imports modName = if all (isUpper . T.head) modParts then T.intercalate "." modParts else "" return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos }