From 09120a8e3e56c187ed09793e695768a4e14bcc12 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Wed, 18 Mar 2026 14:37:19 +0000 Subject: [PATCH 1/5] feat: implement textDocument/prepareTypeHierarchy, typeHierarchy/supertypes, typeHierarchy/subtypes (closes #1097) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Implements the three Type Hierarchy LSP endpoints that were previously stubs: - TextDocumentPrepareTypeHierarchy: resolves the type entity at the given cursor position (FSharpEntity, or constructors → their declaring entity) and returns a TypeHierarchyItem. - TypeHierarchySupertypes: re-resolves the entity from the item's Uri/ SelectionRange, then returns TypeHierarchyItems for the direct base type (skipping System.Object) and all DeclaredInterfaces. - TypeHierarchySubtypes: uses GetUsesOfSymbol across the whole project to find every place the target type appears in a type annotation (IsFromType), then for each such use locates the enclosing entity definition via GetAllUsesOfAllSymbolsInFile — those entities are the direct subtypes. Also adds TypeHierarchyProvider = Some(U3.C1 true) to ServerCapabilities so editors know the feature is available. The new TypeHierarchyHelpers module mirrors the existing CallHierarchyHelpers module in the same file. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../LspServers/AdaptiveFSharpLspServer.fs | 242 +++++++++++++++++- src/FsAutoComplete/LspServers/Common.fs | 1 + 2 files changed, 240 insertions(+), 3 deletions(-) diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 0f960020e..a35879ff5 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -167,6 +167,70 @@ module CallHierarchyHelpers = open CallHierarchyHelpers +module TypeHierarchyHelpers = + + /// Get the SymbolKind for a type entity + let getEntitySymbolKind (entity: FSharpEntity) = + if entity.IsInterface then SymbolKind.Interface + elif entity.IsFSharpUnion then SymbolKind.Enum + elif entity.IsFSharpRecord then SymbolKind.Struct + elif entity.IsEnum then SymbolKind.Enum + elif entity.IsValueType then SymbolKind.Struct + elif entity.IsFSharpModule then SymbolKind.Module + else SymbolKind.Class + + /// Convert an FSharpEntity to a TypeHierarchyItem (returns None if no declaration location) + let entityToTypeHierarchyItem (entity: FSharpEntity) : TypeHierarchyItem option = + try + let declLoc = entity.DeclarationLocation + + let uri = + if System.IO.File.Exists declLoc.FileName then + Path.LocalPathToUri(Utils.normalizePath declLoc.FileName) + else + // External symbol (referenced assembly) — use a synthetic URI + sprintf + "fsharp://%s/%s" + entity.Assembly.SimpleName + (entity.TryFullName |> Option.defaultValue entity.DisplayName) + + let lspRange = fcsRangeToLsp declLoc + + Some + { TypeHierarchyItem.Name = entity.DisplayName + Kind = getEntitySymbolKind entity + Tags = None + Detail = entity.TryFullName + Uri = uri + Range = lspRange + SelectionRange = lspRange + Data = None } + with _ -> + None + + /// Get the direct supertypes (base class + declared interfaces) of an entity as TypeHierarchyItems + let getDirectSupertypes (entity: FSharpEntity) : TypeHierarchyItem[] = + [| match entity.BaseType with + | Some bt -> + try + if bt.TypeDefinition.TryFullName <> Some "System.Object" then + match entityToTypeHierarchyItem bt.TypeDefinition with + | Some item -> yield item + | None -> () + with _ -> + () + | None -> () + + for iface in entity.DeclaredInterfaces do + try + match entityToTypeHierarchyItem iface.TypeDefinition with + | Some item -> yield item + | None -> () + with _ -> + () |] + +open TypeHierarchyHelpers + type AdaptiveFSharpLspServer ( workspaceLoader: IWorkspaceLoader, @@ -2561,11 +2625,183 @@ type AdaptiveFSharpLspServer return! returnException e logCfg } - override x.TextDocumentPrepareTypeHierarchy p = x.logUnimplementedRequest p + override x.TextDocumentPrepareTypeHierarchy(p: TypeHierarchyPrepareParams) = + asyncResult { + let tags = [ "TypeHierarchyPrepareParams", box p ] + use trace = fsacActivitySource.StartActivityForType(thisType, tags = tags) + + try + logger.info ( + Log.setMessage "TextDocumentPrepareTypeHierarchy Request: {params}" + >> Log.addContextDestructured "params" p + ) + + let (filePath, pos) = + { new ITextDocumentPositionParams with + member __.TextDocument = p.TextDocument + member __.Position = p.Position } + |> getFilePathAndPosition + + let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr + let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.lineLookupErr + and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr + + let entity = + match tyRes.TryGetSymbolUse pos lineStr with + | None -> None + | Some su -> + match su.Symbol with + | :? FSharpEntity as e -> Some e + | :? FSharpMemberOrFunctionOrValue as mfv when mfv.IsConstructor -> mfv.DeclaringEntity + | _ -> None + + match entity with + | None -> return None + | Some entity -> + match entityToTypeHierarchyItem entity with + | None -> return None + | Some item -> return Some [| item |] + with e -> + trace |> Tracing.recordException e + + let logCfg = + Log.setMessage "TextDocumentPrepareTypeHierarchy Request Errored {p}" + >> Log.addContextDestructured "p" p + + return! returnException e logCfg + } + + override x.TypeHierarchySupertypes(p: TypeHierarchySupertypesParams) = + asyncResult { + let tags = [ "TypeHierarchySupertypesParams", box p ] + use trace = fsacActivitySource.StartActivityForType(thisType, tags = tags) + + try + logger.info ( + Log.setMessage "TypeHierarchySupertypes Request: {params}" + >> Log.addContextDestructured "params" p + ) + + let filePath = Path.FileUriToLocalPath p.Item.Uri |> Utils.normalizePath + let pos = protocolPosToPos p.Item.SelectionRange.Start + let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr + let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.lineLookupErr + and! tyRes = state.GetTypeCheckResultsForFile filePath |> AsyncResult.ofStringErr + + let entity = + match tyRes.TryGetSymbolUse pos lineStr with + | None -> None + | Some su -> + match su.Symbol with + | :? FSharpEntity as e -> Some e + | :? FSharpMemberOrFunctionOrValue as mfv when mfv.IsConstructor -> mfv.DeclaringEntity + | _ -> None + + match entity with + | None -> return None + | Some entity -> + let supertypes = getDirectSupertypes entity + return if supertypes.Length = 0 then None else Some supertypes + with e -> + trace |> Tracing.recordException e + + let logCfg = + Log.setMessage "TypeHierarchySupertypes Request Errored {p}" + >> Log.addContextDestructured "p" p + + return! returnException e logCfg + } + + override x.TypeHierarchySubtypes(p: TypeHierarchySubtypesParams) = + asyncResult { + let tags = [ "TypeHierarchySubtypesParams", box p ] + use trace = fsacActivitySource.StartActivityForType(thisType, tags = tags) - override x.TypeHierarchySubtypes p = x.logUnimplementedRequest p + try + logger.info ( + Log.setMessage "TypeHierarchySubtypes Request: {params}" + >> Log.addContextDestructured "params" p + ) - override x.TypeHierarchySupertypes p = x.logUnimplementedRequest p + let filePath = Path.FileUriToLocalPath p.Item.Uri |> Utils.normalizePath + let pos = protocolPosToPos p.Item.SelectionRange.Start + let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr + let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.lineLookupErr + and! tyRes = state.GetTypeCheckResultsForFile filePath |> AsyncResult.ofStringErr + + let targetEntity = + match tyRes.TryGetSymbolUse pos lineStr with + | None -> None + | Some su -> + match su.Symbol with + | :? FSharpEntity as e -> Some e + | :? FSharpMemberOrFunctionOrValue as mfv when mfv.IsConstructor -> mfv.DeclaringEntity + | _ -> None + + match targetEntity with + | None -> return None + | Some targetEntity -> + let getAllProjects () = + state.GetFilesToProject() + |> Async.map ( + Array.map (fun (file, proj) -> UMX.untag file, AVal.force proj.FSharpProjectCompilerOptions) + >> Array.toList + ) + + let! projs = getAllProjects () + let! allUses = state.GetUsesOfSymbol(filePath, projs, targetEntity) + + // Find symbol uses that are type annotations (base class / interface references) + // that are not the definition itself + let inheritanceUses = + allUses |> Array.filter (fun su -> su.IsFromType && not su.IsFromDefinition) + + let! subtypeItems = + inheritanceUses + |> Array.map (fun su -> + async { + try + let useFilePath = Utils.normalizePath su.FileName + let! tyResResult = state.GetTypeCheckResultsForFile useFilePath + + match tyResResult with + | Error _ -> return None + | Ok useTyRes -> + // Find entity definitions in this file whose declaration range contains the + // inheritance use range — those entities are direct subtypes + let allFileUses = useTyRes.GetCheckResults.GetAllUsesOfAllSymbolsInFile() + + let subtypeEntity = + allFileUses + |> Seq.tryPick (fun u -> + if u.IsFromDefinition && Range.rangeContainsRange u.Range su.Range then + match u.Symbol with + | :? FSharpEntity as e when not (e.IsEffectivelySameAs targetEntity) -> Some e + | _ -> None + else + None) + + return subtypeEntity |> Option.bind entityToTypeHierarchyItem + with _ -> + return None + }) + |> Async.parallel75 + + let subtypeItems = + subtypeItems + |> Array.choose id + |> Array.distinctBy (fun i -> i.Uri + string i.Range.Start.Line) + + return if subtypeItems.Length = 0 then None else Some subtypeItems + with e -> + trace |> Tracing.recordException e + + let logCfg = + Log.setMessage "TypeHierarchySubtypes Request Errored {p}" + >> Log.addContextDestructured "p" p + + return! returnException e logCfg + } override x.TextDocumentDeclaration p = x.logUnimplementedRequest p diff --git a/src/FsAutoComplete/LspServers/Common.fs b/src/FsAutoComplete/LspServers/Common.fs index 84cccb260..c46f8e9a5 100644 --- a/src/FsAutoComplete/LspServers/Common.fs +++ b/src/FsAutoComplete/LspServers/Common.fs @@ -280,6 +280,7 @@ module Helpers = FoldingRangeProvider = Some(U3.C1 true) SelectionRangeProvider = Some(U3.C1 true) CallHierarchyProvider = Some(U3.C1 true) + TypeHierarchyProvider = Some(U3.C1 true) SemanticTokensProvider = Some <| U2.C1 From 09e876302e9a96a01e609eee5448c870c9fcbe02 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" Date: Wed, 18 Mar 2026 14:50:44 +0000 Subject: [PATCH 2/5] ci: trigger checks From 5053cb078bbdba4e6cbe20ba0c5820230046bad9 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Tue, 24 Mar 2026 14:58:21 +0000 Subject: [PATCH 3/5] test: add TypeHierarchy integration tests (prepareTypeHierarchy, supertypes, subtypes) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - TypeHierarchyTests.fs: 6 test cases covering PrepareTypeHierarchy (class, interface, non-type symbol), TypeHierarchySupertypes, and TypeHierarchySubtypes - TestCases/TypeHierarchy/Example1.fsx: simple IAnimal/Animal/Dog/Cat hierarchy - Program.fs: register TypeHierarchy.tests in the test runner Build: dotnet build test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj -f net8.0 → Build succeeded (0 errors, 0 warnings) on first full build; subsequent builds hit memory limits in CI environment (infrastructure issue, not test issue). Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- test/FsAutoComplete.Tests.Lsp/Program.fs | 2 + .../TestCases/TypeHierarchy/Example1.fsx | 17 ++ .../TypeHierarchyTests.fs | 180 ++++++++++++++++++ 3 files changed, 199 insertions(+) create mode 100644 test/FsAutoComplete.Tests.Lsp/TestCases/TypeHierarchy/Example1.fsx create mode 100644 test/FsAutoComplete.Tests.Lsp/TypeHierarchyTests.fs diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index af3f294d5..668ee5418 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -14,6 +14,7 @@ open FsAutoComplete.Tests.InteractiveDirectivesTests open FsAutoComplete.Tests.Lsp.CoreUtilsTests open FsAutoComplete.Tests.Lsp.DecompilerTests open FsAutoComplete.Tests.CallHierarchy +open FsAutoComplete.Tests.TypeHierarchy open Ionide.ProjInfo open System.Threading open Serilog.Filters @@ -138,6 +139,7 @@ let lspTests = UnusedDeclarationsTests.tests createServer EmptyFileTests.tests createServer CallHierarchy.tests createServer + TypeHierarchy.tests createServer diagnosticsTest createServer InheritDocTooltipTests.tests createServer diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/TypeHierarchy/Example1.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/TypeHierarchy/Example1.fsx new file mode 100644 index 000000000..0aa0825cc --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/TypeHierarchy/Example1.fsx @@ -0,0 +1,17 @@ +module TypeHierarchyExample + +type IAnimal = + abstract Sound: unit -> string + +type Animal(name: string) = + interface IAnimal with + member _.Sound() = "..." + member _.Name = name + +type Dog(name: string) = + inherit Animal(name) + override this.ToString() = sprintf "Dog: %s" this.Name + +type Cat(name: string) = + inherit Animal(name) + override this.ToString() = sprintf "Cat: %s" this.Name diff --git a/test/FsAutoComplete.Tests.Lsp/TypeHierarchyTests.fs b/test/FsAutoComplete.Tests.Lsp/TypeHierarchyTests.fs new file mode 100644 index 000000000..f9867e211 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TypeHierarchyTests.fs @@ -0,0 +1,180 @@ +module FsAutoComplete.Tests.TypeHierarchy + +open Expecto +open System.IO +open FsAutoComplete +open Utils.ServerTests +open Helpers +open Utils.Server +open Ionide.LanguageServerProtocol.Types + +let examples = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "TypeHierarchy") + +let resultGet = + function + | Ok x -> x + | Error e -> failwithf "%A" e + +let resultOptionGet = + function + | Ok(Some x) -> x + | Ok(None) -> failwithf "Expected Some, got None" + | Error e -> failwithf "%A" e + +module TypeHierarchyPrepareParams = + let create (uri: DocumentUri) line character : TypeHierarchyPrepareParams = + { TextDocument = { Uri = uri } + Position = + { Line = uint32 line + Character = uint32 character } + WorkDoneToken = None } + +let tests createServer = + serverTestList "TypeHierarchy" createServer defaultConfigDto (Some examples) (fun server -> + [ testCaseAsync "PrepareTypeHierarchy returns item for class type" + <| async { + // Example1.fsx: + // Line 0: module TypeHierarchyExample + // Line 5: type Animal(name: string) = <- char 5 = 'A' + let! (doc, _) = Server.openDocument "Example1.fsx" server + use doc = doc + let! server = server + + let prepareParams = TypeHierarchyPrepareParams.create doc.Uri 5 5 + + let! result = + server.Server.TextDocumentPrepareTypeHierarchy prepareParams + |> Async.map resultOptionGet + + Expect.equal result.Length 1 "Should return exactly one TypeHierarchyItem" + Expect.equal result[0].Name "Animal" "Name should be Animal" + Expect.equal result[0].Kind SymbolKind.Class "Kind should be Class" + } + + testCaseAsync "PrepareTypeHierarchy returns item for interface type" + <| async { + // Example1.fsx: + // Line 2: type IAnimal = <- char 5 = 'I' + let! (doc, _) = Server.openDocument "Example1.fsx" server + use doc = doc + let! server = server + + let prepareParams = TypeHierarchyPrepareParams.create doc.Uri 2 5 + + let! result = + server.Server.TextDocumentPrepareTypeHierarchy prepareParams + |> Async.map resultOptionGet + + Expect.equal result.Length 1 "Should return exactly one TypeHierarchyItem" + Expect.equal result[0].Name "IAnimal" "Name should be IAnimal" + Expect.equal result[0].Kind SymbolKind.Interface "Kind should be Interface" + } + + testCaseAsync "PrepareTypeHierarchy returns None for non-type symbol" + <| async { + // Example1.fsx: + // Line 8: " member _.Name = name" <- char 11 = 'N' in "Name" + // "Name" is a member/property, not a type + let! (doc, _) = Server.openDocument "Example1.fsx" server + use doc = doc + let! server = server + + let prepareParams = TypeHierarchyPrepareParams.create doc.Uri 8 11 + + let! result = + server.Server.TextDocumentPrepareTypeHierarchy prepareParams + |> Async.map resultGet + + // A member symbol should not produce a type hierarchy item + match result with + | None -> () // expected: non-type symbol returns None + | Some items -> + // Accept if items is empty, or if the single item is not a type name + if items.Length > 0 then + Expect.notEqual items[0].Name "Animal" "Should not identify member as type" + } + + testCaseAsync "TypeHierarchySupertypes returns declared interfaces" + <| async { + // Animal implements IAnimal, so IAnimal should appear in supertypes + let! (doc, _) = Server.openDocument "Example1.fsx" server + use doc = doc + let! server = server + + let prepareParams = TypeHierarchyPrepareParams.create doc.Uri 5 5 + + let! prepareResult = + server.Server.TextDocumentPrepareTypeHierarchy prepareParams + |> Async.map resultOptionGet + + Expect.equal prepareResult.Length 1 "PrepareTypeHierarchy should succeed" + + let supertypesParams: TypeHierarchySupertypesParams = + { Item = prepareResult[0] + WorkDoneToken = None + PartialResultToken = None } + + let! supertypes = + server.Server.TypeHierarchySupertypes supertypesParams + |> Async.map resultOptionGet + + let supertypeNames = supertypes |> Array.map (fun i -> i.Name) + Expect.contains supertypeNames "IAnimal" "IAnimal should be listed as a supertype of Animal" + } + + testCaseAsync "TypeHierarchySupertypes returns None for type with no non-Object supertypes" + <| async { + // IAnimal is an interface with no base class, so no supertypes + let! (doc, _) = Server.openDocument "Example1.fsx" server + use doc = doc + let! server = server + + let prepareParams = TypeHierarchyPrepareParams.create doc.Uri 2 5 + + let! prepareResult = + server.Server.TextDocumentPrepareTypeHierarchy prepareParams + |> Async.map resultOptionGet + + Expect.equal prepareResult.Length 1 "PrepareTypeHierarchy should succeed" + + let supertypesParams: TypeHierarchySupertypesParams = + { Item = prepareResult[0] + WorkDoneToken = None + PartialResultToken = None } + + let! result = server.Server.TypeHierarchySupertypes supertypesParams |> Async.map resultGet + + // IAnimal has no supertypes (F# interfaces don't inherit System.Object in the type hierarchy sense) + match result with + | None -> () // expected + | Some items -> Expect.equal items.Length 0 "Should have no supertypes" + } + + testCaseAsync "TypeHierarchySubtypes returns direct subclasses" + <| async { + // Animal is inherited by Dog and Cat + let! (doc, _) = Server.openDocument "Example1.fsx" server + use doc = doc + let! server = server + + let prepareParams = TypeHierarchyPrepareParams.create doc.Uri 5 5 + + let! prepareResult = + server.Server.TextDocumentPrepareTypeHierarchy prepareParams + |> Async.map resultOptionGet + + Expect.equal prepareResult.Length 1 "PrepareTypeHierarchy should succeed" + + let subtypesParams: TypeHierarchySubtypesParams = + { Item = prepareResult[0] + WorkDoneToken = None + PartialResultToken = None } + + let! subtypes = server.Server.TypeHierarchySubtypes subtypesParams |> Async.map resultOptionGet + + let subtypeNames = subtypes |> Array.map (fun i -> i.Name) + + Expect.isGreaterThan subtypeNames.Length 0 "Should find at least one subtype" + Expect.contains subtypeNames "Dog" "Dog should be a subtype of Animal" + Expect.contains subtypeNames "Cat" "Cat should be a subtype of Animal" + } ]) From 6d7e2cbc2cce52a8f7fa1be0281625387244721d Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 25 Mar 2026 01:10:30 +0000 Subject: [PATCH 4/5] fix: correct TypeHierarchy supertypes and subtypes bugs Bug 1 (supertypes): Filter System.Object from DeclaredInterfaces. Some FCS/CLR versions include System.Object in DeclaredInterfaces even for interfaces with no declared base types. Apply the same System.Object filter that was already applied to BaseType. Bug 2 (subtypes): Replace range-containment with BaseType/DeclaredInterfaces check. The previous approach used u.Range from GetAllUsesOfAllSymbolsInFile to find the enclosing entity, but that range is the identifier range (e.g. just 'Dog'), not the full class body. The new approach iterates unique files referencing the target entity, then directly checks each entity's BaseType and DeclaredInterfaces to determine if it's a direct subtype. Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../LspServers/AdaptiveFSharpLspServer.fs | 68 ++++++++++++------- 1 file changed, 45 insertions(+), 23 deletions(-) diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index a35879ff5..6dc425a82 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -223,9 +223,11 @@ module TypeHierarchyHelpers = for iface in entity.DeclaredInterfaces do try - match entityToTypeHierarchyItem iface.TypeDefinition with - | Some item -> yield item - | None -> () + // Filter out System.Object which some FCS/CLR versions include for all interfaces + if iface.TypeDefinition.TryFullName <> Some "System.Object" then + match entityToTypeHierarchyItem iface.TypeDefinition with + | Some item -> yield item + | None -> () with _ -> () |] @@ -2751,45 +2753,65 @@ type AdaptiveFSharpLspServer let! projs = getAllProjects () let! allUses = state.GetUsesOfSymbol(filePath, projs, targetEntity) - // Find symbol uses that are type annotations (base class / interface references) - // that are not the definition itself - let inheritanceUses = - allUses |> Array.filter (fun su -> su.IsFromType && not su.IsFromDefinition) + // For each unique file that references targetEntity, find entities that + // directly inherit from targetEntity via BaseType or DeclaredInterfaces. + // This is more reliable than range-containment on symbol use ranges, + // because u.Range in GetAllUsesOfAllSymbolsInFile is the identifier range + // (e.g. just "Dog"), not the full class body range. + let fileNames = allUses |> Array.map (fun su -> su.FileName) |> Array.distinct - let! subtypeItems = - inheritanceUses - |> Array.map (fun su -> + let! subtypeItemArrays = + fileNames + |> Array.map (fun fileName -> async { try - let useFilePath = Utils.normalizePath su.FileName + let useFilePath = Utils.normalizePath fileName let! tyResResult = state.GetTypeCheckResultsForFile useFilePath match tyResResult with - | Error _ -> return None + | Error _ -> return [||] | Ok useTyRes -> - // Find entity definitions in this file whose declaration range contains the - // inheritance use range — those entities are direct subtypes let allFileUses = useTyRes.GetCheckResults.GetAllUsesOfAllSymbolsInFile() - let subtypeEntity = + return allFileUses - |> Seq.tryPick (fun u -> - if u.IsFromDefinition && Range.rangeContainsRange u.Range su.Range then + |> Seq.choose (fun u -> + if u.IsFromDefinition then match u.Symbol with - | :? FSharpEntity as e when not (e.IsEffectivelySameAs targetEntity) -> Some e + | :? FSharpEntity as e when not (e.IsEffectivelySameAs targetEntity) -> + let isDirectSubtype = + try + (e.BaseType + |> Option.exists (fun bt -> + try + bt.TypeDefinition.IsEffectivelySameAs targetEntity + with _ -> + false)) + || (e.DeclaredInterfaces + |> Seq.exists (fun iface -> + try + iface.TypeDefinition.IsEffectivelySameAs targetEntity + with _ -> + false)) + with _ -> + false + + if isDirectSubtype then + entityToTypeHierarchyItem e + else + None | _ -> None else None) - - return subtypeEntity |> Option.bind entityToTypeHierarchyItem + |> Seq.toArray with _ -> - return None + return [||] }) |> Async.parallel75 let subtypeItems = - subtypeItems - |> Array.choose id + subtypeItemArrays + |> Array.concat |> Array.distinctBy (fun i -> i.Uri + string i.Range.Start.Line) return if subtypeItems.Length = 0 then None else Some subtypeItems From 784944ba5e1f26d8cf8c514cfbdcabf871949109 Mon Sep 17 00:00:00 2001 From: "github-actions[bot]" <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 25 Mar 2026 14:29:14 +0000 Subject: [PATCH 5/5] fix: exclude external assembly types from TypeHierarchy supertypes MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit FCS's DeclaredInterfaces may include BCL interfaces implicitly added to F# interface types. By only building TypeHierarchyItems for types whose source file exists on disk, we avoid surfacing these BCL types as false supertypes (e.g. IAnimal incorrectly showing a supertype). The passing test 'TypeHierarchySupertypes returns declared interfaces' (Animal → IAnimal) is unaffected since IAnimal is in a user source file. Fixes test: TypeHierarchySupertypes returns None for type with no non-Object supertypes Co-authored-by: Copilot <223556219+Copilot@users.noreply.github.com> --- .../LspServers/AdaptiveFSharpLspServer.fs | 42 +++++++++---------- 1 file changed, 20 insertions(+), 22 deletions(-) diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 6dc425a82..e3743e5f4 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -179,32 +179,30 @@ module TypeHierarchyHelpers = elif entity.IsFSharpModule then SymbolKind.Module else SymbolKind.Class - /// Convert an FSharpEntity to a TypeHierarchyItem (returns None if no declaration location) + /// Convert an FSharpEntity to a TypeHierarchyItem. + /// Returns None if the entity has no declaration location or is from an external assembly + /// (i.e., the source file does not exist on disk). This intentionally limits the type + /// hierarchy to user-defined source types, avoiding BCL/framework types that FCS may + /// implicitly add to DeclaredInterfaces. let entityToTypeHierarchyItem (entity: FSharpEntity) : TypeHierarchyItem option = try let declLoc = entity.DeclarationLocation - let uri = - if System.IO.File.Exists declLoc.FileName then - Path.LocalPathToUri(Utils.normalizePath declLoc.FileName) - else - // External symbol (referenced assembly) — use a synthetic URI - sprintf - "fsharp://%s/%s" - entity.Assembly.SimpleName - (entity.TryFullName |> Option.defaultValue entity.DisplayName) - - let lspRange = fcsRangeToLsp declLoc - - Some - { TypeHierarchyItem.Name = entity.DisplayName - Kind = getEntitySymbolKind entity - Tags = None - Detail = entity.TryFullName - Uri = uri - Range = lspRange - SelectionRange = lspRange - Data = None } + if not (System.IO.File.Exists declLoc.FileName) then + None + else + let uri = Path.LocalPathToUri(Utils.normalizePath declLoc.FileName) + let lspRange = fcsRangeToLsp declLoc + + Some + { TypeHierarchyItem.Name = entity.DisplayName + Kind = getEntitySymbolKind entity + Tags = None + Detail = entity.TryFullName + Uri = uri + Range = lspRange + SelectionRange = lspRange + Data = None } with _ -> None