VS: Assorted QuickInfo improvements

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

@@ -88,8 +88,7 @@
     <Compile Include="Navigation\NavigateToSearchService.fs" />
     <Compile Include="Navigation\FindUsagesService.fs" />
     <Compile Include="Navigation\FindDefinitionService.fs" />
-    <Compile Include="QuickInfo\NavigableTextRun.fs" />
-    <Compile Include="QuickInfo\WpfNagivableTextRunViewElementFactory.fs" />
+    <Compile Include="QuickInfo\WpfFactories.fs" />
     <Compile Include="QuickInfo\Views.fs" />
     <Compile Include="QuickInfo\QuickInfoProvider.fs" />
     <Compile Include="Structure\BlockStructureService.fs" />

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

@@ -493,7 +493,7 @@ type internal GoToDefinition(metadataAsSource: FSharpMetadataAsSourceService) =
         else
             statusBar.TempMessage (SR.CannotNavigateUnknown())
 
-type internal QuickInfo =
+type internal FSharpQuickInfo =
     { StructuredText: ToolTipText
       Span: TextSpan
       Symbol: FSharpSymbol option
@@ -512,7 +512,7 @@ module internal FSharpQuickInfo =
             declRange: range,
             cancellationToken: CancellationToken
         )
-        : Async<QuickInfo option> =
+        : Async<FSharpQuickInfo option> =
 
         asyncMaybe {
             let userOpName = "getQuickInfoFromRange"
@@ -553,7 +553,7 @@ module internal FSharpQuickInfo =
             position: int,
             cancellationToken: CancellationToken
         )
-        : Async<(range * QuickInfo option * QuickInfo option) option> =
+        : Async<(range * FSharpQuickInfo option * FSharpQuickInfo option) option> =
 
         asyncMaybe {
             let userOpName = "getQuickInfo"

vsintegration/src/FSharp.Editor/Options/EditorOptions.fs

@@ -127,7 +127,7 @@ module internal OptionsUI =
             let view = IntelliSenseOptionControl()
             view.charTyped.Unchecked.Add <| fun _ -> view.charDeleted.IsChecked <- System.Nullable false
 
-            let path = "EnterKeySetting"
+            let path = nameof EnterKeySetting
             bindRadioButton view.nevernewline path EnterKeySetting.NeverNewline 
             bindRadioButton view.newlinecompleteline path EnterKeySetting.NewlineOnCompleteWord 
             bindRadioButton view.alwaysnewline path EnterKeySetting.AlwaysNewline
@@ -139,11 +139,11 @@ module internal OptionsUI =
         inherit AbstractOptionPage<QuickInfoOptions>()
         override this.CreateView() = 
             let view = QuickInfoOptionControl()
-            let path = "UnderlineStyle"
+            let path = nameof QuickInfoOptions.Default.UnderlineStyle
             bindRadioButton view.solid path QuickInfoUnderlineStyle.Solid
             bindRadioButton view.dot path QuickInfoUnderlineStyle.Dot
             bindRadioButton view.dash path QuickInfoUnderlineStyle.Dash
-            bindCheckBox view.displayLinks "DisplayLinks"
+            bindCheckBox view.displayLinks (nameof QuickInfoOptions.Default.DisplayLinks)
             upcast view
 
     [<Guid(Guids.codeFixesOptionPageIdString)>]

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

@@ -1,8 +1,9 @@
 // Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
 
-namespace Microsoft.VisualStudio.FSharp.Editor
+namespace Microsoft.VisualStudio.FSharp.Editor.QuickInfo
 
 open System
+open System.IO
 open System.Threading
 open System.Threading.Tasks
 open System.ComponentModel.Composition
@@ -16,21 +17,17 @@ open Microsoft.VisualStudio.Shell
 open Microsoft.VisualStudio.Shell.Interop
 open Microsoft.VisualStudio.Text
 open Microsoft.VisualStudio.Utilities
+open Microsoft.VisualStudio.FSharp.Editor
 
-open FSharp.Compiler
-open FSharp.Compiler.CodeAnalysis
-open FSharp.Compiler.EditorServices
-open FSharp.Compiler.Symbols
 open FSharp.Compiler.Text
-open FSharp.Compiler.Tokenization
+open Microsoft.IO
 
 type internal FSharpAsyncQuickInfoSource
     (
         statusBar: StatusBar,
         xmlMemberIndexService: IVsXMLMemberIndexService,
         metadataAsSource: FSharpMetadataAsSourceService,
-        textBuffer:ITextBuffer,
-        _settings: EditorOptions
+        textBuffer: ITextBuffer
     ) =
 
     // test helper
@@ -40,7 +37,7 @@ type internal FSharpAsyncQuickInfoSource
             return! sigQuickInfo |> Option.orElse targetQuickInfo
         }
 
