Quickinfo Tooltip and GotoDefinition Navigation Improvements

src/fsharp/NicePrint.fs

@@ -83,7 +83,10 @@ module internal PrintUtilities =
             if isAttribute then 
                 defaultArg (String.tryDropSuffix name "Attribute") name 
             else name
-        let tyconTextL = NavigableTaggedText.Create(tagEntityRefName tcref demangled, tcref.DefinitionRange) |> wordL
+        let tyconTextL =
+            tagEntityRefName tcref demangled
+            |> mkNav tcref.DefinitionRange
+            |> wordL
         if denv.shortTypeNames then 
             tyconTextL
         else
@@ -1104,8 +1107,9 @@ module private PrintTastMemberOrVals =
         let stat = PrintTypes.layoutMemberFlags membInfo.MemberFlags
         let _tps,argInfos,rty,_ = GetTypeOfMemberInFSharpForm denv.g v
 
-        let mkNameL niceMethodTypars tagFunction name =       
-            let nameL  = DemangleOperatorNameAsLayout tagFunction name
+        let mkNameL niceMethodTypars tagFunction name =
+            let nameL =
+                DemangleOperatorNameAsLayout (tagFunction >> mkNav v.DefinitionRange) name
             let nameL = 
                 if denv.showMemberContainers then 
                     layoutTyconRef denv v.MemberApparentParent ^^ SepL.dot ^^ nameL
@@ -1157,7 +1161,10 @@ module private PrintTastMemberOrVals =
         let env = SimplifyTypes.CollectInfo true [tau] cxs
         let cxs = env.postfixConstraints
         let argInfos,rty = GetTopTauTypeInFSharpForm denv.g (arityOfVal v).ArgInfos tau v.Range
-        let nameL = wordL ((if v.IsModuleBinding then tagModuleBinding else tagUnknownEntity) v.DisplayName)
+        let nameL =
+            (if v.IsModuleBinding then tagModuleBinding else tagUnknownEntity) v.DisplayName
+            |> mkNav v.DefinitionRange
+            |> wordL 
         let nameL = layoutAccessibility denv v.Accessibility nameL
         let nameL = 
             if v.IsMutable && not denv.suppressMutableKeyword then 
@@ -1389,7 +1396,7 @@ module private TastDefinitionPrinting =
 
     let layoutExtensionMember denv (v:Val) =
         let tycon = v.MemberApparentParent.Deref
-        let nameL = wordL (tagMethod tycon.DisplayName)
+        let nameL = tagMethod tycon.DisplayName |> mkNav v.DefinitionRange |> wordL
         let nameL = layoutAccessibility denv tycon.Accessibility nameL // "type-accessibility"
         let tps =
             match PartitionValTyparsForApparentEnclosingType denv.g v with
@@ -1402,7 +1409,10 @@ module private TastDefinitionPrinting =
         aboveListL (List.map (layoutExtensionMember denv) vs)    
 
     let layoutRecdField addAccess denv  (fld:RecdField) =
-        let lhs = wordL (tagRecordField fld.Name)
+        let lhs =
+            tagRecordField fld.Name
+            |> mkNav fld.DefinitionRange
+            |> wordL 
         let lhs = (if addAccess then layoutAccessibility denv fld.Accessibility lhs else lhs)
         let lhs = if fld.IsMutable then wordL (tagKeyword "mutable") --- lhs else lhs
         (lhs ^^ RightL.colon) --- layoutType denv fld.FormalType
@@ -1426,7 +1436,7 @@ module private TastDefinitionPrinting =
             sepListL (wordL (tagPunctuation "*")) (List.mapi (layoutUnionOrExceptionField denv isGenerated) fields)
 
     let layoutUnionCase denv  prefixL (ucase:UnionCase) =
-        let nmL = DemangleOperatorNameAsLayout tagUnionCase ucase.Id.idText
+        let nmL = DemangleOperatorNameAsLayout (tagUnionCase >> mkNav ucase.DefinitionRange) ucase.Id.idText
         //let nmL = layoutAccessibility denv ucase.Accessibility nmL
         match ucase.RecdFields with
         | []     -> (prefixL ^^ nmL)
