More VS cleanup

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

@@ -52,7 +52,7 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                         ClassificationTypeNames.Text
 
                 match RoslynHelpers.TryFSharpRangeToTextSpan(text, tok.Range) with
-                | Some span -> result.Add(ClassifiedSpan(TextSpan(textSpan.Start + span.Start, span.Length), spanKind))
+                | ValueSome span -> result.Add(ClassifiedSpan(TextSpan(textSpan.Start + span.Start, span.Length), spanKind))
                 | _ -> ()
 
         let flags =
@@ -79,8 +79,8 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
         =
         for item in items do
             match RoslynHelpers.TryFSharpRangeToTextSpan(sourceText, item.Range) with
-            | None -> ()
-            | Some span ->
+            | ValueNone -> ()
+            | ValueSome span ->
                 let span =
                     match item.Type with
                     | SemanticClassificationType.Printf -> span
@@ -111,7 +111,7 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                 | true, items -> items
                 | _ ->
                     let items = ResizeArray()
-                    lookup.[dataItem.Range.StartLine] <- items
+                    lookup[dataItem.Range.StartLine] <- items
                     items
 
             items.Add dataItem
@@ -120,8 +120,25 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
 
         lookup :> IReadOnlyDictionary<_, _>
 
-    let semanticClassificationCache =
-        new DocumentCache<SemanticClassificationLookup>("fsharp-semantic-classification-cache")
+    static let itemTosemanticClassificationLookup (d: SemanticClassificationItem array) =
+        let lookup = Dictionary<int, ResizeArray<SemanticClassificationItem>>()
+        for item in d do
+            let items =
+                let startLine = item.Range.StartLine
+                match lookup.TryGetValue startLine with
+                | true, items -> items
+                | _ ->
+                    let items = ResizeArray()
+                    lookup[startLine] <- items
+                    items
+            items.Add item
+        lookup :> IReadOnlyDictionary<_, _>
+
+    static let unopenedDocumentsSemanticClassificationCache =
+        new DocumentCache<SemanticClassificationLookup>("fsharp-unopened-documents-semantic-classification-cache", 5.)
+
+    static let openedDocumentsSemanticClassificationCache =
+        new DocumentCache<SemanticClassificationLookup>("fsharp-opened-documents-semantic-classification-cache", 2.)
 
     interface IFSharpClassificationService with
         // Do not perform classification if we don't have project options (#defines matter)
@@ -197,7 +214,7 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                 let isOpenDocument = document.Project.Solution.Workspace.IsDocumentOpen document.Id
 
                 if not isOpenDocument then
