use mailbox processors per-file to serialize diagnostics pushes

.github/workflows/build.yml

@@ -8,7 +8,7 @@ jobs:
     strategy:
       matrix:
         os: [windows-2019, macos-10.15, ubuntu-20.04]
-        dotnet: [5.0.300]
+        dotnet: [5.0.301]
       fail-fast: false # we have timing issues on some OS, so we want them all to run
 
     runs-on: ${{ matrix.os }}

.github/workflows/release.yml

@@ -16,7 +16,7 @@ jobs:
   release:
     strategy:
       matrix:
-        dotnet: [5.0.300]
+        dotnet: [5.0.301]
 
     runs-on: ubuntu-20.04
 

.paket/Paket.Restore.targets

@@ -289,14 +289,16 @@
     <PropertyGroup>
       <PaketProjectFile>$(MSBuildProjectDirectory)/$(MSBuildProjectFile)</PaketProjectFile>
       <ContinuePackingAfterGeneratingNuspec>true</ContinuePackingAfterGeneratingNuspec>
+      <UseMSBuild16_10_Pack>false</UseMSBuild16_10_Pack>
+      <UseMSBuild16_10_Pack Condition=" '@(MSBuildMajorVersion)' >= '16' AND '@(MSBuildMinorVersion)' > '10' ">true</UseMSBuild16_10_Pack>
       <UseMSBuild16_0_Pack>false</UseMSBuild16_0_Pack>
-      <UseMSBuild16_0_Pack Condition=" '@(MSBuildMajorVersion)' >= '16' ">true</UseMSBuild16_0_Pack>
+      <UseMSBuild16_0_Pack Condition=" '@(MSBuildMajorVersion)' >= '16' AND (! $(UseMSBuild16_10_Pack)) ">true</UseMSBuild16_0_Pack>
       <UseMSBuild15_9_Pack>false</UseMSBuild15_9_Pack>
       <UseMSBuild15_9_Pack Condition=" '@(MSBuildMajorVersion)' == '15' AND '@(MSBuildMinorVersion)' > '8' ">true</UseMSBuild15_9_Pack>
       <UseMSBuild15_8_Pack>false</UseMSBuild15_8_Pack>
-      <UseMSBuild15_8_Pack Condition=" '$(NuGetToolVersion)' != '4.0.0' AND (! $(UseMSBuild15_9_Pack)) AND (! $(UseMSBuild16_0_Pack)) ">true</UseMSBuild15_8_Pack>
+      <UseMSBuild15_8_Pack Condition=" '$(NuGetToolVersion)' != '4.0.0' AND (! $(UseMSBuild15_9_Pack)) AND (! $(UseMSBuild16_0_Pack)) AND (! $(UseMSBuild16_10_Pack)) ">true</UseMSBuild15_8_Pack>
       <UseNuGet4_Pack>false</UseNuGet4_Pack>
-      <UseNuGet4_Pack Condition=" (! $(UseMSBuild15_8_Pack)) AND (! $(UseMSBuild15_9_Pack)) AND (! $(UseMSBuild16_0_Pack)) ">true</UseNuGet4_Pack>
+      <UseNuGet4_Pack Condition=" (! $(UseMSBuild15_8_Pack)) AND (! $(UseMSBuild15_9_Pack)) AND (! $(UseMSBuild16_0_Pack)) AND (! $(UseMSBuild16_10_Pack)) ">true</UseNuGet4_Pack>
       <AdjustedNuspecOutputPath>$(PaketIntermediateOutputPath)\$(Configuration)</AdjustedNuspecOutputPath>
       <AdjustedNuspecOutputPath Condition="@(_NuspecFilesNewLocation) == ''">$(PaketIntermediateOutputPath)</AdjustedNuspecOutputPath>
     </PropertyGroup>
@@ -314,6 +316,53 @@
     </ConvertToAbsolutePath>
 
     <!-- Call Pack -->
