Implement DocumentHighlightsService

vsintegration/src/FSharp.Editor/CommonHelpers.fs

@@ -15,7 +15,12 @@ open Microsoft.VisualStudio.FSharp.LanguageService
 open Microsoft.FSharp.Compiler.SourceCodeServices
 open Microsoft.FSharp.Compiler.SourceCodeServices.ItemDescriptionIcons
 
-module CommonHelpers =
+[<RequireQualifiedAccess>]
+type internal SymbolSearchKind =
+    | IncludeRightColumn
+    | DoesNotIncludeRightColumn
+
+module internal CommonHelpers =
     type private SourceLineData(lineStart: int, lexStateAtStartOfLine: FSharpTokenizerLexState, lexStateAtEndOfLine: FSharpTokenizerLexState, hashCode: int, classifiedSpans: IReadOnlyList<ClassifiedSpan>) =
         member val LineStart = lineStart
         member val LexStateAtStartOfLine = lexStateAtStartOfLine
@@ -96,7 +101,8 @@ module CommonHelpers =
 
         SourceLineData(textLine.Start, lexState, previousLexState.Value, lineContents.GetHashCode(), classifiedSpans)
 
-    let getColorizationData(documentKey: DocumentId, sourceText: SourceText, textSpan: TextSpan, fileName: string option, defines: string list, cancellationToken: CancellationToken) : List<ClassifiedSpan> =
+    let getColorizationData(documentKey: DocumentId, sourceText: SourceText, textSpan: TextSpan, fileName: string option, defines: string list, 
+                            cancellationToken: CancellationToken) : List<ClassifiedSpan> =
         try
             let sourceTokenizer = FSharpSourceTokenizer(defines, fileName)
             let lines = sourceText.Lines
@@ -159,36 +165,40 @@ module CommonHelpers =
             Assert.Exception(ex)
             List<ClassifiedSpan>()
 
-    let tryClassifyAtPosition (documentKey, sourceText: SourceText, filePath, defines, position: int, cancellationToken) =
+    let tryClassifyAtPosition (documentKey, sourceText: SourceText, filePath, defines, position: int, symbolSearchKind: SymbolSearchKind, cancellationToken) =
         let textLine = sourceText.Lines.GetLineFromPosition(position)
         let textLinePos = sourceText.Lines.GetLinePosition(position)
         let textLineColumn = textLinePos.Character
+        let spans = getColorizationData(documentKey, sourceText, textLine.Span, Some filePath, defines, cancellationToken)
 
-        let classifiedSpanOption =
-            getColorizationData(documentKey, sourceText, textLine.Span, Some(filePath), defines, cancellationToken)
-            |> Seq.tryFind(fun classifiedSpan -> classifiedSpan.TextSpan.Contains(position))
-
-        match classifiedSpanOption with
-        | Some(classifiedSpan) ->
-            match classifiedSpan.ClassificationType with
-            | ClassificationTypeNames.ClassName
-            | ClassificationTypeNames.DelegateName
-            | ClassificationTypeNames.EnumName
-            | ClassificationTypeNames.InterfaceName
-            | ClassificationTypeNames.ModuleName
-            | ClassificationTypeNames.StructName
-            | ClassificationTypeNames.TypeParameterName
-            | ClassificationTypeNames.Identifier -> 
-                match QuickParse.GetCompleteIdentifierIsland true (textLine.ToString()) textLineColumn with
-                | Some (islandIdentifier, islandColumn, isQuoted) -> 
-                    let qualifiers = if isQuoted then [islandIdentifier] else islandIdentifier.Split '.' |> Array.toList
-                    Some (islandColumn, qualifiers, classifiedSpan.TextSpan)
-                | None -> None
-            | ClassificationTypeNames.Operator ->
-                let islandColumn = sourceText.Lines.GetLinePositionSpan(classifiedSpan.TextSpan).End.Character
-                Some (islandColumn, [""], classifiedSpan.TextSpan) 
+        let attempt (position: int) =
+            let classifiedSpanOption = spans |> Seq.tryFind (fun classifiedSpan -> classifiedSpan.TextSpan.Contains position)
+
+            match classifiedSpanOption with
+            | Some(classifiedSpan) ->
+                match classifiedSpan.ClassificationType with
+                | ClassificationTypeNames.ClassName
+                | ClassificationTypeNames.DelegateName
+                | ClassificationTypeNames.EnumName
+                | ClassificationTypeNames.InterfaceName
+                | ClassificationTypeNames.ModuleName
+                | ClassificationTypeNames.StructName
+                | ClassificationTypeNames.TypeParameterName
+                | ClassificationTypeNames.Identifier -> 
+                    match QuickParse.GetCompleteIdentifierIsland true (textLine.ToString()) textLineColumn with
+                    | Some (islandIdentifier, islandColumn, isQuoted) -> 
+                        let qualifiers = if isQuoted then [islandIdentifier] else islandIdentifier.Split '.' |> Array.toList
+                        Some (islandColumn, qualifiers, classifiedSpan.TextSpan)
+                    | None -> None
+                | ClassificationTypeNames.Operator ->
+                    let islandColumn = sourceText.Lines.GetLinePositionSpan(classifiedSpan.TextSpan).End.Character
+                    Some (islandColumn, [""], classifiedSpan.TextSpan) 
+                | _ -> None
             | _ -> None