-    static member BuildSingleQuickInfoItem (documentationBuilder:IDocumentationBuilder) (quickInfo:QuickInfo) =
+    static member BuildSingleQuickInfoItem (documentationBuilder:IDocumentationBuilder) (quickInfo:FSharpQuickInfo) =
         let mainDescription, documentation, typeParameterMap, usage, exceptions = ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray(), ResizeArray()
         XmlDocumentation.BuildDataTipText(documentationBuilder, mainDescription.Add, documentation.Add, typeParameterMap.Add, usage.Add, exceptions.Add, quickInfo.StructuredText)
         let docs = RoslynHelpers.joinWithLineBreaks [documentation; typeParameterMap; usage; exceptions]
@@ -60,6 +57,14 @@ type internal FSharpAsyncQuickInfoSource
                 asyncMaybe {
                     let document = textBuffer.CurrentSnapshot.GetOpenDocumentInCurrentContextWithChanges()
                     let! symbolUseRange, sigQuickInfo, targetQuickInfo = FSharpQuickInfo.getQuickInfo(document, triggerPoint.Position, cancellationToken)
+
+                    let getTooltip filePath =
+                        let solutionDir = Path.GetDirectoryName(document.Project.Solution.FilePath)
+                        let projectDir = Path.GetDirectoryName(document.Project.FilePath)
+                        [ Path.GetRelativePath(projectDir, filePath)
+                          Path.GetRelativePath(solutionDir, filePath) ]
+                        |> List.minBy String.length
+
                     let getTrackingSpan (span:TextSpan) =
                         textBuffer.CurrentSnapshot.CreateTrackingSpan(span.Start, span.Length, SpanTrackingMode.EdgeInclusive)
 
@@ -71,7 +76,7 @@ type internal FSharpAsyncQuickInfoSource
                         let mainDescription, docs = FSharpAsyncQuickInfoSource.BuildSingleQuickInfoItem documentationBuilder quickInfo
                         let imageId = Tokenizer.GetImageIdForSymbol(quickInfo.Symbol, quickInfo.SymbolKind)
                         let navigation = FSharpNavigation(statusBar, metadataAsSource, document, symbolUseRange)
-                        let content = QuickInfoViewProvider.provideContent(imageId, mainDescription, docs, navigation)
+                        let content = QuickInfoViewProvider.provideContent(imageId, mainDescription |> List.ofSeq, [docs |> List.ofSeq], navigation, getTooltip)
                         let span = getTrackingSpan quickInfo.Span
                         return QuickInfoItem(span, content)
 
@@ -88,20 +93,21 @@ type internal FSharpAsyncQuickInfoSource
                                 |> string
                             if String.IsNullOrWhiteSpace text then None else Some text
 
-                        let documentation =
+                        let documentationParts: TaggedText list list =
                             [ match getText targetDocumentation, getText sigDocumentation with
                               | None, None -> ()
-                              | None, Some _ -> yield! sigDocumentation
-                              | Some _, None -> yield! targetDocumentation
+                              | None, Some _ -> sigDocumentation |> List.ofSeq
+                              | Some _, None -> targetDocumentation  |> List.ofSeq
                               | Some implText, Some sigText when implText.Equals (sigText, StringComparison.OrdinalIgnoreCase) ->
-                                    yield! sigDocumentation
+                                    sigDocumentation |> List.ofSeq
                               | Some _  , Some _ ->
-                                    yield! RoslynHelpers.joinWithLineBreaks [ sigDocumentation; [ TaggedText.tagText "-------------" ]; targetDocumentation ]
-                            ] |> ResizeArray
-                        let docs = RoslynHelpers.joinWithLineBreaks [documentation; typeParameterMap; usage; exceptions]
+                                    sigDocumentation  |> List.ofSeq
+                                    targetDocumentation  |> List.ofSeq
+                              RoslynHelpers.joinWithLineBreaks [typeParameterMap; usage; exceptions] |> List.ofSeq
+                            ]
                         let imageId = Tokenizer.GetImageIdForSymbol(targetQuickInfo.Symbol, targetQuickInfo.SymbolKind)
                         let navigation = FSharpNavigation(statusBar, metadataAsSource, document, symbolUseRange)