+    <PackTask Condition="$(UseMSBuild16_10_Pack)"
+              PackItem="$(PackProjectInputFile)"
+              PackageFiles="@(_PackageFiles)"
+              PackageFilesToExclude="@(_PackageFilesToExclude)"
+              PackageVersion="$(PackageVersion)"
+              PackageId="$(PackageId)"
+              Title="$(Title)"
+              Authors="$(Authors)"
+              Description="$(Description)"
+              Copyright="$(Copyright)"
+              RequireLicenseAcceptance="$(PackageRequireLicenseAcceptance)"
+              LicenseUrl="$(PackageLicenseUrl)"
+              ProjectUrl="$(PackageProjectUrl)"
+              IconUrl="$(PackageIconUrl)"
+              ReleaseNotes="$(PackageReleaseNotes)"
+              Tags="$(PackageTags)"
+              DevelopmentDependency="$(DevelopmentDependency)"
+              BuildOutputInPackage="@(_BuildOutputInPackage)"
+              TargetPathsToSymbols="@(_TargetPathsToSymbols)"
+              SymbolPackageFormat="$(SymbolPackageFormat)"
+              TargetFrameworks="@(_TargetFrameworks)"
+              AssemblyName="$(AssemblyName)"
+              PackageOutputPath="$(PackageOutputAbsolutePath)"
+              IncludeSymbols="$(IncludeSymbols)"
+              IncludeSource="$(IncludeSource)"
+              PackageTypes="$(PackageType)"
+              IsTool="$(IsTool)"
+              RepositoryUrl="$(RepositoryUrl)"
+              RepositoryType="$(RepositoryType)"
+              SourceFiles="@(_SourceFiles->Distinct())"
+              NoPackageAnalysis="$(NoPackageAnalysis)"
+              MinClientVersion="$(MinClientVersion)"
+              Serviceable="$(Serviceable)"
+              FrameworkAssemblyReferences="@(_FrameworkAssemblyReferences)"
+              ContinuePackingAfterGeneratingNuspec="$(ContinuePackingAfterGeneratingNuspec)"
+              NuspecOutputPath="$(AdjustedNuspecOutputPath)"
+              IncludeBuildOutput="$(IncludeBuildOutput)"
+              BuildOutputFolders="$(BuildOutputTargetFolder)"
+              ContentTargetFolders="$(ContentTargetFolders)"
+              RestoreOutputPath="$(RestoreOutputAbsolutePath)"
+              NuspecFile="$(NuspecFileAbsolutePath)"
+              NuspecBasePath="$(NuspecBasePath)"
+              NuspecProperties="$(NuspecProperties)"
+              PackageLicenseFile="$(PackageLicenseFile)"
+              PackageLicenseExpression="$(PackageLicenseExpression)"
+              PackageLicenseExpressionVersion="$(PackageLicenseExpressionVersion)"
+              PackageReadmeFile="$(PackageReadmeFile)" />
     <PackTask Condition="$(UseMSBuild16_0_Pack)"
               PackItem="$(PackProjectInputFile)"
               PackageFiles="@(_PackageFiles)"
@@ -343,6 +392,8 @@
               IsTool="$(IsTool)"
               RepositoryUrl="$(RepositoryUrl)"
               RepositoryType="$(RepositoryType)"
+              RepositoryBranch="$(RepositoryBranch)"
+              RepositoryCommit="$(RepositoryCommit)"
               SourceFiles="@(_SourceFiles->Distinct())"
               NoPackageAnalysis="$(NoPackageAnalysis)"
               MinClientVersion="$(MinClientVersion)"
@@ -390,6 +441,8 @@
               IsTool="$(IsTool)"
               RepositoryUrl="$(RepositoryUrl)"
               RepositoryType="$(RepositoryType)"
+              RepositoryBranch="$(RepositoryBranch)"
+              RepositoryCommit="$(RepositoryCommit)"
               SourceFiles="@(_SourceFiles->Distinct())"
               NoPackageAnalysis="$(NoPackageAnalysis)"
               MinClientVersion="$(MinClientVersion)"
@@ -433,6 +486,8 @@
               IsTool="$(IsTool)"
               RepositoryUrl="$(RepositoryUrl)"
               RepositoryType="$(RepositoryType)"
+              RepositoryBranch="$(RepositoryBranch)"
+              RepositoryCommit="$(RepositoryCommit)"
               SourceFiles="@(_SourceFiles->Distinct())"
               NoPackageAnalysis="$(NoPackageAnalysis)"
               MinClientVersion="$(MinClientVersion)"
@@ -475,6 +530,8 @@
               IsTool="$(IsTool)"
               RepositoryUrl="$(RepositoryUrl)"
               RepositoryType="$(RepositoryType)"
+              RepositoryBranch="$(RepositoryBranch)"
+              RepositoryCommit="$(RepositoryCommit)"
               SourceFiles="@(_SourceFiles->Distinct())"
               NoPackageAnalysis="$(NoPackageAnalysis)"
               MinClientVersion="$(MinClientVersion)"

global.json

@@ -1,5 +1,5 @@
 {
     "sdk": {
-        "version": "5.0.300"
+        "version": "5.0.301"
     }
 }