-        | _ -> None
+
+        match attempt position, symbolSearchKind with
+        | None, SymbolSearchKind.IncludeRightColumn -> attempt (position - 1)
+        | x, _ -> x
 
     /// Fix invalid span if it appears to have redundant suffix and prefix.
     let fixupSpan (sourceText: SourceText, span: TextSpan) : TextSpan =

vsintegration/src/FSharp.Editor/DocumentHighlights/DocumentHighlightsService.fs

@@ -0,0 +1,115 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
+
+namespace Microsoft.VisualStudio.FSharp.Editor
+
+open System
+open System.Composition
+open System.Collections.Concurrent
+open System.Collections.Generic
+open System.Collections.Immutable
+open System.Threading
+open System.Threading.Tasks
+open System.Linq
+open System.Runtime.CompilerServices
+
+open Microsoft.CodeAnalysis
+open Microsoft.CodeAnalysis.Completion
+open Microsoft.CodeAnalysis.Classification
+open Microsoft.CodeAnalysis.Editor
+open Microsoft.CodeAnalysis.Editor.Implementation.ReferenceHighlighting
+open Microsoft.CodeAnalysis.Host.Mef
+open Microsoft.CodeAnalysis.Options
+open Microsoft.CodeAnalysis.Text
+
+open Microsoft.VisualStudio.FSharp.LanguageService
+open Microsoft.VisualStudio.Text
+open Microsoft.VisualStudio.Text.Classification
+open Microsoft.VisualStudio.Text.Tagging
+
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.Parser
+open Microsoft.FSharp.Compiler.Range
+open Microsoft.FSharp.Compiler.SourceCodeServices
+open System.Windows.Documents
+
+type internal FSharpHighlightSpan =
+    { IsDefinition: bool
+      TextSpan: TextSpan }
+    override this.ToString() = sprintf "%+A" this
+
+[<Shared>]
+[<ExportLanguageService(typeof<IDocumentHighlightsService>, FSharpCommonConstants.FSharpLanguageName)>]
+type internal FSharpDocumentHighlightsService [<ImportingConstructor>] (checkerProvider: FSharpCheckerProvider, projectInfoManager: ProjectInfoManager) =
+
+    /// Fix invalid spans if they appear to have redundant suffix and prefix.
+    static let fixInvalidSymbolSpans (sourceText: SourceText) (lastIdent: string) (spans: FSharpHighlightSpan []) =
+        spans
+        |> Seq.choose (fun (span: FSharpHighlightSpan) ->
+            let newLastIdent = sourceText.GetSubText(span.TextSpan).ToString()
+            let index = newLastIdent.LastIndexOf(lastIdent, StringComparison.Ordinal)
+            if index > 0 then 
+                // Sometimes FCS returns a composite identifier for a short symbol, so we truncate the prefix
+                // Example: newLastIdent --> "x.Length", lastIdent --> "Length"
+                Some { span with TextSpan = TextSpan(span.TextSpan.Start + index, span.TextSpan.Length - index) }
+            elif index = 0 && newLastIdent.Length > lastIdent.Length then
+                // The returned symbol use is too long; we truncate its redundant suffix
+                // Example: newLastIdent --> "Length<'T>", lastIdent --> "Length"
+                Some { span with TextSpan = TextSpan(span.TextSpan.Start, lastIdent.Length) }
+            elif index = 0 then
+                Some span
+            else
+                // In the case of attributes, a returned symbol use may be a part of original text
+                // Example: newLastIdent --> "Sample", lastIdent --> "SampleAttribute"
+                let index = lastIdent.LastIndexOf(newLastIdent, StringComparison.Ordinal)
+                if index >= 0 then
+                    Some span
+                else None)
+        |> Seq.distinctBy (fun span -> span.TextSpan.Start)
+        |> Seq.toArray
+
+    static member GetDocumentHighlights(checker: FSharpChecker, documentKey: DocumentId, sourceText: SourceText, filePath: string, position: int, 
+                                        defines: string list, options: FSharpProjectOptions, textVersionHash: int, cancellationToken: CancellationToken) : Async<FSharpHighlightSpan[]> =
+        async {
+            let textLine = sourceText.Lines.GetLineFromPosition(position)
+            let textLinePos = sourceText.Lines.GetLinePosition(position)
+            let fcsTextLineNumber = textLinePos.Line + 1
+
+            match CommonHelpers.tryClassifyAtPosition(documentKey, sourceText, filePath, defines, position, SymbolSearchKind.IncludeRightColumn, cancellationToken) with
+            | Some (_, [], _) -> return [||]
+            | Some (islandEndColumn, qualifiers, _span) -> 
+                let! _parseResults, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, textVersionHash, sourceText.ToString(), options)
+                match checkFileAnswer with
+                | FSharpCheckFileAnswer.Aborted -> return [||]
+                | FSharpCheckFileAnswer.Succeeded(checkFileResults) ->
+                    let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, islandEndColumn, textLine.ToString(), qualifiers)
+                    match symbolUse with
+                    | Some symbolUse ->
+                        let! symbolUses = checkFileResults.GetUsesOfSymbolInFile(symbolUse.Symbol)
+                        let lastIdent = List.last qualifiers
+                        return 
+                            [| for symbolUse in symbolUses do
+                                 yield { IsDefinition = symbolUse.IsFromDefinition
+                                         TextSpan = CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, symbolUse.RangeAlternate) } |]
+                            |> fixInvalidSymbolSpans sourceText lastIdent
+                    | None -> return [||]
+            | None -> return [||]
+        }        
+
+    interface IDocumentHighlightsService with
+        member __.GetDocumentHighlightsAsync(document, position, _documentsToSearch, cancellationToken) : Task<ImmutableArray<DocumentHighlights>> =
+            async {
+                 match projectInfoManager.TryGetOptionsForEditingDocumentOrProject(document)  with 
+                 | Some options ->
+                     let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask
+                     let! textVersion = document.GetTextVersionAsync(cancellationToken) |> Async.AwaitTask
+                     let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList)
+                     let! spans = FSharpDocumentHighlightsService.GetDocumentHighlights(checkerProvider.Checker, document.Id, sourceText, document.FilePath, position, defines, options, textVersion.GetHashCode(), cancellationToken)
+
+                     let highlightSpans = spans |> Array.map (fun span ->
+                        let kind = if span.IsDefinition then HighlightSpanKind.Definition else HighlightSpanKind.Reference
+                        HighlightSpan(span.TextSpan, kind))
+
+                     return [| DocumentHighlights(document, highlightSpans.ToImmutableArray()) |].ToImmutableArray()
+                 | None -> return ImmutableArray<DocumentHighlights>()
+            }   
+            |> CommonRoslynHelpers.StartAsyncAsTask(cancellationToken)

vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj

@@ -34,13 +34,17 @@
     <Compile Include="LanguageService.fs" />
     <Compile Include="Classification\ColorizationService.fs" />
     <Compile Include="Utilities\BraceMatchingService.fs" />
-    <Compile Include="Utilities\IndentationService.fs" />
-    <Compile Include="Debugging\BreakpointResolutionService.fs" />
-    <Compile Include="Debugging\LanguageDebugInfoService.fs" />
-    <Compile Include="Diagnostics\DocumentDiagnosticAnalyzer.fs" />
-    <Compile Include="Diagnostics\ProjectDiagnosticAnalyzer.fs" />
-    <Compile Include="Completion\CompletionProvider.fs" />
-    <Compile Include="Completion\SignatureHelp.fs" />
+    <Compile Include="Utilities\IndentationService.fs"/>
+    <Compile Include="Debugging\BreakpointResolutionService.fs"/>
+    <Compile Include="Debugging\LanguageDebugInfoService.fs"/>
+    <Compile Include="Diagnostics\DocumentDiagnosticAnalyzer.fs"/>
+    <Compile Include="Diagnostics\ProjectDiagnosticAnalyzer.fs"/>
+    <Compile Include="Completion\CompletionProvider.fs"/>
+    <Compile Include="Completion\SignatureHelp.fs"/>
+    <Compile Include="BlockComment\CommentUncommentService.fs"/>
+    <Compile Include="QuickInfo\QuickInfoProvider.fs"/>
+    <Compile Include="DocumentHighlights\DocumentHighlightsService.fs" />
+    <Compile Include="HelpContextService.fs"/>
     <Compile Include="Navigation\GoToDefinitionService.fs" />
     <Compile Include="Navigation\NavigationBarItemService.fs" />
     <Compile Include="Navigation\NavigateToSearchService.fs" />

