refactor quickinfo (#2861)

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

@@ -70,6 +70,8 @@
     <Compile Include="Navigation\NavigationBarItemService.fs" />
     <Compile Include="Navigation\NavigateToSearchService.fs" />
     <Compile Include="Navigation\FindUsagesService.fs" />
+    <Compile Include="QuickInfo\Navigation.fs" />
+    <Compile Include="QuickInfo\Views.fs" />
     <Compile Include="QuickInfo\QuickInfoProvider.fs" />
     <Compile Include="BlockComment\CommentUncommentService.fs" />
     <Compile Include="Structure\Structure.fs" />

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

+namespace Microsoft.VisualStudio.FSharp.Editor
+
+open Microsoft.CodeAnalysis
+
+open Microsoft.FSharp.Compiler.Range
+open Microsoft.FSharp.Compiler
+
+type internal QuickInfoNavigation
+    (
+        gotoDefinitionService: FSharpGoToDefinitionService,
+        initialDoc: Document,
+        thisSymbolUseRange: range
+    ) =
+    let workspace = initialDoc.Project.Solution.Workspace
+    let solution = workspace.CurrentSolution
+
+    member __.IsTargetValid (range: range) =
+        range <> rangeStartup &&
+        range <> thisSymbolUseRange &&
+        solution.TryGetDocumentIdFromFSharpRange (range, initialDoc.Project.Id) |> Option.isSome
+
+    member __.NavigateTo (range: range) = 
+        asyncMaybe { 
+            let targetPath = range.FileName 
+            let! targetDoc = solution.TryGetDocumentFromFSharpRange (range, initialDoc.Project.Id)
+            let! targetSource = targetDoc.GetTextAsync() 
+            let! targetTextSpan = RoslynHelpers.TryFSharpRangeToTextSpan (targetSource, range)
+            // to ensure proper navigation decsions we need to check the type of document the navigation call
+            // is originating from and the target we're provided by default
+            //  - signature files (.fsi) should navigate to other signature files 
+            //  - implementation files (.fs) should navigate to other implementation files
+            let (|Signature|Implementation|) filepath =
+                if isSignatureFile filepath then Signature else Implementation
+           
+            match initialDoc.FilePath, targetPath with 
+            | Signature, Signature 
+            | Implementation, Implementation ->
+                return gotoDefinitionService.TryNavigateToTextSpan (targetDoc, targetTextSpan)
+            // adjust the target from signature to implementation
+            | Implementation, Signature  ->
+                return! gotoDefinitionService.NavigateToSymbolDefinitionAsync (targetDoc, targetSource, range) |> liftAsync
+            // adjust the target from implmentation to signature
+            | Signature, Implementation -> 
+                return! gotoDefinitionService.NavigateToSymbolDeclarationAsync (targetDoc, targetSource, range) |> liftAsync
+        } |> Async.Ignore |> Async.StartImmediate

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

@@ -5,27 +5,17 @@ namespace Microsoft.VisualStudio.FSharp.Editor
 open System
 open System.Threading
 open System.Threading.Tasks
-open System.Windows
-open System.Windows.Controls
-open System.Windows.Data
-open System.Windows.Media
 open System.ComponentModel.Composition
 open System.Text
 
 open Microsoft.CodeAnalysis
-open Microsoft.CodeAnalysis.Classification
 open Microsoft.CodeAnalysis.Editor
-open Microsoft.CodeAnalysis.Editor.Shared.Utilities
-open Microsoft.CodeAnalysis.Editor.Shared.Extensions
-open Microsoft.CodeAnalysis.Editor.Implementation.IntelliSense.QuickInfo
 open Microsoft.CodeAnalysis.Text
 
 
 open Microsoft.VisualStudio.FSharp.LanguageService
 open Microsoft.VisualStudio.Shell
 open Microsoft.VisualStudio.Shell.Interop
-open Microsoft.VisualStudio.Utilities
-open Microsoft.VisualStudio.Language.Intellisense
 
 open Microsoft.FSharp.Compiler.SourceCodeServices
 open Microsoft.FSharp.Compiler.Range
@@ -33,59 +23,6 @@ open Microsoft.FSharp.Compiler
 
 open Internal.Utilities.StructuredFormat
 
-module private SessionHandling =
-    let mutable currentSession = None
-    
-    [<Export (typeof<IQuickInfoSourceProvider>)>]
-    [<Name (FSharpProviderConstants.SessionCapturingProvider)>]
-    [<Order (After = PredefinedQuickInfoProviderNames.Semantic)>]
-    [<ContentType (FSharpConstants.FSharpContentTypeName)>]
-    type SourceProviderForCapturingSession () =
-        interface IQuickInfoSourceProvider with 
-            member x.TryCreateQuickInfoSource _ =
-              { new IQuickInfoSource with
-                  member __.AugmentQuickInfoSession(session,_,_) = currentSession <- Some session
-                  member __.Dispose() = () }
-
-module private SourceLink =
-    let solid = 70uy, DashStyles.Solid
-    let dot = 255uy, DashStyle([1.0; 5.0], 0.0)
-    let dash = 90uy, DashStyle([5.0; 5.0], 0.0)
-    let none = 0uy, DashStyles.Solid
-    let opacityCoverter =
-        { new IValueConverter with
-              member this.Convert(value, _, parameter, _) =
-                  match value with 
-                  | :? Color as c -> Color.FromArgb(unbox parameter, c.R, c.G, c.B) :> _
-                  | _ -> Binding.DoNothing
-              member this.ConvertBack(_,_,_,_) = Binding.DoNothing }
-    let getUnderlineStyle() =
-        if not Settings.QuickInfo.DisplayLinks then none
-        else 
-            match Settings.QuickInfo.UnderlineStyle with
-            | QuickInfoUnderlineStyle.Solid -> solid
-            | QuickInfoUnderlineStyle.Dot -> dot
-            | QuickInfoUnderlineStyle.Dash -> dash
-
-
-type internal SourceLink(run) as this = 
-    inherit Documents.Hyperlink(run)   
-
-    let opacity, dashStyle = SourceLink.getUnderlineStyle()
-    let underlineBrush = Media.SolidColorBrush()
-    do BindingOperations.SetBinding(underlineBrush, SolidColorBrush.ColorProperty, Binding("Foreground.Color", Source = this, Converter = SourceLink.opacityCoverter, ConverterParameter = opacity)) |> ignore
-    let normalUnderline = TextDecorationCollection [TextDecoration(Location = TextDecorationLocation.Underline, PenOffset = 1.0)]
-    let slightUnderline = TextDecorationCollection [TextDecoration(Location = TextDecorationLocation.Underline, PenOffset = 1.0, Pen = Pen(Brush = underlineBrush, DashStyle = dashStyle))]
-    do this.TextDecorations <- slightUnderline
-
-    override this.OnMouseEnter(e) = 
-        base.OnMouseEnter(e)
-        this.TextDecorations <- normalUnderline
-
-    override this.OnMouseLeave(e) = 
-        base.OnMouseLeave(e)
-        this.TextDecorations <- slightUnderline
-
 type private TooltipInfo =
     { StructuredText: FSharpStructuredToolTipText 
       Span: TextSpan
@@ -93,13 +30,6 @@ type private TooltipInfo =
       SymbolKind: LexerSymbolKind }
 
 module private FSharpQuickInfo =
-    
-    let private empty = 
-        { new IDeferredQuickInfoContent with 
-            member x.Create() = TextBlock(Visibility = Visibility.Collapsed) :> FrameworkElement }
-
-    let createDeferredContent (symbolGlyph, mainDescription, documentation) =
-        QuickInfoDisplayDeferredContent(symbolGlyph, null, mainDescription, documentation, empty, empty, empty, empty)
 
     // when a construct has been declared in a signature file the documentation comments that are
     // written in that file are the ones that go into the generated xml when the project is compiled
@@ -234,83 +164,10 @@ type internal FSharpQuickInfoProvider
         [<System.ComponentModel.Composition.Import(typeof<SVsServiceProvider>)>] serviceProvider: IServiceProvider,
         checkerProvider: FSharpCheckerProvider,
         projectInfoManager: ProjectInfoManager,
-        typeMap: Shared.Utilities.ClassificationTypeMap,
-        gotoDefinitionService:FSharpGoToDefinitionService,
-        glyphService: IGlyphService
+        gotoDefinitionService: FSharpGoToDefinitionService,
+        viewProvider: QuickInfoViewProvider
     ) =
 