paket.lock

@@ -125,7 +125,7 @@ NUGET
       System.Threading.Tasks.Dataflow (>= 4.9) - restriction: || (== net5.0) (&& (== netstandard2.0) (>= net472)) (&& (== netstandard2.0) (>= net5.0))
     Microsoft.Build.Framework (16.10) - copy_local: false
       System.Security.Permissions (>= 4.7)
-    Microsoft.Build.Locator (1.4.1) - restriction: || (== net5.0) (&& (== netstandard2.0) (>= net5.0))
+    Microsoft.Build.Locator (1.4.1) - restriction: || (== net5.0) (&& (== netstandard2.0) (>= netcoreapp3.1))
     Microsoft.Build.Tasks.Core (16.10) - copy_local: false
       Microsoft.Build.Framework (>= 16.10)
       Microsoft.Build.Utilities.Core (>= 16.10)

src/FsAutoComplete/FsAutoComplete.Lsp.fs

@@ -18,6 +18,7 @@ open FsToolkit.ErrorHandling
 open FSharp.UMX
 open FSharp.Analyzers
 open FSharp.Compiler.Text
+open System.Threading
 
 module FcsRange = FSharp.Compiler.Text.Range
 type FcsRange = FSharp.Compiler.Text.Range
@@ -82,6 +83,85 @@ type FSharpLspClient(sendServerNotification: ClientNotificationSender, sendServe
     member __.NotifyFileParsed (p: PlainNotification) =
         sendServerNotification "fsharp/fileParsed" (box p) |> Async.Ignore
 
+type DiagnosticMessage =
+  | Add of source: string * diags: Diagnostic []
+  | Clear of source: string
+
+/// a type that handles bookkeeping for sending file diagnostics.  It will debounce calls and handle sending diagnostics via the configured function when safe
+type DiagnosticCollection(sendDiagnostics: DocumentUri -> Diagnostic [] -> Async<unit>) =
+  let send uri (diags: Map<string,Diagnostic []>) =
+    Map.toArray diags
+    |> Array.collect snd
+    |> sendDiagnostics uri
+
+  let agents = System.Collections.Generic.Dictionary<DocumentUri, MailboxProcessor<DiagnosticMessage>>()
+  let ctoks = System.Collections.Generic.Dictionary<DocumentUri, CancellationTokenSource>()
+
+
+  let rec restartAgent (fileUri: DocumentUri) =
+    removeAgent fileUri
+    getOrAddAgent fileUri |> ignore
+
+  and removeAgent (fileUri: DocumentUri) =
+    let mailbox = getOrAddAgent fileUri
+    lock agents (fun _ ->
+      let ctok = ctoks.[fileUri]
+      ctok.Cancel()
+      ctoks.Remove(fileUri) |> ignore
+      agents.Remove(fileUri) |> ignore
+    )
+
+  and agentFor (uri: DocumentUri) cTok =
+    let logger = LogProvider.getLoggerByName $"Diagnostics/{uri}"
+    let mailbox = MailboxProcessor.Start((fun inbox ->
+      let rec loop (state: Map<string, Diagnostic []>) = async {
+        match! inbox.Receive() with
+        | Add (source, diags) ->
+          let newState = state |> Map.add source diags
+          do! send uri newState
+          return! loop newState
+        | Clear source ->
+          let newState = state |> Map.remove source
+          do! send uri newState
+          return! loop newState
+      }
+      loop Map.empty
+    ), cTok)
+    mailbox.Error.Add(fun exn -> logger.error (Log.setMessage "Error while sending diagnostics: {message}" >> Log.addExn exn >> Log.addContext "message" exn.Message))
+    mailbox.Error.Add(fun exn -> restartAgent uri)
+    mailbox
+
+  and getOrAddAgent fileUri =
+    match agents.TryGetValue fileUri with
+    | true, mailbox -> mailbox
+    | false, _ ->
+      lock agents (fun _ ->
+        let cts = new CancellationTokenSource()
+        let mailbox = agentFor fileUri cts.Token
+        agents.Add(fileUri, mailbox)
+        ctoks.Add(fileUri, cts)
+        mailbox
+      )
+
+  member x.SetFor(fileUri: DocumentUri, kind: string, values: Diagnostic []) =
+    let mailbox = getOrAddAgent fileUri
+    match values with
+    | [||] ->
+      mailbox.Post (Clear kind)
+    | values ->
+      mailbox.Post (Add(kind, values))
+
+  member x.ClearFor(fileUri: DocumentUri) = removeAgent fileUri
+
+  member x.ClearFor(fileUri: DocumentUri, kind: string) =
+    let mailbox = getOrAddAgent fileUri
+    mailbox.Post (Clear kind)
+
+  interface IDisposable with
+    member x.Dispose() =
+      for KeyValue(fileUri, cts) in ctoks do
+        cts.Cancel()
+
 type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FSharpLspClient) =
     inherit LspServer()
 
