Filter completions for record fields in patterns (#15903)

Author: kerams

src/Compiler/Service/FSharpCheckerResults.fs

@@ -800,6 +800,28 @@ type internal TypeCheckInfo
         | Item.Types (_, ty :: _) when isInterfaceTy g ty -> true
         | _ -> false
 
+    /// Is the item suitable for completion in a pattern
+    let IsPatternCandidate (item: CompletionItem) =
+        match item.Item with
+        | Item.Value v -> v.LiteralValue.IsSome
+        | Item.ILField field -> field.LiteralValue.IsSome
+        | Item.ActivePatternCase _
+        | Item.ExnCase _
+        | Item.ModuleOrNamespaces _
+        | Item.Types _
+        | Item.UnionCase _ -> true
+        | _ -> false
+
+    /// Is the item suitable for completion in a type application or type annotation
+    let IsTypeCandidate (item: CompletionItem) =
+        match item.Item with
+        | Item.ModuleOrNamespaces _
+        | Item.Types _
+        | Item.TypeVar _
+        | Item.UnqualifiedType _
+        | Item.ExnCase _ -> true
+        | _ -> false
+
     /// Return only items with the specified name, modulo "Attribute" for type completions
     let FilterDeclItemsByResidue (getItem: 'a -> Item) residue (items: 'a list) =
         let attributedResidue = residue + "Attribute"
@@ -939,6 +961,10 @@ type internal TypeCheckInfo
             Unresolved = None
         }
 
+    let getItem (x: ItemWithInst) = x.Item
+
+    let getItem2 (x: CompletionItem) = x.Item
+
     /// Checks whether the suggested name is unused.
     /// In the future we could use an increasing numeric suffix for conflict resolution
     let CreateCompletionItemForSuggestedPatternName (pos: pos) name =
@@ -1044,7 +1070,7 @@ type internal TypeCheckInfo
                     |> List.map (fun (name, overloads) ->
                         Item.MethodGroup(name, overloads, None)
                         |> ItemWithNoInst
-                        |> CompletionItem ValueNone ValueNone)
+                        |> DefaultCompletionItem)
 
                 Some(overridableMethods, nenv.DisplayEnv, m)
             | _ -> None)
@@ -1063,12 +1089,77 @@ type internal TypeCheckInfo
                     else
                         Item.UnionCaseField(uci, index)
                         |> ItemWithNoInst
-                        |> CompletionItem ValueNone ValueNone
+                        |> DefaultCompletionItem
                         |> Some)
                 |> Some
             | _ -> None)
 
