Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Makes local record field completion respects the fields sharing one single type signature #2439

Merged
merged 3 commits into from Dec 4, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
18 changes: 12 additions & 6 deletions ghcide/src/Development/IDE/Plugin/Completions/Logic.hs
Expand Up @@ -20,7 +20,6 @@ import Data.List.Extra as List hiding
import qualified Data.Map as Map

import Data.Maybe (fromMaybe, isJust,
listToMaybe,
mapMaybe)
import qualified Data.Text as T
import qualified Text.Fuzzy.Parallel as Fuzzy
Expand Down Expand Up @@ -480,7 +479,7 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result
(showGhc . unLoc $ con_name) field_labels mn doc Nothing
| ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn
, Just con_details <- [getFlds con_args]
, let field_names = mapMaybe extract con_details
, let field_names = concatMap extract con_details
, let field_labels = showGhc . unLoc <$> field_names
, (not . List.null) field_labels
]
Expand All @@ -493,11 +492,18 @@ findRecordCompl uri pmod mn DataDecl {tcdLName, tcdDataDefn} = result
_ -> Nothing

extract ConDeclField{..}
-- TODO: Why is cd_fld_names a list?
| Just fld_name <- rdrNameFieldOcc . unLoc <$> listToMaybe cd_fld_names = Just fld_name
| otherwise = Nothing
-- NOTE: 'cd_fld_names' is grouped so that the fields
-- sharing the same type declaration to fit in the same group; e.g.
--
-- @
-- data Foo = Foo {arg1, arg2 :: Int, arg3 :: Int, arg4 :: Bool}
-- @
--
-- is encoded as @[[arg1, arg2], [arg3], [arg4]]@
-- Hence, we must concat nested arguments into one to get all the fields.
= map (rdrNameFieldOcc . unLoc) cd_fld_names
-- XConDeclField
extract _ = Nothing
extract _ = []
findRecordCompl _ _ _ _ = []

ppr :: Outputable a => a -> T.Text
Expand Down
12 changes: 11 additions & 1 deletion test/functional/Completion.hs
Expand Up @@ -94,7 +94,6 @@ tests = testGroup "completions" [
liftIO $ do
item ^. label @?= "accessor"
item ^. kind @?= Just CiFunction

, testCase "have implicit foralls on basic polymorphic types" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
doc <- openDoc "Completion.hs" "haskell"

Expand Down Expand Up @@ -261,6 +260,17 @@ snippetTests = testGroup "snippets" [
doc <- openDoc "Completion.hs" "haskell"

checkNoSnippets doc
, testCase "works for record fields sharing the single signature" $ runSession hlsCommand fullCaps "test/testdata/completion" $ do
doc <- openDoc "FieldsSharingSignature.hs" "haskell"

let te = TextEdit (Range (Position 1 0) (Position 1 2)) "MkF"
_ <- applyEdit doc te

compls <- getCompletions doc (Position 1 6)
let item = head $ filter (\c -> (c ^. label == "MkFoo") && maybe False ("MkFoo {" `T.isPrefixOf`) (c ^. insertText)) compls
liftIO $ do
item ^. insertTextFormat @?= Just Snippet
item ^. insertText @?= Just "MkFoo {arg1=${1:_arg1}, arg2=${2:_arg2}, arg3=${3:_arg3}, arg4=${4:_arg4}, arg5=${5:_arg5}}"
]
where
checkNoSnippets doc = do
Expand Down
1 change: 1 addition & 0 deletions test/testdata/completion/FieldsSharingSignature.hs
@@ -0,0 +1 @@
data Foo = MkFoo { arg1, arg2, arg3 :: Int, arg4 :: Int, arg5 :: Double }
1 change: 1 addition & 0 deletions test/testdata/completion/hie.yaml
Expand Up @@ -4,3 +4,4 @@ cradle:
- "Completion"
- "Context"
- "DupRecFields"
- "FieldsSharingSignature"