Many tweaks to AdaptiveLSPServer for performance

src/FsAutoComplete.Core/FileSystem.fs

@@ -355,6 +355,54 @@ type VolatileFile =
     Lines: NamedText
     Version: int option }
 
+  /// <summary>Updates the Lines value</summary>
+  member this.SetLines(lines) = { this with Lines = lines }
+
+  /// <summary>Updates the Lines value with supplied text</summary>
+  member this.SetText(text) =
+    this.SetLines(NamedText(this.Lines.FileName, text))
+
+
+  /// <summary>Updates the Touched value</summary>
+  member this.SetTouched touched = { this with Touched = touched }
+
+
+  /// <summary>Updates the Touched value attempting to use the file on disk's GetLastWriteTimeUtc otherwise uses DateTime.UtcNow. </summary>
+  member this.UpdateTouched() =
+    let path = UMX.untag this.Lines.FileName
+
+    let dt =
+      if File.Exists path then
+        File.GetLastWriteTimeUtc path
+      else
+        DateTime.UtcNow
+
+    this.SetTouched dt
+
+
+  /// <summary>Helper method to create a VolatileFile</summary>
+  static member Create(lines, version, touched) =
+    { Lines = lines
+      Version = version
+      Touched = touched }
+
+  /// <summary>Helper method to create a VolatileFile</summary>
+  static member Create(path, text, version, touched) =
+    VolatileFile.Create(NamedText(path, text), version, touched)
+
+  /// <summary>Helper method to create a VolatileFile, attempting to use the file on disk's GetLastWriteTimeUtc otherwise uses DateTime.UtcNow.</summary>
+  static member Create(path: string<LocalPath>, text, version) =
+    let touched =
+      let path = UMX.untag path
+
+      if File.Exists path then
+        File.GetLastWriteTimeUtc path
+      else
+        DateTime.UtcNow
+
+    VolatileFile.Create(path, text, version, touched)
+
+
 type FileSystem(actualFs: IFileSystem, tryFindFile: string<LocalPath> -> VolatileFile option) =
   let fsLogger = LogProvider.getLoggerByName "FileSystem"
 
