Move more stuff to cancellable tasks in VS.Editor

vsintegration/src/FSharp.Editor/Classification/ClassificationDefinitions.fs

@@ -188,15 +188,15 @@ module internal ClassificationDefinitions =
         do VSColorTheme.add_ThemeChanged handler
 
         member _.GetColor(ctype) =
-            match customColorData |> List.tryFind (fun item -> item.ClassificationName = ctype) with
-            | Some item ->
+            match customColorData |> List.tryFindV (fun item -> item.ClassificationName = ctype) with
+            | ValueSome item ->
                 let light, dark = item.LightThemeColor, item.DarkThemeColor
 
                 match getCurrentThemeId () with
                 | LightTheme -> Nullable light
                 | DarkTheme -> Nullable dark
                 | UnknownTheme -> Nullable()
-            | None -> Nullable()
+            | ValueNone -> Nullable()
 
         interface ISetThemeColors with
             member _.SetColors() = setColors ()

vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs

@@ -69,7 +69,7 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
             ct = ct
         )
 
-        result.ToImmutable()
+        result.MoveToImmutable()
 
     static let addSemanticClassification
         sourceText
@@ -118,11 +118,17 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
 
         d.ForEach(f)
 
-        Collections.ObjectModel.ReadOnlyDictionary lookup :> IReadOnlyDictionary<_, _>
+        lookup :> IReadOnlyDictionary<_, _>
 
     let semanticClassificationCache =
         new DocumentCache<SemanticClassificationLookup>("fsharp-semantic-classification-cache")
 
+    // We don't really care here about concurrency in neither DocumentCahce, nor underlying hashmap.
+    let syntacticClassificationCache =
+        new DocumentCache<Dictionary<TextSpan, ImmutableArray<ClassifiedSpan>>>(
+        "fsharp-syntactic-classification-cache",
+        CacheItemPolicy(SlidingExpiration = (TimeSpan.FromMinutes 5)))
+
     interface IFSharpClassificationService with
         // Do not perform classification if we don't have project options (#defines matter)
         member _.AddLexicalClassifications(_: SourceText, _: TextSpan, _: List<ClassifiedSpan>, _: CancellationToken) = ()
