diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 201b5d89f3..ebf52a0cc1 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -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 @@ -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 ] @@ -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 diff --git a/test/functional/Completion.hs b/test/functional/Completion.hs index baabbae830..05d02e09f2 100644 --- a/test/functional/Completion.hs +++ b/test/functional/Completion.hs @@ -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" @@ -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 diff --git a/test/testdata/completion/FieldsSharingSignature.hs b/test/testdata/completion/FieldsSharingSignature.hs new file mode 100644 index 0000000000..f5523a2788 --- /dev/null +++ b/test/testdata/completion/FieldsSharingSignature.hs @@ -0,0 +1 @@ +data Foo = MkFoo { arg1, arg2, arg3 :: Int, arg4 :: Int, arg5 :: Double } diff --git a/test/testdata/completion/hie.yaml b/test/testdata/completion/hie.yaml index 999dc1a77f..6e631ae549 100644 --- a/test/testdata/completion/hie.yaml +++ b/test/testdata/completion/hie.yaml @@ -4,3 +4,4 @@ cradle: - "Completion" - "Context" - "DupRecFields" + - "FieldsSharingSignature"