-    let fragment (content: Layout.TaggedText seq, typemap: ClassificationTypeMap, initialDoc: Document, thisSymbolUseRange: range) : IDeferredQuickInfoContent =
-
-        let workspace = initialDoc.Project.Solution.Workspace
-        let solution = workspace.CurrentSolution
-
-        let isTargetValid range =
-            range <> rangeStartup && solution.TryGetDocumentIdFromFSharpRange (range,initialDoc.Project.Id) |> Option.isSome
-
-        let navigateTo (range:range) = 
-            asyncMaybe { 
-                let targetPath = range.FileName 
-                let! targetDoc = solution.TryGetDocumentFromFSharpRange (range,initialDoc.Project.Id)
-                let! targetSource = targetDoc.GetTextAsync() 
-                let! targetTextSpan = RoslynHelpers.TryFSharpRangeToTextSpan (targetSource, range)
-                // to ensure proper navigation decsions we need to check the type of document the navigation call
-                // is originating from and the target we're provided by default
-                //  - signature files (.fsi) should navigate to other signature files 
-                //  - implementation files (.fs) should navigate to other implementation files
-                let (|Signature|Implementation|) filepath =
-                    if isSignatureFile filepath then Signature else Implementation
-
-                match initialDoc.FilePath, targetPath with 
-                | Signature, Signature 
-                | Implementation, Implementation ->
-                    return (gotoDefinitionService.TryNavigateToTextSpan (targetDoc, targetTextSpan))
-                // adjust the target from signature to implementation
-                | Implementation, Signature  ->
-                    return! gotoDefinitionService.NavigateToSymbolDefinitionAsync (targetDoc, targetSource, range)|>liftAsync
-                // adjust the target from implmentation to signature
-                | Signature, Implementation -> 
-                    return! gotoDefinitionService.NavigateToSymbolDeclarationAsync (targetDoc, targetSource, range)|>liftAsync
-            } 
-            |> Async.map(
-                function
-                | Some true -> SessionHandling.currentSession |> Option.iter (fun session -> session.Dismiss())
-                | _ -> ()) 
-            |> Async.Ignore 
-            |> Async.StartImmediate 
-
-        let formatMap = typemap.ClassificationFormatMapService.GetClassificationFormatMap "tooltip"
-
-        let layoutTagToFormatting (layoutTag: LayoutTag) =
-            layoutTag
-            |> RoslynHelpers.roslynTag
-            |> ClassificationTags.GetClassificationTypeName
-            |> typemap.GetClassificationType
-            |> formatMap.GetTextProperties
-
-        let inlines = 
-            seq { 
-                for taggedText in content do
-                    let run = Documents.Run taggedText.Text
-                    let inl =
-                        match taggedText with
-                        | :? Layout.NavigableTaggedText as nav when thisSymbolUseRange <> nav.Range && isTargetValid nav.Range ->                        
-                            let h = SourceLink (run, ToolTip = nav.Range.FileName)
-                            h.Click.Add (fun _ -> navigateTo nav.Range)
-                            h :> Documents.Inline
-                        | _ -> run :> _
-                    DependencyObjectExtensions.SetTextProperties (inl, layoutTagToFormatting taggedText.Tag)
-                    yield inl
-            }
-
-        let createTextLinks () =
-            let tb = TextBlock(TextWrapping = TextWrapping.Wrap, TextTrimming = TextTrimming.None)
-            DependencyObjectExtensions.SetDefaultTextProperties(tb, formatMap)
-            tb.Inlines.AddRange inlines
-            if tb.Inlines.Count = 0 then tb.Visibility <- Visibility.Collapsed
-            tb :> FrameworkElement
-            
-        { new IDeferredQuickInfoContent with member x.Create() = createTextLinks() }
-
     let xmlMemberIndexService = serviceProvider.GetService(typeof<SVsXMLMemberIndexService>) :?> IVsXMLMemberIndexService
     let documentationBuilder = XmlDocumentation.CreateDocumentationBuilder(xmlMemberIndexService, serviceProvider.DTE)
 