@@ -412,7 +460,7 @@ type FileSystem(actualFs: IFileSystem, tryFindFile: string<LocalPath> -> Volatil
       |> Utils.normalizePath
       |> tryFindFile
       |> Option.map (fun f -> f.Touched)
-      |> Option.defaultValue DateTime.MinValue
+      |> Option.defaultWith (fun () -> actualFs.GetLastWriteTimeShim f)
 
     member _.NormalizePathShim(f: string) = f |> Utils.normalizePath |> UMX.untag
 

src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs

@@ -105,7 +105,7 @@ module AVal =
   /// <summary>
   /// Calls a mapping function which creates additional dependencies to be tracked.
   /// </summary>
-  let mapWithAdditionalDependenies (mapping: 'a -> 'b * list<IAdaptiveValue>) (value: aval<'a>) : aval<'b> =
+  let mapWithAdditionalDependenies (mapping: 'a -> 'b * list<#IAdaptiveValue>) (value: aval<'a>) : aval<'b> =
     let mutable lastDeps = HashSet.empty
 
     { new AVal.AbstractVal<'b>() with
@@ -247,7 +247,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
           | NotificationEvent.FileParsed fn ->
             let uri = Path.LocalPathToUri fn
 
-            do! lspClient.CodeLensRefresh()
             do! ({ Content = UMX.untag uri }: PlainNotification) |> lspClient.NotifyFileParsed
           | NotificationEvent.Workspace ws ->
 
@@ -506,8 +505,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
   let glyphToSymbolKind = clientCapabilities |> AVal.map glyphToSymbolKindGenerator
 
-
-
   let loadedProjectOptions =
     (loader, adaptiveWorkspacePaths)
     ||> AVal.bind2 (fun loader wsp ->
@@ -521,7 +518,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
             projects
             |> AVal.mapWithAdditionalDependenies (fun projects ->
 
-
               projects
               |> Seq.iter (fun (proj: string<LocalPath>, _) ->
                 UMX.untag proj
@@ -563,8 +559,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
                         |> Array.filter (fun x -> x.EndsWith(".props") && isWithinObjFolder x)
                         |> Array.map (UMX.tag >> adaptiveFile)
                     | None -> () ]
-                |> Seq.cast<IAdaptiveValue>
-                |> Seq.toList
 
               projectOptions, additionalDependencies)
 
@@ -624,6 +618,16 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
   let openFilesA = openFiles |> AMap.map' (fun v -> v :> aval<_>)
 
+  let cancelAllOpenFileCheckRequests () =
+    transact (fun () ->
+      let files = openFiles |> AMap.force
+
+      for (_, fileVal) in files do
+        let (oldFile, cts: CancellationTokenSource) = fileVal |> AVal.force
+        cts.Cancel()
+        cts.Dispose()
+        fileVal.Value <- oldFile, new CancellationTokenSource())
+
   let updateOpenFiles (file: VolatileFile) =
 
     let adder _ =
@@ -637,12 +641,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
     transact (fun () -> openFiles.AddOrElse(file.Lines.FileName, adder, updater))
 
-
-  let volaTileFile path text version lastWriteTime =
-    { Touched = lastWriteTime
-      Lines = NamedText(path, text)
-      Version = version }
-
   let findFileInOpenFiles file = openFilesA |> AMap.tryFindA file
 
   let forceFindOpenFileOrRead file =
@@ -816,8 +814,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
           >> Log.addContextDestructured "file" file.Lines.FileName
         )
 
-        analyzeFile config (file.Lines.FileName, file.Version, file.Lines, parseAndCheck)
-        |> Async.Start
 
         let checkErrors = parseAndCheck.GetParseResults.Diagnostics
         let parseErrors = parseAndCheck.GetCheckResults.Diagnostics
@@ -827,9 +823,11 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
           |> Array.distinctBy (fun e ->
             e.Severity, e.ErrorNumber, e.StartLine, e.StartColumn, e.EndLine, e.EndColumn, e.Message)
 
-        let uri = Path.LocalPathToUri(file.Lines.FileName)
-        let diags = errors |> Array.map fcsErrorToDiagnostic
-        diagnosticCollections.SetFor(uri, "F# Compiler", diags)
+        NotificationEvent.ParseError(errors, file.Lines.FileName)
+        |> notifications.Trigger
+
+
+        do! analyzeFile config (file.Lines.FileName, file.Version, file.Lines, parseAndCheck)
 
         // LargeObjectHeap gets fragmented easily for really large files, which F# can easily have.
         // Yes this seems excessive doing this every time we type check but it's the best current kludge.
@@ -843,9 +841,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
     }
 
   /// Bypass Adaptive checking and tell the checker to check a file
-  let forceTypeCheck checker f =
+  let forceTypeCheck f =
     async {
       logger.info (Log.setMessage "Forced Check : {file}" >> Log.addContextDestructured "file" f)
+      let checker = checker |> AVal.force
       let config = config |> AVal.force
 
       match findFileInOpenFiles f |> AVal.force, getProjectOptionsForFile f |> AVal.force |> List.tryHead with
@@ -1548,16 +1547,10 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
           let doc = p.TextDocument
           let filePath = doc.GetFilePath() |> Utils.normalizePath
-          let file = volaTileFile filePath doc.Text (Some doc.Version) DateTime.UtcNow
+          // We want to try to use the file system's datetime if available
+          let file = VolatileFile.Create(filePath, doc.Text, (Some doc.Version))
           updateOpenFiles file
-
-          Async.Start(
-            async {
-              do! Async.Sleep 100
-              forceGetTypeCheckResults filePath |> ignore
-            }
-          )
-
+          forceGetTypeCheckResults filePath |> ignore
           return ()
         with e ->
           logger.error (
@@ -1603,17 +1596,13 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
           let changes = p.ContentChanges |> Array.head
 
+          // We want to update the DateTime here since TextDocumentDidChange will not have changes reflected on disk
+          // TODO: Incremental changes
           let file =
-            volaTileFile filePath changes.Text (p.TextDocument.Version) DateTime.UtcNow
+            VolatileFile.Create(filePath, changes.Text, p.TextDocument.Version, DateTime.UtcNow)
 
           updateOpenFiles file
-
-          Async.Start(
-            async {
-              do! Async.Sleep 100
-              forceGetTypeCheckResults filePath |> ignore
-            }
-          )
+          forceGetTypeCheckResults filePath |> ignore
 
           return ()
         with e ->
@@ -1637,7 +1626,16 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
           let doc = p.TextDocument
           let filePath = doc.GetFilePath() |> Utils.normalizePath
-          let file = volaTileFile filePath p.Text.Value None DateTime.UtcNow
+
+          let file =
+            option {
+              let! oldFile = forceFindOpenFile filePath
+              let oldFile = p.Text |> Option.map (oldFile.SetText) |> Option.defaultValue oldFile
+              return oldFile.UpdateTouched()
+            }
+            |> Option.defaultWith (fun () ->
+              // Very unlikely to get here
+              VolatileFile.Create(filePath, p.Text.Value, None, DateTime.UtcNow))
 
           updateOpenFiles file
           let knownFiles = openFilesA |> AMap.force
@@ -1647,16 +1645,18 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
             >> Log.addContextDestructured "files" knownFiles
           )
 
-          let checker = (AVal.force checker)
+          cancelAllOpenFileCheckRequests ()
 
           for (file, aFile) in knownFiles do
             let (_, cts) = aFile |> AVal.force
 
             do!
-              forceTypeCheck checker file
+              forceTypeCheck file
               |> Async.withCancellationSafe (fun () -> cts.Token)
               |> Async.Ignore<unit option>
 
+          do! lspClient.CodeLensRefresh()
+
           return ()
         with e ->
           logger.error (
@@ -1665,7 +1665,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
             >> Log.addExn e
           )
 
-
         return ()
       }
 

src/FsAutoComplete/LspServers/Common.fs

@@ -188,7 +188,9 @@ module ObservableExtensions =
 
     /// Fires an event only after the specified interval has passed in which no other pending event has fired. Buffers all events leading up to that emit.
     member x.BufferedDebounce(ts: TimeSpan) =
-      x.Publish(fun shared -> shared.Window(shared.Throttle(ts)))
+      x
+        .Publish(fun shared -> shared.Window(shared.Throttle(ts)))
+        .SelectMany(fun l -> l.ToList())
 
 module Helpers =
   let notImplemented<'t> = async.Return LspResult.notImplemented<'t>