Add inferred type name hints

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

@@ -61,7 +61,6 @@ type FSharpScriptOptionsProvider(lifetime: Lifetime, settings: IContextBoundSett
     member val CustomDefines = settings.GetValueProperty(lifetime, fun s -> s.CustomDefines)
 
 
-
 module FSharpTypeHintOptions =
     let [<Literal>] pipeReturnTypes = "Show return type hints in |> chains"
 
@@ -91,7 +90,7 @@ type FSharpOptionsPage
         this.AddComboEnum((fun key -> key.LanguageVersion), FSharpScriptOptions.languageVersion, FSharpLanguageVersion.toString) |> 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()
             [
@@ -100,7 +99,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.BackgroundTypeCheck), RichText(backgroundTypeCheck), null) |> ignore
 

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

@@ -48,6 +48,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/Stages/InferredTypeHintStage.fs

@@ -0,0 +1,172 @@
+namespace JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.Stages
+
+open System
+open JetBrains.Application.Settings
+open JetBrains.ProjectModel
+open JetBrains.ReSharper.Daemon.Stages
+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.Psi
+open JetBrains.ReSharper.Psi.Naming
+open JetBrains.ReSharper.Psi.Naming.Impl
+open JetBrains.ReSharper.Psi.Tree
+open JetBrains.ReSharper.Psi.Util
+open JetBrains.ReSharper.Feature.Services.Daemon
+open JetBrains.ReSharper.Plugins.FSharp.Daemon.Cs.Stages
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
+open FSharp.Compiler.SourceCodeServices
+
+type LocalReferencePatternVisitor(fsFile: IFSharpFile, highlightingContext: TypeNameHintHighlightingContext, namingPolicyProvider, nameParser) =
+    inherit TreeNodeVisitor<IHighlightingConsumer>()
+
+    let isTypeEvidentFromVariableNamePrefix (typ: IType) (variableNameParts: string[]) =
+        if not (typ.IsBool()) then false else
+
+        if variableNameParts.Length > 0 then
+            let prefix = variableNameParts.[0].ToLowerInvariant()
+            prefix = "has" || prefix = "is"
+        else
+            false
+
+    let isEvidentFromVariableName (fsType: FSharpType) variableName =
+        if not highlightingContext.HideTypeNameHintsWhenTypeNameIsEvidentFromVariableName then false else
+
+        let typ = fsType.MapType(Array.empty, fsFile.GetPsiModule())
+        if not (typ.IsValid()) then false else
+
+        let variableNameParts = NamesHelper.GetParts(nameParser, namingPolicyProvider, variableName)
+        if isTypeEvidentFromVariableNamePrefix typ variableNameParts then true else
+
+        match typ.GetTypeElement() with
+        | null -> false
+        | typeElement ->
+
+        let typeName = typeElement.ShortName
+        String.Equals(typeName, variableName, StringComparison.OrdinalIgnoreCase) ||
+        not (String.IsNullOrEmpty(typeName)) &&
+        not (String.IsNullOrEmpty(variableName)) &&
+        NamesHelper.IsLike(variableNameParts, NamesHelper.GetParts(nameParser, namingPolicyProvider, typeName))
+
+    let isTypeOfPatternEvident (pattern: ISynPat) =
+
+        // v-- not evident
+        // x::y::z
+        //    ^--^-- evident
+        let tuplePat = TuplePatNavigator.GetByPattern pattern
+        if isNotNull tuplePat then
+            let consPat = ConsPatNavigator.GetByPattern1 tuplePat
+            if isNull consPat then false else
+
+            // Are we nested inside another ConsPat?
+            let parentTuplePat = TuplePatNavigator.GetByPattern consPat
+            if isNull parentTuplePat then tuplePat.Patterns.IndexOf pattern <> 0 else
+            isNotNull (ConsPatNavigator.GetByPattern1 parentTuplePat)
+
+        else
+
+        //  v-- not evident
+        // [x; y; z]
+        //     ^--^-- evident
+        let listOrListPat = ArrayOrListPatNavigator.GetByPattern pattern
+        if isNotNull listOrListPat then
+            listOrListPat.Patterns.IndexOf pattern <> 0
+
+        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) =
+        let pat = localRefPat.IgnoreParentParens()
+        if isNotNull (TypedPatNavigator.GetByPattern(pat)) then () else
+
+        let binding = BindingNavigator.GetByHeadPattern(pat)
+        if isNotNull binding && isNotNull binding.ReturnTypeInfo then () else
+
+        if isTypeOfPatternEvident pat then () else
+
+        match box (localRefPat.GetFSharpSymbolUse()) with
+        | null -> ()
+        | symbolUse ->
+
+        let symbolUse = symbolUse :?> FSharpSymbolUse
+        match symbolUse.Symbol with
+        | :? FSharpMemberOrFunctionOrValue as mfv when not (isEvidentFromVariableName mfv.FullType localRefPat.ReferenceName.Identifier.Name) ->
+            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))
+        | _ -> ()
+
+type InferredTypeHintHighlightingProcess(fsFile, settings: IContextBoundSettingsStore, highlightingContext: TypeNameHintHighlightingContext, namingManager: NamingManager, nameParser: NameParser, daemonProcess) =
+    inherit FSharpDaemonStageProcessBase(fsFile, daemonProcess)
+
+    let namingPolicyProvider = namingManager.Policy.GetPolicyProvider(fsFile.Language, fsFile.GetSourceFile())
+
+    let visitor = LocalReferencePatternVisitor(fsFile, highlightingContext, namingPolicyProvider, nameParser)
+
+    let visitLetBindings (letBindings: ILetBindings) consumer =
+        if not highlightingContext.ShowTypeNameHintsForImplicitlyTypedVariables then () else
+
+        for binding in letBindings.Bindings do
+            if highlightingContext.HideTypeNameHintsForImplicitlyTypedVariablesWhenTypeIsEvident && isTypeEvident binding.Expression then () else
+            binding.HeadPattern.Accept(visitor, consumer)
+
+    override x.Execute(committer) =
+        let consumer = FilteringHighlightingConsumer(daemonProcess.SourceFile, fsFile, settings)
+        fsFile.ProcessThisAndDescendants(Processor(x, consumer))
+        committer.Invoke(DaemonStageResult(consumer.Highlightings))
+
+    override x.VisitLetModuleDecl(moduleDecl, consumer) =
+        visitLetBindings moduleDecl consumer
+
+    override x.VisitLetOrUseExpr(letOrUseExpr, consumer) =
+        visitLetBindings letOrUseExpr consumer
+
+    override x.VisitMemberParamDeclaration(paramDecl, consumer) =
+        // todo: do we need another setting for this?
+        if highlightingContext.ShowTypeNameHintsForImplicitlyTypedVariables then
+            paramDecl.Pattern.Accept(visitor, consumer)
+
+    override x.VisitMatchClause(matchClause, consumer) =
+        if highlightingContext.ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions then
+            matchClause.Pattern.Accept(visitor, consumer)
+
+    override x.VisitLambdaExpr(lambdaExpr, consumer) =
+        if not highlightingContext.ShowTypeNameHintsForLambdaExpressionParameters then () else
+
+        for pattern in lambdaExpr.Patterns do
+            pattern.Accept(visitor, consumer)
+
+[<DaemonStage(StagesBefore = [| typeof<GlobalFileStructureCollectorStage> |])>]
+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 highlightingContext = TypeNameHintHighlightingContext(settings)
+        let isEnabled =
+            highlightingContext.ShowTypeNameHintsForImplicitlyTypedVariables ||
+            highlightingContext.ShowTypeNameHintsForLambdaExpressionParameters ||
+            highlightingContext.ShowTypeNameHintsForVarDeclarationsInPatternMatchingExpressions
+
+        if not isEnabled then null else
+        InferredTypeHintHighlightingProcess(fsFile, settings, highlightingContext, namingManager, nameParser, daemonProcess) :> _

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