-                        let content = QuickInfoViewProvider.provideContent(imageId, mainDescription, docs, navigation)
+                        let content = QuickInfoViewProvider.provideContent(imageId, mainDescription |> List.ofSeq, documentationParts, navigation, getTooltip)
                         let span = getTrackingSpan targetQuickInfo.Span
                         return QuickInfoItem(span, content)
                 }   |> Async.map Option.toObj
@@ -115,8 +121,7 @@ type internal FSharpAsyncQuickInfoSourceProvider
     [<ImportingConstructor>]
     (
         [<Import(typeof<SVsServiceProvider>)>] serviceProvider: IServiceProvider,
-        metadataAsSource: FSharpMetadataAsSourceService,
-        settings: EditorOptions
+        metadataAsSource: FSharpMetadataAsSourceService
     ) =
 
     interface IAsyncQuickInfoSourceProvider with
@@ -125,4 +130,4 @@ type internal FSharpAsyncQuickInfoSourceProvider
             // It is safe to do it here (see #4713)
             let statusBar = StatusBar(serviceProvider.GetService<SVsStatusbar,IVsStatusbar>())
             let xmlMemberIndexService = serviceProvider.XMLMemberIndexService
-            new FSharpAsyncQuickInfoSource(statusBar, xmlMemberIndexService, metadataAsSource, textBuffer, settings) :> IAsyncQuickInfoSource
+            new FSharpAsyncQuickInfoSource(statusBar, xmlMemberIndexService, metadataAsSource, textBuffer) :> IAsyncQuickInfoSource

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

@@ -1,18 +1,18 @@
 // Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
 
-namespace Microsoft.VisualStudio.FSharp.Editor
+namespace Microsoft.VisualStudio.FSharp.Editor.QuickInfo
 
-open System.Collections.Generic
 open System.Threading
 open FSharp.Compiler.Text
 open Microsoft.CodeAnalysis.Classification
 open Microsoft.VisualStudio.Core.Imaging
-open Microsoft.VisualStudio.Language.StandardClassification
 open Microsoft.VisualStudio.Text.Adornments
 
+open Microsoft.VisualStudio.FSharp.Editor
+
 module internal QuickInfoViewProvider =
 
-    let layoutTagToClassificationTag (layoutTag:TextTag) =
+    let layoutTagToClassificationTag (layoutTag: TextTag) =
         match layoutTag with
         | TextTag.ActivePatternCase
         | TextTag.ActivePatternResult
@@ -49,54 +49,57 @@ module internal QuickInfoViewProvider =
         | TextTag.UnknownEntity
         | TextTag.Text -> ClassificationTypeNames.Text
 