@@ -137,7 +143,7 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
             cancellableTask {
                 use _logBlock = Logger.LogBlock(LogEditorFunctionId.Classification_Syntactic)
 
-                let! cancellationToken = CancellableTask.getCurrentCancellationToken ()
+                let! cancellationToken = CancellableTask.getCancellationToken ()
 
                 let defines, langVersion, strictIndentation = document.GetFsharpParsingOptions()
 
@@ -160,10 +166,30 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                     TelemetryReporter.ReportSingleEventWithDuration(TelemetryEvents.AddSyntacticCalssifications, eventProps)
 
                 if not isOpenDocument then
-                    let classifiedSpans =
-                        getLexicalClassifications (document.FilePath, defines, sourceText, textSpan, cancellationToken)
+                    // If called concurrently, it'll likely race here (in both getting and setting/adding to underlying dictionary)
+                    // But we don't really care for such small caches, will change the implementation if it shows that it's a problem.
+                    match! syntacticClassificationCache.TryGetValueAsync document with
+                    | ValueSome classifiedSpansDict ->
+                        match classifiedSpansDict.TryGetValue(textSpan) with
+                        | true, classifiedSpans -> result.AddRange(classifiedSpans)
+                        | _ ->
+                            let classifiedSpans =
+                                getLexicalClassifications (document.FilePath, defines, sourceText, textSpan, cancellationToken)
+
+                            classifiedSpansDict.Add(textSpan, classifiedSpans)
+                            result.AddRange(classifiedSpans)
+                    | ValueNone ->
+
+                        let classifiedSpans =
+                            getLexicalClassifications (document.FilePath, defines, sourceText, textSpan, cancellationToken)
+
+                        let classifiedSpansDict = Dictionary<TextSpan, ImmutableArray<ClassifiedSpan>>()
+
+                        do! syntacticClassificationCache.SetAsync(document, classifiedSpansDict)
+
+                        do classifiedSpansDict[textSpan] <- classifiedSpans
 
-                    result.AddRange(classifiedSpans)
+                        result.AddRange(classifiedSpans)
                 else
                     result.AddRange(
                         Tokenizer.getClassifiedSpans (

vsintegration/src/FSharp.Editor/CodeFixes/AddMissingFunKeyword.fs

@@ -38,7 +38,7 @@ type internal AddMissingFunKeywordCodeFixProvider [<ImportingConstructor>] () =
                 if textOfError <> "->" then
                     return ValueNone
                 else
-                    let! cancellationToken = CancellableTask.getCurrentCancellationToken ()
+                    let! cancellationToken = CancellableTask.getCancellationToken ()
                     let document = context.Document
 
                     let! defines, langVersion, strictIndentation =

vsintegration/src/FSharp.Editor/CodeFixes/AddMissingRecToMutuallyRecFunctions.fs

@@ -24,7 +24,7 @@ type internal AddMissingRecToMutuallyRecFunctionsCodeFixProvider [<ImportingCons
     interface IFSharpCodeFixProvider with
         member _.GetCodeFixIfAppliesAsync context =
             cancellableTask {
-                let! cancellationToken = CancellableTask.getCurrentCancellationToken ()
+                let! cancellationToken = CancellableTask.getCancellationToken ()
 
                 let! defines, langVersion, strictIndentation =
                     context.Document.GetFsharpParsingOptionsAsync(nameof (AddMissingRecToMutuallyRecFunctionsCodeFixProvider))

vsintegration/src/FSharp.Editor/CodeFixes/AddOpenCodeFixProvider.fs

@@ -4,13 +4,15 @@ namespace Microsoft.VisualStudio.FSharp.Editor
 
 open System.Composition
 open System.Threading.Tasks
+open System.Threading
 open System.Collections.Immutable
 
 open Microsoft.CodeAnalysis.Text
 open Microsoft.CodeAnalysis.CodeFixes
 
 open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Text
+open CancellableTasks
 
 [<ExportCodeFixProvider(FSharpConstants.FSharpLanguageName, Name = CodeFix.AddOpen); Shared>]
 type internal AddOpenCodeFixProvider [<ImportingConstructor>] (assemblyContentProvider: AssemblyContentProvider) =
@@ -68,7 +70,7 @@ type internal AddOpenCodeFixProvider [<ImportingConstructor>] (assemblyContentPr
 
             let! parseResults, checkResults =
                 document.GetFSharpParseAndCheckResultsAsync(nameof (AddOpenCodeFixProvider))
-                |> liftAsync
+                |> CancellableTask.start context.CancellationToken
 
             let line = sourceText.Lines.GetLineFromPosition(context.Span.End)
             let linePos = sourceText.Lines.GetLinePosition(context.Span.End)

vsintegration/src/FSharp.Editor/CodeFixes/AddTypeAnnotationToObjectOfIndeterminateType.fs

@@ -5,6 +5,7 @@ namespace Microsoft.VisualStudio.FSharp.Editor
 open System
 open System.Composition
 open System.Threading.Tasks
+open System.Threading
 open System.Collections.Immutable
 
 open Microsoft.CodeAnalysis.Text
@@ -13,6 +14,7 @@ open Microsoft.CodeAnalysis.CodeFixes
 open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Text
 open FSharp.Compiler.Symbols
+open CancellableTasks
 
 [<ExportCodeFixProvider(FSharpConstants.FSharpLanguageName, Name = CodeFix.AddTypeAnnotationToObjectOfIndeterminateType); Shared>]
 type internal AddTypeAnnotationToObjectOfIndeterminateTypeFixProvider [<ImportingConstructor>] () =
@@ -44,7 +46,7 @@ type internal AddTypeAnnotationToObjectOfIndeterminateTypeFixProvider [<Importin
 
             let! _, checkFileResults =
                 document.GetFSharpParseAndCheckResultsAsync(nameof (AddTypeAnnotationToObjectOfIndeterminateTypeFixProvider))
-                |> liftAsync
+                |> CancellableTask.start context.CancellationToken
 
             let decl =
                 checkFileResults.GetDeclarationLocation(

vsintegration/src/FSharp.Editor/CodeFixes/CodeFixHelpers.fs

@@ -125,7 +125,7 @@ module internal CodeFixExtensions =
 
         member ctx.GetSourceTextAsync() =
             cancellableTask {
-                let! cancellationToken = CancellableTask.getCurrentCancellationToken ()
+                let! cancellationToken = CancellableTask.getCancellationToken ()
                 return! ctx.Document.GetTextAsync cancellationToken
             }
 
@@ -157,7 +157,7 @@ module IFSharpCodeFixProviderExtensions =
             cancellableTask {
                 let sw = Stopwatch.StartNew()
 
-                let! token = CancellableTask.getCurrentCancellationToken ()
+                let! token = CancellableTask.getCancellationToken ()
                 let! sourceText = doc.GetTextAsync token
 
                 let! codeFixOpts =
@@ -167,10 +167,10 @@ module IFSharpCodeFixProviderExtensions =
                     // TODO: this crops the diags on a very high level,
                     // a proper fix is needed.
                     |> Seq.distinctBy (fun d -> d.Id, d.Location)
-                    |> Seq.map (fun diag -> CodeFixContext(doc, diag, IFSharpCodeFixProvider.Action, token))
-                    |> Seq.map (fun context -> provider.GetCodeFixIfAppliesAsync context)
-                    |> Seq.map (fun task -> task token)
-                    |> Task.WhenAll
+                    |> Seq.map (fun diag ->
+                        let context = CodeFixContext(doc, diag, IFSharpCodeFixProvider.Action, token)
+                        provider.GetCodeFixIfAppliesAsync context)
+                    |> CancellableTask.whenAll
 
                 let codeFixes = codeFixOpts |> Seq.map ValueOption.toOption |> Seq.choose id
                 let changes = codeFixes |> Seq.collect (fun codeFix -> codeFix.Changes)

vsintegration/src/FSharp.Editor/CodeFixes/ConvertCSharpLambdaToFSharpLambda.fs

@@ -34,7 +34,7 @@ type internal ConvertCSharpLambdaToFSharpLambdaCodeFixProvider [<ImportingConstr
     interface IFSharpCodeFixProvider with
         member _.GetCodeFixIfAppliesAsync context =
             cancellableTask {
-                let! cancellationToken = CancellableTask.getCurrentCancellationToken ()
+                let! cancellationToken = CancellableTask.getCancellationToken ()
 
                 let! parseResults = context.Document.GetFSharpParseResultsAsync(nameof ConvertCSharpLambdaToFSharpLambdaCodeFixProvider)
                 let! sourceText = context.Document.GetTextAsync(cancellationToken)

vsintegration/src/FSharp.Editor/CodeFixes/ImplementInterfaceCodeFixProvider.fs

@@ -21,6 +21,7 @@ open FSharp.Compiler.Symbols
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
 open FSharp.Compiler.Tokenization
+open CancellableTasks
 
 [<NoEquality; NoComparison>]
 type internal InterfaceState =
@@ -189,17 +190,19 @@ type internal ImplementInterfaceCodeFixProvider [<ImportingConstructor>] () =
 
     override _.RegisterCodeFixesAsync context : Task =
         asyncMaybe {
+            let! ct = Async.CancellationToken |> liftAsync
+
             let! parseResults, checkFileResults =
                 context.Document.GetFSharpParseAndCheckResultsAsync(nameof (ImplementInterfaceCodeFixProvider))
-                |> liftAsync
+                |> CancellableTask.start ct
 
             let cancellationToken = context.CancellationToken
             let! sourceText = context.Document.GetTextAsync(cancellationToken)
             let textLine = sourceText.Lines.GetLineFromPosition context.Span.Start
 
             let! _, _, parsingOptions, _ =
                 context.Document.GetFSharpCompilationOptionsAsync(nameof (ImplementInterfaceCodeFixProvider))
-                |> liftAsync
+                |> CancellableTask.start ct
 
             let defines = CompilerEnvironment.GetConditionalDefinesForEditing parsingOptions
             let langVersionOpt = Some parsingOptions.LangVersionText

vsintegration/src/FSharp.Editor/CodeFixes/MakeDeclarationMutable.fs

@@ -4,13 +4,15 @@ namespace Microsoft.VisualStudio.FSharp.Editor
 
 open System.Composition
 open System.Threading.Tasks
+open System.Threading
 open System.Collections.Immutable
 
 open Microsoft.CodeAnalysis.Text
 open Microsoft.CodeAnalysis.CodeFixes
 
 open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Text
+open CancellableTasks
 
 [<ExportCodeFixProvider(FSharpConstants.FSharpLanguageName, Name = CodeFix.MakeDeclarationMutable); Shared>]
 type internal MakeDeclarationMutableFixProvider [<ImportingConstructor>] () =
@@ -43,7 +45,7 @@ type internal MakeDeclarationMutableFixProvider [<ImportingConstructor>] () =
 
             let! parseFileResults, checkFileResults =
                 document.GetFSharpParseAndCheckResultsAsync(nameof (MakeDeclarationMutableFixProvider))
-                |> liftAsync
+                |> CancellableTask.start context.CancellationToken
 
             let decl =
                 checkFileResults.GetDeclarationLocation(

vsintegration/src/FSharp.Editor/CodeFixes/MissingReferenceCodeFixProvider.fs

@@ -63,11 +63,11 @@ type internal MissingReferenceCodeFixProvider() =
 
                     let exactProjectMatches =
                         solution.Projects
-                        |> Seq.tryFind (fun project ->
+                        |> Seq.tryFindV (fun project ->
                             String.Compare(project.AssemblyName, assemblyName, StringComparison.OrdinalIgnoreCase) = 0)
 
                     match exactProjectMatches with
-                    | Some refProject ->
+                    | ValueSome refProject ->
                         let codefix =
                             createCodeFix (
                                 String.Format(SR.AddProjectReference(), refProject.Name),
@@ -76,21 +76,21 @@ type internal MissingReferenceCodeFixProvider() =
                             )
 
                         context.RegisterCodeFix(codefix, ImmutableArray.Create diagnostic)
-                    | None ->
+                    | ValueNone ->
                         let metadataReferences =
                             solution.Projects
                             |> Seq.collect (fun project -> project.MetadataReferences)
-                            |> Seq.tryFind (fun ref ->
+                            |> Seq.tryFindV (fun ref ->
                                 let referenceAssemblyName = Path.GetFileNameWithoutExtension(ref.Display)
                                 String.Compare(referenceAssemblyName, assemblyName, StringComparison.OrdinalIgnoreCase) = 0)
 
                         match metadataReferences with
-                        | Some metadataRef ->
+                        | ValueSome metadataRef ->
                             let codefix =
                                 createCodeFix (String.Format(SR.AddAssemblyReference(), assemblyName), context, AddMetadataRef metadataRef)
 
                             context.RegisterCodeFix(codefix, ImmutableArray.Create diagnostic)
-                        | None -> ()
+                        | ValueNone -> ()
                 | _ -> ())
         }
         |> RoslynHelpers.StartAsyncUnitAsTask(context.CancellationToken)

vsintegration/src/FSharp.Editor/CodeFixes/RemoveSuperfluousCaptureForUnionCaseWithNoData.fs

@@ -42,8 +42,7 @@ type internal RemoveSuperfluousCaptureForUnionCaseWithNoDataCodeFixProvider [<Im
 
                 return
                     classifications
-                    |> Array.tryFind (fun c -> c.Type = SemanticClassificationType.UnionCase)
-                    |> ValueOption.ofOption
+                    |> Array.tryFindV (fun c -> c.Type = SemanticClassificationType.UnionCase)
                     |> ValueOption.map (fun unionCaseItem ->
                         // The error/warning captures entire pattern match, like "Ns.Type.DuName bindingName". We want to keep type info when suggesting a replacement, and only remove "bindingName".
                         let typeInfoLength = unionCaseItem.Range.EndColumn - m.StartColumn

vsintegration/src/FSharp.Editor/CodeFixes/RemoveUnusedBinding.fs

@@ -32,7 +32,7 @@ type internal RemoveUnusedBindingCodeFixProvider [<ImportingConstructor>] () =
     interface IFSharpCodeFixProvider with
         member _.GetCodeFixIfAppliesAsync context =
             cancellableTask {
-                let! token = CancellableTask.getCurrentCancellationToken ()
+                let! token = CancellableTask.getCancellationToken ()
 
                 let! sourceText = context.Document.GetTextAsync token
                 let! parseResults = context.Document.GetFSharpParseResultsAsync(nameof RemoveUnusedBindingCodeFixProvider)

vsintegration/src/FSharp.Editor/CodeFixes/ReplaceWithSuggestion.fs

@@ -13,6 +13,7 @@ open FSharp.Compiler.Diagnostics
 open FSharp.Compiler.EditorServices
 open FSharp.Compiler.Syntax
 open FSharp.Compiler.Text
+open CancellableTasks
 
 [<ExportCodeFixProvider(FSharpConstants.FSharpLanguageName, Name = CodeFix.ReplaceWithSuggestion); Shared>]
 type internal ReplaceWithSuggestionCodeFixProvider [<ImportingConstructor>] (settings: EditorOptions) =
@@ -28,7 +29,7 @@ type internal ReplaceWithSuggestionCodeFixProvider [<ImportingConstructor>] (set
 
             let! parseFileResults, checkFileResults =
                 document.GetFSharpParseAndCheckResultsAsync(nameof (ReplaceWithSuggestionCodeFixProvider))
-                |> liftAsync
+                |> CancellableTask.start context.CancellationToken
 
             // This is all needed to get a declaration list
             let! sourceText = document.GetTextAsync(context.CancellationToken)

vsintegration/src/FSharp.Editor/CodeFixes/UseMutationWhenValueIsMutable.fs

@@ -12,6 +12,7 @@ open Microsoft.CodeAnalysis.CodeFixes
 
 open FSharp.Compiler.Symbols
 open FSharp.Compiler.Text
+open CancellableTasks
 
 [<ExportCodeFixProvider(FSharpConstants.FSharpLanguageName, Name = CodeFix.UseMutationWhenValueIsMutable); Shared>]
 type internal UseMutationWhenValueIsMutableCodeFixProvider [<ImportingConstructor>] () =
@@ -51,7 +52,7 @@ type internal UseMutationWhenValueIsMutableCodeFixProvider [<ImportingConstructo
 
             let! _, checkFileResults =
                 document.GetFSharpParseAndCheckResultsAsync(nameof (UseMutationWhenValueIsMutableCodeFixProvider))
-                |> liftAsync
+                |> CancellableTask.start context.CancellationToken
 
             let! symbolUse =
                 checkFileResults.GetSymbolUseAtLocation(