More VS cleanup

vsintegration/src/FSharp.Editor/AutomaticCompletion/BraceCompletionSessionProvider.fs

@@ -22,14 +22,10 @@ open Microsoft.CodeAnalysis.Classification
 [<AutoOpen>]
 module BraceCompletionSessionProviderHelpers =
 
-    let tryGetCaretPoint (buffer: ITextBuffer) (session: IBraceCompletionSession) =
-        let point =
-            session.TextView.Caret.Position.Point.GetPoint(buffer, PositionAffinity.Predecessor)
+    let inline tryGetCaretPoint (buffer: ITextBuffer) (session: IBraceCompletionSession) =
+        ValueOption.ofNullable (session.TextView.Caret.Position.Point.GetPoint(buffer, PositionAffinity.Predecessor))
 
-        if point.HasValue then Some point.Value else None
-
-    let tryGetCaretPosition session =
-        session |> tryGetCaretPoint session.SubjectBuffer
+    let inline tryGetCaretPosition (session: IBraceCompletionSession) =  tryGetCaretPoint session.SubjectBuffer session
 
     let tryInsertAdditionalBracePair (session: IBraceCompletionSession) openingChar closingChar =
         let sourceCode = session.TextView.TextSnapshot
@@ -134,13 +130,13 @@ type BraceCompletionSession
                                 // exit without setting the closing point which will take us off the stack
                                 edit.Cancel()
                                 undo.Cancel()
-                                None
+                                ValueNone
                             else
-                                Some(edit.Apply()) // FIXME: perhaps, it should be ApplyAndLogExceptions()
+                                ValueSome(edit.Apply()) // FIXME: perhaps, it should be ApplyAndLogExceptions()
 
                         match nextSnapshot with
-                        | None -> ()
-                        | Some (nextSnapshot) ->
+                        | ValueNone -> ()
+                        | ValueSome (nextSnapshot) ->
 
                             let beforePoint = beforeTrackingPoint.GetPoint(textView.TextSnapshot)
 
@@ -185,7 +181,7 @@ type BraceCompletionSession
 
         if closingSnapshotPoint.Position > 0 then
             match tryGetCaretPosition this with
-            | Some caretPos when not (this.HasNoForwardTyping(caretPos, closingSnapshotPoint.Subtract(1))) -> true
+            | ValueSome caretPos when not (this.HasNoForwardTyping(caretPos, closingSnapshotPoint.Subtract(1))) -> true
             | _ -> false
         else
             false
@@ -265,7 +261,7 @@ type BraceCompletionSession
 
                     match caretPos with
                     // ensure that we are within the session before clearing
-                    | Some caretPos when
+                    | ValueSome caretPos when
                         caretPos.Position < closingSnapshotPoint.Position
                         && closingSnapshotPoint.Position > 0
                         ->
@@ -310,7 +306,7 @@ type BraceCompletionSession
 
         member this.PostReturn() =
             match tryGetCaretPosition this with
-            | Some caretPos ->
+            | ValueSome caretPos ->
                 let closingSnapshotPoint = closingPoint.GetPoint(subjectBuffer.CurrentSnapshot)
 
                 if
@@ -580,13 +576,13 @@ type BraceCompletionSessionProvider [<ImportingConstructor>]
                 maybe {
                     let! document =
                         openingPoint.Snapshot.GetOpenDocumentInCurrentContextWithChanges()
-                        |> Option.ofObj
+                        |> ValueOption.ofObj
 
                     let! sessionFactory = document.TryGetLanguageService<IEditorBraceCompletionSessionFactory>()
 
                     let! session =
                         sessionFactory.TryCreateSession(document, openingPoint.Position, openingBrace, CancellationToken.None)
-                        |> Option.ofObj
+                        |> ValueOption.ofObj
 
                     let undoHistory =
                         undoManager.GetTextBufferUndoManager(textView.TextBuffer).TextBufferUndoHistory

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,29 @@ 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 +218,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 +233,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()
@@ -226,29 +247,53 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                             TelemetryReporter.ReportSingleEventWithDuration(TelemetryEvents.AddSemanticCalssifications, eventProps)
 
                         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)
+                        if classificationData.Length > 0 then
+                            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/CodeFixes/AddOpenCodeFixProvider.fs

@@ -55,21 +55,26 @@ type internal AddOpenCodeFixProvider [<ImportingConstructor>] (assemblyContentPr
 
                 // attribute, shouldn't be here
                 | line when line.StartsWith "[<" && line.EndsWith ">]" ->
-                    let moduleDeclLineNumber =
+                    let moduleDeclLineNumberOpt =
                         sourceText.Lines
                         |> Seq.skip insertionLineNumber
-                        |> Seq.findIndex (fun line -> line.ToString().Contains "module")
-                        // add back the skipped lines
-                        |> fun i -> insertionLineNumber + i
+                        |> Seq.tryFindIndex (fun line -> line.ToString().Contains "module")
 
-                    let moduleDeclLineText = sourceText.Lines[ moduleDeclLineNumber ].ToString().Trim()
+                    match moduleDeclLineNumberOpt with
+                    // implicit top level module
+                    | None -> insertionLineNumber, $"{margin}open {ns}{br}{br}"
+                    // explicit top level module
+                    | Some number ->
+                        // add back the skipped lines
+                        let moduleDeclLineNumber = insertionLineNumber + number
+                        let moduleDeclLineText = sourceText.Lines[ moduleDeclLineNumber ].ToString().Trim()
 
-                    if moduleDeclLineText.EndsWith "=" then
-                        insertionLineNumber, $"{margin}open {ns}{br}{br}"
-                    else
-                        moduleDeclLineNumber + 2, $"{margin}open {ns}{br}{br}"
+                        if moduleDeclLineText.EndsWith "=" then
+                            insertionLineNumber, $"{margin}open {ns}{br}{br}"
+                        else
+                            moduleDeclLineNumber + 2, $"{margin}open {ns}{br}{br}"
 
-                // something else, shot in the dark
+                // implicit top level module
                 | _ -> insertionLineNumber, $"{margin}open {ns}{br}{br}"
 
             | ScopeKind.Namespace -> insertionLineNumber + 3, $"{margin}open {ns}{br}{br}"

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)
 
@@ -1096,17 +1096,18 @@ module CancellableTasks =
         let inline whenAll (tasks: CancellableTask<'a> seq) =
             cancellableTask {
                 let! ct = getCancellationToken ()
-                return! Task.WhenAll (seq { for task in tasks do yield start ct task })
+                let tasks = seq { for task in tasks do yield start ct task }
+                return! Task.WhenAll (tasks)
             }
 
         let inline whenAllTasks (tasks: CancellableTask seq) =
             cancellableTask {
                 let! ct = getCancellationToken ()
-                return! Task.WhenAll (seq { for task in tasks do yield startTask ct task })
+                let tasks = seq { for task in tasks do yield startTask ct task }
+                return! Task.WhenAll (tasks)
             }
 
-        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 ()