@@ -134,22 +214,13 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
 
     let parseFileDebuncer = Debounce(500, parseFile)
 
-    let diagnosticCollections = System.Collections.Concurrent.ConcurrentDictionary<DocumentUri * string,Diagnostic[]>()
 
-    let sendDiagnostics (uri: DocumentUri) =
-        let diags =
-            diagnosticCollections
-            |> Seq.collect (fun kv ->
-                let (u, _) = kv.Key
-                if u = uri then kv.Value else [||])
-            |> Seq.sortBy (fun n ->
-                n.Range.Start.Line
-            )
-            |> Seq.toArray
-        logger.info (Log.setMessage "SendDiag for {file}: {diags} entries" >> Log.addContextDestructured "file" uri >> Log.addContextDestructured "diags" diags.Length )
-        {Uri = uri; Diagnostics = diags}
+    let sendDiagnostics (uri: DocumentUri) (diags: Diagnostic []) =
+        logger.info (Log.setMessage "SendDiag for {file}: {diags} entries" >> Log.addContextDestructured "file" uri >> Log.addContextDestructured "diags" diags.Length)
+        { Uri = uri; Diagnostics = diags }
         |> lspClient.TextDocumentPublishDiagnostics
-        |> Async.Start
+
+    let diagnosticCollections = new DiagnosticCollection(sendDiagnostics)
 
     let handleCommandEvents (n: NotificationEvent) =
       try
@@ -174,36 +245,25 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
 
           | NotificationEvent.ParseError (errors, file) ->
               let uri = Path.LocalPathToUri file
-              diagnosticCollections.AddOrUpdate((uri, "F# Compiler"), [||], fun _ _ -> [||]) |> ignore
-
               let diags = errors |> Array.map (fcsErrorToDiagnostic)
-              diagnosticCollections.AddOrUpdate((uri, "F# Compiler"), diags, fun _ _ -> diags) |> ignore
-              sendDiagnostics uri
+              diagnosticCollections.SetFor(uri, "F# Compiler", diags)
 
           | NotificationEvent.UnusedOpens (file, opens) ->
               let uri = Path.LocalPathToUri file
-              diagnosticCollections.AddOrUpdate((uri, "F# Unused opens"), [||], fun _ _ -> [||]) |> ignore
-
               let diags = opens |> Array.map(fun n ->
                   {Diagnostic.Range = fcsRangeToLsp n; Code = None; Severity = Some DiagnosticSeverity.Hint; Source = "FSAC"; Message = "Unused open statement"; RelatedInformation = Some [||]; Tags = Some [| DiagnosticTag.Unnecessary |] }
               )
-              diagnosticCollections.AddOrUpdate((uri, "F# Unused opens"), diags, fun _ _ -> diags) |> ignore
-              sendDiagnostics uri
+              diagnosticCollections.SetFor(uri, "F# Unused opens", diags)
 
           | NotificationEvent.UnusedDeclarations (file, decls) ->
               let uri = Path.LocalPathToUri file
-              diagnosticCollections.AddOrUpdate((uri, "F# Unused declarations"), [||], fun _ _ -> [||]) |> ignore
-
               let diags = decls |> Array.map(fun (n, t) ->
                   {Diagnostic.Range = fcsRangeToLsp n; Code = (if t then Some "1" else None); Severity = Some DiagnosticSeverity.Hint; Source = "FSAC"; Message = "This value is unused"; RelatedInformation = Some [||]; Tags = Some [| DiagnosticTag.Unnecessary |] }
               )
-              diagnosticCollections.AddOrUpdate((uri, "F# Unused declarations"), diags, fun _ _ -> diags) |> ignore
-              sendDiagnostics uri
+              diagnosticCollections.SetFor(uri, "F# Unused declarations", diags)
 
           | NotificationEvent.SimplifyNames (file, decls) ->
               let uri = Path.LocalPathToUri file
