From d693d983c0707fd5c4f4c4ad108388ee25384e29 Mon Sep 17 00:00:00 2001 From: Josh M <20140997+jcmrva@users.noreply.github.com> Date: Thu, 20 Jan 2022 23:08:51 -0500 Subject: [PATCH] InfoPanel generic parameter formatting & tests (#870) Co-authored-by: Chet Husk --- .../DocumentationFormatter.fs | 115 +++++++++++------- src/FsAutoComplete.Core/Utils.fs | 39 ++++-- .../FsAutoComplete.Tests.Lsp.fsproj | 1 + .../InfoPanelTests.fs | 62 ++++++++++ test/FsAutoComplete.Tests.Lsp/Program.fs | 1 + .../FormattedDocumentation/Script.fsx | 2 + 6 files changed, 168 insertions(+), 52 deletions(-) create mode 100644 test/FsAutoComplete.Tests.Lsp/InfoPanelTests.fs create mode 100644 test/FsAutoComplete.Tests.Lsp/TestCases/FormattedDocumentation/Script.fsx diff --git a/src/FsAutoComplete.Core/DocumentationFormatter.fs b/src/FsAutoComplete.Core/DocumentationFormatter.fs index 76d825995..f7d12e175 100644 --- a/src/FsAutoComplete.Core/DocumentationFormatter.fs +++ b/src/FsAutoComplete.Core/DocumentationFormatter.fs @@ -1,7 +1,7 @@ namespace FsAutoComplete module DocumentationFormatter = - + open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols @@ -26,65 +26,87 @@ module DocumentationFormatter = | true, false -> b | false, false -> a + " " + b - let internal formatLink (name: string) xmlDocSig assemblyName = + let internal formatShowDocumentationLink (name: string) xmlDocSig assemblyName = if assemblyName = "-" || xmlDocSig = "_" then name, name.Length else - let content = sprintf """[{ "XmlDocSig": "%s", "AssemblyName": "%s"}]""" xmlDocSig assemblyName - let cnt = Uri.EscapeDataString content - sprintf "%s" cnt name, name.Length + let content = Uri.EscapeDataString (sprintf """[{ "XmlDocSig": "%s", "AssemblyName": "%s" }]""" xmlDocSig assemblyName) + $"%s{name}", name.Length + + 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 + (("", 0), parts) + ||> Seq.fold (fun (s, l) (ps, pl) -> (s + ps), (l + pl)) + + let resolvedType = + // unwrap any type abbreviations to their wrapped type + if typ.IsAbbreviation then typ.AbbreviatedType else typ - let rec formatType (displayContext: FSharpDisplayContext) (typ : FSharpType) : (string*int) list = - let typ2 = if typ.IsAbbreviation then typ.AbbreviatedType else typ let xmlDocSig = try - if typ2.HasTypeDefinition then - typ2.TypeDefinition.XmlDocSig + // if this type resolves to an actual type, then get the xmldoc signature of it, if any. + // some times + if resolvedType.HasTypeDefinition then + resolvedType.TypeDefinition.XmlDocSig else "-" with | _ -> "-" + let assemblyName = try - if typ2.IsGenericParameter then + if resolvedType.IsGenericParameter then + // generic parameters are unsolved, they don't correspond to actual types, + // so we can't get the assembly name from them "-" else - typ2.TypeDefinition.Assembly.SimpleName + resolvedType.TypeDefinition.Assembly.SimpleName with | _ -> "-" + if typ.IsTupleType || typ.IsStructTupleType then - let separator = formatLink " * " xmlDocSig assemblyName - [ for arg in typ.GenericArguments do - if arg <> typ.GenericArguments.[0] then yield separator - yield! formatType displayContext arg ] + // tuples are made of individual type names for the elements separated by asterisks + let separator = formatShowDocumentationLink " * " xmlDocSig assemblyName + let parts = + typ.GenericArguments + |> Seq.map (formatType displayContext) + |> Seq.intersperse separator + |> List.ofSeq + combineParts parts + elif typ.HasTypeDefinition && typ.GenericArguments.Count > 0 then - let r = + // this type has generic arguments, so we need to format each of them. + // types with generic arguments get rendered as TYPENAME + let renderedGenericArgumentTypes = typ.GenericArguments - |> Seq.collect (formatType displayContext) + |> Seq.map (formatType displayContext) // 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, """<.*>""", "<") - [ yield formatLink t xmlDocSig assemblyName + [ yield formatShowDocumentationLink t xmlDocSig assemblyName if t.EndsWith "<" then - yield! r - yield formatLink ">" xmlDocSig assemblyName ] + 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 - [formatLink name xmlDocSig assemblyName] + formatShowDocumentationLink name xmlDocSig assemblyName else if typ.HasTypeDefinition then let name = typ.TypeDefinition.DisplayName |> FSharpKeywords.AddBackticksToIdentifierIfNeeded - [formatLink name xmlDocSig assemblyName] + formatShowDocumentationLink name xmlDocSig assemblyName else let name = typ.Format displayContext - [formatLink name xmlDocSig assemblyName] + formatShowDocumentationLink name xmlDocSig assemblyName let format displayContext (typ : FSharpType) : (string * int) = formatType displayContext typ - |> Seq.reduce (fun (aLink,aLen) (bLink,bLen) -> (aLink+bLink, aLen+bLen)) let formatGenericParameter includeMemberConstraintTypes displayContext (param:FSharpGenericParameter) = @@ -314,7 +336,7 @@ module DocumentationFormatter = elif func.DisplayName.StartsWith "( " then FSharpKeywords.AddBackticksToIdentifierIfNeeded func.LogicalName elif func.LogicalName.StartsWith "get_" || func.LogicalName.StartsWith "set_" then PrettyNaming.TryChopPropertyName func.DisplayName |> Option.defaultValue func.DisplayName else func.DisplayName - fst (formatLink name func.XmlDocSig func.Assembly.SimpleName) + fst (formatShowDocumentationLink name func.XmlDocSig func.Assembly.SimpleName) let modifiers = let accessibility = @@ -452,7 +474,7 @@ module DocumentationFormatter = sprintf "active pattern %s: %s" apc.Name findVal let getAttributeSignature displayContext (attr: FSharpAttribute) = - let name = formatLink attr.AttributeType.DisplayName attr.AttributeType.XmlDocSig attr.AttributeType.Assembly.SimpleName + let name = formatShowDocumentationLink attr.AttributeType.DisplayName attr.AttributeType.XmlDocSig attr.AttributeType.Assembly.SimpleName let attr = attr.ConstructorArguments |> Seq.map (snd >> string) @@ -568,7 +590,7 @@ module DocumentationFormatter = let types = fse.NestedEntities |> Seq.filter (fun ne -> not ne.IsNamespace ) - |> Seq.map (fun ne -> (typeName ne) ++ fst (formatLink ne.DisplayName ne.XmlDocSig ne.Assembly.SimpleName )) + |> Seq.map (fun ne -> (typeName ne) ++ fst (formatShowDocumentationLink ne.DisplayName ne.XmlDocSig ne.Assembly.SimpleName )) |> Seq.toArray @@ -606,38 +628,43 @@ module DocumentationFormatter = elif fse.IsDelegate then (typeDisplay + delegateTip ()), emptyTypeTip else typeDisplay, typeTip () - + type FSharpSymbol with + /// 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 + m.FullName.Substring "Microsoft.".Length + else m.FullName let footerForType (entity: FSharpSymbolUse) = try match entity with | SymbolUse.MemberFunctionOrValue m -> match m.DeclaringEntity with - | None -> sprintf "Full name: %s\nAssembly: %s" m.FullName m.Assembly.SimpleName + | None -> sprintf "Full name: %s\nAssembly: %s" m.SafeFullName m.Assembly.SimpleName | Some e -> - let link = fst (formatLink e.DisplayName e.XmlDocSig e.Assembly.SimpleName) - sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" m.FullName link m.Assembly.SimpleName + let link = fst (formatShowDocumentationLink e.DisplayName e.XmlDocSig e.Assembly.SimpleName) + sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" m.SafeFullName link m.Assembly.SimpleName | SymbolUse.Entity (c, _) -> match c.DeclaringEntity with - | None -> sprintf "Full name: %s\nAssembly: %s" c.FullName c.Assembly.SimpleName + | None -> sprintf "Full name: %s\nAssembly: %s" c.SafeFullName c.Assembly.SimpleName | Some e -> - let link = fst (formatLink e.DisplayName e.XmlDocSig e.Assembly.SimpleName) - sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" c.FullName link c.Assembly.SimpleName + let link = fst (formatShowDocumentationLink e.DisplayName e.XmlDocSig e.Assembly.SimpleName) + sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" c.SafeFullName link c.Assembly.SimpleName | SymbolUse.Field f -> match f.DeclaringEntity with - | None -> sprintf "Full name: %s\nAssembly: %s" f.FullName f.Assembly.SimpleName + | None -> sprintf "Full name: %s\nAssembly: %s" f.SafeFullName f.Assembly.SimpleName | Some e -> - let link = fst (formatLink e.DisplayName e.XmlDocSig e.Assembly.SimpleName) - sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" f.FullName link f.Assembly.SimpleName + let link = fst (formatShowDocumentationLink e.DisplayName e.XmlDocSig e.Assembly.SimpleName) + sprintf "Full name: %s\nDeclaring Entity: %s\nAssembly: %s" f.SafeFullName link f.Assembly.SimpleName | SymbolUse.ActivePatternCase ap -> - sprintf "Full name: %s\nAssembly: %s" ap.FullName ap.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" ap.SafeFullName ap.Assembly.SimpleName | SymbolUse.UnionCase uc -> - sprintf "Full name: %s\nAssembly: %s" uc.FullName uc.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" uc.SafeFullName uc.Assembly.SimpleName | _ -> "" with | _ -> "" @@ -646,19 +673,19 @@ module DocumentationFormatter = try match entity with | MemberFunctionOrValue m -> - sprintf "Full name: %s\nAssembly: %s" m.FullName m.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" m.SafeFullName m.Assembly.SimpleName | EntityFromSymbol (c, _) -> - sprintf "Full name: %s\nAssembly: %s" c.FullName c.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" c.SafeFullName c.Assembly.SimpleName | Field (f, _) -> - sprintf "Full name: %s\nAssembly: %s" f.FullName f.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" f.SafeFullName f.Assembly.SimpleName | ActivePatternCase ap -> - sprintf "Full name: %s\nAssembly: %s" ap.FullName ap.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" ap.SafeFullName ap.Assembly.SimpleName | UnionCase uc -> - sprintf "Full name: %s\nAssembly: %s" uc.FullName uc.Assembly.SimpleName + sprintf "Full name: %s\nAssembly: %s" uc.SafeFullName uc.Assembly.SimpleName | _ -> "" with | _ -> "" diff --git a/src/FsAutoComplete.Core/Utils.fs b/src/FsAutoComplete.Core/Utils.fs index 56d014a94..44e014946 100644 --- a/src/FsAutoComplete.Core/Utils.fs +++ b/src/FsAutoComplete.Core/Utils.fs @@ -38,6 +38,17 @@ module Map = yield value } +module Seq = + let intersperse separator (sequence: #seq<'a>) = + seq { + let mutable notFirst = false + + for element in sequence do + if notFirst then yield separator + yield element + notFirst <- true + } + module ProcessHelper = let WaitForExitAsync (p: Process) = async { @@ -46,7 +57,10 @@ module ProcessHelper = p.Exited.Add(fun _args -> tcs.TrySetResult(null) |> ignore) let! token = Async.CancellationToken - let _registered = token.Register(fun _ -> tcs.SetCanceled()) + + let _registered = + token.Register(fun _ -> tcs.SetCanceled()) + let! _ = tcs.Task |> Async.AwaitTask () } @@ -95,7 +109,8 @@ let normalizePath (file: string) : string = else UMX.tag 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 @@ -370,7 +385,9 @@ module Array = if array.Length = 0 then state else - let folder = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt folder + let folder = + OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt folder + let mutable state: 'State = state let len = array.Length @@ -416,7 +433,8 @@ 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: _ []) = @@ -465,7 +483,8 @@ 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) @@ -564,7 +583,8 @@ type Path with static member FilePathToUri(filePath: string) : string = let filePath, finished = if filePath.Contains "Untitled-" then - let rg = System.Text.RegularExpressions.Regex.Match(filePath, @"(Untitled-\d+).fsx") + let rg = + System.Text.RegularExpressions.Regex.Match(filePath, @"(Untitled-\d+).fsx") if rg.Success then rg.Groups.[1].Value, true @@ -574,7 +594,8 @@ type Path with filePath, false if not finished then - let uri = System.Text.StringBuilder(filePath.Length) + let uri = + System.Text.StringBuilder(filePath.Length) for c in filePath do if (c >= 'a' && c <= 'z') @@ -694,7 +715,9 @@ module Version = match assemblies with | [| x |] -> - let assembly = x :?> AssemblyInformationalVersionAttribute + let assembly = + x :?> AssemblyInformationalVersionAttribute + assembly.InformationalVersion | _ -> "" diff --git a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj index 83399e319..1595c22d0 100644 --- a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj +++ b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj @@ -28,6 +28,7 @@ + diff --git a/test/FsAutoComplete.Tests.Lsp/InfoPanelTests.fs b/test/FsAutoComplete.Tests.Lsp/InfoPanelTests.fs new file mode 100644 index 000000000..c9dc33ab3 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/InfoPanelTests.fs @@ -0,0 +1,62 @@ +module FsAutoComplete.Tests.InfoPanelTests + +open Expecto +open System.IO +open Ionide.LanguageServerProtocol.Types +open FsAutoComplete +open FsAutoComplete.LspHelpers +open Helpers +open FsToolkit.ErrorHandling + +let trySerialize (t: string): 't option = + try + JsonSerializer.readJson t |> Some + with _ -> None + +let (|As|_|) (m: PlainNotification): 't option = + match trySerialize m.Content with + | Some(r: FsAutoComplete.CommandResponse.ResponseMsg<'t>) -> Some r.Data + | None -> None + +let docFormattingTest state = + let server = + async { + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "FormattedDocumentation") + let config = defaultConfigDto + let! (server, events) = serverInitialize path config state + let path = Path.Combine(path, "Script.fsx") + let tdop : DidOpenTextDocumentParams = { TextDocument = loadDocument path} + do! server.TextDocumentDidOpen tdop + do! waitForParseResultsForFile "Script.fsx" events |> AsyncResult.bimap id (fun e -> failtest "should have not had check errors") + return (server, path) + } + |> Async.Cache + + testSequenced <| testList "Generic Parameter Format Tests" [ + testCaseAsync "Two params have a separator" (async { + let! (server, path) = server + let! doc = server.FSharpDocumentation { TextDocument = { Uri = path }; Position = { Character = 5; Line = 0 } } // Map.map + match doc with + | Result.Error err -> failtest $"Doc error: {err.Message}" + | Result.Ok (As ([[model: FsAutoComplete.CommandResponse.DocumentationDescription]])) -> + Expect.stringContains model.Signature "'Key, 'U" "Formatted doc contains both params separated by (, )" + | Result.Ok _ -> + failtest "couldn't parse doc as the json type we expected" + }) + + testCaseAsync "Tupled params have only asterisk" (async { + let! (server, path) = server + let! doc = server.FSharpDocumentation { TextDocument = { Uri = path }; Position = { Character = 7; Line = 1 } } // List.unzip3 + match doc with + | Result.Error err -> failtest $"Doc error: {err.Message}" + | Result.Ok (As ([[model: FsAutoComplete.CommandResponse.DocumentationDescription]])) -> + Expect.stringContains model.Signature "'T1 * 'T2 * 'T3" "Formatted doc contains 3 params separated by ( * )" + | Result.Ok _ -> + failtest "couldn't parse doc as the json type we expected" + }) + + testCaseAsync "cleanup" (async { + let! server, _ = server + do! server.Shutdown() + }) + ] diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index 6c71843d4..d3d5ba5e0 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -68,6 +68,7 @@ let tests = Completion.tests state GoTo.tests state FindReferences.tests state + InfoPanelTests.docFormattingTest state ] ] diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/FormattedDocumentation/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/FormattedDocumentation/Script.fsx new file mode 100644 index 000000000..78b0856f7 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/FormattedDocumentation/Script.fsx @@ -0,0 +1,2 @@ +Map.map +List.unzip3 \ No newline at end of file