@@ -1611,6 +1621,7 @@ module private TastDefinitionPrinting =
           elif isInterfaceTy g ty then Some "interface", tagInterface n
           elif isClassTy g ty then (if simplified then None else Some "class" ), tagClass n
           else None, tagUnknownType n
+      let name = mkNav tycon.DefinitionRange name
       let nameL = layoutAccessibility denv tycon.Accessibility (wordL name)
       let denv = denv.AddAccessibility tycon.Accessibility 
       let lhsL =

src/fsharp/TastOps.fs

@@ -2506,11 +2506,16 @@ let tagEntityRefName (xref: EntityRef) name =
     elif xref.IsRecordTycon then tagRecord name
     else tagClass name
 
+let fullDisplayTextOfTyconRef  r = fullNameOfEntityRef (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r
+
 let fullNameOfEntityRefAsLayout nmF (xref: EntityRef) =
-    let n = NavigableTaggedText.Create(tagEntityRefName xref (nmF xref), xref.DefinitionRange) |> wordL
+    let navigableText = 
+        tagEntityRefName xref (nmF xref)
+        |> mkNav xref.DefinitionRange
+        |> wordL
     match fullNameOfParentOfEntityRefAsLayout xref  with 
-    | None -> n
-    | Some pathText -> pathText ^^ SepL.dot ^^ n
+    | None -> navigableText
+    | Some pathText -> pathText ^^ SepL.dot ^^ navigableText
 
 let fullNameOfParentOfValRef vref = 
     match vref with 
@@ -2534,7 +2539,6 @@ let fullNameOfParentOfValRefAsLayout vref =
 let fullDisplayTextOfParentOfModRef r = fullNameOfParentOfEntityRef r 
 
 let fullDisplayTextOfModRef r = fullNameOfEntityRef (fun (x:EntityRef) -> x.DemangledModuleOrNamespaceName)  r
-let fullDisplayTextOfTyconRef  r = fullNameOfEntityRef (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r
 let fullDisplayTextOfTyconRefAsLayout  r = fullNameOfEntityRefAsLayout (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r
 let fullDisplayTextOfExnRef  r = fullNameOfEntityRef (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r
 let fullDisplayTextOfExnRefAsLayout  r = fullNameOfEntityRefAsLayout (fun (tc:TyconRef) -> tc.DisplayNameWithStaticParametersAndUnderscoreTypars) r

src/fsharp/layout.fs

@@ -14,13 +14,12 @@ type layout = Internal.Utilities.StructuredFormat.Layout
 type LayoutTag = Internal.Utilities.StructuredFormat.LayoutTag
 type TaggedText = Internal.Utilities.StructuredFormat.TaggedText
 
-type NavigableTaggedText(tag, text, range: Range.range) =
+type NavigableTaggedText(taggedText: TaggedText, range: Range.range) =
     member val Range = range
     interface TaggedText with
-        member x.Tag = tag
-        member x.Text = text
-    static member Create(tt: TaggedText, range) =
-        NavigableTaggedText(tt.Tag, tt.Text, range)      
+        member x.Tag = taggedText.Tag
+        member x.Text = taggedText.Text
+let mkNav r t = NavigableTaggedText(t, r)
 
 let spaces n = new String(' ',n)
 

src/fsharp/layout.fsi

@@ -13,10 +13,10 @@ type LayoutTag = Internal.Utilities.StructuredFormat.LayoutTag
 type TaggedText = Internal.Utilities.StructuredFormat.TaggedText
 
 type NavigableTaggedText =
-    new : LayoutTag * string * Range.range -> NavigableTaggedText
+    new : TaggedText * Range.range -> NavigableTaggedText
     member Range: Range.range
-    static member Create: TaggedText * Range.range -> NavigableTaggedText
     interface TaggedText
+val mkNav : Range.range -> TaggedText -> NavigableTaggedText
 
 module TaggedTextOps = Internal.Utilities.StructuredFormat.TaggedTextOps
 

src/fsharp/vs/ServiceDeclarations.fs

@@ -834,7 +834,7 @@ module internal ItemDescriptionsImpl =
                 wordL (tagText (FSComp.SR.typeInfoUnionCase())) ^^
                 NicePrint.layoutTyconRef denv ucinfo.TyconRef ^^
                 sepL (tagPunctuation ".") ^^
-                wordL (tagUnionCase (DecompileOpName uc.Id.idText)) ^^
+                wordL (tagUnionCase (DecompileOpName uc.Id.idText) |> mkNav uc.DefinitionRange) ^^
                 RightL.colon ^^
                 (if List.isEmpty recd then emptyL else NicePrint.layoutUnionCases denv recd ^^ WordL.arrow) ^^
                 NicePrint.layoutTy denv rty
@@ -845,7 +845,7 @@ module internal ItemDescriptionsImpl =
             let items = apinfo.ActiveTags
             let layout = 
                 wordL (tagText ((FSComp.SR.typeInfoActivePatternResult()))) ^^
-                wordL (tagActivePatternResult (List.item idx items)) ^^
+                wordL (tagActivePatternResult (List.item idx items) |> mkNav apinfo.Range) ^^
                 RightL.colon ^^
                 NicePrint.layoutTy denv ty
             FSharpStructuredToolTipElement.Single(layout, xml)
@@ -859,7 +859,7 @@ module internal ItemDescriptionsImpl =
             let _, ptau, _cxs = PrettyTypes.PrettifyTypes1 denv.g tau
             let layout =
                 wordL (tagText (FSComp.SR.typeInfoActiveRecognizer())) ^^
-                wordL (tagActivePatternCase apref.Name) ^^
+                wordL (tagActivePatternCase apref.Name |> mkNav v.DefinitionRange) ^^
                 RightL.colon ^^
                 NicePrint.layoutTy denv ptau ^^
                 OutputFullName isDecl pubpath_of_vref fullDisplayTextOfValRefAsLayout v
@@ -879,7 +879,7 @@ module internal ItemDescriptionsImpl =
             let layout = 
                 NicePrint.layoutTyconRef denv rfinfo.TyconRef ^^
                 SepL.dot ^^
-                wordL (tagRecordField (DecompileOpName rfield.Name)) ^^
+                wordL (tagRecordField (DecompileOpName rfield.Name) |> mkNav rfield.DefinitionRange) ^^
                 RightL.colon ^^
                 NicePrint.layoutTy denv ty ^^
                 (
@@ -1001,7 +1001,9 @@ module internal ItemDescriptionsImpl =
 
             let layout = 
                 wordL (tagKeyword kind) ^^
-                wordL (if definiteNamespace then tagNamespace (fullDisplayTextOfModRef modref) else (tagModule modref.DemangledModuleOrNamespaceName))
+                (if definiteNamespace then tagNamespace (fullDisplayTextOfModRef modref) else (tagModule modref.DemangledModuleOrNamespaceName)
+                 |> mkNav modref.DefinitionRange
+                 |> wordL)
             if not definiteNamespace then
                 let namesToAdd = 
                     ([],modrefs) 

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

@@ -0,0 +1,108 @@
+[<AutoOpen>]
+module internal Microsoft.VisualStudio.FSharp.Editor.CodeAnalysisExtensions
+
+open Microsoft.CodeAnalysis
+open Microsoft.FSharp.Compiler.Range
+
+type Project with
+
+    /// Returns the projectIds of all projects within the same solution that directly reference this project
+    member this.GetDependentProjectIds () =
+        this.Solution.GetProjectDependencyGraph().GetProjectsThatDirectlyDependOnThisProject this.Id
+
+
+    /// Returns all projects within the same solution that directly reference this project.
+    member this.GetDependentProjects () =
+        this.Solution.GetProjectDependencyGraph().GetProjectsThatDirectlyDependOnThisProject this.Id
+        |> Seq.map this.Solution.GetProject
+
+
+    /// Returns the ProjectIds of all of the projects that this project directly or transitively depneds on
+    member this.GetProjectIdsOfAllProjectsThisProjectDependsOn () =
+        let graph = this.Solution.GetProjectDependencyGraph()
+        let transitiveDependencies = graph.GetProjectsThatThisProjectTransitivelyDependsOn this.Id
+        let directDependencies = graph.GetProjectsThatThisProjectDirectlyDependsOn this.Id
+        Seq.append directDependencies transitiveDependencies
+
+
+    /// The list all of the projects that this project directly or transitively depneds on
+    member this.GetAllProjectsThisProjectDependsOn () =
+        this.GetProjectIdsOfAllProjectsThisProjectDependsOn ()
+        |> Seq.map this.Solution.GetProject
+
+
+type Solution with 
+
+    /// Try to get a document inside the solution using the document's name
+    member self.TryGetDocumentNamed docName =
+        self.Projects |> Seq.tryPick (fun proj ->
+            proj.Documents |> Seq.tryFind (fun doc -> doc.Name = docName))
+
+
+     /// Try to find the documentId corresponding to the provided filepath within this solution  
+    member self.TryGetDocumentFromPath filePath =
+        self.GetDocumentIdsWithFilePath filePath
+        |> Seq.tryHead |> Option.map (fun docId -> self.GetDocument docId)
+
+
+    /// Try to get a project inside the solution using the project's id
+    member self.TryGetProject (projId:ProjectId) =
+        if self.ContainsProject projId then Some (self.GetProject projId) else None
+
+
+    /// Returns the projectIds of all projects within this solution that directly reference the provided project
+    member self.GetDependentProjects (projectId:ProjectId) =
+        self.GetProjectDependencyGraph().GetProjectsThatDirectlyDependOnThisProject projectId
+        |> Seq.map self.GetProject
+
+
+    /// Returns the projectIds of all projects within this solution that directly reference the provided project
+    member self.GetDependentProjectIds (projectId:ProjectId) =
+        self.GetProjectDependencyGraph().GetProjectsThatDirectlyDependOnThisProject projectId
+
+
+    /// Returns the ProjectIds of all of the projects that directly or transitively depends on
+    member self.GetProjectIdsOfAllProjectReferences (projectId:ProjectId) =
+        let graph = self.GetProjectDependencyGraph()
+        let transitiveDependencies = graph.GetProjectsThatThisProjectTransitivelyDependsOn projectId
+        let directDependencies = graph.GetProjectsThatThisProjectDirectlyDependsOn projectId
+        Seq.append directDependencies transitiveDependencies
+
+
+    /// Returns all of the projects that this project that directly or transitively depends on
+    member self.GetAllProjectsThisProjectDependsOn (projectId:ProjectId) =
+        self.GetProjectIdsOfAllProjectReferences projectId
+        |> Seq.map self.GetProject
+
+
+    /// Try to retrieve the corresponding DocumentId for the range's file in the solution
+    /// and if a projectId is provided, only try to find the document within that project
+    /// or a project referenced by that project
+    member self.TryGetDocumentIdFromFSharpRange (range:range,?projectId:ProjectId) =
+
+        let filePath = System.IO.Path.GetFullPathSafe range.FileName
+        let checkProjectId (docId:DocumentId) =
+            if projectId.IsSome then docId.ProjectId = projectId.Value else false
+        //The same file may be present in many projects. We choose one from current or referenced project.
+        let rec matchingDoc = function
+        | [] -> None
+        | (docId:DocumentId)::_ when checkProjectId docId -> Some docId
+        | docId::tail -> 
+            match projectId with 
+            | Some projectId ->
+                if self.GetDependentProjectIds docId.ProjectId |> Seq.contains projectId 
+                then Some docId
+                else matchingDoc tail
+            | None -> Some docId
+
+        self.GetDocumentIdsWithFilePath filePath |> List.ofSeq |> matchingDoc 
+
+
+    /// Try to retrieve the corresponding Document for the range's file in the solution
+    /// and if a projectId is provided, only try to find the document within that project
+    /// or a project referenced by that project
+    member self.TryGetDocumentFromFSharpRange (range:range,?projectId:ProjectId) = 
+        match projectId with
+        | Some projectId -> self.TryGetDocumentIdFromFSharpRange (range, projectId)
+        | None -> self.TryGetDocumentIdFromFSharpRange range
+        |> Option.map self.GetDocument

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

@@ -9,21 +9,46 @@ open Microsoft.CodeAnalysis.Classification
 
 [<RequireQualifiedAccess>]
 module internal FSharpCommonConstants =
+
     [<Literal>]
+    /// "871D2A70-12A2-4e42-9440-425DD92A4116"
     let packageGuidString = "871D2A70-12A2-4e42-9440-425DD92A4116"
+
     [<Literal>]
+    /// "BC6DD5A5-D4D6-4dab-A00D-A51242DBAF1B"
     let languageServiceGuidString = "BC6DD5A5-D4D6-4dab-A00D-A51242DBAF1B"
+
     [<Literal>]
+    /// "4EB7CCB7-4336-4FFD-B12B-396E9FD079A9"
     let editorFactoryGuidString = "4EB7CCB7-4336-4FFD-B12B-396E9FD079A9"
+
     [<Literal>]
+    /// "9B164E40-C3A2-4363-9BC5-EB4039DEF653"
     let svsSettingsPersistenceManagerGuidString = "9B164E40-C3A2-4363-9BC5-EB4039DEF653"
+
     [<Literal>]
+    /// "F#"
     let FSharpLanguageName = "F#"
+
     [<Literal>]
+    /// "F#"
     let FSharpContentTypeName = "F#"
+
     [<Literal>]
+    /// "F# Signature Help"
     let FSharpSignatureHelpContentTypeName = "F# Signature Help"
+
     [<Literal>]
+    /// "F# Language Service"
     let FSharpLanguageServiceCallbackName = "F# Language Service"
+
+    [<Literal>]
+    /// "FSharp"
+    let FSharpLanguageLongName = "FSharp"
+
+[<RequireQualifiedAccess>]
+module internal FSharpProviderConstants =
+
     [<Literal>]
-    let FSharpLanguageLongName = "FSharp"
+    /// "Session Capturing Quick Info Source Provider"
+    let SessionCapturingProvider = "Session Capturing Quick Info Source Provider"

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

@@ -410,8 +410,12 @@ module internal Extensions =
     open Microsoft.VisualStudio.FSharp.Editor.Logging
 
     type System.IServiceProvider with
+
+        /// Retrieve a MEF Visual Studio Service of type 'T
         member x.GetService<'T>() = x.GetService(typeof<'T>) :?> 'T
-        member x.GetService<'T, 'S>() = x.GetService(typeof<'S>) :?> 'T
+
+        /// Retrieve a SVs MEF Service of type 'S and cast it to type 'T
+        member x.GetService<'S,'T>() = x.GetService(typeof<'S>) :?> 'T
 
     type Path with
         static member GetFullPathSafe path =
@@ -526,7 +530,7 @@ module internal Extensions =
                 match declarationLocation with
                 | Some loc ->
                     let filePath = Path.GetFullPathSafe loc.FileName
-                    let isScript = String.Equals(Path.GetExtension(filePath), ".fsx", StringComparison.OrdinalIgnoreCase)
+                    let isScript = isScriptFile filePath 
                     if isScript && filePath = currentDocument.FilePath then 
                         Some SymbolDeclarationLocation.CurrentDocument
                     elif isScript then

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

@@ -82,13 +82,6 @@ module internal CommonRoslynHelpers =
 
     let CollectTaggedText (list: List<_>) (t:TaggedText) = list.Add(TaggedText(roslynTag t.Tag, t.Text))
 
-    let CollectNavigableText (list: List<_>) (t: TaggedText) =
-        let rangeOpt = 
-            match t with
-            | :? NavigableTaggedText as n -> Some n.Range
-            | _ -> None
-        list.Add(roslynTag t.Tag, t.Text, rangeOpt)
-
     let StartAsyncAsTask cancellationToken computation =
         let computation =
             async {
@@ -349,10 +342,3 @@ module internal OpenDeclarationHelper =
             else sourceText
         sourceText, minPos |> Option.defaultValue 0
 
-[<AutoOpen>]
-module internal RoslynExtensions =
-    type Project with
-        /// The list of all other projects within the same solution that reference this project.
-        member this.GetDependentProjects() =
-            this.Solution.GetProjectDependencyGraph().GetProjectsThatDirectlyDependOnThisProject(this.Id)
-            |> Seq.map this.Solution.GetProject