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