-    let getItem (x: ItemWithInst) = x.Item
+    let GetCompletionsForUnionCaseField pos indexOrName caseIdRange isTheOnlyField declaredItems =
+        let declaredItems =
+            declaredItems
+            |> Option.bind (FilterRelevantItemsBy getItem2 None IsPatternCandidate)
+
+        // When the user types `fun (Case (x| )) ->`, we do not yet know whether the intention is to use positional or named arguments,
+        // so let's show options for both.
+        let fields indexOrName isTheOnlyField (uci: UnionCaseInfo) =
+            match indexOrName, isTheOnlyField with
+            | Choice1Of2 (Some 0), true ->
+                uci.UnionCase.RecdFields
+                |> List.mapi (fun index _ -> Item.UnionCaseField(uci, index) |> ItemWithNoInst |> DefaultCompletionItem)
+            | _ -> []
+
+        sResolutions.CapturedNameResolutions
+        |> ResizeArray.tryPick (fun r ->
+            match r.Item with
+            | Item.UnionCase (uci, _) when equals r.Range caseIdRange ->
+                let list =
+                    declaredItems
+                    |> Option.map p13
+                    |> Option.defaultValue []
+                    |> List.append (fields indexOrName isTheOnlyField uci)
+
+                Some(SuggestNameForUnionCaseFieldPattern g caseIdRange.End pos uci indexOrName list, r.DisplayEnv, r.Range)
+            | _ -> None)
+        |> Option.orElse declaredItems
+
+    let GetCompletionsForRecordField pos referencedFields declaredItems =
+        declaredItems
+        |> Option.map (fun (items: CompletionItem list, denv, range) ->
+            let fields =
+                // Try to find a name resolution for any of the referenced fields, and through it access all available fields of the record
+                referencedFields
+                |> List.tryPick (fun (_, fieldRange) ->
+                    sResolutions.CapturedNameResolutions
+                    |> ResizeArray.tryPick (fun cnr ->
+                        match cnr.Item with
+                        | Item.RecdField info when equals cnr.Range fieldRange ->
+                            info.TyconRef.AllFieldAsRefList
+                            |> List.choose (fun field ->
+                                if
+                                    referencedFields
+                                    |> List.exists (fun (fieldName, _) -> fieldName = field.DisplayName)
+                                then
+                                    None
+                                else
+                                    FreshenRecdFieldRef ncenv field.Range field |> Item.RecdField |> Some)
+                            |> Some
+                        | _ -> None))
+                |> Option.defaultWith (fun () ->
+                    // Fall back to showing all record field names in scope
+                    let (nenv, _), _ = GetBestEnvForPos pos
+                    getRecordFieldsInScope nenv)
+                |> List.map (ItemWithNoInst >> DefaultCompletionItem)
+
+            let items =
+                items
+                |> List.filter (fun item ->
+                    match item.Item with
+                    | Item.ModuleOrNamespaces _ -> true
+                    | Item.Types (_, ty :: _) -> isRecdTy g ty
+                    | _ -> false)
+                |> List.append fields
+
+            items, denv, range)
 
     let GetDeclaredItems
         (
@@ -1316,6 +1407,22 @@ type internal TypeCheckInfo
             | atStart when atStart = 0 -> 0
             | otherwise -> otherwise - 1
 
+        let getDeclaredItemsNotInRangeOpWithAllSymbols () =
+            GetDeclaredItems(
+                parseResultsOpt,
+                lineStr,
+                origLongIdentOpt,
+                colAtEndOfNamesAndResidue,
+                residueOpt,
+                lastDotPos,
+                line,
+                loc,
+                filterCtors,
+                resolveOverloads,
+                false,
+                getAllSymbols
+            )
+
         let pos = mkPos line colAtEndOfNamesAndResidue
 
         // Look for a "special" completion context
@@ -1445,21 +1552,7 @@ type internal TypeCheckInfo
             | Some (CompletionContext.ParameterList (endPos, fields)) ->
                 let results = GetNamedParametersAndSettableFields endPos
 
-                let declaredItems =
-                    GetDeclaredItems(
-                        parseResultsOpt,
-                        lineStr,
-                        origLongIdentOpt,
-                        colAtEndOfNamesAndResidue,
-                        residueOpt,
-                        lastDotPos,
-                        line,
-                        loc,
-                        filterCtors,
-                        resolveOverloads,
-                        false,
-                        getAllSymbols
-                    )
+                let declaredItems = getDeclaredItemsNotInRangeOpWithAllSymbols ()
 
                 match results with
                 | NameResResult.Members (items, denv, m) ->
@@ -1484,20 +1577,7 @@ type internal TypeCheckInfo
                 | _ -> declaredItems
 
             | Some (CompletionContext.AttributeApplication) ->
-                GetDeclaredItems(
-                    parseResultsOpt,
-                    lineStr,
-                    origLongIdentOpt,
-                    colAtEndOfNamesAndResidue,
-                    residueOpt,
-                    lastDotPos,
-                    line,
-                    loc,
-                    filterCtors,
-                    resolveOverloads,
-                    false,
-                    getAllSymbols
-                )
+                getDeclaredItemsNotInRangeOpWithAllSymbols ()
                 |> Option.map (fun (items, denv, m) ->
                     items
                     |> List.filter (fun cItem ->
@@ -1509,20 +1589,7 @@ type internal TypeCheckInfo
                     m)
 
             | Some (CompletionContext.OpenDeclaration isOpenType) ->
-                GetDeclaredItems(
-                    parseResultsOpt,
-                    lineStr,
-                    origLongIdentOpt,
-                    colAtEndOfNamesAndResidue,
-                    residueOpt,
-                    lastDotPos,
-                    line,
-                    loc,
-                    filterCtors,
-                    resolveOverloads,
-                    false,
-                    getAllSymbols
-                )
+                getDeclaredItemsNotInRangeOpWithAllSymbols ()
                 |> Option.map (fun (items, denv, m) ->
                     items
                     |> List.filter (fun x ->
@@ -1541,108 +1608,28 @@ type internal TypeCheckInfo
             | Some CompletionContext.TypeAbbreviationOrSingleCaseUnion
             // Completion at 'Field1: ...'
             | Some (CompletionContext.RecordField (RecordContext.Declaration false)) ->
-                GetDeclaredItems(
-                    parseResultsOpt,
-                    lineStr,
-                    origLongIdentOpt,
-                    colAtEndOfNamesAndResidue,
-                    residueOpt,
-                    lastDotPos,
-                    line,
-                    loc,
-                    filterCtors,
-                    resolveOverloads,
-                    false,
-                    getAllSymbols
-                )
-                |> Option.map (fun (items, denv, m) ->
-                    items
-                    |> List.filter (fun cItem ->
-                        match cItem.Item with
-                        | Item.ModuleOrNamespaces _
-                        | Item.Types _
-                        | Item.TypeVar _
-                        | Item.UnqualifiedType _
-                        | Item.ExnCase _ -> true
-                        | _ -> false),
-                    denv,
-                    m)
-
-            | Some (CompletionContext.Pattern (PatternContext.UnionCaseFieldIdentifier (referencedFields, caseIdRange))) ->
-                GetUnionCaseFields caseIdRange referencedFields
-                |> Option.map (fun completions ->
-                    let (nenv, _ad), m = GetBestEnvForPos pos
-                    completions, nenv.DisplayEnv, m)
+                getDeclaredItemsNotInRangeOpWithAllSymbols ()
+                |> Option.bind (FilterRelevantItemsBy getItem2 None IsTypeCandidate)
 
             | Some (CompletionContext.Pattern patternContext) ->
-                let declaredItems =
-                    GetDeclaredItems(
-                        parseResultsOpt,
-                        lineStr,
-                        origLongIdentOpt,
-                        colAtEndOfNamesAndResidue,
-                        residueOpt,
-                        lastDotPos,
-                        line,
-                        loc,
-                        filterCtors,
-                        resolveOverloads,
-                        false,
-                        getAllSymbols
-                    )
-                    |> Option.map (fun (items, denv, range) ->
-                        let filtered =
-                            items
-                            |> List.filter (fun item ->
-                                match item.Item with
-                                | Item.Value v -> v.LiteralValue.IsSome
-                                | Item.ILField field -> field.LiteralValue.IsSome
-                                | Item.ActivePatternCase _
-                                | Item.ExnCase _
-                                | Item.ModuleOrNamespaces _
-                                | Item.NewDef _
-                                | Item.Types _
-                                | Item.UnionCase _ -> true
-                                | _ -> false)
-
-                        filtered, denv, range)
-
-                let indexOrName, caseIdRange =
-                    match patternContext with
-                    | PatternContext.PositionalUnionCaseField (index, _, m) -> Choice1Of2 index, m
-                    | PatternContext.NamedUnionCaseField (name, m) -> Choice2Of2 name, m
-                    | PatternContext.UnionCaseFieldIdentifier _
-                    | PatternContext.Other -> Choice1Of2 None, range0
-
-                // No special handling other than filtering out items that may not appear in a pattern
-                if equals caseIdRange range0 then
-                    declaredItems
-                else
-                    // When the user types `fun (Case (x| )) ->`, we do not yet know whether the intention is to use positional or named arguments,
-                    // so let's show options for both.
-                    let fields patternContext (uci: UnionCaseInfo) =
-                        match patternContext with
-                        | PatternContext.PositionalUnionCaseField (Some 0, true, _) ->
-                            uci.UnionCase.RecdFields
-                            |> List.mapi (fun index _ ->
-                                Item.UnionCaseField(uci, index)
-                                |> ItemWithNoInst
-                                |> CompletionItem ValueNone ValueNone)
-                        | _ -> []
-
-                    sResolutions.CapturedNameResolutions
-                    |> ResizeArray.tryPick (fun r ->
-                        match r.Item with
-                        | Item.UnionCase (uci, _) when equals r.Range caseIdRange ->
-                            let list =
-                                declaredItems
-                                |> Option.map p13
-                                |> Option.defaultValue []
-                                |> List.append (fields patternContext uci)
-
-                            Some(SuggestNameForUnionCaseFieldPattern g caseIdRange.End pos uci indexOrName list, r.DisplayEnv, r.Range)
-                        | _ -> None)
-                    |> Option.orElse declaredItems
+                match patternContext with
+                | PatternContext.UnionCaseFieldIdentifier (referencedFields, caseIdRange) ->
+                    GetUnionCaseFields caseIdRange referencedFields
+                    |> Option.map (fun completions ->
+                        let (nenv, _ad), m = GetBestEnvForPos pos
+                        completions, nenv.DisplayEnv, m)
+                | PatternContext.PositionalUnionCaseField (fieldIndex, isTheOnlyField, caseIdRange) ->
+                    getDeclaredItemsNotInRangeOpWithAllSymbols ()
+                    |> GetCompletionsForUnionCaseField pos (Choice1Of2 fieldIndex) caseIdRange isTheOnlyField
+                | PatternContext.NamedUnionCaseField (fieldName, caseIdRange) ->
+                    getDeclaredItemsNotInRangeOpWithAllSymbols ()
+                    |> GetCompletionsForUnionCaseField pos (Choice2Of2 fieldName) caseIdRange false
+                | PatternContext.RecordFieldIdentifier referencedFields ->
+                    getDeclaredItemsNotInRangeOpWithAllSymbols ()
+                    |> GetCompletionsForRecordField pos referencedFields
+                | PatternContext.Other ->
+                    getDeclaredItemsNotInRangeOpWithAllSymbols ()
+                    |> Option.bind (FilterRelevantItemsBy getItem2 None IsPatternCandidate)
 
             | Some (CompletionContext.MethodOverride enclosingTypeNameRange) -> GetOverridableMethods pos enclosingTypeNameRange
 

src/Compiler/Service/ServiceParsedInputOps.fs

@@ -64,6 +64,9 @@ type PatternContext =
     /// Completing union case field identifier in a pattern (e.g. fun (Case (field1 = a; fie| )) -> )
     | UnionCaseFieldIdentifier of referencedFields: string list * caseIdRange: range
 
+    /// Completing a record field identifier in a pattern (e.g. fun { Field1 = a; Fie| } -> )
+    | RecordFieldIdentifier of referencedFields: (string * range) list
+
     /// Any other position in a pattern that does not need special handling
     | Other
 
@@ -1310,10 +1313,28 @@ module ParsedInput =
             | _ ->
                 pats
                 |> List.tryPick (fun pat -> TryGetCompletionContextInPattern false pat None pos)
+        | SynPat.Record (fieldPats = pats) ->
+            pats
+            |> List.tryPick (fun ((_, fieldId), _, pat) ->
+                if rangeContainsPos fieldId.idRange pos then
+                    let referencedFields = pats |> List.map (fun ((_, x), _, _) -> x.idText, x.idRange)
+                    Some(CompletionContext.Pattern(PatternContext.RecordFieldIdentifier referencedFields))
+                elif rangeContainsPos pat.Range pos then
+                    TryGetCompletionContextInPattern false pat None pos
+                else
+                    None)
+            |> Option.orElseWith (fun () ->
+                // Last resort - check for fun { Field1 = a; F| } ->
+                // That is, pos is after the last field and still within braces
+                if pats |> List.forall (fun (_, m, _) -> rangeBeforePos m pos) then
+                    let referencedFields = pats |> List.map (fun ((_, x), _, _) -> x.idText, x.idRange)
+                    Some(CompletionContext.Pattern(PatternContext.RecordFieldIdentifier referencedFields))
+                else
+                    None)
         | SynPat.Ands (pats = pats)
         | SynPat.ArrayOrList (elementPats = pats) ->
             pats
-            |> List.tryPick (fun pat -> TryGetCompletionContextInPattern suppressIdentifierCompletions pat None pos)
+            |> List.tryPick (fun pat -> TryGetCompletionContextInPattern false pat None pos)
         | SynPat.Tuple (elementPats = pats; commaRanges = commas; range = m) ->
             pats
             |> List.indexed

src/Compiler/Service/ServiceParsedInputOps.fsi

@@ -36,6 +36,9 @@ type public PatternContext =
     /// Completing union case field identifier in a pattern (e.g. fun (Case (field1 = a; fie| )) -> )
     | UnionCaseFieldIdentifier of referencedFields: string list * caseIdRange: range
 
+    /// Completing a record field identifier in a pattern (e.g. fun { Field1 = a; Fie| } -> )
+    | RecordFieldIdentifier of referencedFields: (string * range) list
+
     /// Any other position in a pattern that does not need special handling
     | Other