@@ -108,3 +108,18 @@ let setBindingExpression (expr: IFSharpExpression) contextIndent (letBindings: #
         ModificationUtil.AddChildBefore(newExpr, NewLine(expr.GetLineEnding())) |> ignore
         ModificationUtil.AddChildBefore(newExpr, Whitespace(contextIndent + indentSize)) |> ignore
         shiftExpr 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.Expressions.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

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 04 - Tupled arguments.fs

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

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 04 - Tupled arguments.fs.gold

@@ -0,0 +1,10 @@
+let add (x||(0), y||(1)) =
+    x + y
+
+let l = 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

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 05 - Type annotated - Curried.fs

@@ -0,0 +1,4 @@
+let subtract x (y : int) =
+    x - y
+
+let l = fun x (y: int) -> x - y

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 05 - Type annotated - Curried.fs.gold

@@ -0,0 +1,19 @@
+ShowTypeNameHintsForImplicitlyTypedVariables = True
+let subtract x||(0) (y : int) =
+    x - y
+
+let l = fun x||(1) (y: int) -> x - y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int
+(1): ReSharper Parameter Name Hint: : int
+
+================
+ShowTypeNameHintsForImplicitlyTypedVariables = False
+let subtract x (y : int) =
+    x - y
+
+let l = fun x||(0) (y: int) -> x - y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 06 - Type annotated - Tupled.fs

@@ -0,0 +1,4 @@
+let subtract (x: int, y) =
+    x - y
+
+let l = fun (x: int, y) -> x - y

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 06 - Type annotated - Tupled.fs.gold

@@ -0,0 +1,19 @@
+ShowTypeNameHintsForImplicitlyTypedVariables = True
+let subtract (x: int, y||(0)) =
+    x - y
+
+let l = fun (x: int, y||(1)) -> x - y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int
+(1): ReSharper Parameter Name Hint: : int
+
+================
+ShowTypeNameHintsForImplicitlyTypedVariables = False
+let subtract (x: int, y) =
+    x - y
+
+let l = fun (x: int, y||(0)) -> x - y
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 07 - Local function.fs

@@ -0,0 +1,4 @@
+let hello () =
+    let localFunc x y = x + y
+    let l = fun x y -> x + y
+    ()

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 07 - Local function.fs.gold

@@ -0,0 +1,10 @@
+let hello () =
+    let localFunc x||(0) y||(1) = x + y
+    let l = 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

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

@@ -0,0 +1,3 @@
+let call f x =
+    let y = f (12, (15, [1; 2; 3])) * 15.
+    x f

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

@@ -0,0 +1,7 @@
+let call f x||(0) =
+    let y||(1) = f (12, (15, [1; 2; 3])) * 15.
+    x f
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : (int * (int * int list) -> float) -> 'a
+(1): ReSharper Parameter Name Hint: : float

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 09 - Pattern match argument.fs

@@ -0,0 +1,3 @@
+type MySingleCaseDu = MySingleCaseDu of int
+let addFive (MySingleCaseDu value) =
+    value + 5

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 09 - Pattern match argument.fs.gold

@@ -0,0 +1,6 @@
+type MySingleCaseDu = MySingleCaseDu of int
+let addFive (MySingleCaseDu value||(0)) =
+    value + 5
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 10 - Arguments in parentheses.fs

@@ -0,0 +1,2 @@
+let addFive (hi) =
+    hi + 5

ReSharper.FSharp/test/data/features/daemon/inferredTypeHints/Function 10 - Arguments in parentheses.fs.gold

@@ -0,0 +1,5 @@
+let addFive (hi||(0)) =
+    hi + 5
+
+---------------------------------------------------------
+(0): ReSharper Parameter Name Hint: : int