Completion in object initializers

vladima · latkin · commit 1a246cc0d644 · 2015-02-05T14:30:41.000-08:00
fixes dotnet#119 closes dotnet#197 commit d4dd838 Author: Vladimir Matveev <vladima@microsoft.com> Date: Tue Feb 3 16:20:52 2015 -0800 added test for settable extension property commit 5edc7cc Author: Vladimir Matveev <vladima@microsoft.com> Date: Tue Feb 3 16:20:26 2015 -0800 addressed CR feedback commit f17c57d Author: v2m <desco.by@gmail.com> Date: Sun Feb 1 14:55:02 2015 -0800 added tests for property completion in object creation expressions commit 38a0734 Author: v2m <desco.by@gmail.com> Date: Wed Jan 28 11:25:09 2015 -0800 initial revision of completions for properties in 'new' expressions
diff --git a/src/fsharp/nameres.fs b/src/fsharp/nameres.fs
@@ -2459,8 +2459,17 @@ let ResolveRecordOrClassFieldsOfType (ncenv: NameResolver) m ad typ statics =
     |> List.filter (fun rfref -> rfref.IsStatic = statics  &&  IsFieldInfoAccessible ad rfref)
     |> List.map Item.RecdField
 
+[<RequireQualifiedAccess>]
+type ResolveCompletionTargets =
+    | All of (MethInfo -> TType -> bool)
+    | SettablePropertiesAndFields
+    member this.ResolveAll = 
+        match this with
+        | All _ -> true
+        | SettablePropertiesAndFields -> false
+
 /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type.
-let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad statics typ =
+let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: ResolveCompletionTargets) m ad statics typ =
     let g = ncenv.g
     let amap = ncenv.amap
     
@@ -2469,21 +2478,23 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
         |> List.filter (fun rfref -> rfref.IsStatic = statics  &&  IsFieldInfoAccessible ad rfref)
 
     let ucinfos = 
-        if statics  && isAppTy g typ then 
+        if completionTargets.ResolveAll && statics  && isAppTy g typ then 
             let tc,tinst = destAppTy g typ
             tc.UnionCasesAsRefList 
             |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not)
             |> List.map (fun ucref ->  Item.UnionCase(UnionCaseInfo(tinst,ucref),false))
         else []
 
     let einfos = 
-        ncenv.InfoReader.GetEventInfosOfType(None,ad,m,typ)
-        |> List.filter (fun x -> 
-            IsStandardEventInfo ncenv.InfoReader m ad x &&
-            x.IsStatic = statics)
+        if completionTargets.ResolveAll then
+            ncenv.InfoReader.GetEventInfosOfType(None,ad,m,typ)
+            |> List.filter (fun x -> 
+                IsStandardEventInfo ncenv.InfoReader m ad x &&
+                x.IsStatic = statics)
+        else []
 
     let nestedTypes = 
-        if statics then
+        if completionTargets.ResolveAll && statics then
             typ
             |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) 
         else 
@@ -2501,7 +2512,6 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
             x.IsStatic = statics && 
             IsPropInfoAccessible g amap m ad x)
 
-
     // Exclude get_ and set_ methods accessed by properties 
     let pinfoMethNames = 
       (pinfosIncludingUnseen 
@@ -2513,13 +2523,15 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
        |> List.map (fun pinfo -> pinfo.SetterMethod.LogicalName))
     
     let einfoMethNames = 
