Code completion: named union case fields rule

ReSharper.FSharp/src/FSharp.Psi.Features/FSharp.Psi.Features.fsproj

@@ -21,6 +21,7 @@
     <Compile Include="src\CodeCompletion\Rules\RemoveReparsePatternRule.fs" />
     <Compile Include="src\CodeCompletion\Rules\ImportRule.fs" />
     <Compile Include="src\CodeCompletion\Rules\GenerateMatchExprPatternsRule.fs" />
+    <Compile Include="src\CodeCompletion\Rules\NamedUnionCaseFieldsPatRule.fs" />
     <Compile Include="src\CodeCompletion\FSharpScriptNugetReferencesCompletionProvider.fs" />
     <Compile Include="src\CodeCompletion\FSharpPathCompletionProvider.fs" />
     <Compile Include="src\CodeCompletion\FSharpKeywordsProvider.fs" />

ReSharper.FSharp/src/FSharp.Psi.Features/src/CodeCompletion/FSharpCompletionProviders.fs

@@ -33,6 +33,13 @@ type FSharpLookupItemsProviderBase(logger: ILogger, filterResolved, getAllSymbol
         let fsContext = context.As<FSharpCodeCompletionContext>()
         if isNull fsContext then null else
 
+        let isNamedUnionCaseFieldsPat =
+            let reference = fsContext.ReparsedContext.Reference
+            let parametersOwnerPat = FSharpCompletionUtil.getParametersOwnerPatFromReference reference
+            isNotNull parametersOwnerPat && parametersOwnerPat.Parameters.SingleItem :? INamedUnionCaseFieldsPat
+
+        if isNamedUnionCaseFieldsPat then null else
+
         let tokenType = getTokenType fsContext.TokenAtCaret
         let tokenBeforeType = getTokenType fsContext.TokenBeforeCaret
 

ReSharper.FSharp/src/FSharp.Psi.Features/src/CodeCompletion/FSharpCompletionUtil.fs

@@ -6,7 +6,10 @@ open JetBrains.ReSharper.Feature.Services.CodeCompletion
 open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.LookupItems
 open JetBrains.ReSharper.Feature.Services.CodeCompletion.Settings
 open JetBrains.ReSharper.Plugins.FSharp.Psi
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Resolve
+open JetBrains.ReSharper.Psi.Resolve
 open JetBrains.TextControl
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
 
 let (|BasicCompletion|SmartCompletion|ImportCompletion|) completionType =
     if completionType == CodeCompletionType.BasicCompletion then BasicCompletion else
@@ -42,3 +45,22 @@ type ILookupItem with
 
     member this.WithRelevance(relevance: CLRLookupItemRelevance) =
         this.WithRelevance(uint64 relevance)
+
+let getParametersOwnerPatFromReference (reference: IReference) : IParametersOwnerPat =
+    let reference = reference.As<FSharpSymbolReference>()
+    if isNull reference then null else
+
+    let exprRefName = reference.GetElement().As<IExpressionReferenceName>()
+    if isNull exprRefName || exprRefName.IsQualified then null else
+
+    let refPat = ReferencePatNavigator.GetByReferenceName(exprRefName)
+    let parentPat: IFSharpPattern =
+        // Try finding a reference pattern in case there is no existing named access.
+        if isNotNull refPat then
+            ParenPatNavigator.GetByPattern(refPat)
+        else
+            // Otherwise, try and find an incomplete field pat
+            let fieldPat = FieldPatNavigator.GetByReferenceName(exprRefName)
+            NamedUnionCaseFieldsPatNavigator.GetByFieldPattern(fieldPat)
+
+    ParametersOwnerPatNavigator.GetByParameter(parentPat)

ReSharper.FSharp/src/FSharp.Psi.Features/src/CodeCompletion/Rules/NamedUnionCaseFieldsPatRule.fs

@@ -0,0 +1,98 @@
+namespace JetBrains.ReSharper.Plugins.FSharp.Psi.Features.CodeCompletion.Rules
+
+open FSharp.Compiler.Symbols
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.AspectLookupItems.BaseInfrastructure
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.AspectLookupItems.Behaviors
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.AspectLookupItems.Info
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.AspectLookupItems.Matchers
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.AspectLookupItems.Presentations
+open JetBrains.ReSharper.Feature.Services.CodeCompletion.Infrastructure.LookupItems
+open JetBrains.ReSharper.Plugins.FSharp.Psi
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.CodeCompletion
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.CodeCompletion.FSharpCompletionUtil
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Parsing
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
+open JetBrains.ReSharper.Psi
+open JetBrains.ReSharper.Psi.ExpectedTypes
+open JetBrains.ReSharper.Psi.ExtensionsAPI
+open JetBrains.ReSharper.Psi.Resources
+
+[<Language(typeof<FSharpLanguage>)>]
+type NamedUnionCaseFieldsPatRule() =
+    inherit ItemsProviderOfSpecificContext<FSharpCodeCompletionContext>()
+
+    // Find the parameterOwner `A` in `A()` or `A(a = a; )`
+    // Filter out the already used fields
+    let getFieldsFromParametersOwnerPat (parametersOwnerPat: IParametersOwnerPat) (filterFields: Set<string>) =
+        let referenceName = parametersOwnerPat.ReferenceName
+        if isNull referenceName then Array.empty else
+
+        // We need to figure out if `A` actually is a UnionCase.
+        let fcsUnionCase = referenceName.Reference.GetFcsSymbol().As<FSharpUnionCase>()
+        if isNull fcsUnionCase then Array.empty else
+
+        let fieldNames =
+            fcsUnionCase.Fields
+            |> Seq.choose (fun field -> if field.IsNameGenerated then None else Some field.Name)
+            |> Seq.toArray
+
+        // Only give auto completion to the fields only when all of them are named.
+        if fieldNames.Length <> fcsUnionCase.Fields.Count then Array.empty else
+        if Set.isEmpty filterFields then fieldNames else
+        fieldNames
+        |> Array.except filterFields
+
+    // The current scope is to have A({caret}) captured.
+    // A fake identifier will be inserted in the reparseContext.
+    let getFieldsFromReference (context: FSharpCodeCompletionContext) =
+        let parametersOwnerPat = getParametersOwnerPatFromReference context.ReparsedContext.Reference
+        if isNull parametersOwnerPat then Array.empty else
+
+        let filteredItems =
+            let namedUnionCaseFieldsPat = parametersOwnerPat.Parameters.SingleItem.As<INamedUnionCaseFieldsPat>()
+            if isNull namedUnionCaseFieldsPat then Set.empty else
+
+            namedUnionCaseFieldsPat.FieldPatterns
+            |> Seq.map (fun fieldPat -> fieldPat.ShortName)
+            |> Seq.filter (fun name -> name <> SharedImplUtil.MISSING_DECLARATION_NAME)
+            |> Set.ofSeq
+
+        getFieldsFromParametersOwnerPat parametersOwnerPat filteredItems
+
+    override this.IsAvailable(context) =
+        let fieldNames = getFieldsFromReference context
+        not (Array.isEmpty fieldNames)
+
+    override this.TransformItems(context, collector) =
+        let parametersOwnerPat = getParametersOwnerPatFromReference context.ReparsedContext.Reference
+        let namedUnionCaseFieldsPat = if isNull parametersOwnerPat then null else parametersOwnerPat.Parameters.SingleItem.As<INamedUnionCaseFieldsPat>()
+        if isNotNull namedUnionCaseFieldsPat then
+            // In this scenario we are already in a named union case field pattern.
+            // Thus there is no need to show any other completions.
+            collector.RemoveWhere(fun item -> true)
+
+        let fieldNames = getFieldsFromReference context
+        assert (not (Array.isEmpty fieldNames))
+
+        for fieldName in fieldNames do
+            let info = TextualInfo(fieldName, fieldName, Ranges = context.Ranges)
+            let item =
+                LookupItemFactory
+                    .CreateLookupItem(info)
+                    .WithPresentation(fun _ ->
+                        TextPresentation(info, fieldName, true, PsiSymbolsThemedIcons.Field.Id))
+                    .WithBehavior(fun _ -> TextualBehavior(info))
+                    .WithMatcher(fun _ -> TextualMatcher(info))
+                    // Force the items to be on top in the list.
+                    .WithRelevance(CLRLookupItemRelevance.ExpectedTypeMatch)
+
+            let tailNodeTypes =
+                [| FSharpTokenType.WHITESPACE
+                   FSharpTokenType.EQUALS
+                   FSharpTokenType.WHITESPACE
+                   TailType.CaretTokenNodeType.Instance |]
+
+            item.SetTailType(SimpleTailType(" = ", tailNodeTypes, SkipTypings = [|" = "; "= "|]))
+
+            collector.Add(item)

ReSharper.FSharp/src/FSharp.Psi.Features/src/CodeCompletion/Strategies/FSharpAutopopupStrategies.fs

@@ -62,9 +62,9 @@ type FSharpOnSpaceAutopopupStrategy() =
 
             | TokenType FSharpTokenType.SEMICOLON semi ->
                 match semi.Parent with
-                | :? IRecordFieldBinding as fieldBinding ->
-                    fieldBinding.Semicolon == semi
-
+                | :? IRecordFieldBinding
+                | :? INamedUnionCaseFieldsPat as node ->
+                    node.LastChild == semi
                 | _ -> false
 
             | TokenType FSharpTokenType.LBRACE lbrace ->

ReSharper.FSharp/src/FSharp.Psi/src/Impl/Tree/SynPatBase.cs

@@ -6,6 +6,7 @@
 using JetBrains.ReSharper.Plugins.FSharp.Psi.Tree;
 using JetBrains.ReSharper.Plugins.FSharp.Psi.Util;
 using JetBrains.ReSharper.Psi;
+using JetBrains.ReSharper.Psi.ExtensionsAPI;
 using JetBrains.Util;
 
 namespace JetBrains.ReSharper.Plugins.FSharp.Psi.Impl.Tree
@@ -215,6 +216,7 @@ public override IEnumerable<IFSharpPattern> NestedPatterns
   internal partial class FieldPat
   {
     public FSharpSymbolReference Reference => ReferenceName?.Reference;
+    public string ShortName => ReferenceName?.ShortName ?? SharedImplUtil.MISSING_DECLARATION_NAME;
   }
 
   internal static class ReferencePatternUtil

ReSharper.FSharp/src/FSharp.Psi/src/Tree/IReferencePat.cs

@@ -7,4 +7,9 @@ public partial interface IReferencePat : IMutableModifierOwner, IFSharpDeclarati
     bool IsLocal { get; }
     [CanBeNull] IBindingLikeDeclaration Binding { get; }
   }
+
+  public partial interface IFieldPat
+  {
+    [NotNull] string ShortName { get; }
+  }
 }

ReSharper.FSharp/test/data/features/completion/filtered/NamedUnionCaseFieldsPat - 01.fs

@@ -0,0 +1,9 @@
+module Foo
+
+type Foo =
+    | Meh of int * string
+    | Bar of apple:int * banana: string * citrus: float
+
+let a (b: Foo) =
+    match b with
+    | Bar({caret}) -> ()