diff --git a/src/FsAutoComplete/FsAutoComplete.fsproj b/src/FsAutoComplete/FsAutoComplete.fsproj
index 86c0fbe39..03bdb7089 100644
--- a/src/FsAutoComplete/FsAutoComplete.fsproj
+++ b/src/FsAutoComplete/FsAutoComplete.fsproj
@@ -30,6 +30,8 @@
+
+
diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
index 1ee6abf36..f030ea810 100644
--- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
+++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
@@ -2,7 +2,6 @@ namespace FsAutoComplete.Lsp
open System
open System.IO
-open System.Threading
open FsAutoComplete
open FsAutoComplete.Core
open FsAutoComplete.CodeFix
@@ -15,10 +14,8 @@ open Ionide.LanguageServerProtocol.Types
open Newtonsoft.Json.Linq
open Ionide.ProjInfo.ProjectSystem
open System.Reactive
-open System.Reactive.Linq
open System.Runtime.CompilerServices
open System.Runtime.InteropServices
-open System.Buffers
open FsAutoComplete.Adaptive
open FsAutoComplete.LspHelpers
@@ -31,7 +28,6 @@ open FSharp.UMX
open FSharp.Compiler.Text
open CliWrap
open CliWrap.Buffered
-open FSharp.Compiler.Tokenization
open FSharp.Compiler.EditorServices
open FSharp.Compiler.Symbols
open Fantomas.Client.Contracts
@@ -39,983 +35,29 @@ open Fantomas.Client.LSPFantomasService
open FSharp.Data.Adaptive
open Ionide.ProjInfo
-open FSharp.Compiler.CodeAnalysis
-open FsAutoComplete.LspHelpers
-open FsAutoComplete.UnionPatternMatchCaseGenerator
-open System.Collections.Concurrent
open System.Diagnostics
-open System.Text.RegularExpressions
open IcedTasks
open System.Threading.Tasks
open FsAutoComplete.FCSPatches
-open FSharp.Compiler.Syntax
-
-[]
-type WorkspaceChosen =
- | Sln of string // TODO later when ionide supports sending specific choices instead of only fsprojs
- | Directory of string // TODO later when ionide supports sending specific choices instead of only fsprojs
- | Projs of HashSet>
- | NotChosen
-
-[]
-type AdaptiveWorkspaceChosen =
- | Sln of aval * DateTime> // TODO later when ionide supports sending specific choices instead of only fsprojs
- | Directory of aval * DateTime> // TODO later when ionide supports sending specific choices instead of only fsprojs
- | Projs of amap, DateTime>
- | NotChosen
-
-
-[]
-type LoadedProject =
- { FSharpProjectOptions: FSharpProjectOptions
- LanguageVersion: LanguageVersionShim }
-
- interface IEquatable with
- member x.Equals(other) = x.FSharpProjectOptions = other.FSharpProjectOptions
-
- override x.GetHashCode() = x.FSharpProjectOptions.GetHashCode()
-
- override x.Equals(other) =
- match other with
- | :? LoadedProject as other -> (x :> IEquatable<_>).Equals other
- | _ -> false
-
- member x.SourceFiles = x.FSharpProjectOptions.SourceFiles
- member x.ProjectFileName = x.FSharpProjectOptions.ProjectFileName
- static member op_Implicit(x: LoadedProject) = x.FSharpProjectOptions
-
+open Helpers
type AdaptiveFSharpLspServer
(workspaceLoader: IWorkspaceLoader, lspClient: FSharpLspClient, sourceTextFactory: ISourceTextFactory) =
- let logger = LogProvider.getLoggerFor ()
-
- let thisType = typeof
-
- let disposables = new Disposables.CompositeDisposable()
-
- let rootPath = cval None
-
- let config = cval FSharpConfig.Default
-
- let checker =
- config
- |> AVal.map (fun c -> c.EnableAnalyzers, c.Fsac.CachedTypeCheckCount, c.Fsac.ParallelReferenceResolution)
- |> AVal.map (FSharpCompilerServiceChecker)
-
- /// The reality is a file can be in multiple projects
- /// This is extracted to make it easier to do some type of customized select
- /// in the future
- let selectProject projs = projs |> List.tryHead
-
- let selectFSharpProject (projs: LoadedProject list) =
- projs |> List.tryHead |> Option.map (fun p -> p.FSharpProjectOptions)
-
- let mutable traceNotifications: ProgressListener option = None
-
- /// Toggles trace notifications on or off.
- /// Determines if tracing should occur
- /// The namespaces to start tracing
- ///
- let toggleTraceNotification shouldTrace traceNamespaces =
- traceNotifications |> Option.iter dispose
-
- if shouldTrace then
- traceNotifications <- Some(new ProgressListener(lspClient, traceNamespaces))
- else
- traceNotifications <- None
-
- /// Sets tje FSI arguments on the FSharpCompilerServiceChecker
- ///
- /// Compiler tool locations
- /// Any extra parameters to pass to FSI
- let setFSIArgs
- (checker: FSharpCompilerServiceChecker)
- (fsiCompilerToolLocations: string array)
- (fsiExtraParameters: seq)
- =
- let toCompilerToolArgument (path: string) = sprintf "--compilertool:%s" path
-
- checker.SetFSIAdditionalArguments
- [| yield! fsiCompilerToolLocations |> Array.map toCompilerToolArgument
- yield! fsiExtraParameters |]
-
- /// Loads F# Analyzers from the configured directories
- /// The FSharpConfig
- /// The RootPath
- ///
- let loadAnalyzers (config: FSharpConfig) (rootPath: string option) =
- if config.EnableAnalyzers then
- Loggers.analyzers.info (Log.setMessageI $"Using analyzer roots of {config.AnalyzersPath:roots}")
-
- config.AnalyzersPath
- |> Array.iter (fun analyzerPath ->
- match rootPath with
- | None -> ()
- | Some workspacePath ->
- let dir =
- if
- System.IO.Path.IsPathRooted analyzerPath
- // if analyzer is using absolute path, use it as is
- then
- analyzerPath
- // otherwise, it is a relative path and should be combined with the workspace path
- else
- System.IO.Path.Combine(workspacePath, analyzerPath)
-
- Loggers.analyzers.info (Log.setMessageI $"Loading analyzers from {dir:dir}")
-
- let (dllCount, analyzerCount) = dir |> FSharp.Analyzers.SDK.Client.loadAnalyzers
-
- Loggers.analyzers.info (
- Log.setMessageI
- $"From {analyzerPath:name}: {dllCount:dllNo} dlls including {analyzerCount:analyzersNo} analyzers"
- ))
-
- else
- Loggers.analyzers.info (Log.setMessage "Analyzers disabled")
-
- ///
- /// the FSharpCompilerServiceChecker
- /// The path to dotnet
- /// The root path
- ///
- let setDotnetRoot (checker: FSharpCompilerServiceChecker) (dotnetRoot: string) (rootPath: string option) =
- let di = DirectoryInfo dotnetRoot
-
- if di.Exists then
- let dotnetBinary =
- if
- System.Runtime.InteropServices.RuntimeInformation.IsOSPlatform(Runtime.InteropServices.OSPlatform.Windows)
- then
- FileInfo(Path.Combine(di.FullName, "dotnet.exe"))
- else
- FileInfo(Path.Combine(di.FullName, "dotnet"))
-
- if dotnetBinary.Exists then
- checker.SetDotnetRoot(dotnetBinary, defaultArg rootPath System.Environment.CurrentDirectory |> DirectoryInfo)
-
- else
- // if we were mistakenly given the path to a dotnet binary
- // then use the parent directory as the dotnet root instead
- let fi = FileInfo(di.FullName)
-
- if fi.Exists && (fi.Name = "dotnet" || fi.Name = "dotnet.exe") then
- checker.SetDotnetRoot(fi, defaultArg rootPath System.Environment.CurrentDirectory |> DirectoryInfo)
-
- let configChanges =
- aval {
- let! config = config
- and! checker = checker
- and! rootPath = rootPath
-
- return config, checker, rootPath
- }
-
- // Syncs config changes to the mutable world
- do
- AVal.Observable.onValueChangedWeak configChanges
- |> Observable.subscribe (fun (config, checker, rootPath) ->
- toggleTraceNotification config.Notifications.Trace config.Notifications.TraceNamespaces
-
- setFSIArgs checker config.FSICompilerToolLocations config.FSIExtraParameters
-
- loadAnalyzers config rootPath
-
- setDotnetRoot checker config.DotNetRoot rootPath)
- |> disposables.Add
-
- let updateConfig c = transact (fun () -> config.Value <- c)
-
- let tfmConfig =
- config
- |> AVal.map (fun c ->
- if c.UseSdkScripts then
- FSIRefs.TFM.NetCore
- else
- FSIRefs.TFM.NetFx)
-
-
- let sendDiagnostics (uri: DocumentUri) (diags: Diagnostic[]) =
- logger.info (Log.setMessageI $"SendDiag for {uri:file}: {diags.Length:diags} entries")
-
- // TODO: providing version would be very useful
- { Uri = uri
- Diagnostics = diags
- Version = None }
- |> lspClient.TextDocumentPublishDiagnostics
-
let mutable lastFSharpDocumentationTypeCheck: ParseAndCheckResults option = None
- let diagnosticCollections = new DiagnosticCollection(sendDiagnostics)
-
- let notifications = Event()
-
- let scriptFileProjectOptions = Event()
-
- let fileParsed =
- Event()
-
- let fileChecked = Event()
-
- let detectTests (parseResults: FSharpParseFileResults) (proj: FSharpProjectOptions) ct =
- try
- logger.info (Log.setMessageI $"Test Detection of {parseResults.FileName:file} started")
-
- let fn = UMX.tag parseResults.FileName
-
- let res =
- if proj.OtherOptions |> Seq.exists (fun o -> o.Contains "Expecto.dll") then
- TestAdapter.getExpectoTests parseResults.ParseTree
- elif proj.OtherOptions |> Seq.exists (fun o -> o.Contains "nunit.framework.dll") then
- TestAdapter.getNUnitTest parseResults.ParseTree
- elif proj.OtherOptions |> Seq.exists (fun o -> o.Contains "xunit.assert.dll") then
- TestAdapter.getXUnitTest parseResults.ParseTree
- else
- []
-
- logger.info (Log.setMessageI $"Test Detection of {parseResults.FileName:file} - {res:res}")
-
- notifications.Trigger(NotificationEvent.TestDetected(fn, res |> List.toArray), ct)
- with e ->
- logger.info (
- Log.setMessageI $"Test Detection of {parseResults.FileName:file} failed"
- >> Log.addExn e
- )
-
- do
- disposables.Add
- <| fileParsed.Publish.Subscribe(fun (parseResults, proj, ct) -> detectTests parseResults proj ct)
-
- let builtInCompilerAnalyzers config (file: VolatileFile) (tyRes: ParseAndCheckResults) =
- let filePath = file.FileName
- let filePathUntag = UMX.untag filePath
- let source = file.Source
- let version = file.Version
- let fileName = Path.GetFileName filePathUntag
-
-
- let inline getSourceLine lineNo = (source: ISourceText).GetLineString(lineNo - 1)
-
- let checkUnusedOpens =
- async {
- try
- use progress = new ServerProgressReport(lspClient)
- do! progress.Begin($"Checking unused opens {fileName}...", message = filePathUntag)
-
- let! unused = UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, getSourceLine)
-
- let! ct = Async.CancellationToken
- notifications.Trigger(NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray), file.Version), ct)
- with e ->
- logger.error (Log.setMessage "checkUnusedOpens failed" >> Log.addExn e)
- }
-
- let checkUnusedDeclarations =
- async {
- try
- use progress = new ServerProgressReport(lspClient)
- do! progress.Begin($"Checking unused declarations {fileName}...", message = filePathUntag)
-
- let isScript = Utils.isAScript (filePathUntag)
- let! unused = UnusedDeclarations.getUnusedDeclarations (tyRes.GetCheckResults, isScript)
- let unused = unused |> Seq.toArray
-
- let! ct = Async.CancellationToken
- notifications.Trigger(NotificationEvent.UnusedDeclarations(filePath, unused, file.Version), ct)
- with e ->
- logger.error (Log.setMessage "checkUnusedDeclarations failed" >> Log.addExn e)
- }
-
- let checkSimplifiedNames =
- async {
- try
- use progress = new ServerProgressReport(lspClient)
- do! progress.Begin($"Checking simplifing of names {fileName}...", message = filePathUntag)
-
- let! simplified = SimplifyNames.getSimplifiableNames (tyRes.GetCheckResults, getSourceLine)
- let simplified = Array.ofSeq simplified
- let! ct = Async.CancellationToken
- notifications.Trigger(NotificationEvent.SimplifyNames(filePath, simplified, file.Version), ct)
- with e ->
- logger.error (Log.setMessage "checkSimplifiedNames failed" >> Log.addExn e)
- }
-
- let inline isNotExcluded (exclusions: Regex array) =
- exclusions |> Array.exists (fun r -> r.IsMatch filePathUntag) |> not
-
- let analyzers =
- [
- // if config.Linter then
- // commands.Lint filePath |> Async .Ignore
- if config.UnusedOpensAnalyzer && isNotExcluded config.UnusedOpensAnalyzerExclusions then
- checkUnusedOpens
- if
- config.UnusedDeclarationsAnalyzer
- && isNotExcluded config.UnusedDeclarationsAnalyzerExclusions
- then
- checkUnusedDeclarations
- if
- config.SimplifyNameAnalyzer
- && isNotExcluded config.SimplifyNameAnalyzerExclusions
- then
- checkSimplifiedNames ]
-
- async {
- do! analyzers |> Async.parallel75 |> Async.Ignore
-
- do!
- lspClient.NotifyDocumentAnalyzed
- { TextDocument =
- { Uri = filePath |> Path.LocalPathToUri
- Version = version } }
- }
-
-
- let runAnalyzers (config: FSharpConfig) (parseAndCheck: ParseAndCheckResults) (volatileFile: VolatileFile) =
- async {
- if config.EnableAnalyzers then
- let file = volatileFile.FileName
-
- try
- use progress = new ServerProgressReport(lspClient)
- do! progress.Begin("Running analyzers...", message = UMX.untag file)
-
- Loggers.analyzers.info (
- Log.setMessage "begin analysis of {file}"
- >> Log.addContextDestructured "file" file
- )
-
- match parseAndCheck.GetCheckResults.ImplementationFile with
- | Some tast ->
- // Since analyzers are not async, we need to switch to a new thread to not block threadpool
- do! Async.SwitchToNewThread()
-
- let res =
- Commands.analyzerHandler (
- file,
- volatileFile.Source.ToString().Split("\n"),
- parseAndCheck.GetParseResults.ParseTree,
- tast,
- parseAndCheck.GetCheckResults.PartialAssemblySignature.Entities |> Seq.toList,
- parseAndCheck.GetAllEntities
- )
-
- let! ct = Async.CancellationToken
- notifications.Trigger(NotificationEvent.AnalyzerMessage(res, file, volatileFile.Version), ct)
-
- Loggers.analyzers.info (Log.setMessageI $"end analysis of {file:file}")
-
- | _ ->
- Loggers.analyzers.info (Log.setMessageI $"missing components of {file:file} to run analyzers, skipped them")
-
- ()
- with ex ->
- Loggers.analyzers.error (Log.setMessageI $"Run failed for {file:file}" >> Log.addExn ex)
- }
-
- do
- disposables.Add
- <| fileChecked.Publish.Subscribe(fun (parseAndCheck, volatileFile, ct) ->
- if volatileFile.Source.Length = 0 then
- () // Don't analyze and error on an empty file
- else
- async {
- let config = config |> AVal.force
- do! builtInCompilerAnalyzers config volatileFile parseAndCheck
- do! runAnalyzers config parseAndCheck volatileFile
-
- }
- |> Async.StartWithCT ct)
-
-
- let handleCommandEvents (n: NotificationEvent, ct: CancellationToken) =
- try
- async {
-
- try
- match n with
- | NotificationEvent.FileParsed fn ->
- let uri = Path.LocalPathToUri fn
-
- do! ({ Content = UMX.untag uri }: PlainNotification) |> lspClient.NotifyFileParsed
- | NotificationEvent.Workspace ws ->
-
- let ws =
- match ws with
- | ProjectResponse.Project(x, _) -> CommandResponse.project JsonSerializer.writeJson x
- | ProjectResponse.ProjectError(_, errorDetails) ->
- CommandResponse.projectError JsonSerializer.writeJson errorDetails
- | ProjectResponse.ProjectLoading(projectFileName) ->
- CommandResponse.projectLoading JsonSerializer.writeJson projectFileName
- | ProjectResponse.WorkspaceLoad(finished) ->
- CommandResponse.workspaceLoad JsonSerializer.writeJson finished
- | ProjectResponse.ProjectChanged(projectFileName) -> failwith "Not Implemented"
-
- logger.info (Log.setMessage "Workspace Notify {ws}" >> Log.addContextDestructured "ws" ws)
- do! ({ Content = ws }: PlainNotification) |> lspClient.NotifyWorkspace
-
- | NotificationEvent.ParseError(errors, file, version) ->
- let uri = Path.LocalPathToUri file
- let diags = errors |> Array.map fcsErrorToDiagnostic
- diagnosticCollections.SetFor(uri, "F# Compiler", version, diags)
-
- | NotificationEvent.UnusedOpens(file, opens, version) ->
- let uri = Path.LocalPathToUri file
-
- let diags =
- opens
- |> Array.map (fun n ->
- { Range = fcsRangeToLsp n
- Code = Some "FSAC0001"
- Severity = Some DiagnosticSeverity.Hint
- Source = Some "FSAC"
- Message = "Unused open statement"
- RelatedInformation = None
- Tags = Some [| DiagnosticTag.Unnecessary |]
- Data = None
- CodeDescription = None })
-
- diagnosticCollections.SetFor(uri, "F# Unused opens", version, diags)
-
- | NotificationEvent.UnusedDeclarations(file, decls, version) ->
- let uri = Path.LocalPathToUri file
-
- let diags =
- decls
- |> Array.map (fun n ->
- { Range = fcsRangeToLsp n
- Code = Some "FSAC0003"
- Severity = Some DiagnosticSeverity.Hint
- Source = Some "FSAC"
- Message = "This value is unused"
- RelatedInformation = Some [||]
- Tags = Some [| DiagnosticTag.Unnecessary |]
- Data = None
- CodeDescription = None })
-
- diagnosticCollections.SetFor(uri, "F# Unused declarations", version, diags)
-
- | NotificationEvent.SimplifyNames(file, decls, version) ->
- let uri = Path.LocalPathToUri file
-
- let diags =
- decls
- |> Array.map
-
- (fun
- ({ Range = range
- RelativeName = _relName }) ->
- { Diagnostic.Range = fcsRangeToLsp range
- Code = Some "FSAC0002"
- Severity = Some DiagnosticSeverity.Hint
- Source = Some "FSAC"
- Message = "This qualifier is redundant"
- RelatedInformation = Some [||]
- Tags = Some [| DiagnosticTag.Unnecessary |]
- Data = None
- CodeDescription = None })
-
- diagnosticCollections.SetFor(uri, "F# simplify names", version, diags)
-
- // | NotificationEvent.Lint (file, warnings) ->
- // let uri = Path.LocalPathToUri file
- // // let fs =
- // // warnings |> List.choose (fun w ->
- // // w.Warning.Details.SuggestedFix
- // // |> Option.bind (fun f ->
- // // let f = f.Force()
- // // let range = fcsRangeToLsp w.Warning.Details.Range
- // // f |> Option.map (fun f -> range, {Range = range; NewText = f.ToText})
- // // )
- // // )
-
- // let diags =
- // warnings
- // |> List.map(fun w ->
- // let range = fcsRangeToLsp w.Warning.Details.Range
- // let fixes =
- // match w.Warning.Details.SuggestedFix with
- // | None -> None
- // | Some lazyFix ->
- // match lazyFix.Value with
- // | None -> None
- // | Some fix ->
- // Some (box [ { Range = fcsRangeToLsp fix.FromRange; NewText = fix.ToText } ] )
- // let uri = Option.ofObj w.HelpUrl |> Option.map (fun url -> { Href = Some (Uri url) })
- // { Range = range
- // Code = Some w.Code
- // Severity = Some DiagnosticSeverity.Information
- // Source = "F# Linter"
- // Message = w.Warning.Details.Message
- // RelatedInformation = None
- // Tags = None
- // Data = fixes
- // CodeDescription = uri }
- // )
- // |> List.sortBy (fun diag -> diag.Range)
- // |> List.toArray
- // diagnosticCollections.SetFor(uri, "F# Linter", diags)
-
- | NotificationEvent.Canceled(msg) ->
- let ntf: PlainNotification = { Content = msg }
-
- do! lspClient.NotifyCancelledRequest ntf
- | NotificationEvent.AnalyzerMessage(messages, file, version) ->
- let uri = Path.LocalPathToUri file
-
- match messages with
- | [||] -> diagnosticCollections.SetFor(uri, "F# Analyzers", version, [||])
- | messages ->
- let diags =
- messages
- |> Array.map (fun m ->
- let range = fcsRangeToLsp m.Range
-
- let severity =
- match m.Severity with
- | FSharp.Analyzers.SDK.Info -> DiagnosticSeverity.Information
- | FSharp.Analyzers.SDK.Warning -> DiagnosticSeverity.Warning
- | FSharp.Analyzers.SDK.Error -> DiagnosticSeverity.Error
-
- let fixes =
- match m.Fixes with
- | [] -> None
- | fixes ->
- fixes
- |> List.map (fun fix ->
- { Range = fcsRangeToLsp fix.FromRange
- NewText = fix.ToText })
- |> Ionide.LanguageServerProtocol.Server.serialize
- |> Some
-
- { Range = range
- Code = Option.ofObj m.Code
- Severity = Some severity
- Source = Some $"F# Analyzers (%s{m.Type})"
- Message = m.Message
- RelatedInformation = None
- Tags = None
- CodeDescription = None
- Data = fixes })
-
- diagnosticCollections.SetFor(uri, "F# Analyzers", version, diags)
- | NotificationEvent.TestDetected(file, tests) ->
- let rec map
- (r: TestAdapter.TestAdapterEntry)
- : TestAdapter.TestAdapterEntry =
- { Id = r.Id
- List = r.List
- Name = r.Name
- Type = r.Type
- ModuleType = r.ModuleType
- Range = fcsRangeToLsp r.Range
- Childs = ResizeArray(r.Childs |> Seq.map map) }
-
- do!
- { File = Path.LocalPathToUri file
- Tests = tests |> Array.map map }
- |> lspClient.NotifyTestDetected
- with ex ->
- logger.error (
- Log.setMessage "Exception while handling command event {evt}: {ex}"
- >> Log.addContextDestructured "evt" n
- >> Log.addContext "ex" ex.Message
- )
-
- ()
- }
- |> fun work -> Async.StartImmediate(work, ct)
- with :? OperationCanceledException as e ->
- ()
-
-
- do
- disposables.Add(
- (notifications.Publish :> IObservable<_>)
- // .BufferedDebounce(TimeSpan.FromMilliseconds(200.))
- // .SelectMany(fun l -> l.Distinct())
- .Subscribe(fun e -> handleCommandEvents e)
- )
-
- let getLastUTCChangeForFile (filePath: string) =
- AdaptiveFile.GetLastWriteTimeUtc(UMX.untag filePath)
- |> AVal.map (fun writeTime -> filePath, writeTime)
-
-
- let readFileFromDisk lastTouched (file: string) =
- async {
- if File.Exists(UMX.untag file) then
- use s = File.openFileStreamForReadingAsync file
-
- let! source = sourceTextFactory.Create(file, s) |> Async.AwaitCancellableValueTask
-
- return
- { LastTouched = lastTouched
- Source = source
- Version = 0 }
-
- else // When a user does "File -> New Text File -> Select a language -> F#" without saving, the file won't exist
- return
- { LastTouched = DateTime.UtcNow
- Source = sourceTextFactory.Create(file, "")
- Version = 0 }
- }
-
- let getLatestFileChange (filePath: string) =
- asyncAVal {
- let! (_, lastTouched) = getLastUTCChangeForFile filePath
- return! readFileFromDisk lastTouched filePath
- }
-
- let addAValLogging cb (aval: aval<_>) =
- let cb = aval.AddWeakMarkingCallback(cb)
- aval |> AVal.mapDisposableTuple (fun x -> x, cb)
-
- let projectFileChanges project (filePath: string) =
- let file = getLastUTCChangeForFile filePath
-
- let logMsg () =
- logger.info (Log.setMessageI $"Loading {project:project} because of {filePath:filePath}")
-
- file |> addAValLogging logMsg
-
- let loader = cval workspaceLoader
-
- let binlogConfig =
- aval {
- let! generateBinLog = config |> AVal.map (fun c -> c.GenerateBinlog)
- and! rootPath = rootPath
-
- match generateBinLog, rootPath with
- | _, None
- | false, _ -> return Ionide.ProjInfo.BinaryLogGeneration.Off
- | true, Some rootPath ->
- return Ionide.ProjInfo.BinaryLogGeneration.Within(DirectoryInfo(Path.Combine(rootPath, ".ionide")))
- }
-
- // JB:TODO Adding to solution
- // JB:TODO Adding new project file not yet added to solution
- let workspacePaths: ChangeableValue =
- cval WorkspaceChosen.NotChosen
-
- let noopDisposable =
- { new IDisposable with
- member this.Dispose() : unit = () }
-
- let adaptiveWorkspacePaths =
- workspacePaths
- |> AVal.map (fun wsp ->
- match wsp with
- | WorkspaceChosen.Sln v -> projectFileChanges v v |> AdaptiveWorkspaceChosen.Sln, noopDisposable
- | WorkspaceChosen.Directory d ->
- failwith "Need to use AdaptiveDirectory" |> AdaptiveWorkspaceChosen.Directory, noopDisposable
- | WorkspaceChosen.Projs projs ->
- let projChanges =
- projs
- |> ASet.ofSeq
- |> ASet.mapAtoAMap (UMX.untag >> AdaptiveFile.GetLastWriteTimeUtc)
-
- let cb =
- projChanges.AddCallback(fun old delta ->
- logger.info (
- Log.setMessage "Loading projects because of {delta}"
- >> Log.addContextDestructured "delta" delta
- ))
-
- projChanges |> AdaptiveWorkspaceChosen.Projs, cb
-
- | WorkspaceChosen.NotChosen -> AdaptiveWorkspaceChosen.NotChosen, noopDisposable
-
- )
- |> AVal.mapDisposableTuple (id)
-
- let clientCapabilities = cval None
-
- let glyphToCompletionKind =
- clientCapabilities |> AVal.map (glyphToCompletionKindGenerator)
-
- let glyphToSymbolKind = clientCapabilities |> AVal.map glyphToSymbolKindGenerator
-
- let tryFindProp name (props: list) =
- match props |> Seq.tryFind (fun x -> x.Name = name) with
- | Some v -> v.Value |> Option.ofObj
- | None -> None
-
- let (|ProjectAssetsFile|_|) (props: list) = tryFindProp "ProjectAssetsFile" props
-
- let (|BaseIntermediateOutputPath|_|) (props: list) = tryFindProp "BaseIntermediateOutputPath" props
-
- let (|MSBuildAllProjects|_|) (props: list) =
- tryFindProp "MSBuildAllProjects" props
- |> Option.map (fun v -> v.Split(';', StringSplitOptions.RemoveEmptyEntries))
-
- let loadedProjectOptions =
- aval {
- let! loader = loader
- and! wsp = adaptiveWorkspacePaths
-
- match wsp with
- | AdaptiveWorkspaceChosen.NotChosen -> return []
- | AdaptiveWorkspaceChosen.Sln _ -> return raise (NotImplementedException())
- | AdaptiveWorkspaceChosen.Directory _ -> return raise (NotImplementedException())
- | AdaptiveWorkspaceChosen.Projs projects ->
- let! binlogConfig = binlogConfig
-
- let! projectOptions =
- projects
- |> AMap.mapWithAdditionalDependencies (fun projects ->
-
- projects
- |> Seq.iter (fun (proj: string, _) ->
- let not =
- UMX.untag proj |> ProjectResponse.ProjectLoading |> NotificationEvent.Workspace
-
- notifications.Trigger(not, CancellationToken.None))
-
-
- use progressReport = new ServerProgressReport(lspClient)
-
- progressReport.Begin ($"Loading {projects.Count} Projects") (CancellationToken.None)
- |> ignore>
-
- let projectOptions =
- loader.LoadProjects(projects |> Seq.map (fst >> UMX.untag) |> Seq.toList, [], binlogConfig)
- |> Seq.toList
-
- for p in projectOptions do
- logger.info (
- Log.setMessage "Found BaseIntermediateOutputPath of {path}"
- >> Log.addContextDestructured "path" p.Properties
- )
-
- let additionalDependencies (p: Types.ProjectOptions) =
- [ let projectFileChanges = projectFileChanges p.ProjectFileName
-
- match p.Properties with
- | ProjectAssetsFile v -> yield projectFileChanges (UMX.tag v)
- | _ -> ()
-
- let objPath = (|BaseIntermediateOutputPath|_|) p.Properties
-
- let isWithinObjFolder (file: string) =
- match objPath with
- | None -> true // if no obj folder provided assume we should track this file
- | Some objPath -> file.Contains(objPath)
-
- match p.Properties with
- | MSBuildAllProjects v ->
- yield!
- v
- |> Array.filter (fun x -> x.EndsWith(".props") && isWithinObjFolder x)
- |> Array.map (UMX.tag >> projectFileChanges)
- | _ -> () ]
-
- HashMap.ofList
- [ for p in projectOptions do
- UMX.tag p.ProjectFileName, (p, additionalDependencies p) ]
-
- )
- |> AMap.toAVal
- |> AVal.map HashMap.toValueList
-
-
- and! checker = checker
- checker.ClearCaches() // if we got new projects assume we're gonna need to clear caches
-
- let options =
- let fsharpOptions = projectOptions |> FCS.mapManyOptions |> Seq.toList
-
- List.zip projectOptions fsharpOptions
- |> List.map (fun (projectOption, fso) ->
-
- let langversion = LanguageVersionShim.fromFSharpProjectOptions fso
-
- // Set some default values as FCS uses these for identification/caching purposes
- let fso =
- { fso with
- SourceFiles = fso.SourceFiles |> Array.map (Utils.normalizePath >> UMX.untag)
- Stamp = fso.Stamp |> Option.orElse (Some DateTime.UtcNow.Ticks)
- ProjectId = fso.ProjectId |> Option.orElse (Some(Guid.NewGuid().ToString())) }
-
- { FSharpProjectOptions = fso
- LanguageVersion = langversion },
- projectOption)
-
- options
- |> List.iter (fun (loadedProject, projectOption) ->
- let projectFileName = loadedProject.ProjectFileName
- let projViewerItemsNormalized = ProjectViewer.render projectOption
-
- let responseFiles =
- projViewerItemsNormalized.Items
- |> List.map (function
- | ProjectViewerItem.Compile(p, c) -> ProjectViewerItem.Compile(Helpers.fullPathNormalized p, c))
- |> List.choose (function
- | ProjectViewerItem.Compile(p, _) -> Some p)
-
- let references =
- FscArguments.references (loadedProject.FSharpProjectOptions.OtherOptions |> List.ofArray)
-
- logger.info (
- Log.setMessage "ProjectLoaded {file}"
- >> Log.addContextDestructured "file" projectFileName
- )
-
- let ws =
- { ProjectFileName = projectFileName
- ProjectFiles = responseFiles
- OutFileOpt = Option.ofObj projectOption.TargetPath
- References = references
- Extra = projectOption
- ProjectItems = projViewerItemsNormalized.Items
- Additionals = Map.empty }
-
- let not = ProjectResponse.Project(ws, false) |> NotificationEvent.Workspace
- notifications.Trigger(not, CancellationToken.None))
-
- let not = ProjectResponse.WorkspaceLoad true |> NotificationEvent.Workspace
-
- notifications.Trigger(not, CancellationToken.None)
-
- return options |> List.map fst
- }
-
- ///
- /// Evaluates the adaptive value and returns its current value.
- /// This should not be used inside the adaptive evaluation of other AdaptiveObjects since it does not track dependencies.
- ///
- /// A list of FSharpProjectOptions
- let forceLoadProjects () = loadedProjectOptions |> AVal.force
-
- do
- // Reload Projects with some debouncing if `loadedProjectOptions` is out of date.
- AVal.Observable.onOutOfDateWeak loadedProjectOptions
- |> Observable.throttleOn Concurrency.NewThreadScheduler.Default (TimeSpan.FromMilliseconds(200.))
- |> Observable.observeOn Concurrency.NewThreadScheduler.Default
- |> Observable.subscribe (fun _ -> forceLoadProjects () |> ignore>)
- |> disposables.Add
-
-
- let sourceFileToProjectOptions =
- aval {
- let! options = loadedProjectOptions
-
- return
- options
- |> List.collect (fun proj ->
- proj.SourceFiles
- |> Array.map (fun source -> Utils.normalizePath source, proj)
- |> Array.toList)
- |> List.groupByFst
-
- }
- |> AMap.ofAVal
+ let logger = LogProvider.getLoggerFor ()
let fantomasLogger = LogProvider.getLoggerByName "Fantomas"
let fantomasService: FantomasService = new LSPFantomasService() :> FantomasService
- let openFilesTokens =
- ConcurrentDictionary, CancellationTokenSource>()
-
- let tryGetOpenFileToken filePath =
- match openFilesTokens.TryGetValue(filePath) with
- | (true, v) -> Some v
- | _ -> None
-
- let openFiles = cmap, cval> ()
- let openFilesReadOnly = openFiles |> AMap.map (fun _ x -> x :> aval<_>)
-
- let textChanges =
- cmap, cset> ()
-
- let textChangesReadOnly = textChanges |> AMap.map (fun _ x -> x :> aset<_>)
-
- let logTextChange (v: VolatileFile) =
- logger.debug (
- Log.setMessage "TextChanged for file : {fileName} {touched} {version}"
- >> Log.addContextDestructured "fileName" v.FileName
- >> Log.addContextDestructured "touched" v.LastTouched
- >> Log.addContextDestructured "version" v.Version
- )
-
- let openFilesWithChanges: amap<_, aval> =
- openFilesReadOnly
- |> AMap.map (fun filePath file ->
- aval {
- let! file = file
- and! changes = textChangesReadOnly |> AMap.tryFind filePath
-
- match changes with
- | None -> return file
- | Some c ->
- let! ps = c |> ASet.toAVal
-
- let changes =
- ps
- |> Seq.sortBy (fun (x, _) -> x.TextDocument.Version)
- |> Seq.collect (fun (p, touched) ->
- p.ContentChanges |> Array.map (fun x -> x, p.TextDocument.Version, touched))
-
- let file =
- (file, changes)
- ||> Seq.fold (fun text (change, version, touched) ->
- match change.Range with
- | None -> // replace entire content
- VolatileFile.Create(sourceTextFactory.Create(filePath, change.Text), version, touched)
- | Some rangeToReplace ->
- // replace just this slice
- let fcsRangeToReplace = protocolRangeToRange (UMX.untag filePath) rangeToReplace
-
- try
- match text.Source.ModifyText(fcsRangeToReplace, change.Text) with
- | Ok text -> VolatileFile.Create(text, version, touched)
-
- | Error message ->
- logger.error (
- Log.setMessage
- "Error applying {change} to document {file} for version {version} - {range} : {message} "
- >> Log.addContextDestructured "file" filePath
- >> Log.addContextDestructured "version" version
- >> Log.addContextDestructured "message" message
- >> Log.addContextDestructured "range" fcsRangeToReplace
- >> Log.addContextDestructured "change" change
- )
-
- text
- with e ->
- logger.error (
- Log.setMessage "Error applying {change} to document {file} for version {version} - {range}"
- >> Log.addContextDestructured "file" filePath
- >> Log.addContextDestructured "range" fcsRangeToReplace
- >> Log.addContextDestructured "version" version
- >> Log.addContextDestructured "change" change
- >> Log.addExn e
- )
-
- text)
-
- logTextChange file
- return file
- })
-
+ let thisType = typeof
- let cancelToken filePath (cts: CancellationTokenSource) =
+ let disposables = new Disposables.CompositeDisposable()
- try
- logger.info (
- Log.setMessage "Cancelling {filePath} - {version}"
- >> Log.addContextDestructured "filePath" filePath
- // >> Log.addContextDestructured "version" oldFile.Version
- )
+ let state = new AdaptiveState(lspClient, sourceTextFactory, workspaceLoader)
- cts.Cancel()
- cts.Dispose()
- with
- | :? OperationCanceledException
- | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") ->
- // ignore if already cancelled
- ()
+ do disposables.Add(state)
[]
let rec (|Cancelled|_|) (e: exn) =
@@ -1034,474 +76,6 @@ type AdaptiveFSharpLspServer
| Cancelled -> LspResult.requestCancelled
| e -> LspResult.internalError (string e)
- let cachedFileContents = cmap, asyncaval> ()
-
- let resetCancellationToken filePath =
- let adder _ = new CancellationTokenSource()
-
- let updater key value =
- cancelToken filePath value
- new CancellationTokenSource()
-
- openFilesTokens.AddOrUpdate(filePath, adder, updater)
- |> ignore
-
-
- let updateOpenFiles (file: VolatileFile) =
- let adder _ = cval file
-
- let updater _ (v: cval<_>) = v.Value <- file
-
- resetCancellationToken file.FileName
- transact (fun () -> openFiles.AddOrElse(file.Source.FileName, adder, updater))
-
- let updateTextChanges filePath p =
- let adder _ = cset<_> [ p ]
- let updater _ (v: cset<_>) = v.Add p |> ignore
-
- resetCancellationToken filePath
- transact (fun () -> textChanges.AddOrElse(filePath, adder, updater))
-
- let isFileOpen file = openFiles |> AMap.tryFindA file |> AVal.map (Option.isSome)
-
- let findFileInOpenFiles file = openFilesWithChanges |> AMap.tryFindA file
-
- let forceFindOpenFile filePath = findFileInOpenFiles filePath |> AVal.force
-
-
- let forceFindOpenFileOrRead file =
- asyncOption {
-
- match findFileInOpenFiles file |> AVal.force with
- | Some s -> return s
- | None ->
- // TODO: Log how many times this kind area gets hit and possibly if this should be rethought
- try
- logger.debug (
- Log.setMessage "forceFindOpenFileOrRead else - {file}"
- >> Log.addContextDestructured "file" file
- )
-
- let lastTouched = File.getLastWriteTimeOrDefaultNow file
-
- return! readFileFromDisk lastTouched file
-
- with e ->
- logger.warn (
- Log.setMessage "Could not read file {file}"
- >> Log.addContextDestructured "file" file
- >> Log.addExn e
- )
-
- return! None
- }
- |> Async.map (Result.ofOption (fun () -> $"Could not read file: {file}"))
-
- do
- let fileshimChanges = openFilesWithChanges |> AMap.mapA (fun _ v -> v)
- // let cachedFileContents = cachedFileContents |> cmap.mapA (fun _ v -> v)
-
- let filesystemShim file =
- // GetLastWriteTimeShim gets called _alot_ and when we do checks on save we use Async.Parallel for type checking.
- // Adaptive uses lots of locks under the covers, so many threads can get blocked waiting for data.
- // flattening openFilesWithChanges makes this check a lot quicker as it's not needing to recalculate each value.
-
- fileshimChanges |> AMap.force |> HashMap.tryFind file
-
- FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem <-
- FileSystem(FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem, filesystemShim)
-
- /// Parses a source code for a file and caches the results. Returns an AST that can be traversed for various features.
- /// The FSharpCompilerServiceChecker.
- /// The source to be parsed.
- /// Parsing options for the project or script
- /// The options for the project or script.
- ///
- let parseFile (checker: FSharpCompilerServiceChecker) (source: VolatileFile) parseOpts options =
- async {
- let! result = checker.ParseFile(source.FileName, source.Source, parseOpts)
-
- let! ct = Async.CancellationToken
- fileParsed.Trigger(result, options, ct)
- return result
- }
-
-
-
- /// Parses all files in the workspace. This is mostly used to trigger finding tests.
- let parseAllFiles () =
- asyncAVal {
- let! projects = loadedProjectOptions
- and! (checker: FSharpCompilerServiceChecker) = checker
-
- return
- projects
- |> Array.ofList
- |> Array.Parallel.collect (fun p ->
- let parseOpts = Utils.projectOptionsToParseOptions p.FSharpProjectOptions
- p.SourceFiles |> Array.Parallel.map (fun s -> p, parseOpts, s))
- |> Array.Parallel.map (fun (opts, parseOpts, fileName) ->
- let fileName = UMX.tag fileName
-
- asyncResult {
- let! file = forceFindOpenFileOrRead fileName
- return! parseFile checker file parseOpts opts.FSharpProjectOptions
- }
- |> Async.map Result.toOption)
- |> Async.parallel75
- }
-
- let forceFindSourceText filePath = forceFindOpenFileOrRead filePath |> AsyncResult.map (fun f -> f.Source)
-
-
- let openFilesToChangesAndProjectOptions =
- openFilesWithChanges
- |> AMapAsync.mapAVal (fun filePath file ctok ->
- asyncAVal {
- if Utils.isAScript (UMX.untag filePath) then
- let! (checker: FSharpCompilerServiceChecker) = checker
- and! tfmConfig = tfmConfig
-
- let! projs =
- asyncOption {
- let! cts = tryGetOpenFileToken filePath
- use lcts = CancellationTokenSource.CreateLinkedTokenSource(ctok, cts.Token)
-
- let! opts =
- checker.GetProjectOptionsFromScript(filePath, file.Source, tfmConfig)
- |> Async.withCancellationSafe (fun () -> lcts.Token)
-
- opts |> scriptFileProjectOptions.Trigger
-
- return
- { FSharpProjectOptions = opts
- LanguageVersion = LanguageVersionShim.fromFSharpProjectOptions opts }
- }
-
- return file, Option.toList projs
- else
- let! projs =
- sourceFileToProjectOptions
- |> AMap.tryFind filePath
- |> AVal.map (Option.defaultValue [])
-
- return file, projs
- })
-
- let allFSharpFilesAndProjectOptions =
- let wins =
- openFilesToChangesAndProjectOptions
- |> AMap.map (fun k v -> v |> AsyncAVal.mapSync (fun (file, projects) _ -> Some file, projects))
-
- let loses =
- sourceFileToProjectOptions
- |> AMap.map (fun filePath v ->
- asyncAVal {
- let! file = getLatestFileChange filePath
- return (Some file, v)
- })
-
- AMap.union loses wins
-
- let allFSharpProjectOptions =
- allFSharpFilesAndProjectOptions
- |> AMapAsync.mapAsyncAVal (fun filePath (file, options) ctok -> AsyncAVal.constant options)
-
- let allFilesParsed =
- allFSharpFilesAndProjectOptions
- |> AMapAsync.mapAsyncAVal (fun filePath (file, options: LoadedProject list) ctok ->
- asyncAVal {
- let! (checker: FSharpCompilerServiceChecker) = checker
-
- return!
- asyncOption {
- let! project = options |> selectProject
- let options = project.FSharpProjectOptions
- let parseOpts = Utils.projectOptionsToParseOptions project.FSharpProjectOptions
- let! file = file
- return! parseFile checker file parseOpts options
- }
-
- })
-
-
- let getAllProjectOptions () =
- async {
- let! set =
- allFSharpProjectOptions
- |> AMap.toASetValues
- |> ASet.force
- |> HashSet.toArray
- |> Array.map (AsyncAVal.forceAsync)
- |> Async.parallel75
-
- return set |> Array.collect (List.toArray)
- }
-
-
- let getAllFSharpProjectOptions () =
- getAllProjectOptions ()
- |> Async.map (Array.map (fun x -> x.FSharpProjectOptions))
-
- let getProjectOptionsForFile (filePath: string) =
- asyncAVal {
- match! allFSharpProjectOptions |> AMapAsync.tryFindA filePath with
- | Some projs -> return projs
- | None -> return []
- }
-
- let autoCompleteItems
- : cmap *
- (Position -> option) *
- FSharp.Compiler.Syntax.ParsedInput> =
- cmap ()
-
- let getAutoCompleteByDeclName name = autoCompleteItems |> AMap.tryFind name
-
- let autoCompleteNamespaces =
- autoCompleteItems
- |> AMap.choose (fun name (d, pos, fn, getline, ast) ->
-
- Commands.calculateNamespaceInsert (fun () -> Some ast) d pos getline)
-
- let getAutoCompleteNamespacesByDeclName name = autoCompleteNamespaces |> AMap.tryFind name
-
-
- /// Gets Parse and Check results of a given file while also handling other concerns like Progress, Logging, Eventing.
- /// The FSharpCompilerServiceChecker.
- /// The name of the file in the project whose source to find a typecheck.
- /// The options for the project or script.
- /// Determines if the typecheck should be cached for autocompletions.
- ///
- let parseAndCheckFile (checker: FSharpCompilerServiceChecker) (file: VolatileFile) options shouldCache =
- async {
- let tags =
- [ SemanticConventions.fsac_sourceCodePath, box (UMX.untag file.Source.FileName)
- SemanticConventions.projectFilePath, box (options.ProjectFileName) ]
-
- use _ = fsacActivitySource.StartActivityForType(thisType, tags = tags)
-
-
- logger.info (
- Log.setMessage "Getting typecheck results for {file} - {hash} - {date}"
- >> Log.addContextDestructured "file" file.Source.FileName
- >> Log.addContextDestructured "hash" (file.Source.GetHashCode())
- >> Log.addContextDestructured "date" (file.LastTouched)
- )
-
- let! ct = Async.CancellationToken
-
- use progressReport = new ServerProgressReport(lspClient)
-
- let simpleName = Path.GetFileName(UMX.untag file.Source.FileName)
- do! progressReport.Begin($"Typechecking {simpleName}", message = $"{file.Source.FileName}")
-
- let! result =
- checker.ParseAndCheckFileInProject(
- file.Source.FileName,
- (file.Source.GetHashCode()),
- file.Source,
- options,
- shouldCache = shouldCache
- )
- |> Debug.measureAsync $"checker.ParseAndCheckFileInProject - {file.Source.FileName}"
-
- do! progressReport.End($"Typechecked {file.Source.FileName}")
-
- notifications.Trigger(NotificationEvent.FileParsed(file.Source.FileName), ct)
-
- match result with
- | Error e ->
- logger.error (
- Log.setMessage "Typecheck failed for {file} with {error}"
- >> Log.addContextDestructured "file" file.FileName
- >> Log.addContextDestructured "error" e
- )
-
- return failwith e
- | Ok parseAndCheck ->
- logger.info (
- Log.setMessage "Typecheck completed successfully for {file}"
- >> Log.addContextDestructured "file" file.Source.FileName
- )
-
- Async.Start(
- async {
-
- fileParsed.Trigger(parseAndCheck.GetParseResults, options, ct)
- fileChecked.Trigger(parseAndCheck, file, ct)
- let checkErrors = parseAndCheck.GetParseResults.Diagnostics
- let parseErrors = parseAndCheck.GetCheckResults.Diagnostics
-
- let errors =
- Array.append checkErrors parseErrors
- |> Array.distinctBy (fun e ->
- e.Severity, e.ErrorNumber, e.StartLine, e.StartColumn, e.EndLine, e.EndColumn, e.Message)
-
- notifications.Trigger(NotificationEvent.ParseError(errors, file.Source.FileName, file.Version), ct)
- },
- ct
- )
-
-
- return parseAndCheck
- }
-
- /// Bypass Adaptive checking and tell the checker to check a file
- let bypassAdaptiveTypeCheck (filePath: string) opts =
- asyncResult {
- try
- logger.info (
- Log.setMessage "Forced Check : {file}"
- >> Log.addContextDestructured "file" filePath
- )
-
- let checker = checker |> AVal.force
-
- let! fileInfo = forceFindOpenFileOrRead filePath
- // Don't cache for autocompletions as we really only want to cache "Opened" files.
- return! parseAndCheckFile checker fileInfo opts false
-
- with e ->
-
- logger.warn (
- Log.setMessage "Forced Check error : {file}"
- >> Log.addContextDestructured "file" filePath
- >> Log.addExn e
- )
-
- return! Error(e.ToString())
- }
-
-
- let openFilesToRecentCheckedFilesResults =
- openFilesToChangesAndProjectOptions
- |> AMapAsync.mapAsyncAVal (fun _ (info, projectOptions) _ ->
- asyncAVal {
- let file = info.Source.FileName
- let! checker = checker
-
- return
- option {
- let! opts = selectProject projectOptions
- return! checker.TryGetRecentCheckResultsForFile(file, opts.FSharpProjectOptions, info.Source)
- }
- })
-
- let openFilesToCheckedFilesResults =
- openFilesToChangesAndProjectOptions
- |> AMapAsync.mapAsyncAVal (fun _ (info, projectOptions) ctok ->
- asyncAVal {
- let file = info.Source.FileName
- let! checker = checker
-
- return!
- asyncOption {
- let! opts = selectProject projectOptions
- let! cts = tryGetOpenFileToken file
- use lcts = CancellationTokenSource.CreateLinkedTokenSource(ctok, cts.Token)
-
- return!
- parseAndCheckFile checker info opts.FSharpProjectOptions true
- |> Async.withCancellationSafe (fun () -> lcts.Token)
- }
-
- })
-
- let getParseResults filePath = allFilesParsed |> AMapAsync.tryFindAndFlatten filePath
-
- let getOpenFileTypeCheckResults filePath = openFilesToCheckedFilesResults |> AMapAsync.tryFindAndFlatten (filePath)
-
- let getOpenFileRecentTypeCheckResults filePath =
- openFilesToRecentCheckedFilesResults |> AMapAsync.tryFindAndFlatten (filePath)
-
- let tryGetLineStr pos (text: IFSACSourceText) =
- text.GetLine(pos)
- |> Result.ofOption (fun () -> $"No line in {text.FileName} at position {pos}")
-
- let forceGetParseResults filePath =
- async {
- let! results = getParseResults filePath |> AsyncAVal.forceAsync
- return results |> Result.ofOption (fun () -> $"No parse results for {filePath}")
- }
-
- let forceGetOpenFileRecentTypeCheckResults filePath =
- async {
- let! results = getOpenFileRecentTypeCheckResults filePath |> AsyncAVal.forceAsync
- return results |> Result.ofOption (fun () -> $"No typecheck results for {filePath}")
- }
-
- let forceGetOpenFileTypeCheckResults (filePath: string) =
- async {
- let! results = getOpenFileTypeCheckResults (filePath) |> AsyncAVal.forceAsync
- return results |> Result.ofOption (fun () -> $"No typecheck results for {filePath}")
- }
-
- ///
- /// This will attempt to get typecheck results in this order
- ///
- /// 1. From our internal typecheck cache
- /// 2. From checker.TryGetRecentCheckResultsForFile
- /// 3. Failing both, will type check the file.
- ///
- /// Additionally, it will start typechecking the file in the background to force latest results on the next request.
- ///
- /// The name of the file in the project whose source to find a typecheck.
- /// A Result of ParseAndCheckResults
- let forceGetOpenFileTypeCheckResultsStale (filePath: string) =
- asyncAVal {
- let! (checker: FSharpCompilerServiceChecker) = checker
-
- let inline tryGetLastCheckResultForFile filePath =
- checker.TryGetLastCheckResultForFile(filePath)
- |> Result.ofOption (fun () -> $"No typecheck results for {filePath}")
- |> async.Return
-
- return
- tryGetLastCheckResultForFile filePath
- |> AsyncResult.orElseWith (fun _ -> forceGetOpenFileRecentTypeCheckResults filePath)
- |> AsyncResult.orElseWith (fun _ -> forceGetOpenFileTypeCheckResults filePath)
- |> Async.map (fun r ->
- Async.Start(
- async {
- // This needs to be in a try catch as it can throw on cancellation which causes the server to crash
- try
- do!
- forceGetOpenFileTypeCheckResults filePath
- |> Async.Ignore>
- with e ->
- ()
- }
- )
-
- r)
- }
- |> AsyncAVal.forceAsync
-
- let allFilesToDeclarations =
- allFilesParsed
- |> AMap.map (fun k v -> v |> AsyncAVal.mapOption (fun p _ -> p.GetNavigationItems().Declarations))
-
- let getAllDeclarations () =
- async {
- let! results =
- allFilesToDeclarations
- |> AMap.force
- |> HashMap.toArray
- |> Array.map (fun (k, v) ->
- async {
- let! decls = AsyncAVal.forceAsync v
- return Option.map (fun v -> k, v) decls
- })
- |> Async.parallel75
-
- return results |> Array.Parallel.choose id
-
- }
-
- let getDeclarations filename = allFilesToDeclarations |> AMapAsync.tryFindAndFlatten filename
let getFilePathAndPosition (p: ITextDocumentPositionParams) =
let filePath = p.GetFilePath() |> Utils.normalizePath
@@ -1509,514 +83,11 @@ type AdaptiveFSharpLspServer
filePath, pos
- let forceGetProjectOptions filePath =
- asyncAVal {
- let! projects = getProjectOptionsForFile filePath
- let project = selectProject projects
-
- return
- project
- |> Result.ofOption (fun () -> $"Could not find project containing {filePath}")
-
- }
- |> AsyncAVal.forceAsync
-
- let forceGetFSharpProjectOptions filePath =
- forceGetProjectOptions filePath
- |> Async.map (Result.map (fun p -> p.FSharpProjectOptions))
-
- let codeGenServer =
- { new ICodeGenerationService with
- member x.TokenizeLine(file, i) =
- asyncOption {
- let! (text) = forceFindOpenFileOrRead file |> Async.map Option.ofResult
-
- try
- let! line = text.Source.GetLine(Position.mkPos i 0)
- return Lexer.tokenizeLine [||] line
- with _ ->
- return! None
- }
-
- member x.GetSymbolAtPosition(file, pos) =
- asyncOption {
- try
- let! (text) = forceFindOpenFileOrRead file |> Async.map Option.ofResult
- let! line = tryGetLineStr pos text.Source |> Option.ofResult
- return! Lexer.getSymbol pos.Line pos.Column line SymbolLookupKind.Fuzzy [||]
- with _ ->
- return! None
- }
-
- member x.GetSymbolAndUseAtPositionOfKind(fileName, pos, kind) =
- asyncOption {
- let! symbol = x.GetSymbolAtPosition(fileName, pos)
-
- if symbol.Kind = kind then
- let! (text) = forceFindOpenFileOrRead fileName |> Async.map Option.ofResult
- let! line = tryGetLineStr pos text.Source |> Option.ofResult
- let! tyRes = forceGetOpenFileTypeCheckResults fileName |> Async.map (Option.ofResult)
- let symbolUse = tyRes.TryGetSymbolUse pos line
- return! Some(symbol, symbolUse)
- else
- return! None
- }
-
- member x.ParseFileInProject(file) = forceGetParseResults file |> Async.map (Option.ofResult) }
-
- let getDependentProjectsOfProjects ps =
- let projectSnapshot = forceLoadProjects ()
-
- let allDependents = System.Collections.Generic.HashSet()
-
- let currentPass = ResizeArray()
- currentPass.AddRange(ps |> List.map (fun p -> p.ProjectFileName))
-
- let mutable continueAlong = true
-
- while continueAlong do
- let dependents =
- projectSnapshot
- |> Seq.filter (fun p ->
- p.FSharpProjectOptions.ReferencedProjects
- |> Seq.exists (fun r ->
- match r.ProjectFilePath with
- | None -> false
- | Some p -> currentPass.Contains(p)))
-
- if Seq.isEmpty dependents then
- continueAlong <- false
- currentPass.Clear()
- else
- for d in dependents do
- allDependents.Add d.FSharpProjectOptions |> ignore
-
- currentPass.Clear()
- currentPass.AddRange(dependents |> Seq.map (fun p -> p.ProjectFileName))
-
- Seq.toList allDependents
-
- let getDeclarationLocation (symbolUse, text) =
- let getProjectOptions file =
- async {
- let! projects = getProjectOptionsForFile file |> AsyncAVal.forceAsync
-
- return
- selectProject projects
- |> Option.map (fun project -> project.FSharpProjectOptions)
-
-
- }
-
- let projectsThatContainFile file =
- async {
- let! projects = getProjectOptionsForFile file |> AsyncAVal.forceAsync
- return projects |> List.map (fun p -> p.FSharpProjectOptions)
- }
-
- SymbolLocation.getDeclarationLocation (
- symbolUse,
- text,
- getProjectOptions,
- projectsThatContainFile,
- getDependentProjectsOfProjects
- )
-
- let symbolUseWorkspace
- (includeDeclarations: bool)
- (includeBackticks: bool)
- (errorOnFailureToFixRange: bool)
- pos
- lineStr
- text
- tyRes
- =
-
- let findReferencesForSymbolInFile (file: string, project, symbol) =
- async {
- let checker = checker |> AVal.force
-
- if File.Exists(UMX.untag file) then
- // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files
- return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol)
- else
- // untitled script files
- match! forceGetOpenFileTypeCheckResultsStale file with
- | Error _ -> return Seq.empty
- | Ok tyRes ->
- let! ct = Async.CancellationToken
- let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct)
- return usages |> Seq.map (fun u -> u.Range)
- }
-
- let tryGetProjectOptionsForFsproj (file: string) =
- forceGetFSharpProjectOptions file |> Async.map Option.ofResult
-
- Commands.symbolUseWorkspace
- getDeclarationLocation
- findReferencesForSymbolInFile
- forceFindSourceText
- tryGetProjectOptionsForFsproj
- (getAllFSharpProjectOptions >> Async.map Array.toSeq)
- includeDeclarations
- includeBackticks
- errorOnFailureToFixRange
- pos
- lineStr
- text
- tyRes
-
- let symbolUseWorkspace2
- (includeDeclarations: bool)
- (includeBackticks: bool)
- (errorOnFailureToFixRange: bool)
- pos
- lineStr
- text
- tyRes
- =
- let findReferencesForSymbolInFile (file: string, project, symbol) =
- async {
- let checker = checker |> AVal.force
-
- if File.Exists(UMX.untag file) then
- // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files
- return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol)
- else
- // untitled script files
- match! forceGetOpenFileTypeCheckResultsStale file with
- | Error _ -> return Seq.empty
- | Ok tyRes ->
- let! ct = Async.CancellationToken
- let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct)
- return usages |> Seq.map (fun u -> u.Range)
- }
-
- let tryGetProjectOptionsForFsproj (file: string) =
- forceGetFSharpProjectOptions file |> Async.map Option.ofResult
-
- Commands.symbolUseWorkspace
- getDeclarationLocation
- findReferencesForSymbolInFile
- forceFindSourceText
- tryGetProjectOptionsForFsproj
- (getAllFSharpProjectOptions >> Async.map Array.toSeq)
- includeDeclarations
- includeBackticks
- errorOnFailureToFixRange
- pos
- lineStr
- text
- tyRes
-
- let codefixes =
-
- let tryGetParseResultsForFile filePath pos =
- asyncResult {
- let! (file) = forceFindOpenFileOrRead filePath
- let! lineStr = file.Source |> tryGetLineStr pos
- and! tyRes = forceGetOpenFileTypeCheckResults filePath
- return tyRes, lineStr, file.Source
- }
-
- let getRangeText fileName (range: Ionide.LanguageServerProtocol.Types.Range) =
- asyncResult {
- let! sourceText = forceFindSourceText fileName
- return! sourceText.GetText(protocolRangeToRange (UMX.untag fileName) range)
- }
-
- let tryFindUnionDefinitionFromPos = tryFindUnionDefinitionFromPos codeGenServer
-
- let getUnionPatternMatchCases tyRes pos sourceText line =
- Commands.getUnionPatternMatchCases tryFindUnionDefinitionFromPos tyRes pos sourceText line
-
- let unionCaseStubReplacements (config) () = Map.ofList [ "$1", config.UnionCaseStubGenerationBody ]
-
-
- let implementInterfaceConfig config () : ImplementInterface.Config =
- { ObjectIdentifier = config.InterfaceStubGenerationObjectIdentifier
- MethodBody = config.InterfaceStubGenerationMethodBody
- IndentationSize = config.IndentationSize }
-
- let recordStubReplacements config () = Map.ofList [ "$1", config.RecordStubGenerationBody ]
-
- let tryFindRecordDefinitionFromPos =
- RecordStubGenerator.tryFindRecordDefinitionFromPos codeGenServer
-
- let getRecordStub tyRes pos sourceText line =
- Commands.getRecordStub (tryFindRecordDefinitionFromPos) tyRes pos sourceText line
-
- let getLineText (sourceText: IFSACSourceText) (range: Ionide.LanguageServerProtocol.Types.Range) =
- sourceText.GetText(protocolRangeToRange (UMX.untag sourceText.FileName) range)
- |> Async.singleton
-
- let abstractClassStubReplacements config () =
- Map.ofList
- [ "$objectIdent", config.AbstractClassStubGenerationObjectIdentifier
- "$methodBody", config.AbstractClassStubGenerationMethodBody ]
-
- let tryFindAbstractClassExprInBufferAtPos =
- AbstractClassStubGenerator.tryFindAbstractClassExprInBufferAtPos codeGenServer
-
- let writeAbstractClassStub =
- AbstractClassStubGenerator.writeAbstractClassStub codeGenServer
-
- let getAbstractClassStub tyRes objExprRange sourceText lineStr =
- Commands.getAbstractClassStub
- tryFindAbstractClassExprInBufferAtPos
- writeAbstractClassStub
- tyRes
- objExprRange
- sourceText
- lineStr
- |> AsyncResult.foldResult id id
-
- let getLanguageVersion (file: string) =
- async {
- let! projectOptions = forceGetProjectOptions file
-
- return
- match projectOptions with
- | Ok projectOptions -> projectOptions.LanguageVersion
- | Error _ -> LanguageVersionShim.defaultLanguageVersion.Value
- }
-
- config
- |> AVal.map (fun config ->
- [| Run.ifEnabled (fun _ -> config.UnusedOpensAnalyzer) (RemoveUnusedOpens.fix forceFindSourceText)
- Run.ifEnabled
- (fun _ -> config.ResolveNamespaces)
- (ResolveNamespace.fix tryGetParseResultsForFile Commands.getNamespaceSuggestions)
- ReplaceWithSuggestion.fix
- RemoveRedundantQualifier.fix
- Run.ifEnabled (fun _ -> config.UnusedDeclarationsAnalyzer) (RenameUnusedValue.fix tryGetParseResultsForFile)
- AddNewKeywordToDisposableConstructorInvocation.fix getRangeText
- Run.ifEnabled
- (fun _ -> config.UnionCaseStubGeneration)
- (GenerateUnionCases.fix
- forceFindSourceText
- tryGetParseResultsForFile
- getUnionPatternMatchCases
- (unionCaseStubReplacements config))
- ExternalSystemDiagnostics.linter
- ExternalSystemDiagnostics.analyzers
- Run.ifEnabled
- (fun _ -> config.InterfaceStubGeneration)
- (ImplementInterface.fix
- tryGetParseResultsForFile
- forceGetFSharpProjectOptions
- (implementInterfaceConfig config))
- Run.ifEnabled
- (fun _ -> config.RecordStubGeneration)
- (GenerateRecordStub.fix tryGetParseResultsForFile getRecordStub (recordStubReplacements config))
- Run.ifEnabled
- (fun _ -> config.AbstractClassStubGeneration)
- (GenerateAbstractClassStub.fix
- tryGetParseResultsForFile
- getAbstractClassStub
- (abstractClassStubReplacements config))
- AddMissingEqualsToTypeDefinition.fix forceFindSourceText
- ChangePrefixNegationToInfixSubtraction.fix forceFindSourceText
- ConvertDoubleEqualsToSingleEquals.fix getRangeText
- ChangeEqualsInFieldTypeToColon.fix
- WrapExpressionInParentheses.fix getRangeText
- ChangeRefCellDerefToNot.fix tryGetParseResultsForFile
- ChangeDowncastToUpcast.fix getRangeText
- MakeDeclarationMutable.fix tryGetParseResultsForFile forceGetFSharpProjectOptions
- UseMutationWhenValueIsMutable.fix tryGetParseResultsForFile
- ConvertInvalidRecordToAnonRecord.fix tryGetParseResultsForFile
- RemoveUnnecessaryReturnOrYield.fix tryGetParseResultsForFile getLineText
- ConvertCSharpLambdaToFSharpLambda.fix tryGetParseResultsForFile getLineText
- AddMissingFunKeyword.fix forceFindSourceText getLineText
- MakeOuterBindingRecursive.fix tryGetParseResultsForFile getLineText
- AddMissingRecKeyword.fix forceFindSourceText getLineText
- ConvertBangEqualsToInequality.fix getRangeText
- ChangeDerefBangToValue.fix tryGetParseResultsForFile getLineText
- RemoveUnusedBinding.fix tryGetParseResultsForFile
- AddTypeToIndeterminateValue.fix tryGetParseResultsForFile forceGetFSharpProjectOptions
- ChangeTypeOfNameToNameOf.fix tryGetParseResultsForFile
- AddMissingInstanceMember.fix
- AddMissingXmlDocumentation.fix tryGetParseResultsForFile
- AddExplicitTypeAnnotation.fix tryGetParseResultsForFile
- ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText
- ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText
- GenerateXmlDocumentation.fix tryGetParseResultsForFile
- RemoveRedundantAttributeSuffix.fix tryGetParseResultsForFile
- Run.ifEnabled
- (fun _ -> config.AddPrivateAccessModifier)
- (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace2)
- UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText
- RenameParamToMatchSignature.fix tryGetParseResultsForFile
- RemovePatternArgument.fix tryGetParseResultsForFile
- ToInterpolatedString.fix tryGetParseResultsForFile getLanguageVersion
- AdjustConstant.fix tryGetParseResultsForFile |])
-
- let forgetDocument (uri: DocumentUri) =
- async {
- let filePath = uri |> Path.FileUriToLocalPath |> Utils.normalizePath
-
- let doesNotExist (file: string) = not (File.Exists(UMX.untag file))
-
- let isOutsideWorkspace (file: string) =
- asyncAVal {
- let! rootPath = rootPath
-
- match rootPath with
- | None -> return true // no root workspace specified
- | Some rootPath ->
- let rec isInside (rootDir: DirectoryInfo, dirToCheck: DirectoryInfo) =
- if String.Equals(rootDir.FullName, dirToCheck.FullName, StringComparison.InvariantCultureIgnoreCase) then
- true
- else
- match dirToCheck.Parent with
- | null -> false
- | parent -> isInside (rootDir, parent)
-
- let rootDir = DirectoryInfo(rootPath)
- let fileDir = FileInfo(UMX.untag file).Directory
-
- if isInside (rootDir, fileDir) then
- return false
- else
- let! projectOptions = getProjectOptionsForFile file
-
- match projectOptions |> selectProject with
- | None -> return true
- | Some projectOptions ->
- if doesNotExist (UMX.tag projectOptions.ProjectFileName) then
- return true // script file
- else
- // issue: fs-file does never get removed from project options (-> requires reload of FSAC to register)
- // -> don't know if file still part of project (file might have been removed from project)
- // -> keep cache for file
- return false
- }
-
- |> AsyncAVal.forceAsync
-
- transact (fun () ->
- openFiles.Remove filePath |> ignore
-
- match openFilesTokens.TryRemove(filePath) with
- | (true, cts) -> cancelToken filePath cts
- | _ -> ()
-
- textChanges.Remove filePath |> ignore)
-
- let! isOutsideWorkspace = isOutsideWorkspace filePath
-
- if doesNotExist filePath || isOutsideWorkspace then
- logger.info (
- Log.setMessage "Removing cached data for {file}."
- >> Log.addContext "file" filePath
- )
-
- diagnosticCollections.ClearFor(uri)
- else
- logger.info (
- Log.setMessage "File {file} exists inside workspace so diagnostics will not be cleared"
- >> Log.addContext "file" filePath
- )
- }
-
-
- let getDependentFilesForFile file =
- async {
- let! projects = getProjectOptionsForFile file |> AsyncAVal.forceAsync
-
- return
- projects
- |> List.toArray
- |> Array.collect (fun proj ->
- logger.info (
- Log.setMessage "Source Files: {sourceFiles}"
- >> Log.addContextDestructured "sourceFiles" proj.SourceFiles
- )
-
- let idx = proj.SourceFiles |> Array.findIndex (fun x -> x = UMX.untag file)
-
- proj.SourceFiles
- |> Array.splitAt idx
- |> snd
- |> Array.map (fun sourceFile -> proj.FSharpProjectOptions, sourceFile))
- |> Array.distinct
- }
-
-
- let bypassAdaptiveAndCheckDepenenciesForFile (filePath: string) =
- async {
- let tags = [ SemanticConventions.fsac_sourceCodePath, box (UMX.untag filePath) ]
- use _ = fsacActivitySource.StartActivityForType(thisType, tags = tags)
- let! dependentFiles = getDependentFilesForFile filePath
-
- let! projs = getProjectOptionsForFile filePath |> AsyncAVal.forceAsync
-
- let dependentProjects =
- projs
- |> List.map (fun x -> x.FSharpProjectOptions)
- |> getDependentProjectsOfProjects
- |> List.toArray
- |> Array.collect (fun proj -> proj.SourceFiles |> Array.map (fun sourceFile -> proj, sourceFile))
-
- let mutable checksCompleted = 0
-
- use progressReporter = new ServerProgressReport(lspClient)
-
- let percentage numerator denominator =
- if denominator = 0 then
- 0u
- else
- ((float numerator) / (float denominator)) * 100.0 |> uint32
-
- let checksToPerform =
- let innerChecks =
- Array.concat [| dependentFiles; dependentProjects |]
- |> Array.filter (fun (_, file) ->
- file.Contains "AssemblyInfo.fs" |> not
- && file.Contains "AssemblyAttributes.fs" |> not)
-
- let checksToPerformLength = innerChecks.Length
-
- innerChecks
- |> Array.map (fun (proj, file) ->
- let file = UMX.tag file
-
- let token =
- tryGetOpenFileToken filePath
- |> Option.map (fun cts -> cts.Token)
- |> Option.defaultWith (fun () -> CancellationToken.None)
-
- bypassAdaptiveTypeCheck (file) (proj)
- |> Async.withCancellationSafe (fun () -> token)
- |> Async.Ignore
- |> Async.bind (fun _ ->
- async {
- let checksCompleted = Interlocked.Increment(&checksCompleted)
-
- do!
- progressReporter.Report(
- message = $"{checksCompleted}/{checksToPerformLength} remaining",
- percentage = percentage checksCompleted checksToPerformLength
- )
- }))
-
-
- do!
- progressReporter.Begin(
- "Typechecking Dependent F# files",
- message = $"0/{checksToPerform.Length} remaining",
- percentage = percentage 0 checksToPerform.Length
- )
-
- do! checksToPerform |> Async.parallel75 |> Async.Ignore
-
- }
-
member private x.handleSemanticTokens (filePath: string) range : AsyncLspResult =
asyncResult {
- let! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ let! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let r = tyRes.GetCheckResults.GetSemanticClassification(range)
let filteredRanges = Commands.scrubRanges r
@@ -2047,7 +118,7 @@ type AdaptiveFSharpLspServer
let! res = action () |> AsyncResult.ofStringErr
- let rootPath = rootPath |> AVal.force
+ let rootPath = state.RootPath
match res with
| (FormatDocumentResponse.Formatted(sourceText, formatted)) ->
@@ -2179,7 +250,7 @@ type AdaptiveFSharpLspServer
return! returnException e
}
- member __.ScriptFileProjectOptions = scriptFileProjectOptions.Publish
+ member __.ScriptFileProjectOptions = state.ScriptFileProjectOptions.Publish
member private x.logUnimplementedRequest<'t, 'u>
(
@@ -2242,7 +313,7 @@ type AdaptiveFSharpLspServer
let projs =
match p.RootPath, c.AutomaticWorkspaceInit with
| None, _
- | _, false -> workspacePaths |> AVal.force
+ | _, false -> state.WorkspacePaths
| Some actualRootPath, true ->
let peeks =
WorkspacePeek.peek
@@ -2271,17 +342,17 @@ type AdaptiveFSharpLspServer
|> WorkspaceChosen.Projs
transact (fun () ->
- rootPath.Value <- actualRootPath
- clientCapabilities.Value <- p.Capabilities
+ state.RootPath <- actualRootPath
+ state.ClientCapabilities <- p.Capabilities
lspClient.ClientCapabilities <- p.Capabilities
- diagnosticCollections.ClientSupportsDiagnostics <-
+ state.DiagnosticCollections.ClientSupportsDiagnostics <-
match p.Capabilities with
| Some { TextDocument = Some { PublishDiagnostics = Some _ } } -> true
| _ -> false
- updateConfig c
- workspacePaths.Value <- projs)
+ state.Config <- c
+ state.WorkspacePaths <- projs)
let defaultSettings =
{ Helpers.defaultServerCapabilities with
@@ -2315,7 +386,7 @@ type AdaptiveFSharpLspServer
try
logger.info (Log.setMessage "Initialized request {p}" >> Log.addContextDestructured "p" p)
- let! _ = parseAllFiles () |> AsyncAVal.forceAsync
+ let! _ = state.ParseAllFiles()
return ()
with e ->
@@ -2344,16 +415,8 @@ type AdaptiveFSharpLspServer
let doc = p.TextDocument
let filePath = doc.GetFilePath() |> Utils.normalizePath
- if isFileOpen filePath |> AVal.force then
- return ()
- else
- // We want to try to use the file system's datetime if available
- let file =
- VolatileFile.Create(sourceTextFactory.Create(filePath, doc.Text), doc.Version)
+ do! state.OpenDocument(filePath, doc.Text, doc.Version)
- updateOpenFiles file
- let! _ = forceGetOpenFileTypeCheckResults filePath
- return ()
with e ->
trace |> Tracing.recordException e
@@ -2378,7 +441,7 @@ type AdaptiveFSharpLspServer
)
let doc = p.TextDocument
- do! forgetDocument doc.Uri
+ do! state.ForgetDocument doc.Uri
return ()
with e ->
@@ -2406,11 +469,7 @@ type AdaptiveFSharpLspServer
let doc = p.TextDocument
let filePath = doc.GetFilePath() |> Utils.normalizePath
-
- updateTextChanges filePath (p, DateTime.UtcNow)
-
- let! _ = forceGetOpenFileTypeCheckResults filePath
-
+ do! state.ChangeDocument(filePath, p)
return ()
with e ->
@@ -2440,28 +499,8 @@ type AdaptiveFSharpLspServer
let doc = p.TextDocument
let filePath = doc.GetFilePath() |> Utils.normalizePath
- let file =
- option {
- let! oldFile = forceFindOpenFile filePath
-
- let oldFile =
- p.Text
- |> Option.map (fun t -> sourceTextFactory.Create(oldFile.FileName, t))
- |> Option.map (oldFile.SetSource)
- |> Option.defaultValue oldFile
-
- return oldFile.UpdateTouched()
- }
- |> Option.defaultWith (fun () ->
- // Very unlikely to get here
- VolatileFile.Create(sourceTextFactory.Create(filePath, p.Text.Value), 0))
-
- transact (fun () ->
- updateOpenFiles file
- textChanges.Remove filePath |> ignore)
+ do! state.SaveDocument(filePath, p.Text)
- let! _ = forceGetOpenFileTypeCheckResults filePath
- do! bypassAdaptiveAndCheckDepenenciesForFile filePath
do! lspClient.CodeLensRefresh()
logger.info (
@@ -2495,7 +534,7 @@ type AdaptiveFSharpLspServer
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
if volatileFile.Source.Length = 0 then
return None // An empty file has empty completions. Otherwise we would error down there
@@ -2512,7 +551,7 @@ type AdaptiveFSharpLspServer
return! success (Some completionList)
else
- let config = AVal.force config
+ let config = state.Config
let rec retryAsyncOption (delay: TimeSpan) timesLeft handleError action =
async {
@@ -2528,7 +567,7 @@ type AdaptiveFSharpLspServer
let getCompletions forceGetTypeCheckResultsStale =
asyncResult {
- let! volatileFile = forceFindOpenFileOrRead filePath
+ let! volatileFile = state.GetOpenFileOrRead filePath
let! lineStr = volatileFile.Source |> tryGetLineStr pos
// TextDocumentCompletion will sometimes come in before TextDocumentDidChange
@@ -2548,7 +587,7 @@ type AdaptiveFSharpLspServer
let! typeCheckResults =
if isSpecialChar previousCharacter then
- forceGetOpenFileTypeCheckResults filePath
+ state.GetOpenFileTypeCheckResults filePath
else
forceGetTypeCheckResultsStale filePath
@@ -2572,8 +611,8 @@ type AdaptiveFSharpLspServer
match e with
| "Should not have empty completions" ->
// If we don't get any completions, assume we need to wait for a full typecheck
- getCompletions forceGetOpenFileTypeCheckResults
- | _ -> getCompletions forceGetOpenFileTypeCheckResultsStale
+ getCompletions state.GetOpenFileTypeCheckResults
+ | _ -> getCompletions state.GetOpenFileTypeCheckResultsCached
let getCodeToInsert (d: DeclarationListItem) =
match d.NamespaceToOpen with
@@ -2596,7 +635,7 @@ type AdaptiveFSharpLspServer
{ CompletionItem.Create(d.NameInList) with
Data = Some(JValue(d.FullName))
- Kind = (AVal.force glyphToCompletionKind) d.Glyph
+ Kind = (state.GlyphToCompletionKind) d.Glyph
InsertText = Some code
SortText = Some(sprintf "%06d" id)
FilterText = Some filterText
@@ -2607,7 +646,7 @@ type AdaptiveFSharpLspServer
(TimeSpan.FromMilliseconds(15.))
100
handleError
- (getCompletions forceGetOpenFileTypeCheckResultsStale)
+ (getCompletions state.GetOpenFileTypeCheckResultsCached)
|> AsyncResult.ofStringErr
with
| None -> return! success (None)
@@ -2616,12 +655,10 @@ type AdaptiveFSharpLspServer
return!
Debug.measure "TextDocumentCompletion.TryGetCompletions success"
<| fun () ->
- transact (fun () ->
- HashMap.OfList(
- [ for d in decls do
- d.FullName, (d, pos, filePath, volatileFile.Source.GetLine, typeCheckResults.GetAST) ]
- )
- |> autoCompleteItems.UpdateTo)
+ [ for d in decls do
+ d.FullName, (d, pos, filePath, volatileFile.Source.GetLine, typeCheckResults.GetAST) ]
+
+ |> state.UpdateAutocompleteItems
|> ignore
let includeKeywords = config.KeywordsAutocomplete && shouldKeywords
@@ -2654,7 +691,7 @@ type AdaptiveFSharpLspServer
}
override __.CompletionItemResolve(ci: CompletionItem) =
- let config = AVal.force config
+ let config = state.Config
let mapHelpText (ci: CompletionItem) (text: HelpText) =
match text with
@@ -2705,7 +742,7 @@ type AdaptiveFSharpLspServer
else
sym
- match getAutoCompleteByDeclName sym |> AVal.force with
+ match state.GetAutoCompleteByDeclName sym with
| None -> //Isn't in sync filled cache, we don't have result
CoreResponse.ErrorRes(sprintf "No help text available for symbol '%s'" sym)
| Some(decl, pos, fn, _, _) -> //Is in sync filled cache, try to get results from async filled caches or calculate if it's not there
@@ -2713,7 +750,7 @@ type AdaptiveFSharpLspServer
let tip = decl.Description
let n =
- match getAutoCompleteNamespacesByDeclName sym |> AVal.force with
+ match state.GetAutoCompleteNamespacesByDeclName sym with
| Some s when not config.FullNameExternalAutocomplete -> Some s
| _ -> None
@@ -2768,8 +805,8 @@ type AdaptiveFSharpLspServer
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
@@ -2833,9 +870,9 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResultsStale filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResultsCached filePath |> AsyncResult.ofStringErr
match tyRes.TryGetToolTipEnhanced pos lineStr with
| Ok(Some tooltipResult) ->
@@ -2845,7 +882,7 @@ type AdaptiveFSharpLspServer
)
let formatCommentStyle =
- let config = AVal.force config
+ let config = state.Config
if config.TooltipMode = "full" then
TipFormatter.FormatCommentStyle.FullEnhanced
@@ -2926,12 +963,12 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- let! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ let! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! (_, _, range) =
- Commands.renameSymbolRange getDeclarationLocation false pos lineStr volatileFile.Source tyRes
+ Commands.renameSymbolRange state.GetDeclarationLocation false pos lineStr volatileFile.Source tyRes
|> AsyncResult.mapError (fun msg -> JsonRpc.Error.Create(JsonRpc.ErrorCodes.invalidParams, msg))
return range |> fcsRangeToLsp |> PrepareRenameResult.Range |> Some
@@ -2949,9 +986,9 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
// validate name and surround with backticks if necessary
let! newName =
@@ -2960,11 +997,11 @@ type AdaptiveFSharpLspServer
// safety check: rename valid?
let! _ =
- Commands.renameSymbolRange getDeclarationLocation false pos lineStr volatileFile.Source tyRes
+ Commands.renameSymbolRange state.GetDeclarationLocation false pos lineStr volatileFile.Source tyRes
|> AsyncResult.mapError (fun msg -> JsonRpc.Error.Create(JsonRpc.ErrorCodes.invalidParams, msg))
let! ranges =
- symbolUseWorkspace true true true pos lineStr volatileFile.Source tyRes
+ state.SymbolUseWorkspace(true, true, true, pos, lineStr, volatileFile.Source, tyRes)
|> AsyncResult.mapError (fun msg -> JsonRpc.Error.Create(JsonRpc.ErrorCodes.invalidParams, msg))
let! documentChanges =
@@ -2981,7 +1018,7 @@ type AdaptiveFSharpLspServer
let! version =
async {
- let! file = forceFindOpenFileOrRead file
+ let! file = state.GetOpenFileOrRead file
return file |> Option.ofResult |> Option.map (fun (f) -> f.Version)
}
@@ -2993,8 +1030,10 @@ type AdaptiveFSharpLspServer
})
|> Async.parallel75
- let clientCapabilities = clientCapabilities |> AVal.force |> Option.get
- return WorkspaceEdit.Create(documentChanges, clientCapabilities) |> Some
+
+ return
+ state.ClientCapabilities
+ |> Option.map (fun clientCapabilities -> WorkspaceEdit.Create(documentChanges, clientCapabilities))
with e ->
trace |> Tracing.recordException e
@@ -3020,10 +1059,10 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! decl = tyRes.TryFindDeclaration pos lineStr |> AsyncResult.ofStringErr
return decl |> findDeclToLspLocation |> GotoResult.Single |> Some
with e ->
@@ -3051,9 +1090,9 @@ type AdaptiveFSharpLspServer
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! decl = tyRes.TryFindTypeDeclaration pos lineStr |> AsyncResult.ofStringErr
return decl |> findDeclToLspLocation |> GotoResult.Single |> Some
with e ->
@@ -3080,12 +1119,12 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! usages =
- symbolUseWorkspace true true false pos lineStr volatileFile.Source tyRes
+ state.SymbolUseWorkspace(true, true, false, pos, lineStr, volatileFile.Source, tyRes)
|> AsyncResult.mapError (JsonRpc.Error.InternalErrorMessage)
let references =
@@ -3116,9 +1155,9 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
match
tyRes.TryGetSymbolUseAndUsages pos lineStr
@@ -3158,37 +1197,26 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
logger.info (
Log.setMessage "TextDocumentImplementation Request: {parms}"
>> Log.addContextDestructured "parms" p
)
- let getProjectOptions file =
- getProjectOptionsForFile file
- |> AsyncAVal.forceAsync
- |> Async.map List.head
- |> Async.map (fun x -> x.FSharpProjectOptions)
-
- let checker = checker |> AVal.force
+ let getProjectOptions file = state.GetProjectOptionsForFile file |> AsyncResult.bimap id failwith //? Should we fail here?
let getUsesOfSymbol (filePath, opts: _ list, symbol: FSharpSymbol) =
- checker.GetUsesOfSymbol(filePath, opts, symbol)
+ state.GetUsesOfSymbol(filePath, opts, symbol)
let getAllProjects () =
- allFSharpProjectOptions
- |> AMap.force
- |> Seq.toList
- |> Seq.map (fun (k, v) ->
- async {
- let! proj = AsyncAVal.forceAsync v
- return Option.map (fun proj -> UMX.untag k, proj) (selectFSharpProject proj)
- })
- |> Async.parallel75
- |> Async.map (Array.choose id >> List.ofArray)
+ state.GetFilesToProject()
+ |> Async.map (
+ Array.map (fun (file, proj) -> UMX.untag file, proj.FSharpProjectOptions)
+ >> Array.toList
+ )
let! res =
Commands.symbolImplementationProject getProjectOptions getUsesOfSymbol getAllProjects tyRes pos lineStr
@@ -3232,15 +1260,12 @@ type AdaptiveFSharpLspServer
let fn = p.TextDocument.GetFilePath() |> Utils.normalizePath
- match! getDeclarations fn |> AsyncAVal.forceAsync with
+ match! state.GetDeclarations fn with
| Some decls ->
return
- glyphToSymbolKind
- |> AVal.map (fun glyphToSymbolKind ->
- decls
- |> Array.collect (fun top ->
- getSymbolInformations p.TextDocument.Uri glyphToSymbolKind top (fun s -> true)))
- |> AVal.force
+ decls
+ |> Array.collect (fun top ->
+ getSymbolInformations p.TextDocument.Uri state.GlyphToSymbolKind top (fun s -> true))
|> U2.First
|> Some
| None -> return! LspResult.internalError $"No declarations for {fn}"
@@ -3268,9 +1293,9 @@ type AdaptiveFSharpLspServer
>> Log.addContextDestructured "parms" symbolRequest
)
- let glyphToSymbolKind = glyphToSymbolKind |> AVal.force
+ let glyphToSymbolKind = state.GlyphToSymbolKind
- let! decls = getAllDeclarations ()
+ let! decls = state.GetAllDeclarations()
let res =
decls
@@ -3311,7 +1336,7 @@ type AdaptiveFSharpLspServer
>> Log.addContextDestructured "parms" p
)
- let tryGetFileCheckerOptionsWithLines file = forceFindSourceText file
+ let tryGetFileCheckerOptionsWithLines file = state.GetOpenFileSource file
let formatDocumentAsync x = fantomasService.FormatDocumentAsync x
Commands.formatDocument tryGetFileCheckerOptionsWithLines formatDocumentAsync fileName
@@ -3361,7 +1386,7 @@ type AdaptiveFSharpLspServer
p.Range.End.Character
)
- let tryGetFileCheckerOptionsWithLines file = forceFindSourceText file
+ let tryGetFileCheckerOptionsWithLines file = state.GetOpenFileSource file
let formatSelectionAsync x = fantomasService.FormatSelectionAsync x
Commands.formatSelection tryGetFileCheckerOptionsWithLines formatSelectionAsync fileName range
@@ -3404,8 +1429,7 @@ type AdaptiveFSharpLspServer
)
let (fixes: Async[]>) =
- codefixes
- |> AVal.force
+ state.Codefixes
|> Array.map (fun codeFix ->
async {
try
@@ -3436,18 +1460,21 @@ type AdaptiveFSharpLspServer
let tryGetFileVersion filePath =
async {
- let! foo = forceFindOpenFileOrRead filePath
+ let! foo = state.GetOpenFileOrRead filePath
return foo |> Option.ofResult |> Option.map (fun (f) -> f.Version)
}
- let clientCapabilities = clientCapabilities |> AVal.force
+ let! clientCapabilities =
+ state.ClientCapabilities
+ |> Result.ofOption (fun () -> "ClientCapabilities not available")
+ |> Result.ofStringErr
match actions with
| [] -> return None
| actions ->
let! fixes =
actions
- |> List.map (CodeAction.OfFix tryGetFileVersion clientCapabilities.Value)
+ |> List.map (CodeAction.OfFix tryGetFileVersion clientCapabilities)
|> Async.parallel75
return Some(fixes |> Array.map U2.Second)
@@ -3476,10 +1503,10 @@ type AdaptiveFSharpLspServer
let fn = p.TextDocument.GetFilePath() |> Utils.normalizePath
- match! getDeclarations (fn) |> AsyncAVal.forceAsync with
+ match! state.GetDeclarations(fn) with
| None -> return None
| Some decls ->
- let config = AVal.force config
+ let config = state.Config
let res =
[| if config.LineLens.Enabled <> "replaceCodeLens" then
@@ -3521,7 +1548,7 @@ type AdaptiveFSharpLspServer
let filePath = Path.FileUriToLocalPath data.[0] |> Utils.normalizePath
try
- let! tyRes = forceGetOpenFileTypeCheckResultsStale filePath |> AsyncResult.ofStringErr
+ let! tyRes = state.GetOpenFileTypeCheckResultsCached filePath |> AsyncResult.ofStringErr
logger.info (
@@ -3529,7 +1556,7 @@ type AdaptiveFSharpLspServer
>> Log.addContextDestructured "file" filePath
)
- let! (sourceText: IFSACSourceText) = forceFindSourceText filePath |> AsyncResult.ofStringErr
+ let! (sourceText: IFSACSourceText) = state.GetOpenFileSource filePath |> AsyncResult.ofStringErr
let! lineStr = sourceText |> tryGetLineStr pos |> Result.ofStringErr
let typ = data.[1]
@@ -3605,7 +1632,7 @@ type AdaptiveFSharpLspServer
return { p with Command = Some cmd } |> Some |> success
elif typ = "reference" then
let! uses =
- symbolUseWorkspace false true false pos lineStr sourceText tyRes
+ state.SymbolUseWorkspace(false, true, false, pos, lineStr, sourceText, tyRes)
|> AsyncResult.mapError (JsonRpc.Error.InternalErrorMessage)
match uses with
@@ -3666,7 +1693,7 @@ type AdaptiveFSharpLspServer
for c in p.Changes do
if c.Type = FileChangeType.Deleted then
- do! forgetDocument c.Uri
+ do! state.ForgetDocument c.Uri
with e ->
trace |> Tracing.recordException e
@@ -3692,9 +1719,9 @@ type AdaptiveFSharpLspServer
dto.FSharp
|> Option.iter (fun fsharpConfig ->
- let c = config |> AVal.force
+ let c = state.Config
let c = c.AddDto fsharpConfig
- updateConfig c)
+ state.Config <- c)
with e ->
trace |> Tracing.recordException e
@@ -3721,8 +1748,8 @@ type AdaptiveFSharpLspServer
let getParseResultsForFile file =
asyncResult {
- let! sourceText = forceFindSourceText file
- and! parseResults = forceGetParseResults file
+ let! sourceText = state.GetOpenFileSource file
+ and! parseResults = state.GetParseResults file
return sourceText, parseResults
}
@@ -3765,7 +1792,7 @@ type AdaptiveFSharpLspServer
let getParseResultsForFile file =
asyncResult {
- let! parseResults = forceGetParseResults file
+ let! parseResults = state.GetParseResults file
return parseResults
}
@@ -3852,12 +1879,12 @@ type AdaptiveFSharpLspServer
)
let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let fcsRange = protocolRangeToRange (UMX.untag filePath) p.Range
- let config = config |> AVal.force
+ let config = state.Config
let! hints =
Commands.InlayHints(
@@ -3957,10 +1984,10 @@ type AdaptiveFSharpLspServer
)
let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
- let! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ let! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let fcsRange = protocolRangeToRange (UMX.untag filePath) p.Range
@@ -4040,11 +2067,10 @@ type AdaptiveFSharpLspServer
let filePath = Path.FileUriToLocalPath p.Item.Uri |> Utils.normalizePath
let pos = protocolPosToPos p.Item.SelectionRange.Start
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.ofStringErr
- and! opts = forceGetProjectOptions filePath |> AsyncResult.ofStringErr
// Incoming file may not be "Opened" so we need to force a typecheck
- let! tyRes = bypassAdaptiveTypeCheck filePath opts |> AsyncResult.ofStringErr
+ let! tyRes = state.GetTypeCheckResultsForFile filePath |> AsyncResult.ofStringErr
let locationToCallHierarchyItem (loc: Location) =
@@ -4056,7 +2082,7 @@ type AdaptiveFSharpLspServer
let fn = loc.Uri |> Path.FileUriToLocalPath |> Utils.normalizePath
- let! parseResults = getParseResults fn |> AsyncAVal.forceAsync
+ let! parseResults = state.GetParseResults fn |> Async.map Result.toOption
let! (fullBindingRange, glyph, bindingIdents) =
parseResults.TryRangeOfNameOfNearestOuterBindingOrMember(protocolPosToPos loc.Range.Start)
@@ -4071,7 +2097,7 @@ type AdaptiveFSharpLspServer
let retVals =
{ From =
{ Name = name
- Kind = (AVal.force glyphToSymbolKind) glyph |> Option.defaultValue SymbolKind.Method
+ Kind = (state.GlyphToSymbolKind) glyph |> Option.defaultValue SymbolKind.Method
Tags = None
Detail = Some(sprintf $"From {Path.GetFileName(UMX.untag fn)}")
Uri = loc.Uri
@@ -4084,7 +2110,7 @@ type AdaptiveFSharpLspServer
}
let! usages =
- symbolUseWorkspace true true false pos lineStr volatileFile.Source tyRes
+ state.SymbolUseWorkspace(true, true, false, pos, lineStr, volatileFile.Source, tyRes)
|> AsyncResult.mapError (JsonRpc.Error.InternalErrorMessage)
let! references =
@@ -4128,9 +2154,9 @@ type AdaptiveFSharpLspServer
member __.Position = p.Position }
|> getFilePathAndPosition
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = tryGetLineStr pos volatileFile.Source |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! decl = tyRes.TryFindDeclaration pos lineStr |> AsyncResult.ofStringErr
@@ -4209,10 +2235,10 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! tip = Commands.typesig tyRes pos lineStr |> Result.ofCoreResponse
return
@@ -4245,10 +2271,10 @@ type AdaptiveFSharpLspServer
FSharp.Compiler.Text.Position.mkPos (p.Position.Line) (p.Position.Character + 2)
let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
let! (typ, parms, generics) = tyRes.TryGetSignatureData pos lineStr |> Result.ofStringErr
return
@@ -4280,10 +2306,10 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
match!
Commands.GenerateXmlDocumentation(tyRes, pos, lineStr)
@@ -4334,7 +2360,7 @@ type AdaptiveFSharpLspServer
let fn = p.Project.GetFilePath() |> Utils.normalizePath
- match! getDeclarations fn |> AsyncAVal.forceAsync with
+ match! state.GetDeclarations fn with
| None -> return! LspResult.internalError $"No declerations found for {fn}"
| Some decls ->
let decls = decls |> Array.map (fun d -> d, fn)
@@ -4369,8 +2395,8 @@ type AdaptiveFSharpLspServer
|> Array.map (fun t -> t.GetFilePath() |> Utils.normalizePath)
|> HashSet.ofArray
- transact (fun () -> workspacePaths.Value <- (WorkspaceChosen.Projs projs))
- let! _ = parseAllFiles () |> AsyncAVal.forceAsync
+ transact (fun () -> state.WorkspacePaths <- (WorkspaceChosen.Projs projs))
+ let! _ = state.ParseAllFiles()
return { Content = CommandResponse.workspaceLoad FsAutoComplete.JsonSerializer.writeJson true }
@@ -4435,13 +2461,11 @@ type AdaptiveFSharpLspServer
>> Log.addContextDestructured "parms" p
)
- let paths = workspacePaths |> AVal.force
+ let paths = state.WorkspacePaths
transact (fun () ->
- workspacePaths.Value <-
+ state.WorkspacePaths <-
match paths with
- | WorkspaceChosen.Sln x -> failwith "Can't load individual projects when Sln is chosen"
- | WorkspaceChosen.Directory x -> failwith "Can't load individual projects when Directory is chosen"
| WorkspaceChosen.Projs ps ->
p.Project.GetFilePath()
|> Utils.normalizePath
@@ -4631,9 +2655,9 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
match! Commands.Help tyRes pos lineStr |> Result.ofCoreResponse with
| Some t -> return Some { Content = CommandResponse.help FsAutoComplete.JsonSerializer.writeJson t }
@@ -4662,9 +2686,9 @@ type AdaptiveFSharpLspServer
)
let (filePath, pos) = getFilePathAndPosition p
- let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr
+ let! volatileFile = state.GetOpenFileOrRead filePath |> AsyncResult.ofStringErr
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
- and! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ and! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
lastFSharpDocumentationTypeCheck <- Some tyRes
match! Commands.FormattedDocumentation tyRes pos lineStr |> Result.ofCoreResponse with
@@ -4750,10 +2774,7 @@ type AdaptiveFSharpLspServer
try
// since the analyzer state handling code is in `updateConfig`, re-trigger it here
- transact
- <| fun () ->
- config.MarkOutdated()
- updateConfig config.Value
+ state.LoadAnalyzers()
return LspResult.success ()
with e ->
@@ -4774,9 +2795,12 @@ type AdaptiveFSharpLspServer
)
let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath
- let! tyRes = forceGetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
+ let! tyRes = state.GetOpenFileTypeCheckResults filePath |> AsyncResult.ofStringErr
- match! Commands.pipelineHints forceFindSourceText tyRes |> AsyncResult.ofCoreResponse with
+ match!
+ Commands.pipelineHints state.GetOpenFileSource tyRes
+ |> AsyncResult.ofCoreResponse
+ with
| None -> return None
| Some res ->
return Some { Content = CommandResponse.pipelineHint FsAutoComplete.JsonSerializer.writeJson res }
@@ -4988,7 +3012,8 @@ type AdaptiveFSharpLspServer
|> AsyncResult.ignore
let fileUri = Path.FilePathToUri fullPath
- diagnosticCollections.ClearFor fileUri
+ do! state.ForgetDocument fileUri
+ // diagnosticCollections.ClearFor fileUri
return None
with e ->
@@ -5032,9 +3057,7 @@ type AdaptiveFSharpLspServer
return! returnException e
}
- override x.Dispose() =
- traceNotifications |> Option.iter (dispose)
- disposables.Dispose()
+ override x.Dispose() = disposables.Dispose()
member this.WorkDoneProgessCancel(token: ProgressToken) : Async =
async {
@@ -5067,7 +3090,6 @@ type AdaptiveFSharpLspServer
module AdaptiveFSharpLspServer =
- open System.Threading.Tasks
open StreamJsonRpc
let createRpc (handler: IJsonRpcMessageHandler) : JsonRpc =
diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs
new file mode 100644
index 000000000..073dd82d3
--- /dev/null
+++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs
@@ -0,0 +1,2081 @@
+namespace FsAutoComplete.Lsp
+
+open System
+open System.IO
+open System.Threading
+open FsAutoComplete
+open FsAutoComplete.CodeFix
+open FsAutoComplete.Logging
+open Ionide.LanguageServerProtocol
+open Ionide.LanguageServerProtocol.Types
+open Ionide.ProjInfo.ProjectSystem
+open System.Reactive
+
+open FsAutoComplete.Adaptive
+open FsAutoComplete.LspHelpers
+
+open FSharp.Control.Reactive
+open FsToolkit.ErrorHandling
+open FsAutoComplete.Telemetry
+open FsAutoComplete.Utils.Tracing
+open FSharp.UMX
+
+open FSharp.Compiler.Text
+open CliWrap
+open FSharp.Compiler.EditorServices
+
+open FSharp.Data.Adaptive
+open Ionide.ProjInfo
+open FSharp.Compiler.CodeAnalysis
+open FsAutoComplete.UnionPatternMatchCaseGenerator
+open System.Collections.Concurrent
+open System.Text.RegularExpressions
+open IcedTasks
+open System.Threading.Tasks
+open FsAutoComplete.FCSPatches
+open FsAutoComplete.Lsp
+open FsAutoComplete.Lsp.Helpers
+
+
+[]
+type WorkspaceChosen =
+ | Projs of HashSet>
+ | NotChosen
+
+[]
+type AdaptiveWorkspaceChosen =
+ | Projs of amap, DateTime>
+ | NotChosen
+
+
+[]
+type LoadedProject =
+ { FSharpProjectOptions: FSharpProjectOptions
+ LanguageVersion: LanguageVersionShim }
+
+ interface IEquatable with
+ member x.Equals(other) = x.FSharpProjectOptions = other.FSharpProjectOptions
+
+ override x.GetHashCode() = x.FSharpProjectOptions.GetHashCode()
+
+ override x.Equals(other: obj) =
+ match other with
+ | :? LoadedProject as other -> (x :> IEquatable<_>).Equals other
+ | _ -> false
+
+ member x.SourceFiles = x.FSharpProjectOptions.SourceFiles
+ member x.ProjectFileName = x.FSharpProjectOptions.ProjectFileName
+ static member op_Implicit(x: LoadedProject) = x.FSharpProjectOptions
+
+
+type AdaptiveState(lspClient: FSharpLspClient, sourceTextFactory: ISourceTextFactory, workspaceLoader: IWorkspaceLoader)
+ =
+ let logger = LogProvider.getLoggerFor ()
+ let thisType = typeof
+ let disposables = new Disposables.CompositeDisposable()
+
+ /// The reality is a file can be in multiple projects
+ /// This is extracted to make it easier to do some type of customized select
+ /// in the future
+ let selectProject projs = projs |> List.tryHead
+
+ let rootPath = cval None
+
+ let config = cval FSharpConfig.Default
+
+ let checker =
+ config
+ |> AVal.map (fun c -> c.EnableAnalyzers, c.Fsac.CachedTypeCheckCount, c.Fsac.ParallelReferenceResolution)
+ |> AVal.map (FSharpCompilerServiceChecker)
+
+ let configChanges =
+ aval {
+ let! config = config
+ and! checker = checker
+ and! rootPath = rootPath
+
+ return config, checker, rootPath
+ }
+
+
+ let mutable traceNotifications: ProgressListener option = None
+
+ /// Toggles trace notifications on or off.
+ /// Determines if tracing should occur
+ /// The namespaces to start tracing
+ ///
+ let toggleTraceNotification shouldTrace traceNamespaces =
+ traceNotifications |> Option.iter dispose
+
+ if shouldTrace then
+ traceNotifications <- Some(new ProgressListener(lspClient, traceNamespaces))
+ else
+ traceNotifications <- None
+
+ /// Sets tje FSI arguments on the FSharpCompilerServiceChecker
+ ///
+ /// Compiler tool locations
+ /// Any extra parameters to pass to FSI
+ let setFSIArgs
+ (checker: FSharpCompilerServiceChecker)
+ (fsiCompilerToolLocations: string array)
+ (fsiExtraParameters: seq)
+ =
+ let toCompilerToolArgument (path: string) = sprintf "--compilertool:%s" path
+
+ checker.SetFSIAdditionalArguments
+ [| yield! fsiCompilerToolLocations |> Array.map toCompilerToolArgument
+ yield! fsiExtraParameters |]
+
+ /// Loads F# Analyzers from the configured directories
+ /// The FSharpConfig
+ /// The RootPath
+ ///
+ let loadAnalyzers (config: FSharpConfig) (rootPath: string option) =
+ if config.EnableAnalyzers then
+ Loggers.analyzers.info (Log.setMessageI $"Using analyzer roots of {config.AnalyzersPath:roots}")
+
+ config.AnalyzersPath
+ |> Array.iter (fun analyzerPath ->
+ match rootPath with
+ | None -> ()
+ | Some workspacePath ->
+ let dir =
+ if
+ System.IO.Path.IsPathRooted analyzerPath
+ // if analyzer is using absolute path, use it as is
+ then
+ analyzerPath
+ // otherwise, it is a relative path and should be combined with the workspace path
+ else
+ System.IO.Path.Combine(workspacePath, analyzerPath)
+
+ Loggers.analyzers.info (Log.setMessageI $"Loading analyzers from {dir:dir}")
+
+ let (dllCount, analyzerCount) = dir |> FSharp.Analyzers.SDK.Client.loadAnalyzers
+
+ Loggers.analyzers.info (
+ Log.setMessageI
+ $"From {analyzerPath:name}: {dllCount:dllNo} dlls including {analyzerCount:analyzersNo} analyzers"
+ ))
+
+ else
+ Loggers.analyzers.info (Log.setMessage "Analyzers disabled")
+
+ ///
+ /// the FSharpCompilerServiceChecker
+ /// The path to dotnet
+ /// The root path
+ ///
+ let setDotnetRoot (checker: FSharpCompilerServiceChecker) (dotnetRoot: string) (rootPath: string option) =
+ let di = DirectoryInfo dotnetRoot
+
+ if di.Exists then
+ let dotnetBinary =
+ if
+ System.Runtime.InteropServices.RuntimeInformation.IsOSPlatform(Runtime.InteropServices.OSPlatform.Windows)
+ then
+ FileInfo(Path.Combine(di.FullName, "dotnet.exe"))
+ else
+ FileInfo(Path.Combine(di.FullName, "dotnet"))
+
+ if dotnetBinary.Exists then
+ checker.SetDotnetRoot(dotnetBinary, defaultArg rootPath System.Environment.CurrentDirectory |> DirectoryInfo)
+
+ else
+ // if we were mistakenly given the path to a dotnet binary
+ // then use the parent directory as the dotnet root instead
+ let fi = FileInfo(di.FullName)
+
+ if fi.Exists && (fi.Name = "dotnet" || fi.Name = "dotnet.exe") then
+ checker.SetDotnetRoot(fi, defaultArg rootPath System.Environment.CurrentDirectory |> DirectoryInfo)
+
+
+
+ // Syncs config changes to the mutable world
+ do
+ AVal.Observable.onValueChangedWeak configChanges
+ |> Observable.subscribe (fun (config, checker, rootPath) ->
+ toggleTraceNotification config.Notifications.Trace config.Notifications.TraceNamespaces
+
+ setFSIArgs checker config.FSICompilerToolLocations config.FSIExtraParameters
+
+ loadAnalyzers config rootPath
+
+ setDotnetRoot checker config.DotNetRoot rootPath)
+ |> disposables.Add
+
+
+ let tfmConfig =
+ config
+ |> AVal.map (fun c ->
+ if c.UseSdkScripts then
+ FSIRefs.TFM.NetCore
+ else
+ FSIRefs.TFM.NetFx)
+
+
+ let sendDiagnostics (uri: DocumentUri) (diags: Diagnostic[]) =
+ logger.info (Log.setMessageI $"SendDiag for {uri:file}: {diags.Length:diags} entries")
+
+ // TODO: providing version would be very useful
+ { Uri = uri
+ Diagnostics = diags
+ Version = None }
+ |> lspClient.TextDocumentPublishDiagnostics
+
+
+ let diagnosticCollections = new DiagnosticCollection(sendDiagnostics)
+
+ let notifications = Event()
+
+ let scriptFileProjectOptions = Event()
+
+ let fileParsed =
+ Event()
+
+ let fileChecked = Event()
+
+ let detectTests (parseResults: FSharpParseFileResults) (proj: FSharpProjectOptions) ct =
+ try
+ logger.info (Log.setMessageI $"Test Detection of {parseResults.FileName:file} started")
+
+ let fn = UMX.tag parseResults.FileName
+
+ let res =
+ if proj.OtherOptions |> Seq.exists (fun o -> o.Contains "Expecto.dll") then
+ TestAdapter.getExpectoTests parseResults.ParseTree
+ elif proj.OtherOptions |> Seq.exists (fun o -> o.Contains "nunit.framework.dll") then
+ TestAdapter.getNUnitTest parseResults.ParseTree
+ elif proj.OtherOptions |> Seq.exists (fun o -> o.Contains "xunit.assert.dll") then
+ TestAdapter.getXUnitTest parseResults.ParseTree
+ else
+ []
+
+ logger.info (Log.setMessageI $"Test Detection of {parseResults.FileName:file} - {res:res}")
+
+ notifications.Trigger(NotificationEvent.TestDetected(fn, res |> List.toArray), ct)
+ with e ->
+ logger.info (
+ Log.setMessageI $"Test Detection of {parseResults.FileName:file} failed"
+ >> Log.addExn e
+ )
+
+ do
+ disposables.Add
+ <| fileParsed.Publish.Subscribe(fun (parseResults, proj, ct) -> detectTests parseResults proj ct)
+
+ let builtInCompilerAnalyzers config (file: VolatileFile) (tyRes: ParseAndCheckResults) =
+ let filePath = file.FileName
+ let filePathUntag = UMX.untag filePath
+ let source = file.Source
+ let version = file.Version
+ let fileName = Path.GetFileName filePathUntag
+
+
+ let inline getSourceLine lineNo = (source: ISourceText).GetLineString(lineNo - 1)
+
+ let checkUnusedOpens =
+ async {
+ try
+ use progress = new ServerProgressReport(lspClient)
+ do! progress.Begin($"Checking unused opens {fileName}...", message = filePathUntag)
+
+ let! unused = UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, getSourceLine)
+
+ let! ct = Async.CancellationToken
+ notifications.Trigger(NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray), file.Version), ct)
+ with e ->
+ logger.error (Log.setMessage "checkUnusedOpens failed" >> Log.addExn e)
+ }
+
+ let checkUnusedDeclarations =
+ async {
+ try
+ use progress = new ServerProgressReport(lspClient)
+ do! progress.Begin($"Checking unused declarations {fileName}...", message = filePathUntag)
+
+ let isScript = Utils.isAScript (filePathUntag)
+ let! unused = UnusedDeclarations.getUnusedDeclarations (tyRes.GetCheckResults, isScript)
+ let unused = unused |> Seq.toArray
+
+ let! ct = Async.CancellationToken
+ notifications.Trigger(NotificationEvent.UnusedDeclarations(filePath, unused, file.Version), ct)
+ with e ->
+ logger.error (Log.setMessage "checkUnusedDeclarations failed" >> Log.addExn e)
+ }
+
+ let checkSimplifiedNames =
+ async {
+ try
+ use progress = new ServerProgressReport(lspClient)
+ do! progress.Begin($"Checking simplifying of names {fileName}...", message = filePathUntag)
+
+ let! simplified = SimplifyNames.getSimplifiableNames (tyRes.GetCheckResults, getSourceLine)
+ let simplified = Array.ofSeq simplified
+ let! ct = Async.CancellationToken
+ notifications.Trigger(NotificationEvent.SimplifyNames(filePath, simplified, file.Version), ct)
+ with e ->
+ logger.error (Log.setMessage "checkSimplifiedNames failed" >> Log.addExn e)
+ }
+
+ let inline isNotExcluded (exclusions: Regex array) =
+ exclusions |> Array.exists (fun r -> r.IsMatch filePathUntag) |> not
+
+ let analyzers =
+ [
+ // if config.Linter then
+ // commands.Lint filePath |> Async .Ignore
+ if config.UnusedOpensAnalyzer && isNotExcluded config.UnusedOpensAnalyzerExclusions then
+ checkUnusedOpens
+ if
+ config.UnusedDeclarationsAnalyzer
+ && isNotExcluded config.UnusedDeclarationsAnalyzerExclusions
+ then
+ checkUnusedDeclarations
+ if
+ config.SimplifyNameAnalyzer
+ && isNotExcluded config.SimplifyNameAnalyzerExclusions
+ then
+ checkSimplifiedNames ]
+
+ async {
+ do! analyzers |> Async.parallel75 |> Async.Ignore
+
+ do!
+ lspClient.NotifyDocumentAnalyzed
+ { TextDocument =
+ { Uri = filePath |> Path.LocalPathToUri
+ Version = version } }
+ }
+
+
+ let runAnalyzers (config: FSharpConfig) (parseAndCheck: ParseAndCheckResults) (volatileFile: VolatileFile) =
+ async {
+ if config.EnableAnalyzers then
+ let file = volatileFile.FileName
+
+ try
+ use progress = new ServerProgressReport(lspClient)
+ do! progress.Begin("Running analyzers...", message = UMX.untag file)
+
+ Loggers.analyzers.info (
+ Log.setMessage "begin analysis of {file}"
+ >> Log.addContextDestructured "file" file
+ )
+
+ match parseAndCheck.GetCheckResults.ImplementationFile with
+ | Some tast ->
+ // Since analyzers are not async, we need to switch to a new thread to not block threadpool
+ do! Async.SwitchToNewThread()
+
+ let res =
+ Commands.analyzerHandler (
+ file,
+ volatileFile.Source.ToString().Split("\n"),
+ parseAndCheck.GetParseResults.ParseTree,
+ tast,
+ parseAndCheck.GetCheckResults.PartialAssemblySignature.Entities |> Seq.toList,
+ parseAndCheck.GetAllEntities
+ )
+
+ let! ct = Async.CancellationToken
+ notifications.Trigger(NotificationEvent.AnalyzerMessage(res, file, volatileFile.Version), ct)
+
+ Loggers.analyzers.info (Log.setMessageI $"end analysis of {file:file}")
+
+ | _ ->
+ Loggers.analyzers.info (Log.setMessageI $"missing components of {file:file} to run analyzers, skipped them")
+
+ ()
+ with ex ->
+ Loggers.analyzers.error (Log.setMessageI $"Run failed for {file:file}" >> Log.addExn ex)
+ }
+
+ do
+ disposables.Add
+ <| fileChecked.Publish.Subscribe(fun (parseAndCheck, volatileFile, ct) ->
+ if volatileFile.Source.Length = 0 then
+ () // Don't analyze and error on an empty file
+ else
+ async {
+ let config = config |> AVal.force
+ do! builtInCompilerAnalyzers config volatileFile parseAndCheck
+ do! runAnalyzers config parseAndCheck volatileFile
+
+ }
+ |> Async.StartWithCT ct)
+
+
+ let handleCommandEvents (n: NotificationEvent, ct: CancellationToken) =
+ try
+ async {
+
+ try
+ match n with
+ | NotificationEvent.FileParsed fn ->
+ let uri = Path.LocalPathToUri fn
+
+ do! ({ Content = UMX.untag uri }: PlainNotification) |> lspClient.NotifyFileParsed
+ | NotificationEvent.Workspace ws ->
+
+ let ws =
+ match ws with
+ | ProjectResponse.Project(x, _) -> CommandResponse.project JsonSerializer.writeJson x
+ | ProjectResponse.ProjectError(_, errorDetails) ->
+ CommandResponse.projectError JsonSerializer.writeJson errorDetails
+ | ProjectResponse.ProjectLoading(projectFileName) ->
+ CommandResponse.projectLoading JsonSerializer.writeJson projectFileName
+ | ProjectResponse.WorkspaceLoad(finished) ->
+ CommandResponse.workspaceLoad JsonSerializer.writeJson finished
+ | ProjectResponse.ProjectChanged(projectFileName) -> failwith "Not Implemented"
+
+ logger.info (Log.setMessage "Workspace Notify {ws}" >> Log.addContextDestructured "ws" ws)
+ do! ({ Content = ws }: PlainNotification) |> lspClient.NotifyWorkspace
+
+ | NotificationEvent.ParseError(errors, file, version) ->
+ let uri = Path.LocalPathToUri file
+ let diags = errors |> Array.map fcsErrorToDiagnostic
+ diagnosticCollections.SetFor(uri, "F# Compiler", version, diags)
+
+ | NotificationEvent.UnusedOpens(file, opens, version) ->
+ let uri = Path.LocalPathToUri file
+
+ let diags =
+ opens
+ |> Array.map (fun n ->
+ { Range = fcsRangeToLsp n
+ Code = Some "FSAC0001"
+ Severity = Some DiagnosticSeverity.Hint
+ Source = Some "FSAC"
+ Message = "Unused open statement"
+ RelatedInformation = None
+ Tags = Some [| DiagnosticTag.Unnecessary |]
+ Data = None
+ CodeDescription = None })
+
+ diagnosticCollections.SetFor(uri, "F# Unused opens", version, diags)
+
+ | NotificationEvent.UnusedDeclarations(file, decls, version) ->
+ let uri = Path.LocalPathToUri file
+
+ let diags =
+ decls
+ |> Array.map (fun n ->
+ { Range = fcsRangeToLsp n
+ Code = Some "FSAC0003"
+ Severity = Some DiagnosticSeverity.Hint
+ Source = Some "FSAC"
+ Message = "This value is unused"
+ RelatedInformation = Some [||]
+ Tags = Some [| DiagnosticTag.Unnecessary |]
+ Data = None
+ CodeDescription = None })
+
+ diagnosticCollections.SetFor(uri, "F# Unused declarations", version, diags)
+
+ | NotificationEvent.SimplifyNames(file, decls, version) ->
+ let uri = Path.LocalPathToUri file
+
+ let diags =
+ decls
+ |> Array.map
+
+ (fun
+ ({ Range = range
+ RelativeName = _relName }) ->
+ { Diagnostic.Range = fcsRangeToLsp range
+ Code = Some "FSAC0002"
+ Severity = Some DiagnosticSeverity.Hint
+ Source = Some "FSAC"
+ Message = "This qualifier is redundant"
+ RelatedInformation = Some [||]
+ Tags = Some [| DiagnosticTag.Unnecessary |]
+ Data = None
+ CodeDescription = None })
+
+ diagnosticCollections.SetFor(uri, "F# simplify names", version, diags)
+
+ // | NotificationEvent.Lint (file, warnings) ->
+ // let uri = Path.LocalPathToUri file
+ // // let fs =
+ // // warnings |> List.choose (fun w ->
+ // // w.Warning.Details.SuggestedFix
+ // // |> Option.bind (fun f ->
+ // // let f = f.Force()
+ // // let range = fcsRangeToLsp w.Warning.Details.Range
+ // // f |> Option.map (fun f -> range, {Range = range; NewText = f.ToText})
+ // // )
+ // // )
+
+ // let diags =
+ // warnings
+ // |> List.map(fun w ->
+ // let range = fcsRangeToLsp w.Warning.Details.Range
+ // let fixes =
+ // match w.Warning.Details.SuggestedFix with
+ // | None -> None
+ // | Some lazyFix ->
+ // match lazyFix.Value with
+ // | None -> None
+ // | Some fix ->
+ // Some (box [ { Range = fcsRangeToLsp fix.FromRange; NewText = fix.ToText } ] )
+ // let uri = Option.ofObj w.HelpUrl |> Option.map (fun url -> { Href = Some (Uri url) })
+ // { Range = range
+ // Code = Some w.Code
+ // Severity = Some DiagnosticSeverity.Information
+ // Source = "F# Linter"
+ // Message = w.Warning.Details.Message
+ // RelatedInformation = None
+ // Tags = None
+ // Data = fixes
+ // CodeDescription = uri }
+ // )
+ // |> List.sortBy (fun diag -> diag.Range)
+ // |> List.toArray
+ // diagnosticCollections.SetFor(uri, "F# Linter", diags)
+
+ | NotificationEvent.Canceled(msg) ->
+ let ntf: PlainNotification = { Content = msg }
+
+ do! lspClient.NotifyCancelledRequest ntf
+ | NotificationEvent.AnalyzerMessage(messages, file, version) ->
+ let uri = Path.LocalPathToUri file
+
+ match messages with
+ | [||] -> diagnosticCollections.SetFor(uri, "F# Analyzers", version, [||])
+ | messages ->
+ let diags =
+ messages
+ |> Array.map (fun m ->
+ let range = fcsRangeToLsp m.Range
+
+ let severity =
+ match m.Severity with
+ | FSharp.Analyzers.SDK.Info -> DiagnosticSeverity.Information
+ | FSharp.Analyzers.SDK.Warning -> DiagnosticSeverity.Warning
+ | FSharp.Analyzers.SDK.Error -> DiagnosticSeverity.Error
+
+ let fixes =
+ match m.Fixes with
+ | [] -> None
+ | fixes ->
+ fixes
+ |> List.map (fun fix ->
+ { Range = fcsRangeToLsp fix.FromRange
+ NewText = fix.ToText })
+ |> Ionide.LanguageServerProtocol.Server.serialize
+ |> Some
+
+ { Range = range
+ Code = Option.ofObj m.Code
+ Severity = Some severity
+ Source = Some $"F# Analyzers (%s{m.Type})"
+ Message = m.Message
+ RelatedInformation = None
+ Tags = None
+ CodeDescription = None
+ Data = fixes })
+
+ diagnosticCollections.SetFor(uri, "F# Analyzers", version, diags)
+ | NotificationEvent.TestDetected(file, tests) ->
+ let rec map
+ (r: TestAdapter.TestAdapterEntry)
+ : TestAdapter.TestAdapterEntry =
+ { Id = r.Id
+ List = r.List
+ Name = r.Name
+ Type = r.Type
+ ModuleType = r.ModuleType
+ Range = fcsRangeToLsp r.Range
+ Childs = ResizeArray(r.Childs |> Seq.map map) }
+
+ do!
+ { File = Path.LocalPathToUri file
+ Tests = tests |> Array.map map }
+ |> lspClient.NotifyTestDetected
+ with ex ->
+ logger.error (
+ Log.setMessage "Exception while handling command event {evt}: {ex}"
+ >> Log.addContextDestructured "evt" n
+ >> Log.addContext "ex" ex.Message
+ )
+
+ ()
+ }
+ |> fun work -> Async.StartImmediate(work, ct)
+ with :? OperationCanceledException as e ->
+ ()
+
+
+ do
+ disposables.Add(
+ (notifications.Publish :> IObservable<_>)
+ // .BufferedDebounce(TimeSpan.FromMilliseconds(200.))
+ // .SelectMany(fun l -> l.Distinct())
+ .Subscribe(fun e -> handleCommandEvents e)
+ )
+
+ let getLastUTCChangeForFile (filePath: string) =
+ AdaptiveFile.GetLastWriteTimeUtc(UMX.untag filePath)
+ |> AVal.map (fun writeTime -> filePath, writeTime)
+
+ let readFileFromDisk lastTouched (file: string) =
+ async {
+ if File.Exists(UMX.untag file) then
+ use s = File.openFileStreamForReadingAsync file
+
+ let! source = sourceTextFactory.Create(file, s) |> Async.AwaitCancellableValueTask
+
+ return
+ { LastTouched = lastTouched
+ Source = source
+ Version = 0 }
+
+ else // When a user does "File -> New Text File -> Select a language -> F#" without saving, the file won't exist
+ return
+ { LastTouched = DateTime.UtcNow
+ Source = sourceTextFactory.Create(file, "")
+ Version = 0 }
+ }
+
+ let getLatestFileChange (filePath: string) =
+ asyncAVal {
+ let! (_, lastTouched) = getLastUTCChangeForFile filePath
+ return! readFileFromDisk lastTouched filePath
+ }
+
+ let addAValLogging cb (aval: aval<_>) =
+ let cb = aval.AddWeakMarkingCallback(cb)
+ aval |> AVal.mapDisposableTuple (fun x -> x, cb)
+
+ let projectFileChanges project (filePath: string) =
+ let file = getLastUTCChangeForFile filePath
+
+ let logMsg () =
+ logger.info (Log.setMessageI $"Loading {project:project} because of {filePath:filePath}")
+
+ file |> addAValLogging logMsg
+
+ let loader = cval workspaceLoader
+
+ let binlogConfig =
+ aval {
+ let! generateBinLog = config |> AVal.map (fun c -> c.GenerateBinlog)
+ and! rootPath = rootPath
+
+ match generateBinLog, rootPath with
+ | _, None
+ | false, _ -> return Ionide.ProjInfo.BinaryLogGeneration.Off
+ | true, Some rootPath ->
+ return Ionide.ProjInfo.BinaryLogGeneration.Within(DirectoryInfo(Path.Combine(rootPath, ".ionide")))
+ }
+
+ let workspacePaths: ChangeableValue =
+ cval WorkspaceChosen.NotChosen
+
+ let noopDisposable =
+ { new IDisposable with
+ member this.Dispose() : unit = () }
+
+ let adaptiveWorkspacePaths =
+ workspacePaths
+ |> AVal.map (fun wsp ->
+ match wsp with
+ | WorkspaceChosen.Projs projs ->
+ let projChanges =
+ projs
+ |> ASet.ofSeq
+ |> ASet.mapAtoAMap (UMX.untag >> AdaptiveFile.GetLastWriteTimeUtc)
+
+ let cb =
+ projChanges.AddCallback(fun old delta ->
+ logger.info (
+ Log.setMessage "Loading projects because of {delta}"
+ >> Log.addContextDestructured "delta" delta
+ ))
+
+ projChanges |> AdaptiveWorkspaceChosen.Projs, cb
+
+ | WorkspaceChosen.NotChosen -> AdaptiveWorkspaceChosen.NotChosen, noopDisposable
+
+ )
+ |> AVal.mapDisposableTuple (id)
+
+ let clientCapabilities = cval None
+
+ let glyphToCompletionKind =
+ clientCapabilities |> AVal.map (glyphToCompletionKindGenerator)
+
+ let glyphToSymbolKind = clientCapabilities |> AVal.map glyphToSymbolKindGenerator
+
+ let tryFindProp name (props: list) =
+ match props |> Seq.tryFind (fun x -> x.Name = name) with
+ | Some v -> v.Value |> Option.ofObj
+ | None -> None
+
+ let (|ProjectAssetsFile|_|) (props: list) = tryFindProp "ProjectAssetsFile" props
+
+ let (|BaseIntermediateOutputPath|_|) (props: list) = tryFindProp "BaseIntermediateOutputPath" props
+
+ let (|MSBuildAllProjects|_|) (props: list) =
+ tryFindProp "MSBuildAllProjects" props
+ |> Option.map (fun v -> v.Split(';', StringSplitOptions.RemoveEmptyEntries))
+
+ let loadedProjectOptions =
+ aval {
+ let! loader = loader
+ and! wsp = adaptiveWorkspacePaths
+
+ match wsp with
+ | AdaptiveWorkspaceChosen.NotChosen -> return []
+ | AdaptiveWorkspaceChosen.Projs projects ->
+ let! binlogConfig = binlogConfig
+
+ let! projectOptions =
+ projects
+ |> AMap.mapWithAdditionalDependencies (fun projects ->
+
+ projects
+ |> Seq.iter (fun (proj: string, _) ->
+ let not =
+ UMX.untag proj |> ProjectResponse.ProjectLoading |> NotificationEvent.Workspace
+
+ notifications.Trigger(not, CancellationToken.None))
+
+ use progressReport = new ServerProgressReport(lspClient)
+
+ progressReport.Begin ($"Loading {projects.Count} Projects") (CancellationToken.None)
+ |> ignore>
+
+ let projectOptions =
+ loader.LoadProjects(projects |> Seq.map (fst >> UMX.untag) |> Seq.toList, [], binlogConfig)
+ |> Seq.toList
+
+ for p in projectOptions do
+ logger.info (
+ Log.setMessage "Found BaseIntermediateOutputPath of {path}"
+ >> Log.addContextDestructured "path" p.Properties
+ )
+
+ // Collect other files that should trigger a reload of a project
+ let additionalDependencies (p: Types.ProjectOptions) =
+ [ let projectFileChanges = projectFileChanges p.ProjectFileName
+
+ match p.Properties with
+ | ProjectAssetsFile v -> yield projectFileChanges (UMX.tag v)
+ | _ -> ()
+
+ let objPath = (|BaseIntermediateOutputPath|_|) p.Properties
+
+ let isWithinObjFolder (file: string) =
+ match objPath with
+ | None -> true // if no obj folder provided assume we should track this file
+ | Some objPath -> file.Contains(objPath)
+
+ match p.Properties with
+ | MSBuildAllProjects v ->
+ yield!
+ v
+ |> Array.filter (fun x -> x.EndsWith(".props") && isWithinObjFolder x)
+ |> Array.map (UMX.tag >> projectFileChanges)
+ | _ -> () ]
+
+ HashMap.ofList
+ [ for p in projectOptions do
+ UMX.tag p.ProjectFileName, (p, additionalDependencies p) ]
+
+ )
+ |> AMap.toAVal
+ |> AVal.map HashMap.toValueList
+
+
+ and! checker = checker
+ checker.ClearCaches() // if we got new projects assume we're gonna need to clear caches
+
+ let options =
+ let fsharpOptions = projectOptions |> FCS.mapManyOptions |> Seq.toList
+
+ List.zip projectOptions fsharpOptions
+ |> List.map (fun (projectOption, fso) ->
+
+ let langversion = LanguageVersionShim.fromFSharpProjectOptions fso
+
+ // Set some default values as FCS uses these for identification/caching purposes
+ let fso =
+ { fso with
+ SourceFiles = fso.SourceFiles |> Array.map (Utils.normalizePath >> UMX.untag)
+ Stamp = fso.Stamp |> Option.orElse (Some DateTime.UtcNow.Ticks)
+ ProjectId = fso.ProjectId |> Option.orElse (Some(Guid.NewGuid().ToString())) }
+
+ { FSharpProjectOptions = fso
+ LanguageVersion = langversion },
+ projectOption)
+
+ options
+ |> List.iter (fun (loadedProject, projectOption) ->
+ let projectFileName = loadedProject.ProjectFileName
+ let projViewerItemsNormalized = ProjectViewer.render projectOption
+
+ let responseFiles =
+ projViewerItemsNormalized.Items
+ |> List.map (function
+ | ProjectViewerItem.Compile(p, c) -> ProjectViewerItem.Compile(Helpers.fullPathNormalized p, c))
+ |> List.choose (function
+ | ProjectViewerItem.Compile(p, _) -> Some p)
+
+ let references =
+ FscArguments.references (loadedProject.FSharpProjectOptions.OtherOptions |> List.ofArray)
+
+ logger.info (
+ Log.setMessage "ProjectLoaded {file}"
+ >> Log.addContextDestructured "file" projectFileName
+ )
+
+ let ws =
+ { ProjectFileName = projectFileName
+ ProjectFiles = responseFiles
+ OutFileOpt = Option.ofObj projectOption.TargetPath
+ References = references
+ Extra = projectOption
+ ProjectItems = projViewerItemsNormalized.Items
+ Additionals = Map.empty }
+
+ let not = ProjectResponse.Project(ws, false) |> NotificationEvent.Workspace
+ notifications.Trigger(not, CancellationToken.None))
+
+ let not = ProjectResponse.WorkspaceLoad true |> NotificationEvent.Workspace
+
+ notifications.Trigger(not, CancellationToken.None)
+
+ return options |> List.map fst
+ }
+
+ ///
+ /// Evaluates the adaptive value and returns its current value.
+ /// This should not be used inside the adaptive evaluation of other AdaptiveObjects since it does not track dependencies.
+ ///
+ /// A list of FSharpProjectOptions
+ let forceLoadProjects () = loadedProjectOptions |> AVal.force
+
+ do
+ // Reload Projects with some debouncing if `loadedProjectOptions` is out of date.
+ AVal.Observable.onOutOfDateWeak loadedProjectOptions
+ |> Observable.throttleOn Concurrency.NewThreadScheduler.Default (TimeSpan.FromMilliseconds(200.))
+ |> Observable.observeOn Concurrency.NewThreadScheduler.Default
+ |> Observable.subscribe (fun _ -> forceLoadProjects () |> ignore>)
+ |> disposables.Add
+
+
+ let sourceFileToProjectOptions =
+ aval {
+ let! options = loadedProjectOptions
+
+ return
+ options
+ |> List.collect (fun proj ->
+ proj.SourceFiles
+ |> Array.map (fun source -> Utils.normalizePath source, proj)
+ |> Array.toList)
+ |> List.groupByFst
+
+ }
+ |> AMap.ofAVal
+
+
+ let openFilesTokens =
+ ConcurrentDictionary, CancellationTokenSource>()
+
+ let tryGetOpenFileToken filePath =
+ match openFilesTokens.TryGetValue(filePath) with
+ | (true, v) -> Some v
+ | _ -> None
+
+ let openFiles = cmap, cval> ()
+ let openFilesReadOnly = openFiles |> AMap.map (fun _ x -> x :> aval<_>)
+
+ let textChanges =
+ cmap, cset> ()
+
+ let textChangesReadOnly = textChanges |> AMap.map (fun _ x -> x :> aset<_>)
+
+ let logTextChange (v: VolatileFile) =
+ logger.debug (
+ Log.setMessage "TextChanged for file : {fileName} {touched} {version}"
+ >> Log.addContextDestructured "fileName" v.FileName
+ >> Log.addContextDestructured "touched" v.LastTouched
+ >> Log.addContextDestructured "version" v.Version
+ )
+
+ let openFilesWithChanges: amap<_, aval> =
+ openFilesReadOnly
+ |> AMap.map (fun filePath file ->
+ aval {
+ let! file = file
+ and! changes = textChangesReadOnly |> AMap.tryFind filePath
+
+ match changes with
+ | None -> return file
+ | Some c ->
+ let! ps = c |> ASet.toAVal
+
+ let changes =
+ ps
+ |> Seq.sortBy (fun (x, _) -> x.TextDocument.Version)
+ |> Seq.collect (fun (p, touched) ->
+ p.ContentChanges |> Array.map (fun x -> x, p.TextDocument.Version, touched))
+
+ let file =
+ (file, changes)
+ ||> Seq.fold (fun text (change, version, touched) ->
+ match change.Range with
+ | None -> // replace entire content
+ VolatileFile.Create(sourceTextFactory.Create(filePath, change.Text), version, touched)
+ | Some rangeToReplace ->
+ // replace just this slice
+ let fcsRangeToReplace = protocolRangeToRange (UMX.untag filePath) rangeToReplace
+
+ try
+ match text.Source.ModifyText(fcsRangeToReplace, change.Text) with
+ | Ok text -> VolatileFile.Create(text, version, touched)
+
+ | Error message ->
+ logger.error (
+ Log.setMessage
+ "Error applying {change} to document {file} for version {version} - {range} : {message} "
+ >> Log.addContextDestructured "file" filePath
+ >> Log.addContextDestructured "version" version
+ >> Log.addContextDestructured "message" message
+ >> Log.addContextDestructured "range" fcsRangeToReplace
+ >> Log.addContextDestructured "change" change
+ )
+
+ text
+ with e ->
+ logger.error (
+ Log.setMessage "Error applying {change} to document {file} for version {version} - {range}"
+ >> Log.addContextDestructured "file" filePath
+ >> Log.addContextDestructured "range" fcsRangeToReplace
+ >> Log.addContextDestructured "version" version
+ >> Log.addContextDestructured "change" change
+ >> Log.addExn e
+ )
+
+ text)
+
+ logTextChange file
+ return file
+ })
+
+
+ let cancelToken filePath (cts: CancellationTokenSource) =
+
+ try
+ logger.info (
+ Log.setMessage "Cancelling {filePath} - {version}"
+ >> Log.addContextDestructured "filePath" filePath
+ // >> Log.addContextDestructured "version" oldFile.Version
+ )
+
+ cts.Cancel()
+ cts.Dispose()
+ with
+ | :? OperationCanceledException
+ | :? ObjectDisposedException as e when e.Message.Contains("CancellationTokenSource has been disposed") ->
+ // ignore if already cancelled
+ ()
+
+
+ let cachedFileContents = cmap, asyncaval> ()
+
+ let resetCancellationToken filePath =
+ let adder _ = new CancellationTokenSource()
+
+ let updater key value =
+ cancelToken filePath value
+ new CancellationTokenSource()
+
+ openFilesTokens.AddOrUpdate(filePath, adder, updater)
+ |> ignore
+
+
+ let updateOpenFiles (file: VolatileFile) =
+ let adder _ = cval file
+
+ let updater _ (v: cval<_>) = v.Value <- file
+
+ resetCancellationToken file.FileName
+ transact (fun () -> openFiles.AddOrElse(file.Source.FileName, adder, updater))
+
+ let updateTextChanges filePath p =
+ let adder _ = cset<_> [ p ]
+ let updater _ (v: cset<_>) = v.Add p |> ignore
+
+ resetCancellationToken filePath
+ transact (fun () -> textChanges.AddOrElse(filePath, adder, updater))
+
+ let isFileOpen file = openFiles |> AMap.tryFindA file |> AVal.map (Option.isSome)
+
+ let findFileInOpenFiles file = openFilesWithChanges |> AMap.tryFindA file
+
+ let forceFindOpenFile filePath = findFileInOpenFiles filePath |> AVal.force
+
+
+ let forceFindOpenFileOrRead file =
+ asyncOption {
+
+ match findFileInOpenFiles file |> AVal.force with
+ | Some s -> return s
+ | None ->
+ // TODO: Log how many times this kind area gets hit and possibly if this should be rethought
+ try
+ logger.debug (
+ Log.setMessage "forceFindOpenFileOrRead else - {file}"
+ >> Log.addContextDestructured "file" file
+ )
+
+ let lastTouched = File.getLastWriteTimeOrDefaultNow file
+
+ return! readFileFromDisk lastTouched file
+
+ with e ->
+ logger.warn (
+ Log.setMessage "Could not read file {file}"
+ >> Log.addContextDestructured "file" file
+ >> Log.addExn e
+ )
+
+ return! None
+ }
+ |> Async.map (Result.ofOption (fun () -> $"Could not read file: {file}"))
+
+ do
+ let fileshimChanges = openFilesWithChanges |> AMap.mapA (fun _ v -> v)
+ // let cachedFileContents = cachedFileContents |> cmap.mapA (fun _ v -> v)
+
+ let filesystemShim file =
+ // GetLastWriteTimeShim gets called _alot_ and when we do checks on save we use Async.Parallel for type checking.
+ // Adaptive uses lots of locks under the covers, so many threads can get blocked waiting for data.
+ // flattening openFilesWithChanges makes this check a lot quicker as it's not needing to recalculate each value.
+
+ fileshimChanges |> AMap.force |> HashMap.tryFind file
+
+ FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem <-
+ FileSystem(FSharp.Compiler.IO.FileSystemAutoOpens.FileSystem, filesystemShim)
+
+ /// Parses a source code for a file and caches the results. Returns an AST that can be traversed for various features.
+ /// The FSharpCompilerServiceChecker.
+ /// The source to be parsed.
+ /// Parsing options for the project or script
+ /// The options for the project or script.
+ ///
+ let parseFile (checker: FSharpCompilerServiceChecker) (source: VolatileFile) parseOpts options =
+ async {
+ let! result = checker.ParseFile(source.FileName, source.Source, parseOpts)
+
+ let! ct = Async.CancellationToken
+ fileParsed.Trigger(result, options, ct)
+ return result
+ }
+
+
+
+ /// Parses all files in the workspace. This is mostly used to trigger finding tests.
+ let parseAllFiles () =
+ asyncAVal {
+ let! projects = loadedProjectOptions
+ and! (checker: FSharpCompilerServiceChecker) = checker
+
+ return
+ projects
+ |> Array.ofList
+ |> Array.Parallel.collect (fun p ->
+ let parseOpts = Utils.projectOptionsToParseOptions p.FSharpProjectOptions
+ p.SourceFiles |> Array.Parallel.map (fun s -> p, parseOpts, s))
+ |> Array.Parallel.map (fun (opts, parseOpts, fileName) ->
+ let fileName = UMX.tag fileName
+
+ asyncResult {
+ let! file = forceFindOpenFileOrRead fileName
+ return! parseFile checker file parseOpts opts.FSharpProjectOptions
+ }
+ |> Async.map Result.toOption)
+ |> Async.parallel75
+ }
+
+ let forceFindSourceText filePath = forceFindOpenFileOrRead filePath |> AsyncResult.map (fun f -> f.Source)
+
+
+ let openFilesToChangesAndProjectOptions =
+ openFilesWithChanges
+ |> AMapAsync.mapAVal (fun filePath file ctok ->
+ asyncAVal {
+ if Utils.isAScript (UMX.untag filePath) then
+ let! (checker: FSharpCompilerServiceChecker) = checker
+ and! tfmConfig = tfmConfig
+
+ let! projs =
+ asyncOption {
+ let! cts = tryGetOpenFileToken filePath
+ use lcts = CancellationTokenSource.CreateLinkedTokenSource(ctok, cts.Token)
+
+ let! opts =
+ checker.GetProjectOptionsFromScript(filePath, file.Source, tfmConfig)
+ |> Async.withCancellation lcts.Token
+
+ opts |> scriptFileProjectOptions.Trigger
+
+ return
+ { FSharpProjectOptions = opts
+ LanguageVersion = LanguageVersionShim.fromFSharpProjectOptions opts }
+ }
+
+ return file, Option.toList projs
+ else
+ let! projs =
+ sourceFileToProjectOptions
+ |> AMap.tryFind filePath
+ |> AVal.map (Option.defaultValue [])
+
+ return file, projs
+ })
+
+ let allFSharpFilesAndProjectOptions =
+ let wins =
+ openFilesToChangesAndProjectOptions
+ |> AMap.map (fun k v -> v |> AsyncAVal.mapSync (fun (file, projects) _ -> Some file, projects))
+
+ let loses =
+ sourceFileToProjectOptions
+ |> AMap.map (fun filePath v ->
+ asyncAVal {
+ let! file = getLatestFileChange filePath
+ return (Some file, v)
+ })
+
+ AMap.union loses wins
+
+ let allFilesToFSharpProjectOptions =
+ allFSharpFilesAndProjectOptions
+ |> AMapAsync.mapAsyncAVal (fun filePath (file, options) ctok -> AsyncAVal.constant options)
+
+ let allFilesParsed =
+ allFSharpFilesAndProjectOptions
+ |> AMapAsync.mapAsyncAVal (fun filePath (file, options: LoadedProject list) ctok ->
+ asyncAVal {
+ let! (checker: FSharpCompilerServiceChecker) = checker
+
+ return!
+ asyncOption {
+ let! project = options |> selectProject
+ let options = project.FSharpProjectOptions
+ let parseOpts = Utils.projectOptionsToParseOptions project.FSharpProjectOptions
+ let! file = file
+ return! parseFile checker file parseOpts options
+ }
+
+ })
+
+ let getAllFilesToProjectOptions () =
+ allFilesToFSharpProjectOptions
+ // |> AMap.toASetValues
+ |> AMap.force
+ |> HashMap.toArray
+ |> Array.map (fun (sourceTextPath, projects) ->
+ async {
+ let! projs = AsyncAVal.forceAsync projects
+ return sourceTextPath, projs
+ })
+ |> Async.parallel75
+
+ let getAllFilesToProjectOptionsSelected () =
+ async {
+ let! set = getAllFilesToProjectOptions ()
+
+ return
+ set
+ |> Array.choose (fun (k, v) -> selectProject v |> Option.map (fun v -> k, v))
+ }
+
+ let getAllProjectOptions () =
+ async {
+ let! set =
+ allFilesToFSharpProjectOptions
+ |> AMap.toASetValues
+ |> ASet.force
+ |> HashSet.toArray
+ |> Array.map (AsyncAVal.forceAsync)
+ |> Async.parallel75
+
+ return set |> Array.collect (List.toArray)
+ }
+
+
+ let getAllFSharpProjectOptions () =
+ getAllProjectOptions ()
+ |> Async.map (Array.map (fun x -> x.FSharpProjectOptions))
+
+ let getProjectOptionsForFile (filePath: string) =
+ asyncAVal {
+ match! allFilesToFSharpProjectOptions |> AMapAsync.tryFindA filePath with
+ | Some projs -> return projs
+ | None -> return []
+ }
+
+ let autoCompleteItems
+ : cmap *
+ (Position -> option) *
+ FSharp.Compiler.Syntax.ParsedInput> =
+ cmap ()
+
+ let getAutoCompleteByDeclName name = autoCompleteItems |> AMap.tryFind name
+
+ let autoCompleteNamespaces =
+ autoCompleteItems
+ |> AMap.choose (fun name (d, pos, fn, getline, ast) ->
+
+ Commands.calculateNamespaceInsert (fun () -> Some ast) d pos getline)
+
+ let getAutoCompleteNamespacesByDeclName name = autoCompleteNamespaces |> AMap.tryFind name
+
+
+ /// Gets Parse and Check results of a given file while also handling other concerns like Progress, Logging, Eventing.
+ /// The FSharpCompilerServiceChecker.
+ /// The name of the file in the project whose source to find a typecheck.
+ /// The options for the project or script.
+ /// Determines if the typecheck should be cached for autocompletions.
+ ///
+ let parseAndCheckFile (checker: FSharpCompilerServiceChecker) (file: VolatileFile) options shouldCache =
+ async {
+ let tags =
+ [ SemanticConventions.fsac_sourceCodePath, box (UMX.untag file.Source.FileName)
+ SemanticConventions.projectFilePath, box (options.ProjectFileName) ]
+
+ use _ = fsacActivitySource.StartActivityForType(thisType, tags = tags)
+
+
+ logger.info (
+ Log.setMessage "Getting typecheck results for {file} - {hash} - {date}"
+ >> Log.addContextDestructured "file" file.Source.FileName
+ >> Log.addContextDestructured "hash" (file.Source.GetHashCode())
+ >> Log.addContextDestructured "date" (file.LastTouched)
+ )
+
+ let! ct = Async.CancellationToken
+
+ use progressReport = new ServerProgressReport(lspClient)
+
+ let simpleName = Path.GetFileName(UMX.untag file.Source.FileName)
+ do! progressReport.Begin($"Typechecking {simpleName}", message = $"{file.Source.FileName}")
+
+ let! result =
+ checker.ParseAndCheckFileInProject(
+ file.Source.FileName,
+ (file.Source.GetHashCode()),
+ file.Source,
+ options,
+ shouldCache = shouldCache
+ )
+ |> Debug.measureAsync $"checker.ParseAndCheckFileInProject - {file.Source.FileName}"
+
+ do! progressReport.End($"Typechecked {file.Source.FileName}")
+
+ notifications.Trigger(NotificationEvent.FileParsed(file.Source.FileName), ct)
+
+ match result with
+ | Error e ->
+ logger.error (
+ Log.setMessage "Typecheck failed for {file} with {error}"
+ >> Log.addContextDestructured "file" file.FileName
+ >> Log.addContextDestructured "error" e
+ )
+
+ return failwith e
+ | Ok parseAndCheck ->
+ logger.info (
+ Log.setMessage "Typecheck completed successfully for {file}"
+ >> Log.addContextDestructured "file" file.Source.FileName
+ )
+
+ Async.Start(
+ async {
+
+ fileParsed.Trigger(parseAndCheck.GetParseResults, options, ct)
+ fileChecked.Trigger(parseAndCheck, file, ct)
+ let checkErrors = parseAndCheck.GetParseResults.Diagnostics
+ let parseErrors = parseAndCheck.GetCheckResults.Diagnostics
+
+ let errors =
+ Array.append checkErrors parseErrors
+ |> Array.distinctBy (fun e ->
+ e.Severity, e.ErrorNumber, e.StartLine, e.StartColumn, e.EndLine, e.EndColumn, e.Message)
+
+ notifications.Trigger(NotificationEvent.ParseError(errors, file.Source.FileName, file.Version), ct)
+ },
+ ct
+ )
+
+
+ return parseAndCheck
+ }
+
+ /// Bypass Adaptive checking and tell the checker to check a file
+ let bypassAdaptiveTypeCheck (filePath: string) opts =
+ asyncResult {
+ try
+ logger.info (
+ Log.setMessage "Forced Check : {file}"
+ >> Log.addContextDestructured "file" filePath
+ )
+
+ let checker = checker |> AVal.force
+
+ let! fileInfo = forceFindOpenFileOrRead filePath
+ // Don't cache for autocompletions as we really only want to cache "Opened" files.
+ return! parseAndCheckFile checker fileInfo opts false
+
+ with e ->
+
+ logger.warn (
+ Log.setMessage "Forced Check error : {file}"
+ >> Log.addContextDestructured "file" filePath
+ >> Log.addExn e
+ )
+
+ return! Error(e.ToString())
+ }
+
+
+ let openFilesToRecentCheckedFilesResults =
+ openFilesToChangesAndProjectOptions
+ |> AMapAsync.mapAsyncAVal (fun _ (info, projectOptions) _ ->
+ asyncAVal {
+ let file = info.Source.FileName
+ let! checker = checker
+
+ return
+ option {
+ let! opts = selectProject projectOptions
+ return! checker.TryGetRecentCheckResultsForFile(file, opts.FSharpProjectOptions, info.Source)
+ }
+ })
+
+ let openFilesToCheckedFilesResults =
+ openFilesToChangesAndProjectOptions
+ |> AMapAsync.mapAsyncAVal (fun _ (info, projectOptions) ctok ->
+ asyncAVal {
+ let file = info.Source.FileName
+ let! checker = checker
+
+ return!
+ asyncOption {
+ let! opts = selectProject projectOptions
+ let! cts = tryGetOpenFileToken file
+ use lcts = CancellationTokenSource.CreateLinkedTokenSource(ctok, cts.Token)
+
+ return!
+ parseAndCheckFile checker info opts.FSharpProjectOptions true
+ |> Async.withCancellation lcts.Token
+ }
+
+ })
+
+ let getParseResults filePath = allFilesParsed |> AMapAsync.tryFindAndFlatten filePath
+
+ let getOpenFileTypeCheckResults filePath = openFilesToCheckedFilesResults |> AMapAsync.tryFindAndFlatten (filePath)
+
+ let getOpenFileRecentTypeCheckResults filePath =
+ openFilesToRecentCheckedFilesResults |> AMapAsync.tryFindAndFlatten (filePath)
+
+ let forceGetParseResults filePath =
+ async {
+ let! results = getParseResults filePath |> AsyncAVal.forceAsync
+ return results |> Result.ofOption (fun () -> $"No parse results for {filePath}")
+ }
+
+ let forceGetOpenFileRecentTypeCheckResults filePath =
+ async {
+ let! results = getOpenFileRecentTypeCheckResults filePath |> AsyncAVal.forceAsync
+ return results |> Result.ofOption (fun () -> $"No typecheck results for {filePath}")
+ }
+
+ let forceGetOpenFileTypeCheckResults (filePath: string) =
+ async {
+ let! results = getOpenFileTypeCheckResults (filePath) |> AsyncAVal.forceAsync
+ return results |> Result.ofOption (fun () -> $"No typecheck results for {filePath}")
+ }
+
+ ///
+ /// This will attempt to get typecheck results in this order
+ ///
+ /// 1. From our internal typecheck cache
+ /// 2. From checker.TryGetRecentCheckResultsForFile
+ /// 3. Failing both, will type check the file.
+ ///
+ /// Additionally, it will start typechecking the file in the background to force latest results on the next request.
+ ///
+ /// The name of the file in the project whose source to find a typecheck.
+ /// A Result of ParseAndCheckResults
+ let forceGetOpenFileTypeCheckResultsStale (filePath: string) =
+ asyncAVal {
+ let! (checker: FSharpCompilerServiceChecker) = checker
+
+ let inline tryGetLastCheckResultForFile filePath =
+ checker.TryGetLastCheckResultForFile(filePath)
+ |> Result.ofOption (fun () -> $"No typecheck results for {filePath}")
+ |> async.Return
+
+ return
+ tryGetLastCheckResultForFile filePath
+ |> AsyncResult.orElseWith (fun _ -> forceGetOpenFileRecentTypeCheckResults filePath)
+ |> AsyncResult.orElseWith (fun _ -> forceGetOpenFileTypeCheckResults filePath)
+ |> Async.map (fun r ->
+ Async.Start(
+ async {
+ // This needs to be in a try catch as it can throw on cancellation which causes the server to crash
+ try
+ do!
+ forceGetOpenFileTypeCheckResults filePath
+ |> Async.Ignore>
+ with e ->
+ ()
+ }
+ )
+
+ r)
+ }
+ |> AsyncAVal.forceAsync
+
+ let allFilesToDeclarations =
+ allFilesParsed
+ |> AMap.map (fun k v -> v |> AsyncAVal.mapOption (fun p _ -> p.GetNavigationItems().Declarations))
+
+ let getAllDeclarations () =
+ async {
+ let! results =
+ allFilesToDeclarations
+ |> AMap.force
+ |> HashMap.toArray
+ |> Array.map (fun (k, v) ->
+ async {
+ let! decls = AsyncAVal.forceAsync v
+ return Option.map (fun v -> k, v) decls
+ })
+ |> Async.parallel75
+
+ return results |> Array.Parallel.choose id
+
+ }
+
+ let getDeclarations filename = allFilesToDeclarations |> AMapAsync.tryFindAndFlatten filename
+
+
+ let forceGetProjectOptions filePath =
+ asyncAVal {
+ let! projects = getProjectOptionsForFile filePath
+ let project = selectProject projects
+
+ return
+ project
+ |> Result.ofOption (fun () -> $"Could not find project containing {filePath}")
+
+ }
+ |> AsyncAVal.forceAsync
+
+ let forceGetFSharpProjectOptions filePath =
+ forceGetProjectOptions filePath
+ |> Async.map (Result.map (fun p -> p.FSharpProjectOptions))
+
+ let codeGenServer =
+ { new ICodeGenerationService with
+ member x.TokenizeLine(file, i) =
+ asyncOption {
+ let! (text) = forceFindOpenFileOrRead file |> Async.map Option.ofResult
+
+ try
+ let! line = text.Source.GetLine(Position.mkPos i 0)
+ return Lexer.tokenizeLine [||] line
+ with _ ->
+ return! None
+ }
+
+ member x.GetSymbolAtPosition(file, pos) =
+ asyncOption {
+ try
+ let! (text) = forceFindOpenFileOrRead file |> Async.map Option.ofResult
+ let! line = tryGetLineStr pos text.Source |> Option.ofResult
+ return! Lexer.getSymbol pos.Line pos.Column line SymbolLookupKind.Fuzzy [||]
+ with _ ->
+ return! None
+ }
+
+ member x.GetSymbolAndUseAtPositionOfKind(fileName, pos, kind) =
+ asyncOption {
+ let! symbol = x.GetSymbolAtPosition(fileName, pos)
+
+ if symbol.Kind = kind then
+ let! (text) = forceFindOpenFileOrRead fileName |> Async.map Option.ofResult
+ let! line = tryGetLineStr pos text.Source |> Option.ofResult
+ let! tyRes = forceGetOpenFileTypeCheckResults fileName |> Async.map (Option.ofResult)
+ let symbolUse = tyRes.TryGetSymbolUse pos line
+ return! Some(symbol, symbolUse)
+ else
+ return! None
+ }
+
+ member x.ParseFileInProject(file) = forceGetParseResults file |> Async.map (Option.ofResult) }
+
+ let getDependentProjectsOfProjects ps =
+ let projectSnapshot = forceLoadProjects ()
+
+ let allDependents = System.Collections.Generic.HashSet()
+
+ let currentPass = ResizeArray()
+ currentPass.AddRange(ps |> List.map (fun p -> p.ProjectFileName))
+
+ let mutable continueAlong = true
+
+ while continueAlong do
+ let dependents =
+ projectSnapshot
+ |> Seq.filter (fun p ->
+ p.FSharpProjectOptions.ReferencedProjects
+ |> Seq.exists (fun r ->
+ match r.ProjectFilePath with
+ | None -> false
+ | Some p -> currentPass.Contains(p)))
+
+ if Seq.isEmpty dependents then
+ continueAlong <- false
+ currentPass.Clear()
+ else
+ for d in dependents do
+ allDependents.Add d.FSharpProjectOptions |> ignore
+
+ currentPass.Clear()
+ currentPass.AddRange(dependents |> Seq.map (fun p -> p.ProjectFileName))
+
+ Seq.toList allDependents
+
+ let getDeclarationLocation (symbolUse, text) =
+ let getProjectOptions file =
+ async {
+ let! projects = getProjectOptionsForFile file |> AsyncAVal.forceAsync
+
+ return
+ selectProject projects
+ |> Option.map (fun project -> project.FSharpProjectOptions)
+
+ }
+
+ let projectsThatContainFile file =
+ async {
+ let! projects = getProjectOptionsForFile file |> AsyncAVal.forceAsync
+ return projects |> List.map (fun p -> p.FSharpProjectOptions)
+ }
+
+ SymbolLocation.getDeclarationLocation (
+ symbolUse,
+ text,
+ getProjectOptions,
+ projectsThatContainFile,
+ getDependentProjectsOfProjects
+ )
+
+ let symbolUseWorkspace
+ (includeDeclarations: bool)
+ (includeBackticks: bool)
+ (errorOnFailureToFixRange: bool)
+ pos
+ lineStr
+ text
+ tyRes
+ =
+
+ let findReferencesForSymbolInFile (file: string, project, symbol) =
+ async {
+ let checker = checker |> AVal.force
+
+ if File.Exists(UMX.untag file) then
+ // `FSharpChecker.FindBackgroundReferencesInFile` only works with existing files
+ return! checker.FindReferencesForSymbolInFile(UMX.untag file, project, symbol)
+ else
+ // untitled script files
+ match! forceGetOpenFileTypeCheckResultsStale file with
+ | Error _ -> return Seq.empty
+ | Ok tyRes ->
+ let! ct = Async.CancellationToken
+ let usages = tyRes.GetCheckResults.GetUsesOfSymbolInFile(symbol, ct)
+ return usages |> Seq.map (fun u -> u.Range)
+ }
+
+ let tryGetProjectOptionsForFsproj (file: string) =
+ forceGetFSharpProjectOptions file |> Async.map Option.ofResult
+
+ Commands.symbolUseWorkspace
+ getDeclarationLocation
+ findReferencesForSymbolInFile
+ forceFindSourceText
+ tryGetProjectOptionsForFsproj
+ (getAllFSharpProjectOptions >> Async.map Array.toSeq)
+ includeDeclarations
+ includeBackticks
+ errorOnFailureToFixRange
+ pos
+ lineStr
+ text
+ tyRes
+
+
+ let codefixes =
+
+ let tryGetParseResultsForFile filePath pos =
+ asyncResult {
+ let! (file) = forceFindOpenFileOrRead filePath
+ let! lineStr = file.Source |> tryGetLineStr pos
+ and! tyRes = forceGetOpenFileTypeCheckResults filePath
+ return tyRes, lineStr, file.Source
+ }
+
+ let getRangeText fileName (range: Ionide.LanguageServerProtocol.Types.Range) =
+ asyncResult {
+ let! sourceText = forceFindSourceText fileName
+ return! sourceText.GetText(protocolRangeToRange (UMX.untag fileName) range)
+ }
+
+ let tryFindUnionDefinitionFromPos = tryFindUnionDefinitionFromPos codeGenServer
+
+ let getUnionPatternMatchCases tyRes pos sourceText line =
+ Commands.getUnionPatternMatchCases tryFindUnionDefinitionFromPos tyRes pos sourceText line
+
+ let unionCaseStubReplacements (config) () = Map.ofList [ "$1", config.UnionCaseStubGenerationBody ]
+
+
+ let implementInterfaceConfig config () : ImplementInterface.Config =
+ { ObjectIdentifier = config.InterfaceStubGenerationObjectIdentifier
+ MethodBody = config.InterfaceStubGenerationMethodBody
+ IndentationSize = config.IndentationSize }
+
+ let recordStubReplacements config () = Map.ofList [ "$1", config.RecordStubGenerationBody ]
+
+ let tryFindRecordDefinitionFromPos =
+ RecordStubGenerator.tryFindRecordDefinitionFromPos codeGenServer
+
+ let getRecordStub tyRes pos sourceText line =
+ Commands.getRecordStub (tryFindRecordDefinitionFromPos) tyRes pos sourceText line
+
+ let getLineText (sourceText: IFSACSourceText) (range: Ionide.LanguageServerProtocol.Types.Range) =
+ sourceText.GetText(protocolRangeToRange (UMX.untag sourceText.FileName) range)
+ |> Async.singleton
+
+ let abstractClassStubReplacements config () =
+ Map.ofList
+ [ "$objectIdent", config.AbstractClassStubGenerationObjectIdentifier
+ "$methodBody", config.AbstractClassStubGenerationMethodBody ]
+
+ let tryFindAbstractClassExprInBufferAtPos =
+ AbstractClassStubGenerator.tryFindAbstractClassExprInBufferAtPos codeGenServer
+
+ let writeAbstractClassStub =
+ AbstractClassStubGenerator.writeAbstractClassStub codeGenServer
+
+ let getAbstractClassStub tyRes objExprRange sourceText lineStr =
+ Commands.getAbstractClassStub
+ tryFindAbstractClassExprInBufferAtPos
+ writeAbstractClassStub
+ tyRes
+ objExprRange
+ sourceText
+ lineStr
+ |> AsyncResult.foldResult id id
+
+ let getLanguageVersion (file: string) =
+ async {
+ let! projectOptions = forceGetProjectOptions file
+
+ return
+ match projectOptions with
+ | Ok projectOptions -> projectOptions.LanguageVersion
+ | Error _ -> LanguageVersionShim.defaultLanguageVersion.Value
+ }
+
+ config
+ |> AVal.map (fun config ->
+ [| Run.ifEnabled (fun _ -> config.UnusedOpensAnalyzer) (RemoveUnusedOpens.fix forceFindSourceText)
+ Run.ifEnabled
+ (fun _ -> config.ResolveNamespaces)
+ (ResolveNamespace.fix tryGetParseResultsForFile Commands.getNamespaceSuggestions)
+ ReplaceWithSuggestion.fix
+ RemoveRedundantQualifier.fix
+ Run.ifEnabled (fun _ -> config.UnusedDeclarationsAnalyzer) (RenameUnusedValue.fix tryGetParseResultsForFile)
+ AddNewKeywordToDisposableConstructorInvocation.fix getRangeText
+ Run.ifEnabled
+ (fun _ -> config.UnionCaseStubGeneration)
+ (GenerateUnionCases.fix
+ forceFindSourceText
+ tryGetParseResultsForFile
+ getUnionPatternMatchCases
+ (unionCaseStubReplacements config))
+ ExternalSystemDiagnostics.linter
+ ExternalSystemDiagnostics.analyzers
+ Run.ifEnabled
+ (fun _ -> config.InterfaceStubGeneration)
+ (ImplementInterface.fix
+ tryGetParseResultsForFile
+ forceGetFSharpProjectOptions
+ (implementInterfaceConfig config))
+ Run.ifEnabled
+ (fun _ -> config.RecordStubGeneration)
+ (GenerateRecordStub.fix tryGetParseResultsForFile getRecordStub (recordStubReplacements config))
+ Run.ifEnabled
+ (fun _ -> config.AbstractClassStubGeneration)
+ (GenerateAbstractClassStub.fix
+ tryGetParseResultsForFile
+ getAbstractClassStub
+ (abstractClassStubReplacements config))
+ AddMissingEqualsToTypeDefinition.fix forceFindSourceText
+ ChangePrefixNegationToInfixSubtraction.fix forceFindSourceText
+ ConvertDoubleEqualsToSingleEquals.fix getRangeText
+ ChangeEqualsInFieldTypeToColon.fix
+ WrapExpressionInParentheses.fix getRangeText
+ ChangeRefCellDerefToNot.fix tryGetParseResultsForFile
+ ChangeDowncastToUpcast.fix getRangeText
+ MakeDeclarationMutable.fix tryGetParseResultsForFile forceGetFSharpProjectOptions
+ UseMutationWhenValueIsMutable.fix tryGetParseResultsForFile
+ ConvertInvalidRecordToAnonRecord.fix tryGetParseResultsForFile
+ RemoveUnnecessaryReturnOrYield.fix tryGetParseResultsForFile getLineText
+ ConvertCSharpLambdaToFSharpLambda.fix tryGetParseResultsForFile getLineText
+ AddMissingFunKeyword.fix forceFindSourceText getLineText
+ MakeOuterBindingRecursive.fix tryGetParseResultsForFile getLineText
+ AddMissingRecKeyword.fix forceFindSourceText getLineText
+ ConvertBangEqualsToInequality.fix getRangeText
+ ChangeDerefBangToValue.fix tryGetParseResultsForFile getLineText
+ RemoveUnusedBinding.fix tryGetParseResultsForFile
+ AddTypeToIndeterminateValue.fix tryGetParseResultsForFile forceGetFSharpProjectOptions
+ ChangeTypeOfNameToNameOf.fix tryGetParseResultsForFile
+ AddMissingInstanceMember.fix
+ AddMissingXmlDocumentation.fix tryGetParseResultsForFile
+ AddExplicitTypeAnnotation.fix tryGetParseResultsForFile
+ ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText
+ ConvertTripleSlashCommentToXmlTaggedDoc.fix tryGetParseResultsForFile getRangeText
+ GenerateXmlDocumentation.fix tryGetParseResultsForFile
+ RemoveRedundantAttributeSuffix.fix tryGetParseResultsForFile
+ Run.ifEnabled
+ (fun _ -> config.AddPrivateAccessModifier)
+ (AddPrivateAccessModifier.fix tryGetParseResultsForFile symbolUseWorkspace)
+ UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText
+ RenameParamToMatchSignature.fix tryGetParseResultsForFile
+ RemovePatternArgument.fix tryGetParseResultsForFile
+ ToInterpolatedString.fix tryGetParseResultsForFile getLanguageVersion
+ AdjustConstant.fix tryGetParseResultsForFile |])
+
+ let forgetDocument (uri: DocumentUri) =
+ async {
+ let filePath = uri |> Path.FileUriToLocalPath |> Utils.normalizePath
+
+ let doesNotExist (file: string) = not (File.Exists(UMX.untag file))
+
+ let isOutsideWorkspace (file: string) =
+ asyncAVal {
+ let! rootPath = rootPath
+
+ match rootPath with
+ | None -> return true // no root workspace specified
+ | Some rootPath ->
+ let rec isInside (rootDir: DirectoryInfo, dirToCheck: DirectoryInfo) =
+ if String.Equals(rootDir.FullName, dirToCheck.FullName, StringComparison.InvariantCultureIgnoreCase) then
+ true
+ else
+ match dirToCheck.Parent with
+ | null -> false
+ | parent -> isInside (rootDir, parent)
+
+ let rootDir = DirectoryInfo(rootPath)
+ let fileDir = FileInfo(UMX.untag file).Directory
+
+ if isInside (rootDir, fileDir) then
+ return false
+ else
+ let! projectOptions = getProjectOptionsForFile file
+
+ match projectOptions |> selectProject with
+ | None -> return true
+ | Some projectOptions ->
+ if doesNotExist (UMX.tag projectOptions.ProjectFileName) then
+ return true // script file
+ else
+ // issue: fs-file does never get removed from project options (-> requires reload of FSAC to register)
+ // -> don't know if file still part of project (file might have been removed from project)
+ // -> keep cache for file
+ return false
+ }
+
+ |> AsyncAVal.forceAsync
+
+ transact (fun () ->
+ openFiles.Remove filePath |> ignore
+
+ match openFilesTokens.TryRemove(filePath) with
+ | (true, cts) -> cancelToken filePath cts
+ | _ -> ()
+
+ textChanges.Remove filePath |> ignore)
+
+ let! isOutsideWorkspace = isOutsideWorkspace filePath
+
+ if doesNotExist filePath || isOutsideWorkspace then
+ logger.info (
+ Log.setMessage "Removing cached data for {file}."
+ >> Log.addContext "file" filePath
+ )
+
+ diagnosticCollections.ClearFor(uri)
+ else
+ logger.info (
+ Log.setMessage "File {file} exists inside workspace so diagnostics will not be cleared"
+ >> Log.addContext "file" filePath
+ )
+ }
+
+
+ let getDependentFilesForFile file =
+ async {
+ let! projects = getProjectOptionsForFile file |> AsyncAVal.forceAsync
+
+ return
+ projects
+ |> List.toArray
+ |> Array.collect (fun proj ->
+ logger.info (
+ Log.setMessage "Source Files: {sourceFiles}"
+ >> Log.addContextDestructured "sourceFiles" proj.SourceFiles
+ )
+
+ let idx = proj.SourceFiles |> Array.findIndex (fun x -> x = UMX.untag file)
+
+ proj.SourceFiles
+ |> Array.splitAt idx
+ |> snd
+ |> Array.map (fun sourceFile -> proj.FSharpProjectOptions, sourceFile))
+ |> Array.distinct
+ }
+
+
+ let bypassAdaptiveAndCheckDependenciesForFile (filePath: string) =
+ async {
+ let tags = [ SemanticConventions.fsac_sourceCodePath, box (UMX.untag filePath) ]
+ use _ = fsacActivitySource.StartActivityForType(thisType, tags = tags)
+ let! dependentFiles = getDependentFilesForFile filePath
+
+ let! projs = getProjectOptionsForFile filePath |> AsyncAVal.forceAsync
+
+ let dependentProjects =
+ projs
+ |> List.map (fun x -> x.FSharpProjectOptions)
+ |> getDependentProjectsOfProjects
+ |> List.toArray
+ |> Array.collect (fun proj -> proj.SourceFiles |> Array.map (fun sourceFile -> proj, sourceFile))
+
+ let mutable checksCompleted = 0
+
+ use progressReporter = new ServerProgressReport(lspClient)
+
+ let percentage numerator denominator =
+ if denominator = 0 then
+ 0u
+ else
+ ((float numerator) / (float denominator)) * 100.0 |> uint32
+
+ let checksToPerform =
+ let innerChecks =
+ Array.concat [| dependentFiles; dependentProjects |]
+ |> Array.filter (fun (_, file) ->
+ file.Contains "AssemblyInfo.fs" |> not
+ && file.Contains "AssemblyAttributes.fs" |> not)
+
+ let checksToPerformLength = innerChecks.Length
+
+ innerChecks
+ |> Array.map (fun (proj, file) ->
+ let file = UMX.tag file
+
+ let token =
+ tryGetOpenFileToken filePath
+ |> Option.map (fun cts -> cts.Token)
+ |> Option.defaultWith (fun () -> CancellationToken.None)
+
+ bypassAdaptiveTypeCheck (file) (proj)
+ |> Async.withCancellation token
+ |> Async.Ignore
+ |> Async.bind (fun _ ->
+ async {
+ let checksCompleted = Interlocked.Increment(&checksCompleted)
+
+ do!
+ progressReporter.Report(
+ message = $"{checksCompleted}/{checksToPerformLength} remaining",
+ percentage = percentage checksCompleted checksToPerformLength
+ )
+ }))
+
+
+ do!
+ progressReporter.Begin(
+ "Typechecking Dependent F# files",
+ message = $"0/{checksToPerform.Length} remaining",
+ percentage = percentage 0 checksToPerform.Length
+ )
+
+ do! checksToPerform |> Async.parallel75 |> Async.Ignore
+
+ }
+
+
+ member x.RootPath
+ with get () = AVal.force rootPath
+ and set v = transact (fun () -> rootPath.Value <- v)
+
+ member x.Config
+ with get () = AVal.force config
+ and set v = transact (fun () -> config.Value <- v)
+
+ member x.LoadAnalyzers() =
+ transact
+ <| fun () ->
+ config.MarkOutdated()
+ x.Config <- config.Value
+
+ member x.ClientCapabilities
+ with get () = AVal.force clientCapabilities
+ and set v = transact (fun () -> clientCapabilities.Value <- v)
+
+ member x.WorkspacePaths
+ with get () = AVal.force workspacePaths
+ and set v = transact (fun () -> workspacePaths.Value <- v)
+
+ member x.DiagnosticCollections = diagnosticCollections
+
+ member x.ScriptFileProjectOptions = scriptFileProjectOptions
+
+ member x.OpenDocument(filePath, text: string, version) =
+ cancellableTask {
+ if isFileOpen filePath |> AVal.force then
+ return ()
+ else
+ // We want to try to use the file system's datetime if available
+ let file = VolatileFile.Create(sourceTextFactory.Create(filePath, text), version)
+
+ updateOpenFiles file
+
+ do!
+ forceGetOpenFileTypeCheckResults filePath
+ |> Async.Ignore>
+
+ return ()
+ }
+
+ member x.ChangeDocument(filePath, p: DidChangeTextDocumentParams) =
+ cancellableTask {
+ updateTextChanges filePath (p, DateTime.UtcNow)
+
+ do!
+ forceGetOpenFileTypeCheckResults filePath
+ |> Async.Ignore>
+ }
+
+ member x.SaveDocument(filePath: string, text: string option) =
+ cancellableTask {
+ let file =
+ option {
+ let! oldFile = forceFindOpenFile filePath
+
+ let oldFile =
+ text
+ |> Option.map (fun t -> sourceTextFactory.Create(oldFile.FileName, t))
+ |> Option.map (oldFile.SetSource)
+ |> Option.defaultValue oldFile
+
+ return oldFile.UpdateTouched()
+ }
+ |> Option.defaultWith (fun () ->
+ // Very unlikely to get here
+ VolatileFile.Create(sourceTextFactory.Create(filePath, text.Value), 0))
+
+ transact (fun () ->
+ updateOpenFiles file
+ textChanges.Remove filePath |> ignore)
+
+ let! _ = forceGetOpenFileTypeCheckResults filePath
+ do! bypassAdaptiveAndCheckDependenciesForFile filePath
+ }
+
+
+
+ member x.ForgetDocument(filePath) = forgetDocument filePath
+
+ member x.ParseAllFiles() = parseAllFiles () |> AsyncAVal.forceAsync
+
+ member x.GetOpenFile(filePath) = forceFindOpenFile filePath
+
+ member x.GetOpenFileSource(filePath) = forceFindSourceText filePath
+
+ member x.GetOpenFileOrRead(filePath) = forceFindOpenFileOrRead filePath
+
+ member x.GetParseResults filePath = forceGetParseResults filePath
+
+ member x.GetOpenFileTypeCheckResults(file) = forceGetOpenFileTypeCheckResults file
+
+ member x.GetOpenFileTypeCheckResultsCached(filePath) = forceGetOpenFileTypeCheckResultsStale filePath
+
+ member x.GetProjectOptionsForFile(filePath) = forceGetFSharpProjectOptions filePath
+
+ member x.GetTypeCheckResultsForFile(filePath, opts) = bypassAdaptiveTypeCheck filePath opts
+
+ member x.GetTypeCheckResultsForFile(filePath) =
+ asyncResult {
+ let! opts = forceGetProjectOptions filePath
+ return! x.GetTypeCheckResultsForFile(filePath, opts)
+ }
+
+ member x.GetFilesToProject() = getAllFilesToProjectOptionsSelected ()
+
+ member x.GetUsesOfSymbol(filePath, opts, symbol) = (AVal.force checker).GetUsesOfSymbol(filePath, opts, symbol)
+
+ member x.Codefixes = codefixes |> AVal.force
+
+ member x.GlyphToCompletionKind = glyphToCompletionKind |> AVal.force
+
+ member x.UpdateAutocompleteItems(items: list<_ * _>) =
+ transact (fun () -> autoCompleteItems.UpdateTo(HashMap.OfList(items)))
+
+ member x.GetAutoCompleteByDeclName declName = getAutoCompleteByDeclName declName |> AVal.force
+
+ member x.GetAutoCompleteNamespacesByDeclName declName = getAutoCompleteNamespacesByDeclName declName |> AVal.force
+
+ member x.SymbolUseWorkspace
+ (
+ includeDeclarations,
+ includeBackticks,
+ errorOnFailureToFixRange,
+ pos,
+ lineStr,
+ text,
+ tyRes
+ ) =
+ symbolUseWorkspace includeDeclarations includeBackticks errorOnFailureToFixRange pos lineStr text tyRes
+
+ member x.GetDeclarationLocation(symbolUse, text) = getDeclarationLocation (symbolUse, text)
+
+ member x.GetDeclarations(filename) = getDeclarations filename |> AsyncAVal.forceAsync
+
+ member x.GetAllDeclarations() = getAllDeclarations ()
+
+ member x.GlyphToSymbolKind = glyphToSymbolKind |> AVal.force
+
+ interface IDisposable with
+ member this.Dispose() =
+
+ traceNotifications |> Option.iter (dispose)
+ disposables.Dispose()
diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi b/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi
new file mode 100644
index 000000000..53280cdc4
--- /dev/null
+++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi
@@ -0,0 +1,121 @@
+namespace FsAutoComplete.Lsp
+
+open System
+open FsAutoComplete
+open FsAutoComplete.CodeFix
+open FsAutoComplete.Logging
+open Ionide.LanguageServerProtocol
+open Ionide.LanguageServerProtocol.Types
+
+open FsAutoComplete.LspHelpers
+open FSharp.UMX
+open FSharp.Compiler.Text
+open FSharp.Compiler.EditorServices
+open FSharp.Data.Adaptive
+open Ionide.ProjInfo
+open FSharp.Compiler.CodeAnalysis
+open IcedTasks
+open FsAutoComplete.FCSPatches
+open FsAutoComplete.Lsp
+
+[]
+type WorkspaceChosen =
+ | Projs of HashSet>
+ | NotChosen
+
+[]
+type AdaptiveWorkspaceChosen =
+ | Projs of amap, DateTime>
+ | NotChosen
+
+[]
+type LoadedProject =
+ { FSharpProjectOptions: FSharpProjectOptions
+ LanguageVersion: LanguageVersionShim }
+
+ interface IEquatable
+ override GetHashCode: unit -> int
+ override Equals: other: obj -> bool
+ member SourceFiles: string array
+ member ProjectFileName: string
+ static member op_Implicit: x: LoadedProject -> FSharpProjectOptions
+
+type AdaptiveState =
+ new:
+ lspClient: FSharpLspClient * sourceTextFactory: ISourceTextFactory * workspaceLoader: IWorkspaceLoader ->
+ AdaptiveState
+
+ member RootPath: string option with get, set
+ member Config: FSharpConfig with get, set
+ member LoadAnalyzers: unit -> unit
+ member ClientCapabilities: ClientCapabilities option with get, set
+ member WorkspacePaths: WorkspaceChosen with get, set
+ member DiagnosticCollections: DiagnosticCollection
+ member ScriptFileProjectOptions: Event
+
+
+ member OpenDocument: filePath: string * text: string * version: int -> CancellableTask
+ member ChangeDocument: filePath: string * p: DidChangeTextDocumentParams -> CancellableTask
+ member SaveDocument: filePath: string * text: string option -> CancellableTask
+ member ForgetDocument: filePath: DocumentUri -> Async
+ member ParseAllFiles: unit -> Async
+ member GetOpenFile: filePath: string -> VolatileFile option
+ member GetOpenFileSource: filePath: string -> Async>
+ member GetOpenFileOrRead: filePath: string -> Async>
+ member GetParseResults: filePath: string -> Async>
+ member GetOpenFileTypeCheckResults: file: string -> Async>
+ member GetOpenFileTypeCheckResultsCached: filePath: string -> Async>
+ member GetProjectOptionsForFile: filePath: string -> Async>
+
+ member GetTypeCheckResultsForFile:
+ filePath: string * opts: FSharpProjectOptions -> Async>
+
+ member GetTypeCheckResultsForFile: filePath: string -> Async>
+ member GetFilesToProject: unit -> Async<(string * LoadedProject) array>
+
+ member GetUsesOfSymbol:
+ filePath: string *
+ opts: (string * FSharpProjectOptions) seq *
+ symbol: FSharp.Compiler.Symbols.FSharpSymbol ->
+ Async
+
+ member Codefixes: (CodeActionParams -> Async>) array
+ member GlyphToCompletionKind: (FSharpGlyph -> Types.CompletionItemKind option)
+
+ member UpdateAutocompleteItems:
+ items:
+ (DeclName *
+ (DeclarationListItem *
+ Position *
+ string *
+ (Position -> string option) *
+ FSharp.Compiler.Syntax.ParsedInput)) list ->
+ bool
+
+ member GetAutoCompleteByDeclName:
+ declName: DeclName ->
+ (DeclarationListItem *
+ Position *
+ string *
+ (Position -> string option) *
+ FSharp.Compiler.Syntax.ParsedInput) option
+
+ member GetAutoCompleteNamespacesByDeclName: declName: DeclName -> CompletionNamespaceInsert option
+
+ member SymbolUseWorkspace:
+ includeDeclarations: bool *
+ includeBackticks: bool *
+ errorOnFailureToFixRange: bool *
+ pos: Position *
+ lineStr: LineStr *
+ text: IFSACSourceText *
+ tyRes: ParseAndCheckResults ->
+ Async, Range array>, string>>
+
+ member GetDeclarationLocation:
+ symbolUse: FSharpSymbolUse * text: IFSACSourceText -> Async>
+
+ member GetDeclarations: filename: string -> Async
+ member GetAllDeclarations: unit -> Async<(string * NavigationTopLevelDeclaration array) array>
+ member GlyphToSymbolKind: (FSharpGlyph -> SymbolKind option)
+ interface IDisposable
diff --git a/src/FsAutoComplete/LspServers/Common.fs b/src/FsAutoComplete/LspServers/Common.fs
index ded94ace4..b0dc991d9 100644
--- a/src/FsAutoComplete/LspServers/Common.fs
+++ b/src/FsAutoComplete/LspServers/Common.fs
@@ -185,6 +185,11 @@ module Helpers =
let notImplemented<'t> = async.Return LspResult.notImplemented<'t>
let ignoreNotification = async.Return(())
+ let tryGetLineStr pos (text: IFSACSourceText) =
+ text.GetLine(pos)
+ |> Result.ofOption (fun () -> $"No line in {text.FileName} at position {pos}")
+
+
let fullPathNormalized = Path.GetFullPath >> Utils.normalizePath >> UMX.untag
let defaultServerCapabilities =
diff --git a/src/FsAutoComplete/LspServers/FSharpLspClient.fs b/src/FsAutoComplete/LspServers/FSharpLspClient.fs
index fe05c265e..ccfbc89fe 100644
--- a/src/FsAutoComplete/LspServers/FSharpLspClient.fs
+++ b/src/FsAutoComplete/LspServers/FSharpLspClient.fs
@@ -233,8 +233,8 @@ type ProgressListener(lspClient: FSharpLspClient, traceNamespace: string array)
async {
while not isDisposed do
for (a, p) in inflightEvents.Values do
- // We don't get always get a corresponding ActivityStopped for a given Activity event so this looks at anything that hasn't had a duration incresed at all
- // We don't seem to get a corresponding ActivityStopped on cancelled typechecks.
+ // We don't get always get a corresponding ActivityStopped for a given Activity event so this looks at anything that hasn't had a duration increased at all
+ // We don't seem to get a corresponding ActivityStopped on cancelled type-checks.
if isStopped a then
do! p.End()
inflightEvents.TryRemove(a.Id) |> ignore