-        [ for einfo in einfos do 
-            let delegateType = einfo.GetDelegateType(amap,m)
-            let (SigOfFunctionForDelegate(invokeMethInfo,_,_,_)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad 
-            // Only events with void return types are suppressed in intellisense.
-            if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then 
-              yield einfo.GetAddMethod().DisplayName
-              yield einfo.GetRemoveMethod().DisplayName ]
+        if completionTargets.ResolveAll then
+            [ for einfo in einfos do 
+                let delegateType = einfo.GetDelegateType(amap,m)
+                let (SigOfFunctionForDelegate(invokeMethInfo,_,_,_)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad 
+                // Only events with void return types are suppressed in intellisense.
+                if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then 
+                  yield einfo.GetAddMethod().DisplayName
+                  yield einfo.GetRemoveMethod().DisplayName ]
+        else []
 
     let suppressedMethNames = Zset.ofList String.order (pinfoMethNames @ einfoMethNames)
 
@@ -2528,6 +2540,10 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
         |> List.filter (fun x -> not (PropInfoIsUnseen m x))
 
     let minfoFilter (minfo:MethInfo) = 
+        let isApplicableMeth =
+            match completionTargets with
+            | ResolveCompletionTargets.All x -> x
+            | _ -> failwith "internal error: expected completionTargets = ResolveCompletionTargets.All"
         // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is 
         // System.Object. Few of these are typically used from F#.  
         //
@@ -2566,24 +2582,37 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
         result
 
     let pinfoItems = 
+        let pinfos = 
+            match completionTargets with
+            | ResolveCompletionTargets.SettablePropertiesAndFields -> pinfos |> List.filter (fun p -> p.HasSetter)
+            | _ -> pinfos
+
         pinfos
-        |> List.map (fun pinfo -> DecodeFSharpEvent [pinfo] ad g ncenv m)
-        |> List.filter (fun pinfo-> match pinfo with
-                                    | Some(Item.Event(einfo)) -> IsStandardEventInfo ncenv.InfoReader m ad einfo
-                                    | _ -> pinfo.IsSome)
-        |> List.map (fun pinfo->pinfo.Value)
-
-    let addersAndRemovers = 
-        pinfoItems 
-        |> List.map (function Item.Event(FSEvent(_,_,addValRef,removeValRef)) -> [addValRef.LogicalName;removeValRef.LogicalName] | _ -> [])
-        |> List.concat
-    
+        |> List.choose (fun pinfo->
+            let pinfoOpt = DecodeFSharpEvent [pinfo] ad g ncenv m
+            match pinfoOpt, completionTargets with
+            | Some(Item.Event(einfo)), ResolveCompletionTargets.All _ -> if IsStandardEventInfo ncenv.InfoReader m ad einfo then pinfoOpt else None
+            | _ -> pinfoOpt)
+
     // REVIEW: add a name filter here in the common cases?
     let minfos = 
-        AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m typ 
-        |> List.filter minfoFilter
-        |> List.filter (fun minfo -> not(addersAndRemovers|>List.exists (fun ar-> ar = minfo.LogicalName)))
+        if completionTargets.ResolveAll then
+            let minfos =
+                AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m typ 
+                |> List.filter minfoFilter
+
+            let addersAndRemovers = 
+                pinfoItems 
+                |> List.map (function Item.Event(FSEvent(_,_,addValRef,removeValRef)) -> [addValRef.LogicalName;removeValRef.LogicalName] | _ -> [])
+                |> List.concat
+
+            match addersAndRemovers with
+            | [] -> minfos
+            | addersAndRemovers ->
+                let isNotAdderOrRemover (minfo: MethInfo) = not(addersAndRemovers |> List.exists (fun ar -> ar = minfo.LogicalName))
+                List.filter isNotAdderOrRemover minfos
 
+        else []
     // Partition methods into overload sets
     let rec partitionl (l:MethInfo list) acc = 
         match l with
@@ -2592,8 +2621,6 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv isApplicableMeth m ad st
             let nm = h.LogicalName
             partitionl t (NameMultiMap.add nm h acc)
 
-
-
     // Build the results
     ucinfos @
     List.map Item.RecdField rfinfos @
@@ -2891,7 +2918,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE
 
 /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions.
 let ResolvePartialLongIdent ncenv nenv isApplicableMeth m ad plid allowObsolete = 
-    ResolvePartialLongIdentPrim ncenv nenv isApplicableMeth OpenQualified m ad plid allowObsolete 
+    ResolvePartialLongIdentPrim ncenv nenv (ResolveCompletionTargets.All isApplicableMeth) OpenQualified m ad plid allowObsolete 
 
 // REVIEW: has much in common with ResolvePartialLongIdentInModuleOrNamespace - probably they should be united
 let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameResolver) nenv m ad (modref:ModuleOrNamespaceRef) plid allowObsolete =
diff --git a/src/fsharp/nameres.fsi b/src/fsharp/nameres.fsi
@@ -303,5 +303,10 @@ val FakeInstantiationGenerator : range -> Typar list -> TType list
 /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions.
 val ResolvePartialLongIdent : NameResolver -> NameResolutionEnv -> (MethInfo -> TType -> bool) -> range -> AccessorDomain -> string list -> bool -> Item list
 
+[<RequireQualifiedAccess>]
+type ResolveCompletionTargets =
+    | All of (MethInfo -> TType -> bool)
+    | SettablePropertiesAndFields
+
 /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type.
-val ResolveCompletionsInType       : NameResolver -> NameResolutionEnv -> (MethInfo -> TType -> bool) -> Range.range -> Infos.AccessorDomain -> bool -> TType -> Item list
+val ResolveCompletionsInType       : NameResolver -> NameResolutionEnv -> ResolveCompletionTargets -> Range.range -> Infos.AccessorDomain -> bool -> TType -> Item list
diff --git a/src/fsharp/vs/ServiceUntypedParse.fs b/src/fsharp/vs/ServiceUntypedParse.fs
@@ -70,6 +70,7 @@ type internal CompletionContext =
     // completing records field
     | RecordField of RecordContext
     | RangeOperator
+    | NewObject of pos * HashSet<string>
 
 //----------------------------------------------------------------------------
 // Untyped scope
@@ -387,6 +388,9 @@ type internal UntypedParseInfo(parsed:UntypedParseResults) =
         scope.ValidateBreakpointLocationImpl(pos)
 
 module internal UntypedParseInfoImpl =
+    
+    let emptyStringSet = HashSet<string>()
+
     let GetUntypedParseResults (upi : UntypedParseInfo) = upi.Results
 
     let GetRangeOfExprLeftOfDot(line,col,parseTreeOpt) =
@@ -726,13 +730,99 @@ module internal UntypedParseInfoImpl =
                     Some CompletionContext.Invalid
             | _ -> None
 
+        let (|Operator|_|) name e = 
+            match e with
+            | SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.App(ExprAtomicFlag.NonAtomic, true, SynExpr.Ident(ident), lhs, _), rhs, _) 
+                when ident.idText = name -> Some(lhs, rhs)
+            | _ -> None
+
         // checks if we are in rhs of the range operator
         let isInRhsOfRangeOp (p : AstTraversal.TraversePath) = 
             match p with