@@ -343,11 +200,9 @@ type internal FSharpQuickInfoProvider
                     let mainDescription = ResizeArray()
                     let documentation = ResizeArray()
                     XmlDocumentation.BuildDataTipText(documentationBuilder, mainDescription.Add, documentation.Add, tooltip.StructuredText)
-                    let content = 
-                        FSharpQuickInfo.createDeferredContent
-                            (SymbolGlyphDeferredContent(Tokenizer.GetGlyphForSymbol(tooltip.Symbol, tooltip.SymbolKind), glyphService),
-                             fragment (mainDescription, typeMap, document, symbolUse.RangeAlternate),
-                             fragment (documentation, typeMap, document, symbolUse.RangeAlternate))
+                    let glyph = Tokenizer.GetGlyphForSymbol(tooltip.Symbol, tooltip.SymbolKind)
+                    let navigation = QuickInfoNavigation(gotoDefinitionService, document, symbolUse.RangeAlternate)
+                    let content = viewProvider.ProvideContent( glyph, mainDescription, documentation, navigation)
                     return QuickInfoItem (tooltip.Span, content)
 
                 | Some sigTooltip, Some targetTooltip ->
@@ -387,13 +242,9 @@ type internal FSharpQuickInfoProvider
                               yield seperator
                               yield lineBreak
                               yield! targetDocumentation ]