vsintegration/src/FSharp.Editor/Navigation/GoToDefinitionService.fs

@@ -53,7 +53,7 @@ type internal FSharpGoToDefinitionService
             let textLine = sourceText.Lines.GetLineFromPosition(position)
             let textLinePos = sourceText.Lines.GetLinePosition(position)
             let fcsTextLineNumber = textLinePos.Line + 1 // Roslyn line numbers are zero-based, FSharp.Compiler.Service line numbers are 1-based
-            match CommonHelpers.tryClassifyAtPosition(documentKey, sourceText, filePath, defines, position, cancellationToken) with 
+            match CommonHelpers.tryClassifyAtPosition(documentKey, sourceText, filePath, defines, position, SymbolSearchKind.IncludeRightColumn, cancellationToken) with 
             | Some (islandColumn, qualifiers, _) -> 
                 let! _parseResults, checkFileAnswer = checker.ParseAndCheckFileInProject(filePath, textVersionHash, sourceText.ToString(), options)
                 match checkFileAnswer with

vsintegration/src/FSharp.Editor/QuickInfo/QuickInfoProvider.fs

@@ -85,7 +85,7 @@ type internal FSharpQuickInfoProvider
             //let qualifyingNames, partialName = QuickParse.GetPartialLongNameEx(textLine.ToString(), textLineColumn - 1)
             let defines = CompilerEnvironment.GetCompilationDefinesForEditing(filePath, options.OtherOptions |> Seq.toList)
             let tryClassifyAtPosition position = 
-                CommonHelpers.tryClassifyAtPosition(documentId, sourceText, filePath, defines, position, cancellationToken)
+                CommonHelpers.tryClassifyAtPosition(documentId, sourceText, filePath, defines, position, SymbolSearchKind.DoesNotIncludeRightColumn, cancellationToken)
 
             let quickParseInfo = 
                 match tryClassifyAtPosition position with 
