diff --git a/src/Compiler/Facilities/AsyncMemoize.fs b/src/Compiler/Facilities/AsyncMemoize.fs index d22093a2b4..ce3ff5dd47 100644 --- a/src/Compiler/Facilities/AsyncMemoize.fs +++ b/src/Compiler/Facilities/AsyncMemoize.fs @@ -89,6 +89,7 @@ type internal JobEvent = | Cleared type internal ICacheKey<'TKey, 'TVersion> = + // TODO Key should probably be renamed to Identifier abstract member GetKey: unit -> 'TKey abstract member GetVersion: unit -> 'TVersion abstract member GetLabel: unit -> string diff --git a/src/Compiler/Service/FSharpProjectSnapshot.fs b/src/Compiler/Service/FSharpProjectSnapshot.fs index 2a88fcdee9..3e3ba0325e 100644 --- a/src/Compiler/Service/FSharpProjectSnapshot.fs +++ b/src/Compiler/Service/FSharpProjectSnapshot.fs @@ -1,4 +1,4 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. module FSharp.Compiler.CodeAnalysis.ProjectSnapshot @@ -41,10 +41,10 @@ module internal Helpers = let addFileNameAndVersion (file: IFileSnapshot) = addFileName file >> Md5Hasher.addBytes file.Version - let signatureHash projectCoreVersion (sourceFiles: IFileSnapshot seq) = + let signatureHash projectBaseVersion (sourceFiles: IFileSnapshot seq) = let mutable lastFile = "" - ((projectCoreVersion, Set.empty), sourceFiles) + ((projectBaseVersion, Set.empty), sourceFiles) ||> Seq.fold (fun (res, sigs) file -> if file.IsSignatureFile then lastFile <- file.FileName @@ -72,6 +72,13 @@ type FSharpFileSnapshot(FileName: string, Version: string, GetSource: unit -> Ta static member Create(fileName: string, version: string, getSource: unit -> Task) = FSharpFileSnapshot(fileName, version, getSource) + static member CreateFromString(filename: string, content: string) = + FSharpFileSnapshot( + filename, + Md5Hasher.hashString content |> Md5Hasher.toString, + fun () -> Task.FromResult(SourceTextNew.ofString content) + ) + static member CreateFromFileSystem(fileName: string) = FSharpFileSnapshot( fileName, @@ -171,18 +178,34 @@ type ReferenceOnDisk = { Path: string; LastModified: DateTime } /// A snapshot of an F# project. The source file type can differ based on which stage of compilation the snapshot is used for. -type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: ProjectCore, sourceFiles: 'T list) = +type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot> + (projectConfig: ProjectConfig, referencedProjects: FSharpReferencedProjectSnapshot list, sourceFiles: 'T list) = + + // Version of project without source files + let baseVersion = + lazy + (projectConfig.Version + |> Md5Hasher.addBytes' (referencedProjects |> Seq.map _.Version)) + + let baseVersionString = lazy (baseVersion.Value |> Md5Hasher.toString) + + let baseCacheKeyWith (label, version) = + { new ICacheKey<_, _> with + member _.GetLabel() = $"{label} ({projectConfig.Label})" + member _.GetKey() = projectConfig.Identifier + member _.GetVersion() = baseVersionString.Value, version + } let noFileVersionsHash = lazy - (projectCore.Version + (baseVersion.Value |> Md5Hasher.addStrings (sourceFiles |> Seq.map (fun x -> x.FileName))) let noFileVersionsKey = lazy ({ new ICacheKey<_, _> with - member _.GetLabel() = projectCore.Label - member _.GetKey() = projectCore.Identifier + member _.GetLabel() = projectConfig.Label + member _.GetKey() = projectConfig.Identifier member _.GetVersion() = noFileVersionsHash.Value |> Md5Hasher.toString @@ -191,7 +214,7 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj let fullHash = lazy - (projectCore.Version + (baseVersion.Value |> Md5Hasher.addStrings ( sourceFiles |> Seq.collect (fun x -> @@ -204,8 +227,8 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj let fullKey = lazy ({ new ICacheKey<_, _> with - member _.GetLabel() = projectCore.Label - member _.GetKey() = projectCore.Identifier + member _.GetLabel() = projectConfig.Label + member _.GetKey() = projectConfig.Identifier member _.GetVersion() = fullHash.Value |> Md5Hasher.toString }) @@ -213,10 +236,10 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj hash |> Md5Hasher.addString file.FileName |> Md5Hasher.addBytes file.Version let signatureHash = - lazy (signatureHash projectCore.Version (sourceFiles |> Seq.map (fun x -> x :> IFileSnapshot))) + lazy (signatureHash baseVersion.Value (sourceFiles |> Seq.map (fun x -> x :> IFileSnapshot))) let signatureKey = - lazy (projectCore.CacheKeyWith("Signature", signatureHash.Value |> fst |> Md5Hasher.toString)) + lazy (baseCacheKeyWith ("Signature", signatureHash.Value |> fst |> Md5Hasher.toString)) let lastFileHash = lazy @@ -234,48 +257,48 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj (let hash, f = lastFileHash.Value { new ICacheKey<_, _> with - member _.GetLabel() = $"{f.FileName} ({projectCore.Label})" - member _.GetKey() = f.FileName, projectCore.Identifier + member _.GetLabel() = $"{f.FileName} ({projectConfig.Label})" + member _.GetKey() = f.FileName, projectConfig.Identifier member _.GetVersion() = hash |> Md5Hasher.toString }) let sourceFileNames = lazy (sourceFiles |> List.map (fun x -> x.FileName)) - member _.ProjectFileName = projectCore.ProjectFileName - member _.ProjectId = projectCore.ProjectId - member _.Identifier = projectCore.Identifier - member _.ReferencesOnDisk = projectCore.ReferencesOnDisk - member _.OtherOptions = projectCore.OtherOptions - member _.ReferencedProjects = projectCore.ReferencedProjects + member _.ProjectFileName = projectConfig.ProjectFileName + member _.ProjectId = projectConfig.ProjectId + member _.Identifier = projectConfig.Identifier + member _.ReferencesOnDisk = projectConfig.ReferencesOnDisk + member _.OtherOptions = projectConfig.OtherOptions + member _.ReferencedProjects = referencedProjects member _.IsIncompleteTypeCheckEnvironment = - projectCore.IsIncompleteTypeCheckEnvironment + projectConfig.IsIncompleteTypeCheckEnvironment - member _.UseScriptResolutionRules = projectCore.UseScriptResolutionRules - member _.LoadTime = projectCore.LoadTime - member _.UnresolvedReferences = projectCore.UnresolvedReferences - member _.OriginalLoadReferences = projectCore.OriginalLoadReferences - member _.Stamp = projectCore.Stamp - member _.CommandLineOptions = projectCore.CommandLineOptions - member _.ProjectDirectory = projectCore.ProjectDirectory + member _.UseScriptResolutionRules = projectConfig.UseScriptResolutionRules + member _.LoadTime = projectConfig.LoadTime + member _.UnresolvedReferences = projectConfig.UnresolvedReferences + member _.OriginalLoadReferences = projectConfig.OriginalLoadReferences + member _.Stamp = projectConfig.Stamp + member _.CommandLineOptions = projectConfig.CommandLineOptions + member _.ProjectDirectory = projectConfig.ProjectDirectory - member _.OutputFileName = projectCore.OutputFileName + member _.OutputFileName = projectConfig.OutputFileName - member _.ProjectCore = projectCore + member _.ProjectConfig = projectConfig member _.SourceFiles = sourceFiles member _.SourceFileNames = sourceFileNames.Value - member _.Label = projectCore.Label + member _.Label = projectConfig.Label member _.IndexOf fileName = sourceFiles |> List.tryFindIndex (fun x -> x.FileName = fileName) - |> Option.defaultWith (fun () -> failwith (sprintf "Unable to find file %s in project %s" fileName projectCore.ProjectFileName)) + |> Option.defaultWith (fun () -> failwith (sprintf "Unable to find file %s in project %s" fileName projectConfig.ProjectFileName)) member private _.With(sourceFiles: 'T list) = - ProjectSnapshotBase(projectCore, sourceFiles) + ProjectSnapshotBase(projectConfig, referencedProjects, sourceFiles) /// Create a new snapshot with given source files replacing files in this snapshot with the same name. Other files remain unchanged. member this.Replace(changedSourceFiles: 'T list) = @@ -312,7 +335,7 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj /// The newest last modified time of any file in this snapshot including the project file member _.GetLastModifiedTimeOnDisk() = seq { - projectCore.ProjectFileName + projectConfig.ProjectFileName yield! sourceFiles @@ -328,7 +351,7 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj member _.LastFileVersion = lastFileHash.Value |> fst /// Version for parsing - doesn't include any references because they don't affect parsing (...right?) - member _.ParsingVersion = projectCore.VersionForParsing |> Md5Hasher.toString + member _.ParsingVersion = projectConfig.VersionForParsing |> Md5Hasher.toString /// A key for this snapshot but without file versions. So it will be the same across any in-file changes. member _.NoFileVersionsKey = noFileVersionsKey.Value @@ -352,110 +375,136 @@ type internal ProjectSnapshotBase<'T when 'T :> IFileSnapshot>(projectCore: Proj fileKey.WithExtraVersion(fileSnapshot.Version |> Md5Hasher.toString) + /// Cache key for the project without source files + member this.BaseCacheKeyWith(label, version) = baseCacheKeyWith (label, version) + /// Project snapshot with filenames and versions given as initial input and internal ProjectSnapshot = ProjectSnapshotBase /// Project snapshot with file sources loaded and internal ProjectSnapshotWithSources = ProjectSnapshotBase -/// All required information for compiling a project except the source files. It's kept separate so it can be reused +/// All required information for compiling a project except the source files and referenced projects. It's kept separate so it can be reused /// for different stages of a project snapshot and also between changes to the source files. -and internal ProjectCore +and ProjectConfig + internal ( - ProjectFileName: string, - ProjectId: string option, - ReferencesOnDisk: ReferenceOnDisk list, - OtherOptions: string list, - ReferencedProjects: FSharpReferencedProjectSnapshot list, - IsIncompleteTypeCheckEnvironment: bool, - UseScriptResolutionRules: bool, - LoadTime: DateTime, - UnresolvedReferences: FSharpUnresolvedReferencesSet option, - OriginalLoadReferences: (range * string * string) list, - Stamp: int64 option - ) as self = + projectFileName: string, + outputFileName: string option, + referencesOnDisk: ReferenceOnDisk list, + otherOptions: string list, + isIncompleteTypeCheckEnvironment: bool, + useScriptResolutionRules: bool, + unresolvedReferences, + originalLoadReferences: (range * string * string) list, + loadTime: DateTime, + stamp: int64 option, + projectId: string option + ) = let hashForParsing = lazy (Md5Hasher.empty - |> Md5Hasher.addString ProjectFileName - |> Md5Hasher.addStrings OtherOptions - |> Md5Hasher.addBool IsIncompleteTypeCheckEnvironment - |> Md5Hasher.addBool UseScriptResolutionRules) + |> Md5Hasher.addString projectFileName + |> Md5Hasher.addStrings otherOptions + |> Md5Hasher.addBool isIncompleteTypeCheckEnvironment + |> Md5Hasher.addBool useScriptResolutionRules) let fullHash = lazy (hashForParsing.Value - |> Md5Hasher.addStrings (ReferencesOnDisk |> Seq.map (fun r -> r.Path)) - |> Md5Hasher.addDateTimes (ReferencesOnDisk |> Seq.map (fun r -> r.LastModified)) - |> Md5Hasher.addBytes' ( - ReferencedProjects - |> Seq.map (function - | FSharpReference(_name, p) -> p.ProjectSnapshot.SignatureVersion - | PEReference(getStamp, _) -> Md5Hasher.empty |> Md5Hasher.addDateTime (getStamp ()) - | ILModuleReference(_name, getStamp, _) -> Md5Hasher.empty |> Md5Hasher.addDateTime (getStamp ())) - )) - - let fullHashString = lazy (fullHash.Value |> Md5Hasher.toString) + |> Md5Hasher.addStrings (referencesOnDisk |> Seq.map (fun r -> r.Path)) + |> Md5Hasher.addDateTimes (referencesOnDisk |> Seq.map (fun r -> r.LastModified))) let commandLineOptions = lazy (seq { - yield! OtherOptions + yield! otherOptions - for r in ReferencesOnDisk do + for r in referencesOnDisk do $"-r:{r.Path}" } |> Seq.toList) - let outputFileName = lazy (OtherOptions |> findOutputFileName) - - let key = lazy (ProjectFileName, outputFileName.Value |> Option.defaultValue "") + let outputFileNameValue = + lazy + (outputFileName + |> Option.orElseWith (fun () -> otherOptions |> findOutputFileName)) - let cacheKey = + let identifier = lazy - ({ new ICacheKey<_, _> with - member _.GetLabel() = self.Label - member _.GetKey() = self.Identifier - member _.GetVersion() = fullHashString.Value - }) + ((projectFileName, outputFileNameValue.Value |> Option.defaultValue "") + |> FSharpProjectIdentifier) + + new(projectFileName: string, + outputFileName: string option, + referencesOnDisk: string seq, + otherOptions: string seq, + ?isIncompleteTypeCheckEnvironment: bool, + ?useScriptResolutionRules: bool, + ?loadTime: DateTime, + ?stamp: int64, + ?projectId: string) = - member val ProjectDirectory = !! Path.GetDirectoryName(ProjectFileName) - member _.OutputFileName = outputFileName.Value - member _.Identifier: ProjectIdentifier = key.Value + let referencesOnDisk = + referencesOnDisk + |> Seq.map (fun path -> + { + Path = path + LastModified = FileSystem.GetLastWriteTimeShim path + }) + |> Seq.toList + + ProjectConfig( + projectFileName, + outputFileName, + referencesOnDisk, + otherOptions |> Seq.toList, + isIncompleteTypeCheckEnvironment = defaultArg isIncompleteTypeCheckEnvironment false, + useScriptResolutionRules = defaultArg useScriptResolutionRules false, + unresolvedReferences = None, + originalLoadReferences = [], + loadTime = defaultArg loadTime DateTime.Now, + stamp = stamp, + projectId = projectId + ) + + member val ProjectDirectory = !! Path.GetDirectoryName(projectFileName) + member _.OutputFileName = outputFileNameValue.Value + member _.Identifier = identifier.Value member _.Version = fullHash.Value - member _.Label = ProjectFileName |> shortPath + member _.Label = projectFileName |> shortPath member _.VersionForParsing = hashForParsing.Value member _.CommandLineOptions = commandLineOptions.Value - member _.ProjectFileName = ProjectFileName - member _.ProjectId = ProjectId - member _.ReferencesOnDisk = ReferencesOnDisk - member _.OtherOptions = OtherOptions - member _.ReferencedProjects = ReferencedProjects - member _.IsIncompleteTypeCheckEnvironment = IsIncompleteTypeCheckEnvironment - member _.UseScriptResolutionRules = UseScriptResolutionRules - member _.LoadTime = LoadTime - member _.UnresolvedReferences = UnresolvedReferences - member _.OriginalLoadReferences = OriginalLoadReferences - member _.Stamp = Stamp - - member _.CacheKeyWith(label, version) = - { new ICacheKey<_, _> with - member _.GetLabel() = $"{label} ({self.Label})" - member _.GetKey() = self.Identifier - member _.GetVersion() = fullHashString.Value, version - } - - member _.CacheKeyWith(label, key, version) = - { new ICacheKey<_, _> with - member _.GetLabel() = $"{label} ({self.Label})" - member _.GetKey() = key, self.Identifier - member _.GetVersion() = fullHashString.Value, version - } - - member _.CacheKey = cacheKey.Value + member _.ProjectFileName = projectFileName + member _.ProjectId = projectId + member _.ReferencesOnDisk = referencesOnDisk + member _.OtherOptions = otherOptions + + member _.IsIncompleteTypeCheckEnvironment = isIncompleteTypeCheckEnvironment + member _.UseScriptResolutionRules = useScriptResolutionRules + member _.LoadTime = loadTime + member _.Stamp = stamp + member _.UnresolvedReferences = unresolvedReferences + member _.OriginalLoadReferences = originalLoadReferences + + /// Creates a copy of this project config with a new set of references + member internal _.With(newReferencesOnDisk) = + ProjectConfig( + projectFileName, + outputFileName, + newReferencesOnDisk, + otherOptions, + isIncompleteTypeCheckEnvironment, + useScriptResolutionRules, + unresolvedReferences, + originalLoadReferences, + loadTime, + stamp, + projectId + ) and [] FSharpReferencedProjectSnapshot = /// @@ -503,6 +552,12 @@ and [ p.ProjectSnapshot.SignatureVersion + | PEReference(getStamp, _) -> Md5Hasher.empty |> Md5Hasher.addDateTime (getStamp ()) + | ILModuleReference(_name, getStamp, _) -> Md5Hasher.empty |> Md5Hasher.addDateTime (getStamp ()) + override this.Equals(o) = match o with | :? FSharpReferencedProjectSnapshot as o -> @@ -523,6 +578,17 @@ and [] FSharpProjectIdentifier = | FSharpProjectIdentifier of projectFileName: string * outputFileName: string + member this.OutputFileName = + match this with + | FSharpProjectIdentifier(_, outputFileName) -> outputFileName + + member this.ProjectFileName = + match this with + | FSharpProjectIdentifier(projectFileName, _) -> projectFileName + + override this.ToString() = + $"{shortPath this.ProjectFileName} 🡒 {shortPath this.OutputFileName}" + /// A snapshot of an F# project. This type contains all the necessary information for type checking a project. and [] FSharpProjectSnapshot internal (projectSnapshot) = @@ -533,7 +599,7 @@ and [] FSha projectSnapshot.Replace(changedSourceFiles) |> FSharpProjectSnapshot member _.Label = projectSnapshot.Label - member _.Identifier = FSharpProjectIdentifier projectSnapshot.ProjectCore.Identifier + member _.Identifier = projectSnapshot.ProjectConfig.Identifier member _.ProjectFileName = projectSnapshot.ProjectFileName member _.ProjectId = projectSnapshot.ProjectId member _.SourceFiles = projectSnapshot.SourceFiles @@ -549,10 +615,12 @@ and [] FSha member _.UnresolvedReferences = projectSnapshot.UnresolvedReferences member _.OriginalLoadReferences = projectSnapshot.OriginalLoadReferences member _.Stamp = projectSnapshot.Stamp + member _.OutputFileName = projectSnapshot.OutputFileName static member Create ( projectFileName: string, + outputFileName: string option, projectId: string option, sourceFiles: FSharpFileSnapshot list, referencesOnDisk: ReferenceOnDisk list, @@ -566,22 +634,23 @@ and [] FSha stamp: int64 option ) = - let projectCore = - ProjectCore( + let projectConfig = + ProjectConfig( projectFileName, - projectId, + outputFileName, referencesOnDisk, otherOptions, - referencedProjects, isIncompleteTypeCheckEnvironment, useScriptResolutionRules, - loadTime, unresolvedReferences, originalLoadReferences, - stamp + loadTime, + stamp, + projectId ) - ProjectSnapshotBase(projectCore, sourceFiles) |> FSharpProjectSnapshot + ProjectSnapshotBase(projectConfig, referencedProjects, sourceFiles) + |> FSharpProjectSnapshot static member FromOptions(options: FSharpProjectOptions, getFileSnapshot, ?snapshotAccumulator) = let snapshotAccumulator = defaultArg snapshotAccumulator (Dictionary()) @@ -629,6 +698,7 @@ and [] FSha let snapshot = FSharpProjectSnapshot.Create( projectFileName = options.ProjectFileName, + outputFileName = None, projectId = options.ProjectId, sourceFiles = (sourceFiles |> List.ofArray), referencesOnDisk = (referencesOnDisk |> List.ofArray), @@ -683,7 +753,7 @@ and [] FSha let compilerArgs = File.ReadAllLines responseFile.FullName - let directoryName : string = + let directoryName: string = match responseFile.DirectoryName with | null -> failwith "Directory name of the response file is null" | str -> str @@ -720,6 +790,7 @@ and [] FSha FSharpProjectSnapshot.Create( projectFileName = projectFileName, + outputFileName = None, projectId = None, sourceFiles = (fsharpFiles |> List.map FSharpFileSnapshot.CreateFromFileSystem), referencesOnDisk = diff --git a/src/Compiler/Service/TransparentCompiler.fs b/src/Compiler/Service/TransparentCompiler.fs index 5158ac7f25..00290bd5cd 100644 --- a/src/Compiler/Service/TransparentCompiler.fs +++ b/src/Compiler/Service/TransparentCompiler.fs @@ -298,7 +298,7 @@ type internal CompilerCaches(sizeFactor: int) = member val ScriptClosure = AsyncMemoize(sf, 2 * sf, name = "ScriptClosure") - member this.Clear(projects: Set) = + member this.Clear(projects: Set) = let shouldClear project = projects |> Set.contains project this.ParseFile.Clear(fst >> shouldClear) @@ -422,11 +422,11 @@ type internal TransparentCompiler (useFsiAuxLib: bool) (useSdkRefs: bool) (assumeDotNetFramework: bool) - (projectIdentifier: ProjectIdentifier) + (projectIdentifier: FSharpProjectIdentifier) (otherOptions: string list) (stamp: int64 option) = - { new ICacheKey with + { new ICacheKey with member _.GetKey() = fileName, projectIdentifier member _.GetLabel() = $"ScriptClosure for %s{fileName}" @@ -456,7 +456,7 @@ type internal TransparentCompiler (useSdkRefs: bool option) (sdkDirOverride: string option) (assumeDotNetFramework: bool option) - (projectIdentifier: ProjectIdentifier) + (projectIdentifier: FSharpProjectIdentifier) (otherOptions: string list) (stamp: int64 option) = @@ -464,7 +464,7 @@ type internal TransparentCompiler let useSdkRefs = defaultArg useSdkRefs true let assumeDotNetFramework = defaultArg assumeDotNetFramework false - let key: ICacheKey = + let key = mkScriptClosureCacheKey fileName source @@ -826,8 +826,8 @@ type internal TransparentCompiler let mutable BootstrapInfoIdCounter = 0 /// Bootstrap info that does not depend source files - let ComputeBootstrapInfoStatic (projectSnapshot: ProjectCore, tcConfig: TcConfig, assemblyName: string, loadClosureOpt) = - let cacheKey = projectSnapshot.CacheKeyWith("BootstrapInfoStatic", assemblyName) + let ComputeBootstrapInfoStatic (projectSnapshot: ProjectSnapshotBase<_>, tcConfig: TcConfig, assemblyName: string, loadClosureOpt) = + let cacheKey = projectSnapshot.BaseCacheKeyWith("BootstrapInfoStatic", assemblyName) caches.BootstrapInfoStatic.Get( cacheKey, @@ -957,7 +957,7 @@ type internal TransparentCompiler let outFile, _, assemblyName = tcConfigB.DecideNames sourceFiles let! bootstrapId, tcImports, tcGlobals, initialTcInfo, importsInvalidatedByTypeProvider = - ComputeBootstrapInfoStatic(projectSnapshot.ProjectCore, tcConfig, assemblyName, loadClosureOpt) + ComputeBootstrapInfoStatic(projectSnapshot, tcConfig, assemblyName, loadClosureOpt) // Check for the existence of loaded sources and prepend them to the sources list if present. let loadedSources = @@ -1056,7 +1056,7 @@ type internal TransparentCompiler |> Seq.map (fun f -> LoadSource f isExe (f.FileName = bootstrapInfo.LastFileName)) |> MultipleDiagnosticsLoggers.Parallel - return ProjectSnapshotWithSources(projectSnapshot.ProjectCore, sources |> Array.toList) + return ProjectSnapshotWithSources(projectSnapshot.ProjectConfig, projectSnapshot.ReferencedProjects, sources |> Array.toList) } @@ -1067,7 +1067,7 @@ type internal TransparentCompiler member _.GetLabel() = file.FileName |> shortPath member _.GetKey() = - projectSnapshot.ProjectCore.Identifier, file.FileName + projectSnapshot.ProjectConfig.Identifier, file.FileName member _.GetVersion() = projectSnapshot.ParsingVersion, @@ -1467,7 +1467,7 @@ type internal TransparentCompiler |> Seq.map (ComputeParseFile projectSnapshot tcConfig) |> MultipleDiagnosticsLoggers.Parallel - return ProjectSnapshotBase<_>(projectSnapshot.ProjectCore, parsedInputs |> Array.toList) + return ProjectSnapshotBase<_>(projectSnapshot.ProjectConfig, projectSnapshot.ReferencedProjects, parsedInputs |> Array.toList) } // Type check file and all its dependencies @@ -2137,19 +2137,19 @@ type internal TransparentCompiler use _ = Activity.start "TransparentCompiler.ClearCache" [| Activity.Tags.userOpName, userOpName |] - this.Caches.Clear( - projects - |> Seq.map (function - | FSharpProjectIdentifier(x, y) -> (x, y)) - |> Set - ) + this.Caches.Clear(Set projects) member this.ClearCache(options: seq, userOpName: string) : unit = use _ = Activity.start "TransparentCompiler.ClearCache" [| Activity.Tags.userOpName, userOpName |] backgroundCompiler.ClearCache(options, userOpName) - this.Caches.Clear(options |> Seq.map (fun o -> o.GetProjectIdentifier()) |> Set) + + this.Caches.Clear( + options + |> Seq.map (fun o -> o.GetProjectIdentifier() |> FSharpProjectIdentifier) + |> Set + ) member _.ClearCaches() : unit = backgroundCompiler.ClearCaches() @@ -2365,7 +2365,7 @@ type internal TransparentCompiler useFsiAuxLib useSdkRefs assumeDotNetFramework - (projectFileName, "") + (FSharpProjectIdentifier(projectFileName, "")) otherFlags optionsStamp @@ -2394,6 +2394,7 @@ type internal TransparentCompiler FSharpProjectSnapshot.Create( fileName + ".fsproj", None, + None, sourceFiles, references, otherFlags, @@ -2445,10 +2446,7 @@ type internal TransparentCompiler backgroundCompiler.InvalidateConfiguration(options, userOpName) member this.InvalidateConfiguration(projectSnapshot: FSharpProjectSnapshot, _userOpName: string) : unit = - let (FSharpProjectIdentifier(projectFileName, outputFileName)) = - projectSnapshot.Identifier - - this.Caches.Clear(Set.singleton (ProjectIdentifier(projectFileName, outputFileName))) + this.Caches.Clear(Set.singleton projectSnapshot.Identifier) member this.NotifyFileChanged(fileName: string, options: FSharpProjectOptions, userOpName: string) : Async = backgroundCompiler.NotifyFileChanged(fileName, options, userOpName) diff --git a/src/Compiler/Service/TransparentCompiler.fsi b/src/Compiler/Service/TransparentCompiler.fsi index 7746445c0a..ed4241f523 100644 --- a/src/Compiler/Service/TransparentCompiler.fsi +++ b/src/Compiler/Service/TransparentCompiler.fsi @@ -21,6 +21,7 @@ open FSharp.Compiler.NameResolution open FSharp.Compiler.TypedTree open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.EditorServices +open FSharp.Compiler.CodeAnalysis.ProjectSnapshot /// Accumulated results of type checking. The minimum amount of state in order to continue type-checking following files. [] @@ -101,41 +102,43 @@ type internal CompilerCaches = new: sizeFactor: int -> CompilerCaches - member AssemblyData: AsyncMemoize<(string * string), (string * string), ProjectAssemblyDataResult> + member AssemblyData: AsyncMemoize - member BootstrapInfo: AsyncMemoize<(string * string), string, (BootstrapInfo option * FSharpDiagnostic array)> + member BootstrapInfo: AsyncMemoize member BootstrapInfoStatic: - AsyncMemoize<(string * string), (string * string), (int * TcImports * TcGlobals * TcInfo * Event)> + AsyncMemoize)> member DependencyGraph: AsyncMemoize<(DependencyGraphType option * byte array), string, (Graph * Graph)> member FrameworkImports: AsyncMemoize - member ItemKeyStore: AsyncMemoize<(string * (string * string)), string, ItemKeyStore option> + member ItemKeyStore: AsyncMemoize<(string * FSharpProjectIdentifier), string, ItemKeyStore option> member ParseAndCheckAllFilesInProject: AsyncMemoizeDisabled member ParseAndCheckFileInProject: - AsyncMemoize<(string * (string * string)), string * string, (FSharpParseFileResults * FSharpCheckFileAnswer)> + AsyncMemoize<(string * FSharpProjectIdentifier), string * string, (FSharpParseFileResults * + FSharpCheckFileAnswer)> - member ParseAndCheckProject: AsyncMemoize<(string * string), string, FSharpCheckProjectResults> + member ParseAndCheckProject: AsyncMemoize member ParseFile: - AsyncMemoize<((string * string) * string), (string * string * bool), ProjectSnapshot.FSharpParsedFile> + AsyncMemoize<(FSharpProjectIdentifier * string), (string * string * bool), ProjectSnapshot.FSharpParsedFile> member ParseFileWithoutProject: AsyncMemoize member ProjectExtras: AsyncMemoizeDisabled - member SemanticClassification: AsyncMemoize<(string * (string * string)), string, SemanticClassificationView option> + member SemanticClassification: + AsyncMemoize<(string * FSharpProjectIdentifier), string, SemanticClassificationView option> member SizeFactor: int - member TcIntermediate: AsyncMemoize<(string * (string * string)), (string * int), TcIntermediate> + member TcIntermediate: AsyncMemoize<(string * FSharpProjectIdentifier), (string * int), TcIntermediate> - member ScriptClosure: AsyncMemoize<(string * (string * string)), string, LoadClosure> + member ScriptClosure: AsyncMemoize<(string * FSharpProjectIdentifier), string, LoadClosure> member TcLastFile: AsyncMemoizeDisabled diff --git a/src/FSharp.Compiler.LanguageServer/Common/CapabilitiesManager.fs b/src/FSharp.Compiler.LanguageServer/Common/CapabilitiesManager.fs index 0d2b42e7d0..7632a80ce6 100644 --- a/src/FSharp.Compiler.LanguageServer/Common/CapabilitiesManager.fs +++ b/src/FSharp.Compiler.LanguageServer/Common/CapabilitiesManager.fs @@ -15,8 +15,7 @@ type CapabilitiesManager(scOverrides: IServerCapabilitiesOverride seq) = TextDocumentSync = TextDocumentSyncOptions(OpenClose = true, Change = TextDocumentSyncKind.Full), DiagnosticOptions = DiagnosticOptions(WorkDoneProgress = true, InterFileDependencies = true, Identifier = "potato", WorkspaceDiagnostics = true), - CompletionProvider = - CompletionOptions(TriggerCharacters=[|"."; " "|], ResolveProvider=true, WorkDoneProgress=true), + CompletionProvider = CompletionOptions(TriggerCharacters = [| "."; " " |], ResolveProvider = true, WorkDoneProgress = true), HoverProvider = SumType(HoverOptions(WorkDoneProgress = true)) ) @@ -33,4 +32,4 @@ type CapabilitiesManager(scOverrides: IServerCapabilitiesOverride seq) = member this.GetInitializeParams() = match initializeParams with | Some params' -> params' - | None -> failwith "InitializeParams is null" \ No newline at end of file + | None -> failwith "InitializeParams is null" diff --git a/src/FSharp.Compiler.LanguageServer/Common/DependencyGraph.fs b/src/FSharp.Compiler.LanguageServer/Common/DependencyGraph.fs new file mode 100644 index 0000000000..b27228bb23 --- /dev/null +++ b/src/FSharp.Compiler.LanguageServer/Common/DependencyGraph.fs @@ -0,0 +1,372 @@ +/// This Dependency Graph provides a way to maintain an up-to-date but lazy set of dependent values. +/// When changes are applied to the graph (either vertices change value or edges change), no computation is performed. +/// Only when a value is requested it is lazily computed and thereafter stored until invalidated by further changes. +module FSharp.Compiler.LanguageServer.Common.DependencyGraph + +open System.Collections.Generic + +type DependencyNode<'Identifier, 'Value> = + { + Id: 'Identifier // TODO: probably not needed + Value: 'Value option + + // TODO: optional if it's root node + Compute: 'Value seq -> 'Value + } + +let insert key value (dict: Dictionary<_, _>) = + match dict.TryGetValue key with + | true, _ -> dict[key] <- value + | false, _ -> dict.Add(key, value) + +type IDependencyGraph<'Id, 'Val when 'Id: equality> = + + abstract member AddOrUpdateNode: id: 'Id * value: 'Val -> unit + abstract member AddList: nodes: ('Id * 'Val) seq -> 'Id seq + abstract member AddOrUpdateNode: id: 'Id * dependsOn: 'Id seq * compute: ('Val seq -> 'Val) -> unit + abstract member GetValue: id: 'Id -> 'Val + abstract member GetDependenciesOf: id: 'Id -> 'Id seq + abstract member GetDependentsOf: id: 'Id -> 'Id seq + abstract member AddDependency: node: 'Id * dependsOn: 'Id -> unit + abstract member RemoveDependency: node: 'Id * noLongerDependsOn: 'Id -> unit + abstract member UpdateNode: id: 'Id * update: ('Val -> 'Val) -> unit + abstract member RemoveNode: id: 'Id -> unit + abstract member Debug_GetNodes: ('Id -> bool) -> DependencyNode<'Id, 'Val> seq + abstract member Debug_RenderMermaid: ?mapping: ('Id -> 'Id) -> string + abstract member OnWarning: (string -> unit) -> unit + +and IThreadSafeDependencyGraph<'Id, 'Val when 'Id: equality> = + inherit IDependencyGraph<'Id, 'Val> + + abstract member Transact<'a> : (IDependencyGraph<'Id, 'Val> -> 'a) -> 'a + +module Internal = + + type DependencyGraph<'Id, 'Val when 'Id: equality and 'Id: not null>() as self = + let nodes = Dictionary<'Id, DependencyNode<'Id, 'Val>>() + let dependencies = Dictionary<'Id, HashSet<'Id>>() + let dependents = Dictionary<'Id, HashSet<'Id>>() + let warningSubscribers = ResizeArray() + + let rec invalidateDependents (id: 'Id) = + match dependents.TryGetValue id with + | true, set -> + for dependent in set do + nodes.[dependent] <- { nodes.[dependent] with Value = None } + invalidateDependents dependent + | false, _ -> () + + let invalidateNodeAndDependents id = + nodes[id] <- { nodes[id] with Value = None } + invalidateDependents id + + let addNode node = + nodes |> insert node.Id node + invalidateDependents node.Id + + member _.Debug = + {| + Nodes = nodes + Dependencies = dependencies + Dependents = dependents + |} + + member _.AddOrUpdateNode(id: 'Id, value: 'Val) = + addNode + { + Id = id + Value = Some value + Compute = (fun _ -> value) + } + + member _.AddList(nodes: ('Id * 'Val) seq) = + nodes + |> Seq.map (fun (id, value) -> + addNode + { + Id = id + Value = Some value + Compute = (fun _ -> value) + } + + id) + |> Seq.toList + + member _.AddOrUpdateNode(id: 'Id, dependsOn: 'Id seq, compute: 'Val seq -> 'Val) = + addNode + { + Id = id + Value = None + Compute = compute + } + + match dependencies.TryGetValue id with + | true, oldDependencies -> + for dep in oldDependencies do + match dependents.TryGetValue dep with + | true, set -> set.Remove id |> ignore + | _ -> () + | _ -> () + + dependencies |> insert id (HashSet dependsOn) + + for dep in dependsOn do + match dependents.TryGetValue dep with + | true, set -> set.Add id |> ignore + | false, _ -> dependents.Add(dep, HashSet([| id |])) + + member this.GetValue(id: 'Id) = + let node = nodes[id] + + match node.Value with + | Some value -> value + | None -> + let dependencies = dependencies.[id] + let values = dependencies |> Seq.map (fun id -> this.GetValue id) + let value = node.Compute values + nodes.[id] <- { node with Value = Some value } + value + + member this.GetDependenciesOf(identifier: 'Id) = + match dependencies.TryGetValue identifier with + | true, set -> set |> Seq.map id + | false, _ -> Seq.empty + + member this.GetDependentsOf(identifier: 'Id) = + match dependents.TryGetValue identifier with + | true, set -> set |> Seq.map id + | false, _ -> Seq.empty + + member this.AddDependency(node: 'Id, dependsOn: 'Id) = + match dependencies.TryGetValue node with + | true, deps -> deps.Add dependsOn |> ignore + | false, _ -> dependencies.Add(node, HashSet([| dependsOn |])) + + match dependents.TryGetValue dependsOn with + | true, deps -> deps.Add node |> ignore + | false, _ -> dependents.Add(dependsOn, HashSet([| node |])) + + invalidateDependents dependsOn + + member this.RemoveDependency(node: 'Id, noLongerDependsOn: 'Id) = + match dependencies.TryGetValue node with + | true, deps -> deps.Remove noLongerDependsOn |> ignore + | false, _ -> () + + match dependents.TryGetValue noLongerDependsOn with + | true, deps -> deps.Remove node |> ignore + | false, _ -> () + + invalidateNodeAndDependents node + + member this.UpdateNode(id: 'Id, update: 'Val -> 'Val) = + this.GetValue id + |> update + |> fun value -> this.AddOrUpdateNode(id, value) |> ignore + + member this.RemoveNode(id: 'Id) = + + match nodes.TryGetValue id with + | true, _ -> + // Invalidate dependents of the removed node + invalidateDependents id + + // Remove the node from the nodes dictionary + nodes.Remove id |> ignore + + // Remove the node from dependencies and update dependents + match dependencies.TryGetValue id with + | true, deps -> + for dep in deps do + match dependents.TryGetValue dep with + | true, set -> set.Remove id |> ignore + | false, _ -> () + + dependencies.Remove id |> ignore + | false, _ -> () + + // Remove the node from dependents and update dependencies + match dependents.TryGetValue id with + | true, deps -> + for dep in deps do + match dependencies.TryGetValue dep with + | true, set -> set.Remove id |> ignore + | false, _ -> () + + dependents.Remove id |> ignore + | false, _ -> () + | false, _ -> () + + member this.Debug_GetNodes(predicate: 'Id -> bool) : DependencyNode<'Id, 'Val> seq = + nodes.Values |> Seq.filter (fun node -> predicate node.Id) + + member _.Debug_RenderMermaid(?mapping) = + + let mapping = defaultArg mapping id + + // We need to give each node a number so the graph is easy to render + let nodeNumbersById = Dictionary() + + nodes.Keys + |> Seq.map mapping + |> Seq.distinct + |> Seq.indexed + |> Seq.iter (fun (x, y) -> nodeNumbersById.Add(y, x)) + + let content = + dependencies + |> Seq.collect (fun kv -> + let node = kv.Key + let nodeNumber = nodeNumbersById[mapping node] + + kv.Value + |> Seq.map (fun dep -> nodeNumbersById[mapping dep], mapping dep) + |> Seq.map (fun (depNumber, dep) -> $"{nodeNumber}[{node}] --> {depNumber}[{dep}]") + |> Seq.distinct) + |> String.concat "\n" + + $"```mermaid\n\ngraph LR\n\n{content}\n\n```" + + member _.OnWarning(f) = warningSubscribers.Add f |> ignore + + interface IDependencyGraph<'Id, 'Val> with + + member this.Debug_GetNodes(predicate) = self.Debug_GetNodes(predicate) + + member _.AddOrUpdateNode(id, value) = self.AddOrUpdateNode(id, value) + member _.AddList(nodes) = self.AddList(nodes) + + member _.AddOrUpdateNode(id, dependsOn, compute) = + self.AddOrUpdateNode(id, dependsOn, compute) + + member _.GetValue(id) = self.GetValue(id) + member _.GetDependenciesOf(id) = self.GetDependenciesOf(id) + member _.GetDependentsOf(id) = self.GetDependentsOf(id) + member _.AddDependency(node, dependsOn) = self.AddDependency(node, dependsOn) + + member _.RemoveDependency(node, noLongerDependsOn) = + self.RemoveDependency(node, noLongerDependsOn) + + member _.UpdateNode(id, update) = self.UpdateNode(id, update) + member _.RemoveNode(id) = self.RemoveNode(id) + + member _.OnWarning f = self.OnWarning f + + member _.Debug_RenderMermaid(x) = self.Debug_RenderMermaid(?mapping = x) + +/// This type can be used to chain together a series of dependent nodes when there is some kind of type hierarchy in the graph. +/// That is when 'T represents some subset of 'Val (e.g. a sub type or a case in DU). +/// It can also carry some state that is passed along the chain. +type GraphBuilder<'Id, 'Val, 'T, 'State when 'Id: equality> + (graph: IDependencyGraph<'Id, 'Val>, ids: 'Id seq, unwrap: 'Val seq -> 'T, state: 'State) = + + member _.Ids = ids + + member _.State = state + + member _.Graph = graph + + member _.AddDependentNode(id, compute, unwrapNext) = + graph.AddOrUpdateNode(id, ids, unwrap >> compute) + GraphBuilder(graph, Seq.singleton id, unwrapNext, state) + + member _.AddDependentNode(id, compute, unwrapNext, nextState) = + graph.AddOrUpdateNode(id, ids, unwrap >> compute) + GraphBuilder(graph, Seq.singleton id, unwrapNext, nextState) + +open Internal +open System.Runtime.CompilerServices + +type LockOperatedDependencyGraph<'Id, 'Val when 'Id: equality and 'Id: not null>() = + + let lockObj = System.Object() + let graph = DependencyGraph<_, _>() + + interface IThreadSafeDependencyGraph<'Id, 'Val> with + + member _.AddDependency(node, dependsOn) = + lock lockObj (fun () -> graph.AddDependency(node, dependsOn)) + + member _.AddList(nodes) = + lock lockObj (fun () -> graph.AddList(nodes)) + + member _.AddOrUpdateNode(id, value) = + lock lockObj (fun () -> graph.AddOrUpdateNode(id, value)) + + member _.AddOrUpdateNode(id, dependsOn, compute) = + lock lockObj (fun () -> graph.AddOrUpdateNode(id, dependsOn, compute)) + + member _.GetDependenciesOf(id) = + lock lockObj (fun () -> graph.GetDependenciesOf(id)) + + member _.GetDependentsOf(id) = + lock lockObj (fun () -> graph.GetDependentsOf(id)) + + member _.GetValue(id) = + lock lockObj (fun () -> graph.GetValue(id)) + + member _.UpdateNode(id, update) = + lock lockObj (fun () -> graph.UpdateNode(id, update)) + + member _.RemoveNode(id) = + lock lockObj (fun () -> graph.RemoveNode(id)) + + member _.RemoveDependency(node, noLongerDependsOn) = + lock lockObj (fun () -> graph.RemoveDependency(node, noLongerDependsOn)) + + member _.Transact(f) = lock lockObj (fun () -> f graph) + + member _.OnWarning(f) = + lock lockObj (fun () -> graph.OnWarning f) + + member _.Debug_GetNodes(predicate) = + lock lockObj (fun () -> graph.Debug_GetNodes(predicate)) + + member _.Debug_RenderMermaid(m) = + lock lockObj (fun () -> graph.Debug_RenderMermaid(?mapping = m)) + +[] +type GraphExtensions = + + [] + static member Unpack(node: 'NodeValue, unpacker) = + match unpacker node with + | Some value -> value + | None -> failwith $"Expected {unpacker} but got: {node}" + + [] + static member UnpackOne(dependencies: 'NodeValue seq, unpacker: 'NodeValue -> 'UnpackedDependency option) = + dependencies + |> Seq.tryExactlyOne + |> Option.bind unpacker + |> Option.defaultWith (fun () -> + failwith $"Expected exactly one dependency matching {unpacker} but got: %A{dependencies |> Seq.toArray}") + + [] + static member UnpackMany(dependencies: 'NodeValue seq, unpacker) = + let results = dependencies |> Seq.choose unpacker + + if dependencies |> Seq.length <> (results |> Seq.length) then + failwith $"Expected all dependencies to match {unpacker} but got: %A{dependencies |> Seq.toArray}" + + results + + [] + static member UnpackOneMany(dependencies: 'NodeValue seq, oneUnpacker, manyUnpacker) = + let mutable oneResult = None + let manyResult = new ResizeArray<_>() + let extras = new ResizeArray<_>() + + for dependency in dependencies do + match oneUnpacker dependency, manyUnpacker dependency with + | Some item, _ -> oneResult <- Some item + | None, Some item -> manyResult.Add item |> ignore + | None, None -> extras.Add dependency |> ignore + + match oneResult with + | None -> failwith $"Expected exactly one dependency matching {oneUnpacker} but didn't find any" + | Some head -> + if extras.Count > 0 then + failwith $"Found extra dependencies: %A{extras.ToArray()}" + + head, seq manyResult diff --git a/src/FSharp.Compiler.LanguageServer/Common/FSharpRequestContext.fs b/src/FSharp.Compiler.LanguageServer/Common/FSharpRequestContext.fs index db26ff4651..134cee8834 100644 --- a/src/FSharp.Compiler.LanguageServer/Common/FSharpRequestContext.fs +++ b/src/FSharp.Compiler.LanguageServer/Common/FSharpRequestContext.fs @@ -1,176 +1,23 @@ namespace FSharp.Compiler.LanguageServer.Common open Microsoft.CommonLanguageServerProtocol.Framework -open Microsoft.VisualStudio.LanguageServer.Protocol -open FSharp.Compiler.CodeAnalysis -open FSharp.Compiler.EditorServices -open FSharp.Compiler.Tokenization -open System open System.Threading open System.Threading.Tasks -#nowarn "57" - -module TokenTypes = - - [] - let (|LexicalClassification|_|) (tok: FSharpToken) = - if tok.IsKeyword then - ValueSome SemanticTokenTypes.Keyword - elif tok.IsNumericLiteral then - ValueSome SemanticTokenTypes.Number - elif tok.IsCommentTrivia then - ValueSome SemanticTokenTypes.Comment - elif tok.IsStringLiteral then - ValueSome SemanticTokenTypes.String - else - ValueNone - - // Tokenizes the source code and returns a list of token ranges and their SemanticTokenTypes - let GetSyntacticTokenTypes (source: FSharp.Compiler.Text.ISourceText) (fileName: string) = - let mutable tokRangesAndTypes = [] - - let tokenCallback = - fun (tok: FSharpToken) -> - match tok with - | LexicalClassification tokType -> tokRangesAndTypes <- (tok.Range, tokType) :: tokRangesAndTypes - | _ -> () - - FSharpLexer.Tokenize( - source, - tokenCallback, - flags = (FSharpLexerFlags.Default &&& ~~~FSharpLexerFlags.Compiling &&& ~~~FSharpLexerFlags.UseLexFilter), - filePath = fileName - ) - - tokRangesAndTypes - - let FSharpTokenTypeToLSP (fst: SemanticClassificationType) = - // XXX kinda arbitrary mapping - match fst with - | SemanticClassificationType.ReferenceType -> SemanticTokenTypes.Class - | SemanticClassificationType.ValueType -> SemanticTokenTypes.Struct - | SemanticClassificationType.UnionCase -> SemanticTokenTypes.Enum - | SemanticClassificationType.UnionCaseField -> SemanticTokenTypes.EnumMember - | SemanticClassificationType.Function -> SemanticTokenTypes.Function - | SemanticClassificationType.Property -> SemanticTokenTypes.Property - | SemanticClassificationType.Module -> SemanticTokenTypes.Type - | SemanticClassificationType.Namespace -> SemanticTokenTypes.Namespace - | SemanticClassificationType.Interface -> SemanticTokenTypes.Interface - | SemanticClassificationType.TypeArgument -> SemanticTokenTypes.TypeParameter - | SemanticClassificationType.Operator -> SemanticTokenTypes.Operator - | SemanticClassificationType.Method -> SemanticTokenTypes.Method - | SemanticClassificationType.ExtensionMethod -> SemanticTokenTypes.Method - | SemanticClassificationType.Field -> SemanticTokenTypes.Property - | SemanticClassificationType.Event -> SemanticTokenTypes.Event - | SemanticClassificationType.Delegate -> SemanticTokenTypes.Function - | SemanticClassificationType.NamedArgument -> SemanticTokenTypes.Parameter - | SemanticClassificationType.LocalValue -> SemanticTokenTypes.Variable - | SemanticClassificationType.Plaintext -> SemanticTokenTypes.String - | SemanticClassificationType.Type -> SemanticTokenTypes.Type - | SemanticClassificationType.Printf -> SemanticTokenTypes.Keyword - | _ -> SemanticTokenTypes.Comment - - let toIndex (x: string) = SemanticTokenTypes.AllTypes |> Seq.findIndex (fun y -> y = x) - -type FSharpRequestContext(lspServices: ILspServices, logger: ILspLogger, workspace: FSharpWorkspace, checker: FSharpChecker) = +type FSharpRequestContext(lspServices: ILspServices, logger: ILspLogger, workspace: FSharpWorkspace) = member _.LspServices = lspServices member _.Logger = logger member _.Workspace = workspace - member _.Checker = checker - - // TODO: split to parse and check diagnostics - member _.GetDiagnosticsForFile(file: Uri) = - - workspace.GetSnapshotForFile file - |> Option.map (fun snapshot -> - async { - let! parseResult, checkFileAnswer = checker.ParseAndCheckFileInProject(file.LocalPath, snapshot, "LSP Get diagnostics") - return - match checkFileAnswer with - | FSharpCheckFileAnswer.Succeeded result -> result.Diagnostics - | FSharpCheckFileAnswer.Aborted -> parseResult.Diagnostics - }) - |> Option.defaultValue (async.Return [||]) - - member _.GetSemanticTokensForFile(file: Uri) = - - workspace.GetSnapshotForFile file - |> Option.map (fun snapshot -> - async { - let! _, checkFileAnswer = checker.ParseAndCheckFileInProject(file.LocalPath, snapshot, "LSP Get semantic classification") - - let semanticClassifications = - match checkFileAnswer with - | FSharpCheckFileAnswer.Succeeded result -> result.GetSemanticClassification(None) // XXX not sure if range opt should be None - | FSharpCheckFileAnswer.Aborted -> [||] // XXX should be error maybe - - let! source = - snapshot.ProjectSnapshot.SourceFiles - |> Seq.find (fun f -> f.FileName = file.LocalPath) - |> _.GetSource() - |> Async.AwaitTask - - let syntacticClassifications = TokenTypes.GetSyntacticTokenTypes source file.LocalPath - - let lspFormatTokens = - semanticClassifications - |> Array.map (fun item -> (item.Range, item.Type |> TokenTypes.FSharpTokenTypeToLSP |> TokenTypes.toIndex)) - |> Array.append (syntacticClassifications|> List.map (fun (r, t) -> (r, TokenTypes.toIndex t)) |> Array.ofList) - |> Array.map (fun (r, tokType) -> - let length = r.EndColumn - r.StartColumn // XXX Does not deal with multiline tokens? - {| startLine = r.StartLine - 1; startCol = r.StartColumn; length = length; tokType = tokType; tokMods = 0 |}) - //(startLine, startCol, length, tokType, tokMods)) - |> Array.sortWith (fun x1 x2 -> - let c = x1.startLine.CompareTo(x2.startLine) - if c <> 0 then c - else x1.startCol.CompareTo(x2.startCol)) - - let tokensRelative = - lspFormatTokens - |> Array.append [| {| startLine = 0; startCol = 0; length = 0; tokType = 0; tokMods = 0 |} |] - |> Array.pairwise - |> Array.map (fun (prev, this) -> - {| - startLine = this.startLine - prev.startLine - startCol = (if prev.startLine = this.startLine then this.startCol - prev.startCol else this.startCol) - length = this.length - tokType = this.tokType - tokMods = this.tokMods - |}) - - return tokensRelative - |> Array.map (fun tok -> - [| tok.startLine; tok.startCol; tok.length; tok.tokType; tok.tokMods |]) - |> Array.concat - }) - |> Option.defaultValue (async { return [||] }) - -type ContextHolder(intialWorkspace, lspServices: ILspServices) = +type ContextHolder(workspace, lspServices: ILspServices) = let logger = lspServices.GetRequiredService() - // TODO: We need to get configuration for this somehow. Also make it replaceable when configuration changes. - let checker = - FSharpChecker.Create( - keepAllBackgroundResolutions = true, - keepAllBackgroundSymbolUses = true, - enableBackgroundItemKeyStoreAndSemanticClassification = true, - enablePartialTypeChecking = true, - parallelReferenceResolution = true, - captureIdentifiersWhenParsing = true, - useSyntaxTreeCache = true, - useTransparentCompiler = true - ) - - let mutable context = - FSharpRequestContext(lspServices, logger, intialWorkspace, checker) + let context = FSharpRequestContext(lspServices, logger, workspace) member _.GetContext() = context - member _.UpdateWorkspace(f) = - context <- FSharpRequestContext(lspServices, logger, f context.Workspace, checker) + member _.UpdateWorkspace(f) = f context.Workspace type FShapRequestContextFactory(lspServices: ILspServices) = @@ -185,4 +32,3 @@ type FShapRequestContextFactory(lspServices: ILspServices) = lspServices.GetRequiredService() |> _.GetContext() |> Task.FromResult - diff --git a/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspace.fs b/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspace.fs index 6fda31fc9c..f53abd7a9d 100644 --- a/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspace.fs +++ b/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspace.fs @@ -1,134 +1,64 @@ namespace FSharp.Compiler.LanguageServer.Common -open FSharp.Compiler.Text +open System.IO +open System.Threading -#nowarn "57" +open FSharp.Compiler.CodeAnalysis -open System -open System.Threading.Tasks -open FSharp.Compiler.CodeAnalysis.ProjectSnapshot +open DependencyGraph +open FSharpWorkspaceState +open FSharpWorkspaceQuery -/// Holds a project snapshot and a queue of changes that will be applied to it when it's requested +/// This type holds the current state of an F# workspace. It's mutable but thread-safe. It accepts updates to the state and can be queried for +/// information about the workspace. /// -/// The assumption is that this is faster than actually applying the changes to the snapshot immediately and that -/// we will be doing this on potentially every keystroke. But this should probably be measured at some point. -type SnapshotHolder(snapshot: FSharpProjectSnapshot, changedFiles: Set, openFiles: Map) = - - let applyFileChangesToSnapshot () = - let files = - changedFiles - |> Seq.map (fun filePath -> - match openFiles.TryFind filePath with - | Some content -> - FSharpFileSnapshot.Create( - filePath, - DateTime.Now.Ticks.ToString(), - fun () -> content |> SourceTextNew.ofString |> Task.FromResult - ) - | None -> FSharpFileSnapshot.CreateFromFileSystem(filePath)) - |> Seq.toList - - snapshot.Replace files - - // We don't want to mutate the workspace by applying the changes when snapshot is requested because that would force the language - // requests to be processed sequentially. So instead we keep the change application under lazy so it's still only computed if needed - // and only once and workspace doesn't change. - let appliedChanges = - lazy SnapshotHolder(applyFileChangesToSnapshot (), Set.empty, openFiles) - - member private _.snapshot = snapshot - member private _.changedFiles = changedFiles - - member private this.GetMostUpToDateInstance() = - if appliedChanges.IsValueCreated then - appliedChanges.Value - else - this - - member this.WithFileChanged(file, openFiles) = - let previous = this.GetMostUpToDateInstance() - SnapshotHolder(previous.snapshot, previous.changedFiles.Add file, openFiles) - - member this.WithoutFileChanged(file, openFiles) = - let previous = this.GetMostUpToDateInstance() - SnapshotHolder(previous.snapshot, previous.changedFiles.Remove file, openFiles) - - member _.GetSnapshot() = appliedChanges.Value.snapshot - - static member Of(snapshot: FSharpProjectSnapshot) = - SnapshotHolder(snapshot, Set.empty, Map.empty) - -type FSharpWorkspace - private - ( - projects: Map, - openFiles: Map, - fileMap: Map> - ) = +/// The state can be built up incrementally by adding projects with one of `Projects.AddOrUpdate` overloads. Updates to any project properties are +/// done the same way. Each project is identified by its project file path and output path or by `FSharpProjectIdentifier`. When the same project is +/// added again it will be updated with the new information. +/// +/// Project references are discovered automatically as projects are added or updated. +/// +/// Updates to file contents are signaled through `Files.Open`, `Files.Edit` and `Files.Close` methods. +type FSharpWorkspace(checker: FSharpChecker) = - let updateProjectsWithFile (file: Uri) f (projects: Map) = - fileMap - |> Map.tryFind file.LocalPath - |> Option.map (fun identifier -> - (projects, identifier) - ||> Seq.fold (fun projects identifier -> - let snapshotHolder = projects[identifier] - projects.Add(identifier, f snapshotHolder))) - |> Option.defaultValue projects + let depGraph = LockOperatedDependencyGraph() :> IThreadSafeDependencyGraph<_, _> - member _.Projects = projects - member _.OpenFiles = openFiles - member _.FileMap = fileMap + let files = FSharpWorkspaceFiles depGraph - member this.OpenFile(file: Uri, content: string) = this.ChangeFile(file, content) + let projects = FSharpWorkspaceProjects(depGraph, files) - member _.CloseFile(file: Uri) = - let openFiles = openFiles.Remove(file.LocalPath) + let query = FSharpWorkspaceQuery(depGraph, checker) + new() = FSharpWorkspace( - projects = - (projects - |> updateProjectsWithFile file _.WithoutFileChanged(file.LocalPath, openFiles)), - openFiles = openFiles, - fileMap = fileMap + FSharpChecker.Create( + keepAllBackgroundResolutions = true, + keepAllBackgroundSymbolUses = true, + enableBackgroundItemKeyStoreAndSemanticClassification = true, + enablePartialTypeChecking = true, + parallelReferenceResolution = true, + captureIdentifiersWhenParsing = true, + useTransparentCompiler = true + ) ) - member _.ChangeFile(file: Uri, content: string) = - - // TODO: should we assert that the file is open? - - let openFiles = openFiles.Add(file.LocalPath, content) + member internal this.Debug_DumpMermaid(path) = + let content = + depGraph.Debug_RenderMermaid (function + // Collapse all reference on disk nodes into one. Otherwise the graph is too big to render. + | WorkspaceGraphTypes.WorkspaceNodeKey.ReferenceOnDisk _ -> WorkspaceGraphTypes.WorkspaceNodeKey.ReferenceOnDisk "..." + | x -> x) - FSharpWorkspace( - projects = - (projects - |> updateProjectsWithFile file _.WithFileChanged(file.LocalPath, openFiles)), - openFiles = openFiles, - fileMap = fileMap - ) + File.WriteAllText(__SOURCE_DIRECTORY__ + path, content) - member _.GetSnapshotForFile(file: Uri) = - fileMap - |> Map.tryFind file.LocalPath + /// The `FSharpChecker` instance used by this workspace. + member _.Checker = checker - // TODO: eventually we need to deal with choosing the appropriate project here - // Hopefully we will be able to do it through receiving project context from LSP - // Otherwise we have to keep track of which project/configuration is active - |> Option.bind Seq.tryHead + /// File management for this workspace + member _.Files = files - |> Option.bind projects.TryFind - |> Option.map _.GetSnapshot() + /// Project management for this workspace + member _.Projects = projects - static member Create(projects: FSharpProjectSnapshot seq) = - FSharpWorkspace( - projects = Map.ofSeq (projects |> Seq.map (fun p -> p.Identifier, SnapshotHolder.Of p)), - openFiles = Map.empty, - fileMap = - (projects - |> Seq.collect (fun p -> - p.ProjectSnapshot.SourceFileNames - |> Seq.map (fun f -> Uri(f).LocalPath, p.Identifier)) - |> Seq.groupBy fst - |> Seq.map (fun (f, ps) -> f, Set.ofSeq (ps |> Seq.map snd)) - |> Map.ofSeq) - ) + /// Use this to query the workspace for information + member _.Query = query diff --git a/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspaceQuery.fs b/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspaceQuery.fs new file mode 100644 index 0000000000..ec522eccf3 --- /dev/null +++ b/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspaceQuery.fs @@ -0,0 +1,212 @@ +/// Code to handle quries to F# workspace +module FSharp.Compiler.LanguageServer.Common.FSharpWorkspaceQuery + +open System +open System.Collections.Generic +open Microsoft.CommonLanguageServerProtocol.Framework +open Microsoft.VisualStudio.LanguageServer.Protocol + +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.EditorServices +open FSharp.Compiler.Tokenization + +open DependencyGraph +open FSharpWorkspaceState +open System.Threading + +#nowarn "57" + +type FSharpDiagnosticReport internal (diagnostics, resultId) = + + member _.Diagnostics = diagnostics + + /// The result ID of the diagnostics. This needs to be unique for each version of the document in order to be able to clear old diagnostics. + member _.ResultId = resultId.ToString() + +module TokenTypes = + + [] + let (|LexicalClassification|_|) (tok: FSharpToken) = + if tok.IsKeyword then + ValueSome SemanticTokenTypes.Keyword + elif tok.IsNumericLiteral then + ValueSome SemanticTokenTypes.Number + elif tok.IsCommentTrivia then + ValueSome SemanticTokenTypes.Comment + elif tok.IsStringLiteral then + ValueSome SemanticTokenTypes.String + else + ValueNone + + // Tokenizes the source code and returns a list of token ranges and their SemanticTokenTypes + let GetSyntacticTokenTypes (source: FSharp.Compiler.Text.ISourceText) (fileName: string) = + let mutable tokRangesAndTypes = [] + + let tokenCallback = + fun (tok: FSharpToken) -> + match tok with + | LexicalClassification tokType -> tokRangesAndTypes <- (tok.Range, tokType) :: tokRangesAndTypes + | _ -> () + + FSharpLexer.Tokenize( + source, + tokenCallback, + flags = + (FSharpLexerFlags.Default + &&& ~~~FSharpLexerFlags.Compiling + &&& ~~~FSharpLexerFlags.UseLexFilter), + filePath = fileName + ) + + tokRangesAndTypes + + let FSharpTokenTypeToLSP (fst: SemanticClassificationType) = + // XXX kinda arbitrary mapping + match fst with + | SemanticClassificationType.ReferenceType -> SemanticTokenTypes.Class + | SemanticClassificationType.ValueType -> SemanticTokenTypes.Struct + | SemanticClassificationType.UnionCase -> SemanticTokenTypes.Enum + | SemanticClassificationType.UnionCaseField -> SemanticTokenTypes.EnumMember + | SemanticClassificationType.Function -> SemanticTokenTypes.Function + | SemanticClassificationType.Property -> SemanticTokenTypes.Property + | SemanticClassificationType.Module -> SemanticTokenTypes.Type + | SemanticClassificationType.Namespace -> SemanticTokenTypes.Namespace + | SemanticClassificationType.Interface -> SemanticTokenTypes.Interface + | SemanticClassificationType.TypeArgument -> SemanticTokenTypes.TypeParameter + | SemanticClassificationType.Operator -> SemanticTokenTypes.Operator + | SemanticClassificationType.Method -> SemanticTokenTypes.Method + | SemanticClassificationType.ExtensionMethod -> SemanticTokenTypes.Method + | SemanticClassificationType.Field -> SemanticTokenTypes.Property + | SemanticClassificationType.Event -> SemanticTokenTypes.Event + | SemanticClassificationType.Delegate -> SemanticTokenTypes.Function + | SemanticClassificationType.NamedArgument -> SemanticTokenTypes.Parameter + | SemanticClassificationType.LocalValue -> SemanticTokenTypes.Variable + | SemanticClassificationType.Plaintext -> SemanticTokenTypes.String + | SemanticClassificationType.Type -> SemanticTokenTypes.Type + | SemanticClassificationType.Printf -> SemanticTokenTypes.Keyword + | _ -> SemanticTokenTypes.Comment + + let toIndex (x: string) = + SemanticTokenTypes.AllTypes |> Seq.findIndex (fun y -> y = x) + +type FSharpWorkspaceQuery internal (depGraph: IThreadSafeDependencyGraph<_, _>, checker: FSharpChecker) = + + let mutable resultIdCounter = 0 + + // TODO: we might need something more sophisticated eventually + // for now it's important that the result id is unique every time + // in order to be able to clear previous diagnostics + let getDiagnosticResultId () = Interlocked.Increment(&resultIdCounter) + + member _.GetProjectSnapshot projectIdentifier = + try + depGraph.GetProjectSnapshot projectIdentifier |> Some + with :? KeyNotFoundException -> + None + + member _.GetProjectSnapshotForFile(file: Uri) = + + depGraph.GetProjectsContaining file.LocalPath + + // TODO: eventually we need to deal with choosing the appropriate project here + // Hopefully we will be able to do it through receiving project context from LSP + // Otherwise we have to keep track of which project/configuration is active + |> Seq.tryHead // For now just get the first one + + // TODO: split to parse and check diagnostics + member this.GetDiagnosticsForFile(file: Uri) = + async { + + let! diagnostics = + this.GetProjectSnapshotForFile file + |> Option.map (fun snapshot -> + async { + let! parseResult, checkFileAnswer = + checker.ParseAndCheckFileInProject(file.LocalPath, snapshot, "LSP Get diagnostics") + + return + match checkFileAnswer with + | FSharpCheckFileAnswer.Succeeded result -> result.Diagnostics + | FSharpCheckFileAnswer.Aborted -> parseResult.Diagnostics + }) + |> Option.defaultValue (async.Return [||]) + + return FSharpDiagnosticReport(diagnostics, getDiagnosticResultId ()) + } + + member this.GetSemanticTokensForFile(file) = + + this.GetProjectSnapshotForFile file + |> Option.map (fun snapshot -> + async { + let! _, checkFileAnswer = checker.ParseAndCheckFileInProject(file.LocalPath, snapshot, "LSP Get semantic classification") + + let semanticClassifications = + match checkFileAnswer with + | FSharpCheckFileAnswer.Succeeded result -> result.GetSemanticClassification(None) // XXX not sure if range opt should be None + | FSharpCheckFileAnswer.Aborted -> [||] // XXX should be error maybe + + let! source = + snapshot.ProjectSnapshot.SourceFiles + |> Seq.find (fun f -> f.FileName = file.LocalPath) + |> _.GetSource() + |> Async.AwaitTask + + let syntacticClassifications = + TokenTypes.GetSyntacticTokenTypes source file.LocalPath + + let lspFormatTokens = + semanticClassifications + |> Array.map (fun item -> (item.Range, item.Type |> TokenTypes.FSharpTokenTypeToLSP |> TokenTypes.toIndex)) + |> Array.append ( + syntacticClassifications + |> List.map (fun (r, t) -> (r, TokenTypes.toIndex t)) + |> Array.ofList + ) + |> Array.map (fun (r, tokType) -> + let length = r.EndColumn - r.StartColumn // XXX Does not deal with multiline tokens? + + {| + startLine = r.StartLine - 1 + startCol = r.StartColumn + length = length + tokType = tokType + tokMods = 0 + |}) + //(startLine, startCol, length, tokType, tokMods)) + |> Array.sortWith (fun x1 x2 -> + let c = x1.startLine.CompareTo(x2.startLine) + if c <> 0 then c else x1.startCol.CompareTo(x2.startCol)) + + let tokensRelative = + lspFormatTokens + |> Array.append + [| + {| + startLine = 0 + startCol = 0 + length = 0 + tokType = 0 + tokMods = 0 + |} + |] + |> Array.pairwise + |> Array.map (fun (prev, this) -> + {| + startLine = this.startLine - prev.startLine + startCol = + (if prev.startLine = this.startLine then + this.startCol - prev.startCol + else + this.startCol) + length = this.length + tokType = this.tokType + tokMods = this.tokMods + |}) + + return + tokensRelative + |> Array.map (fun tok -> [| tok.startLine; tok.startCol; tok.length; tok.tokType; tok.tokMods |]) + |> Array.concat + }) + |> Option.defaultValue (async { return [||] }) diff --git a/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspaceState.fs b/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspaceState.fs new file mode 100644 index 0000000000..3f874e5103 --- /dev/null +++ b/src/FSharp.Compiler.LanguageServer/Common/FSharpWorkspaceState.fs @@ -0,0 +1,366 @@ +/// Code to handle state management in an F# workspace. +module FSharp.Compiler.LanguageServer.Common.FSharpWorkspaceState + +open System +open System.IO +open System.Runtime.CompilerServices +open System.Collections.Concurrent + +open FSharp.Compiler.CodeAnalysis.ProjectSnapshot +open Internal.Utilities.Collections + +open DependencyGraph + +#nowarn "57" + +/// Types for the workspace graph. These should not be accessed directly, rather through the +/// extension methods in `WorkspaceDependencyGraphExtensions`. +module internal WorkspaceGraphTypes = + + /// All project information except source files + type ProjectWithoutFiles = ProjectConfig * FSharpReferencedProjectSnapshot list + + [] + type internal WorkspaceNodeKey = + // TODO: maybe this should be URI + | SourceFile of filePath: string + | ReferenceOnDisk of filePath: string + /// All project information except source files and (in-memory) project references + | ProjectConfig of FSharpProjectIdentifier + /// All project information except source files + | ProjectWithoutFiles of FSharpProjectIdentifier + /// Complete project information + | ProjectSnapshot of FSharpProjectIdentifier + + override this.ToString() = + match this with + | SourceFile path -> $"File {shortPath path}" + | ReferenceOnDisk path -> $"Reference on disk {shortPath path}" + | ProjectConfig id -> $"ProjectConfig {id}" + | ProjectWithoutFiles id -> $"ProjectWithoutFiles {id}" + | ProjectSnapshot id -> $"ProjectSnapshot {id}" + + [] + type internal WorkspaceNodeValue = + | SourceFile of FSharpFileSnapshot + | ReferenceOnDisk of ReferenceOnDisk + /// All project information except source files and (in-memory) project references + | ProjectConfig of ProjectConfig + /// All project information except source files + | ProjectWithoutFiles of ProjectWithoutFiles + /// Complete project information + | ProjectSnapshot of FSharpProjectSnapshot + + module internal WorkspaceNode = + + let projectConfig value = + match value with + | WorkspaceNodeValue.ProjectConfig p -> Some p + | _ -> None + + let projectSnapshot value = + match value with + | WorkspaceNodeValue.ProjectSnapshot p -> Some p + | _ -> None + + let projectWithoutFiles value = + match value with + | WorkspaceNodeValue.ProjectWithoutFiles(p, refs) -> Some(p, refs) + | _ -> None + + let sourceFile value = + match value with + | WorkspaceNodeValue.SourceFile f -> Some f + | _ -> None + + let referenceOnDisk value = + match value with + | WorkspaceNodeValue.ReferenceOnDisk r -> Some r + | _ -> None + + let projectConfigKey value = + match value with + | WorkspaceNodeKey.ProjectConfig p -> Some p + | _ -> None + + let projectSnapshotKey value = + match value with + | WorkspaceNodeKey.ProjectSnapshot p -> Some p + | _ -> None + + let projectWithoutFilesKey value = + match value with + | WorkspaceNodeKey.ProjectWithoutFiles x -> Some x + | _ -> None + + let sourceFileKey value = + match value with + | WorkspaceNodeKey.SourceFile f -> Some f + | _ -> None + + let referenceOnDiskKey value = + match value with + | WorkspaceNodeKey.ReferenceOnDisk r -> Some r + | _ -> None + +[] +module internal WorkspaceDependencyGraphExtensions = + + open WorkspaceGraphTypes + + /// This type adds extension methods to the dependency graph to constraint the types and type relations + /// that can be added to the graph. + /// + /// All unsafe operations that can throw at runtime, i.e. unpacking, are done here. + type internal WorkspaceDependencyGraphTypeExtensions = + + [] + static member AddOrUpdateFile(this: IDependencyGraph<_, _>, file: string, snapshot) = + this.AddOrUpdateNode(WorkspaceNodeKey.SourceFile file, WorkspaceNodeValue.SourceFile(snapshot)) + + [] + static member AddFiles(this: IDependencyGraph<_, _>, files: seq) = + let ids = + files + |> Seq.map (fun (file, snapshot) -> WorkspaceNodeKey.SourceFile file, WorkspaceNodeValue.SourceFile(snapshot)) + |> this.AddList + + GraphBuilder(this, ids, _.UnpackMany(WorkspaceNode.sourceFile), ()) + + [] + static member AddReferencesOnDisk(this: IDependencyGraph<_, _>, references: seq) = + let ids = + references + |> Seq.map (fun r -> WorkspaceNodeKey.ReferenceOnDisk r.Path, WorkspaceNodeValue.ReferenceOnDisk r) + |> this.AddList + + GraphBuilder(this, ids, _.UnpackMany(WorkspaceNode.referenceOnDisk), ()) + + [] + static member AddProjectConfig(this: GraphBuilder<_, _, ReferenceOnDisk seq, unit>, projectIdentifier, computeProjectConfig) = + this.AddDependentNode( + WorkspaceNodeKey.ProjectConfig projectIdentifier, + computeProjectConfig >> WorkspaceNodeValue.ProjectConfig, + _.UnpackOneMany(WorkspaceNode.projectConfig, WorkspaceNode.projectSnapshot), + projectIdentifier + ) + + [] + static member AddProjectWithoutFiles + ( + this: GraphBuilder<_, _, (ProjectConfig * FSharpProjectSnapshot seq), _>, + computeProjectWithoutFiles + ) = + this.AddDependentNode( + WorkspaceNodeKey.ProjectWithoutFiles this.State, + computeProjectWithoutFiles >> WorkspaceNodeValue.ProjectWithoutFiles, + _.UnpackOne(WorkspaceNode.projectWithoutFiles) + ) + + [] + static member AddSourceFiles(this: GraphBuilder<_, _, ProjectWithoutFiles, FSharpProjectIdentifier>, sourceFiles) = + let ids = + sourceFiles + |> Seq.map (fun (file, snapshot) -> WorkspaceNodeKey.SourceFile file, WorkspaceNodeValue.SourceFile(snapshot)) + |> this.Graph.AddList + + GraphBuilder( + this.Graph, + (Seq.append this.Ids ids), + (_.UnpackOneMany(WorkspaceNode.projectWithoutFiles, WorkspaceNode.sourceFile)), + this.State + ) + + [] + static member AddProjectSnapshot + ( + this: GraphBuilder<_, _, (ProjectWithoutFiles * FSharpFileSnapshot seq), _>, + computeProjectSnapshot + ) = + + this.AddDependentNode( + WorkspaceNodeKey.ProjectSnapshot this.State, + computeProjectSnapshot >> WorkspaceNodeValue.ProjectSnapshot, + ignore + ) + |> ignore + + [] + static member AddProjectReference(this: IDependencyGraph<_, _>, project, dependsOn) = + this.AddDependency(WorkspaceNodeKey.ProjectWithoutFiles project, dependsOn = WorkspaceNodeKey.ProjectSnapshot dependsOn) + + [] + static member RemoveProjectReference(this: IDependencyGraph<_, _>, project, noLongerDependsOn) = + this.RemoveDependency( + WorkspaceNodeKey.ProjectWithoutFiles project, + noLongerDependsOn = WorkspaceNodeKey.ProjectSnapshot noLongerDependsOn + ) + + [] + static member GetProjectSnapshot(this: IDependencyGraph<_, _>, project) = + this + .GetValue(WorkspaceNodeKey.ProjectSnapshot project) + .Unpack(WorkspaceNode.projectSnapshot) + + [] + static member GetProjectReferencesOf(this: IDependencyGraph<_, _>, project) = + this.GetDependenciesOf(WorkspaceNodeKey.ProjectWithoutFiles project) + |> Seq.choose (function + | WorkspaceNodeKey.ProjectSnapshot projectId -> Some projectId + | _ -> None) + + [] + static member GetProjectsThatReference(this: IDependencyGraph<_, _>, dllPath) = + this + .GetDependentsOf(WorkspaceNodeKey.ReferenceOnDisk dllPath) + .UnpackMany(WorkspaceNode.projectConfigKey) + + [] + static member GetProjectsContaining(this: IDependencyGraph<_, _>, file) = + this.GetDependentsOf(WorkspaceNodeKey.SourceFile file) + |> Seq.map this.GetValue + |> _.UnpackMany(WorkspaceNode.projectSnapshot) + +/// Interface for managing files in an F# workspace. +type FSharpWorkspaceFiles internal (depGraph: IThreadSafeDependencyGraph<_, _>) = + + /// Open files in the editor. + let openFiles = ConcurrentDictionary() + + /// Indicates that a file has been opened and has the given content. Any updates to the file should be done through `Files.Edit`. + member this.Open = this.Edit + + /// Indicates that a file has been changed and now has the given content. If it wasn't previously open it is considered open now. + member _.Edit(file: Uri, content) = + openFiles.AddOrUpdate(file.LocalPath, content, (fun _ _ -> content)) |> ignore + depGraph.AddOrUpdateFile(file.LocalPath, FSharpFileSnapshot.CreateFromString(file.LocalPath, content)) + + /// Indicates that a file has been closed. Any changes that were not saved to disk are undone and any further reading + /// of the file's contents will be from the filesystem. + member _.Close(file: Uri) = + openFiles.TryRemove(file.LocalPath) |> ignore + + // The file may have had changes that weren't saved to disk and are therefore undone by closing it. + depGraph.AddOrUpdateFile(file.LocalPath, FSharpFileSnapshot.CreateFromFileSystem(file.LocalPath)) + + member internal _.GetFileContentIfOpen(path: string) = + match openFiles.TryGetValue(path) with + | true, content -> Some content + | false, _ -> None + +/// Interface for managing with projects in an F# workspace. +type FSharpWorkspaceProjects internal (depGraph: IThreadSafeDependencyGraph<_, _>, files: FSharpWorkspaceFiles) = + + /// A map from project output path to project identifier. + let outputPathMap = ConcurrentDictionary() + + /// Adds or updates an F# project in the workspace. Project is identified by the project file and output path or FSharpProjectIdentifier. + member _.AddOrUpdate(projectConfig: ProjectConfig, sourceFilePaths: string seq) = + + let projectIdentifier = projectConfig.Identifier + + // Add the project identifier to the map + // TODO: do something if it's empty? + outputPathMap.AddOrUpdate(projectIdentifier.OutputFileName, (fun _ -> projectIdentifier), (fun _ _ -> projectIdentifier)) + |> ignore + + // Find any referenced projects that we aleady know about + let projectReferences = + projectConfig.ReferencesOnDisk + |> Seq.choose (fun ref -> + match outputPathMap.TryGetValue ref.Path with + | true, projectIdentifier -> Some projectIdentifier + | _ -> None) + |> Set + + depGraph.Transact(fun depGraph -> + + depGraph + .AddReferencesOnDisk(projectConfig.ReferencesOnDisk) + .AddProjectConfig(projectIdentifier, (fun refsOnDisk -> projectConfig.With(refsOnDisk |> Seq.toList))) + .AddProjectWithoutFiles( + (fun (projectConfig, referencedProjects) -> + + let referencedProjects = + referencedProjects + |> Seq.map (fun s -> + FSharpReferencedProjectSnapshot.FSharpReference( + s.OutputFileName + |> Option.defaultWith (fun () -> failwith "project doesn't have output filename"), + s + )) + |> Seq.toList + + projectConfig, referencedProjects) + ) + .AddSourceFiles( + sourceFilePaths + |> Seq.map (fun path -> + path, + files.GetFileContentIfOpen path + |> Option.map (fun content -> FSharpFileSnapshot.CreateFromString(path, content)) + |> Option.defaultWith (fun () -> FSharpFileSnapshot.CreateFromFileSystem path)) + ) + .AddProjectSnapshot( + (fun ((projectConfig, referencedProjects), sourceFiles) -> + ProjectSnapshot(projectConfig, referencedProjects, sourceFiles |> Seq.toList) + |> FSharpProjectSnapshot) + ) + + // In case this is an update, we should check for any existing project references that are not contained in the incoming compiler args and remove them + let existingReferences = depGraph.GetProjectReferencesOf projectIdentifier |> Set + + let referencesToRemove = existingReferences - projectReferences + let referencesToAdd = projectReferences - existingReferences + + for projectId in referencesToRemove do + depGraph.RemoveProjectReference(projectIdentifier, projectId) + + for projectId in referencesToAdd do + depGraph.AddProjectReference(projectIdentifier, projectId) + + // Check if any projects we know about depend on this project and add the references if they don't already exist + let dependentProjectIds = + depGraph.GetProjectsThatReference projectIdentifier.OutputFileName + + for dependentProjectId in dependentProjectIds do + depGraph.AddProjectReference(dependentProjectId, projectIdentifier) + + projectIdentifier) + + member this.AddOrUpdate(projectPath: string, outputPath, compilerArgs) = + + let directoryPath = Path.GetDirectoryName(projectPath) + + let fsharpFileExtensions = set [| ".fs"; ".fsi"; ".fsx" |] + + let isFSharpFile (file: string) = + Set.exists (fun (ext: string) -> file.EndsWith(ext, StringComparison.Ordinal)) fsharpFileExtensions + + let isReference: string -> bool = _.StartsWith("-r:") + + let referencesOnDisk = + compilerArgs |> Seq.filter isReference |> Seq.map _.Substring(3) + + let otherOptions = + compilerArgs + |> Seq.filter (not << isReference) + |> Seq.filter (not << isFSharpFile) + |> Seq.toList + + let sourceFiles = + compilerArgs + |> Seq.choose (fun (line: string) -> + if not (isFSharpFile line) then + None + else + Some(Path.Combine(directoryPath, line))) + + this.AddOrUpdate(projectPath, outputPath, sourceFiles, referencesOnDisk, otherOptions) + + member this.AddOrUpdate(projectFileName, outputFileName, sourceFiles, referencesOnDisk, otherOptions) = + + let projectConfig = + ProjectConfig(projectFileName, Some outputFileName, referencesOnDisk, otherOptions) + + this.AddOrUpdate(projectConfig, sourceFiles) diff --git a/src/FSharp.Compiler.LanguageServer/Common/LifecycleManager.fs b/src/FSharp.Compiler.LanguageServer/Common/LifecycleManager.fs index 14c6c4382e..cd033fc3d2 100644 --- a/src/FSharp.Compiler.LanguageServer/Common/LifecycleManager.fs +++ b/src/FSharp.Compiler.LanguageServer/Common/LifecycleManager.fs @@ -27,7 +27,7 @@ type FSharpLspServices(serviceCollection: IServiceCollection) as this = let serviceProvider = serviceCollection.BuildServiceProvider() interface ILspServices with - member this.GetRequiredService<'T>() : 'T = + member this.GetRequiredService<'T when 'T: not null>() : 'T = serviceProvider.GetRequiredService<'T>() member this.TryGetService(t) = serviceProvider.GetService(t) diff --git a/src/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj b/src/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj index 5a714ffd86..bb98e60d79 100644 --- a/src/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj +++ b/src/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj @@ -3,6 +3,7 @@ Exe net8.0 + true @@ -13,6 +14,10 @@ + + + + @@ -27,8 +32,11 @@ + + + diff --git a/src/FSharp.Compiler.LanguageServer/FSharpLanguageServer.fs b/src/FSharp.Compiler.LanguageServer/FSharpLanguageServer.fs index 70770760b1..71e6a148e3 100644 --- a/src/FSharp.Compiler.LanguageServer/FSharpLanguageServer.fs +++ b/src/FSharp.Compiler.LanguageServer/FSharpLanguageServer.fs @@ -30,7 +30,7 @@ type FSharpLanguageServer (jsonRpc: JsonRpc, logger: ILspLogger, ?initialWorkspace: FSharpWorkspace, ?addExtraHandlers: Action) = inherit AbstractLanguageServer(jsonRpc, logger) - let initialWorkspace = defaultArg initialWorkspace (FSharpWorkspace.Create []) + let initialWorkspace = defaultArg initialWorkspace (FSharpWorkspace()) do // This spins up the queue and ensure the LSP is ready to start receiving requests @@ -67,7 +67,7 @@ type FSharpLanguageServer lspServices :> ILspServices static member Create() = - FSharpLanguageServer.Create(FSharpWorkspace.Create Seq.empty, (fun _ -> ())) + FSharpLanguageServer.Create(FSharpWorkspace(), (fun _ -> ())) static member Create(initialWorkspace, addExtraHandlers: Action) = FSharpLanguageServer.Create(LspLogger System.Diagnostics.Trace.TraceInformation, initialWorkspace, addExtraHandlers) diff --git a/src/FSharp.Compiler.LanguageServer/Handlers/DocumentStateHandler.fs b/src/FSharp.Compiler.LanguageServer/Handlers/DocumentStateHandler.fs index 869d8a5614..e549b27a7c 100644 --- a/src/FSharp.Compiler.LanguageServer/Handlers/DocumentStateHandler.fs +++ b/src/FSharp.Compiler.LanguageServer/Handlers/DocumentStateHandler.fs @@ -21,7 +21,7 @@ type DocumentStateHandler() = ) = let contextHolder = context.LspServices.GetRequiredService() - contextHolder.UpdateWorkspace _.OpenFile(request.TextDocument.Uri, request.TextDocument.Text) + contextHolder.UpdateWorkspace _.Files.Open(request.TextDocument.Uri, request.TextDocument.Text) Task.FromResult(SemanticTokensDeltaPartialResult()) @@ -35,7 +35,7 @@ type DocumentStateHandler() = ) = let contextHolder = context.LspServices.GetRequiredService() - contextHolder.UpdateWorkspace _.ChangeFile(request.TextDocument.Uri, request.ContentChanges.[0].Text) + contextHolder.UpdateWorkspace _.Files.Edit(request.TextDocument.Uri, request.ContentChanges.[0].Text) Task.FromResult(SemanticTokensDeltaPartialResult()) @@ -49,6 +49,6 @@ type DocumentStateHandler() = ) = let contextHolder = context.LspServices.GetRequiredService() - contextHolder.UpdateWorkspace _.CloseFile(request.TextDocument.Uri) + contextHolder.UpdateWorkspace _.Files.Close(request.TextDocument.Uri) Task.CompletedTask diff --git a/src/FSharp.Compiler.LanguageServer/Handlers/LanguageFeaturesHandler.fs b/src/FSharp.Compiler.LanguageServer/Handlers/LanguageFeaturesHandler.fs index 1609cdc06c..d900fdfc3b 100644 --- a/src/FSharp.Compiler.LanguageServer/Handlers/LanguageFeaturesHandler.fs +++ b/src/FSharp.Compiler.LanguageServer/Handlers/LanguageFeaturesHandler.fs @@ -19,4 +19,4 @@ type LanguageFeaturesHandler() = context: FSharpRequestContext, cancellationToken: CancellationToken ) = - Task.FromResult(new RelatedUnchangedDocumentDiagnosticReport()) \ No newline at end of file + Task.FromResult(new RelatedUnchangedDocumentDiagnosticReport()) diff --git a/src/FSharp.VisualStudio.Extension/FSharpLanguageServerProvider.cs b/src/FSharp.VisualStudio.Extension/FSharpLanguageServerProvider.cs index ace7d25343..e7f0ecf07c 100644 --- a/src/FSharp.VisualStudio.Extension/FSharpLanguageServerProvider.cs +++ b/src/FSharp.VisualStudio.Extension/FSharpLanguageServerProvider.cs @@ -7,6 +7,7 @@ namespace FSharp.VisualStudio.Extension; using System.Collections.Generic; using System.Diagnostics; using System.IO; +using System.IO.Packaging; using System.IO.Pipelines; using System.Linq; using System.Threading; @@ -82,8 +83,8 @@ public ServerCapabilities OverrideServerCapabilities(ServerCapabilities value) Range = false }, HoverProvider = new HoverOptions() - { - WorkDoneProgress = true + { + WorkDoneProgress = true } }; return capabilities; @@ -101,7 +102,7 @@ public async Task HandleRequestAsync( FSharpRequestContext context, CancellationToken cancellationToken) { - var tokens = await context.GetSemanticTokensForFile(request!.TextDocument!.Uri).Please(cancellationToken); + var tokens = await context.Workspace.Query.GetSemanticTokensForFile(request!.TextDocument!.Uri).Please(cancellationToken); return new SemanticTokens { Data = tokens }; } @@ -117,15 +118,16 @@ internal class VsDiagnosticsHandler [LanguageServerEndpoint(VSInternalMethods.DocumentPullDiagnosticName)] public async Task HandleRequestAsync(VSInternalDocumentDiagnosticsParams request, FSharpRequestContext context, CancellationToken cancellationToken) { - var result = await context.GetDiagnosticsForFile(request!.TextDocument!.Uri).Please(cancellationToken); + var report = await context.Workspace.Query.GetDiagnosticsForFile(request!.TextDocument!.Uri).Please(cancellationToken); - var rep = new VSInternalDiagnosticReport + var vsReport = new VSInternalDiagnosticReport { - ResultId = "potato1", // Has to be present for diagnostic to show up - //Identifier = 69, + ResultId = report.ResultId, + //Identifier = 1, //Version = 1, + Diagnostics = - result.Select(d => + report.Diagnostics.Select(d => new Diagnostic { @@ -143,7 +145,7 @@ public async Task HandleRequestAsync(VSInternalDoc ).ToArray() }; - return [rep]; + return [vsReport]; } [LanguageServerEndpoint("textDocument/_vs_getProjectContexts")] @@ -171,6 +173,108 @@ public Task HandleRequestAsync(VSGetProjectContextsParams } +internal class SolutionObserver : IObserver> +{ + public void OnCompleted() + { + + } + + public void OnError(Exception error) + { + } + + public void OnNext(IQueryResults value) + { + Trace.TraceInformation("Solution was updated"); + } + +} + +internal class ProjectObserver(FSharpWorkspace workspace) : IObserver> +{ + private readonly FSharpWorkspace workspace = workspace; + + internal void ProcessProject(IProjectSnapshot project) + { + project.Id.TryGetValue("ProjectPath", out var projectPath); + + List<(string, string)> projectInfos = []; + + if (projectPath != null && projectPath.ToLower().EndsWith(".fsproj")) + { + var configs = project.ActiveConfigurations.ToList(); + + foreach (var config in configs) + { + if (config != null) + { + // Extract bin output path for each active config + var data = config.OutputGroups; + + string? outputPath = null; + foreach (var group in data) + { + if (group.Name == "Built") + { + foreach (var output in group.Outputs) + { + if (output.FinalOutputPath != null && (output.FinalOutputPath.ToLower().EndsWith(".dll") || output.FinalOutputPath.ToLower().EndsWith(".exe"))) + { + outputPath = output.FinalOutputPath; + break; + } + } + if (outputPath != null) + { + break; + } + } + } + + foreach (var ruleResults in config.RuleResults) + { + // XXX Idk why `.Where` does not work with these IAsyncQueryable type + if (ruleResults?.RuleName == "CompilerCommandLineArgs") + { + // XXX Not sure why there would be more than one item for this rule result + // Taking first one, ignoring the rest + var args = ruleResults?.Items?.FirstOrDefault()?.Name; + if (args != null && outputPath != null) projectInfos.Add((outputPath, args)); + } + } + } + } + + foreach (var projectInfo in projectInfos) + { + workspace.Projects.AddOrUpdate(projectPath, projectInfo.Item1, projectInfo.Item2.Split(';')); + } + + workspace.Debug_DumpMermaid("../../../../dep-graph.md"); + + + } + } + + public void OnNext(IQueryResults result) + { + foreach (var project in result) + { + this.ProcessProject(project); + } + } + + public void OnCompleted() + { + } + + public void OnError(Exception error) + { + } +} + + [VisualStudioContribution] internal class FSharpLanguageServerProvider : LanguageServerProvider { @@ -194,76 +298,37 @@ internal class FSharpLanguageServerProvider : LanguageServerProvider { var ws = this.Extensibility.Workspaces(); - IQueryResults? result = await ws.QueryProjectsAsync(project => project + var projectQuery = (IAsyncQueryable project) => project .With(p => p.ActiveConfigurations + .With(c => c.ConfigurationDimensions.With(d => d.Name).With(d => d.Value)) + .With(c => c.Properties.With(p => p.Name).With(p => p.Value)) + .With(c => c.OutputGroups.With(g => g.Name).With(g => g.Outputs.With(o => o.Name).With(o => o.FinalOutputPath).With(o => o.RootRelativeURL))) .With(c => c.RuleResultsByRuleName("CompilerCommandLineArgs") .With(r => r.RuleName) .With(r => r.Items))) - .With(p => new { p.ActiveConfigurations, p.Id, p.Guid }), cancellationToken); + .With(p => p.ProjectReferences + .With(r => r.ReferencedProjectPath) + .With(r => r.CanonicalName) + .With(r => r.Id) + .With(r => r.Name) + .With(r => r.ProjectGuid) + .With(r => r.ReferencedProjectId) + .With(r => r.ReferenceType)); + IQueryResults? result = await ws.QueryProjectsAsync(p => projectQuery(p).With(p => new { p.ActiveConfigurations, p.Id, p.Guid }), cancellationToken); + + var workspace = new FSharpWorkspace(); - List<(string, string)> projectsAndCommandLineArgs = []; foreach (var project in result) { - project.Id.TryGetValue("ProjectPath", out var projectPath); + var observer = new ProjectObserver(workspace); - List commandLineArgs = []; - if (projectPath != null) - { - // There can be multiple Active Configurations, e.g. one for net8.0 and one for net472 - // TODO For now taking any single one of them, but we might actually want to pick specific one - var config = project.ActiveConfigurations.FirstOrDefault(); - if (config != null) - { - foreach (var ruleResults in config.RuleResults) - { - // XXX Idk why `.Where` does not work with these IAsyncQuerable type - if (ruleResults?.RuleName == "CompilerCommandLineArgs") - { - // XXX Not sure why there would be more than one item for this rule result - // Taking first one, ignoring the rest - var args = ruleResults?.Items?.FirstOrDefault()?.Name; - if (args != null) commandLineArgs.Add(args); - } - } - } - if (commandLineArgs.Count > 0) - { - projectsAndCommandLineArgs.Add((projectPath, commandLineArgs[0])); - } - } + await projectQuery(project.AsQueryable()).SubscribeAsync(observer, CancellationToken.None); - try - { - this.ProcessProject(project); - } - catch (Exception ex) - { - Debug.WriteLine(ex); - } + // TODO: should we do this, or are we guaranteed it will get processed? + // observer.ProcessProject(project); } - FSharpWorkspace workspace; - - try - { - List snapshots = []; - foreach(var args in projectsAndCommandLineArgs) - { - var lines = args.Item2.Split(';'); // XXX Probably not robust enough - var path = args.Item1; - - string directoryPath = Path.GetDirectoryName(path) ?? throw new Exception("Directory path should not be null"); - var snapshot = FSharpProjectSnapshot.FromCommandLineArgs( - lines, directoryPath, Path.GetFileName(path)); - snapshots.Add(snapshot); - } - workspace = FSharpWorkspace.Create(snapshots); - } - catch - { - workspace = FSharpWorkspace.Create([]); - } var ((clientStream, serverStream), _server) = FSharpLanguageServer.Create(workspace, (serviceCollection) => { @@ -272,41 +337,25 @@ internal class FSharpLanguageServerProvider : LanguageServerProvider serviceCollection.AddSingleton(); }); - return new DuplexPipe( - PipeReader.Create(clientStream), - PipeWriter.Create(serverStream)); - } + var solutions = await ws.QuerySolutionAsync( + solution => solution.With(solution => solution.FileName), + cancellationToken); - private void ProcessProject(IProjectSnapshot project) - { - List>? files = project.Files.Please(); - var references = project.ProjectReferences.Please(); + var singleSolution = solutions.FirstOrDefault(); - var properties = project.Properties.Please(); - var id = project.Id; - - var configurationDimensions = project.ConfigurationDimensions.Please(); - var configurations = project.Configurations.Please(); - - foreach (var configuration in configurations) + if (singleSolution != null) { - this.ProcessConfiguration(configuration.Value); + var unsubscriber = await singleSolution + .AsQueryable() + .With(p => p.Projects.With(p => p.Files)) + .SubscribeAsync(new SolutionObserver(), CancellationToken.None); } - } - private void ProcessConfiguration(IProjectConfigurationSnapshot configuration) - { - var properties = configuration.Properties.Please(); - var packageReferences = configuration.PackageReferences.Please(); - var assemblyReferences = configuration.AssemblyReferences.Please(); - var refNames = assemblyReferences.Select(r => r.Value.Name).ToList(); - var dimensions = configuration.ConfigurationDimensions.Please(); - var outputGroups = configuration.OutputGroups.Please(); - var buildProperties = configuration.BuildProperties.Please(); - var buildPropDictionary = buildProperties.Select(p => (p.Value.Name, p.Value.Value)).ToList(); - return; - } + return new DuplexPipe( + PipeReader.Create(clientStream), + PipeWriter.Create(serverStream)); + } /// public override Task OnServerInitializationResultAsync(ServerInitializationResult serverInitializationResult, LanguageServerInitializationFailureInfo? initializationFailureInfo, CancellationToken cancellationToken) diff --git a/tests/FSharp.Compiler.LanguageServer.Tests/DependencyGraphTests.fs b/tests/FSharp.Compiler.LanguageServer.Tests/DependencyGraphTests.fs new file mode 100644 index 0000000000..5f6c378cfc --- /dev/null +++ b/tests/FSharp.Compiler.LanguageServer.Tests/DependencyGraphTests.fs @@ -0,0 +1,161 @@ +module DependencyGraphTests + +open FSharp.Compiler.LanguageServer.Common.DependencyGraph.Internal +open Xunit +open FSharp.Compiler.LanguageServer.Common.DependencyGraph + +[] +let ``Can add a node to the graph`` () = + let graph = DependencyGraph() + graph.AddOrUpdateNode(1, 1) |> ignore + Assert.Equal(1, graph.GetValue(1)) + +[] +let ``Can add a node with dependencies to the graph`` () = + let graph = DependencyGraph() + graph.AddOrUpdateNode(1, 1) + graph.AddOrUpdateNode(2, [ 1 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + + graph.AddOrUpdateNode(3, [ 2 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + |> ignore + + graph.AddOrUpdateNode(4, [ 1; 3 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + |> ignore + + Assert.Equal(2, graph.GetValue(2)) + Assert.Equal(3, graph.GetValue(3)) + Assert.Equal(5, graph.GetValue(4)) + +[] +let ``Can update a value`` () = + let graph = DependencyGraph() + graph.AddOrUpdateNode(1, 1) + graph.AddOrUpdateNode(2, [ 1 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + + graph.AddOrUpdateNode(3, [ 2 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + |> ignore + + graph.AddOrUpdateNode(4, [ 1; 3 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + |> ignore + + graph.AddOrUpdateNode(1, 2) |> ignore + + // Values were invalidated + Assert.Equal(None, graph.Debug.Nodes[2].Value) + Assert.Equal(None, graph.Debug.Nodes[3].Value) + Assert.Equal(None, graph.Debug.Nodes[4].Value) + + Assert.Equal(7, graph.GetValue(4)) + Assert.Equal(Some 3, graph.Debug.Nodes[2].Value) + Assert.Equal(Some 4, graph.Debug.Nodes[3].Value) + Assert.Equal(Some 7, graph.Debug.Nodes[4].Value) + +[] +let ``Dependencies are ordered`` () = + let graph = DependencyGraph() + let input = [ 1..100 ] + let ids = graph.AddList(seq { for x in input -> (x, [ x ]) }) + + graph.AddOrUpdateNode(101, ids, (fun deps -> deps |> Seq.collect id |> Seq.toList)) + |> ignore + + Assert.Equal(input, graph.GetValue(101)) + graph.AddOrUpdateNode(35, [ 42 ]) |> ignore + let expectedResult = input |> List.map (fun x -> if x = 35 then 42 else x) + Assert.Equal(expectedResult, graph.GetValue(101)) + +[] +let ``We can add a dependency between existing nodes`` () = + let graph = DependencyGraph() + graph.AddOrUpdateNode(1, [ 1 ]) + + graph.AddOrUpdateNode(2, [ 1 ], (fun deps -> deps |> Seq.concat |> Seq.toList)) + |> ignore + + graph.AddOrUpdateNode(3, [ 3 ]) |> ignore + Assert.Equal([ 1 ], graph.GetValue(2)) + graph.AddDependency(2, 3) + Assert.Equal([ 1; 3 ], graph.GetValue(2)) + +[] +let ``Can remove a node and update dependents`` () = + let graph = DependencyGraph() + graph.AddOrUpdateNode(1, 1) + graph.AddOrUpdateNode(2, [ 1 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + + graph.AddOrUpdateNode(3, [ 2 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + |> ignore + + graph.AddOrUpdateNode(4, [ 1; 3 ], (fun deps -> deps |> Seq.sum |> (+) 1)) + |> ignore + + // Check values before removal + Assert.Equal(2, graph.GetValue(2)) + Assert.Equal(3, graph.GetValue(3)) + Assert.Equal(5, graph.GetValue(4)) + + graph.RemoveNode(1) |> ignore + + // Check new values + Assert.Equal(1, graph.GetValue(2)) + Assert.Equal(2, graph.GetValue(3)) + Assert.Equal(3, graph.GetValue(4)) + +type MyDiscriminatedUnion = + | CaseA of int + | CaseB of string + +[] +let ``GraphBuilder with discriminated union`` () = + let graph = DependencyGraph() + let builder = GraphBuilder(graph, [ 1 ], (fun values -> values |> Seq.head), ()) + builder.Graph.AddOrUpdateNode(1, CaseA 1) + + builder.AddDependentNode( + 2, + (function + | CaseA x -> CaseB(string x) + | CaseB _ -> failwith "Unexpected case"), + (fun values -> values |> Seq.head) + ) + |> ignore + + Assert.Equal(CaseB "1", graph.GetValue(2)) + +[] +let ``GraphBuilder with chained AddDependentNode calls`` () = + let graph = DependencyGraph() + let builder = GraphBuilder(graph, [ 1 ], (fun values -> values |> Seq.head), ()) + builder.Graph.AddOrUpdateNode(1, CaseA 1) + + let builder2 = + builder.AddDependentNode( + 2, + (function + | CaseA x -> CaseB(string x) + | CaseB _ -> failwith "Unexpected case"), + (fun values -> values |> Seq.head) + ) + + builder2.AddDependentNode( + 3, + (function + | CaseB x -> CaseA(int x * 2) + | CaseA _ -> failwith "Unexpected case"), + (fun values -> values |> Seq.head) + ) + |> ignore + + Assert.Equal(CaseB "1", graph.GetValue(2)) + Assert.Equal(CaseA 2, graph.GetValue(3)) + + // Update the value of node 1 + builder.Graph.AddOrUpdateNode(1, CaseA 2) |> ignore + + // Values were invalidated + Assert.Equal(None, graph.Debug.Nodes[2].Value) + Assert.Equal(None, graph.Debug.Nodes[3].Value) + + // Check new values + Assert.Equal(CaseB "2", graph.GetValue(2)) + Assert.Equal(CaseA 4, graph.GetValue(3)) diff --git a/tests/FSharp.Compiler.LanguageServer.Tests/FSharp.Compiler.LanguageServer.Tests.fsproj b/tests/FSharp.Compiler.LanguageServer.Tests/FSharp.Compiler.LanguageServer.Tests.fsproj index dbffa2deb1..9570ca4844 100644 --- a/tests/FSharp.Compiler.LanguageServer.Tests/FSharp.Compiler.LanguageServer.Tests.fsproj +++ b/tests/FSharp.Compiler.LanguageServer.Tests/FSharp.Compiler.LanguageServer.Tests.fsproj @@ -15,6 +15,8 @@ + + diff --git a/tests/FSharp.Compiler.LanguageServer.Tests/FSharpWorkspaceTests.fs b/tests/FSharp.Compiler.LanguageServer.Tests/FSharpWorkspaceTests.fs new file mode 100644 index 0000000000..46492d09c0 --- /dev/null +++ b/tests/FSharp.Compiler.LanguageServer.Tests/FSharpWorkspaceTests.fs @@ -0,0 +1,300 @@ +module FSharpWorkspaceTests + +open System +open Xunit +open FSharp.Compiler.LanguageServer.Common +open FSharp.Compiler.CodeAnalysis.ProjectSnapshot +open TestFramework +open FSharp.Compiler.IO + +#nowarn "57" + +type ProjectConfig with + + static member Minimal(?name, ?outputPath, ?referencesOnDisk) = + let name = defaultArg name "test" + let projectFileName = $"{name}.fsproj" + let outputPath = defaultArg outputPath $"{name}.dll" + let referencesOnDisk = defaultArg referencesOnDisk [] + ProjectConfig(projectFileName, Some outputPath, referencesOnDisk, []) + +let getReferencedSnapshot (projectIdentifier: FSharpProjectIdentifier) (projectSnapshot: FSharpProjectSnapshot) = + projectSnapshot.ReferencedProjects + |> Seq.pick (function + | FSharpReference(x, snapshot) when x = projectIdentifier.OutputFileName -> Some snapshot + | _ -> None) + +let sourceFileOnDisk (content: string) = + let path = getTemporaryFileName () + ".fs" + FileSystem.OpenFileForWriteShim(path).Write(content) + Uri(path) + +let assertFileHasContent filePath expectedContent (projectSnapshot: FSharpProjectSnapshot) = + let fileSnapshot = + projectSnapshot.SourceFiles |> Seq.find (_.FileName >> (=) filePath) + + Assert.Equal(expectedContent, fileSnapshot.GetSource().Result.ToString()) + +[] +let ``Add project to workspace`` () = + let workspace = FSharpWorkspace() + let projectPath = "test.fsproj" + let outputPath = "test.dll" + let compilerArgs = [| "test.fs" |] + let projectIdentifier = workspace.Projects.AddOrUpdate(projectPath, outputPath, compilerArgs) + let projectSnapshot = workspace.Query.GetProjectSnapshot(projectIdentifier).Value + Assert.NotNull(projectSnapshot) + Assert.Equal(projectPath, projectSnapshot.ProjectFileName) + Assert.Equal(Some outputPath, projectSnapshot.OutputFileName) + Assert.Contains("test.fs", projectSnapshot.SourceFiles |> Seq.map (fun f -> f.FileName)) + +[] +let ``Open file in workspace`` () = + let workspace = FSharpWorkspace() + let fileUri = Uri("file:///test.fs") + let content = "let x = 1" + + let projectPath = "test.fsproj" + let outputPath = "test.dll" + let compilerArgs = [| fileUri.LocalPath |] + let _projectIdentifier = workspace.Projects.AddOrUpdate(projectPath, outputPath, compilerArgs) + + workspace.Files.Open(fileUri, content) + let projectSnapshot = workspace.Query.GetProjectSnapshotForFile(fileUri) + + // Retrieve the file snapshot from the project snapshot + let fileSnapshot = + projectSnapshot + |> Option.defaultWith (fun () -> failwith "Project snapshot not found") + |> _.SourceFiles + |> Seq.find (fun f -> f.FileName = fileUri.LocalPath) + + // Assert that the content of the file in the snapshot is correct + Assert.Equal(content, fileSnapshot.GetSource().Result.ToString()) + + let fileSnapshot = + projectSnapshot + |> Option.defaultWith (fun () -> failwith "Project snapshot not found") + |> _.SourceFiles + |> Seq.find (fun f -> f.FileName = fileUri.LocalPath) + + Assert.Equal(content, fileSnapshot.GetSource().Result.ToString()) + +[] +let ``Close file in workspace`` () = + let workspace = FSharpWorkspace() + + let contentOnDisk = "let x = 1" + let fileOnDisk = sourceFileOnDisk contentOnDisk + + let _projectIdentifier = + workspace.Projects.AddOrUpdate(ProjectConfig.Minimal(), [ fileOnDisk.LocalPath ]) + + workspace.Files.Open(fileOnDisk, contentOnDisk) + + let contentInMemory = "let x = 2" + workspace.Files.Edit(fileOnDisk, contentInMemory) + + let projectSnapshot = + workspace.Query.GetProjectSnapshotForFile(fileOnDisk) + |> Option.defaultWith (fun () -> failwith "Project snapshot not found") + + let fileSnapshot = + projectSnapshot.SourceFiles |> Seq.find (_.FileName >> (=) fileOnDisk.LocalPath) + + Assert.Equal(contentInMemory, fileSnapshot.GetSource().Result.ToString()) + + workspace.Files.Close(fileOnDisk) + + let projectSnapshot = + workspace.Query.GetProjectSnapshotForFile(fileOnDisk) + |> Option.defaultWith (fun () -> failwith "Project snapshot not found") + + let fileSnapshot = + projectSnapshot.SourceFiles |> Seq.find (_.FileName >> (=) fileOnDisk.LocalPath) + + Assert.Equal(contentOnDisk, fileSnapshot.GetSource().Result.ToString()) + +[] +let ``Change file in workspace`` () = + let workspace = FSharpWorkspace() + + let fileUri = Uri("file:///test.fs") + + let _projectIdentifier = + workspace.Projects.AddOrUpdate(ProjectConfig.Minimal(), [ fileUri.LocalPath ]) + + let initialContent = "let x = 2" + + workspace.Files.Open(fileUri, initialContent) + + let updatedContent = "let x = 3" + + workspace.Files.Edit(fileUri, updatedContent) + + let projectSnapshot = + workspace.Query.GetProjectSnapshotForFile(fileUri) + |> Option.defaultWith (fun () -> failwith "Project snapshot not found") + + let fileSnapshot = + projectSnapshot.SourceFiles |> Seq.find (_.FileName >> (=) fileUri.LocalPath) + + Assert.Equal(updatedContent, fileSnapshot.GetSource().Result.ToString()) + +[] +let ``Add multiple projects with references`` () = + let workspace = FSharpWorkspace() + let projectPath1 = "test1.fsproj" + let outputPath1 = "test1.dll" + let compilerArgs1 = [| "test1.fs" |] + + let projectIdentifier1 = + workspace.Projects.AddOrUpdate(projectPath1, outputPath1, compilerArgs1) + + let projectPath2 = "test2.fsproj" + let outputPath2 = "test2.dll" + let compilerArgs2 = [| "test2.fs"; "-r:test1.dll" |] + + let projectIdentifier2 = + workspace.Projects.AddOrUpdate(projectPath2, outputPath2, compilerArgs2) + + let projectSnapshot1 = workspace.Query.GetProjectSnapshot(projectIdentifier1).Value + let projectSnapshot2 = workspace.Query.GetProjectSnapshot(projectIdentifier2).Value + Assert.Contains("test1.fs", projectSnapshot1.SourceFiles |> Seq.map (fun f -> f.FileName)) + Assert.Contains("test2.fs", projectSnapshot2.SourceFiles |> Seq.map (fun f -> f.FileName)) + + Assert.Contains( + projectSnapshot1, + projectSnapshot2.ReferencedProjects + |> Seq.choose (function + | FSharpReferencedProjectSnapshot.FSharpReference(_, s) -> Some s + | _ -> None) + ) + +[] +let ``Propagate changes to snapshots`` () = + let workspace = FSharpWorkspace() + + let file1 = sourceFileOnDisk "let x = 1" + let pid1 = workspace.Projects.AddOrUpdate(ProjectConfig.Minimal("p1"), [ file1.LocalPath ]) + + let file2 = sourceFileOnDisk "let y = 2" + + let pid2 = + workspace.Projects.AddOrUpdate(ProjectConfig.Minimal("p2", referencesOnDisk = [ pid1.OutputFileName ]), [ file2.LocalPath ]) + + let file3 = sourceFileOnDisk "let z = 3" + + let pid3 = + workspace.Projects.AddOrUpdate(ProjectConfig.Minimal("p3", referencesOnDisk = [ pid2.OutputFileName ]), [ file3.LocalPath ]) + + let s3 = workspace.Query.GetProjectSnapshot(pid3).Value + + s3 + |> getReferencedSnapshot pid2 + |> getReferencedSnapshot pid1 + |> assertFileHasContent file1.LocalPath "let x = 1" + + let updatedContent = "let x = 2" + + workspace.Files.Edit(file1, updatedContent) + + let s3 = workspace.Query.GetProjectSnapshot(pid3).Value + + s3 + |> getReferencedSnapshot pid2 + |> getReferencedSnapshot pid1 + |> assertFileHasContent file1.LocalPath updatedContent + +[] +let ``Update project by adding a source file`` () = + let workspace = FSharpWorkspace() + let projectPath = "test.fsproj" + let outputPath = "test.dll" + let compilerArgs = [| "test.fs" |] + let projectIdentifier = workspace.Projects.AddOrUpdate(projectPath, outputPath, compilerArgs) + let newSourceFile = "newTest.fs" + let newCompilerArgs = [| "test.fs"; newSourceFile |] + workspace.Projects.AddOrUpdate(projectPath, outputPath, newCompilerArgs) |> ignore + let projectSnapshot = workspace.Query.GetProjectSnapshot(projectIdentifier).Value + Assert.NotNull(projectSnapshot) + Assert.Contains("test.fs", projectSnapshot.SourceFiles |> Seq.map (fun f -> f.FileName)) + Assert.Contains(newSourceFile, projectSnapshot.SourceFiles |> Seq.map (fun f -> f.FileName)) + +[] +let ``Update project by adding a reference`` () = + let workspace = FSharpWorkspace() + let projectPath1 = "test1.fsproj" + let outputPath1 = "test1.dll" + let compilerArgs1 = [| "test1.fs" |] + + let projectIdentifier1 = + workspace.Projects.AddOrUpdate(projectPath1, outputPath1, compilerArgs1) + + let projectPath2 = "test2.fsproj" + let outputPath2 = "test2.dll" + let compilerArgs2 = [| "test2.fs" |] + + let projectIdentifier2 = + workspace.Projects.AddOrUpdate(projectPath2, outputPath2, compilerArgs2) + + let newCompilerArgs2 = [| "test2.fs"; "-r:test1.dll" |] + workspace.Projects.AddOrUpdate(projectPath2, outputPath2, newCompilerArgs2) |> ignore + let projectSnapshot1 = workspace.Query.GetProjectSnapshot(projectIdentifier1).Value + let projectSnapshot2 = workspace.Query.GetProjectSnapshot(projectIdentifier2).Value + + Assert.Contains( + projectSnapshot1, + projectSnapshot2.ReferencedProjects + |> Seq.choose (function + | FSharpReferencedProjectSnapshot.FSharpReference(_, s) -> Some s + | _ -> None) + ) + +[] +let ``Create references in existing projects`` () = + let workspace = FSharpWorkspace() + let projectPath1 = "test1.fsproj" + let outputPath1 = "test1.dll" + let compilerArgs1 = [| "test1.fs" |] + + let projectIdentifier1 = + workspace.Projects.AddOrUpdate(projectPath1, outputPath1, compilerArgs1) + + let projectPath2 = "test2.fsproj" + let outputPath2 = "test2.dll" + let compilerArgs2 = [| "test2.fs" |] + + let projectIdentifier2 = + workspace.Projects.AddOrUpdate(projectPath2, outputPath2, compilerArgs2) + + let projectSnapshot1 = workspace.Query.GetProjectSnapshot(projectIdentifier1).Value + let projectSnapshot2 = workspace.Query.GetProjectSnapshot(projectIdentifier2).Value + + Assert.DoesNotContain( + projectSnapshot1, + projectSnapshot2.ReferencedProjects + |> Seq.choose (function + | FSharpReferencedProjectSnapshot.FSharpReference(_, s) -> Some s + | _ -> None) + ) + + let newCompilerArgs2 = [| "test2.fs"; "-r:test1.dll" |] + workspace.Projects.AddOrUpdate(projectPath2, outputPath2, newCompilerArgs2) |> ignore + let projectSnapshot1 = workspace.Query.GetProjectSnapshot(projectIdentifier1).Value + let projectSnapshot2 = workspace.Query.GetProjectSnapshot(projectIdentifier2).Value + + Assert.Contains( + projectSnapshot1, + projectSnapshot2.ReferencedProjects + |> Seq.choose (function + | FSharpReferencedProjectSnapshot.FSharpReference(_, s) -> Some s + | _ -> None) + ) + +[] +let ``Asking for an unknown project snapshot returns None`` () = + + let workspace = FSharpWorkspace() + + Assert.Equal(None, workspace.Query.GetProjectSnapshot(FSharpProjectIdentifier("hello", "world"))) diff --git a/tests/FSharp.Compiler.LanguageServer.Tests/LanguageServerTests.fs b/tests/FSharp.Compiler.LanguageServer.Tests/LanguageServerTests.fs index df5fc6f41d..f1f633a4c0 100644 --- a/tests/FSharp.Compiler.LanguageServer.Tests/LanguageServerTests.fs +++ b/tests/FSharp.Compiler.LanguageServer.Tests/LanguageServerTests.fs @@ -11,42 +11,41 @@ open System.Diagnostics open Microsoft.VisualStudio.LanguageServer.Protocol open Nerdbank.Streams - [] let ``The server can process the initialization message`` () = - // Create a StringWriter to capture the output + // Create a StringWriter to capture the output let rpcTrace = new StringWriter() try - let struct (clientStream, _serverStream) = FullDuplexStream.CreatePair() + let struct (clientStream, _serverStream) = FullDuplexStream.CreatePair() - use formatter = new JsonMessageFormatter() + use formatter = new JsonMessageFormatter() - use messageHandler = new HeaderDelimitedMessageHandler(clientStream, clientStream, formatter) + use messageHandler = + new HeaderDelimitedMessageHandler(clientStream, clientStream, formatter) - use jsonRpc = new JsonRpc(messageHandler) - + use jsonRpc = new JsonRpc(messageHandler) - // Create a new TraceListener with the StringWriter - let listener = new TextWriterTraceListener(rpcTrace) + // Create a new TraceListener with the StringWriter + let listener = new TextWriterTraceListener(rpcTrace) - // Add the listener to the JsonRpc TraceSource - jsonRpc.TraceSource.Listeners.Add(listener) |> ignore + // Add the listener to the JsonRpc TraceSource + jsonRpc.TraceSource.Listeners.Add(listener) |> ignore - // Set the TraceLevel to Information to get all informational, warning and error messages - jsonRpc.TraceSource.Switch.Level <- SourceLevels.Information + // Set the TraceLevel to Information to get all informational, warning and error messages + jsonRpc.TraceSource.Switch.Level <- SourceLevels.Information - //jsonRpc.inv + //jsonRpc.inv - // Now all JsonRpc debug information will be written to the StringWriter + // Now all JsonRpc debug information will be written to the StringWriter - let log = ResizeArray() + let log = ResizeArray() - let _s = new FSharpLanguageServer(jsonRpc, (LspLogger log.Add)) + let _s = new FSharpLanguageServer(jsonRpc, (LspLogger log.Add)) - jsonRpc.StartListening() + jsonRpc.StartListening() //let initializeParams = InitializeParams( // ProcessId = System.Diagnostics.Process.GetCurrentProcess().Id, @@ -54,10 +53,7 @@ let ``The server can process the initialization message`` () = // InitializationOptions = None, // RootPath = "file:///c:/temp") - - - finally let _output = rpcTrace.ToString() - () \ No newline at end of file + () diff --git a/tests/FSharp.Compiler.LanguageServer.Tests/Program.fs b/tests/FSharp.Compiler.LanguageServer.Tests/Program.fs index 0695f84c68..80c6d84278 100644 --- a/tests/FSharp.Compiler.LanguageServer.Tests/Program.fs +++ b/tests/FSharp.Compiler.LanguageServer.Tests/Program.fs @@ -1 +1,3 @@ -module Program = let [] main _ = 0 +module Program = + [] + let main _ = 0