-
-                    let content = 
-                        FSharpQuickInfo.createDeferredContent
-                            (SymbolGlyphDeferredContent (Tokenizer.GetGlyphForSymbol (targetTooltip.Symbol, targetTooltip.SymbolKind), glyphService),
-                            fragment (description, typeMap, document, symbolUse.RangeAlternate),
-                            fragment (documentation, typeMap, document, symbolUse.RangeAlternate))
-
+                    let glyph = Tokenizer.GetGlyphForSymbol(targetTooltip.Symbol, targetTooltip.SymbolKind)
+                    let navigation = QuickInfoNavigation(gotoDefinitionService, document, symbolUse.RangeAlternate)
+                    let content = viewProvider.ProvideContent(glyph, description, documentation, navigation)
                     return QuickInfoItem (targetTooltip.Span, content)
             }   |> Async.map Option.toObj
                 |> RoslynHelpers.StartAsyncAsTask cancellationToken 

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

+namespace Microsoft.VisualStudio.FSharp.Editor
+
+open System.ComponentModel.Composition
+open System.Windows
+open System.Windows.Controls
+open System.Windows.Data
+open System.Windows.Media
+
+open Microsoft.CodeAnalysis
+open Microsoft.CodeAnalysis.Classification
+open Microsoft.CodeAnalysis.Editor
+open Microsoft.CodeAnalysis.Editor.Shared.Utilities
+open Microsoft.CodeAnalysis.Editor.Shared.Extensions
+open Microsoft.CodeAnalysis.Editor.Implementation.IntelliSense.QuickInfo
+
+open Microsoft.VisualStudio.Language.Intellisense
+open Microsoft.VisualStudio.Utilities
+
+open Microsoft.FSharp.Compiler.Range
+open Microsoft.FSharp.Compiler
+
+open Internal.Utilities.StructuredFormat
+
+module private SessionHandling =
+    let mutable currentSession = None
+    
+    [<Export (typeof<IQuickInfoSourceProvider>)>]
+    [<Name (FSharpProviderConstants.SessionCapturingProvider)>]
+    [<Order (After = PredefinedQuickInfoProviderNames.Semantic)>]
+    [<ContentType (FSharpConstants.FSharpContentTypeName)>]
+    type SourceProviderForCapturingSession () =
+        interface IQuickInfoSourceProvider with 
+            member x.TryCreateQuickInfoSource _ =
+              { new IQuickInfoSource with
+                  member __.AugmentQuickInfoSession(session,_,_) = currentSession <- Some session
+                  member __.Dispose() = () }
+
+module private SourceLink =
+    let solid = 70uy, DashStyles.Solid
+    let dot = 255uy, DashStyle([1.0; 5.0], 0.0)
+    let dash = 90uy, DashStyle([5.0; 5.0], 0.0)
+    let none = 0uy, DashStyles.Solid
+    let opacityCoverter =
+        { new IValueConverter with
+              member this.Convert(value, _, parameter, _) =
+                  match value with 
+                  | :? Color as c -> Color.FromArgb(unbox parameter, c.R, c.G, c.B) :> _
+                  | _ -> Binding.DoNothing
+              member this.ConvertBack(_,_,_,_) = Binding.DoNothing }
+    let getUnderlineStyle() =
+        if not Settings.QuickInfo.DisplayLinks then none
+        else 
+            match Settings.QuickInfo.UnderlineStyle with
+            | QuickInfoUnderlineStyle.Solid -> solid
+            | QuickInfoUnderlineStyle.Dot -> dot
+            | QuickInfoUnderlineStyle.Dash -> dash
+
+
+type internal SourceLink(run) as this = 
+    inherit Documents.Hyperlink(run)   
+
+    let opacity, dashStyle = SourceLink.getUnderlineStyle()
+    let underlineBrush = Media.SolidColorBrush()
+    do BindingOperations.SetBinding(underlineBrush, SolidColorBrush.ColorProperty, Binding("Foreground.Color", Source = this, Converter = SourceLink.opacityCoverter, ConverterParameter = opacity)) |> ignore
+    let normalUnderline = TextDecorationCollection [TextDecoration(Location = TextDecorationLocation.Underline, PenOffset = 1.0)]
+    let slightUnderline = TextDecorationCollection [TextDecoration(Location = TextDecorationLocation.Underline, PenOffset = 1.0, Pen = Pen(Brush = underlineBrush, DashStyle = dashStyle))]
+    do this.TextDecorations <- slightUnderline
+
+    override this.OnMouseEnter(e) = 
+        base.OnMouseEnter(e)
+        this.TextDecorations <- normalUnderline
+
+    override this.OnMouseLeave(e) = 
+        base.OnMouseLeave(e)
+        this.TextDecorations <- slightUnderline
+
+[<Export>]
+type internal QuickInfoViewProvider
+    [<ImportingConstructor>]
+    (
+        // lazy to try to mitigate #2756 (wrong tooltip font)
+        typeMap: Lazy<ClassificationTypeMap>,
+        glyphService: IGlyphService
+    ) =
+
+    let formatMap = lazy typeMap.Value.ClassificationFormatMapService.GetClassificationFormatMap "tooltip"
+
+    let layoutTagToFormatting (layoutTag: LayoutTag) =
+        layoutTag
+        |> RoslynHelpers.roslynTag
+        |> ClassificationTags.GetClassificationTypeName
+        |> typeMap.Value.GetClassificationType
+        |> formatMap.Value.GetTextProperties
+    
+    let formatText (navigation: QuickInfoNavigation) (content: Layout.TaggedText seq) : IDeferredQuickInfoContent =
+
+        let navigateAndDismiss range _ =
+            navigation.NavigateTo range
+            SessionHandling.currentSession |> Option.iter ( fun session -> session.Dismiss() )
+
+        let inlines = 
+            seq { 
+                for taggedText in content do
+                    let run = Documents.Run taggedText.Text
+                    let inl =
+                        match taggedText with
+                        | :? Layout.NavigableTaggedText as nav when navigation.IsTargetValid nav.Range ->                        
+                            let h = SourceLink (run, ToolTip = nav.Range.FileName)
+                            h.Click.Add <| navigateAndDismiss nav.Range
+                            h :> Documents.Inline
+                        | _ -> run :> _
+                    DependencyObjectExtensions.SetTextProperties (inl, layoutTagToFormatting taggedText.Tag)
+                    yield inl
+            }
+
+        let createTextLinks () =
+            let tb = TextBlock(TextWrapping = TextWrapping.Wrap, TextTrimming = TextTrimming.None)
+            DependencyObjectExtensions.SetDefaultTextProperties(tb, formatMap.Value)
+            tb.Inlines.AddRange inlines
+            if tb.Inlines.Count = 0 then tb.Visibility <- Visibility.Collapsed
+            tb :> FrameworkElement
+            
+        { new IDeferredQuickInfoContent with member x.Create() = createTextLinks() }
+
+    let empty = 
+        { new IDeferredQuickInfoContent with 
+            member x.Create() = TextBlock(Visibility = Visibility.Collapsed) :> FrameworkElement }
+
+    let createDeferredContent (symbolGlyph, mainDescription, documentation) =
+        QuickInfoDisplayDeferredContent(symbolGlyph, null, mainDescription, documentation, empty, empty, empty, empty)
+
+    member __.ProvideContent(glyph: Glyph, description: TaggedText seq, documentation: TaggedText seq, navigation: QuickInfoNavigation) =
+        let navigableText = formatText navigation
+        let glyphContent = SymbolGlyphDeferredContent(glyph, glyphService)
+        createDeferredContent(glyphContent, navigableText description, navigableText documentation)