Add inferred type name hints

ReSharper.FSharp/src/FSharp.Common/src/Settings/FSharpOptions.fs

@@ -147,7 +147,7 @@ type FSharpOptionsPage
         this.AddBoolOption((fun key -> key.FsiInteractiveEditor), RichText(FSharpExperimentalFeatures.fsiInteractiveEditor)) |> ignore
 
         this.AddHeader("Type hints")
-        let showPipeReturnTypes = this.AddBoolOption((fun key -> key.ShowPipeReturnTypes), RichText(FSharpTypeHintOptions.pipeReturnTypes), null)
+        this.AddBoolOption((fun key -> key.ShowPipeReturnTypes), RichText(FSharpTypeHintOptions.pipeReturnTypes), null) |> ignore
         do
             use _x = this.Indent()
             [
@@ -156,7 +156,7 @@ type FSharpOptionsPage
             |> Seq.iter (fun checkbox ->
                 this.AddBinding(checkbox, BindingStyle.IsEnabledProperty, (fun key -> key.ShowPipeReturnTypes), id)
             )
-        
+
         this.AddHeader("FSharp.Compiler.Service options")
         this.AddBoolOption((fun key -> key.EnableReactorMonitor), RichText(enableFcsReactorMonitor), null) |> ignore
         this.AddBoolOption((fun key -> key.BackgroundTypeCheck), RichText(backgroundTypeCheck), null) |> ignore

ReSharper.FSharp/src/FSharp.Psi.Features/FSharp.Psi.Features.fsproj

@@ -62,6 +62,7 @@
     <Compile Include="src\Daemon\Stages\FSharpVcsCodeVisionRangesProviderStage.fs" />
     <Compile Include="src\Daemon\Stages\FSharpErrorsStage.fs" />
     <Compile Include="src\Daemon\Stages\PipeChainTypeHintStage.fs" />
+    <Compile Include="src\Daemon\Stages\InferredTypeHintStage.fs" />
     <Compile Include="src\Daemon\Stages\InferredTypeCodeVisionProvider.fs" />
     <Compile Include="src\Daemon\Stages\FSharpSyntaxHighlightingStage.fs" />
     <Compile Include="src\Daemon\UsageChecking\FSharpUsageCheckingService.fs" />

ReSharper.FSharp/src/FSharp.Psi.Features/src/Daemon/Highlightings/TypeHintHighlighting.fs

@@ -9,13 +9,8 @@ open JetBrains.ReSharper.Feature.Services.Daemon
 open JetBrains.TextControl.DocumentMarkup
 open JetBrains.UI.RichText
 
-[<DaemonIntraTextAdornmentProvider(typeof<TypeHintAdornmentProvider>)>]
-[<StaticSeverityHighlighting(Severity.INFO,
-     typeof<HighlightingGroupIds.IntraTextAdornments>,
-     AttributeId = AnalysisHighlightingAttributeIds.PARAMETER_NAME_HINT,
-     OverlapResolve = OverlapResolveKind.NONE,
-     ShowToolTipInStatusBar = false)>]
-type TypeHintHighlighting(typeNameString: string, range: DocumentRange) =
+[<AbstractClass>]
+type TypeHintHighlightingBase(typeNameString: string, range: DocumentRange, mode) =
     let text = RichText(": " + typeNameString)
 
     interface IHighlighting with
@@ -28,18 +23,19 @@ type TypeHintHighlighting(typeNameString: string, range: DocumentRange) =
         member x.TestOutput = text.Text
 
     member x.Text = text
+    member x.Mode = mode
     member x.IsValid() = not text.IsEmpty && not range.IsEmpty
 
 and [<SolutionComponent>] TypeHintAdornmentProvider() =
     interface IHighlighterIntraTextAdornmentProvider with
         member x.IsValid(highlighter) =
             match highlighter.UserData with
-            | :? TypeHintHighlighting as dm -> dm.IsValid()
+            | :? TypeHintHighlightingBase as dm -> dm.IsValid()
             | _ -> false
 
         member x.CreateDataModel(highlighter) =
             match highlighter.UserData with
-            | :? TypeHintHighlighting as thh ->
+            | :? TypeHintHighlightingBase as thh ->
                 { new IIntraTextAdornmentDataModel with
                     override x.Text = thh.Text
                     override x.HasContextMenu = false
@@ -51,6 +47,26 @@ and [<SolutionComponent>] TypeHintAdornmentProvider() =
                     override x.IconId = null
                     override x.IsPreceding = false
                     override x.Order = 0
-                    override x.InlayHintsMode = InlayHintsMode.Default
+                    override x.InlayHintsMode = thh.Mode
                 }
             | _ -> null
+
+
+[<DaemonIntraTextAdornmentProvider(typeof<TypeHintAdornmentProvider>)>]
+[<StaticSeverityHighlighting(Severity.INFO,
+     typeof<HighlightingGroupIds.IntraTextAdornments>,
+     AttributeId = AnalysisHighlightingAttributeIds.PARAMETER_NAME_HINT,
+     OverlapResolve = OverlapResolveKind.NONE,
+     ShowToolTipInStatusBar = false)>]
+type TypeHintHighlighting(typeNameString: string, range: DocumentRange, mode) =
+    inherit TypeHintHighlightingBase(typeNameString, range, mode)
+
+
+[<DaemonIntraTextAdornmentProvider(typeof<TypeHintAdornmentProvider>)>]
+[<StaticSeverityHighlighting(Severity.INFO,
+     typeof<HighlightingGroupIds.IntraTextAdornments>,
+     AttributeId = AnalysisHighlightingAttributeIds.PARAMETER_NAME_HINT,
+     OverlapResolve = OverlapResolveKind.NONE,
+     ShowToolTipInStatusBar = false)>]
+type PipeTypeHintHighlighting(typeNameString: string, range: DocumentRange) =
+    inherit TypeHintHighlightingBase(typeNameString, range, InlayHintsMode.Default)

ReSharper.FSharp/src/FSharp.Psi.Features/src/Daemon/Stages/InferredTypeCodeVisionProvider.fs

@@ -59,7 +59,7 @@ type InferredTypeCodeVisionProvider() =
         member x.OnExtraActionClick(_, _, _) = ()
 
 
-[<DaemonStage>]
+[<DaemonStage(StagesBefore = [| typeof<FSharpErrorsStage> |])>]
 type InferredTypeCodeVisionStage(provider: InferredTypeCodeVisionProvider) =
     inherit FSharpDaemonStageBase()
 

ReSharper.FSharp/src/FSharp.Psi.Features/src/Daemon/Stages/InferredTypeHintStage.fs

@@ -0,0 +1,201 @@
+namespace JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.Stages
+
+open FSharp.Compiler.SourceCodeServices
+open JetBrains.Application.InlayHints
+open JetBrains.Application.Settings
+open JetBrains.Application.Settings.WellKnownRootKeys
+open JetBrains.ProjectModel
+open JetBrains.ReSharper.Feature.Services.InlayHints
+open JetBrains.ReSharper.Feature.Services.TypeNameHints
+open JetBrains.ReSharper.Plugins.FSharp
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Util
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Util
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.Highlightings
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Impl
+open JetBrains.ReSharper.Plugins.FSharp.Util
+open JetBrains.ReSharper.Psi
+open JetBrains.ReSharper.Psi.ExtensionsAPI
+open JetBrains.ReSharper.Psi.Naming
+open JetBrains.ReSharper.Psi.Naming.Impl
+open JetBrains.ReSharper.Psi.Tree
+open JetBrains.ReSharper.Feature.Services.Daemon
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
+open JetBrains.Util
+
+[<SettingsKey(typeof<InlayHintsSettings>, "ReSharper F# Type Name Hints settings")>]
+type FSharpTypeNameHintsOptions() =
+    inherit TypeNameHintsOptionsBase()
+
+    [<SettingsEntry(InlayHintsMode.PushToShowHints, "Visibility mode of type name hints for lambda expression parameters"); DefaultValue>]
+    val mutable ShowTypeNameHintsForLambdaExpressionParameters: InlayHintsMode
+
+    [<SettingsEntry(InlayHintsMode.PushToShowHints, "Visibility mode of type name hints for pattern matching expressions"); DefaultValue>]
+    val mutable ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions: InlayHintsMode
+
+
+type FSharpTypeNameHintHighlightingContext(settingsStore: IContextBoundSettingsStore) =
+    inherit TypeNameHintHighlightingContext<FSharpTypeNameHintsOptions>(settingsStore)
+
+    member val ShowTypeNameHintsForLambdaExpressionParameters =
+        settingsStore.GetValue(fun (options: FSharpTypeNameHintsOptions) ->
+            options.ShowTypeNameHintsForLambdaExpressionParameters)
+
+    member val ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions =
+        settingsStore.GetValue(fun (options: FSharpTypeNameHintsOptions) ->
+            options.ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions)
+
+
+type LocalReferencePatternVisitor
+        (fsFile: IFSharpFile, context: FSharpTypeNameHintHighlightingContext, namingPolicyProvider, nameParser) =
+    inherit TreeNodeVisitor<IHighlightingConsumer * InlayHintsMode>()
+
+    let isTypeEvidentFromVariableNamePrefix (fcsType: FSharpType) (variableNameParts: string[]) =
+        variableNameParts.Length > 0 &&
+
+        match variableNameParts.[0] with
+        | IgnoreCase "has" | IgnoreCase "is" -> fcsType.MapType(EmptyList.InstanceList, fsFile.GetPsiModule()).IsBool()
+        | _ -> false
+
+    let isEvidentFromVariableName (fcsType: FSharpType) variableName =
+        if not context.HideTypeNameHintsWhenTypeNameIsEvidentFromVariableName then false else
+        if not fcsType.HasTypeDefinition then false else
+
+        let nameParts = NamesHelper.GetParts(nameParser, namingPolicyProvider, variableName)
+
+        let fcsEntity = fcsType.TypeDefinition
+        if isTypeEvidentFromVariableNamePrefix fcsType nameParts then true else
+
+        match fcsEntity.LogicalName with
+        | IgnoreCase variableName -> true
+        | typeName -> NamesHelper.IsLike(nameParts, NamesHelper.GetParts(nameParser, namingPolicyProvider, typeName))
+
+    let isTypeOfPatternEvident (pattern: IFSharpPattern) =
+
+        // v-- not evident
+        // x::y::z
+        //    ^--  evident
+        let listConsPat = ListConsPatNavigator.GetByHeadPattern pattern
+        if isNotNull listConsPat then
+            isNotNull (ListConsPatNavigator.GetByTailPattern(listConsPat))
+
+        // x::y::z
+        //       ^--  evident
+        elif isNotNull (ListConsPatNavigator.GetByTailPattern(pattern)) then
+            true else
+
+        //  v-- not evident
+        // [x; y; z]
+        //     ^--^-- evident
+        let listOrListPat = ArrayOrListPatNavigator.GetByPattern(pattern)
+        if isNotNull listOrListPat then
+            match Seq.tryHead listOrListPat.PatternsEnumerable with
+            | None -> false
+            | Some head -> head <> pattern
+        else
+            false
+
+    override x.VisitNode(node, context) =
+        for child in node.Children() do
+            match child with
+            | :? IFSharpTreeNode as treeNode -> treeNode.Accept(x, (context))
+            | _ -> ()
+
+    override x.VisitLocalReferencePat(localRefPat, (consumer, inlayHintsMode)) =
+        let pat = localRefPat.IgnoreParentParens()
+        if isNotNull (TypedPatNavigator.GetByPattern(pat)) then () else
+
+        let binding = BindingNavigator.GetByHeadPattern(pat)
+        if isNotNull binding && isNotNull binding.ReturnTypeInfo then () else
+
+        let variableName = localRefPat.SourceName
+        if variableName = SharedImplUtil.MISSING_DECLARATION_NAME then () else
+
+        if isTypeOfPatternEvident pat then () else
+
+        let symbolUse = localRefPat.GetFSharpSymbolUse()
+        if isNull symbolUse then () else
+
+        match symbolUse.Symbol with
+        | :? FSharpMemberOrFunctionOrValue as mfv when not (isEvidentFromVariableName mfv.FullType variableName) ->
+            let typeNameStr = symbolUse.DisplayContext.WithShortTypeNames(true) |> mfv.FullType.Format
+            let range = localRefPat.GetNavigationRange().EndOffsetRange()
+
+            // todo: TypeNameHintHighlighting can be used when RIDER-39605 is resolved
+            consumer.AddHighlighting(TypeHintHighlighting(typeNameStr, range, inlayHintsMode))
+        | _ -> ()
+
+type InferredTypeHintHighlightingProcess
+        (fsFile, settings: IContextBoundSettingsStore, highlightingContext: FSharpTypeNameHintHighlightingContext,
+         namingManager: NamingManager, nameParser: NameParser, daemonProcess, isEnabled) =
+    inherit FSharpDaemonStageProcessBase(fsFile, daemonProcess)
+
+    let namingPolicyProvider = namingManager.Policy.GetPolicyProvider(fsFile.Language, fsFile.GetSourceFile())
+    let hideHintsForEvidentTypes = highlightingContext.HideTypeNameHintsForImplicitlyTypedVariablesWhenTypeIsEvident
+
+    let visitor = LocalReferencePatternVisitor(fsFile, highlightingContext, namingPolicyProvider, nameParser)
+
+    let visitLetBindings (letBindings: ILetBindings) consumer =
+        if highlightingContext.ShowTypeNameHintsForImplicitlyTypedVariables = InlayHintsMode.Never then () else
+
+        for binding in letBindings.Bindings do
+            if hideHintsForEvidentTypes && isTypeEvident binding.Expression then () else
+
+            match binding.HeadPattern with
+            | null -> ()
+            | headPat -> headPat.Accept(visitor, consumer)
+
+    override x.Execute(committer) =
+        if not isEnabled then
+            committer.Invoke(DaemonStageResult(EmptyArray.Instance, 0))
+            committer.Invoke(DaemonStageResult(EmptyArray.Instance, 1))
+        else
+            let consumer = FilteringHighlightingConsumer(daemonProcess.SourceFile, fsFile, settings)
+            fsFile.ProcessThisAndDescendants(Processor(x, consumer))
+            committer.Invoke(DaemonStageResult(consumer.Highlightings))
+
+    override x.VisitLetBindingsDeclaration(moduleDecl, consumer) =
+        visitLetBindings moduleDecl (consumer, InlayHintsMode.Default)
+
+    override x.VisitLetOrUseExpr(letOrUseExpr, consumer) =
+        visitLetBindings letOrUseExpr (consumer, InlayHintsMode.Default)
+
+    override x.VisitParametersPatternDeclaration(paramDecl, consumer) =
+        let inlayHintsMode = highlightingContext.ShowTypeNameHintsForImplicitlyTypedVariables
+        if inlayHintsMode <> InlayHintsMode.Never then
+            match paramDecl.Pattern with
+            | null -> ()
+            | pattern -> pattern.Accept(visitor, (consumer, inlayHintsMode))
+
+    override x.VisitMatchClause(matchClause, consumer) =
+        let inlayHintsMode = highlightingContext.ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions
+        if inlayHintsMode <> InlayHintsMode.Never then
+            match matchClause.Pattern with
+            | null -> ()
+            | pattern -> pattern.Accept(visitor, (consumer, inlayHintsMode))
+
+    override x.VisitLambdaExpr(lambdaExpr, consumer) =
+        let inlayHintsMode = highlightingContext.ShowTypeNameHintsForLambdaExpressionParameters
+        if inlayHintsMode <> InlayHintsMode.Never then
+            for pattern in lambdaExpr.Patterns do
+                if isNotNull pattern then
+                    pattern.Accept(visitor, (consumer, inlayHintsMode))
+
+
+[<DaemonStage(StagesBefore = [| typeof<FSharpErrorsStage> |])>]
+type InferredTypeHintStage(namingManager: NamingManager, nameParser: NameParser) =
+    inherit FSharpDaemonStageBase()
+
+    override x.IsSupported(sourceFile, processKind) =
+        processKind = DaemonProcessKind.VISIBLE_DOCUMENT &&
+        base.IsSupported(sourceFile, processKind) &&
+        not (sourceFile.LanguageType.Is<FSharpSignatureProjectFileType>())
+
+    override x.CreateStageProcess(fsFile, settings, daemonProcess) =
+        let context = FSharpTypeNameHintHighlightingContext(settings)
+
+        let isEnabled =
+            context.ShowTypeNameHintsForImplicitlyTypedVariables <> InlayHintsMode.Never ||
+            context.ShowTypeNameHintsForLambdaExpressionParameters <> InlayHintsMode.Never ||
+            context.ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions <> InlayHintsMode.Never
+
+        InferredTypeHintHighlightingProcess(fsFile, settings, context, namingManager, nameParser, daemonProcess, isEnabled) :> _

ReSharper.FSharp/src/FSharp.Psi.Features/src/Daemon/Stages/PipeChainTypeHintStage.fs

@@ -92,7 +92,7 @@ type PipeChainHighlightingProcess(logger: ILogger, fsFile, settings: IContextBou
                 // Use EndOffsetRange to ensure the adornment appears at the end of multi-line expressions
                 let range = exprToAdorn.GetNavigationRange().EndOffsetRange()
 
-                highlightingConsumer.AddHighlighting(TypeHintHighlighting(returnTypeStr, range))
+                highlightingConsumer.AddHighlighting(PipeTypeHintHighlighting(returnTypeStr, range))
             | _ -> ()
 
         highlightingConsumer.Highlightings
@@ -137,7 +137,7 @@ type PipeChainHighlightingProcess(logger: ILogger, fsFile, settings: IContextBou
 
         committer.Invoke(DaemonStageResult remainingHighlightings)
 
-[<DaemonStage(StagesBefore = [| typeof<GlobalFileStructureCollectorStage> |])>]
+[<DaemonStage(StagesBefore = [| typeof<FSharpErrorsStage> |])>]
 type PipeChainTypeHintStage(logger: ILogger) =
     inherit FSharpDaemonStageBase()
 

ReSharper.FSharp/src/FSharp.Psi.Features/src/Util/FSharpExpressionUtil.fs

@@ -130,3 +130,21 @@ let setBindingExpression (expr: IFSharpExpression) contextIndent (letBindings: #
         ModificationUtil.AddChildBefore(newExpr, NewLine(expr.GetLineEnding())) |> ignore
         ModificationUtil.AddChildBefore(newExpr, Whitespace(contextIndent + indentSize)) |> ignore
         shiftNode indentSize newExpr
+
+let rec isTypeEvident (expr: IFSharpExpression) =
+    match expr.IgnoreInnerParens() with
+    | :? IObjExpr
+    | :? ICastExpr
+    | :? ILambdaExpr
+    | :? ILiteralExpr -> true
+
+    | :? ITupleExpr as tupleExpr ->
+        tupleExpr.Expressions |> Seq.forall isTypeEvident
+
+    | :? IArrayOrListExpr as arrayOrListExpr ->
+        match arrayOrListExpr.Expression with
+        | :? ISequentialExpr as seqExpr ->
+            isTypeEvident (seqExpr.ExpressionsEnumerable.FirstOrDefault())
+        | _ -> false
+
+    | _ -> false

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 01 - No arguments.fs

@@ -0,0 +1,4 @@
+let add () =
+    "hello there"
+
+let l = fun () -> "hello there"

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 01 - No arguments.fs.gold

@@ -0,0 +1,6 @@
+let add () =
+    "hello there"
+
+let l = fun () -> "hello there"
+
+---------------------------------------------------------

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 02 - Curried arguments.fs

@@ -0,0 +1,4 @@
+let add x y =
+    x + y
+
+let x = fun x y -> x + y

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 02 - Curried arguments.fs.gold

@@ -0,0 +1,22 @@
+ShowTypeNameHintsForLambdaExpressionParameters = True
+let add x||(0) y||(1) =
+    x + y
+
+let x = fun x||(2) y||(3) -> x + y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int
+(1): ReSharper Parameter Name Hint: : int
+(2): ReSharper Parameter Name Hint: : int
+(3): ReSharper Parameter Name Hint: : int
+
+================
+ShowTypeNameHintsForLambdaExpressionParameters = False
+let add x||(0) y||(1) =
+    x + y
+
+let x = fun x y -> x + y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int
+(1): ReSharper Parameter Name Hint: : int

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 03 - Generic arguments.fs

@@ -0,0 +1,4 @@
+let add x y =
+    15 + y
+
+let l = fun x y -> 15 + y

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 03 - Generic arguments.fs.gold

@@ -0,0 +1,10 @@
+let add x||(0) y||(1) =
+    15 + y
+
+let l = fun x||(2) y||(3) -> 15 + y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : 'a
+(1): ReSharper Parameter Name Hint: : int
+(2): ReSharper Parameter Name Hint: : 'a
+(3): ReSharper Parameter Name Hint: : int