@@ -107,7 +107,8 @@ type internal FSharpQuickInfoProvider
             async {
                 let! sourceText = document.GetTextAsync(cancellationToken) |> Async.AwaitTask
                 let defines = projectInfoManager.GetCompilationDefinesForEditingDocument(document)  
-                let classification = CommonHelpers.tryClassifyAtPosition(document.Id, sourceText, document.FilePath, defines, position, cancellationToken)
+                let classification = 
+                    CommonHelpers.tryClassifyAtPosition(document.Id, sourceText, document.FilePath, defines, position, SymbolSearchKind.DoesNotIncludeRightColumn, cancellationToken)
 
                 match classification with
                 | Some _ ->

vsintegration/tests/unittests/DocumentHighlightsServiceTests.fs

@@ -0,0 +1,101 @@
+
+// To run the tests in this file:
+//
+// Technique 1: Compile VisualFSharp.Unittests.dll and run it as a set of unit tests
+//
+// Technique 2:
+//
+//   Enable some tests in the #if EXE section at the end of the file, 
+//   then compile this file as an EXE that has InternalsVisibleTo access into the
+//   appropriate DLLs.  This can be the quickest way to get turnaround on updating the tests
+//   and capturing large amounts of structured output.
+(*
+    cd Debug\net40\bin
+    .\fsc.exe --define:EXE -r:.\Microsoft.Build.Utilities.Core.dll -o VisualFSharp.Unittests.exe -g --optimize- -r .\FSharp.LanguageService.Compiler.dll  -r .\FSharp.Editor.dll -r nunit.framework.dll ..\..\..\tests\service\FsUnit.fs ..\..\..\tests\service\Common.fs /delaysign /keyfile:..\..\..\src\fsharp\msft.pubkey ..\..\..\vsintegration\tests\unittests\CompletionProviderTests.fs 
+    .\VisualFSharp.Unittests.exe 
+*)
+// Technique 3: 
+// 
+//    Use F# Interactive.  This only works for FSharp.Compiler.Service.dll which has a public API
+
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  Licensed under the Apache License, Version 2.0.  See License.txt in the project root for license information.
+module Microsoft.VisualStudio.FSharp.Editor.Tests.Roslyn.DocumentHighlightsServiceTests
+
+open System
+open System.Threading
+
+open NUnit.Framework
+
+open Microsoft.CodeAnalysis
+open Microsoft.CodeAnalysis.Text
+open Microsoft.VisualStudio.FSharp.Editor
+
+open Microsoft.FSharp.Compiler
+open Microsoft.FSharp.Compiler.SourceCodeServices
+
+let filePath = "C:\\test.fs"
+
+let internal options = { 
+    ProjectFileName = "C:\\test.fsproj"
+    ProjectFileNames =  [| filePath |]
+    ReferencedProjects = [| |]
+    OtherOptions = [| |]
+    IsIncompleteTypeCheckEnvironment = true
+    UseScriptResolutionRules = false
+    LoadTime = DateTime.MaxValue
+    UnresolvedReferences = None
+    ExtraProjectInfo = None
+}
+
+let private getSpans (sourceText: SourceText) (caretPosition: int) =
+    let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
+    FSharpDocumentHighlightsService.GetDocumentHighlights(
+        FSharpChecker.Instance, documentId, sourceText, filePath, caretPosition, [], options, 0, CancellationToken.None)
+    |> Async.RunSynchronously
+
+let private span sourceText isDefinition (startLine, startCol) (endLine, endCol) =
+    let range = Range.mkRange filePath (Range.mkPos startLine startCol) (Range.mkPos endLine endCol)
+    { IsDefinition = isDefinition
+      TextSpan = CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, range) }
+
+[<Test>]
+let ShouldHighlightAllSimpleLocalSymbolReferences() =
+    let fileContents = """
+    let foo x = 
+        x + x
+    let y = foo 2
+    """
+    let sourceText = SourceText.From(fileContents)
+    let caretPosition = fileContents.IndexOf("foo") + 1
+    let spans = getSpans sourceText caretPosition
+
+    let expected =
+        [| span sourceText true (2, 8) (2, 11)
+           span sourceText false (4, 12) (4, 15) |]
+
+    Assert.AreEqual(expected, spans)
+
+[<Test>]
+let ShouldHighlightAllQualifiedSymbolReferences() =
+    let fileContents = """
+    let x = System.DateTime.Now
+    let y = System.DateTime.MaxValue
+    """
+    let sourceText = SourceText.From(fileContents)
+    let caretPosition = fileContents.IndexOf("DateTime") + 1
+    let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
+
+    let spans = getSpans sourceText caretPosition
+
+    let expected =
+        [| span sourceText false (2, 19) (2, 27)
+           span sourceText false (3, 19) (3, 27) |]
+
+    Assert.AreEqual(expected, spans)
+
+    let caretPosition = fileContents.IndexOf("Now") + 1
+    let documentId = DocumentId.CreateNewId(ProjectId.CreateNewId())
+    let spans = getSpans sourceText caretPosition
+    let expected = [| span sourceText false (2, 28) (2, 31) |]
+
+    Assert.AreEqual(expected, spans)