+    let (|TaggedText|) (tt: TaggedText) = tt.Tag, tt.Text
+
+    let (|LineBreak|_|) =
+        function TaggedText (TextTag.LineBreak, _) -> Some () | _ -> None
+
+    let (|DocSeparator|_|) =
+        function LineBreak :: TaggedText (TextTag.Text, "-------------") :: LineBreak :: rest -> Some rest | _ -> None
+
+    let wrapContent (elements: obj list) =
+        ContainerElement(ContainerElementStyle.Wrapped, elements |> Seq.map box)
+
+    let stackContent (elements: obj list) =
+        ContainerElement(ContainerElementStyle.Stacked, elements |> Seq.map box)
+
+    let encloseRuns runs = wrapContent (runs |> List.rev) |> box
+
+    let emptyLine = wrapContent [ ClassifiedTextRun(ClassificationTypeNames.WhiteSpace, "") |> box ]
+
     let provideContent
         (
-            imageId:ImageId option,
-            description: seq<TaggedText>,
-            documentation: seq<TaggedText>,
-            navigation:FSharpNavigation
+            imageId: ImageId option,
+            description: TaggedText list,
+            documentation: TaggedText list list,
+            navigation: FSharpNavigation,
+            getTooltip
         ) =
 
-        let buildContainerElement (itemGroup: seq<TaggedText>) =
-            let finalCollection = List<ContainerElement>()
-            let currentContainerItems = List<obj>()
-            let runsCollection = List<ClassifiedTextRun>()
-            let flushRuns() =
-                if runsCollection.Count > 0 then
-                    let element = ClassifiedTextElement(runsCollection)
-                    currentContainerItems.Add(element :> obj)
-                    runsCollection.Clear()
-            let flushContainer() =
-                if currentContainerItems.Count > 0 then
-                    let element = ContainerElement(ContainerElementStyle.Wrapped, currentContainerItems)
-                    finalCollection.Add(element)
-                    currentContainerItems.Clear()
-            for item in itemGroup do
-                let classificationTag = layoutTagToClassificationTag item.Tag
-                match item with
-                | :? NavigableTaggedText as nav when navigation.IsTargetValid nav.Range ->
-                    flushRuns()
-                    let navigableTextRun = NavigableTextRun(classificationTag, item.Text, fun () -> navigation.NavigateTo(nav.Range, CancellationToken.None))
-                    currentContainerItems.Add(navigableTextRun :> obj)
-                | _ when item.Tag = TextTag.LineBreak ->
-                    flushRuns()
-                    // preserve succesive linebreaks
-                    if currentContainerItems.Count = 0 then
-                        runsCollection.Add(ClassifiedTextRun(PredefinedClassificationTypeNames.Other, System.String.Empty))
-                        flushRuns()
-                    flushContainer()
-                | _ -> 
-                    let newRun = ClassifiedTextRun(classificationTag, item.Text)
-                    runsCollection.Add(newRun)   
-            flushRuns()
-            flushContainer()
-            ContainerElement(ContainerElementStyle.Stacked, finalCollection |> Seq.map box)
+        let encloseText text =
+            let rec loop text runs stack =
+                match (text: TaggedText list) with
+                | [] -> stackContent (encloseRuns runs :: stack |> List.rev)
+                | DocSeparator (LineBreak :: rest)
+                | DocSeparator rest -> loop rest [] (box Separator :: encloseRuns runs :: stack)
+                | LineBreak :: rest when runs |> List.isEmpty -> loop rest [] (emptyLine :: stack)
+                | LineBreak :: rest -> loop rest [] (encloseRuns runs :: stack)
+                | :? NavigableTaggedText as item :: rest when navigation.IsTargetValid item.Range ->
+                    let classificationTag = layoutTagToClassificationTag item.Tag
+                    let action = fun () -> navigation.NavigateTo(item.Range, CancellationToken.None)
+                    let run = ClassifiedTextRun(classificationTag, item.Text, action, getTooltip item.Range.FileName)
+                    loop rest (run :: runs) stack
+                | item :: rest ->
+                    let run = ClassifiedTextRun(layoutTagToClassificationTag item.Tag, item.Text)
+                    loop rest (run :: runs) stack
+
+            loop text [] [] |> box
 
         let innerElement =
             match imageId with