-            | TS.Expr(SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.App(ExprAtomicFlag.NonAtomic, true, SynExpr.Ident(ident), _, _), _, _))::_  
-                when ident.idText = "op_Range"-> true
+            | TS.Expr(Operator "op_Range" _)::_ -> true
             | _ -> false
 
+        let (|Setter|_|) e =
+            match e with
+            | Operator "op_Equality" (SynExpr.Ident id, _) -> Some id
+            | _ -> None
+
+        let findSetters argList =
+            match argList with
+            | SynExpr.Paren(SynExpr.Tuple(parameters, _, _), _, _, _) -> 
+                let setters = HashSet()
+                for p in parameters do
+                    match p with
+                    | Setter id -> ignore(setters.Add id.idText)
+                    | _ -> ()
+                setters
+            | _ -> emptyStringSet
+
+        let endOfLastIdent (lid: LongIdentWithDots) = 
+            let last = List.last lid.Lid
+            last.idRange.End
+
+        let endOfClosingTokenOrLastIdent (mClosing: range option) (lid : LongIdentWithDots) =
+            match mClosing with
+            | Some m -> m.End
+            | None -> endOfLastIdent lid
+
+        let endOfClosingTokenOrIdent (mClosing: range option) (id : Ident) =
+            match mClosing with
+            | Some m -> m.End
+            | None -> id.idRange.End
+
+        let (|NewObject|_|) e =
+            match e with
+            | (SynExpr.New (_, SynType.LongIdent typeName, arg, _)) -> 
+                // new A()
+                Some (endOfLastIdent typeName, findSetters arg)
+            | (SynExpr.New (_, SynType.App(SynType.LongIdent typeName, _, _, _, mGreaterThan, _, _), arg, _)) -> 
+                // new A<_>()
+                Some (endOfClosingTokenOrLastIdent mGreaterThan typeName, findSetters arg)
+            | (SynExpr.App (ExprAtomicFlag.Atomic, false, SynExpr.Ident id, arg, _)) -> 
+                // A()
+                Some (id.idRange.End, findSetters arg)
+            | (SynExpr.App (ExprAtomicFlag.Atomic, false, SynExpr.TypeApp(SynExpr.Ident id, _, _, _, mGreaterThan, _, _), arg, _)) -> 
+                // A<_>()
+                Some (endOfClosingTokenOrIdent mGreaterThan id , findSetters arg)
+            | (SynExpr.App (ExprAtomicFlag.Atomic, false, SynExpr.LongIdent(_, lid, _, _), arg, _)) -> 
+                // A.B()
+                Some (endOfLastIdent lid, findSetters arg)
+            | (SynExpr.App (ExprAtomicFlag.Atomic, false, SynExpr.TypeApp(SynExpr.LongIdent(_, lid, _, _), _, _, _, mGreaterThan, _, _), arg, _)) -> 
+                // A.B<_>()
+                Some (endOfClosingTokenOrLastIdent mGreaterThan lid, findSetters arg)
+            | _ -> None
+        
+        let isOnTheRightOfComma (elements: SynExpr list) (commas: range list) current = 
+            let rec loop elements (commas: range list) = 
+                match elements with
+                | x::xs ->
+                    match commas with
+                    | c::cs -> 
+                        if x === current then posLt c.End pos || posEq c.End pos 
+                        else loop xs cs
+                    | _ -> false
+                | _ -> false
+            loop elements commas
+
+        let (|PartOfParameterList|_|) precedingArgument path =
+            match path with
+            | TS.Expr(SynExpr.Paren _)::TS.Expr(NewObject(args))::_ -> 
+                if Option.isSome precedingArgument then None else Some args
+            | TS.Expr(SynExpr.Tuple (elements, commas, _))::TS.Expr(SynExpr.Paren _)::TS.Expr(NewObject(args))::_ -> 
+                match precedingArgument with
+                | None -> Some args
+                | Some e ->
+                    // if expression is passed then
+                    // 1. find it in among elements of the tuple
+                    // 2. find corresponding comma
+                    // 3. check that current position is past the comma
+                    // this is used for cases like (a = something-here.) if the cursor is after .
+                    // in this case this is not object initializer completion context
+                    if isOnTheRightOfComma elements commas e then Some args else None
+            | _ -> None
+
         let walker = 
             { 
                 new AstTraversal.AstVisitorBase<_>() with
@@ -741,7 +831,26 @@ module internal UntypedParseInfoImpl =
                             match defaultTraverse expr with
                             | None -> Some (CompletionContext.RangeOperator) // nothing was found - report that we were in the context of range operator
                             | x -> x // ok, we found something - return it
-                        else defaultTraverse expr
+                        else
+                        match expr with
+                        // new A($)
+                        | SynExpr.Const(SynConst.Unit, m) when rangeContainsPos m pos ->
+                            match path with
+                            | TS.Expr(NewObject args)::_ -> Some (CompletionContext.NewObject args)
+                            | _ -> defaultTraverse expr
+                        // new (... A$)
+                        | SynExpr.Ident id when id.idRange.End = pos ->
+                            match path with
+                            | PartOfParameterList None args -> Some (CompletionContext.NewObject args)
+                            | _ -> defaultTraverse expr
+                        // new (A$ = 1)
+                        // new (A = 1,$)
+                        | Setter id when id.idRange.End = pos || rangeBeforePos expr.Range pos ->
+                            let precedingArgument = if id.idRange.End = pos then None else Some expr
+                            match path with
+                            | PartOfParameterList precedingArgument args-> Some (CompletionContext.NewObject args)
+                            | _ -> defaultTraverse expr
+                        | _ -> defaultTraverse expr
 
                     member this.VisitRecordField(path, copyOpt, field) = 
                         let contextFromTreePath completionPath = 
diff --git a/src/fsharp/vs/ServiceUntypedParse.fsi b/src/fsharp/vs/ServiceUntypedParse.fsi
@@ -67,7 +67,9 @@ type internal CompletionContext =
     // completing records field
     | RecordField of RecordContext
     | RangeOperator
-
+    // completing property setters in constructor call
+    // end of constructor ast node * list of properties that were already set
+    | NewObject of pos * HashSet<string>
 
 // implementation details used by other code in the compiler    
 module internal UntypedParseInfoImpl =
diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs
diff --git a/vsintegration/src/unittests/Tests.LanguageService.Completion.fs b/vsintegration/src/unittests/Tests.LanguageService.Completion.fs
