diff --git a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj index 609e696d61..015f7f23d8 100644 --- a/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj +++ b/src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj @@ -559,6 +559,9 @@ Service/service.fs + + Service/ServiceInterfaceStubGenerator.fs + diff --git a/src/fsharp/vs/ServiceAssemblyContent.fs b/src/fsharp/vs/ServiceAssemblyContent.fs index e4ad54d0aa..08156324e2 100644 --- a/src/fsharp/vs/ServiceAssemblyContent.fs +++ b/src/fsharp/vs/ServiceAssemblyContent.fs @@ -23,8 +23,7 @@ module internal Extensions = [] [] module Option = - let inline attempt (f: unit -> 'T) = try Some (f()) with _ -> None - let inline defaultValue v = function Some x -> x | None -> v + let inline attempt (f: unit -> 'T) = try Some (f()) with _ -> None let inline orElse v = function Some x -> Some x | None -> v [] diff --git a/src/fsharp/vs/ServiceInterfaceStubGenerator.fs b/src/fsharp/vs/ServiceInterfaceStubGenerator.fs new file mode 100644 index 0000000000..0d385afb0b --- /dev/null +++ b/src/fsharp/vs/ServiceInterfaceStubGenerator.fs @@ -0,0 +1,999 @@ +namespace Microsoft.FSharp.Compiler.SourceCodeServices + +open System +open System.Diagnostics +open System.Collections.Generic +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.Ast +open Microsoft.FSharp.Compiler.Range +open Microsoft.FSharp.Compiler.SourceCodeServices + +[] +[] +module Array = + /// pass an array byref to reverse it in place + let revInPlace (array: 'T []) = + if Array.isEmpty array then () else + let arrlen, revlen = array.Length-1, array.Length/2 - 1 + for idx in 0 .. revlen do + let t1 = array.[idx] + let t2 = array.[arrlen-idx] + array.[idx] <- t2 + array.[arrlen-idx] <- t1 + + /// Async implementation of Array.map. + let mapAsync (mapping : 'T -> Async<'U>) (array : 'T[]) : Async<'U[]> = + let len = Array.length array + let result = Array.zeroCreate len + + async { // Apply the mapping function to each array element. + for i in 0 .. len - 1 do + let! mappedValue = mapping array.[i] + result.[i] <- mappedValue + + // Return the completed results. + return result + } + +[] +[] +module String = + open System.IO + + let inline toCharArray (str: string) = str.ToCharArray() + + let lowerCaseFirstChar (str: string) = + if String.IsNullOrEmpty str + || Char.IsLower(str, 0) then str else + let strArr = toCharArray str + match Array.tryHead strArr with + | None -> str + | Some c -> + strArr.[0] <- Char.ToLower c + String (strArr) + + let extractTrailingIndex (str: string) = + match str with + | null -> null, None + | _ -> + let charr = str.ToCharArray() + Array.revInPlace charr + let digits = Array.takeWhile Char.IsDigit charr + Array.revInPlace digits + String digits + |> function + | "" -> str, None + | index -> str.Substring (0, str.Length - index.Length), Some (int index) + + /// Remove all trailing and leading whitespace from the string + /// return null if the string is null + let trim (value: string) = if isNull value then null else value.Trim() + + /// Splits a string into substrings based on the strings in the array separators + let split options (separator: string []) (value: string) = + if isNull value then null else value.Split(separator, options) + + let (|StartsWith|_|) pattern value = + if String.IsNullOrWhiteSpace value then + None + elif value.StartsWith pattern then + Some() + else None + + let (|Contains|_|) pattern value = + if String.IsNullOrWhiteSpace value then + None + elif value.Contains pattern then + Some() + else None + + let getLines (str: string) = + use reader = new StringReader(str) + [| + let line = ref (reader.ReadLine()) + while not (isNull !line) do + yield !line + line := reader.ReadLine() + if str.EndsWith("\n") then + // last trailing space not returned + // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak + yield String.Empty + |] + +[] +module internal CodeGenerationUtils = + open System.IO + open System.CodeDom.Compiler + + type ColumnIndentedTextWriter() = + let stringWriter = new StringWriter() + let indentWriter = new IndentedTextWriter(stringWriter, " ") + + member __.Write(s: string) = + indentWriter.Write("{0}", s) + + member __.Write(s: string, [] objs: obj []) = + indentWriter.Write(s, objs) + + member __.WriteLine(s: string) = + indentWriter.WriteLine("{0}", s) + + member __.WriteLine(s: string, [] objs: obj []) = + indentWriter.WriteLine(s, objs) + + member x.WriteBlankLines count = + for _ in 0 .. count - 1 do + x.WriteLine "" + + member __.Indent i = + indentWriter.Indent <- indentWriter.Indent + i + + member __.Unindent i = + indentWriter.Indent <- max 0 (indentWriter.Indent - i) + + member __.Dump() = + indentWriter.InnerWriter.ToString() + + interface IDisposable with + member __.Dispose() = + stringWriter.Dispose() + indentWriter.Dispose() + + let (|IndexerArg|) = function + | SynIndexerArg.Two(e1, e2) -> [e1; e2] + | SynIndexerArg.One e -> [e] + + let (|IndexerArgList|) xs = + List.collect (|IndexerArg|) xs + + /// An recursive pattern that collect all sequential expressions to avoid StackOverflowException + let rec (|Sequentials|_|) = function + | SynExpr.Sequential(_, _, e, Sequentials es, _) -> + Some(e::es) + | SynExpr.Sequential(_, _, e1, e2, _) -> + Some [e1; e2] + | _ -> None + + /// Represent environment where a captured identifier should be renamed + type NamesWithIndices = Map> + + let keywordSet = set PrettyNaming.KeywordNames + + /// Rename a given argument if the identifier has been used + let normalizeArgName (namesWithIndices: NamesWithIndices) nm = + match nm with + | "()" -> nm, namesWithIndices + | _ -> + let nm = String.lowerCaseFirstChar nm + let nm, index = String.extractTrailingIndex nm + + let index, namesWithIndices = + match namesWithIndices |> Map.tryFind nm, index with + | Some indexes, index -> + let rec getAvailableIndex idx = + if indexes |> Set.contains idx then + getAvailableIndex (idx + 1) + else idx + let index = index |> Option.defaultValue 1 |> getAvailableIndex + Some index, namesWithIndices |> Map.add nm (indexes |> Set.add index) + | None, Some index -> Some index, namesWithIndices |> Map.add nm (Set.ofList [index]) + | None, None -> None, namesWithIndices |> Map.add nm Set.empty + + let nm = + match index with + | Some index -> sprintf "%s%d" nm index + | None -> nm + + let nm = if Set.contains nm keywordSet then sprintf "``%s``" nm else nm + nm, namesWithIndices + +/// Capture information about an interface in ASTs +[] +type internal InterfaceData = + | Interface of SynType * SynMemberDefns option + | ObjExpr of SynType * SynBinding list + member x.Range = + match x with + | InterfaceData.Interface(typ, _) -> + typ.Range + | InterfaceData.ObjExpr(typ, _) -> + typ.Range + member x.TypeParameters = + match x with + | InterfaceData.Interface(typ, _) + | InterfaceData.ObjExpr(typ, _) -> + let rec (|RationalConst|) = function + | SynRationalConst.Integer i -> + string i + | SynRationalConst.Rational(numerator, denominator, _) -> + sprintf "(%i/%i)" numerator denominator + | SynRationalConst.Negate (RationalConst s) -> + sprintf "- %s" s + + let rec (|TypeIdent|_|) = function + | SynType.Var(SynTypar.Typar(s, req , _), _) -> + match req with + | NoStaticReq -> + Some ("'" + s.idText) + | HeadTypeStaticReq -> + Some ("^" + s.idText) + | SynType.LongIdent(LongIdentWithDots(xs, _)) -> + xs |> Seq.map (fun x -> x.idText) |> String.concat "." |> Some + | SynType.App(t, _, ts, _, _, isPostfix, _) -> + match t, ts with + | TypeIdent typeName, [] -> Some typeName + | TypeIdent typeName, [TypeIdent typeArg] -> + if isPostfix then + Some (sprintf "%s %s" typeArg typeName) + else + Some (sprintf "%s<%s>" typeName typeArg) + | TypeIdent typeName, _ -> + let typeArgs = ts |> Seq.choose (|TypeIdent|_|) |> String.concat ", " + if isPostfix then + Some (sprintf "(%s) %s" typeArgs typeName) + else + Some(sprintf "%s<%s>" typeName typeArgs) + | _ -> + //debug "Unsupported case with %A and %A" t ts + None + | SynType.Anon _ -> + Some "_" + | SynType.Tuple(ts, _) -> + Some (ts |> Seq.choose (snd >> (|TypeIdent|_|)) |> String.concat " * ") + | SynType.Array(dimension, TypeIdent typeName, _) -> + Some (sprintf "%s [%s]" typeName (new String(',', dimension-1))) + | SynType.MeasurePower(TypeIdent typeName, RationalConst power, _) -> + Some (sprintf "%s^%s" typeName power) + | SynType.MeasureDivide(TypeIdent numerator, TypeIdent denominator, _) -> + Some (sprintf "%s/%s" numerator denominator) + | _ -> + None + match typ with + | SynType.App(_, _, ts, _, _, _, _) + | SynType.LongIdentApp(_, _, _, ts, _, _, _) -> + ts |> Seq.choose (|TypeIdent|_|) |> Seq.toArray + | _ -> + [||] + +module internal InterfaceStubGenerator = + [] + type internal Context = + { + Writer: ColumnIndentedTextWriter + /// Map generic types to specific instances for specialized interface implementation + TypeInstantations: Map + /// Data for interface instantiation + ArgInstantiations: (FSharpGenericParameter * FSharpType) seq + /// Indentation inside method bodies + Indentation: int + /// Object identifier of the interface e.g. 'x', 'this', '__', etc. + ObjectIdent: string + /// A list of lines represents skeleton of each member + MethodBody: string [] + /// Context in order to display types in the short form + DisplayContext: FSharpDisplayContext + } + + // Adapt from MetadataFormat module in FSharp.Formatting + + let internal (|AllAndLast|_|) (xs: 'T list) = + match xs with + | [] -> + None + | _ -> + let revd = List.rev xs + Some (List.rev revd.Tail, revd.Head) + + let internal getTypeParameterName (typar: FSharpGenericParameter) = + (if typar.IsSolveAtCompileTime then "^" else "'") + typar.Name + + let internal bracket (str: string) = + if str.Contains(" ") then "(" + str + ")" else str + + let internal formatType ctx (typ: FSharpType) = + let genericDefinition = typ.Instantiate(Seq.toList ctx.ArgInstantiations).Format(ctx.DisplayContext) + (genericDefinition, ctx.TypeInstantations) + ||> Map.fold (fun s k v -> s.Replace(k, v)) + + // Format each argument, including its name and type + let internal formatArgUsage ctx hasTypeAnnotation (namesWithIndices: Map>) (arg: FSharpParameter) = + let nm = + match arg.Name with + | None -> + if arg.Type.HasTypeDefinition && arg.Type.TypeDefinition.XmlDocSig = "T:Microsoft.FSharp.Core.unit" then "()" + else sprintf "arg%d" (namesWithIndices |> Map.toSeq |> Seq.map snd |> Seq.sumBy Set.count |> max 1) + | Some x -> x + + let nm, namesWithIndices = normalizeArgName namesWithIndices nm + + // Detect an optional argument + let isOptionalArg = hasAttribute arg.Attributes + let argName = if isOptionalArg then "?" + nm else nm + (if hasTypeAnnotation && argName <> "()" then + argName + ": " + formatType ctx arg.Type + else argName), + namesWithIndices + + let internal formatArgsUsage ctx hasTypeAnnotation (v: FSharpMemberOrFunctionOrValue) args = + let isItemIndexer = (v.IsInstanceMember && v.DisplayName = "Item") + let unit, argSep, tupSep = "()", " ", ", " + let args, namesWithIndices = + args + |> List.fold (fun (argsSoFar: string list list, namesWithIndices) args -> + let argsSoFar', namesWithIndices = + args + |> List.fold (fun (acc: string list, allNames) arg -> + let name, allNames = formatArgUsage ctx hasTypeAnnotation allNames arg + name :: acc, allNames) ([], namesWithIndices) + List.rev argsSoFar' :: argsSoFar, namesWithIndices) + ([], Map.ofList [ ctx.ObjectIdent, Set.empty ]) + args + |> List.rev + |> List.map (function + | [] -> unit + | [arg] when arg = unit -> unit + | [arg] when not v.IsMember || isItemIndexer -> arg + | args when isItemIndexer -> String.concat tupSep args + | args -> bracket (String.concat tupSep args)) + |> String.concat argSep + , namesWithIndices + + [] + type internal MemberInfo = + | PropertyGetSet of FSharpMemberOrFunctionOrValue * FSharpMemberOrFunctionOrValue + | Member of FSharpMemberOrFunctionOrValue + + let internal getArgTypes (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = + let argInfos = v.CurriedParameterGroups |> Seq.map Seq.toList |> Seq.toList + + let retType = v.ReturnParameter.Type + + let argInfos, retType = + match argInfos, v.IsPropertyGetterMethod, v.IsPropertySetterMethod with + | [ AllAndLast(args, last) ], _, true -> [ args ], Some last.Type + | [[]], true, _ -> [], Some retType + | _, _, _ -> argInfos, Some retType + + let retType = + match retType with + | Some typ -> + let coreType = formatType ctx typ + if v.IsEvent then + let isEventHandler = + typ.BaseType + |> Option.bind (fun t -> + if t.HasTypeDefinition then + t.TypeDefinition.TryGetFullName() + else None) + |> Option.exists ((=) "System.MulticastDelegate") + if isEventHandler then sprintf "IEvent<%s, _>" coreType else coreType + else coreType + | None -> + "unit" + + argInfos, retType + + /// Convert a getter/setter to its canonical form + let internal normalizePropertyName (v: FSharpMemberOrFunctionOrValue) = + let displayName = v.DisplayName + if (v.IsPropertyGetterMethod && displayName.StartsWith("get_")) || + (v.IsPropertySetterMethod && displayName.StartsWith("set_")) then + displayName.[4..] + else displayName + + let internal isEventMember (m: FSharpMemberOrFunctionOrValue) = + m.IsEvent || hasAttribute m.Attributes + + let internal formatMember (ctx: Context) m verboseMode = + let getParamArgs (argInfos: FSharpParameter list list) (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = + let args, namesWithIndices = + match argInfos with + | [[x]] when v.IsPropertyGetterMethod && x.Name.IsNone + && x.Type.TypeDefinition.XmlDocSig = "T:Microsoft.FSharp.Core.unit" -> + "", Map.ofList [ctx.ObjectIdent, Set.empty] + | _ -> formatArgsUsage ctx verboseMode v argInfos + + if String.IsNullOrWhiteSpace(args) then "" + elif args.StartsWith("(") then args + elif v.CurriedParameterGroups.Count > 1 && (not verboseMode) then " " + args + else sprintf "(%s)" args + , namesWithIndices + + let preprocess (ctx: Context) (v: FSharpMemberOrFunctionOrValue) = + let buildUsage argInfos = + let parArgs, _ = getParamArgs argInfos ctx v + match v.IsMember, v.IsInstanceMember, v.LogicalName, v.DisplayName with + // Constructors + | _, _, ".ctor", _ -> "new" + parArgs + // Properties (skipping arguments) + | _, true, _, name when v.IsPropertyGetterMethod || v.IsPropertySetterMethod -> + if name.StartsWith("get_") || name.StartsWith("set_") then name.[4..] else name + // Ordinary instance members + | _, true, _, name -> name + parArgs + // Ordinary functions or values + | false, _, _, name when + not (hasAttribute v.LogicalEnclosingEntity.Attributes) -> + name + " " + parArgs + // Ordinary static members or things (?) that require fully qualified access + | _, _, _, name -> name + parArgs + + let modifiers = + [ if v.InlineAnnotation = FSharpInlineAnnotation.AlwaysInline then yield "inline" + if v.Accessibility.IsInternal then yield "internal" ] + + let argInfos, retType = getArgTypes ctx v + let usage = buildUsage argInfos + usage, modifiers, argInfos, retType + + // A couple of helper methods for emitting close declarations of members and stub method bodies. + let closeDeclaration (returnType:string) (writer:ColumnIndentedTextWriter) = + if verboseMode then writer.Write(": {0}", returnType) + writer.Write(" = ", returnType) + if verboseMode then writer.WriteLine("") + let writeImplementation (ctx:Context) (writer:ColumnIndentedTextWriter) = + match verboseMode, ctx.MethodBody with + | false, [| singleLine |] -> writer.WriteLine(singleLine) + | _, lines -> + writer.Indent ctx.Indentation + for line in lines do + writer.WriteLine(line) + writer.Unindent ctx.Indentation + + match m with + | MemberInfo.PropertyGetSet(getter, setter) -> + let (usage, modifiers, getterArgInfos, retType) = preprocess ctx getter + let closeDeclaration = closeDeclaration retType + let writeImplementation = writeImplementation ctx + let (_, _, setterArgInfos, _) = preprocess ctx setter + let writer = ctx.Writer + writer.Write("member ") + for modifier in modifiers do + writer.Write("{0} ", modifier) + writer.Write("{0}.", ctx.ObjectIdent) + + // Try to print getters and setters on the same identifier + writer.WriteLine(usage) + writer.Indent ctx.Indentation + match getParamArgs getterArgInfos ctx getter with + | "", _ | "()", _ -> writer.Write("with get ()") + | args, _ -> writer.Write("with get {0}", args) + writer |> closeDeclaration + writer |> writeImplementation + match getParamArgs setterArgInfos ctx setter with + | "", _ | "()", _ -> + if verboseMode then writer.WriteLine("and set (v: {0}): unit = ", retType) + else writer.Write("and set v = ") + | args, namesWithIndices -> + let valueArgName, _ = normalizeArgName namesWithIndices "v" + if verboseMode then writer.WriteLine("and set {0} ({1}: {2}): unit = ", args, valueArgName, retType) + else writer.Write("and set {0} {1} = ", args, valueArgName) + writer |> writeImplementation + writer.Unindent ctx.Indentation + + | MemberInfo.Member v -> + let (usage, modifiers, argInfos, retType) = preprocess ctx v + let closeDeclaration = closeDeclaration retType + let writeImplementation = writeImplementation ctx + let writer = ctx.Writer + if isEventMember v then + writer.WriteLine("[]") + writer.Write("member ") + for modifier in modifiers do + writer.Write("{0} ", modifier) + writer.Write("{0}.", ctx.ObjectIdent) + + if v.IsEvent then + writer.Write(usage) + writer |> closeDeclaration + writer |> writeImplementation + elif v.IsPropertySetterMethod then + writer.WriteLine(usage) + writer.Indent ctx.Indentation + match getParamArgs argInfos ctx v with + | "", _ | "()", _ -> + writer.WriteLine("with set (v: {0}): unit = ", retType) + | args, namesWithIndices -> + let valueArgName, _ = normalizeArgName namesWithIndices "v" + writer.Write("with set {0} ({1}", args, valueArgName) + if verboseMode then writer.Write(": {0}): unit", retType) + else writer.Write(")") + writer.Write(" = ") + if verboseMode then writer.WriteLine("") + + writer |> writeImplementation + writer.Unindent ctx.Indentation + elif v.IsPropertyGetterMethod then + writer.Write(usage) + match getParamArgs argInfos ctx v with + | "", _ | "()", _ -> + // Use the short-hand notation for getters without arguments + writer |> closeDeclaration + writer |> writeImplementation + | args, _ -> + writer.WriteLine("") + writer.Indent ctx.Indentation + writer.Write("with get {0}", args) + writer |> closeDeclaration + writer |> writeImplementation + writer.Unindent ctx.Indentation + else + writer.Write(usage) + writer |> closeDeclaration + writer |> writeImplementation + + let rec internal getNonAbbreviatedType (typ: FSharpType) = + if typ.HasTypeDefinition && typ.TypeDefinition.IsFSharpAbbreviation then + getNonAbbreviatedType typ.AbbreviatedType + else typ + + // Sometimes interface members are stored in the form of `IInterface<'T> -> ...`, + // so we need to get the 2nd generic argument + let internal (|MemberFunctionType|_|) (typ: FSharpType) = + if typ.IsFunctionType && typ.GenericArguments.Count = 2 then + Some typ.GenericArguments.[1] + else None + + let internal (|TypeOfMember|_|) (m: FSharpMemberOrFunctionOrValue) = + match m.FullTypeSafe with + | Some (MemberFunctionType typ) when m.IsProperty && m.EnclosingEntity.IsFSharp -> + Some typ + | Some typ -> Some typ + | None -> None + + let internal (|EventFunctionType|_|) (typ: FSharpType) = + match typ with + | MemberFunctionType typ -> + if typ.IsFunctionType && typ.GenericArguments.Count = 2 then + let retType = typ.GenericArguments.[0] + let argType = typ.GenericArguments.[1] + if argType.GenericArguments.Count = 2 then + Some (argType.GenericArguments.[0], retType) + else None + else None + | _ -> + None + + let internal removeWhitespace (str: string) = + str.Replace(" ", "") + + /// Filter out duplicated interfaces in inheritance chain + let rec internal getInterfaces (e: FSharpEntity) = + seq { for iface in e.AllInterfaces -> + let typ = getNonAbbreviatedType iface + // Argument should be kept lazy so that it is only evaluated when instantiating a new type + typ.TypeDefinition, Seq.zip typ.TypeDefinition.GenericParameters typ.GenericArguments + } + |> Seq.distinct + + /// Get members in the decreasing order of inheritance chain + let getInterfaceMembers (e: FSharpEntity) = + seq { + for (iface, instantiations) in getInterfaces e do + yield! iface.TryGetMembersFunctionsAndValues + |> Seq.choose (fun m -> + // Use this hack when FCS doesn't return enough information on .NET properties and events + if m.IsProperty || m.IsEventAddMethod || m.IsEventRemoveMethod then + None + else Some (m, instantiations)) + } + + /// Check whether an interface is empty + let hasNoInterfaceMember e = + getInterfaceMembers e |> Seq.isEmpty + + let internal (|LongIdentPattern|_|) = function + | SynPat.LongIdent(LongIdentWithDots(xs, _), _, _, _, _, _) -> +// let (name, range) = xs |> List.map (fun x -> x.idText, x.idRange) |> List.last + let last = List.last xs + Some(last.idText, last.idRange) + | _ -> + None + + // Get name and associated range of a member + // On merged properties (consisting both getters and setters), they have the same range values, + // so we use 'get_' and 'set_' prefix to ensure corresponding symbols are retrieved correctly. + let internal (|MemberNameAndRange|_|) = function + | Binding(_access, _bindingKind, _isInline, _isMutable, _attrs, _xmldoc, SynValData(Some mf, _, _), LongIdentPattern(name, range), + _retTy, _expr, _bindingRange, _seqPoint) when mf.MemberKind = MemberKind.PropertyGet -> + if name.StartsWith("get_") then Some(name, range) else Some("get_" + name, range) + | Binding(_access, _bindingKind, _isInline, _isMutable, _attrs, _xmldoc, SynValData(Some mf, _, _), LongIdentPattern(name, range), + _retTy, _expr, _bindingRange, _seqPoint) when mf.MemberKind = MemberKind.PropertySet -> + if name.StartsWith("set_") then Some(name, range) else Some("set_" + name, range) + | Binding(_access, _bindingKind, _isInline, _isMutable, _attrs, _xmldoc, _valData, LongIdentPattern(name, range), + _retTy, _expr, _bindingRange, _seqPoint) -> + Some(name, range) + | _ -> + None + + /// Get associated member names and ranges + /// In case of properties, intrinsic ranges might not be correct for the purpose of getting + /// positions of 'member', which indicate the indentation for generating new members + let getMemberNameAndRanges = function + | InterfaceData.Interface(_, None) -> + [] + | InterfaceData.Interface(_, Some memberDefns) -> + memberDefns + |> Seq.choose (function (SynMemberDefn.Member(binding, _)) -> Some binding | _ -> None) + |> Seq.choose (|MemberNameAndRange|_|) + |> Seq.toList + | InterfaceData.ObjExpr(_, bindings) -> + List.choose (|MemberNameAndRange|_|) bindings + + let internal normalizeEventName (m: FSharpMemberOrFunctionOrValue) = + let name = m.DisplayName + if name.StartsWith("add_") then name.[4..] + elif name.StartsWith("remove_") then name.[7..] + else name + + /// Ideally this info should be returned in error symbols from FCS. + /// Because it isn't, we implement a crude way of getting member signatures: + /// (1) Crack ASTs to get member names and their associated ranges + /// (2) Check symbols of those members based on ranges + /// (3) If any symbol found, capture its member signature + let getImplementedMemberSignatures (getMemberByLocation: string * range -> Async) displayContext interfaceData = + let formatMemberSignature (symbolUse: FSharpSymbolUse) = + match symbolUse.Symbol with + | :? FSharpMemberOrFunctionOrValue as m -> + match m.FullTypeSafe with + | Some _ when isEventMember m -> + // Events don't have overloads so we use only display names for comparison + let signature = normalizeEventName m + Some [signature] + | Some typ -> + let signature = removeWhitespace (sprintf "%s:%s" m.DisplayName (typ.Format(displayContext))) + Some [signature] + | None -> + None + | _ -> + //fail "Should only accept symbol uses of members." + None + async { + let! symbolUses = + getMemberNameAndRanges interfaceData + |> List.toArray + |> Array.mapAsync getMemberByLocation + return symbolUses |> Array.choose (Option.bind formatMemberSignature >> Option.map String.Concat) + |> Set.ofArray + } + + /// Check whether an entity is an interface or type abbreviation of an interface + let rec isInterface (e: FSharpEntity) = + e.IsInterface || (e.IsFSharpAbbreviation && isInterface e.AbbreviatedType.TypeDefinition) + + /// Generate stub implementation of an interface at a start column + let formatInterface startColumn indentation (typeInstances: string []) objectIdent + (methodBody: string) (displayContext: FSharpDisplayContext) excludedMemberSignatures + (e: FSharpEntity) verboseMode = + Debug.Assert(isInterface e, "The entity should be an interface.") + let lines = String.getLines methodBody + use writer = new ColumnIndentedTextWriter() + let typeParams = Seq.map getTypeParameterName e.GenericParameters + let instantiations = + let insts = + Seq.zip typeParams typeInstances + // Filter out useless instances (when it is replaced by the same name or by wildcard) + |> Seq.filter(fun (t1, t2) -> t1 <> t2 && t2 <> "_") + |> Map.ofSeq + // A simple hack to handle instantiation of type alias + if e.IsFSharpAbbreviation then + let typ = getNonAbbreviatedType e.AbbreviatedType + (typ.TypeDefinition.GenericParameters |> Seq.map getTypeParameterName, + typ.GenericArguments |> Seq.map (fun typ -> typ.Format(displayContext))) + ||> Seq.zip + |> Seq.fold (fun acc (x, y) -> Map.add x y acc) insts + else insts + let ctx = { Writer = writer; TypeInstantations = instantiations; ArgInstantiations = Seq.empty; + Indentation = indentation; ObjectIdent = objectIdent; MethodBody = lines; DisplayContext = displayContext } + let missingMembers = + getInterfaceMembers e + |> Seq.groupBy (fun (m, insts) -> + match m with + | _ when isEventMember m -> + Some (normalizeEventName m) + | TypeOfMember typ -> + let signature = removeWhitespace (sprintf "%s:%s" m.DisplayName (formatType { ctx with ArgInstantiations = insts } typ)) + Some signature + | _ -> + //debug "FullType throws exceptions due to bugs in FCS." + None) + |> Seq.collect (fun (signature, members) -> + match signature with + | None -> + members + | Some signature when not (Set.contains signature excludedMemberSignatures) -> + // Return the first member from a group of members for a particular signature + Seq.truncate 1 members + | _ -> Seq.empty) + + // All members have already been implemented + if Seq.isEmpty missingMembers then + String.Empty + else + writer.Indent startColumn + writer.WriteLine("") + let duplicatedMembers = + missingMembers + |> Seq.countBy(fun (m, insts) -> m.DisplayName, insts |> Seq.length) + |> Seq.filter (snd >> (<) 1) + |> Seq.map (fst >> fst) + |> Set.ofSeq + + let getReturnType v = snd (getArgTypes ctx v) + let rec formatMembers (members : (FSharpMemberOrFunctionOrValue * _) list) = + match members with + // Since there is no unified source of information for properties, + // we try to merge getters and setters when they seem to match. + // Assume that getter and setter come right after each other. + // They belong to the same property if names and return types are the same + | (getter as first, insts) :: (setter, _) :: otherMembers + | (setter as first, _) :: (getter, insts) :: otherMembers when + getter.IsPropertyGetterMethod && setter.IsPropertySetterMethod && + normalizePropertyName getter = normalizePropertyName setter && + getReturnType getter = getReturnType setter -> + let useVerboseMode = verboseMode || duplicatedMembers.Contains first.DisplayName + formatMember { ctx with ArgInstantiations = insts } (MemberInfo.PropertyGetSet(getter, setter)) useVerboseMode + formatMembers otherMembers + | (m, insts) :: otherMembers -> + let useVerboseMode = verboseMode || duplicatedMembers.Contains m.DisplayName + formatMember { ctx with ArgInstantiations = insts } (MemberInfo.Member m) useVerboseMode + formatMembers otherMembers + | [] -> () + + missingMembers + |> Seq.sortBy (fun (m, _) -> + // Sort by normalized name and return type so that getters and setters of the same properties + // are guaranteed to be neighboring. + normalizePropertyName m, getReturnType m) + |> Seq.toList + |> formatMembers + writer.Dump() + + /// Find corresponding interface declaration at a given position + let tryFindInterfaceDeclaration (pos: pos) (parsedInput: ParsedInput) = + let rec walkImplFileInput (ParsedImplFileInput(_name, _isScript, _fileName, _scopedPragmas, _hashDirectives, moduleOrNamespaceList, _)) = + List.tryPick walkSynModuleOrNamespace moduleOrNamespaceList + + and walkSynModuleOrNamespace(SynModuleOrNamespace(_, _, _, decls, _, _, _access, range)) = + if not <| rangeContainsPos range pos then + None + else + List.tryPick walkSynModuleDecl decls + + and walkSynModuleDecl(decl: SynModuleDecl) = + if not <| rangeContainsPos decl.Range pos then + None + else + match decl with + | SynModuleDecl.Exception(SynExceptionDefn(_, synMembers, _), _) -> + List.tryPick walkSynMemberDefn synMembers + | SynModuleDecl.Let(_isRecursive, bindings, _range) -> + List.tryPick walkBinding bindings + | SynModuleDecl.ModuleAbbrev(_lhs, _rhs, _range) -> + None + | SynModuleDecl.NamespaceFragment(fragment) -> + walkSynModuleOrNamespace fragment + | SynModuleDecl.NestedModule(_, _, modules, _, _) -> + List.tryPick walkSynModuleDecl modules + | SynModuleDecl.Types(typeDefs, _range) -> + List.tryPick walkSynTypeDefn typeDefs + | SynModuleDecl.DoExpr (_, expr, _) -> + walkExpr expr + | SynModuleDecl.Attributes _ + | SynModuleDecl.HashDirective _ + | SynModuleDecl.Open _ -> + None + + and walkSynTypeDefn(TypeDefn(_componentInfo, representation, members, range)) = + if not <| rangeContainsPos range pos then + None + else + walkSynTypeDefnRepr representation + |> Option.orElse (List.tryPick walkSynMemberDefn members) + + and walkSynTypeDefnRepr(typeDefnRepr: SynTypeDefnRepr) = + if not <| rangeContainsPos typeDefnRepr.Range pos then + None + else + match typeDefnRepr with + | SynTypeDefnRepr.ObjectModel(_kind, members, _range) -> + List.tryPick walkSynMemberDefn members + | SynTypeDefnRepr.Simple(_repr, _range) -> + None + | SynTypeDefnRepr.Exception _ -> None + + and walkSynMemberDefn (memberDefn: SynMemberDefn) = + if not <| rangeContainsPos memberDefn.Range pos then + None + else + match memberDefn with + | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> + None + | SynMemberDefn.AutoProperty(_attributes, _isStatic, _id, _type, _memberKind, _memberFlags, _xmlDoc, _access, expr, _r1, _r2) -> + walkExpr expr + | SynMemberDefn.Interface(interfaceType, members, _range) -> + if rangeContainsPos interfaceType.Range pos then + Some(InterfaceData.Interface(interfaceType, members)) + else + Option.bind (List.tryPick walkSynMemberDefn) members + | SynMemberDefn.Member(binding, _range) -> + walkBinding binding + | SynMemberDefn.NestedType(typeDef, _access, _range) -> + walkSynTypeDefn typeDef + | SynMemberDefn.ValField(_field, _range) -> + None + | SynMemberDefn.LetBindings(bindings, _isStatic, _isRec, _range) -> + List.tryPick walkBinding bindings + | SynMemberDefn.Open _ + | SynMemberDefn.ImplicitCtor _ + | SynMemberDefn.Inherit _ -> None + | SynMemberDefn.ImplicitInherit (_, expr, _, _) -> walkExpr expr + + and walkBinding (Binding(_access, _bindingKind, _isInline, _isMutable, _attrs, _xmldoc, _valData, _headPat, _retTy, expr, _bindingRange, _seqPoint)) = + walkExpr expr + + and walkExpr expr = + if not <| rangeContainsPos expr.Range pos then + None + else + match expr with + | SynExpr.Quote(synExpr1, _, synExpr2, _, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.Const(_synConst, _range) -> + None + + | SynExpr.Paren(synExpr, _, _, _parenRange) -> + walkExpr synExpr + | SynExpr.Typed(synExpr, _synType, _range) -> + walkExpr synExpr + + | SynExpr.Tuple(synExprList, _, _range) + | SynExpr.ArrayOrList(_, synExprList, _range) -> + List.tryPick walkExpr synExprList + + | SynExpr.Record(_inheritOpt, _copyOpt, fields, _range) -> + List.tryPick (fun (_, e, _) -> Option.bind walkExpr e) fields + + | SynExpr.New(_, _synType, synExpr, _range) -> + walkExpr synExpr + + | SynExpr.ObjExpr(ty, baseCallOpt, binds, ifaces, _range1, _range2) -> + match baseCallOpt with + | None -> + if rangeContainsPos ty.Range pos then + Some (InterfaceData.ObjExpr(ty, binds)) + else + ifaces |> List.tryPick (fun (InterfaceImpl(ty, binds, range)) -> + if rangeContainsPos range pos then + Some (InterfaceData.ObjExpr(ty, binds)) + else None) + | Some _ -> + // Ignore object expressions of normal objects + None + + | SynExpr.While(_sequencePointInfoForWhileLoop, synExpr1, synExpr2, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.ForEach(_sequencePointInfoForForLoop, _seqExprOnly, _isFromSource, _synPat, synExpr1, synExpr2, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.For(_sequencePointInfoForForLoop, _ident, synExpr1, _, synExpr2, synExpr3, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] + + | SynExpr.ArrayOrListOfSeqExpr(_, synExpr, _range) -> + walkExpr synExpr + | SynExpr.CompExpr(_, _, synExpr, _range) -> + walkExpr synExpr + | SynExpr.Lambda(_, _, _synSimplePats, synExpr, _range) -> + walkExpr synExpr + + | SynExpr.MatchLambda(_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) -> + synMatchClauseList |> List.tryPick (fun (Clause(_, _, e, _, _)) -> walkExpr e) + | SynExpr.Match(_sequencePointInfoForBinding, synExpr, synMatchClauseList, _, _range) -> + walkExpr synExpr + |> Option.orElse (synMatchClauseList |> List.tryPick (fun (Clause(_, _, e, _, _)) -> walkExpr e)) + + | SynExpr.Lazy(synExpr, _range) -> + walkExpr synExpr + | SynExpr.Do(synExpr, _range) -> + walkExpr synExpr + | SynExpr.Assert(synExpr, _range) -> + walkExpr synExpr + + | SynExpr.App(_exprAtomicFlag, _isInfix, synExpr1, synExpr2, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.TypeApp(synExpr, _, _synTypeList, _commas, _, _, _range) -> + walkExpr synExpr + + | SynExpr.LetOrUse(_, _, synBindingList, synExpr, _range) -> + Option.orElse (List.tryPick walkBinding synBindingList) (walkExpr synExpr) + + | SynExpr.TryWith(synExpr, _range, _synMatchClauseList, _range2, _range3, _sequencePointInfoForTry, _sequencePointInfoForWith) -> + walkExpr synExpr + + | SynExpr.TryFinally(synExpr1, synExpr2, _range, _sequencePointInfoForTry, _sequencePointInfoForFinally) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | Sequentials exprs -> + List.tryPick walkExpr exprs + + | SynExpr.IfThenElse(synExpr1, synExpr2, synExprOpt, _sequencePointInfoForBinding, _isRecovery, _range, _range2) -> + match synExprOpt with + | Some synExpr3 -> + List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] + | None -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.Ident(_ident) -> + None + | SynExpr.LongIdent(_, _longIdent, _altNameRefCell, _range) -> + None + + | SynExpr.LongIdentSet(_longIdent, synExpr, _range) -> + walkExpr synExpr + | SynExpr.DotGet(synExpr, _dotm, _longIdent, _range) -> + walkExpr synExpr + + | SynExpr.DotSet(synExpr1, _longIdent, synExpr2, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.DotIndexedGet(synExpr, IndexerArgList synExprList, _range, _range2) -> + Option.orElse (walkExpr synExpr) (List.tryPick walkExpr synExprList) + + | SynExpr.DotIndexedSet(synExpr1, IndexerArgList synExprList, synExpr2, _, _range, _range2) -> + [ yield synExpr1 + yield! synExprList + yield synExpr2 ] + |> List.tryPick walkExpr + + | SynExpr.JoinIn(synExpr1, _range, synExpr2, _range2) -> + List.tryPick walkExpr [synExpr1; synExpr2] + | SynExpr.NamedIndexedPropertySet(_longIdent, synExpr1, synExpr2, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.DotNamedIndexedPropertySet(synExpr1, _longIdent, synExpr2, synExpr3, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2; synExpr3] + + | SynExpr.TypeTest(synExpr, _synType, _range) + | SynExpr.Upcast(synExpr, _synType, _range) + | SynExpr.Downcast(synExpr, _synType, _range) -> + walkExpr synExpr + | SynExpr.InferredUpcast(synExpr, _range) + | SynExpr.InferredDowncast(synExpr, _range) -> + walkExpr synExpr + | SynExpr.AddressOf(_, synExpr, _range, _range2) -> + walkExpr synExpr + | SynExpr.TraitCall(_synTyparList, _synMemberSig, synExpr, _range) -> + walkExpr synExpr + + | SynExpr.Null(_range) + | SynExpr.ImplicitZero(_range) -> + None + + | SynExpr.YieldOrReturn(_, synExpr, _range) + | SynExpr.YieldOrReturnFrom(_, synExpr, _range) + | SynExpr.DoBang(synExpr, _range) -> + walkExpr synExpr + + | SynExpr.LetOrUseBang(_sequencePointInfoForBinding, _, _, _synPat, synExpr1, synExpr2, _range) -> + List.tryPick walkExpr [synExpr1; synExpr2] + + | SynExpr.LibraryOnlyILAssembly _ + | SynExpr.LibraryOnlyStaticOptimization _ + | SynExpr.LibraryOnlyUnionCaseFieldGet _ + | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> + None + | SynExpr.ArbitraryAfterError(_debugStr, _range) -> + None + + | SynExpr.FromParseError(synExpr, _range) + | SynExpr.DiscardAfterMissingQualificationAfterDot(synExpr, _range) -> + walkExpr synExpr + + | _ -> None + + match parsedInput with + | ParsedInput.SigFile _input -> + None + | ParsedInput.ImplFile input -> + walkImplFileInput input diff --git a/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs b/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs new file mode 100644 index 0000000000..d27835923f --- /dev/null +++ b/vsintegration/src/FSharp.Editor/CodeFix/ImplementInterfaceCodeFixProvider.fs @@ -0,0 +1,183 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace rec Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Composition +open System.Collections.Immutable +open System.Threading +open System.Threading.Tasks + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Formatting +open Microsoft.CodeAnalysis.Text +open Microsoft.CodeAnalysis.CodeFixes +open Microsoft.CodeAnalysis.CodeActions + +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.Parser +open Microsoft.FSharp.Compiler.Range +open Microsoft.FSharp.Compiler.SourceCodeServices + +[] +type internal InterfaceState = + { InterfaceData: InterfaceData + EndPosOfWith: pos option + Tokens: FSharpTokenInfo list } + +[] +type internal FSharpImplementInterfaceCodeFixProvider + [] + ( + checkerProvider: FSharpCheckerProvider, + projectInfoManager: ProjectInfoManager + ) = + inherit CodeFixProvider() + let fixableDiagnosticIds = ["FS0366"] + let checker = checkerProvider.Checker + + let queryInterfaceState (pos: pos) tokens (ast: Ast.ParsedInput) = + async { + let line = pos.Line - 1 + let column = pos.Column + match InterfaceStubGenerator.tryFindInterfaceDeclaration pos ast with + | None -> return None + | Some iface -> + let endPosOfWidth = + tokens + |> List.tryPick (fun (t: FSharpTokenInfo) -> + if t.CharClass = FSharpTokenCharKind.Keyword && t.LeftColumn >= column && t.TokenName = "WITH" then + Some (Pos.fromZ line (t.RightColumn + 1)) + else None) + return Some { InterfaceData = iface; EndPosOfWith = endPosOfWidth; Tokens = tokens } + } + + let getLineIdent (lineStr: string) = + lineStr.Length - lineStr.TrimStart(' ').Length + + let inferStartColumn indentSize state (sourceText: SourceText) = + match InterfaceStubGenerator.getMemberNameAndRanges state.InterfaceData with + | (_, range) :: _ -> + let lineStr = sourceText.Lines.[range.StartLine-1].ToString() + getLineIdent lineStr + | [] -> + match state.InterfaceData with + | InterfaceData.Interface _ as iface -> + // 'interface ISomething with' is often in a new line, we use the indentation of that line + let lineStr = sourceText.Lines.[iface.Range.StartLine-1].ToString() + getLineIdent lineStr + indentSize + | InterfaceData.ObjExpr _ as iface -> + state.Tokens + |> List.tryPick (fun (t: FSharpTokenInfo) -> + if t.CharClass = FSharpTokenCharKind.Keyword && t.TokenName = "NEW" then + Some (t.LeftColumn + indentSize) + else None) + // There is no reference point, we indent the content at the start column of the interface + |> Option.defaultValue iface.Range.StartColumn + + let handleImplementInterface (sourceText: SourceText) state displayContext implementedMemberSignatures entity indentSize verboseMode = + let startColumn = inferStartColumn indentSize state sourceText + let objectIdentifier = "this" + let defaultBody = "raise (System.NotImplementedException())" + let typeParams = state.InterfaceData.TypeParameters + let stub = + let stub = InterfaceStubGenerator.formatInterface + startColumn indentSize typeParams objectIdentifier defaultBody + displayContext implementedMemberSignatures entity verboseMode + stub.TrimEnd(Environment.NewLine.ToCharArray()) + match state.EndPosOfWith with + | Some pos -> + let currentPos = sourceText.Lines.[pos.Line-1].Start + pos.Column + TextChange(TextSpan(currentPos, 0), stub) + | None -> + let range = state.InterfaceData.Range + let currentPos = sourceText.Lines.[range.EndLine-1].Start + range.EndColumn + TextChange(TextSpan(currentPos, 0), " with" + stub) + + let registerSuggestions (context: CodeFixContext, results: FSharpCheckFileResults, state: InterfaceState, displayContext, entity, indentSize) = + if InterfaceStubGenerator.hasNoInterfaceMember entity then + () + else + let membersAndRanges = InterfaceStubGenerator.getMemberNameAndRanges state.InterfaceData + let interfaceMembers = InterfaceStubGenerator.getInterfaceMembers entity + let hasTypeCheckError = results.Errors |> Array.exists (fun e -> e.Severity = FSharpErrorSeverity.Error) + // This comparison is a bit expensive + if hasTypeCheckError && List.length membersAndRanges <> Seq.length interfaceMembers then + let diagnostics = (context.Diagnostics |> Seq.filter (fun x -> fixableDiagnosticIds |> List.contains x.Id)).ToImmutableArray() + let registerCodeFix title verboseMode = + let codeAction = + CodeAction.Create( + title, + (fun (cancellationToken: CancellationToken) -> + async { + let! sourceText = context.Document.GetTextAsync() |> Async.AwaitTask + let getMemberByLocation(name, range: range) = + let lineStr = sourceText.Lines.[range.EndLine-1].ToString() + results.GetSymbolUseAtLocation(range.EndLine, range.EndColumn, lineStr, [name]) + let! implementedMemberSignatures = + InterfaceStubGenerator.getImplementedMemberSignatures getMemberByLocation displayContext state.InterfaceData + let textChange = handleImplementInterface sourceText state displayContext implementedMemberSignatures entity indentSize verboseMode + return context.Document.WithText(sourceText.WithChanges textChange) + } |> CommonRoslynHelpers.StartAsyncAsTask(cancellationToken)), + title) + context.RegisterCodeFix(codeAction, diagnostics) + + registerCodeFix SR.ImplementInterface.Value true + registerCodeFix SR.ImplementInterfaceWithoutTypeAnnotation.Value false + else + () + + override __.FixableDiagnosticIds = fixableDiagnosticIds.ToImmutableArray() + + override __.RegisterCodeFixesAsync context : Task = + async { + match projectInfoManager.TryGetOptionsForEditingDocumentOrProject context.Document with + | Some options -> + let cancellationToken = context.CancellationToken + let! sourceText = context.Document.GetTextAsync(cancellationToken) |> Async.AwaitTask + let! textVersion = context.Document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask + let! parseResults, checkFileAnswer = checker.ParseAndCheckFileInProject(context.Document.FilePath, textVersion.GetHashCode(), sourceText.ToString(), options) + match parseResults.ParseTree, checkFileAnswer with + | None, _ + | _, FSharpCheckFileAnswer.Aborted -> () + | Some parsedInput, FSharpCheckFileAnswer.Succeeded checkFileResults -> + let textLine = sourceText.Lines.GetLineFromPosition context.Span.Start + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(context.Document.FilePath, options.OtherOptions |> Seq.toList) + // Notice that context.Span doesn't return reliable ranges to find tokens at exact positions. + // That's why we tokenize the line and try to find the last successive identifier token + let tokens = CommonHelpers.tokenizeLine(context.Document.Id, sourceText, context.Span.Start, context.Document.FilePath, defines) + let rec tryFindIdentifierToken acc tokens = + match tokens with + | t :: remainingTokens when t.Tag = FSharpTokenTag.Identifier -> + tryFindIdentifierToken (Some t) remainingTokens + | t :: remainingTokens when t.Tag = FSharpTokenTag.DOT || Option.isNone acc -> + tryFindIdentifierToken acc remainingTokens + | _ :: _ + | [] -> acc + match tryFindIdentifierToken None tokens with + | Some token -> + let fixupPosition = textLine.Start + token.RightColumn + let interfacePos = Pos.fromZ textLine.LineNumber token.RightColumn + let! interfaceState = queryInterfaceState interfacePos tokens parsedInput + let symbol = CommonHelpers.getSymbolAtPosition(context.Document.Id, sourceText, fixupPosition, context.Document.FilePath, defines, SymbolLookupKind.Fuzzy) + match interfaceState, symbol with + | Some state, Some symbol -> + let fcsTextLineNumber = textLine.LineNumber + 1 + let lineContents = textLine.ToString() + let! options = context.Document.GetOptionsAsync(cancellationToken) |> Async.AwaitTask + let tabSize = options.GetOption(FormattingOptions.TabSize, FSharpCommonConstants.FSharpLanguageName) + let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, symbol.RightColumn, lineContents, [symbol.Text]) + symbolUse + |> Option.bind (fun symbolUse -> + match symbolUse.Symbol with + | :? FSharpEntity as entity -> + if InterfaceStubGenerator.isInterface entity then + Some (entity, symbolUse.DisplayContext) + else None + | _ -> None) + |> Option.iter (fun (entity, displayContext) -> + registerSuggestions (context, checkFileResults, state, displayContext, entity, tabSize)) + | _ -> () + | None -> () + | None -> () + } |> CommonRoslynHelpers.StartAsyncUnitAsTask(context.CancellationToken) diff --git a/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs b/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs index 4ee9660ffe..311843e619 100644 --- a/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs @@ -315,40 +315,50 @@ module internal CommonHelpers = Text = lineStr.Substring(token.Token.LeftColumn, token.Token.FullMatchedLength) FileName = fileName }) - let getSymbolAtPosition(documentKey: DocumentId, sourceText: SourceText, position: int, fileName: string, defines: string list, lookupKind: SymbolLookupKind) : LexerSymbol option = - try - let textLine = sourceText.Lines.GetLineFromPosition(position) - let textLinePos = sourceText.Lines.GetLinePosition(position) - let lineNumber = textLinePos.Line + 1 // FCS line number - let sourceTokenizer = FSharpSourceTokenizer(defines, Some fileName) - let lines = sourceText.Lines - // We keep incremental data per-document. When text changes we correlate text line-by-line (by hash codes of lines) - let sourceTextData = dataCache.GetValue(documentKey, fun key -> SourceTextData(lines.Count)) - - // Go backwards to find the last cached scanned line that is valid - let scanStartLine = - let mutable i = lineNumber - while i > 0 && (match sourceTextData.[i-1] with Some data -> not (data.IsValid(lines.[i])) | None -> true) do - i <- i - 1 - i + let private getCachedSourceLineData(documentKey: DocumentId, sourceText: SourceText, position: int, fileName: string, defines: string list) = + let textLine = sourceText.Lines.GetLineFromPosition(position) + let textLinePos = sourceText.Lines.GetLinePosition(position) + let lineNumber = textLinePos.Line + 1 // FCS line number + let sourceTokenizer = FSharpSourceTokenizer(defines, Some fileName) + let lines = sourceText.Lines + // We keep incremental data per-document. When text changes we correlate text line-by-line (by hash codes of lines) + let sourceTextData = dataCache.GetValue(documentKey, fun key -> SourceTextData(lines.Count)) + + // Go backwards to find the last cached scanned line that is valid + let scanStartLine = + let mutable i = lineNumber + while i > 0 && (match sourceTextData.[i-1] with Some data -> not (data.IsValid(lines.[i])) | None -> true) do + i <- i - 1 + i - let lexState = if scanStartLine = 0 then 0L else sourceTextData.[scanStartLine - 1].Value.LexStateAtEndOfLine - let lineContents = textLine.Text.ToString(textLine.Span) + let lexState = if scanStartLine = 0 then 0L else sourceTextData.[scanStartLine - 1].Value.LexStateAtEndOfLine + let lineContents = textLine.Text.ToString(textLine.Span) + + // We can reuse the old data when + // 1. the line starts at the same overall position + // 2. the hash codes match + // 3. the start-of-line lex states are the same + match sourceTextData.[lineNumber] with + | Some data when data.IsValid(textLine) && data.LexStateAtStartOfLine = lexState -> + data, textLinePos, lineContents + | _ -> + // Otherwise, we recompute + let newData = scanSourceLine(sourceTokenizer, textLine, lineContents, lexState) + sourceTextData.[lineNumber] <- Some newData + newData, textLinePos, lineContents + + let tokenizeLine (documentKey, sourceText, position, fileName, defines) = + try + let lineData, _, _ = getCachedSourceLineData(documentKey, sourceText, position, fileName, defines) + lineData.Tokens + with + | ex -> + Assert.Exception(ex) + [] - let lineData = - // We can reuse the old data when - // 1. the line starts at the same overall position - // 2. the hash codes match - // 3. the start-of-line lex states are the same - match sourceTextData.[lineNumber] with - | Some data when data.IsValid(textLine) && data.LexStateAtStartOfLine = lexState -> - data - | _ -> - // Otherwise, we recompute - let newData = scanSourceLine(sourceTokenizer, textLine, lineContents, lexState) - sourceTextData.[lineNumber] <- Some newData - newData - + let getSymbolAtPosition(documentKey: DocumentId, sourceText: SourceText, position: int, fileName: string, defines: string list, lookupKind: SymbolLookupKind) : LexerSymbol option = + try + let lineData, textLinePos, lineContents = getCachedSourceLineData(documentKey, sourceText, position, fileName, defines) getSymbolFromTokens(fileName, lineData.Tokens, textLinePos, lineContents, lookupKind) with | :? System.OperationCanceledException -> reraise() diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index e993bd37e7..e10bcf8697 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -63,6 +63,7 @@ + diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.resx b/vsintegration/src/FSharp.Editor/FSharp.Editor.resx index 20aff78027..3a614a0db1 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.resx +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.resx @@ -120,6 +120,12 @@ Add 'new' keyword + + Implement interface explicitly + + + Implement interface explicitly without type annotation + Prefix value name with underscore diff --git a/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs b/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs index adb0de5696..f8c8dee5d8 100644 --- a/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs +++ b/vsintegration/src/FSharp.Editor/srFSharp.Editor.fs @@ -16,3 +16,5 @@ module SR = let AddNewKeyword = lazy ( GetString "AddNewKeyword" ) // "Add 'new' keyword" let PrefixValueNameWithUnderscore = lazy ( GetString "PrefixValueNameWithUnderscore" ) // "Prefix value name with underscore" let RenameValueToUnderscore = lazy ( GetString "RenameValueToUnderscore" ) // "Rename value to '_'" + let ImplementInterface = lazy ( GetString "ImplementInterface" ) + let ImplementInterfaceWithoutTypeAnnotation = lazy ( GetString "ImplementInterfaceWithoutTypeAnnotation" )