-            | Some imageId ->
-                ContainerElement(ContainerElementStyle.Wrapped, ImageElement(imageId), buildContainerElement description)
-            | None ->
-                ContainerElement(ContainerElementStyle.Wrapped, buildContainerElement description)
+            | Some imageId -> wrapContent [ stackContent [ ImageElement(imageId) ]; encloseText description ]
+            | None -> ContainerElement(ContainerElementStyle.Wrapped, encloseText description)
+
+        let separated = stackContent (documentation |> List.map encloseText)
 
-        ContainerElement(ContainerElementStyle.Stacked, innerElement, buildContainerElement documentation)
+        wrapContent [ stackContent [ innerElement; separated ] ]

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

@@ -0,0 +1,60 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Microsoft.VisualStudio.FSharp.Editor.QuickInfo
+
+open System.ComponentModel.Composition
+open System.Windows
+open System.Windows.Controls
+
+open Microsoft.VisualStudio.Text.Adornments
+open Microsoft.VisualStudio.Text.Editor
+open Microsoft.VisualStudio.Utilities
+
+open Microsoft.VisualStudio.FSharp.Editor
+
+type Separator = Separator
+
+[<Export(typeof<IViewElementFactory>)>]
+[<Name("QuickInfoElement to UIElement")>]
+[<TypeConversion(typeof<ClassifiedTextRun>, typeof<UIElement>)>]
+type WpfNavigableTextRunFactory [<ImportingConstructor>] (viewElementFactoryService: IViewElementFactoryService, settings: EditorOptions) =
+    let resources = Microsoft.VisualStudio.FSharp.UIResources.NavStyles().Resources
+
+    interface IViewElementFactory with
+        member _.CreateViewElement(textView: ITextView, model: obj) =
+            match model with
+            | :? ClassifiedTextRun as classifiedTextRun ->
+                // use the default converters to get a UIElement
+                let classifiedTextElement = ClassifiedTextElement([ classifiedTextRun ])
+
+                let convertedElement =
+                    viewElementFactoryService.CreateViewElement<UIElement>(textView, classifiedTextElement)
+                // Apply custom underline.
+                match convertedElement with
+                | :? TextBlock as tb when classifiedTextRun.NavigationAction <> null && settings.QuickInfo.DisplayLinks ->
+                    match tb.Inlines.FirstInline with
+                    | :? Documents.Hyperlink as hyperlink ->
+                        let key =
+                            match settings.QuickInfo.UnderlineStyle with
+                            | QuickInfoUnderlineStyle.Solid -> "solid_underline"
+                            | QuickInfoUnderlineStyle.Dash -> "dash_underline"
+                            | QuickInfoUnderlineStyle.Dot -> "dot_underline"
+                        // Fix color and apply styles.
+                        hyperlink.Foreground <- hyperlink.Inlines.FirstInline.Foreground
+                        hyperlink.Style <- downcast resources[key]
+                    | _ -> ()
+                | _ -> ()
+
+                box convertedElement :?> _
+            | _ ->
+                failwith $"Invalid type conversion.  Supported conversion is {typeof<ClassifiedTextRun>.Name} to {typeof<UIElement>.Name}."
+
+[<Export(typeof<IViewElementFactory>)>]
+[<Name("Separator to UIElement")>]
+[<TypeConversion(typeof<Separator>, typeof<UIElement>)>]
+type WpfSeparatorFactory() =
+    interface IViewElementFactory with
+        member _.CreateViewElement(_, model: obj) =
+            match model with
+            | :? Separator -> Controls.Separator(Opacity = 0.4, Margin = Thickness(0, 10, 0, 10)) |> box :?> _
+            | _ -> failwith $"Invalid type conversion.  Supported conversion is {typeof<Separator>.Name} to {typeof<UIElement>.Name}."