-                    match! semanticClassificationCache.TryGetValueAsync document with
+                    match! unopenedDocumentsSemanticClassificationCache.TryGetValueAsync document with
                     | ValueSome classificationDataLookup ->
                         let eventProps: (string * obj) array =
                             [|
@@ -212,7 +229,7 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                             TelemetryReporter.ReportSingleEventWithDuration(TelemetryEvents.AddSemanticCalssifications, eventProps)
 
                         addSemanticClassificationByLookup sourceText textSpan classificationDataLookup result
-                    | _ ->
+                    | ValueNone ->
                         let eventProps: (string * obj) array =
                             [|
                                 "context.document.project.id", document.Project.Id.Id.ToString()
@@ -227,28 +244,50 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
 
                         let! classificationData = document.GetFSharpSemanticClassificationAsync(nameof (FSharpClassificationService))
                         let classificationDataLookup = toSemanticClassificationLookup classificationData
-                        do! semanticClassificationCache.SetAsync(document, classificationDataLookup)
+                        do! unopenedDocumentsSemanticClassificationCache.SetAsync(document, classificationDataLookup)
                         addSemanticClassificationByLookup sourceText textSpan classificationDataLookup result
                 else
-                    let eventProps: (string * obj) array =
-                        [|
-                            "context.document.project.id", document.Project.Id.Id.ToString()
-                            "context.document.id", document.Id.Id.ToString()
-                            "isOpenDocument", isOpenDocument
-                            "textSpanLength", textSpan.Length
-                            "cacheHit", false
-                        |]
 
-                    use _eventDuration =
-                        TelemetryReporter.ReportSingleEventWithDuration(TelemetryEvents.AddSemanticCalssifications, eventProps)
+                    match! openedDocumentsSemanticClassificationCache.TryGetValueAsync document with
+                    | ValueSome classificationDataLookup ->
+                        let eventProps: (string * obj) array =
+                            [|
+                                "context.document.project.id", document.Project.Id.Id.ToString()
+                                "context.document.id", document.Id.Id.ToString()
+                                "isOpenDocument", isOpenDocument
+                                "textSpanLength", textSpan.Length
+                                "cacheHit", true
+                            |]
+
+                        use _eventDuration =
+                            TelemetryReporter.ReportSingleEventWithDuration(TelemetryEvents.AddSemanticCalssifications, eventProps)
+
+                        addSemanticClassificationByLookup sourceText textSpan classificationDataLookup result
+                    | ValueNone ->
+
+                        let eventProps: (string * obj) array =
+                            [|
+                                "context.document.project.id", document.Project.Id.Id.ToString()
+                                "context.document.id", document.Id.Id.ToString()
+                                "isOpenDocument", isOpenDocument
+                                "textSpanLength", textSpan.Length
+                                "cacheHit", false
+                            |]
+
+                        use _eventDuration =
+                            TelemetryReporter.ReportSingleEventWithDuration(TelemetryEvents.AddSemanticCalssifications, eventProps)
+
+                        let! _, checkResults = document.GetFSharpParseAndCheckResultsAsync(nameof (IFSharpClassificationService))
+
+                        let targetRange =
+                            RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText)
 
-                    let! _, checkResults = document.GetFSharpParseAndCheckResultsAsync(nameof (IFSharpClassificationService))
+                        let classificationData = checkResults.GetSemanticClassification(Some targetRange)
 
-                    let targetRange =
-                        RoslynHelpers.TextSpanToFSharpRange(document.FilePath, textSpan, sourceText)
+                        let classificationDataLookup = itemTosemanticClassificationLookup classificationData
+                        do! unopenedDocumentsSemanticClassificationCache.SetAsync(document, classificationDataLookup)
 
-                    let classificationData = checkResults.GetSemanticClassification(Some targetRange)
-                    addSemanticClassification sourceText textSpan classificationData result
+                        addSemanticClassification sourceText textSpan classificationData result
             }
             |> CancellableTask.startAsTask cancellationToken
 

vsintegration/src/FSharp.Editor/Commands/XmlDocCommandService.fs

@@ -16,6 +16,8 @@ open Microsoft.VisualStudio.TextManager.Interop
 open Microsoft.VisualStudio.LanguageServices
 open Microsoft.VisualStudio.Utilities
 open FSharp.Compiler.EditorServices
+open CancellableTasks.CancellableTaskBuilder
+open CancellableTasks
 
 type internal XmlDocCommandFilter(wpfTextView: IWpfTextView, filePath: string, workspace: VisualStudioWorkspace) =
 
@@ -67,7 +69,12 @@ type internal XmlDocCommandFilter(wpfTextView: IWpfTextView, filePath: string, w
                                 let! document = getLastDocument ()
                                 let! cancellationToken = Async.CancellationToken |> liftAsync
                                 let! sourceText = document.GetTextAsync(cancellationToken)
-                                let! parseResults = document.GetFSharpParseResultsAsync(nameof (XmlDocCommandFilter)) |> liftAsync
+
+                                let! parseResults =
+                                    document.GetFSharpParseResultsAsync(nameof (XmlDocCommandFilter))
+                                    |> CancellableTask.start cancellationToken
+                                    |> Async.AwaitTask
+                                    |> liftAsync
 
                                 let xmlDocables =
                                     XmlDocParser.GetXmlDocables(sourceText.ToFSharpSourceText(), parseResults.ParseTree)

vsintegration/src/FSharp.Editor/Common/CancellableTasks.fs

@@ -451,13 +451,13 @@ module CancellableTasks =
 
         /// <summary>
         /// Builds a cancellableTask using computation expression syntax.
-        /// Default behaviour when binding (v)options is to return a cacnelled task.
+        /// Default behaviour when binding (v)options is to return a cancelled task.
         /// </summary>
         let foregroundCancellableTask = CancellableTaskBuilder(false)
 
         /// <summary>
         /// Builds a cancellableTask using computation expression syntax which switches to execute on a background thread if not already doing so.
-        /// Default behaviour when binding (v)options is to return a cacnelled task.
+        /// Default behaviour when binding (v)options is to return a cancelled task.
         /// </summary>
         let cancellableTask = CancellableTaskBuilder(true)
 
@@ -1105,8 +1105,7 @@ module CancellableTasks =
                 return! Task.WhenAll (seq { for task in tasks do yield startTask ct task })
             }
 
