diff --git a/src/Microsoft.DotNet.Interactive.FSharp.Tests/KernelTests.fs b/src/Microsoft.DotNet.Interactive.FSharp.Tests/KernelTests.fs index 8a2cd7fcab..b721913fbb 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp.Tests/KernelTests.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp.Tests/KernelTests.fs @@ -1,4 +1,4 @@ -// Copyright (c) .NET Foundation and contributors. All rights reserved. +// Copyright (c) .NET Foundation and contributors. All rights reserved. // Licensed under the MIT license. See LICENSE file in the project root for full license information. namespace Microsoft.DotNet.Interactive.FSharp.Tests @@ -90,8 +90,8 @@ type KernelTests() = "let a = Math.Sin(10.0)" ] - // Math.Sin(a: float) : float - texts.Should().ContainAll(@"static member Sin", "a: float", "-> float") + // Math.Sin(a : float) : float + texts.Should().ContainAll(@"static member Sin", "a : float", "-> float") [] member __.``HoverText for Types``() = @@ -127,8 +127,8 @@ type KernelTests() = "let a = int 20.0" ] - // val inline int : value:'T -> int (requires member op_Explicit) - texts.Should().ContainAll("val inline int:", "^T (requires static member op_Explicit )", "-> int") + // val inline int : value : 'T -> int (requires member op_Explicit) + texts.Should().ContainAll("val inline int :", "^T (requires static member op_Explicit )", "-> int") [] member __.``Get completion list for List module then get the 'average' function and verify it has documentation``() = diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FSharpKernel.fs b/src/Microsoft.DotNet.Interactive.FSharp/FSharpKernel.fs index d5d5b8b907..60feab823e 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FSharpKernel.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FSharpKernel.fs @@ -206,15 +206,14 @@ type FSharpKernel () as this = let formattedDiagnostics = fsiDiagnostics - |> Array.map (fun d -> d.ToString()) - |> Array.map (fun text -> new FormattedValue(PlainTextFormatter.MimeType, text)) + |> Array.map (fun d -> new FormattedValue(PlainTextFormatter.MimeType, d.ToString())) context.Publish(DiagnosticsProduced(diagnostics, formattedDiagnostics, codeSubmission)) match result with | Ok(result) when not isError -> match result with - | Some(value) when value.ReflectionType <> typeof -> + | Some(value) when Type.(<>)(value.ReflectionType, typeof) -> let resultValue = value.ReflectionValue let formattedValues : IReadOnlyList = match resultValue with @@ -292,8 +291,17 @@ type FSharpKernel () as this = } match res.TryGetToolTipEnhanced (mkPos line col) lineContent with - | Result.Ok (Some (tip, signature, footer, typeDoc)) -> + | Result.Ok (Some result) -> + let (tip, signature, footer, typeDoc) = + result.ToolTipText, + result.Signature, + result.Footer, + (match result.SymbolInfo with + | TryGetToolTipEnhancedResult.Symbol sxa -> Some sxa.XmlDocSig + | TryGetToolTipEnhancedResult.Keyword kwd -> None) + let results = + FsAutoComplete.TipFormatter.formatTipEnhanced tip signature footer typeDoc FsAutoComplete.TipFormatter.FormatCommentStyle.Legacy @@ -302,7 +310,8 @@ type FSharpKernel () as this = // make footer look like in Ionide let newFooter = footer.Split([|'\n'|], StringSplitOptions.RemoveEmptyEntries) - |> Seq.map (fun line -> line.TrimEnd('\r')) + |> Seq.map (fun line -> line.Trim()) // Trim both ends to handle any whitespace + |> Seq.filter (String.IsNullOrWhiteSpace >> not) // Remove empty lines |> Seq.filter (fsiAssemblyRx.IsMatch >> not) |> Seq.map (sprintf "*%s*") |> String.concat "\n\n----\n" @@ -364,6 +373,162 @@ type FSharpKernel () as this = () } + let handleRequestSignatureHelp (requestSignatureHelp: RequestSignatureHelp) (context: KernelInvocationContext) = + let text = FSharp.Compiler.Text.SourceText.ofString requestSignatureHelp.Code + + // FCS uses 1-based line numbers + let line = requestSignatureHelp.LinePosition.Line + 1 + let col = requestSignatureHelp.LinePosition.Character + + let lineContent = text.GetLineString(line - 1) + + // Find the start of the current token by working backwards from cursor + let rec findTokenStart pos = + if pos <= 0 || pos > lineContent.Length then + min pos lineContent.Length |> max 0 + else + let c = lineContent.[pos - 1] + if Char.IsWhiteSpace(c) || c = '(' then pos + else findTokenStart (pos - 1) + + // Skip whitespace and opening parens backwards from a position + let rec skipWhitespaceAndParens pos = + if pos <= 0 then 0 + elif Char.IsWhiteSpace(lineContent.[pos - 1]) || lineContent.[pos - 1] = '(' then + skipWhitespaceAndParens (pos - 1) + else pos + + // Skip whitespace backwards from a position + let rec skipWhitespace pos = + if pos <= 0 then 0 + elif Char.IsWhiteSpace(lineContent.[pos - 1]) then skipWhitespace (pos - 1) + else pos + + // Find the start position of the function name (first token on the line) + let rec findFunctionName currentEnd = + if currentEnd <= 0 then 0 + else + let pos = skipWhitespace currentEnd + if pos = 0 then 0 + else + let start = findTokenStart pos + let checkPos = skipWhitespace start + if checkPos > 0 && lineContent.[checkPos - 1] <> '(' then + findFunctionName checkPos + else + start + + // Find the end position of a token starting from a given position + let rec findTokenEnd pos = + if pos >= lineContent.Length then lineContent.Length + elif Char.IsWhiteSpace(lineContent.[pos]) || lineContent.[pos] = '(' then pos + else findTokenEnd (pos + 1) + + // Extract function name by finding the first token on the line + let tokenEnd = skipWhitespaceAndParens (min col lineContent.Length) + let functionStartPos = findFunctionName tokenEnd + let functionName = + if functionStartPos < lineContent.Length then + let endPos = findTokenEnd functionStartPos + if endPos > functionStartPos then + lineContent.Substring(functionStartPos, endPos - functionStartPos).Trim() + else "" + else "" + + if not (String.IsNullOrWhiteSpace functionName) then + // Use F# Compiler Services to get signature information + // This works for both user-defined functions and BCL types + // Add common opens to help FCS resolve BCL types and make it a complete expression + let codeWithContext = + if requestSignatureHelp.Code.Contains "System." then + // Add open statement and make it a complete (but invalid) expression + // by adding a placeholder argument - FCS should still give us signature help + let placeholder = + if requestSignatureHelp.Code.EndsWith '(' then + "\"\")" // Close with a placeholder string argument + else + "" + sprintf "open System\n%s%s" requestSignatureHelp.Code placeholder + else + requestSignatureHelp.Code + let adjustedLine = if requestSignatureHelp.Code.Contains "System." then line + 1 else line + let parse, check, _ctx = script.Value.Fsi.ParseAndCheckInteraction codeWithContext + let res = FsAutoComplete.ParseAndCheckResults(parse, check, EntityCache()) + + match res.TryGetSignatureData (mkPos adjustedLine (functionStartPos + 1)) lineContent with + | Ok (returnType, parameterGroups, generics) -> + let functionDisplayName, documentation = + match res.TryGetSymbolUse (mkPos line (functionStartPos + 1)) lineContent with + | Some symbolUse -> + let displayName = symbolUse.Symbol.DisplayName + let xmlDoc = symbolUse.Symbol.XmlDoc + let doc = FsAutoComplete.TipFormatter.formatDocumentationFromXmlDoc xmlDoc + let docString = + match doc with + | FsAutoComplete.TipFormatter.TipFormatterResult.Success formatted -> formatted + | _ -> "" + (displayName, docString) + | None -> (functionName, "") + + let activeParameter = + let textBeforeCursor = lineContent.Substring(0, min col lineContent.Length) + let openParenIndex = textBeforeCursor.LastIndexOf '(' + let closeParenIndex = textBeforeCursor.LastIndexOf ')' + + if openParenIndex >= 0 && (closeParenIndex < 0 || openParenIndex > closeParenIndex) then + let textInParens = textBeforeCursor.Substring(openParenIndex + 1) + textInParens.Split(',').Length - 1 + else + let startPos = min functionStartPos textBeforeCursor.Length + let textAfterFunction = + if startPos < textBeforeCursor.Length then + textBeforeCursor.Substring(startPos).Trim() + else + "" + let tokens = textAfterFunction.Split([|' '; '\t'|], StringSplitOptions.RemoveEmptyEntries) + max 0 (tokens.Length - 1) + + let ids = parameterGroups |> List.collect id + let totalParams = ids |> List.length + let activeParameter = min activeParameter (totalParams - 1) |> max 0 + + let parameters = + ids + |> List.map (fun (name, paramType) -> + ParameterInformation( + label = sprintf "%s: %s" name paramType, + documentation = FormattedValue("text/markdown", ""))) + + let paramsFormatted = + parameterGroups + |> List.map (fun group -> + group + |> List.map (fun (name, paramType) -> sprintf $"{name}: {paramType}") + |> String.concat " * ") + |> String.concat " -> " + + let genericsFormatted = + if List.isEmpty generics then "" + else sprintf "<%s>" (String.concat ", " generics) + + let label = + if String.IsNullOrWhiteSpace paramsFormatted then + sprintf $"{functionDisplayName}{genericsFormatted} : {returnType}" + else + sprintf $"{functionDisplayName}{genericsFormatted} : {paramsFormatted} -> {returnType}" + + let signature = SignatureInformation( + label = label, + documentation = FormattedValue("text/markdown", documentation), + parameters = parameters) + + context.Publish(SignatureHelpProduced(requestSignatureHelp, [signature], activeSignatureIndex = 0, activeParameterIndex = activeParameter)) + Task.FromResult () + | Error _ -> + Task.FromResult () + else + Task.FromResult () + let handleRequestDiagnostics (requestDiagnostics: RequestDiagnostics) (context: KernelInvocationContext) = task { let _parseResults, checkFileResults, _checkProjectResults = script.Value.Fsi.ParseAndCheckInteraction(requestDiagnostics.Code) @@ -451,6 +616,9 @@ type FSharpKernel () as this = interface IKernelCommandHandler with member this.HandleAsync(command: RequestHoverText, context: KernelInvocationContext) = handleRequestHoverText command context + interface IKernelCommandHandler with + member this.HandleAsync(command: RequestSignatureHelp, context: KernelInvocationContext) = handleRequestSignatureHelp command context + interface IKernelCommandHandler with member this.HandleAsync(command: RequestValueInfos, context: KernelInvocationContext) = handleRequestValueValueInfos command context diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FSharpScriptHelpers.fs b/src/Microsoft.DotNet.Interactive.FSharp/FSharpScriptHelpers.fs index f338e4a8d4..2377ef5237 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FSharpScriptHelpers.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FSharpScriptHelpers.fs @@ -12,7 +12,7 @@ open FSharp.Compiler.Interactive.Shell open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -[] +[] type LangVersion = | V47 | V50 diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/DocumentationFormatter.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/DocumentationFormatter.fs index 352e761082..d60177ebf1 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/DocumentationFormatter.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/DocumentationFormatter.fs @@ -16,7 +16,22 @@ module DocumentationFormatter = let mutable lastDisplayContext: FSharpDisplayContext = FSharpDisplayContext.Empty - let emptyTypeTip = [||], [||], [||], [||], [||], [||] + type EntityInfo = + { Constructors: string array + Fields: string array + Functions: string array + Interfaces: string array + Attributes: string array + DeclaredTypes: string array } + + static member Empty = + + { Constructors = [||] + Fields = [||] + Functions = [||] + Interfaces = [||] + Attributes = [||] + DeclaredTypes = [||] } /// Concat two strings with a space between if both a and b are not IsNullOrWhiteSpace let internal (++) (a: string) (b: string) = @@ -35,6 +50,8 @@ module DocumentationFormatter = $"%s{name}", name.Length + let tag = Regex """<.*>""" + let rec formatType (displayContext: FSharpDisplayContext) (typ: FSharpType) : string * int = let combineParts (parts: (string * int) seq) : string * int = // make a single type name out of all of the tuple parts, since each part is correct by construction @@ -86,23 +103,18 @@ module DocumentationFormatter = // we set this context specifically because we want to enforce prefix-generic form on tooltip displays let newContext = displayContext.WithPrefixGenericParameters() let org = typ.Format newContext - let t = Regex.Replace(org, """<.*>""", "<") + let t = tag.Replace(org, "<") [ yield formatShowDocumentationLink t xmlDocSig assemblyName - if t.EndsWith "<" then + if t.EndsWith("<", StringComparison.Ordinal) then yield! renderedGenericArgumentTypes |> Seq.intersperse (", ", 2) yield formatShowDocumentationLink ">" xmlDocSig assemblyName ] |> combineParts elif typ.IsGenericParameter then - // generic parameters are either ^ or ' prefixed, depending on if they are inline or not - let name = - (if typ.GenericParameter.IsSolveAtCompileTime then - "^" - else - "'") - + typ.GenericParameter.Name + let prefix = if typ.GenericParameter.IsSolveAtCompileTime then "^" else "'" + let name = prefix + typ.GenericParameter.Name formatShowDocumentationLink name xmlDocSig assemblyName else if typ.HasTypeDefinition then @@ -119,8 +131,7 @@ module DocumentationFormatter = let formatGenericParameter includeMemberConstraintTypes displayContext (param: FSharpGenericParameter) = - let asGenericParamName (param: FSharpGenericParameter) = - (if param.IsSolveAtCompileTime then "^" else "'") + param.Name + let asGenericParamName (param: FSharpGenericParameter) = (if param.IsSolveAtCompileTime then "^" else "'") + param.Name let sb = StringBuilder() @@ -128,7 +139,7 @@ module DocumentationFormatter = let memberConstraint (c: FSharpGenericParameterMemberConstraint) = let formattedMemberName, isProperty = match c.IsProperty, PrettyNaming.TryChopPropertyName c.MemberName with - | true, Some (chopped) when chopped <> c.MemberName -> chopped, true + | true, Some(chopped) when chopped <> c.MemberName -> chopped, true | _, _ -> if PrettyNaming.IsLogicalOpName c.MemberName then PrettyNaming.ConvertValLogicalNameToDisplayNameCore c.MemberName, false @@ -159,11 +170,9 @@ module DocumentationFormatter = } |> String.concat "" - let typeConstraint (tc: FSharpType) = - sprintf ":> %s" (tc |> format displayContext |> fst) + let typeConstraint (tc: FSharpType) = sprintf ":> %s" (tc |> format displayContext |> fst) - let enumConstraint (ec: FSharpType) = - sprintf "enum<%s>" (ec |> format displayContext |> fst) + let enumConstraint (ec: FSharpType) = sprintf "enum<%s>" (ec |> format displayContext |> fst) let delegateConstraint (tc: FSharpGenericParameterDelegateConstraint) = sprintf @@ -206,12 +215,12 @@ module DocumentationFormatter = with :? InvalidOperationException -> p.DisplayName, p.DisplayName.Length - let getUnioncaseSignature displayContext (unionCase: FSharpUnionCase) = + let getUnionCaseSignature displayContext (unionCase: FSharpUnionCase) = if unionCase.Fields.Count > 0 then let typeList = unionCase.Fields |> Seq.map (fun unionField -> - if unionField.Name.StartsWith "Item" then //TODO: Some better way of detecting default names for the union cases' fields + if unionField.Name.StartsWith("Item", StringComparison.Ordinal) then //TODO: Some better way of detecting default names for the union cases' fields unionField.FieldType |> format displayContext |> fst else @@ -225,7 +234,7 @@ module DocumentationFormatter = unionCase.DisplayName let getFuncSignatureWithIdent displayContext (func: FSharpMemberOrFunctionOrValue) (ident: int) = - let maybeGetter = func.LogicalName.StartsWith "get_" + let maybeGetter = func.LogicalName.StartsWith("get_", StringComparison.Ordinal) let indent = String.replicate ident " " let functionName = @@ -237,7 +246,7 @@ module DocumentationFormatter = |> FSharpKeywords.NormalizeIdentifierBackticks elif func.IsOperatorOrActivePattern then func.DisplayName - elif func.DisplayName.StartsWith "( " then + elif func.DisplayName.StartsWith("( ", StringComparison.Ordinal) then FSharpKeywords.NormalizeIdentifierBackticks func.LogicalName else FSharpKeywords.NormalizeIdentifierBackticks func.DisplayName @@ -410,9 +419,12 @@ module DocumentationFormatter = "new" elif func.IsOperatorOrActivePattern then func.DisplayName - elif func.DisplayName.StartsWith "( " then + elif func.DisplayName.StartsWith("( ", StringComparison.Ordinal) then FSharpKeywords.NormalizeIdentifierBackticks func.LogicalName - elif func.LogicalName.StartsWith "get_" || func.LogicalName.StartsWith "set_" then + elif + func.LogicalName.StartsWith("get_", StringComparison.Ordinal) + || func.LogicalName.StartsWith("set_", StringComparison.Ordinal) + then PrettyNaming.TryChopPropertyName func.DisplayName |> Option.defaultValue func.DisplayName else @@ -477,8 +489,7 @@ module DocumentationFormatter = with _ -> "Unknown" - let formatName (parameter: FSharpParameter) = - parameter.Name |> Option.defaultValue parameter.DisplayName + let formatName (parameter: FSharpParameter) = parameter.Name |> Option.defaultValue parameter.DisplayName let isDelegate = match func.EnclosingEntitySafe with @@ -531,7 +542,7 @@ module DocumentationFormatter = let prefix = if v.IsMutable then "val mutable" else "val" let name = - (if v.DisplayName.StartsWith "( " then + (if v.DisplayName.StartsWith("( ", StringComparison.Ordinal) then v.LogicalName else v.DisplayName) @@ -539,9 +550,9 @@ module DocumentationFormatter = let constraints = match v.FullTypeSafe with - | Some fulltype when fulltype.IsGenericParameter -> + | Some fullType when fullType.IsGenericParameter -> let formattedParam = - formatGenericParameter false displayContext fulltype.GenericParameter + formatGenericParameter false displayContext fullType.GenericParameter if String.IsNullOrWhiteSpace formattedParam then None @@ -579,7 +590,7 @@ module DocumentationFormatter = sprintf "active pattern %s: %s" apc.Name findVal - let getAttributeSignature displayContext (attr: FSharpAttribute) = + let getAttributeSignature (attr: FSharpAttribute) = let name = formatShowDocumentationLink attr.AttributeType.DisplayName @@ -610,7 +621,7 @@ module DocumentationFormatter = | _ when fse.IsInterface -> "interface" | _ -> "type" - let enumtip () = + let enumTip () = $" ={nl} |" ++ (fse.FSharpFields |> Seq.filter (fun f -> not f.IsCompilerGenerated) @@ -624,10 +635,10 @@ module DocumentationFormatter = | None -> field.Name) |> String.concat $"{nl} | ") - let uniontip () = + let unionTip () = $" ={nl} |" ++ (fse.UnionCases - |> Seq.map (getUnioncaseSignature displayContext) + |> Seq.map (getUnionCaseSignature displayContext) |> String.concat ($"{nl} | ")) let delegateTip () = @@ -638,7 +649,7 @@ module DocumentationFormatter = $" ={nl} delegate of{nl}{invokerSig}" let typeTip () = - let constrc = + let constructors = fse.MembersFunctionsAndValues |> Seq.filter (fun n -> n.IsConstructor && n.Accessibility.IsPublic) |> Seq.collect (fun f -> @@ -709,25 +720,30 @@ module DocumentationFormatter = |> Seq.map (fun inf -> fst (format displayContext inf)) |> Seq.toArray - let attrs = - fse.Attributes |> Seq.map (getAttributeSignature displayContext) |> Seq.toArray + let attrs = fse.Attributes |> Seq.map getAttributeSignature |> Seq.toArray let types = fse.NestedEntities - |> Seq.filter (fun ne -> + |> Seq.choose (fun ne -> let isCompilerGenerated = ne.Attributes |> Seq.tryFind (fun attribute -> attribute.AttributeType.CompiledName = "CompilerGeneratedAttribute") |> Option.isSome - not ne.IsNamespace && not isCompilerGenerated) - |> Seq.map (fun ne -> - (typeName ne) - ++ fst (formatShowDocumentationLink ne.DisplayName ne.XmlDocSig ne.Assembly.SimpleName)) + if not ne.IsNamespace && not isCompilerGenerated then + (typeName ne) + ++ fst (formatShowDocumentationLink ne.DisplayName ne.XmlDocSig ne.Assembly.SimpleName) + |> Some + else + None) |> Seq.toArray - - constrc, fields, funcs, interfaces, attrs, types + { Constructors = constructors + Fields = fields + Functions = funcs + Interfaces = interfaces + Attributes = attrs + DeclaredTypes = types } let typeDisplay = let name = @@ -761,11 +777,11 @@ module DocumentationFormatter = basicName if fse.IsFSharpUnion then - (typeDisplay + uniontip ()), typeTip () + (typeDisplay + unionTip ()), typeTip () elif fse.IsEnum then - (typeDisplay + enumtip ()), emptyTypeTip + (typeDisplay + enumTip ()), EntityInfo.Empty elif fse.IsDelegate then - (typeDisplay + delegateTip ()), emptyTypeTip + (typeDisplay + delegateTip ()), EntityInfo.Empty else typeDisplay, typeTip () @@ -773,7 +789,10 @@ module DocumentationFormatter = /// trims the leading 'Microsoft.' from the full name of the symbol member m.SafeFullName = - if m.FullName.StartsWith "Microsoft." && m.Assembly.SimpleName = "FSharp.Core" then + if + m.FullName.StartsWith("Microsoft.", StringComparison.Ordinal) + && m.Assembly.SimpleName = "FSharp.Core" + then m.FullName.Substring "Microsoft.".Length else m.FullName @@ -790,7 +809,7 @@ module DocumentationFormatter = sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" m.SafeFullName link m.Assembly.SimpleName - | SymbolUse.Entity (c, _) -> + | SymbolUse.Entity(c, _) -> match c.DeclaringEntity with | None -> sprintf "Full name: %s\nAssembly: %s" c.SafeFullName c.Assembly.SimpleName | Some e -> @@ -821,9 +840,9 @@ module DocumentationFormatter = match entity with | MemberFunctionOrValue m -> sprintf "Full name: %s\nAssembly: %s" m.SafeFullName m.Assembly.SimpleName - | EntityFromSymbol (c, _) -> sprintf "Full name: %s\nAssembly: %s" c.SafeFullName c.Assembly.SimpleName + | EntityFromSymbol(c, _) -> sprintf "Full name: %s\nAssembly: %s" c.SafeFullName c.Assembly.SimpleName - | Field (f, _) -> sprintf "Full name: %s\nAssembly: %s" f.SafeFullName f.Assembly.SimpleName + | Field(f, _) -> sprintf "Full name: %s\nAssembly: %s" f.SafeFullName f.Assembly.SimpleName | ActivePatternCase ap -> sprintf "Full name: %s\nAssembly: %s" ap.SafeFullName ap.Assembly.SimpleName @@ -850,19 +869,19 @@ module DocumentationFormatter = lastDisplayContext <- symbol.DisplayContext match symbol with - | SymbolUse.TypeAbbreviation (fse) -> + | SymbolUse.TypeAbbreviation(fse) -> try let parent = fse.GetAbbreviatedParent() match parent with - | FSharpEntity (ent, _, _) -> + | FSharpEntity(ent, _, _) -> let signature = getEntitySignature symbol.DisplayContext ent Some(signature, footerForType' parent, cn) | _ -> None with _ -> None - | SymbolUse.Entity (fse, _) -> + | SymbolUse.Entity(fse, _) -> try let signature = getEntitySignature symbol.DisplayContext fse Some(signature, footerForType symbol, cn) @@ -874,66 +893,60 @@ module DocumentationFormatter = | Some ent when ent.IsValueType || ent.IsEnum -> //ValueTypes let signature = getFuncSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | _ -> //ReferenceType constructor let signature = getFuncSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.Operator func -> let signature = getFuncSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.Pattern func -> //Active pattern or operator let signature = getFuncSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.Property prop -> let signature = getFuncSignature symbol.DisplayContext prop - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.ClosureOrNestedFunction func -> //represents a closure or nested function let signature = getFuncSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.Function func -> let signature = getFuncSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.Val func -> //val name : Type let signature = getValSignature symbol.DisplayContext func - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.Field fsf -> let signature = getFieldSignature symbol.DisplayContext fsf - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.UnionCase uc -> - let signature = getUnioncaseSignature symbol.DisplayContext uc - Some((signature, emptyTypeTip), footerForType symbol, cn) + let signature = getUnionCaseSignature symbol.DisplayContext uc + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.ActivePatternCase apc -> let signature = getAPCaseSignature symbol.DisplayContext apc - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.ActivePattern ap -> let signature = getFuncSignature symbol.DisplayContext ap - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | SymbolUse.GenericParameter gp -> let signature = - sprintf - "%s (requires %s)" - (if gp.IsSolveAtCompileTime then - "^" + gp.Name - else - "'" + gp.Name) - (formatGenericParameter false symbol.DisplayContext gp) + $"'%s{gp.Name} (requires %s{formatGenericParameter false symbol.DisplayContext gp})" - Some((signature, emptyTypeTip), footerForType symbol, cn) + Some((signature, EntityInfo.Empty), footerForType symbol, cn) | _ -> None @@ -943,7 +956,7 @@ module DocumentationFormatter = let cn = compiledNameType' symbol match symbol with - | EntityFromSymbol (fse, _) -> + | EntityFromSymbol(fse, _) -> try let signature = getEntitySignature lastDisplayContext fse Some(signature, footerForType' symbol, cn) @@ -955,57 +968,51 @@ module DocumentationFormatter = | Some ent when ent.IsValueType || ent.IsEnum -> //ValueTypes let signature = getFuncSignature lastDisplayContext func - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | _ -> //ReferenceType constructor let signature = getFuncSignature lastDisplayContext func - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | SymbolPatterns.Operator func -> let signature = getFuncSignature lastDisplayContext func - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | Property prop -> let signature = getFuncSignature lastDisplayContext prop - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | ClosureOrNestedFunction func -> //represents a closure or nested function let signature = getFuncSignature lastDisplayContext func - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | Function func -> let signature = getFuncSignature lastDisplayContext func - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | Val func -> //val name : Type let signature = getValSignature lastDisplayContext func - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) - | Field (fsf, _) -> + | Field(fsf, _) -> let signature = getFieldSignature lastDisplayContext fsf - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | UnionCase uc -> - let signature = getUnioncaseSignature lastDisplayContext uc - Some((signature, emptyTypeTip), footerForType' symbol, cn) + let signature = getUnionCaseSignature lastDisplayContext uc + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | ActivePatternCase apc -> let signature = getAPCaseSignature lastDisplayContext apc - Some((signature, emptyTypeTip), footerForType' symbol, cn) + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | GenericParameter gp -> let signature = - sprintf - "%s (requires %s)" - (if gp.IsSolveAtCompileTime then - "^" + gp.Name - else - "'" + gp.Name) - (formatGenericParameter false lastDisplayContext gp) - - Some((signature, emptyTypeTip), footerForType' symbol, cn) + $"'%s{gp.Name} (requires %s{formatGenericParameter false lastDisplayContext gp})" + + Some((signature, EntityInfo.Empty), footerForType' symbol, cn) | _ -> None diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/KeywordList.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/KeywordList.fs index 21dc8444f0..a5dd2b6506 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/KeywordList.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/KeywordList.fs @@ -27,13 +27,19 @@ module KeywordList = |> dict let hashDirectives = - [ "r", "References an assembly" - "load", "Reads a source file, compiles it, and runs it." + [ "r", "References an assembly or a nuget: package" + "load", "References a source .fsx script or .fs file, by compiling and running it." "I", "Specifies an assembly search path in quotation marks." "light", "Enables or disables lightweight syntax, for compatibility with other versions of ML" "if", "Supports conditional compilation" "else", "Supports conditional compilation" "endif", "Supports conditional compilation" "nowarn", "Disables a compiler warning or warnings" + "warnon", "Enables a compiler warning or warnings" + "quit", "exits the interactive session" + "time", "toggles whether to display performance information" "line", "Indicates the original source code line" ] |> dict + + let allKeywords: string list = + keywordDescriptions |> Seq.map ((|KeyValue|) >> fst) |> Seq.toList diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Lexer.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Lexer.fs index 62dd42e8d8..ba587f0a79 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Lexer.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Lexer.fs @@ -1,5 +1,6 @@ namespace FsAutoComplete +open System open FSharp.Compiler.Tokenization type SymbolKind = @@ -14,9 +15,9 @@ type SymbolKind = type LexerSymbol = { Kind: SymbolKind - Line: int - LeftColumn: int - RightColumn: int + Line: uint32 + LeftColumn: uint32 + RightColumn: uint32 Text: string } [] @@ -29,22 +30,44 @@ type SymbolLookupKind = type private DraftToken = { Kind: SymbolKind Token: FSharpTokenInfo - RightColumn: int } + RightColumn: uint32 } static member inline Create kind token = { Kind = kind Token = token - RightColumn = token.LeftColumn + token.FullMatchedLength - 1 } + RightColumn = uint32 (token.LeftColumn + token.FullMatchedLength - 1) } module Lexer = + + [] + let (|Define|_|) (a: string) = + if a.StartsWith("--define:", StringComparison.Ordinal) then + ValueSome(a.[9..]) + else + ValueNone + + [] + let (|LangVersion|_|) (a: string) = + if a.StartsWith("--langversion:", StringComparison.Ordinal) then + ValueSome(a.[14..]) + else + ValueNone + /// Return all tokens of current line let tokenizeLine (args: string[]) lineStr = - let defines = - args - |> Seq.choose (fun s -> if s.StartsWith "--define:" then Some s.[9..] else None) - |> Seq.toList + let defines, langVersion = + ((ResizeArray(), None), args) + ||> Array.fold (fun (defines, langVersion) arg -> + match arg with + | Define d -> + defines.Add(d) + defines, langVersion + | LangVersion v -> defines, Some(v) + | _ -> defines, langVersion) + + let sourceTokenizer = + FSharpSourceTokenizer(Seq.toList defines, Some "/tmp.fsx", langVersion, None) - let sourceTokenizer = FSharpSourceTokenizer(defines, Some "/tmp.fsx", None, None) let lineTokenizer = sourceTokenizer.CreateLineTokenizer lineStr let rec loop lexState acc = @@ -54,23 +77,17 @@ module Lexer = loop FSharpTokenizerLexState.Initial [] - let inline private isIdentifier t = - t.CharClass = FSharpTokenCharKind.Identifier + let inline private isIdentifier t = t.CharClass = FSharpTokenCharKind.Identifier - let inline private isOperator t = - t.CharClass = FSharpTokenCharKind.Operator + let inline private isOperator t = t.CharClass = FSharpTokenCharKind.Operator - let inline private isKeyword t = - t.ColorClass = FSharpTokenColorKind.Keyword + let inline private isKeyword t = t.ColorClass = FSharpTokenColorKind.Keyword - let inline private isPunctuation t = - t.ColorClass = FSharpTokenColorKind.Punctuation + let inline private isPunctuation t = t.ColorClass = FSharpTokenColorKind.Punctuation let inline private (|GenericTypeParameterPrefix|StaticallyResolvedTypeParameterPrefix|ActivePattern|Other|) - ( - (token: FSharpTokenInfo), - (lineStr: string) - ) = + ((token: FSharpTokenInfo), (lineStr: string)) + = if token.Tag = FSharpTokenTag.QUOTE then GenericTypeParameterPrefix elif token.Tag = FSharpTokenTag.INFIX_AT_HAT_OP then @@ -96,93 +113,90 @@ module Lexer = // Each of them has FullMatchedLength = 3. So, we take the first GREATER and skip the other two). // // Generic type parameters: we convert QUOTE + IDENT tokens into single IDENT token, altering its LeftColumn - // and FullMathedLength (for "'type" which is tokenized as (QUOTE, left=2) + (IDENT, left=3, length=4) + // and FullMethodLength (for "'type" which is tokenized as (QUOTE, left=2) + (IDENT, left=3, length=4) // we'll get (IDENT, left=2, length=5). // // Statically resolved type parameters: we convert INFIX_AT_HAT_OP + IDENT tokens into single IDENT token, altering its LeftColumn - // and FullMathedLength (for "^type" which is tokenized as (INFIX_AT_HAT_OP, left=2) + (IDENT, left=3, length=4) + // and FullMethodLength (for "^type" which is tokenized as (INFIX_AT_HAT_OP, left=2) + (IDENT, left=3, length=4) // we'll get (IDENT, left=2, length=5). let private fixTokens lineStr (tokens: FSharpTokenInfo list) = tokens |> List.fold - (fun (acc, (lastToken: DraftToken option)) token -> - match lastToken with - //Operator starting with . (like .>>) should be operator - | Some ({ Kind = SymbolKind.Dot } as lastToken) when - isOperator token && token.LeftColumn <= lastToken.RightColumn - -> - let mergedToken = - { lastToken.Token with - Tag = token.Tag - RightColumn = token.RightColumn } - - acc, - Some - { lastToken with - Token = mergedToken - Kind = SymbolKind.Operator } - | Some t when token.LeftColumn <= t.RightColumn -> acc, lastToken - | Some ({ Kind = SymbolKind.ActivePattern } as lastToken) when - token.Tag = FSharpTokenTag.BAR - || token.Tag = FSharpTokenTag.IDENT - || token.Tag = FSharpTokenTag.UNDERSCORE - -> - let mergedToken = - { lastToken.Token with - Tag = FSharpTokenTag.IDENT - RightColumn = token.RightColumn - FullMatchedLength = lastToken.Token.FullMatchedLength + token.FullMatchedLength } - - acc, - Some - { lastToken with - Token = mergedToken - RightColumn = lastToken.RightColumn + token.FullMatchedLength } - | _ -> - match token, lineStr with - | GenericTypeParameterPrefix -> acc, Some(DraftToken.Create GenericTypeParameter token) - | StaticallyResolvedTypeParameterPrefix -> - acc, Some(DraftToken.Create StaticallyResolvedTypeParameter token) - | ActivePattern -> acc, Some(DraftToken.Create ActivePattern token) - | Other -> - let draftToken = - match lastToken with - | Some { Kind = GenericTypeParameter | StaticallyResolvedTypeParameter as kind } when - isIdentifier token - -> - DraftToken.Create - kind - { token with - LeftColumn = token.LeftColumn - 1 - FullMatchedLength = token.FullMatchedLength + 1 } - | Some ({ Kind = SymbolKind.ActivePattern } as ap) when token.Tag = FSharpTokenTag.RPAREN -> - DraftToken.Create SymbolKind.Ident ap.Token - | Some ({ Kind = SymbolKind.Operator } as op) when token.Tag = FSharpTokenTag.RPAREN -> - DraftToken.Create SymbolKind.Operator op.Token - // ^ operator - | Some { Kind = SymbolKind.StaticallyResolvedTypeParameter } -> - { Kind = SymbolKind.Operator - RightColumn = token.RightColumn - 1 - Token = token } - | _ -> - let kind = - if isOperator token then Operator - elif isIdentifier token then Ident - elif isKeyword token then Keyword - elif isPunctuation token then Dot - else Other - - DraftToken.Create kind token - - draftToken :: acc, Some draftToken) - ([], None) + (fun (acc, (lastToken: DraftToken option)) token -> + match lastToken with + //Operator starting with . (like .>>) should be operator + | Some({ Kind = SymbolKind.Dot } as lastToken) when + isOperator token && token.LeftColumn <= int lastToken.RightColumn + -> + let mergedToken = + { lastToken.Token with + Tag = token.Tag + RightColumn = token.RightColumn } + + acc, + Some + { lastToken with + Token = mergedToken + Kind = SymbolKind.Operator } + | Some t when token.LeftColumn <= int t.RightColumn -> acc, lastToken + | Some({ Kind = SymbolKind.ActivePattern } as lastToken) when + token.Tag = FSharpTokenTag.BAR + || token.Tag = FSharpTokenTag.IDENT + || token.Tag = FSharpTokenTag.UNDERSCORE + -> + let mergedToken = + { lastToken.Token with + Tag = FSharpTokenTag.IDENT + RightColumn = token.RightColumn + FullMatchedLength = lastToken.Token.FullMatchedLength + token.FullMatchedLength } + + acc, + Some + { lastToken with + Token = mergedToken + RightColumn = lastToken.RightColumn + uint32 token.FullMatchedLength } + | _ -> + match token, lineStr with + | GenericTypeParameterPrefix -> acc, Some(DraftToken.Create GenericTypeParameter token) + | StaticallyResolvedTypeParameterPrefix -> acc, Some(DraftToken.Create StaticallyResolvedTypeParameter token) + | ActivePattern -> acc, Some(DraftToken.Create ActivePattern token) + | Other -> + let draftToken = + match lastToken with + | Some { Kind = GenericTypeParameter | StaticallyResolvedTypeParameter as kind } when isIdentifier token -> + DraftToken.Create + kind + { token with + LeftColumn = token.LeftColumn - 1 + FullMatchedLength = token.FullMatchedLength + 1 } + | Some({ Kind = SymbolKind.ActivePattern } as ap) when token.Tag = FSharpTokenTag.RPAREN -> + DraftToken.Create SymbolKind.Ident ap.Token + | Some({ Kind = SymbolKind.Operator } as op) when token.Tag = FSharpTokenTag.RPAREN -> + DraftToken.Create SymbolKind.Operator op.Token + // ^ operator + | Some { Kind = SymbolKind.StaticallyResolvedTypeParameter } -> + { Kind = SymbolKind.Operator + RightColumn = uint32 (token.RightColumn - 1) + Token = token } + | _ -> + let kind = + if isOperator token then Operator + elif isIdentifier token then Ident + elif isKeyword token then Keyword + elif isPunctuation token then Dot + else Other + + DraftToken.Create kind token + + draftToken :: acc, Some draftToken) + ([], None) |> fst // Returns symbol at a given position. let private getSymbolFromTokens (tokens: FSharpTokenInfo list) - line - col + (line: uint32) + (col: uint32) (lineStr: string) lookupKind : LexerSymbol option = @@ -194,11 +208,11 @@ module Lexer = | SymbolLookupKind.Simple | SymbolLookupKind.Fuzzy -> tokens - |> List.filter (fun x -> x.Token.LeftColumn <= col && x.RightColumn + 1 >= col) + |> List.filter (fun x -> x.Token.LeftColumn <= int col && x.RightColumn + 1u >= col) | SymbolLookupKind.ForCompletion -> tokens - |> List.filter (fun x -> x.Token.LeftColumn <= col && x.RightColumn >= col) - | SymbolLookupKind.ByLongIdent -> tokens |> List.filter (fun x -> x.Token.LeftColumn <= col) + |> List.filter (fun x -> x.Token.LeftColumn <= int col && x.RightColumn >= col) + | SymbolLookupKind.ByLongIdent -> tokens |> List.filter (fun x -> x.Token.LeftColumn <= int col) match lookupKind with | SymbolLookupKind.ByLongIdent -> @@ -211,8 +225,8 @@ module Lexer = if t2.Tag = FSharpTokenTag.DOT then tryFindStartColumn remainingTokens else - Some t1.LeftColumn - | { Kind = Ident; Token = t } :: _ -> Some t.LeftColumn + Some(uint32 t1.LeftColumn) + | { Kind = Ident; Token = t } :: _ -> Some(uint32 t.LeftColumn) | _ :: _ | [] -> None @@ -231,8 +245,8 @@ module Lexer = { Kind = Ident Line = line LeftColumn = leftCol - RightColumn = first.RightColumn + 1 - Text = lineStr.[leftCol .. first.RightColumn] }) + RightColumn = first.RightColumn + 1u + Text = lineStr.[int leftCol .. int first.RightColumn] }) | SymbolLookupKind.Fuzzy -> // Select IDENT token. If failed, select OPERATOR token. tokensUnderCursor @@ -243,13 +257,14 @@ module Lexer = | StaticallyResolvedTypeParameter | Keyword -> true | _ -> false) + // Gets the option if Some x, otherwise try to get another value |> Option.orElseWith (fun _ -> tokensUnderCursor |> List.tryFind (fun { DraftToken.Kind = k } -> k = Operator)) |> Option.map (fun token -> { Kind = token.Kind Line = line - LeftColumn = token.Token.LeftColumn - RightColumn = token.RightColumn + 1 + LeftColumn = uint32 token.Token.LeftColumn + RightColumn = token.RightColumn + 1u Text = lineStr.Substring(token.Token.LeftColumn, token.Token.FullMatchedLength) }) | SymbolLookupKind.ForCompletion | SymbolLookupKind.Simple -> @@ -258,16 +273,17 @@ module Lexer = |> Option.map (fun token -> { Kind = token.Kind Line = line - LeftColumn = token.Token.LeftColumn - RightColumn = token.RightColumn + 1 + LeftColumn = uint32 token.Token.LeftColumn + RightColumn = token.RightColumn + 1u Text = lineStr.Substring(token.Token.LeftColumn, token.Token.FullMatchedLength) }) - let getSymbol line col lineStr lookupKind (args: string[]) = + let getSymbol (line: uint32) (col: uint32) lineStr lookupKind (args: string[]) = let tokens = tokenizeLine args lineStr try getSymbolFromTokens tokens line col lineStr lookupKind with e -> + //LoggingService.LogInfo (sprintf "Getting lex symbols failed with %O" e) None let inline private tryGetLexerSymbolIslands sym = @@ -279,26 +295,25 @@ module Lexer = // (we look for full identifier in the backward direction, but only // for a short identifier forward - this means that when you hover // 'B' in 'A.B.C', you will get intellisense for 'A.B' module) - let findIdents col lineStr lookupType = + let findIdents (col: uint32) lineStr lookupType = if lineStr = "" then None else - getSymbol 0 col lineStr lookupType [||] |> Option.bind tryGetLexerSymbolIslands + getSymbol 0u col lineStr lookupType [||] |> Option.bind tryGetLexerSymbolIslands - let findLongIdents (col, lineStr) = - findIdents col lineStr SymbolLookupKind.Fuzzy + let findLongIdents (col, lineStr) = findIdents col lineStr SymbolLookupKind.Fuzzy - let findLongIdentsAndResidue (col, lineStr: string) = - let lineStr = lineStr.Substring(0, System.Math.Max(0, col)) + let findLongIdentsAndResidue (col: uint32, lineStr: string) = + let lineStr = lineStr.Substring(0, int col) - match getSymbol 0 col lineStr SymbolLookupKind.ByLongIdent [||] with + match getSymbol 0u col lineStr SymbolLookupKind.ByLongIdent [||] with | Some sym -> match sym.Text with | "" -> [], "" | text -> let res = text.Split '.' |> List.ofArray |> List.rev - if lineStr.[col - 1] = '.' then + if lineStr.[int col - 1] = '.' then res |> List.rev, "" else match res with diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/ParseAndCheckResults.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/ParseAndCheckResults.fs index 5a318fca75..8993456af4 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/ParseAndCheckResults.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/ParseAndCheckResults.fs @@ -1,5 +1,6 @@ namespace FsAutoComplete +open FsAutoComplete.UntypedAstUtils open FSharp.Compiler open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.EditorServices @@ -12,89 +13,129 @@ open Utils open FSharp.Compiler.Tokenization open FSharp.Compiler.Syntax +[] +module TryGetToolTipEnhancedResult = + + type SymbolInfo = + | Keyword of string + | Symbol of + {| XmlDocSig: string + Assembly: string |} + +type TryGetToolTipEnhancedResult = + { ToolTipText: ToolTipText + Signature: string + Footer: string + SymbolInfo: TryGetToolTipEnhancedResult.SymbolInfo } + type ParseAndCheckResults - ( - parseResults: FSharpParseFileResults, - checkResults: FSharpCheckFileResults, - entityCache: EntityCache - ) = + (parseResults: FSharpParseFileResults, checkResults: FSharpCheckFileResults, entityCache: EntityCache) = member __.TryGetToolTip (pos: Position) (lineStr: LineStr) = - match Lexer.findLongIdents (pos.Column, lineStr) with - | None -> ResultOrString.Error "Cannot find ident for tooltip" - | Some (col, identIsland) -> + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with + | None -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + | Some(col, identIsland) -> let identIsland = Array.toList identIsland // TODO: Display other tooltip types, for example for strings or comments where appropriate let tip = - checkResults.GetToolTip(pos.Line, col, lineStr, identIsland, FSharpTokenTag.Identifier) + checkResults.GetToolTip(pos.Line, int col, lineStr, identIsland, FSharpTokenTag.Identifier) match tip with - | ToolTipText (elems) when elems |> List.forall ((=) ToolTipElement.None) -> + | ToolTipText(elems) when elems |> List.forall ((=) ToolTipElement.None) -> match identIsland with | [ ident ] -> match KeywordList.keywordTooltips.TryGetValue ident with | true, tip -> Ok tip - | _ -> ResultOrString.Error "No tooltip information" - | _ -> ResultOrString.Error "No tooltip information" - | _ -> Ok(tip) + | _ -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + | _ -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + | _ -> Ok tip - member x.TryGetToolTipEnhanced (pos: Position) (lineStr: LineStr) = + member x.TryGetToolTipEnhanced (pos: Position) (lineStr: LineStr) : Result, string> = let (|EmptyTooltip|_|) (ToolTipText elems) = - match elems with - | [] -> Some() - | elems when elems |> List.forall ((=) ToolTipElement.None) -> Some() - | _ -> None - - match Lexer.findLongIdents (pos.Column, lineStr) with - | None -> Error "Cannot find ident for tooltip" - | Some (col, identIsland) -> - let identIsland = Array.toList identIsland - // TODO: Display other tooltip types, for example for strings or comments where appropriate - let tip = - checkResults.GetToolTip(pos.Line, col, lineStr, identIsland, FSharpTokenTag.Identifier) - - let symbol = - checkResults.GetSymbolUseAtLocation(pos.Line, col, lineStr, identIsland) - - match tip with - | EmptyTooltip when symbol.IsNone -> - match identIsland with - | [ ident ] -> + match elems with + | [] -> Some() + | elems when elems |> List.forall ((=) ToolTipElement.None) -> Some() + | _ -> None + + match Completion.atPos (pos, x.GetParseResults.ParseTree) with + | Completion.Context.StringLiteral -> Ok None + | Completion.Context.SynType + | Completion.Context.Unknown -> + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with + | None -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + | Some(col, identIsland) -> + let identIsland = Array.toList identIsland + // TODO: Display other tooltip types, for example for strings or comments where appropriate + let tip = + checkResults.GetToolTip(pos.Line, int col, lineStr, identIsland, FSharpTokenTag.Identifier) + + let symbol = + checkResults.GetSymbolUseAtLocation(pos.Line, int col, lineStr, identIsland) + + match tip with + | EmptyTooltip when symbol.IsNone -> + match identIsland with + | [ ident ] -> match KeywordList.keywordTooltips.TryGetValue ident with - | true, tip -> Ok(Some(tip, ident, "", None)) - | _ -> Error "No tooltip information" - | _ -> Error "No tooltip information" - | _ -> - match symbol with - | None -> Error "No tooltip information" - | Some symbol -> - - match SignatureFormatter.getTooltipDetailsFromSymbolUse symbol with - | None -> Error "No tooltip information" - | Some (signature, footer) -> - let typeDoc = - getTypeIfConstructor symbol.Symbol |> Option.map (fun n -> n.XmlDocSig) - - Ok(Some(tip, signature, footer, typeDoc)) + | true, tip -> + { ToolTipText = tip + Signature = ident + Footer = "" + SymbolInfo = TryGetToolTipEnhancedResult.Keyword ident } + |> Some |> Ok + | _ -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + + | _ -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + | _ -> + match symbol with + | None -> + Error $"Cannot find ident for tooltip: {pos.Column:column} in {lineStr:lineString}" + | Some symbol -> + + // Retrieve the FSharpSymbol instance so we can find the XmlDocSig + // This mimic, the behavior of the Info Panel on hover + // 1. If this is a concrete type it returns that type reference + // 2. If this a type alias, it returns the aliases type reference + let resolvedType = symbol.Symbol.GetAbbreviatedParent() + + match SignatureFormatter.getTooltipDetailsFromSymbolUse symbol with + | None -> + Error $"Cannot find tooltip for {symbol:symbol} ({pos.Column:column} in {lineStr:lineString})" + + | Some(signature, footer) -> + { ToolTipText = tip + Signature = signature + Footer = footer + SymbolInfo = + TryGetToolTipEnhancedResult.Symbol + {| XmlDocSig = resolvedType.XmlDocSig + Assembly = symbol.Symbol.Assembly.SimpleName |} } + |> Some |> Ok member __.TryGetFormattedDocumentation (pos: Position) (lineStr: LineStr) = - match Lexer.findLongIdents (pos.Column, lineStr) with + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with | None -> Error "Cannot find ident" - | Some (col, identIsland) -> + | Some(col, identIsland) -> let identIsland = Array.toList identIsland // TODO: Display other tooltip types, for example for strings or comments where appropriate let tip = - checkResults.GetToolTip(pos.Line, col, lineStr, identIsland, FSharpTokenTag.Identifier) + checkResults.GetToolTip(pos.Line, int col, lineStr, identIsland, FSharpTokenTag.Identifier) let symbol = - checkResults.GetSymbolUseAtLocation(pos.Line, col, lineStr, identIsland) + checkResults.GetSymbolUseAtLocation(pos.Line, int col, lineStr, identIsland) match tip with - | ToolTipText (elems) when elems |> List.forall ((=) ToolTipElement.None) && symbol.IsNone -> + | ToolTipText(elems) when elems |> List.forall ((=) ToolTipElement.None) && symbol.IsNone -> match identIsland with | [ ident ] -> match KeywordList.keywordTooltips.TryGetValue ident with - | true, tip -> Ok(Some tip, None, (ident, (DocumentationFormatter.emptyTypeTip)), "", "") + | true, tip -> Ok(Some tip, None, (ident, DocumentationFormatter.EntityInfo.Empty), "", "") | _ -> Error "No tooltip information" | _ -> Error "No documentation information" | _ -> @@ -103,7 +144,7 @@ type ParseAndCheckResults | Some symbol -> match DocumentationFormatter.getTooltipDetailsFromSymbolUse symbol with | None -> Error "No documentation information" - | Some (signature, footer, cn) -> + | Some(signature, footer, cn) -> match symbol with | SymbolUse.TypeAbbreviation symbol -> Ok( @@ -128,7 +169,7 @@ type ParseAndCheckResults if not check then match e.Symbol with - | FSharpEntity (_, abrvEnt, _) -> abrvEnt.XmlDocSig = xmlSig && abrvEnt.Assembly.SimpleName = assembly + | FSharpEntity(_, abrvEnt, _) -> abrvEnt.XmlDocSig = xmlSig && abrvEnt.Assembly.SimpleName = assembly | _ -> false else true) @@ -143,7 +184,7 @@ type ParseAndCheckResults if not check then match e.Symbol with - | FSharpEntity (_, abrvEnt, _) -> abrvEnt.XmlDocSig = xmlSig + | FSharpEntity(_, abrvEnt, _) -> abrvEnt.XmlDocSig = xmlSig | _ -> false else true) @@ -155,7 +196,7 @@ type ParseAndCheckResults entities |> List.tryPick (fun e -> match e.Symbol with - | FSharpEntity (ent, _, _) -> + | FSharpEntity(ent, _, _) -> match ent.MembersFunctionsAndValues |> Seq.tryFind (fun f -> f.XmlDocSig = xmlSig) with | Some e -> Some(e :> FSharpSymbol) | None -> @@ -169,52 +210,71 @@ type ParseAndCheckResults | Some symbol -> match DocumentationFormatter.getTooltipDetailsFromSymbol symbol with | None -> Error "No tooltip information" - | Some (signature, footer, cn) -> + | Some(signature, footer, cn) -> Ok(symbol.XmlDocSig, symbol.Assembly.FileName |> Option.defaultValue "", symbol.XmlDoc, signature, footer, cn) member __.TryGetSymbolUse (pos: Position) (lineStr: LineStr) : FSharpSymbolUse option = - match Lexer.findLongIdents (pos.Column, lineStr) with + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with | None -> None - | Some (colu, identIsland) -> + | Some(colu, identIsland) -> let identIsland = Array.toList identIsland - checkResults.GetSymbolUseAtLocation(pos.Line, colu, lineStr, identIsland) + checkResults.GetSymbolUseAtLocation(pos.Line, int colu, lineStr, identIsland) + + member x.TryGetSymbolUseFromIdent (sourceText: ISourceText) (ident: Ident) : FSharpSymbolUse option = + let line = sourceText.GetLineString(ident.idRange.EndLine - 1) + x.GetCheckResults.GetSymbolUseAtLocation(ident.idRange.EndLine, ident.idRange.EndColumn, line, [ ident.idText ]) + + member __.TryGetSymbolUses (pos: Position) (lineStr: LineStr) : FSharpSymbolUse list = + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with + | None -> [] + | Some(colu, identIsland) -> + let identIsland = Array.toList identIsland + checkResults.GetSymbolUsesAtLocation(pos.Line, int colu, lineStr, identIsland) member x.TryGetSymbolUseAndUsages (pos: Position) (lineStr: LineStr) = - let symboluse = x.TryGetSymbolUse pos lineStr + let symbolUse = x.TryGetSymbolUse pos lineStr - match symboluse with + match symbolUse with | None -> ResultOrString.Error "No symbol information found" - | Some symboluse -> - let symboluses = checkResults.GetUsesOfSymbolInFile symboluse.Symbol - Ok(symboluse, symboluses) + | Some symbolUse -> + let symbolUses = checkResults.GetUsesOfSymbolInFile symbolUse.Symbol + Ok(symbolUse, symbolUses) member __.TryGetSignatureData (pos: Position) (lineStr: LineStr) = - match Lexer.findLongIdents (pos.Column, lineStr) with + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with | None -> ResultOrString.Error "No ident at this location" - | Some (colu, identIsland) -> + | Some(colu, identIsland) -> let identIsland = Array.toList identIsland - let symboluse = - checkResults.GetSymbolUseAtLocation(pos.Line, colu, lineStr, identIsland) + let symbolUse = + checkResults.GetSymbolUseAtLocation(pos.Line, int colu, lineStr, identIsland) - match symboluse with + match symbolUse with | None -> ResultOrString.Error "No symbol information found" - | Some symboluse -> - let fsym = symboluse.Symbol + | Some symbolUse -> + let fsym = symbolUse.Symbol match fsym with | :? FSharpMemberOrFunctionOrValue as symbol -> let typ = - symbol.ReturnParameter.Type.Format(symboluse.DisplayContext.WithPrefixGenericParameters()) + symbol.ReturnParameter.Type.Format(symbolUse.DisplayContext.WithPrefixGenericParameters()) if symbol.IsPropertyGetterMethod then Ok(typ, [], []) else + let symbol = + // Symbol is a property with both get and set. + // Take the setter symbol in this case. + if symbol.HasGetterMethod && symbol.HasSetterMethod then + symbol.SetterMethod + else + symbol + let parms = symbol.CurriedParameterGroups |> Seq.map ( - Seq.map (fun p -> p.DisplayName, p.Type.Format(symboluse.DisplayContext.WithPrefixGenericParameters())) + Seq.map (fun p -> p.DisplayName, p.Type.Format(symbolUse.DisplayContext.WithPrefixGenericParameters())) >> Seq.toList ) |> Seq.toList @@ -228,22 +288,103 @@ type ParseAndCheckResults Ok(typ, [ [ ("unit", "unit") ] ], []) | _ -> Ok(typ, parms, generics) | :? FSharpField as symbol -> - let typ = symbol.FieldType.Format symboluse.DisplayContext + let typ = symbol.FieldType.Format symbolUse.DisplayContext Ok(typ, [], []) | _ -> ResultOrString.Error "Not a member, function or value" member __.TryGetF1Help (pos: Position) (lineStr: LineStr) = - match Lexer.findLongIdents (pos.Column, lineStr) with + match Lexer.findLongIdents (uint32 pos.Column, lineStr) with | None -> ResultOrString.Error "No ident at this location" - | Some (colu, identIsland) -> + | Some(colu, identIsland) -> let identIsland = Array.toList identIsland - let help = checkResults.GetF1Keyword(pos.Line, colu, lineStr, identIsland) + let help = checkResults.GetF1Keyword(pos.Line, int colu, lineStr, identIsland) match help with | None -> ResultOrString.Error "No symbol information found" | Some hlp -> Ok hlp + member x.TryGetCompletions (pos: Position) (lineStr: LineStr) (getAllSymbols: unit -> AssemblySymbol list) = + async { + let completionContext = Completion.atPos (pos, x.GetParseResults.ParseTree) + + match completionContext with + | Completion.Context.StringLiteral -> return None + | Completion.Context.Unknown + | Completion.Context.SynType -> + try + let longName = QuickParse.GetPartialLongNameEx(lineStr, pos.Column - 1) + + let getSymbols () = + [ for assemblySymbol in getAllSymbols () do + if + assemblySymbol.FullName.Contains(".") + && not (PrettyNaming.IsOperatorDisplayName assemblySymbol.Symbol.DisplayName) + then + yield assemblySymbol ] + + let fcsCompletionContext = + ParsedInput.TryGetCompletionContext(pos, x.GetParseResults.ParseTree, lineStr) + + let results = + checkResults.GetDeclarationListInfo( + Some parseResults, + pos.Line, + lineStr, + longName, + getAllEntities = getSymbols, + completionContextAtPos = (pos, fcsCompletionContext) + ) + + let getKindPriority kind = + match kind with + | CompletionItemKind.SuggestedName + | CompletionItemKind.CustomOperation -> 0 + | CompletionItemKind.Property -> 1 + | CompletionItemKind.Field -> 2 + | CompletionItemKind.Method(isExtension = false) -> 3 + | CompletionItemKind.Event -> 4 + | CompletionItemKind.Argument -> 5 + | CompletionItemKind.Other -> 6 + | CompletionItemKind.Method(isExtension = true) -> 7 + + Array.sortInPlaceWith + (fun (x: DeclarationListItem) (y: DeclarationListItem) -> + let mutable n = (not x.IsResolved).CompareTo(not y.IsResolved) + + if n <> 0 then + n + else + n <- (getKindPriority x.Kind).CompareTo(getKindPriority y.Kind) + + if n <> 0 then + n + else + n <- (not x.IsOwnMember).CompareTo(not y.IsOwnMember) + + if n <> 0 then + n + else + n <- String.Compare(x.NameInList, y.NameInList, StringComparison.OrdinalIgnoreCase) + + if n <> 0 then + n + else + x.MinorPriority.CompareTo(y.MinorPriority)) + results.Items + + + let shouldKeywords = + results.Items.Length > 0 + && not results.IsForType + && not results.IsError + && List.isEmpty longName.QualifyingIdents + + return Some(results.Items, longName.PartialIdent, shouldKeywords) + with :? TimeoutException -> + return None + } + member __.GetAllEntities(publicOnly: bool) : AssemblySymbol list = try let res = @@ -273,10 +414,10 @@ type ParseAndCheckResults with _ -> [] - member __.GetAllSymbolUsesInFile() = - checkResults.GetAllUsesOfAllSymbolsInFile() + member __.GetAllSymbolUsesInFile() = checkResults.GetAllUsesOfAllSymbolsInFile() member __.GetSemanticClassification = checkResults.GetSemanticClassification None member __.GetAST = parseResults.ParseTree member __.GetCheckResults: FSharpCheckFileResults = checkResults member __.GetParseResults: FSharpParseFileResults = parseResults + member __.FileName: string = Utils.normalizePath parseResults.FileName diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/SignatureFormatter.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/SignatureFormatter.fs index 5e63f542a7..d378527d4f 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/SignatureFormatter.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/SignatureFormatter.fs @@ -38,8 +38,74 @@ module SignatureFormatter = "Microsoft.FSharp.Core.CompilerServices.MeasureInverse`1" "Microsoft.FSharp.Core.CompilerServices.MeasureProduct`2" ] - let private isMeasureType (t: FSharpEntity) = - Set.contains t.FullName measureTypeNames + let private isMeasureType (t: FSharpEntity) = Set.contains t.FullName measureTypeNames + + type ParameterType = + | Generic of FSharpGenericParameter + | WithGenericArguments of FSharpType + | Concrete of FSharpEntity + | Function of ParameterType list + | Tuple of ParameterType list + | StructTuple of ParameterType list + + static member displayName = + function + | Generic x -> (if x.IsSolveAtCompileTime then "^" else "'") + x.DisplayName + | WithGenericArguments x -> + let parameters = + x.GenericArguments + |> Seq.map (ParameterType.getParameterType >> ParameterType.displayName) + |> String.join ", " + + let displayName = x.TypeDefinition.DisplayName + + displayName + "<" + parameters + ">" + | Concrete x -> x.DisplayName + | Function x -> x |> List.map ParameterType.displayName |> String.join " -> " + | Tuple x -> + let args = x |> List.map ParameterType.displayName |> String.join " * " + $"({args})" + | StructTuple x -> + let args = x |> List.map ParameterType.displayName |> String.join " * " + $"struct ({args})" + + static member displayNameUnAnnotated = + function + | Generic x -> (if x.IsSolveAtCompileTime then "^" else "'") + x.DisplayName + | WithGenericArguments x -> + let parameters = + x.GenericArguments + |> Seq.map (ParameterType.getParameterType >> ParameterType.displayNameUnAnnotated) + |> String.join ", " + + let displayName = x.TypeDefinition.UnAnnotate().DisplayName + + displayName + "<" + parameters + ">" + | Concrete x -> x.UnAnnotate().DisplayName + | Function x -> x |> List.map ParameterType.displayNameUnAnnotated |> String.join " -> " + | Tuple x -> + let args = x |> List.map ParameterType.displayNameUnAnnotated |> String.join " * " + $"({args})" + | StructTuple x -> + let args = x |> List.map ParameterType.displayNameUnAnnotated |> String.join " * " + $"struct ({args})" + + static member getParameterType(x: FSharpType) : ParameterType = + if x.IsFunctionType then + Function(ParameterType.getGenericArgumentTypes x) + else if x.IsGenericParameter then + Generic x.GenericParameter + else if x.IsStructTupleType then + StructTuple(ParameterType.getGenericArgumentTypes x) + else if x.IsTupleType then + Tuple(ParameterType.getGenericArgumentTypes x) + else if x.GenericArguments.Count > 0 then + WithGenericArguments x + else + x.TypeDefinition |> Concrete + + static member getGenericArgumentTypes(e: FSharpType) : ParameterType list = + e.GenericArguments |> Seq.map ParameterType.getParameterType |> Seq.toList let rec formatFSharpType (context: FSharpDisplayContext) (typ: FSharpType) : string = let context = context.WithPrefixGenericParameters() @@ -59,6 +125,11 @@ module SignatureFormatter = sprintf "struct (%s)" refTupleStr else refTupleStr + elif typ.IsAbbreviation && typ.AbbreviatedType.IsFunctionType then + typ.AbbreviatedType + |> ParameterType.getGenericArgumentTypes + |> List.map ParameterType.displayName + |> String.join " -> " elif typ.IsGenericParameter then (if typ.GenericParameter.IsSolveAtCompileTime then "^" @@ -89,8 +160,7 @@ module SignatureFormatter = let formatGenericParameter includeMemberConstraintTypes displayContext (param: FSharpGenericParameter) = - let asGenericParamName (param: FSharpGenericParameter) = - (if param.IsSolveAtCompileTime then "^" else "'") + param.Name + let asGenericParamName (param: FSharpGenericParameter) = (if param.IsSolveAtCompileTime then "^" else "'") + param.Name let sb = StringBuilder() @@ -98,7 +168,7 @@ module SignatureFormatter = let memberConstraint (c: FSharpGenericParameterMemberConstraint) = let formattedMemberName, isProperty = match c.IsProperty, PrettyNaming.TryChopPropertyName c.MemberName with - | true, Some (chopped) when chopped <> c.MemberName -> chopped, true + | true, Some(chopped) when chopped <> c.MemberName -> chopped, true | _, _ -> if PrettyNaming.IsLogicalOpName c.MemberName then $"( {PrettyNaming.ConvertValLogicalNameToDisplayNameCore c.MemberName} )", false @@ -129,11 +199,9 @@ module SignatureFormatter = } |> String.concat "" - let typeConstraint (tc: FSharpType) = - sprintf ":> %s" (formatFSharpType displayContext tc) + let typeConstraint (tc: FSharpType) = sprintf ":> %s" (formatFSharpType displayContext tc) - let enumConstraint (ec: FSharpType) = - sprintf "enum<%s>" (formatFSharpType displayContext ec) + let enumConstraint (ec: FSharpType) = sprintf "enum<%s>" (formatFSharpType displayContext ec) let delegateConstraint (tc: FSharpGenericParameterDelegateConstraint) = sprintf @@ -170,15 +238,15 @@ module SignatureFormatter = sb.ToString() - let getUnioncaseSignature (displayContext: FSharpDisplayContext) (unionCase: FSharpUnionCase) = + let getUnionCaseSignature (displayContext: FSharpDisplayContext) (unionCase: FSharpUnionCase) = if unionCase.Fields.Count > 0 then let typeList = unionCase.Fields |> Seq.map (fun unionField -> - if unionField.Name.StartsWith "Item" then //TODO: Some better way of dettecting default names for the union cases' fields + if unionField.Name.StartsWith("Item", StringComparison.Ordinal) then //TODO: Some better way of detecting default names for the union cases' fields formatFSharpType displayContext unionField.FieldType else - unionField.Name ++ ":" ++ (formatFSharpType displayContext unionField.FieldType)) + unionField.Name + ":" ++ (formatFSharpType displayContext unionField.FieldType)) |> String.concat " * " unionCase.DisplayName + " of " + typeList @@ -186,7 +254,7 @@ module SignatureFormatter = unionCase.DisplayName let getFuncSignatureWithIdent displayContext (func: FSharpMemberOrFunctionOrValue) (ident: int) = - let maybeGetter = func.LogicalName.StartsWith "get_" + let maybeGetter = func.LogicalName.StartsWith("get_", StringComparison.Ordinal) let indent = String.replicate ident " " let functionName = @@ -198,7 +266,7 @@ module SignatureFormatter = |> FSharpKeywords.NormalizeIdentifierBackticks elif func.IsOperatorOrActivePattern then $"( {func.DisplayNameCore} )" - elif func.DisplayName.StartsWith "( " then + elif func.DisplayName.StartsWith("( ", StringComparison.Ordinal) then FSharpKeywords.NormalizeIdentifierBackticks func.LogicalName else FSharpKeywords.NormalizeIdentifierBackticks func.DisplayName @@ -213,7 +281,7 @@ module SignatureFormatter = | _ -> "" let modifier = - //F# types are prefixed with new, should non F# types be too for consistancy? + //F# types are prefixed with new, should non F# types be too for consistency? if func.IsConstructor then match func.EnclosingEntitySafe with | Some ent -> @@ -257,21 +325,34 @@ module SignatureFormatter = "Unknown" let retTypeConstraint = - if func.ReturnParameter.Type.IsGenericParameter then - let formattedParam = - formatGenericParameter false displayContext func.ReturnParameter.Type.GenericParameter + let genericParamConstraints = ResizeArray() - if String.IsNullOrWhiteSpace formattedParam then - formattedParam + let rec getGenericParameters (f: FSharpType) = + if f.IsGenericParameter then + let formattedParam = formatGenericParameter false displayContext f.GenericParameter + + if not <| String.IsNullOrWhiteSpace formattedParam then + genericParamConstraints.Add formattedParam else - "(requires " + formattedParam + " )" - else + try + f.GenericArguments |> Seq.iter getGenericParameters + with e -> + () // Sometimes GenericArguments throws an exception when accessing it + + getGenericParameters func.ReturnParameter.Type + + if Seq.isEmpty genericParamConstraints then "" + else + let formattedParam = genericParamConstraints |> String.join " and " |> _.Trim() + "(requires " + formattedParam + ")" let safeParameterName (p: FSharpParameter) = match Option.defaultValue p.DisplayNameCore p.Name with | "" -> "" - | name -> FSharpKeywords.NormalizeIdentifierBackticks name + | name -> + let n = FSharpKeywords.NormalizeIdentifierBackticks name + if p.IsOptionalArg then "?" + n else n // render optional args as "?ident: type" let padLength = let allLengths = @@ -283,7 +364,10 @@ module SignatureFormatter = let formatName indent padding (parameter: FSharpParameter) = let name = safeParameterName parameter - indent + name.PadRight padding + ":" + + match name with + | "" -> indent + " ".PadRight padding + | _ -> indent + name.PadRight padding + ":" let isDelegate = match func.EnclosingEntitySafe with @@ -296,6 +380,8 @@ module SignatureFormatter = if p.Type.IsFunctionType then $"({formatted})" + else if p.IsOptionalArg && formatted.StartsWith("option<", StringComparison.Ordinal) then // render optional args as "?ident: type" + formatted.AsSpan(7, formatted.Length - 8).ToString() else formatted with :? InvalidOperationException -> @@ -315,8 +401,11 @@ module SignatureFormatter = retType //A ctor with () parameters seems to be a list with an empty list. // Also abstract members and abstract member overrides with one () parameter seem to be a list with an empty list. - elif func.IsConstructor || (func.IsMember && (not func.IsPropertyGetterMethod)) then - modifiers + ": unit -> " ++ retType + elif func.IsConstructor then + let retType = if retType = "unit" then func.DisplayNameCore else retType + modifiers + ": unit ->" ++ retType + elif func.IsMember && (not func.IsPropertyGetterMethod) then + modifiers + ": unit ->" ++ retType else modifiers ++ functionName + ":" ++ retType //Value members seems to be a list with an empty list | [ [ p ] ] when maybeGetter && formatParameter p = "unit" -> //Member or property with only getter @@ -382,9 +471,12 @@ module SignatureFormatter = "new" elif func.IsOperatorOrActivePattern then func.DisplayName - elif func.DisplayName.StartsWith "( " then + elif func.DisplayName.StartsWith("( ", StringComparison.Ordinal) then FSharpKeywords.NormalizeIdentifierBackticks func.LogicalName - elif func.LogicalName.StartsWith "get_" || func.LogicalName.StartsWith "set_" then + elif + func.LogicalName.StartsWith("get_", StringComparison.Ordinal) + || func.LogicalName.StartsWith("set_", StringComparison.Ordinal) + then PrettyNaming.TryChopPropertyName func.DisplayName |> Option.defaultValue func.DisplayName else @@ -449,8 +541,7 @@ module SignatureFormatter = with _ -> "Unknown" - let formatName (parameter: FSharpParameter) = - parameter.Name |> Option.defaultValue parameter.DisplayName + let formatName (parameter: FSharpParameter) = parameter.Name |> Option.defaultValue parameter.DisplayName let isDelegate = match func.EnclosingEntitySafe with @@ -490,9 +581,15 @@ module SignatureFormatter = many |> List.map (fun (paramTypes) -> paramTypes - |> List.map (fun p -> formatName p + ":" ++ (formatParameter p)) + |> List.map (fun p -> + let paramName = formatName p + + if String.IsNullOrWhiteSpace(paramName) then + formatParameter p + else + paramName + ":" ++ (formatParameter p)) |> String.concat (" * ")) - |> String.concat ("-> ") + |> String.concat (" -> ") let typeArguments = allParams ++ "->" ++ retType @@ -521,7 +618,7 @@ module SignatureFormatter = let prefix = if v.IsMutable then "val mutable" else "val" let name = - (if v.DisplayName.StartsWith "( " then + (if v.DisplayName.StartsWith("( ", StringComparison.Ordinal) then v.LogicalName else v.DisplayName) @@ -529,9 +626,9 @@ module SignatureFormatter = let constraints = match v.FullTypeSafe with - | Some fulltype when fulltype.IsGenericParameter -> + | Some fullType when fullType.IsGenericParameter -> let formattedParam = - formatGenericParameter false displayContext fulltype.GenericParameter + formatGenericParameter false displayContext fullType.GenericParameter if String.IsNullOrWhiteSpace formattedParam then None @@ -540,8 +637,8 @@ module SignatureFormatter = | _ -> None match constraints with - | Some constraints -> prefix ++ name ++ ":" ++ constraints - | None -> prefix ++ name ++ ":" ++ retType + | Some constraints -> prefix ++ name + ":" ++ constraints + | None -> prefix ++ name + ":" ++ retType let getFieldSignature displayContext (field: FSharpField) = let retType = formatFSharpType displayContext field.FieldType @@ -555,10 +652,12 @@ module SignatureFormatter = let getAPCaseSignature displayContext (apc: FSharpActivePatternCase) = let findVal = + let apcSearchString = $"|{apc.DisplayName}|" + apc.Group.DeclaringEntity |> Option.bind (fun ent -> ent.MembersFunctionsAndValues - |> Seq.tryFind (fun func -> func.DisplayName.Contains apc.DisplayName) + |> Seq.tryFind (fun func -> func.DisplayName.Contains(apcSearchString, StringComparison.OrdinalIgnoreCase)) |> Option.map (getFuncSignature displayContext)) |> Option.bind (fun n -> try @@ -587,20 +686,22 @@ module SignatureFormatter = | _ when fse.IsInterface -> "interface" | _ -> "type" - let enumtip () = + let enumTip () = $" ={nl} |" ++ (fse.FSharpFields - |> Seq.filter (fun f -> not f.IsCompilerGenerated) - |> Seq.map (fun field -> - match field.LiteralValue with - | Some lv -> field.Name + " = " + (string lv) - | None -> field.Name) + |> Seq.choose (fun field -> + if field.IsCompilerGenerated then + None + else + match field.LiteralValue with + | Some lv -> field.Name + " = " + (string lv) |> Some + | None -> Some field.Name) |> String.concat $"{nl} | ") - let uniontip () = + let unionTip () = $" ={nl} |" ++ (fse.UnionCases - |> Seq.map (getUnioncaseSignature displayContext) + |> Seq.map (getUnionCaseSignature displayContext) |> String.concat $"{nl} | ") let delegateTip () = @@ -611,15 +712,15 @@ module SignatureFormatter = $" ={nl} delegate of{nl}{invokerSig}" let typeTip () = - let constrc = + let constructors = fse.MembersFunctionsAndValues |> Seq.filter (fun n -> n.IsConstructor && n.Accessibility.IsPublic) |> fun v -> - match Seq.tryHead v with - | None -> "" - | Some f -> - let l = Seq.length v - getFuncSignatureForTypeSignature displayContext f l false false + match Seq.tryHead v with + | None -> "" + | Some f -> + let l = Seq.length v + getFuncSignatureForTypeSignature displayContext f l false false let fields = fse.FSharpFields @@ -664,7 +765,7 @@ module SignatureFormatter = let res = - [ yield constrc + [ yield constructors if not fse.IsFSharpModule then yield! fields @@ -703,26 +804,58 @@ module SignatureFormatter = let basicName = modifier + typeName ++ name if fse.IsFSharpAbbreviation then - let unannotatedType = fse.UnAnnotate() - basicName ++ "=" ++ (unannotatedType.DisplayName) + if fse.AbbreviatedType.IsFunctionType then + let typeNames = + ParameterType.getGenericArgumentTypes fse.AbbreviatedType + |> List.map ParameterType.displayNameUnAnnotated + |> String.join " -> " + + basicName ++ "=" ++ typeNames + else if fse.AbbreviatedType.IsGenericParameter then + basicName ++ "=" ++ $"'{fse.AbbreviatedType.GenericParameter.DisplayName}" + else if fse.AbbreviatedType.IsStructTupleType then + let typeNames = + ParameterType.getGenericArgumentTypes fse.AbbreviatedType + |> List.map ParameterType.displayNameUnAnnotated + |> String.join " * " + + basicName ++ "=" ++ $"struct ({typeNames})" + else if fse.AbbreviatedType.IsTupleType then + let typeNames = + ParameterType.getGenericArgumentTypes fse.AbbreviatedType + |> List.map ParameterType.displayNameUnAnnotated + |> String.join " * " + + basicName ++ "=" ++ $"({typeNames})" + else + let unannotatedType = fse.UnAnnotate() + basicName ++ "=" ++ (unannotatedType.DisplayName) else basicName - if fse.IsFSharpUnion then typeDisplay + uniontip () - elif fse.IsEnum then typeDisplay + enumtip () - elif fse.IsDelegate then typeDisplay + delegateTip () - else typeDisplay + typeTip () + if fse.IsFSharpUnion then + typeDisplay + unionTip () + elif fse.IsEnum then + typeDisplay + enumTip () + elif fse.IsDelegate then + typeDisplay + delegateTip () + elif + fse.IsFSharpAbbreviation + && (fse.AbbreviatedType.IsTupleType || fse.AbbreviatedType.IsStructTupleType) + then + typeDisplay + else + typeDisplay + typeTip () let footerForType (entity: FSharpSymbolUse) = - let formatFooter (fullName, assyName) = - $"Full name: %s{fullName}{nl}Assembly: %s{assyName}" + let formatFooter (fullName, asmName) = $"Full name: %s{fullName}{nl}Assembly: %s{asmName}" let valFooterData = try match entity with | SymbolUse.MemberFunctionOrValue m -> Some(m.FullName, m.Assembly.SimpleName) - | SymbolUse.Entity (c, _) -> Some(c.FullName, c.Assembly.SimpleName) + | SymbolUse.Entity(c, _) -> Some(c.FullName, c.Assembly.SimpleName) | SymbolUse.Field f -> Some(f.FullName, f.Assembly.SimpleName) @@ -735,10 +868,10 @@ module SignatureFormatter = valFooterData |> Option.map formatFooter |> Option.defaultValue "" - ///Returns formated symbol signature and footer that can be used to enhance standard FCS' text tooltips + ///Returns formatted symbol signature and footer that can be used to enhance standard FCS' text tooltips let getTooltipDetailsFromSymbolUse (symbol: FSharpSymbolUse) = match symbol with - | SymbolUse.Entity (fse, _) -> + | SymbolUse.Entity(fse, _) -> try let signature = getEntitySignature symbol.DisplayContext fse Some(signature, footerForType symbol) @@ -788,7 +921,7 @@ module SignatureFormatter = Some(signature, footerForType symbol) | SymbolUse.UnionCase uc -> - let signature = getUnioncaseSignature symbol.DisplayContext uc + let signature = getUnionCaseSignature symbol.DisplayContext uc Some(signature, footerForType symbol) | SymbolUse.ActivePatternCase apc -> @@ -801,13 +934,7 @@ module SignatureFormatter = | SymbolUse.GenericParameter gp -> let signature = - sprintf - "%s (requires %s)" - (if gp.IsSolveAtCompileTime then - "^" + gp.Name - else - "'" + gp.Name) - (formatGenericParameter false symbol.DisplayContext gp) + $"'%s{gp.Name} (requires %s{formatGenericParameter false symbol.DisplayContext gp})" Some(signature, footerForType symbol) diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TipFormatter.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TipFormatter.fs index a3dde05926..04228b0e69 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TipFormatter.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TipFormatter.fs @@ -29,7 +29,7 @@ module private Section = content |> Seq.map (fun kv -> let text = - if kv.Value.Contains("\n") then + if kv.Value.Contains '\n' then kv.Value.Split('\n') |> Seq.map (fun line -> "> " + line.TrimStart()) |> String.concat Environment.NewLine @@ -41,8 +41,7 @@ module private Section = |> String.concat nl |> addSection name - let fromOption (name: string) (content: string option) = - if content.IsNone then "" else addSection name content.Value + let fromOption (name: string) (content: string option) = if content.IsNone then "" else addSection name content.Value let fromList (name: string) (content: string seq) = if Seq.isEmpty content then @@ -69,8 +68,7 @@ module private Format = { TagName: string Formatter: TagInfo -> string option } - let private extractTextFromQuote (quotedText: string) = - quotedText.Substring(1, quotedText.Length - 2) + let private extractTextFromQuote (quotedText: string) = quotedText.Substring(1, quotedText.Length - 2) let extractMemberText (text: string) = @@ -143,7 +141,7 @@ module private Format = // otherwise it will create an infinity loop text else - // Should not happend but like that we are sure to handle all possible cases + // Should not happened but like that we are sure to handle all possible cases text | _ -> text @@ -153,25 +151,57 @@ module private Format = function | VoidElement _ -> None - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> let lang = match lang attributes with | Some lang -> lang | None -> "forceNoHighlight" + // We need to trim the end of the text because the + // user write XML comments with a space between the '///' + // and the '' tag. Then it mess up identification of new lines + // at the end of the code snippet. + // Example: + // /// + // /// var x = 1; + // /// + // ^ This space is the one we need to remove + let innerText = innerText.TrimEnd() + + // Try to detect how the code snippet is formatted + // so render the markdown code block the best way + // by avoid empty lines at the beginning or the end let formattedText = - if innerText.Contains("\n") then + match + innerText.StartsWith("\n", StringComparison.Ordinal), innerText.EndsWith("\n", StringComparison.Ordinal) + with + | true, true -> sprintf "```%s%s```" lang innerText + | true, false -> sprintf "```%s%s\n```" lang innerText + | false, true -> sprintf "```%s\n%s```" lang innerText + | false, false -> sprintf "```%s\n%s\n```" lang innerText - if innerText.StartsWith("\n") then + Some formattedText - sprintf "```%s%s\n```" lang innerText + } + |> applyFormatter - else - sprintf "```%s\n%s\n```" lang innerText + let private example = + { TagName = "example" + Formatter = + function + | VoidElement _ -> None - else - sprintf "`%s`" innerText + | NonVoidElement(innerText, _) -> + let formattedText = + nl + + nl + // This try to keep a visual consistency and indicate that this + // "Example section" is part of it parent section (summary, remarks, etc.) + + """Example:""" + + nl + + nl + + innerText Some formattedText @@ -183,7 +213,7 @@ module private Format = Formatter = function | VoidElement _ -> None - | NonVoidElement (innerText, _) -> "`" + innerText + "`" |> Some } + | NonVoidElement(innerText, _) -> "`" + innerText + "`" |> Some } |> applyFormatter let private link text uri = $"[`%s{text}`](%s{uri})" @@ -198,7 +228,7 @@ module private Format = | Some href -> Some(link href href) | None -> None - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> match href attributes with | Some href -> Some(link innerText href) | None -> Some(code innerText) } @@ -210,7 +240,7 @@ module private Format = function | VoidElement _ -> None - | NonVoidElement (innerText, _) -> nl + innerText + nl |> Some } + | NonVoidElement(innerText, _) -> nl + innerText + nl |> Some } |> applyFormatter let private block = @@ -219,7 +249,7 @@ module private Format = function | VoidElement _ -> None - | NonVoidElement (innerText, _) -> nl + innerText + nl |> Some } + | NonVoidElement(innerText, _) -> nl + innerText + nl |> Some } |> applyFormatter let private see = @@ -237,7 +267,7 @@ module private Format = Formatter = function | VoidElement attributes -> formatFromAttributes attributes - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> if String.IsNullOrWhiteSpace innerText then formatFromAttributes attributes else @@ -255,7 +285,7 @@ module private Format = | Some href -> Some(link href href) | None -> None - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> if String.IsNullOrWhiteSpace innerText then match href attributes with | Some href -> Some(link innerText href) @@ -273,7 +303,7 @@ module private Format = | Some name -> Some(code name) | None -> None - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> if String.IsNullOrWhiteSpace innerText then match name attributes with | Some name -> @@ -295,7 +325,7 @@ module private Format = | Some name -> Some(code name) | None -> None - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> if String.IsNullOrWhiteSpace innerText then match name attributes with | Some name -> @@ -371,7 +401,7 @@ module private Format = // CaseC of the or section // // The original comments is for `System.Uri("")` - // By making the assumption that an 'or' section is always single line this allows us the detact the "" section + // By making the assumption that an 'or' section is always single line this allows us to detect the "" section // orText is on a single line, we just add quotation syntax if lastParagraphStartIndex = -1 then @@ -395,7 +425,7 @@ module private Format = /// If an 'or' block is found between 2 elements then we remove it as we can't generate a valid markdown for it /// /// For example, Some text -or- another text cannot be converted into a multiline string - /// and so we prefer to remove the 'or' block instead of having some weird markdown artefacts + /// and so we prefer to remove the 'or' block instead of having some weird markdown artifacts /// /// For now, we only consider text between to be invalid /// We can add more in the future if needed, but I want to keep this as minimal as possible to avoid capturing false positive @@ -407,17 +437,19 @@ module private Format = Regex.Matches(text, invalidOrBlockPattern, RegexOptions.Multiline) |> Seq.cast |> Seq.fold - (fun (state: string) (m: Match) -> - let orText = m.Groups.["or_text"] + (fun (state: string) (m: Match) -> + let orText = m.Groups.["or_text"] + + if orText.Success then + let replacement = orText.Value.Replace("-or-", "or") - if orText.Success then - let replacement = orText.Value.Replace("-or-", "or") + state.Replace(orText.Value, replacement) + else + state) + text - state.Replace(orText.Value, replacement) - else - state) - text + let private thsPattern = Regex "" let private convertTable = { TagName = "table" @@ -425,9 +457,9 @@ module private Format = function | VoidElement _ -> None - | NonVoidElement (innerText, _) -> + | NonVoidElement(innerText, _) -> - let rowCount = Regex.Matches(innerText, "").Count + let rowCount = thsPattern.Matches(innerText).Count let convertedTable = innerText @@ -454,6 +486,7 @@ module private Format = type private Term = string type private Definition = string + [] type private ListStyle = | Bulleted | Numbered @@ -472,9 +505,9 @@ module private Format = let private itemListToStringAsMarkdownList (prefix: string) (item: ItemList) = match item with - | DescriptionOnly description -> prefix + " " + description - | TermOnly term -> prefix + " " + "**" + term + "**" - | Definitions (term, description) -> prefix + " " + "**" + term + "** - " + description + | DescriptionOnly description -> $"{prefix} {description}" + | TermOnly term -> $"{prefix} **{term}**" + | Definitions(term, description) -> $"{prefix} **{term}** - {description}" let private list = let getType (attributes: Map) = Map.tryFind "type" attributes @@ -497,14 +530,14 @@ module private Format = None | _ -> None - let tryGetDescription (text: string) = - tryGetInnerTextOnNonVoidElement text "description" + let tryGetDescription (text: string) = tryGetInnerTextOnNonVoidElement text "description" + + let tryGetTerm (text: string) = tryGetInnerTextOnNonVoidElement text "term" - let tryGetTerm (text: string) = - tryGetInnerTextOnNonVoidElement text "term" + let itmPattern = Regex(tagPattern "item", RegexOptions.IgnoreCase) let rec extractItemList (res: ItemList list) (text: string) = - match Regex.Match(text, tagPattern "item", RegexOptions.IgnoreCase) with + match itmPattern.Match text with | m when m.Success -> let newText = text.Substring(m.Value.Length) @@ -527,8 +560,10 @@ module private Format = extractItemList res newText | _ -> res + let listHeader = Regex(tagPattern "listheader", RegexOptions.IgnoreCase) + let rec extractColumnHeader (res: string list) (text: string) = - match Regex.Match(text, tagPattern "listheader", RegexOptions.IgnoreCase) with + match listHeader.Match text with | m when m.Success -> let newText = text.Substring(m.Value.Length) @@ -537,7 +572,7 @@ module private Format = let rec extractAllTerms (res: string list) (text: string) = match tryGetNonVoidElement text "term" with - | Some (fullString, innerText) -> + | Some(fullString, innerText) -> let escapedRegex = Regex(Regex.Escape(fullString)) let newText = escapedRegex.Replace(text, "", 1) extractAllTerms (res @ [ innerText ]) newText @@ -548,9 +583,10 @@ module private Format = extractColumnHeader res newText | _ -> res + let itemPattern = Regex(tagPattern "item", RegexOptions.IgnoreCase) let rec extractRowsForTable (res: (string list) list) (text: string) = - match Regex.Match(text, tagPattern "item", RegexOptions.IgnoreCase) with + match itemPattern.Match text with | m when m.Success -> let newText = text.Substring(m.Value.Length) @@ -559,7 +595,7 @@ module private Format = let rec extractAllTerms (res: string list) (text: string) = match tryGetNonVoidElement text "term" with - | Some (fullString, innerText) -> + | Some(fullString, innerText) -> let escapedRegex = Regex(Regex.Escape(fullString)) let newText = escapedRegex.Replace(text, "", 1) extractAllTerms (res @ [ innerText ]) newText @@ -575,7 +611,7 @@ module private Format = function | VoidElement _ -> None - | NonVoidElement (innerText, attributes) -> + | NonVoidElement(innerText, attributes) -> let listStyle = match getType attributes with | Some "bullet" -> Bulleted @@ -614,7 +650,7 @@ module private Format = " | " + header) |> String.concat "" - let seprator = + let separator = columnHeaders |> List.mapi (fun index _ -> if index = 0 then "| ---" @@ -639,7 +675,7 @@ module private Format = Environment.NewLine + columnHeadersText + Environment.NewLine - + seprator + + separator + Environment.NewLine + itemsText) |> Some } @@ -651,12 +687,7 @@ module private Format = /// For example, this allows to print '>' in the tooltip instead of '>' /// let private unescapeSpecialCharacters (text: string) = - text - .Replace("<", "<") - .Replace(">", ">") - .Replace(""", "\"") - .Replace("'", "'") - .Replace("&", "&") + text.Replace("<", "<").Replace(">", ">").Replace(""", "\"").Replace("'", "'").Replace("&", "&") let applyAll (text: string) = text @@ -665,6 +696,7 @@ module private Format = |> removeInvalidOrBlock // Start the transformation process |> paragraph + |> example |> block |> codeInline |> codeBlock @@ -679,6 +711,13 @@ module private Format = |> handleMicrosoftOrList |> unescapeSpecialCharacters +[] +type FormatCommentStyle = + | Legacy + | FullEnhanced + | SummaryOnly + | Documentation + // TODO: Improve this parser. Is there any other XmlDoc parser available? type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: int) = /// References used to detect if we should remove meaningless spaces @@ -690,12 +729,15 @@ type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: | _ -> let content = // Normale the EOL - // This make it easier to work with line splittig + // This make it easier to work with line splitting node.InnerXml.Replace("\r\n", "\n") |> Format.applyAll content.Split('\n') |> Array.map (fun line -> - if not (String.IsNullOrWhiteSpace line) && line.StartsWith(tabsOffset) then + if + not (String.IsNullOrWhiteSpace line) + && line.StartsWith(tabsOffset, StringComparison.Ordinal) + then line.Substring(columnOffset + indentationSize) else line) @@ -707,8 +749,7 @@ type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: |> Seq.map (fun node -> Format.extractMemberText node.Attributes.[0].InnerText, node) |> Seq.toList - let readRemarks (doc: XmlDocument) = - doc.DocumentElement.GetElementsByTagName "remarks" |> Seq.cast + let readRemarks (doc: XmlDocument) = doc.DocumentElement.GetElementsByTagName "remarks" |> Seq.cast let rawSummary = doc.DocumentElement.ChildNodes.[0] let rawParameters = readChildren "param" doc @@ -722,10 +763,19 @@ type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: |> Seq.tryHead let rawExamples = - doc.DocumentElement.GetElementsByTagName "example" |> Seq.cast - - let readNamedContentAsKvPair (key, content) = - KeyValuePair(key, readContentForTooltip content) + doc.DocumentElement.GetElementsByTagName "example" + |> Seq.cast + // We need to filter out the examples node that are children + // of another "main" node + // This is because if the example node is inside a "main" node + // then we render it in place. + // So we don't need to render it independently in the Examples section + |> Seq.filter (fun node -> + [ "summary"; "param"; "returns"; "exception"; "remarks"; "typeparam" ] + |> List.contains node.ParentNode.Name + |> not) + + let readNamedContentAsKvPair (key, content) = KeyValuePair(key, readContentForTooltip content) let summary = readContentForTooltip rawSummary @@ -767,6 +817,8 @@ type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: else "**Description**" + nl + nl + summary + member __.HasTruncatedExamples = examples |> Seq.isEmpty |> not + member __.ToFullEnhancedString() = let content = summary @@ -775,7 +827,6 @@ type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: + Section.fromKeyValueList "Parameters" parameters + Section.fromOption "Returns" returns + Section.fromKeyValueList "Exceptions" exceptions - + Section.fromList "Examples" examples + Section.fromList "See also" seeAlso // If we where unable to process the doc comment, then just output it as it is @@ -798,11 +849,19 @@ type private XmlDocMember(doc: XmlDocument, indentationSize: int, columnOffset: + Section.fromList "Examples" examples + Section.fromList "See also" seeAlso + member this.FormatComment(formatStyle: FormatCommentStyle) = + match formatStyle with + | FormatCommentStyle.Legacy -> this.ToString() + | FormatCommentStyle.SummaryOnly -> this.ToSummaryOnlyString() + | FormatCommentStyle.FullEnhanced -> this.ToFullEnhancedString() + | FormatCommentStyle.Documentation -> this.ToDocumentationString() + + let rec private readXmlDoc (reader: XmlReader) (indentationSize: int) (acc: Map) = let acc' = match reader.Read() with | false -> indentationSize, None - // Assembly is the first node in the XML and is at least always indended by 1 "tab" + // Assembly is the first node in the XML and is at least always intended by 1 "tab" // So we used it as a reference to detect the tabs sizes // This is needed because `netstandard.xml` use 2 spaces tabs // Where when building a C# classlib, the xml file use 4 spaces size for example @@ -835,6 +894,28 @@ let rec private readXmlDoc (reader: XmlReader) (indentationSize: int) (acc: Map< let private xmlDocCache = Collections.Concurrent.ConcurrentDictionary>() +let private findCultures v = + let rec loop state (v: System.Globalization.CultureInfo) = + let state' = v.Name :: state + + if v.Parent = System.Globalization.CultureInfo.InvariantCulture then + "" :: state' |> List.rev + else + loop state' v.Parent + + loop [] v + +let private findLocalizedXmlFile (xmlFile: string) = + let xmlName = Path.GetFileName xmlFile + let path = Path.GetDirectoryName xmlFile + + findCultures System.Globalization.CultureInfo.CurrentUICulture + |> List.map (fun culture -> Path.Combine(path, culture, xmlName)) + |> List.tryFind File.Exists + |> Option.defaultValue xmlFile + +let pPattern = Regex """(

)+(.*)(<\/?p>)*""" + let private getXmlDoc dllFile = let xmlFile = Path.ChangeExtension(dllFile, ".xml") //Workaround for netstandard.dll @@ -848,9 +929,11 @@ let private getXmlDoc dllFile = else xmlFile - if xmlDocCache.ContainsKey xmlFile then - Some xmlDocCache.[xmlFile] - else + let xmlFile = findLocalizedXmlFile xmlFile + + match xmlDocCache.TryGetValue xmlFile with + | true, cachedXmlFile -> Some cachedXmlFile + | false, _ -> let rec exists filePath tryAgain = match File.Exists filePath, tryAgain with | true, _ -> Some filePath @@ -871,7 +954,7 @@ let private getXmlDoc dllFile = //Workaround for netstandard xmlDoc let cnt = if actualXmlFile.Contains "netstandard.xml" then - let cnt = Regex.Replace(cnt, """(

)+(.*)(<\/?p>)*""", "$2") + let cnt = pPattern.Replace(cnt, "$2") cnt.Replace("

", "").Replace("

", "").Replace("
", "") else @@ -884,23 +967,30 @@ let private getXmlDoc dllFile = xmlDocCache.AddOrUpdate(xmlFile, xmlDoc, (fun _ _ -> xmlDoc)) |> ignore Some xmlDoc - with ex -> + with _ -> None // TODO: Remove the empty map from cache to try again in the next request? -[] -type FormatCommentStyle = - | Legacy - | FullEnhanced - | SummaryOnly - | Documentation - // -------------------------------------------------------------------------------------- // Formatting of tool-tip information displayed in F# IntelliSense // -------------------------------------------------------------------------------------- -let private buildFormatComment cmt (formatStyle: FormatCommentStyle) (typeDoc: string option) = - match cmt with - | FSharpXmlDoc.FromXmlText xmldoc -> - try + +[] +type private TryGetXmlDocMemberResult = + | Some of XmlDocMember + | None + | Error + +[] +type TipFormatterResult<'T> = + | Success of 'T + | Error of string + | None + +let private tryGetXmlDocMember (xmlDoc: FSharpXmlDoc) = + try + match xmlDoc with + | FSharpXmlDoc.FromXmlText xmldoc -> + let document = xmldoc.GetXmlText() // We create a "fake" XML document in order to use the same parser for both libraries and user code let xml = sprintf "%s" document @@ -911,7 +1001,7 @@ let private buildFormatComment cmt (formatStyle: FormatCommentStyle) (typeDoc: s let rec findIndentationSize (lines: string list) = match lines with | head :: tail -> - let lesserThanIndex = head.IndexOf("<") + let lesserThanIndex = head.IndexOf('<', StringComparison.Ordinal) if lesserThanIndex <> -1 then lesserThanIndex @@ -924,44 +1014,26 @@ let private buildFormatComment cmt (formatStyle: FormatCommentStyle) (typeDoc: s let xmlDoc = XmlDocMember(doc, indentationSize, 0) - match formatStyle with - | FormatCommentStyle.Legacy -> xmlDoc.ToString() - | FormatCommentStyle.SummaryOnly -> xmlDoc.ToSummaryOnlyString() - | FormatCommentStyle.FullEnhanced -> xmlDoc.ToFullEnhancedString() - | FormatCommentStyle.Documentation -> xmlDoc.ToDocumentationString() - - with ex -> - sprintf - "An error occured when parsing the doc comment, please check that your doc comment is valid.\n\nMore info can be found LSP output" - - | FSharpXmlDoc.FromXmlFile (dllFile, memberName) -> - match getXmlDoc dllFile with - | Some doc when doc.ContainsKey memberName -> - let typeDoc = - match typeDoc with - | Some s when doc.ContainsKey s -> - match formatStyle with - | FormatCommentStyle.Legacy -> doc.[s].ToString() - | FormatCommentStyle.SummaryOnly -> doc.[s].ToSummaryOnlyString() - | FormatCommentStyle.FullEnhanced -> doc.[s].ToFullEnhancedString() - | FormatCommentStyle.Documentation -> doc.[s].ToDocumentationString() - | _ -> "" - - match formatStyle with - | FormatCommentStyle.Legacy -> doc.[memberName].ToString() + (if typeDoc <> "" then "\n\n" + typeDoc else "") - | FormatCommentStyle.SummaryOnly -> - doc.[memberName].ToSummaryOnlyString() - + (if typeDoc <> "" then "\n\n" + typeDoc else "") - | FormatCommentStyle.FullEnhanced -> - doc.[memberName].ToFullEnhancedString() - + (if typeDoc <> "" then "\n\n" + typeDoc else "") - | FormatCommentStyle.Documentation -> - doc.[memberName].ToDocumentationString() - + (if typeDoc <> "" then "\n\n" + typeDoc else "") - | _ -> "" - | _ -> "" - -let formatTaggedText (t: TaggedText) : string = + TryGetXmlDocMemberResult.Some xmlDoc + + | FSharpXmlDoc.FromXmlFile(dllFile, memberName) -> + match getXmlDoc dllFile with + | Some doc -> + match doc.TryGetValue memberName with + | true, docmember -> TryGetXmlDocMemberResult.Some docmember + | false, _ -> TryGetXmlDocMemberResult.None + | _ -> TryGetXmlDocMemberResult.None + + | FSharpXmlDoc.None -> TryGetXmlDocMemberResult.None + with ex -> + + TryGetXmlDocMemberResult.Error + +[] +let private ERROR_WHILE_PARSING_DOC_COMMENT = + "An error occurred when parsing the doc comment, please check that your doc comment is valid.\n\nMore info can be found in the LSP output" + +let private formatTaggedText (t: TaggedText) : string = match t.Tag with | TextTag.ActivePatternResult | TextTag.UnionCase @@ -985,8 +1057,8 @@ let formatTaggedText (t: TaggedText) : string = | TextTag.StringLiteral | TextTag.Text | TextTag.Punctuation - | TextTag.UnknownType - | TextTag.UnknownEntity -> t.Text + | TextTag.UnknownType -> t.Text + | TextTag.UnknownEntity | TextTag.Enum | TextTag.Event | TextTag.ActivePatternCase @@ -998,13 +1070,14 @@ let formatTaggedText (t: TaggedText) : string = | TextTag.Record | TextTag.TypeParameter -> $"`{t.Text}`" -let formatUntaggedText (t: TaggedText) = t.Text +let private formatUntaggedText (t: TaggedText) = t.Text -let formatUntaggedTexts = Array.map formatUntaggedText >> String.concat "" +let private formatUntaggedTexts = Array.map formatUntaggedText >> String.concat "" -let formatTaggedTexts = Array.map formatTaggedText >> String.concat "" +let private formatTaggedTexts = + Array.map formatTaggedText >> String.concat "" >> (fun s -> s.Replace("``", "")) -let formatGenericParameters (typeMappings: TaggedText[] list) = +let private formatGenericParameters (typeMappings: TaggedText[] list) = typeMappings |> List.map (fun typeMap -> $"* {formatTaggedTexts typeMap}") |> String.concat nl @@ -1018,12 +1091,17 @@ let formatCompletionItemTip (ToolTipText tips) : (string * string) = let makeTooltip (tipElement: ToolTipElementData) = let header = formatUntaggedTexts tipElement.MainDescription - let body = buildFormatComment tipElement.XmlDoc FormatCommentStyle.Legacy None + let body = + match tryGetXmlDocMember tipElement.XmlDoc with + | TryGetXmlDocMemberResult.Some xmlDoc -> xmlDoc.FormatComment(FormatCommentStyle.Legacy) + | TryGetXmlDocMemberResult.None -> "" + | TryGetXmlDocMemberResult.Error -> ERROR_WHILE_PARSING_DOC_COMMENT + header, body items |> List.tryHead |> Option.map makeTooltip - | ToolTipElement.CompositionError (error) -> Some("", error) + | ToolTipElement.CompositionError(error) -> Some("", error) | _ -> Some("", "No signature data")) /// Formats a tooltip signature for output as a signatureHelp, @@ -1034,11 +1112,130 @@ let formatPlainTip (ToolTipText tips) : (string * string) = | ToolTipElement.Group items -> let t = items |> Seq.head let signature = formatUntaggedTexts t.MainDescription - let description = buildFormatComment t.XmlDoc FormatCommentStyle.Legacy None + + let description = + match tryGetXmlDocMember t.XmlDoc with + | TryGetXmlDocMemberResult.Some xmlDoc -> xmlDoc.FormatComment(FormatCommentStyle.Legacy) + | TryGetXmlDocMemberResult.None -> "" + | TryGetXmlDocMemberResult.Error -> ERROR_WHILE_PARSING_DOC_COMMENT + Some(signature, description) - | ToolTipElement.CompositionError (error) -> Some("", error) + | ToolTipElement.CompositionError(error) -> Some("", error) | _ -> Some("", "No signature data")) + +let prepareSignature (signatureText: string) = + signatureText.Split Environment.NewLine + // Remove empty lines + |> Array.filter (not << String.IsNullOrWhiteSpace) + |> String.concat nl + +let prepareFooterLines (footerText: string) = + footerText.Split Environment.NewLine + // Remove empty lines + |> Array.filter (not << String.IsNullOrWhiteSpace) + // Mark each line as an individual string in italics + |> Array.map (fun n -> "*" + n + "*") + + +let private tryComputeTooltipInfo (ToolTipText tips) (formatCommentStyle: FormatCommentStyle) = + + // Note: In the previous code, we were returning a `(string * string * string) list list` + // but always discarding the tooltip later if the list had more than one element + // and only using the first element of the inner list. + // More over, I don't know in which case we can have several elements in the + // `(ToolTipText tips)` parameter. + // So I can't test why we have list of list stuff, but like I said, we were + // discarding the tooltip if it had more than one element. + // + // The new code should do the same thing, as before but instead of + // computing the rendered tooltip, and discarding some of them afterwards, + // we are discarding the things we don't want earlier and only compute the + // tooltip we want to display if we have the right data. + + let computeGenericParametersText (tooltipData: ToolTipElementData) = + // If there are no generic parameters, don't display the section + if tooltipData.TypeMapping.IsEmpty then + None + // If there are generic parameters, display the section + else + "**Generic Parameters**" + + nl + + nl + + formatGenericParameters tooltipData.TypeMapping + |> Some + + tips + // Render the first valid tooltip and return it + |> List.tryPick (function + | ToolTipElement.Group(tooltipData :: _) -> + let docComment, hasTruncatedExamples = + match tryGetXmlDocMember tooltipData.XmlDoc with + | TryGetXmlDocMemberResult.Some xmlDoc -> + // Format the doc comment + let docCommentText = xmlDoc.FormatComment formatCommentStyle + + // Concatenate the doc comment and the generic parameters section + let consolidatedDocCommentText = + match computeGenericParametersText tooltipData with + | Some genericParametersText -> docCommentText + nl + nl + genericParametersText + | None -> docCommentText + + consolidatedDocCommentText, xmlDoc.HasTruncatedExamples + + | TryGetXmlDocMemberResult.None -> + // Even if a symbol doesn't have a doc comment, it can still have generic parameters + let docComment = + match computeGenericParametersText tooltipData with + | Some genericParametersText -> genericParametersText + | None -> "" + + docComment, false + | TryGetXmlDocMemberResult.Error -> ERROR_WHILE_PARSING_DOC_COMMENT, false + + {| DocComment = docComment + HasTruncatedExamples = hasTruncatedExamples |} + |> Ok + |> Some + + | ToolTipElement.CompositionError error -> error |> Error |> Some + + | ToolTipElement.Group [] + | ToolTipElement.None -> None) + +/// +/// Try format the given tooltip with the requested style. +/// +/// Tooltip documentation to render in the middle +/// Style of tooltip +/// +/// - TipFormatterResult.Success {| DocComment; HasTruncatedExamples |} if the doc comment has been formatted +/// +/// Where DocComment is the format tooltip and HasTruncatedExamples is true if examples have been truncated +/// +/// - TipFormatterResult.None if the doc comment has not been found +/// - TipFormatterResult.Error string if an error occurred while parsing the doc comment +/// +let tryFormatTipEnhanced toolTipText (formatCommentStyle: FormatCommentStyle) = + + match tryComputeTooltipInfo toolTipText formatCommentStyle with + | Some(Ok tooltipResult) -> TipFormatterResult.Success tooltipResult + + | Some(Error error) -> TipFormatterResult.Error error + + | None -> TipFormatterResult.None + +let private buildFormatComment cmt (formatStyle: FormatCommentStyle) (typeDoc: string option) = + match tryGetXmlDocMember cmt with + | TryGetXmlDocMemberResult.Some xmlDoc -> + match formatStyle with + | FormatCommentStyle.Legacy -> xmlDoc.ToString() + | FormatCommentStyle.SummaryOnly -> xmlDoc.ToSummaryOnlyString() + | FormatCommentStyle.FullEnhanced -> xmlDoc.ToFullEnhancedString() + | FormatCommentStyle.Documentation -> xmlDoc.ToDocumentationString() + | TryGetXmlDocMemberResult.None -> "" + | TryGetXmlDocMemberResult.Error -> "" + let formatTipEnhanced (ToolTipText tips) (signature: string) @@ -1046,6 +1243,15 @@ let formatTipEnhanced (typeDoc: string option) (formatCommentStyle: FormatCommentStyle) : (string * string * string) list list = + + // Normalize signature: ensure space before colon in type annotations + // The new FsAutoComplete SignatureFormatter produces "val foo: int" but tests expect "val foo : int" + let normalizedSignature = + if signature.Contains(":") then + System.Text.RegularExpressions.Regex.Replace(signature, @"(\w+):\s*", "$1 : ") + else + signature + tips |> List.choose (function | ToolTipElement.Group items -> @@ -1064,50 +1270,92 @@ let formatTipEnhanced + nl + formatGenericParameters i.TypeMapping - (signature, comment, footer)) + (normalizedSignature, comment, footer)) ) | ToolTipElement.CompositionError (error) -> Some [ ("", error, "") ] | _ -> None) -let formatDocumentation - (ToolTipText tips) - ((signature, (constructors, fields, functions, interfaces, attrs, ts)): string * (string[] * string[] * string[] * string[] * string[] * string[])) - (footer: string) - (cn: string) - = - tips - |> List.choose (function - | ToolTipElement.Group items -> - Some( - items - |> List.map (fun i -> - let comment = - if i.TypeMapping.IsEmpty then - buildFormatComment i.XmlDoc FormatCommentStyle.Documentation None - else - buildFormatComment i.XmlDoc FormatCommentStyle.Documentation None - + nl - + nl - + "**Generic Parameters**" - + nl - + nl - + formatGenericParameters i.TypeMapping +/// +/// Generate the 'Show documentation' link for the tooltip. +/// +/// The link is rendered differently depending on if examples +/// have been truncated or not. +/// +/// true if the examples have been truncated +/// XmlDocSignature in the format of T:System.String.concat +/// Assembly name, example FSharp.Core +/// Returns a string which represent the show documentation link +let renderShowDocumentationLink (hasTruncatedExamples: bool) (xmlDocSig: string) (assemblyName: string) = + + // TODO: Refactor this code, to avoid duplicate with DocumentationFormatter.fs + let content = + Uri.EscapeDataString(sprintf """[{ "XmlDocSig": "%s", "AssemblyName": "%s" }]""" xmlDocSig assemblyName) + + let text = + if hasTruncatedExamples then + "Open the documentation to see the truncated examples" + else + "Open the documentation" + + $"%s{text}" + +/// +/// Try format the given tooltip as documentation. +/// +/// Tooltip to format +/// +/// - TipFormatterResult.Success string if the doc comment has been formatted +/// - TipFormatterResult.None if the doc comment has not been found +/// - TipFormatterResult.Error string if an error occurred while parsing the doc comment +/// +let tryFormatDocumentationFromTooltip toolTipText = + + match tryComputeTooltipInfo toolTipText FormatCommentStyle.Documentation with + | Some(Ok tooltipResult) -> TipFormatterResult.Success tooltipResult.DocComment + + | Some(Error error) -> TipFormatterResult.Error error + + | None -> TipFormatterResult.None + +/// +/// Try format the doc comment based on the XmlSignature and the assembly name. +/// +/// +/// XmlSignature used to identify the doc comment to format +/// +/// Example: T:System.String.concat +/// +/// +/// Assembly name used to identify the doc comment to format +/// +/// Example: FSharp.Core +/// +/// +/// - TipFormatterResult.Success string if the doc comment has been formatted +/// - TipFormatterResult.None if the doc comment has not been found +/// - TipFormatterResult.Error string if an error occurred while parsing the doc comment +/// +let tryFormatDocumentationFromXmlSig (xmlSig: string) (assembly: string) = + let xmlDoc = FSharpXmlDoc.FromXmlFile(assembly, xmlSig) - (signature, constructors, fields, functions, interfaces, attrs, ts, comment, footer, cn)) - ) - | ToolTipElement.CompositionError (error) -> Some [ ("", [||], [||], [||], [||], [||], [||], error, "", "") ] - | _ -> None) + match tryGetXmlDocMember xmlDoc with + | TryGetXmlDocMemberResult.Some xmlDoc -> + let formattedComment = xmlDoc.FormatComment(FormatCommentStyle.Documentation) -let formatDocumentationFromXmlSig - (xmlSig: string) - (assembly: string) - ((signature, (constructors, fields, functions, interfaces, attrs, ts)): string * (string[] * string[] * string[] * string[] * string[] * string[])) - (footer: string) - (cn: string) - = - let xmlDoc = FSharpXmlDoc.FromXmlFile(assembly, xmlSig) - let comment = buildFormatComment xmlDoc FormatCommentStyle.Documentation None - [ [ (signature, constructors, fields, functions, interfaces, attrs, ts, comment, footer, cn) ] ] + TipFormatterResult.Success formattedComment + + | TryGetXmlDocMemberResult.None -> TipFormatterResult.None + | TryGetXmlDocMemberResult.Error -> TipFormatterResult.Error ERROR_WHILE_PARSING_DOC_COMMENT + +let formatDocumentationFromXmlDoc xmlDoc = + match tryGetXmlDocMember xmlDoc with + | TryGetXmlDocMemberResult.Some xmlDoc -> + let formattedComment = xmlDoc.FormatComment(FormatCommentStyle.Documentation) + + TipFormatterResult.Success formattedComment + + | TryGetXmlDocMemberResult.None -> TipFormatterResult.None + | TryGetXmlDocMemberResult.Error -> TipFormatterResult.Error ERROR_WHILE_PARSING_DOC_COMMENT let extractSignature (ToolTipText tips) = let getSignature (t: TaggedText[]) = diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstPatterns.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstPatterns.fs index 9a45b9b5e5..1c06ded728 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstPatterns.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstPatterns.fs @@ -3,6 +3,8 @@ module FsAutoComplete.Patterns open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Symbols +open FSharp.Compiler.Text + /// Active patterns over `FSharpSymbolUse`. module SymbolUse = @@ -27,7 +29,7 @@ module SymbolUse = |> Option.toList |> List.map (fun fullName -> if ent.GenericParameters.Count > 0 && fullName.Length > 2 then - fullName.[0 .. fullName.Length - 3] //Get name without sufix specifing number of generic arguments (for example `'2`) + fullName.[0 .. fullName.Length - 3] //Get name without suffix specifying number of generic arguments (for example `'2`) else fullName) @@ -69,7 +71,7 @@ module SymbolUse = | :? FSharpParameter as param -> Some param | _ -> None - let (|StaticParameter|_|) (symbol: FSharpSymbolUse) = Some + let (|StaticParameter|_|) (_symbol: FSharpSymbolUse) = Some let (|UnionCase|_|) (symbol: FSharpSymbolUse) = @@ -85,13 +87,13 @@ module SymbolUse = let (|TypeAbbreviation|_|) = function - | Entity (entity, _) when entity.IsFSharpAbbreviation -> Some entity + | Entity(entity, _) when entity.IsFSharpAbbreviation -> Some entity | _ -> None let (|Class|_|) = function - | Entity (entity, _) when entity.IsClass -> Some entity - | Entity (entity, _) when + | Entity(entity, _) when entity.IsClass -> Some entity + | Entity(entity, _) when entity.IsFSharp && entity.IsOpaque && not entity.IsFSharpModule @@ -107,7 +109,7 @@ module SymbolUse = let (|Delegate|_|) = function - | Entity (entity, _) when entity.IsDelegate -> Some entity + | Entity(entity, _) when entity.IsDelegate -> Some entity | _ -> None let (|Event|_|) = @@ -208,37 +210,37 @@ module SymbolUse = let (|Enum|_|) = function - | Entity (entity, _) when entity.IsEnum -> Some entity + | Entity(entity, _) when entity.IsEnum -> Some entity | _ -> None let (|Interface|_|) = function - | Entity (entity, _) when entity.IsInterface -> Some entity + | Entity(entity, _) when entity.IsInterface -> Some entity | _ -> None let (|Module|_|) = function - | Entity (entity, _) when entity.IsFSharpModule -> Some entity + | Entity(entity, _) when entity.IsFSharpModule -> Some entity | _ -> None let (|Namespace|_|) = function - | Entity (entity, _) when entity.IsNamespace -> Some entity + | Entity(entity, _) when entity.IsNamespace -> Some entity | _ -> None let (|Record|_|) = function - | Entity (entity, _) when entity.IsFSharpRecord -> Some entity + | Entity(entity, _) when entity.IsFSharpRecord -> Some entity | _ -> None let (|Union|_|) = function - | Entity (entity, _) when entity.IsFSharpUnion -> Some entity + | Entity(entity, _) when entity.IsFSharpUnion -> Some entity | _ -> None let (|ValueType|_|) = function - | Entity (entity, _) when entity.IsValueType && not entity.IsEnum -> Some entity + | Entity(entity, _) when entity.IsValueType && not entity.IsEnum -> Some entity | _ -> None let (|ComputationExpression|_|) (symbol: FSharpSymbolUse) = @@ -249,11 +251,36 @@ module SymbolUse = let (|Attribute|_|) = function - | Entity (entity, _) when entity.IsAttributeType -> Some entity - | _ -> None + | Entity(entity, _) when entity.IsAttributeType -> Some entity + | _ -> None + + let trySignatureLocation (signatureLocation: range option) = + match signatureLocation with + | None -> None + | Some signatureLocation -> + if not (isSignatureFileStr (signatureLocation.FileName)) then + None + else + Some signatureLocation + + let (|IsInSignature|_|) (symbolUse: FSharpSymbolUse) = trySignatureLocation symbolUse.Symbol.SignatureLocation + + let (|IsParentInSignature|_|) (symbolUse: FSharpSymbolUse) = + match trySignatureLocation symbolUse.Symbol.SignatureLocation with + // We are interested in the scenarios when the current symbol is not in a signature file but the parent is. + | Some _ -> None + | None -> + let parentOpt = + match symbolUse.Symbol with + | :? FSharpEntity as entity -> entity.DeclaringEntity + | :? FSharpMemberOrFunctionOrValue as mfv -> mfv.DeclaringEntity + | _ -> None + + parentOpt + |> Option.bind (fun parentEntity -> trySignatureLocation parentEntity.SignatureLocation) -[] /// Active patterns over `FSharpSymbol`. +[] module SymbolPatterns = let private attributeSuffixLength = "Attribute".Length @@ -271,7 +298,7 @@ module SymbolPatterns = |> Option.toList |> List.map (fun fullName -> if ent.GenericParameters.Count > 0 && fullName.Length > 2 then - fullName.[0 .. fullName.Length - 3] //Get name without sufix specifing number of generic arguments (for example `'2`) + fullName.[0 .. fullName.Length - 3] //Get name without suffix specifying number of generic arguments (for example `'2`) else fullName) @@ -300,7 +327,7 @@ module SymbolPatterns = |> Option.toList |> List.map (fun fullName -> if ent.GenericParameters.Count > 0 && fullName.Length > 2 then - fullName.[0 .. fullName.Length - 3] //Get name without sufix specifing number of generic arguments (for example `'2`) + fullName.[0 .. fullName.Length - 3] //Get name without suffix specifying number of generic arguments (for example `'2`) else fullName) @@ -347,7 +374,7 @@ module SymbolPatterns = let getBaseType (entity: FSharpEntity) = try match entity.BaseType with - | Some (TypeWithDefinition def) -> Some def + | Some(TypeWithDefinition def) -> Some def | _ -> None with _ -> None @@ -380,16 +407,13 @@ module SymbolPatterns = else None - let (|Record|_|) (e: FSharpEntity) = - if e.IsFSharpRecord then Some() else None + let (|Record|_|) (e: FSharpEntity) = if e.IsFSharpRecord then Some() else None - let (|UnionType|_|) (e: FSharpEntity) = - if e.IsFSharpUnion then Some() else None + let (|UnionType|_|) (e: FSharpEntity) = if e.IsFSharpUnion then Some() else None let (|Delegate|_|) (e: FSharpEntity) = if e.IsDelegate then Some() else None - let (|FSharpException|_|) (e: FSharpEntity) = - if e.IsFSharpExceptionDeclaration then Some() else None + let (|FSharpException|_|) (e: FSharpEntity) = if e.IsFSharpExceptionDeclaration then Some() else None let (|Interface|_|) (e: FSharpEntity) = if e.IsInterface then Some() else None @@ -413,32 +437,28 @@ module SymbolPatterns = else None - let (|ProvidedType|_|) (e: FSharpEntity) = None + let (|ProvidedType|_|) (_e: FSharpEntity) = None let (|ByRef|_|) (e: FSharpEntity) = if e.IsByRef then Some() else None let (|Array|_|) (e: FSharpEntity) = if e.IsArrayType then Some() else None - let (|FSharpModule|_|) (entity: FSharpEntity) = - if entity.IsFSharpModule then Some() else None + let (|FSharpModule|_|) (entity: FSharpEntity) = if entity.IsFSharpModule then Some() else None - let (|Namespace|_|) (entity: FSharpEntity) = - if entity.IsNamespace then Some() else None + let (|Namespace|_|) (entity: FSharpEntity) = if entity.IsNamespace then Some() else None - let (|ProvidedAndErasedType|_|) (entity: FSharpEntity) = None + let (|ProvidedAndErasedType|_|) (_entity: FSharpEntity) = None let (|Enum|_|) (entity: FSharpEntity) = if entity.IsEnum then Some() else None - let (|Tuple|_|) (ty: FSharpType option) = - ty |> Option.bind (fun ty -> if ty.IsTupleType then Some() else None) + let (|Tuple|_|) (ty: FSharpType option) = ty |> Option.bind (fun ty -> if ty.IsTupleType then Some() else None) let (|RefCell|_|) (ty: FSharpType) = match getAbbreviatedType ty with | TypeWithDefinition def when def.IsFSharpRecord && def.FullName = "Microsoft.FSharp.Core.FSharpRef`1" -> Some() | _ -> None - let (|FunctionType|_|) (ty: FSharpType) = - if ty.IsFunctionType then Some() else None + let (|FunctionType|_|) (ty: FSharpType) = if ty.IsFunctionType then Some() else None let (|Pattern|_|) (symbol: FSharpSymbol) = match symbol with @@ -519,8 +539,7 @@ module SymbolPatterns = | _ -> None | _ -> None - let (|ExtensionMember|_|) (func: FSharpMemberOrFunctionOrValue) = - if func.IsExtensionMember then Some() else None + let (|ExtensionMember|_|) (func: FSharpMemberOrFunctionOrValue) = if func.IsExtensionMember then Some() else None let (|Event|_|) (func: FSharpMemberOrFunctionOrValue) = if func.IsEvent then Some() else None diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstUtils.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstUtils.fs index 998dad6d6d..7c10c7e993 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstUtils.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/TypedAstUtils.fs @@ -1,9 +1,11 @@ -///Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/Common/TypedAstUtils.fs +//Original code from VisualFSharpPowerTools project: https://github.com/fsprojects/VisualFSharpPowerTools/blob/master/src/FSharp.Editing/Common/TypedAstUtils.fs namespace FsAutoComplete open System open System.Text.RegularExpressions open FSharp.Compiler.Symbols +open UntypedAstUtils + [] module TypedAstUtils = @@ -32,11 +34,9 @@ module TypedAstUtils = | Some name when name = typeof<'T>.Name -> true | _ -> false - let hasAttribute<'T> (attributes: seq) = - attributes |> Seq.exists isAttribute<'T> + let hasAttribute<'T> (attributes: seq) = attributes |> Seq.exists isAttribute<'T> - let tryGetAttribute<'T> (attributes: seq) = - attributes |> Seq.tryFind isAttribute<'T> + let tryGetAttribute<'T> (attributes: seq) = attributes |> Seq.tryFind isAttribute<'T> let hasModuleSuffixAttribute (entity: FSharpEntity) = entity.Attributes @@ -49,23 +49,23 @@ module TypedAstUtils = let res = match arg with | :? int32 as arg when arg = int CompilationRepresentationFlags.ModuleSuffix -> Some() - | :? CompilationRepresentationFlags as arg when arg = CompilationRepresentationFlags.ModuleSuffix -> Some() + | :? CompilationRepresentationFlags as arg when arg = CompilationRepresentationFlags.ModuleSuffix -> + Some() | _ -> None res))) |> Option.isSome let isOperator (name: string) = - name.StartsWith "( " - && name.EndsWith " )" + name.StartsWith("( ", StringComparison.Ordinal) + && name.EndsWith(" )", StringComparison.Ordinal) && name.Length > 4 && name.Substring(2, name.Length - 4) |> String.forall (fun c -> c <> ' ' && not (Char.IsLetter c)) let private UnnamedUnionFieldRegex = Regex("^Item(\d+)?$", RegexOptions.Compiled) - let isUnnamedUnionCaseField (field: FSharpField) = - UnnamedUnionFieldRegex.IsMatch(field.Name) + let isUnnamedUnionCaseField (field: FSharpField) = UnnamedUnionFieldRegex.IsMatch(field.Name) [] module TypedAstExtensionHelpers = @@ -82,7 +82,7 @@ module TypedAstExtensionHelpers = match fullName with | Some fullName -> match Option.attempt (fun _ -> x.DisplayName) with - | Some shortDisplayName when not (shortDisplayName.Contains ".") -> + | Some shortDisplayName when not (shortDisplayName.Contains '.') -> Some(fullName |> Array.replace (fullName.Length - 1) shortDisplayName) | _ -> Some fullName | None -> None @@ -145,7 +145,7 @@ module TypedAstExtensionHelpers = loop x 0 - //TODO: Do we need to unannotate like above? + //TODO: Do we need to un-annotate like above? member x.AllBaseTypes = let rec allBaseTypes (entity: FSharpEntity) = [ match entity.TryFullName with @@ -171,19 +171,32 @@ module TypedAstExtensionHelpers = match fullName with | Some fullName -> match Option.attempt (fun _ -> x.DisplayName) with - | Some shortDisplayName when not (shortDisplayName.Contains ".") -> + | Some shortDisplayName when not (shortDisplayName.Contains '.') -> Some(fullName |> Array.replace (fullName.Length - 1) shortDisplayName) | _ -> Some fullName | None -> None |> Option.map (fun fullDisplayName -> String.Join(".", fullDisplayName)) + member x.TryGetFullCompiledOperatorNameIdents() : Idents option = + // For operator ++ displayName is ( ++ ) compiledName is op_PlusPlus + if isOperator x.DisplayName && x.DisplayName <> x.CompiledName then + x.DeclaringEntity + |> Option.bind (fun e -> e.TryGetFullName()) + |> Option.map (fun enclosingEntityFullName -> + Array.append (enclosingEntityFullName.Split '.') [| x.CompiledName |]) + else + None member x.IsConstructor = x.CompiledName = ".ctor" member x.IsOperatorOrActivePattern = - x.CompiledName.StartsWith "op_" + x.CompiledName.StartsWith("op_", StringComparison.Ordinal) || let name = x.DisplayName in - if name.StartsWith "( " && name.EndsWith " )" && name.Length > 4 then + if + name.StartsWith("( ", StringComparison.Ordinal) + && name.EndsWith(" )", StringComparison.Ordinal) + && name.Length > 4 + then name.Substring(2, name.Length - 4) |> String.forall (fun c -> c <> ' ') else false @@ -218,13 +231,13 @@ module TypedAstExtensionHelpers = type FSharpSymbol with /// - /// If this member is a type abbeviation (type Foo = Bar<string> for example), + /// If this member is a type abbreviation (type Foo = Bar<string> for example), /// resolves the underlying type. Otherwise returns this type. /// member this.GetAbbreviatedParent() = match this with | Entity e -> - if e.IsFSharpAbbreviation then + if e.IsFSharpAbbreviation && e.AbbreviatedType.HasTypeDefinition then e.AbbreviatedType.TypeDefinition.GetAbbreviatedParent() else this @@ -273,7 +286,7 @@ module TypedAstExtensionHelpers = | UnionCase fsu -> fsu.XmlDoc | ActivePattern apc -> apc.XmlDoc | GenericParameter gp -> gp.XmlDoc - | Parameter p -> FSharpXmlDoc.None + | Parameter _ -> FSharpXmlDoc.None type FSharpGenericParameterMemberConstraint with diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/UntypedAstUtils.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/UntypedAstUtils.fs new file mode 100644 index 0000000000..d06bc6af3f --- /dev/null +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/UntypedAstUtils.fs @@ -0,0 +1,676 @@ +namespace FSharp.Compiler + +module Syntax = + open FSharp.Compiler.Syntax + + /// A pattern that collects all attributes from a `SynAttributes` into a single flat list + let (|AllAttrs|) (attrs: SynAttributes) = attrs |> List.collect (fun attrList -> attrList.Attributes) + + /// An recursive pattern that collect all sequential expressions to avoid StackOverflowException + let rec (|Sequentials|_|) = + function + | SynExpr.Sequential(expr1 = e; expr2 = Sequentials es) -> Some(e :: es) + | SynExpr.Sequential(expr1 = e1; expr2 = e2) -> Some [ e1; e2 ] + | _ -> None + + let (|ConstructorPats|) = + function + | SynArgPats.Pats ps -> ps + | SynArgPats.NamePatPairs(pats = xs) -> xs |> List.map (fun (_, _, pat) -> pat) + + /// A pattern that collects all patterns from a `SynSimplePats` into a single flat list + let (|AllSimplePats|) (pats: SynSimplePats) = + let rec loop acc pat = + match pat with + | SynSimplePats.SimplePats(pats = pats) -> acc @ pats + + loop [] pats + + type SyntaxCollectorBase() = + abstract WalkSynModuleOrNamespace: SynModuleOrNamespace -> unit + default _.WalkSynModuleOrNamespace _ = () + abstract WalkAttribute: SynAttribute -> unit + default _.WalkAttribute _ = () + abstract WalkSynModuleDecl: SynModuleDecl -> unit + default _.WalkSynModuleDecl _ = () + abstract WalkExpr: SynExpr -> unit + default _.WalkExpr _ = () + abstract WalkTypar: SynTypar -> unit + default _.WalkTypar _ = () + abstract WalkTyparDecl: SynTyparDecl -> unit + default _.WalkTyparDecl _ = () + abstract WalkTypeConstraint: SynTypeConstraint -> unit + default _.WalkTypeConstraint _ = () + abstract WalkType: SynType -> unit + default _.WalkType _ = () + abstract WalkMemberSig: SynMemberSig -> unit + default _.WalkMemberSig _ = () + abstract WalkPat: SynPat -> unit + default _.WalkPat _ = () + abstract WalkValTyparDecls: SynValTyparDecls -> unit + default _.WalkValTyparDecls _ = () + abstract WalkBinding: SynBinding -> unit + default _.WalkBinding _ = () + abstract WalkSimplePat: SynSimplePat -> unit + default _.WalkSimplePat _ = () + abstract WalkInterfaceImpl: SynInterfaceImpl -> unit + default _.WalkInterfaceImpl _ = () + abstract WalkClause: SynMatchClause -> unit + default _.WalkClause _ = () + abstract WalkInterpolatedStringPart: SynInterpolatedStringPart -> unit + default _.WalkInterpolatedStringPart _ = () + abstract WalkMeasure: SynMeasure -> unit + default _.WalkMeasure _ = () + abstract WalkComponentInfo: SynComponentInfo -> unit + default _.WalkComponentInfo _ = () + abstract WalkTypeDefnSigRepr: SynTypeDefnSigRepr -> unit + default _.WalkTypeDefnSigRepr _ = () + abstract WalkUnionCaseType: SynUnionCaseKind -> unit + default _.WalkUnionCaseType _ = () + abstract WalkEnumCase: SynEnumCase -> unit + default _.WalkEnumCase _ = () + abstract WalkField: SynField -> unit + default _.WalkField _ = () + abstract WalkTypeDefnSimple: SynTypeDefnSimpleRepr -> unit + default _.WalkTypeDefnSimple _ = () + abstract WalkValSig: SynValSig -> unit + default _.WalkValSig _ = () + abstract WalkMember: SynMemberDefn -> unit + default _.WalkMember _ = () + abstract WalkUnionCase: SynUnionCase -> unit + default _.WalkUnionCase _ = () + abstract WalkTypeDefnRepr: SynTypeDefnRepr -> unit + default _.WalkTypeDefnRepr _ = () + abstract WalkTypeDefn: SynTypeDefn -> unit + default _.WalkTypeDefn _ = () + + let walkAst (walker: SyntaxCollectorBase) (input: ParsedInput) : unit = + + let rec walkImplFileInput (ParsedImplFileInput(contents = moduleOrNamespaceList)) = + List.iter walkSynModuleOrNamespace moduleOrNamespaceList + () + + and walkSynModuleOrNamespace (SynModuleOrNamespace(decls = decls; attribs = AllAttrs attrs; range = _) as s) = + walker.WalkSynModuleOrNamespace s + List.iter walkAttribute attrs + List.iter walkSynModuleDecl decls + + and walkAttribute (attr: SynAttribute) = walkExpr attr.ArgExpr + + and walkTyparDecl (SynTyparDecl(attributes = AllAttrs attrs; typar = typar; intersectionConstraints = ts)) = + List.iter walkAttribute attrs + walkTypar typar + List.iter walkType ts + + and walkTyparDecls (typars: SynTyparDecls) = + typars.TyparDecls |> List.iter walkTyparDecl + typars.Constraints |> List.iter walkTypeConstraint + + and walkSynValTyparDecls (SynValTyparDecls(typars, _)) = Option.iter walkTyparDecls typars + + and walkTypeConstraint s = + walker.WalkTypeConstraint s + + match s with + | SynTypeConstraint.WhereTyparIsValueType(t, _) + | SynTypeConstraint.WhereTyparIsReferenceType(t, _) + | SynTypeConstraint.WhereTyparIsUnmanaged(t, _) + | SynTypeConstraint.WhereTyparSupportsNull(t, _) + | SynTypeConstraint.WhereTyparIsComparable(t, _) + | SynTypeConstraint.WhereTyparIsEquatable(t, _) -> walkTypar t + | SynTypeConstraint.WhereTyparDefaultsToType(t, ty, _) + | SynTypeConstraint.WhereTyparSubtypeOfType(t, ty, _) -> + walkTypar t + walkType ty + | SynTypeConstraint.WhereTyparIsEnum(t, ts, _) + | SynTypeConstraint.WhereTyparIsDelegate(t, ts, _) -> + walkTypar t + List.iter walkType ts + | SynTypeConstraint.WhereTyparSupportsMember(t, sign, _) -> + walkType t + walkMemberSig sign + | SynTypeConstraint.WhereSelfConstrained(t, _) -> walkType t + | SynTypeConstraint.WhereTyparNotSupportsNull(t, _, _) -> walkTypar t + + and walkPat s = + walker.WalkPat s + + match s with + | SynPat.Tuple(elementPats = pats) + | SynPat.ArrayOrList(elementPats = pats) + | SynPat.Ands(pats = pats) -> List.iter walkPat pats + | SynPat.Named _ -> () + | SynPat.Typed(pat, t, _) -> + walkPat pat + walkType t + | SynPat.Attrib(pat, AllAttrs attrs, _) -> + walkPat pat + List.iter walkAttribute attrs + | SynPat.Or(pat1, pat2, _, _) -> List.iter walkPat [ pat1; pat2 ] + | SynPat.LongIdent(typarDecls = typars; argPats = ConstructorPats pats; range = _) -> + Option.iter walkSynValTyparDecls typars + List.iter walkPat pats + | SynPat.Paren(pat, _) -> walkPat pat + | SynPat.IsInst(t, _) -> walkType t + | SynPat.QuoteExpr(e, _) -> walkExpr e + | SynPat.Const _ -> () + | SynPat.Wild _ -> () + | SynPat.Record _ -> () + | SynPat.Null _ -> () + | SynPat.OptionalVal _ -> () + | SynPat.InstanceMember _ -> () + | SynPat.FromParseError _ -> () + | SynPat.As(lpat, rpat, _) -> + walkPat lpat + walkPat rpat + | SynPat.ListCons(lpat, rpat, _, _) -> + walkPat lpat + walkPat rpat + + and walkTypar (SynTypar _ as s) = walker.WalkTypar s + + and walkBinding + (SynBinding(attributes = AllAttrs attrs; headPat = pat; returnInfo = returnInfo; expr = e; range = _) as s) + = + walker.WalkBinding s + List.iter walkAttribute attrs + walkPat pat + walkExpr e + + returnInfo + |> Option.iter (fun (SynBindingReturnInfo(t, _, attrs, _)) -> + walkType t + walkAttributes attrs) + + and walkAttributes (attrs: SynAttributes) = + List.iter (fun (attrList: SynAttributeList) -> List.iter walkAttribute attrList.Attributes) attrs + + and walkInterfaceImpl (SynInterfaceImpl(bindings = bindings; range = _) as s) = + walker.WalkInterfaceImpl s + List.iter walkBinding bindings + + and walkType s = + walker.WalkType s + + match s with + | SynType.Array(_, t, _) + | SynType.HashConstraint(t, _) + | SynType.MeasurePower(t, _, _) -> walkType t + | SynType.Fun(t1, t2, _, _) -> + // | SynType.MeasureDivide(t1, t2, r) -> + walkType t1 + walkType t2 + | SynType.App(ty, _, types, _, _, _, _) -> + walkType ty + List.iter walkType types + | SynType.LongIdentApp(_, _, _, types, _, _, _) -> List.iter walkType types + | SynType.Tuple(_, ts, _) -> + ts + |> List.iter (function + | SynTupleTypeSegment.Type t -> walkType t + | _ -> ()) + | SynType.WithGlobalConstraints(t, typeConstraints, _) -> + walkType t + List.iter walkTypeConstraint typeConstraints + | SynType.LongIdent _ -> () + | SynType.AnonRecd _ -> () + | SynType.Var _ -> () + | SynType.Anon _ -> () + | SynType.StaticConstant _ -> () + | SynType.StaticConstantExpr _ -> () + | SynType.StaticConstantNamed _ -> () + | SynType.Paren(innerType, _) -> walkType innerType + | SynType.SignatureParameter(usedType = t; range = _) -> walkType t + | SynType.Or(lhs, rhs, _, _) -> + walkType lhs + walkType rhs + | SynType.FromParseError _ -> () + | SynType.Intersection(typar, types, _, _) -> + Option.iter walkTypar typar + List.iter walkType types + | SynType.StaticConstantNull(_) -> () + | SynType.WithNull(t, _, _, _) -> walkType t + + and walkClause (SynMatchClause(pat, e1, e2, _, _, _) as s) = + walker.WalkClause s + walkPat pat + walkExpr e2 + e1 |> Option.iter walkExpr + + and walkSimplePats = + function + | SynSimplePats.SimplePats(pats = pats; range = _) -> List.iter walkSimplePat pats + + and walkInterpolatedStringPart s = + walker.WalkInterpolatedStringPart s + + match s with + | SynInterpolatedStringPart.FillExpr(expr, _) -> walkExpr expr + | SynInterpolatedStringPart.String _ -> () + + and walkExpr s = + walker.WalkExpr s + + match s with + | SynExpr.Typed(expr = e) + | SynExpr.Paren(expr = e) + | SynExpr.InferredUpcast(expr = e) + | SynExpr.InferredDowncast(expr = e) + | SynExpr.AddressOf(expr = e) + | SynExpr.DoBang(expr = e) + | SynExpr.YieldOrReturn(expr = e) + | SynExpr.ArrayOrListComputed(expr = e) + | SynExpr.ComputationExpr(expr = e) + | SynExpr.Do(expr = e) + | SynExpr.Assert(expr = e) + | SynExpr.Lazy(expr = e) + | SynExpr.YieldOrReturnFrom(expr = e) + | SynExpr.DotLambda(expr = e) -> walkExpr e + | SynExpr.Quote(operator, _, quotedExpr, _, _) -> + walkExpr operator + walkExpr quotedExpr + | SynExpr.SequentialOrImplicitYield(_, e1, e2, ifNotE, _) -> + walkExpr e1 + walkExpr e2 + walkExpr ifNotE + | SynExpr.Lambda(args = pats; body = e; range = _) -> + walkSimplePats pats + walkExpr e + | SynExpr.New(_, t, e, _) + | SynExpr.TypeTest(e, t, _) + | SynExpr.Upcast(e, t, _) + | SynExpr.Downcast(e, t, _) -> + walkExpr e + walkType t + | SynExpr.Tuple(_, es, _, _) + | Sequentials es -> List.iter walkExpr es //TODO?? + | SynExpr.ArrayOrList(_, es, _) -> List.iter walkExpr es + | SynExpr.App(_, _, e1, e2, _) + | SynExpr.TryFinally(e1, e2, _, _, _, _) + | SynExpr.While(_, e1, e2, _) -> List.iter walkExpr [ e1; e2 ] + | SynExpr.Record(_, _, fields, _) -> + + fields + |> List.iter (fun (SynExprRecordField(fieldName = (_, _); expr = e)) -> e |> Option.iter walkExpr) + | SynExpr.ObjExpr(ty, argOpt, _, bindings, _, ifaces, _, _) -> + + argOpt |> Option.iter (fun (e, _) -> walkExpr e) + + walkType ty + List.iter walkBinding bindings + List.iter walkInterfaceImpl ifaces + | SynExpr.For(identBody = e1; toBody = e2; doBody = e3; range = _) -> List.iter walkExpr [ e1; e2; e3 ] + | SynExpr.ForEach(_, _, _, _, pat, e1, e2, _) -> + walkPat pat + List.iter walkExpr [ e1; e2 ] + | SynExpr.MatchLambda(_, _, synMatchClauseList, _, _) -> List.iter walkClause synMatchClauseList + | SynExpr.Match(expr = e; clauses = synMatchClauseList; range = _) -> + walkExpr e + List.iter walkClause synMatchClauseList + | SynExpr.TypeApp(e, _, tys, _, _, _, _) -> + List.iter walkType tys + walkExpr e + | SynExpr.LetOrUse(bindings = bindings; body = e; range = _) -> + List.iter walkBinding bindings + walkExpr e + | SynExpr.TryWith(tryExpr = e; withCases = clauses; range = _) -> + List.iter walkClause clauses + walkExpr e + | SynExpr.IfThenElse(ifExpr = e1; thenExpr = e2; elseExpr = e3; range = _) -> + List.iter walkExpr [ e1; e2 ] + e3 |> Option.iter walkExpr + | SynExpr.LongIdentSet(_, e, _) + | SynExpr.DotGet(e, _, _, _) -> walkExpr e + | SynExpr.DotSet(e1, _, e2, _) -> + walkExpr e1 + walkExpr e2 + | SynExpr.DotIndexedGet(e, args, _, _) -> + walkExpr e + walkExpr args + | SynExpr.DotIndexedSet(e1, args, e2, _, _, _) -> + walkExpr e1 + walkExpr args + walkExpr e2 + | SynExpr.NamedIndexedPropertySet(_, e1, e2, _) -> List.iter walkExpr [ e1; e2 ] + | SynExpr.DotNamedIndexedPropertySet(e1, _, e2, e3, _) -> List.iter walkExpr [ e1; e2; e3 ] + | SynExpr.JoinIn(e1, _, e2, _) -> List.iter walkExpr [ e1; e2 ] + | SynExpr.LetOrUseBang(pat = pat; rhs = e1; andBangs = ands; body = e2; range = _) -> + walkPat pat + walkExpr e1 + + for SynExprAndBang(pat = pat; body = body; range = _) in ands do + walkPat pat + walkExpr body + + walkExpr e2 + | SynExpr.TraitCall(t, sign, e, _) -> + walkType t + walkMemberSig sign + walkExpr e + | SynExpr.Const(SynConst.Measure(synMeasure = m), _) -> walkMeasure m + | SynExpr.Const _ -> () + | SynExpr.AnonRecd _ -> () + | SynExpr.Sequential _ -> () + | SynExpr.Ident _ -> () + | SynExpr.LongIdent _ -> () + | SynExpr.Set _ -> () + | SynExpr.Null _ -> () + | SynExpr.ImplicitZero _ -> () + | SynExpr.MatchBang(range = _) -> () + | SynExpr.LibraryOnlyILAssembly _ -> () + | SynExpr.LibraryOnlyStaticOptimization _ -> () + | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> () + | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> () + | SynExpr.ArbitraryAfterError _ -> () + | SynExpr.FromParseError _ -> () + | SynExpr.DiscardAfterMissingQualificationAfterDot _ -> () + | SynExpr.Fixed _ -> () + | SynExpr.InterpolatedString(parts, _, _) -> + + for part in parts do + walkInterpolatedStringPart part + | SynExpr.IndexFromEnd(itemExpr, _) -> walkExpr itemExpr + | SynExpr.IndexRange(e1, _, e2, _, _, _) -> + Option.iter walkExpr e1 + Option.iter walkExpr e2 + | SynExpr.DebugPoint(innerExpr = expr) -> walkExpr expr + | SynExpr.Dynamic(funcExpr = e1; argExpr = e2; range = _) -> + walkExpr e1 + walkExpr e2 + | SynExpr.Typar(t, _) -> walkTypar t + | SynExpr.WhileBang(whileExpr = whileExpr; doExpr = doExpr) -> + walkExpr whileExpr + walkExpr doExpr + + and walkMeasure s = + walker.WalkMeasure s + + match s with + | SynMeasure.Product(measure1 = m1; measure2 = m2) -> + walkMeasure m1 + walkMeasure m2 + | SynMeasure.Divide(m1, _, m2, _) -> + Option.iter walkMeasure m1 + walkMeasure m2 + | SynMeasure.Named _ -> () + | SynMeasure.Seq(ms, _) -> List.iter walkMeasure ms + | SynMeasure.Power(m, _, _, _) -> walkMeasure m + | SynMeasure.Var(ty, _) -> walkTypar ty + | SynMeasure.Paren(m, _) -> walkMeasure m + | SynMeasure.One _ + | SynMeasure.Anon _ -> () + + and walkSimplePat s = + walker.WalkSimplePat s + + match s with + | SynSimplePat.Attrib(pat, AllAttrs attrs, _) -> + walkSimplePat pat + List.iter walkAttribute attrs + | SynSimplePat.Typed(pat, t, _) -> + walkSimplePat pat + walkType t + | SynSimplePat.Id _ -> () + + and walkField (SynField(attributes = AllAttrs attrs; fieldType = t; range = _) as s) = + walker.WalkField s + List.iter walkAttribute attrs + walkType t + + and walkValSig + (SynValSig(attributes = AllAttrs attrs; synType = t; arity = SynValInfo(argInfos, argInfo); range = _) as s) + = + walker.WalkValSig s + List.iter walkAttribute attrs + walkType t + + argInfo :: (argInfos |> List.concat) + |> List.collect (fun (SynArgInfo(attributes = AllAttrs attrs)) -> attrs) + |> List.iter walkAttribute + + and walkMemberSig s = + walker.WalkMemberSig s + + match s with + | SynMemberSig.Inherit(t, _) + | SynMemberSig.Interface(t, _) -> walkType t + | SynMemberSig.Member(vs, _, _, _) -> walkValSig vs + | SynMemberSig.ValField(f, _) -> walkField f + | SynMemberSig.NestedType(SynTypeDefnSig(typeInfo = info; typeRepr = repr; members = memberSigs), _) -> + + walkComponentInfo info + walkTypeDefnSigRepr repr + List.iter walkMemberSig memberSigs + + and walkMember s = + walker.WalkMember s + + match s with + | SynMemberDefn.AbstractSlot(valSig, _, _, _) -> walkValSig valSig + | SynMemberDefn.Member(binding, _) -> walkBinding binding + | SynMemberDefn.ImplicitCtor(attributes = AllAttrs attrs; ctorArgs = ctorPattern) -> + List.iter walkAttribute attrs + walkPat ctorPattern + | SynMemberDefn.ImplicitInherit(inheritType = t; inheritArgs = e) -> + walkType t + walkExpr e + | SynMemberDefn.LetBindings(bindings, _, _, _) -> List.iter walkBinding bindings + | SynMemberDefn.Interface(t, _, members, _) -> + walkType t + members |> Option.iter (List.iter walkMember) + | SynMemberDefn.Inherit(baseType = t) -> t |> Option.iter walkType + | SynMemberDefn.ValField(field, _) -> walkField field + | SynMemberDefn.NestedType(tdef, _, _) -> walkTypeDefn tdef + | SynMemberDefn.AutoProperty(attributes = AllAttrs attrs; typeOpt = t; synExpr = e; range = _) -> + List.iter walkAttribute attrs + Option.iter walkType t + walkExpr e + | SynMemberDefn.Open _ -> () + | SynMemberDefn.GetSetMember(memberDefnForGet = getter; memberDefnForSet = setter; range = _) -> + Option.iter walkBinding getter + Option.iter walkBinding setter + + and walkEnumCase (SynEnumCase(attributes = AllAttrs attrs; range = _) as s) = + walker.WalkEnumCase s + List.iter walkAttribute attrs + + and walkUnionCaseType s = + walker.WalkUnionCaseType s + + match s with + | SynUnionCaseKind.Fields fields -> List.iter walkField fields + | SynUnionCaseKind.FullType(t, _) -> walkType t + + and walkUnionCase (SynUnionCase(attributes = AllAttrs attrs; caseType = t; range = _) as s) = + walker.WalkUnionCase s + List.iter walkAttribute attrs + walkUnionCaseType t + + and walkTypeDefnSimple s = + walker.WalkTypeDefnSimple s + + match s with + | SynTypeDefnSimpleRepr.Enum(cases, _) -> List.iter walkEnumCase cases + | SynTypeDefnSimpleRepr.Union(_, cases, _) -> List.iter walkUnionCase cases + | SynTypeDefnSimpleRepr.Record(_, fields, _) -> List.iter walkField fields + | SynTypeDefnSimpleRepr.TypeAbbrev(_, t, _) -> walkType t + | SynTypeDefnSimpleRepr.General _ -> () + | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly _ -> () + | SynTypeDefnSimpleRepr.None _ -> () + | SynTypeDefnSimpleRepr.Exception _ -> () + + and walkComponentInfo + (SynComponentInfo( + attributes = AllAttrs attrs; typeParams = typars; constraints = constraints; longId = _; range = _) as s) + = + walker.WalkComponentInfo s + List.iter walkAttribute attrs + Option.iter walkTyparDecls typars + List.iter walkTypeConstraint constraints + + and walkTypeDefnRepr s = + walker.WalkTypeDefnRepr s + + match s with + | SynTypeDefnRepr.ObjectModel(_, defns, _) -> List.iter walkMember defns + | SynTypeDefnRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnRepr.Exception _ -> () + + and walkTypeDefnSigRepr s = + walker.WalkTypeDefnSigRepr s + + match s with + | SynTypeDefnSigRepr.ObjectModel(_, defns, _) -> List.iter walkMemberSig defns + | SynTypeDefnSigRepr.Simple(defn, _) -> walkTypeDefnSimple defn + | SynTypeDefnSigRepr.Exception _ -> () + + and walkTypeDefn (SynTypeDefn(info, repr, members, implicitCtor, _, _) as s) = + walker.WalkTypeDefn s + + walkComponentInfo info + walkTypeDefnRepr repr + Option.iter walkMember implicitCtor + List.iter walkMember members + + and walkSynModuleDecl (decl: SynModuleDecl) = + walker.WalkSynModuleDecl decl + + match decl with + | SynModuleDecl.NamespaceFragment fragment -> walkSynModuleOrNamespace fragment + | SynModuleDecl.NestedModule(info, _, modules, _, _, _) -> + walkComponentInfo info + List.iter walkSynModuleDecl modules + | SynModuleDecl.Let(_, bindings, _) -> List.iter walkBinding bindings + | SynModuleDecl.Expr(expr, _) -> walkExpr expr + | SynModuleDecl.Types(types, _) -> List.iter walkTypeDefn types + | SynModuleDecl.Attributes(attributes = AllAttrs attrs; range = _) -> List.iter walkAttribute attrs + | SynModuleDecl.ModuleAbbrev _ -> () + | SynModuleDecl.Exception _ -> () + | SynModuleDecl.Open _ -> () + | SynModuleDecl.HashDirective _ -> () + + + match input with + | ParsedInput.ImplFile input -> walkImplFileInput input + | _ -> () + +namespace FsAutoComplete + +module UntypedAstUtils = + + open FSharp.Compiler.Syntax + open FSharp.Compiler.Text + + type Range with + + member inline x.IsEmpty = x.StartColumn = x.EndColumn && x.StartLine = x.EndLine + + type internal ShortIdent = string + type internal Idents = ShortIdent[] + + let internal longIdentToArray (longIdent: LongIdent) : Idents = longIdent |> Seq.map string |> Seq.toArray + + /// matches if the range contains the position + let (|ContainsPos|_|) pos range = if Range.rangeContainsPos range pos then Some() else None + + /// Active pattern that matches an ident on a given name by the ident's `idText` + let (|Ident|_|) ofName = + function + | SynExpr.Ident ident when ident.idText = ofName -> Some() + | _ -> None + + /// matches if the range contains the position + let (|IdentContainsPos|_|) pos (ident: Ident) = (|ContainsPos|_|) pos ident.idRange + +module FoldingRange = + open FSharp.Compiler.Text + open FSharp.Compiler.Syntax + + /// a walker that collects all ranges of syntax elements that contain the given position + [] + type private RangeCollectorWalker(pos: Position) = + inherit SyntaxCollectorBase() + let ranges = ResizeArray() + + let addIfInside (m: Range) = + if (Range.rangeContainsPos m pos) then + ranges.Add m + + override _.WalkSynModuleOrNamespace m = addIfInside m.Range + override _.WalkAttribute a = addIfInside a.Range + override _.WalkTypeConstraint c = addIfInside c.Range + override _.WalkPat p = addIfInside p.Range + + override _.WalkBinding(SynBinding(range = r; returnInfo = ri)) = + addIfInside r + ri |> Option.iter (fun (SynBindingReturnInfo(range = r')) -> addIfInside r') + + override _.WalkInterfaceImpl(SynInterfaceImpl(range = range)) = addIfInside range + override _.WalkType t = addIfInside t.Range + override _.WalkClause c = addIfInside c.Range + + override _.WalkInterpolatedStringPart i = + match i with + | SynInterpolatedStringPart.FillExpr(qualifiers = Some ident) -> addIfInside ident.idRange + | SynInterpolatedStringPart.String(_, r) -> addIfInside r + | _ -> () + + override _.WalkExpr e = addIfInside e.Range + + override _.WalkMeasure m = + match m with + | SynMeasure.Product(range = r) + | SynMeasure.Divide(range = r) + | SynMeasure.Named(range = r) + | SynMeasure.Seq(range = r) + | SynMeasure.Power(range = r) + | SynMeasure.Var(range = r) + | SynMeasure.Paren(range = r) + | SynMeasure.One(range = r) + | SynMeasure.Anon(range = r) -> addIfInside r + + override _.WalkSimplePat p = addIfInside p.Range + override _.WalkField(SynField(range = r)) = addIfInside r + override _.WalkValSig(SynValSig(range = r)) = addIfInside r + override _.WalkMemberSig m = addIfInside m.Range + override _.WalkMember m = addIfInside m.Range + override _.WalkEnumCase e = addIfInside e.Range + override _.WalkUnionCase u = addIfInside u.Range + override _.WalkTypeDefnSimple s = addIfInside s.Range + override _.WalkComponentInfo c = addIfInside c.Range + override _.WalkTypeDefnRepr t = addIfInside t.Range + override _.WalkTypeDefnSigRepr t = addIfInside t.Range + override _.WalkTypeDefn t = addIfInside t.Range + override _.WalkSynModuleDecl s = addIfInside s.Range + + member _.Ranges = ranges + + let getRangesAtPosition input (r: Position) : Range list = + let walker = RangeCollectorWalker(r) + walkAst walker input + walker.Ranges |> Seq.toList + +module Completion = + open FSharp.Compiler.Text + open FSharp.Compiler.Syntax + + [] + type Context = + | StringLiteral + | Unknown + | SynType + + let atPos (pos: Position, ast: ParsedInput) : Context = + (pos, ast) + ||> ParsedInput.tryPick (fun _path node -> + match node with + | SyntaxNode.SynType _ -> Some Context.SynType + | _ -> None) + |> Option.orElseWith (fun () -> + ast + |> ParsedInput.tryNode pos + |> Option.bind (fun (node, _path) -> + match node with + | SyntaxNode.SynExpr(SynExpr.Const(SynConst.String _, _)) -> Some Context.StringLiteral + | _ -> None)) + |> Option.defaultValue Context.Unknown diff --git a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Utils.fs b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Utils.fs index 9ccd8575c2..cd6cba2110 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Utils.fs +++ b/src/Microsoft.DotNet.Interactive.FSharp/FsAutoComplete/Utils.fs @@ -8,6 +8,16 @@ open System.Collections.Concurrent open System open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Symbols +open System.Runtime.CompilerServices +open System.Globalization + + +/// Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources. +let dispose (d: #IDisposable) = d.Dispose() + +/// Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources asynchronously. +/// A task that represents the asynchronous dispose operation. +let disposeAsync (d: #IAsyncDisposable) = d.DisposeAsync() module internal Map = /// Combine two maps of identical types by starting with the first map and overlaying the second one. @@ -15,7 +25,7 @@ module internal Map = let merge (first: Map<'a, 'b>) (second: Map<'a, 'b>) = let mutable result = first - for (KeyValue (key, value)) in second do + for (KeyValue(key, value)) in second do result <- Map.add key value result result @@ -24,7 +34,7 @@ module internal Map = let combineTakeFirst (first: Map<_, _>) (second: Map<_, _>) = let mutable result = first - for (KeyValue (key, value)) in second do + for (KeyValue(key, value)) in second do if result.ContainsKey key then () else @@ -34,7 +44,7 @@ module internal Map = let values (m: Map<_, _>) = seq { - for (KeyValue (_, value)) in m do + for (KeyValue(_, value)) in m do yield value } @@ -52,9 +62,12 @@ module Seq = } module ProcessHelper = + let WaitForExitAsync (p: Process) = async { - let tcs = TaskCompletionSource() + let tcs = + TaskCompletionSource(TaskCreationOptions.RunContinuationsAsynchronously) + p.EnableRaisingEvents <- true p.Exited.Add(fun _args -> tcs.TrySetResult(null) |> ignore) @@ -66,8 +79,6 @@ module ProcessHelper = () } - - type ResultOrString<'a> = Result<'a, string> type Serializer = obj -> string @@ -98,32 +109,35 @@ type Document = GetLineText0: int -> string GetLineText1: int -> string } + /// /// Checks if the file ends with `.fsx` `.fsscript` or `.sketchfs` /// -let isAScript (fileName: string) = - let ext = Path.GetExtension(fileName) - - [ ".fsx"; ".fsscript"; ".sketchfs" ] |> List.exists ((=) ext) +let inline isAScript (fileName: ReadOnlySpan) = + fileName.EndsWith ".fsx" + || fileName.EndsWith ".fsscript" + || fileName.EndsWith ".sketchfs" /// /// Checks if the file ends with `.fsi` /// -let isSignatureFile (fileName: string) = fileName.EndsWith ".fsi" +let inline isSignatureFile (fileName: ReadOnlySpan) = fileName.EndsWith ".fsi" +let inline isSignatureFileStr (fileName: string) = fileName.EndsWith ".fsi" /// /// Checks if the file ends with `.fs` /// -let isFsharpFile (fileName: string) = fileName.EndsWith ".fs" +let isFsharpFile (fileName: ReadOnlySpan) = fileName.EndsWith ".fs" + +let inline internal isFileWithFSharpI fileName = isAScript fileName || isSignatureFile fileName || isFsharpFile fileName + /// /// This is a combination of `isAScript`, `isSignatureFile`, and `isFsharpFile` /// /// /// -let isFileWithFSharp fileName = - [ isAScript; isSignatureFile; isFsharpFile ] - |> List.exists (fun f -> f fileName) +let inline isFileWithFSharp (fileName: string) = isFileWithFSharpI (fileName.AsSpan()) let normalizePath (file: string) : string = if isFileWithFSharp file then @@ -132,8 +146,7 @@ let normalizePath (file: string) : string = else file -let inline combinePaths path1 (path2: string) = - Path.Combine(path1, path2.TrimStart [| '\\'; '/' |]) +let inline combinePaths path1 (path2: string) = Path.Combine(path1, path2.TrimStart [| '\\'; '/' |]) let inline () path1 path2 = combinePaths path1 path2 @@ -144,7 +157,9 @@ let projectOptionsToParseOptions (checkOptions: FSharpProjectOptions) = | [||] -> checkOptions.OtherOptions |> Array.where (isFileWithFSharp) | x -> x - { FSharpParsingOptions.Default with SourceFiles = files } + { FSharpParsingOptions.Default with + SourceFiles = files } + [] module Option = @@ -170,9 +185,13 @@ module Result = | Some x -> Ok x | None -> Error(recover ()) + let inline ofVOption recover o = + match o with + | ValueSome x -> Ok x + | ValueNone -> Error(recover ()) + /// ensure the condition is true before continuing - let inline guard condition errorValue = - if condition () then Ok() else Error errorValue + let inline guard condition errorValue = if condition () then Ok() else Error errorValue [] module Async = @@ -205,6 +224,14 @@ module Async = // Start the workflow using a provided cancellation token Async.StartWithContinuations(work, cont, econt, ccont, cancellationToken = cancellationToken)) + /// Creates an asynchronous computation that executes all the given asynchronous computations, using 75% of the Environment.ProcessorCount + /// A sequence of distinct computations to be parallelized. + let parallel75 computations = + let maxConcurrency = + Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75)) + + Async.Parallel(computations, int maxConcurrency) + [] module Array = /// Async implementation of Array.map. @@ -226,141 +253,6 @@ module AsyncResult = let inline bimap okF errF r = Async.map (Result.bimap okF errF) r let inline ofOption recover o = Async.map (Result.ofOption recover) o -// Maybe computation expression builder, copied from ExtCore library -/// https://github.com/jack-pappas/ExtCore/blob/master/ExtCore/Control.fs -[] -type MaybeBuilder() = - // 'T -> M<'T> - [] - member inline __.Return value : 'T option = Some value - - // M<'T> -> M<'T> - [] - member inline __.ReturnFrom value : 'T option = value - - // unit -> M<'T> - [] - member inline __.Zero() : unit option = Some() // TODO: Should this be None? - - // (unit -> M<'T>) -> M<'T> - [] - member __.Delay(f: unit -> 'T option) : 'T option = f () - - // M<'T> -> M<'T> -> M<'T> - // or - // M -> M<'T> -> M<'T> - [] - member inline __.Combine(r1, r2: 'T option) : 'T option = - match r1 with - | None -> None - | Some () -> r2 - - // M<'T> * ('T -> M<'U>) -> M<'U> - [] - member inline __.Bind(value, f: 'T -> 'U option) : 'U option = Option.bind f value - - // 'T * ('T -> M<'U>) -> M<'U> when 'U :> IDisposable - [] - member __.Using(resource: ('T :> IDisposable), body: _ -> _ option) : _ option = - try - body resource - finally - if not <| obj.ReferenceEquals(null, box resource) then - resource.Dispose() - - // (unit -> bool) * M<'T> -> M<'T> - [] - member x.While(guard, body: _ option) : _ option = - if guard () then - // OPTIMIZE: This could be simplified so we don't need to make calls to Bind and While. - x.Bind(body, (fun () -> x.While(guard, body))) - else - x.Zero() - - // seq<'T> * ('T -> M<'U>) -> M<'U> - // or - // seq<'T> * ('T -> M<'U>) -> seq> - [] - member x.For(sequence: seq<_>, body: 'T -> unit option) : _ option = - // OPTIMIZE: This could be simplified so we don't need to make calls to Using, While, Delay. - x.Using(sequence.GetEnumerator(), (fun enum -> x.While(enum.MoveNext, x.Delay(fun () -> body enum.Current)))) - -[] -type AsyncMaybeBuilder() = - [] - member __.Return value : Async<'T option> = Some value |> async.Return - - [] - member __.ReturnFrom value : Async<'T option> = value - - [] - member __.ReturnFrom(value: 'T option) : Async<'T option> = async.Return value - - [] - member __.Zero() : Async = Some() |> async.Return - - [] - member __.Delay(f: unit -> Async<'T option>) : Async<'T option> = f () - - [] - member __.Combine(r1, r2: Async<'T option>) : Async<'T option> = - async { - let! r1' = r1 - - match r1' with - | None -> return None - | Some () -> return! r2 - } - - [] - member __.Bind(value: Async<'T option>, f: 'T -> Async<'U option>) : Async<'U option> = - async { - let! value' = value - - match value' with - | None -> return None - | Some result -> return! f result - } - - [] - member __.Bind(value: 'T option, f: 'T -> Async<'U option>) : Async<'U option> = - async { - match value with - | None -> return None - | Some result -> return! f result - } - - [] - member __.Using(resource: ('T :> IDisposable), body: _ -> Async<_ option>) : Async<_ option> = - try - body resource - finally - if not << isNull <| resource then - resource.Dispose() - - [] - member x.While(guard, body: Async<_ option>) : Async<_ option> = - if guard () then - x.Bind(body, (fun () -> x.While(guard, body))) - else - x.Zero() - - [] - member x.For(sequence: seq<_>, body: 'T -> Async) : Async<_ option> = - x.Using(sequence.GetEnumerator(), (fun enum -> x.While(enum.MoveNext, x.Delay(fun () -> body enum.Current)))) - - [] - member inline __.TryWith(computation: Async<'T option>, catchHandler: exn -> Async<'T option>) : Async<'T option> = - async.TryWith(computation, catchHandler) - - [] - member inline __.TryFinally(computation: Async<'T option>, compensation: unit -> unit) : Async<'T option> = - async.TryFinally(computation, compensation) - -[] -module AsyncMaybe = - let inline liftAsync (async: Async<'T>) : Async<_ option> = async |> Async.map Some - [] [] @@ -449,8 +341,7 @@ module Array = let startsWith (prefix: _[]) (whole: _[]) = isSubArray prefix whole 0 /// Returns true if one array has trailing elements equal to another's. - let endsWith (suffix: _[]) (whole: _[]) = - isSubArray suffix whole (whole.Length - suffix.Length) + let endsWith (suffix: _[]) (whole: _[]) = isSubArray suffix whole (whole.Length - suffix.Length) /// Returns a new array with an element replaced with a given value. let replace index value (array: _[]) = @@ -470,13 +361,13 @@ module Array = if areEqual array [||] then () else - let arrlen, revlen = array.Length - 1, array.Length / 2 - 1 + let arrLen, revLen = array.Length - 1, array.Length / 2 - 1 - for idx in 0..revlen do + for idx in 0..revLen do let t1 = array.[idx] - let t2 = array.[arrlen - idx] + let t2 = array.[arrLen - idx] array.[idx] <- t2 - array.[arrlen - idx] <- t1 + array.[arrLen - idx] <- t1 let splitAt (n: int) (xs: 'a[]) : 'a[] * 'a[] = match xs with @@ -499,15 +390,20 @@ module Array = module List = ///Returns the greatest of all elements in the list that is less than the threshold - let maxUnderThreshold nmax = - List.maxBy (fun n -> if n > nmax then 0 else n) - - + let maxUnderThreshold nmax = List.maxBy (fun n -> if n > nmax then 0 else n) + /// Groups a tupled list by the first item to produce a list of values + let groupByFst (tupledItems: ('Key * 'Value) list) = + tupledItems + |> List.groupBy (fst) + |> List.map (fun (key, list) -> key, list |> List.map snd) [] [] module String = + /// Concatenates all the elements of a string array, using the specified separator between each element. + let inline join (separator: string) (items: string seq) = String.Join(separator, items) + let inline toCharArray (str: string) = str.ToCharArray() let lowerCaseFirstChar (str: string) = @@ -539,9 +435,12 @@ module String = let (|StartsWith|_|) (pattern: string) (value: string) = - if String.IsNullOrWhiteSpace value then None - elif value.StartsWith pattern then Some() - else None + if String.IsNullOrWhiteSpace value then + None + elif value.StartsWith(pattern, StringComparison.Ordinal) then + Some() + else + None let split (splitter: char) (s: string) = s.Split([| splitter |], StringSplitOptions.RemoveEmptyEntries) |> List.ofArray @@ -555,7 +454,7 @@ module String = yield line.Value line.Value <- reader.ReadLine() - if str.EndsWith("\n") then + if str.EndsWith("\n", StringComparison.Ordinal) then // last trailing space not returned // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak yield String.Empty |] @@ -569,6 +468,72 @@ module String = | -1 -> NoMatch | n -> Split(s.[0 .. n - 1], s.Substring(n + 1)) +[] +type ReadOnlySpanExtensions = + /// Note: empty string -> 1 line + [] + static member CountLines(text: ReadOnlySpan) = + let mutable count = 0 + + for _ in text.EnumerateLines() do + count <- count + 1 + + count + + [] + static member LastLine(text: ReadOnlySpan) = + let mutable line = ReadOnlySpan.Empty + + for current in text.EnumerateLines() do + line <- current + + line + +#if !NET7_0_OR_GREATER + [] + static member IndexOfAnyExcept(span: ReadOnlySpan, value0: char, value1: char) = + let mutable i = 0 + let mutable found = false + + while not found && i < span.Length do + let c = span[i] + + if c <> value0 && c <> value1 then + found <- true + else + i <- i + 1 + + if found then i else -1 + + [] + static member IndexOfAnyExcept(span: ReadOnlySpan, values: ReadOnlySpan) = + let mutable i = 0 + let mutable found = false + + while not found && i < span.Length do + if values.IndexOf span[i] < 0 then + found <- true + else + i <- i + 1 + + if found then i else -1 + + [] + static member LastIndexOfAnyExcept(span: ReadOnlySpan, value0: char, value1: char) = + let mutable i = span.Length - 1 + let mutable found = false + + while not found && i >= 0 do + let c = span[i] + + if c <> value0 && c <> value1 then + found <- true + else + i <- i - 1 + + if found then i else -1 +#endif + type ConcurrentDictionary<'key, 'value> with member x.TryFind key = @@ -676,27 +641,23 @@ type Path with let inline debug msg = Printf.kprintf Debug.WriteLine msg let inline fail msg = Printf.kprintf Debug.Fail msg -let asyncMaybe = AsyncMaybeBuilder() -let maybe = MaybeBuilder() let chooseByPrefix (prefix: string) (s: string) = - if s.StartsWith(prefix) then + if s.StartsWith(prefix, StringComparison.Ordinal) then Some(s.Substring(prefix.Length)) else None -let chooseByPrefix2 prefixes (s: string) = - prefixes |> List.tryPick (fun prefix -> chooseByPrefix prefix s) +let chooseByPrefix2 prefixes (s: string) = prefixes |> List.tryPick (fun prefix -> chooseByPrefix prefix s) let splitByPrefix (prefix: string) (s: string) = - if s.StartsWith(prefix) then + if s.StartsWith(prefix, StringComparison.Ordinal) then Some(prefix, s.Substring(prefix.Length)) else None -let splitByPrefix2 prefixes (s: string) = - prefixes |> List.tryPick (fun prefix -> splitByPrefix prefix s) +let splitByPrefix2 prefixes (s: string) = prefixes |> List.tryPick (fun prefix -> splitByPrefix prefix s) [] module Patterns = @@ -704,7 +665,7 @@ module Patterns = let (|StartsWith|_|) (pat: string) (str: string) = match str with | null -> None - | _ when str.StartsWith pat -> Some str + | _ when str.StartsWith(pat, StringComparison.Ordinal) -> Some str | _ -> None let (|Contains|_|) (pat: string) (str: string) = @@ -722,7 +683,7 @@ module Version = let private informationalVersion () = let assemblies = - typeof.Assembly.GetCustomAttributes (typeof, true) + typeof.Assembly.GetCustomAttributes(typeof, true) match assemblies with | [| x |] -> @@ -750,21 +711,20 @@ module Version = type Debounce<'a>(timeout, fn) as x = let mailbox = - MailboxProcessor<'a>.Start - (fun agent -> - let rec loop ida idb arg = - async { - let! r = agent.TryReceive(x.Timeout) - - match r with - | Some arg -> return! loop ida (idb + 1) (Some arg) - | None when ida <> idb -> - do! fn arg.Value - return! loop 0 0 None - | None -> return! loop 0 0 arg - } - - loop 0 0 None) + MailboxProcessor<'a>.Start(fun agent -> + let rec loop ida idb arg = + async { + let! r = agent.TryReceive(x.Timeout) + + match r with + | Some arg -> return! loop ida (idb + 1) (Some arg) + | None when ida <> idb -> + do! fn arg.Value + return! loop 0 0 None + | None -> return! loop 0 0 arg + } + + loop 0 0 None) /// Calls the function, after debouncing has been applied. member _.Bounce(arg) = mailbox.Post(arg) @@ -773,8 +733,7 @@ type Debounce<'a>(timeout, fn) as x = member val Timeout = timeout with get, set module Indentation = - let inline get (line: string) = - line.Length - line.AsSpan().Trim(' ').Length + let inline get (line: string) = line.Length - line.AsSpan().Trim(' ').Length type FSharpSymbol with diff --git a/src/Microsoft.DotNet.Interactive.FSharp/Microsoft.DotNet.Interactive.FSharp.fsproj b/src/Microsoft.DotNet.Interactive.FSharp/Microsoft.DotNet.Interactive.FSharp.fsproj index c03c26cb53..8458fd2519 100644 --- a/src/Microsoft.DotNet.Interactive.FSharp/Microsoft.DotNet.Interactive.FSharp.fsproj +++ b/src/Microsoft.DotNet.Interactive.FSharp/Microsoft.DotNet.Interactive.FSharp.fsproj @@ -19,6 +19,7 @@ + diff --git a/src/Microsoft.DotNet.Interactive.Tests/LanguageServices/SignatureHelpTests.cs b/src/Microsoft.DotNet.Interactive.Tests/LanguageServices/SignatureHelpTests.cs index 3ae3cab5e5..044148ecd7 100644 --- a/src/Microsoft.DotNet.Interactive.Tests/LanguageServices/SignatureHelpTests.cs +++ b/src/Microsoft.DotNet.Interactive.Tests/LanguageServices/SignatureHelpTests.cs @@ -1,4 +1,4 @@ -// Copyright (c) .NET Foundation and contributors. All rights reserved. +// Copyright (c) .NET Foundation and contributors. All rights reserved. // Licensed under the MIT license. See LICENSE file in the project root for full license information. using System.Linq; @@ -33,6 +33,8 @@ private Task SendSignatureHelpRequest(Kernel kernel, string [InlineData(Language.CSharp, "int Add(int a, int b) => a + b;", "Add(1,$$)", 0, "int Add(int a, int b)", 1, "b")] [InlineData(Language.CSharp, "int Add(int a, int b) => a + b;\nint Sub(int c, int d) => c - d;", "Add(Sub($$", 0, "int Sub(int c, int d)", 0, "c")] [InlineData(Language.CSharp, "int Add(int a, int b) => a + b;\nint Sub(int c, int d) => c - d;", "Add(Sub(1, 2),$$", 0, "int Add(int a, int b)", 1, "b")] + [InlineData(Language.FSharp, "let add a b = a + b", "add $$", 0, "add : a: int -> b: int -> int", 0, "a: int")] + [InlineData(Language.FSharp, "let add a b = a + b", "add 1 $$", 0, "add : a: int -> b: int -> int", 1, "b: int")] public async Task correct_signature_help_is_displayed(Language language, string submittedCode, string markupCode, int activeSignature, string signaureLabel, int activeParameter, string parameterName) { var kernel = CreateKernel(language); @@ -83,6 +85,7 @@ public async Task signature_help_can_handle_language_switching_and_offsets() [Theory] [InlineData(Language.CSharp, "System.Environment.GetEnvironmentVariable($$", 0, "Retrieves the value of an environment variable from the current process")] + //[InlineData(Language.FSharp, "System.Environment.GetEnvironmentVariable($$", 0, "Retrieves the value of an environment variable from the current process", Skip = "F# Compiler Services requires proper context/imports to resolve BCL types")] public async Task signature_help_can_return_doc_comments_from_bcl_types(Language language, string markupCode, int activeSignature, string expectedDocumentationSubstring) { using var kernel = CreateKernel(language);