Inline type hints for F#

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

@@ -126,6 +126,9 @@
     <Compile Include="Build\SetGlobalPropertiesForSdkProjects.fs" />
     <Compile Include="AutomaticCompletion\BraceCompletionSessionProvider.fsi" />
     <Compile Include="AutomaticCompletion\BraceCompletionSessionProvider.fs" />
+    <Compile Include="Hints\HintService.fs" />
+    <Compile Include="Hints\NativeToRoslynHintConverter.fs" />
+    <Compile Include="Hints\RoslynAdapter.fs" />
     <Compile Include="Lens\LensDisplayService.fs" />
     <Compile Include="Lens\LensService.fs" />
     <Compile Include="Lens\LensProvider.fs" />

vsintegration/src/FSharp.Editor/Hints/HintService.fs

@@ -0,0 +1,79 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Microsoft.VisualStudio.FSharp.Editor.Hints
+
+open Microsoft.CodeAnalysis
+open Microsoft.VisualStudio.FSharp.Editor
+open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.Symbols
+open FSharp.Compiler.Text
+
+module HintService =
+
+    // Relatively convenient for testing
+    type NativeHint = {
+        Range: range
+        Parts: TaggedText list
+    }
+
+    let private isValidForHint 
+        (parseFileResults: FSharpParseFileResults) 
+        (symbol: FSharpMemberOrFunctionOrValue)
+        (symbolUse: FSharpSymbolUse) =
+
+        let isNotAnnotatedManually = 
+            not (parseFileResults.IsTypeAnnotationGivenAtPosition symbolUse.Range.Start)
+
+        let isNotAfterDot = 
+            symbolUse.IsFromDefinition 
+            && not symbol.IsMemberThisValue
+
+        let isNotTypeAlias = 
+            not symbol.IsConstructorThisValue
+
+        symbol.IsValue // we'll be adding other stuff gradually here
+        && isNotAnnotatedManually
+        && isNotAfterDot
+        && isNotTypeAlias
+
+    let private getHintParts
+        (symbol: FSharpMemberOrFunctionOrValue) 
+        (symbolUse: FSharpSymbolUse) =
+
+        match symbol.GetReturnTypeLayout symbolUse.DisplayContext with
+        | Some typeInfo -> 
+            let colon = TaggedText(TextTag.Text, ": ")
+            colon :: (typeInfo |> Array.toList)
+
+        // not sure when this can happen but better safe than sorry
+        | None -> 
+            []
+
+    let private getHintsForSymbol parseResults (symbolUse: FSharpSymbolUse) =
+        match symbolUse.Symbol with
+        | :? FSharpMemberOrFunctionOrValue as mfvSymbol 
+          when isValidForHint parseResults mfvSymbol symbolUse ->
+
+            [ {
+                Range = symbolUse.Range
+                Parts = getHintParts mfvSymbol symbolUse
+            } ]
+
+        // we'll be adding other stuff gradually here
+        | _ -> 
+            []
+
+    let getHintsForDocument (document: Document) userOpName cancellationToken = 
+        async {
+            if isSignatureFile document.FilePath
+            then 
+                return []
+            else
+                let! parseResults, checkResults = 
+                    document.GetFSharpParseAndCheckResultsAsync userOpName 
+
+                return 
+                    checkResults.GetAllUsesOfAllSymbolsInFile cancellationToken
+                    |> Seq.toList
+                    |> List.collect (getHintsForSymbol parseResults)
+        }

vsintegration/src/FSharp.Editor/Hints/NativeToRoslynHintConverter.fs

@@ -0,0 +1,27 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Microsoft.VisualStudio.FSharp.Editor.Hints
+
+open System.Collections.Immutable
+open Microsoft.CodeAnalysis.Text
+open Microsoft.CodeAnalysis.ExternalAccess.FSharp.InlineHints
+open Microsoft.VisualStudio.FSharp.Editor
+open FSharp.Compiler.Text
+open HintService
+
+module NativeToRoslynHintConverter =
+
+    let rangeToSpan range sourceText = 
+        let symbolSpan = RoslynHelpers.FSharpRangeToTextSpan(sourceText, range)
+        let overshadowLength = 0 // anything >0 means overlaying the code
+        TextSpan(symbolSpan.End, overshadowLength)
+
+    let nativeToRoslynText (taggedText: TaggedText) = 
+        let tag = RoslynHelpers.roslynTag taggedText.Tag
+        let text = taggedText.Text
+        RoslynTaggedText(tag, text)
+
+    let convert sourceText hint =
+        let span = rangeToSpan hint.Range sourceText
+        let displayParts = hint.Parts |> Seq.map nativeToRoslynText
+        FSharpInlineHint(span, displayParts.ToImmutableArray())

vsintegration/src/FSharp.Editor/Hints/RoslynAdapter.fs