-        let inline ignore (ctask: CancellableTask<_>) =
-            ctask |> toUnit
+        let inline ignore ([<InlineIfLambda>] ctask: CancellableTask<_>) = toUnit ctask
 
     /// <exclude />
     [<AutoOpen>]

vsintegration/src/FSharp.Editor/Common/CodeAnalysisExtensions.fs

@@ -53,17 +53,8 @@ type Solution with
         // It's crucial to normalize file path here (specificaly, remove relative parts),
         // otherwise Roslyn does not find documents.
         self.GetDocumentIdsWithFilePath(Path.GetFullPath filePath)
-        |> Seq.tryHead
-        |> Option.map (fun docId -> self.GetDocument docId)
-
-    /// Try to find the document corresponding to the provided filepath and ProjectId within this solution
-    member self.TryGetDocumentFromPath(filePath, projId: ProjectId) =
-        // It's crucial to normalize file path here (specificaly, remove relative parts),
-        // otherwise Roslyn does not find documents.
-        self.GetDocumentIdsWithFilePath(Path.GetFullPath filePath)
-        |> Seq.filter (fun x -> x.ProjectId = projId)
-        |> Seq.tryHead
-        |> Option.map (fun docId -> self.GetDocument docId)
+        |> ImmutableArray.tryHeadV
+        |> ValueOption.map (fun docId -> self.GetDocument docId)
 
     /// Try to get a project inside the solution using the project's id
     member self.TryGetProject(projId: ProjectId) =

vsintegration/src/FSharp.Editor/Common/DocumentCache.fs

