Skip to content

Filter completions for record fields in patterns #15903

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

Merged
merged 6 commits into from
Sep 5, 2023
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.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
279 changes: 133 additions & 146 deletions src/Compiler/Service/FSharpCheckerResults.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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)
Expand All @@ -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
(
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) ->
Expand All @@ -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 ->
Expand All @@ -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 ->
Expand All @@ -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

Expand Down
23 changes: 22 additions & 1 deletion src/Compiler/Service/ServiceParsedInputOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions src/Compiler/Service/ServiceParsedInputOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
Loading