-              diagnosticCollections.AddOrUpdate((uri, "F# simplify names"), [||], fun _ _ -> [||]) |> ignore
-
               let diags = decls |> Array.map(fun ({ Range = range; RelativeName = _relName }) ->
                   { Diagnostic.Range = fcsRangeToLsp range
                     Code = None
@@ -213,13 +273,10 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
                     RelatedInformation = Some [| |]
                     Tags = Some [| DiagnosticTag.Unnecessary |] }
               )
-              diagnosticCollections.AddOrUpdate((uri, "F# simplify names"), diags, fun _ _ -> diags) |> ignore
-              sendDiagnostics uri
+              diagnosticCollections.SetFor(uri, "F# simplify names", diags)
 
           | NotificationEvent.Lint (file, warnings) ->
               let uri = Path.LocalPathToUri file
-              diagnosticCollections.AddOrUpdate((uri, "F# Linter"), [||], fun _ _ -> [||]) |> ignore
-
               let fs =
                   warnings |> List.choose (fun w ->
                       w.Warning.Details.SuggestedFix
@@ -232,7 +289,8 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
 
               lintFixes.[uri] <- fs
               let diags =
-                  warnings |> List.map(fun w ->
+                  warnings
+                  |> List.map(fun w ->
                       // ideally we'd be able to include a clickable link to the docs page for this errorlint code, but that is not the case here
                       // neither the Message or the RelatedInformation structures support markdown.
                       let range = fcsRangeToLsp w.Warning.Details.Range
@@ -244,9 +302,9 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
                         RelatedInformation = None
                         Tags = None }
                   )
+                  |> List.sortBy (fun diag -> diag.Range)
                   |> List.toArray
-              diagnosticCollections.AddOrUpdate((uri, "F# Linter"), diags, fun _ _ -> diags) |> ignore
-              sendDiagnostics uri
+              diagnosticCollections.SetFor(uri, "F# linter", diags)
 
           | NotificationEvent.Canceled (msg) ->
               let ntf = {Content = msg}
@@ -257,12 +315,10 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
               |> lspClient.TextDocumentPublishDiagnostics
               |> Async.Start
           | NotificationEvent.AnalyzerMessage(messages, file) ->
-
               let uri = Path.LocalPathToUri file
-              diagnosticCollections.AddOrUpdate((uri, "F# Analyzers"), [||], fun _ _ -> [||]) |> ignore
               match messages with
               | [||] ->
-                diagnosticCollections.AddOrUpdate((uri, "F# Analyzers"), [||], fun _ _ -> [||]) |> ignore
+                diagnosticCollections.SetFor(uri, "F# Analyzers", [||])
               | messages ->
                 let fs =
                     messages
@@ -278,7 +334,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
                 if analyzerFixes.ContainsKey uri then () else analyzerFixes.[uri] <- new System.Collections.Generic.Dictionary<_,_>()
                 analyzerFixes.[uri].[aName] <- fs
 
-                let diag =
+                let diags =
                     messages |> Array.map (fun m ->
                         let range = fcsRangeToLsp m.Range
                         let s =
@@ -294,8 +350,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
                           RelatedInformation = None
                           Tags = None }
                     )
-                diagnosticCollections.AddOrUpdate((uri, "F# Analyzers"), diag, fun _ _ -> diag) |> ignore
-                sendDiagnostics uri
+                diagnosticCollections.SetFor(uri, "F# Analyzers", diags)
       with
       | _ -> ()
 
@@ -462,6 +517,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
       for (dispose: IDisposable) in commandDisposables do
         dispose.Dispose()
       (commands :> IDisposable).Dispose()
+      (diagnosticCollections :> IDisposable).Dispose()
     }
 
     override __.Initialize(p: InitializeParams) = async {
@@ -1304,12 +1360,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS
         |> Array.iter (fun c ->
             if c.Type = FileChangeType.Deleted then
                 let uri = c.Uri
-                diagnosticCollections.AddOrUpdate((uri, "F# Compiler"), [||], fun _ _ -> [||]) |> ignore
-                diagnosticCollections.AddOrUpdate((uri, "F# Unused opens"), [||], fun _ _ -> [||]) |> ignore
-                diagnosticCollections.AddOrUpdate((uri, "F# Unused declarations"), [||], fun _ _ -> [||]) |> ignore
-                diagnosticCollections.AddOrUpdate((uri, "F# simplify names"), [||], fun _ _ -> [||]) |> ignore
-                diagnosticCollections.AddOrUpdate((uri, "F# Linter"), [||], fun _ _ -> [||]) |> ignore
-                sendDiagnostics uri
+                diagnosticCollections.ClearFor uri
             ()
         )