@@ -0,0 +1,38 @@
+// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.
+
+namespace Microsoft.VisualStudio.FSharp.Editor.Hints
+
+open System.Collections.Immutable
+open System.ComponentModel.Composition
+open Microsoft.CodeAnalysis.ExternalAccess.FSharp.InlineHints
+open Microsoft.VisualStudio.FSharp.Editor
+
+// So the Roslyn interface is called IFSharpInlineHintsService
+// but our implementation is called just HintsService.
+// That's because we'll likely use this API for things other than inline hints,
+// e.g. signature hints above the line, pipeline hints on the side and so on.
+
+[<Export(typeof<IFSharpInlineHintsService>)>]
+type internal RoslynAdapter 
+    [<ImportingConstructor>]
+    (settings: EditorOptions) =
+
+    static let userOpName = "Hints"
+
+    interface IFSharpInlineHintsService with
+        member _.GetInlineHintsAsync(document, _, cancellationToken) =
+            async {
+                if not settings.Advanced.IsInlineHintsEnabled 
+                then return ImmutableArray.Empty
+
+                else
+                    let! sourceText = document.GetTextAsync cancellationToken |> Async.AwaitTask
+                    let! nativeHints = 
+                        HintService.getHintsForDocument document userOpName cancellationToken
+
+                    let roslynHints = 
+                        nativeHints 
+                        |> Seq.map (NativeToRoslynHintConverter.convert sourceText)
+
+                    return roslynHints.ToImmutableArray()
+            } |> RoslynHelpers.StartAsyncAsTask cancellationToken

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

@@ -85,10 +85,12 @@ type LensOptions =
 [<CLIMutable>]
 type AdvancedOptions =
     { IsBlockStructureEnabled: bool
-      IsOutliningEnabled: bool }
+      IsOutliningEnabled: bool
+      IsInlineHintsEnabled: bool }
     static member Default =
       { IsBlockStructureEnabled = true
-        IsOutliningEnabled = true }
+        IsOutliningEnabled = true
+        IsInlineHintsEnabled = false }
 
 [<CLIMutable>]
 type FormattingOptions =

vsintegration/src/FSharp.UIResources/AdvancedOptionsControl.xaml

@@ -24,6 +24,10 @@
                     <CheckBox x:Name="toggleOutloning" IsChecked="{Binding IsOutliningEnabled}"
                               Content="{x:Static local:Strings.Show_Outlining}"/>
                 </GroupBox>
+                <GroupBox Header="{x:Static local:Strings.Inline_Hints}">
+                    <CheckBox x:Name="toggleInlineHints" IsChecked="{Binding IsInlineHintsEnabled}"
+                              Content="{x:Static local:Strings.Show_Inline_Hints}"/>
+                </GroupBox>
             </StackPanel>
         </ScrollViewer>
     </Grid>

vsintegration/src/FSharp.UIResources/Strings.resx

@@ -189,6 +189,12 @@
   <data name="Show_Outlining" xml:space="preserve">
     <value>Show outlining and collapsible nodes for F# code</value>
   </data>
+  <data name="Inline_Hints" xml:space="preserve">
+    <value>Inline Hints</value>
+  </data>
+  <data name="Show_Inline_Hints" xml:space="preserve">
+    <value>Display inline type hints (experimental)</value>
+  </data>
   <data name="Time_until_stale_completion" xml:space="preserve">
     <value>Time until stale results are used (in milliseconds)</value>
   </data>

vsintegration/src/FSharp.UIResources/xlf/Strings.cs.xlf

@@ -7,6 +7,11 @@
         <target state="translated">Vždy umístit otevřené příkazy na nejvyšší úroveň</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">Zobrazit s_ymboly v neotevřených oborech názvů</target>

vsintegration/src/FSharp.UIResources/xlf/Strings.de.xlf

@@ -7,6 +7,11 @@
         <target state="translated">open-Anweisungen immer an oberster Ebene platzieren</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">S_ymbole in nicht geöffneten Namespaces anzeigen</target>

vsintegration/src/FSharp.UIResources/xlf/Strings.es.xlf

@@ -7,6 +7,11 @@
         <target state="translated">Colocar siempre las instrucciones open en el nivel superior</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">Mostrar sím_bolos en espacios de nombres sin abrir</target>

vsintegration/src/FSharp.UIResources/xlf/Strings.fr.xlf

@@ -7,6 +7,11 @@
         <target state="translated">Placer toujours les instructions open au niveau supérieur</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">Afficher les sym_boles dans les espaces de noms non ouverts</target>

vsintegration/src/FSharp.UIResources/xlf/Strings.it.xlf

@@ -7,6 +7,11 @@
         <target state="translated">Inserisci sempre le istruzioni OPEN al primo livello</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">Mostra si_mboli in spazi dei nomi non aperti</target>

vsintegration/src/FSharp.UIResources/xlf/Strings.ja.xlf

@@ -7,6 +7,11 @@
         <target state="translated">Open ステートメントを常に最上位に配置する</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">開かれていない名前空間の記号を表示する(_Y)</target>

vsintegration/src/FSharp.UIResources/xlf/Strings.ko.xlf

@@ -7,6 +7,11 @@
         <target state="translated">항상 최상위에 open 문 배치</target>
         <note />
       </trans-unit>
+      <trans-unit id="Inline_Hints">
+        <source>Inline Hints</source>
+        <target state="new">Inline Hints</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Lens">
         <source>Lens</source>
         <target state="translated">Lens</target>
@@ -77,6 +82,11 @@
         <target state="new">Parallelization (requires restart)</target>
         <note />
       </trans-unit>
+      <trans-unit id="Show_Inline_Hints">
+        <source>Display inline type hints (experimental)</source>
+        <target state="new">Display inline type hints (experimental)</target>
+        <note />
+      </trans-unit>
       <trans-unit id="Show_all_symbols">
         <source>Show s_ymbols in unopened namespaces</source>
         <target state="translated">열려 있지 않은 네임스페이스에 기호 표시(_Y)</target>