@@ -16,6 +16,9 @@ type DocumentCache<'Value when 'Value: not struct>(name: string, ?cacheItemPolic
     let policy =
         defaultArg cacheItemPolicy (CacheItemPolicy(SlidingExpiration = (TimeSpan.FromSeconds defaultSlidingExpiration)))
 
+    new(name: string, slidingExpirationSeconds: float) =
+        new DocumentCache<'Value>(name, CacheItemPolicy(SlidingExpiration = (TimeSpan.FromSeconds slidingExpirationSeconds)))
+
     member _.TryGetValueAsync(doc: Document) =
         cancellableTask {
             let! ct = CancellableTask.getCancellationToken ()

vsintegration/src/FSharp.Editor/Common/Extensions.fs

@@ -298,11 +298,63 @@ module ValueOption =
         | ValueSome v -> Some v
         | _ -> None
 
+[<RequireQualifiedAccess>]
+module IEnumerator =
+    let chooseV f (e: IEnumerator<'T>) =
+        let mutable started = false
+        let mutable curr = None
+
+        let get () =
+            if not started then
+                raise (InvalidOperationException("Not started"))
+
+            match curr with
+            | None -> raise (InvalidOperationException("Already finished"))
+            | Some x -> x
+
+        { new IEnumerator<'U> with
+            member _.Current = get ()
+          interface System.Collections.IEnumerator with
+              member _.Current = box (get ())
+
+              member _.MoveNext() =
+                  if not started then
+                      started <- true
+
+                  curr <- None
+
+                  while (curr.IsNone && e.MoveNext()) do
+                      curr <- f e.Current
+
+                  Option.isSome curr
+
+              member _.Reset() =
+                  raise (NotSupportedException("Reset is not supported"))
+          interface System.IDisposable with
+              member _.Dispose() = e.Dispose()
+        }
+
 [<RequireQualifiedAccess>]
 module Seq =
 
+    let mkSeq f =
+        { new IEnumerable<'U> with
+            member _.GetEnumerator() = f ()
+          interface System.Collections.IEnumerable with
+              member _.GetEnumerator() =
+                  (f () :> System.Collections.IEnumerator)
+        }
+
+    let inline revamp f (ie: seq<_>) =
+        mkSeq (fun () -> f (ie.GetEnumerator()))
+
     let toImmutableArray (xs: seq<'a>) : ImmutableArray<'a> = xs.ToImmutableArray()
 
+    let inline tryHeadV (source: seq<_>) =
+        use e = source.GetEnumerator()
+
+        if (e.MoveNext()) then ValueSome e.Current else ValueNone
+
     let inline tryFindV ([<InlineIfLambda>] predicate) (source: seq<'T>) =
         use e = source.GetEnumerator()
         let mutable res = ValueNone
@@ -326,6 +378,18 @@ module Seq =
 
         loop 0
 
+    let inline tryPickV ([<InlineIfLambda>] chooser) (source: seq<'T>) =
+        use e = source.GetEnumerator()
+        let mutable res = ValueNone
+
+        while (ValueOption.isNone res && e.MoveNext()) do
+            res <- chooser e.Current
+
+        res
+
+    let chooseV chooser source =
+        revamp (IEnumerator.chooseV chooser) source
+
 [<RequireQualifiedAccess>]
 module Array =
     let inline foldi ([<InlineIfLambda>] folder: 'State -> int -> 'T -> 'State) (state: 'State) (xs: 'T[]) =
@@ -340,6 +404,9 @@ module Array =
 
     let toImmutableArray (xs: 'T[]) = xs.ToImmutableArray()
 
+    let inline tryHeadV (array: _[]) =
+        if array.Length = 0 then ValueNone else ValueSome array[0]
+
     let inline tryFindV ([<InlineIfLambda>] predicate) (array: _[]) =
 
         let rec loop i =
@@ -349,6 +416,75 @@ module Array =
 
         loop 0
 
+    let inline chooseV ([<InlineIfLambda>] chooser: 'T -> 'U voption) (array: 'T[]) =
+
+        let mutable i = 0
+        let mutable first = Unchecked.defaultof<'U>
+        let mutable found = false
+
+        while i < array.Length && not found do
+            let element = array.[i]
+
+            match chooser element with
+            | ValueNone -> i <- i + 1
+            | ValueSome b ->
+                first <- b
+                found <- true
+
+        if i <> array.Length then
+
+            let chunk1: 'U[] = Array.zeroCreate ((array.Length >>> 2) + 1)
+
+            chunk1.[0] <- first
+            let mutable count = 1
+            i <- i + 1
+
+            while count < chunk1.Length && i < array.Length do
+                let element = array.[i]
+
+                match chooser element with
+                | ValueNone -> ()
+                | ValueSome b ->
+                    chunk1.[count] <- b
+                    count <- count + 1
+
+                i <- i + 1
+
+            if i < array.Length then
+                let chunk2: 'U[] = Array.zeroCreate (array.Length - i)
+
+                count <- 0
+
+                while i < array.Length do
+                    let element = array.[i]
+
+                    match chooser element with
+                    | ValueNone -> ()
+                    | ValueSome b ->
+                        chunk2.[count] <- b
+                        count <- count + 1
+
+                    i <- i + 1
+
+                let res: 'U[] = Array.zeroCreate (chunk1.Length + count)
+
+                Array.Copy(chunk1, res, chunk1.Length)
+                Array.Copy(chunk2, 0, res, chunk1.Length, count)
+                res
+            else
+                Array.sub chunk1 0 count
+        else
+            Array.empty
+
+[<RequireQualifiedAccess>]
+module ImmutableArray =
+    let inline tryHeadV (xs: ImmutableArray<'T>) : 'T voption =
+        if xs.Length = 0 then ValueNone else ValueSome xs[0]
+
+    let inline empty<'T> = ImmutableArray<'T>.Empty
+
+    let inline create<'T> (x: 'T) = ImmutableArray.Create<'T>(x)
+
 [<RequireQualifiedAccess>]
 module List =
     let rec tryFindV predicate list =