Quick fixes: replace return type (#367)

ReSharper.FSharp/src/FSharp.Psi.Daemon/src/Stages/FcsErrorsStageProcessBase.fs

@@ -87,7 +87,10 @@ module FSharpErrors =
     let [<Literal>] typeConstraintMismatchMessage = "Type constraint mismatch. The type \n    '(.+)'    \nis not compatible with type\n    '(.+)'"
 
     let [<Literal>] typeEquationMessage = "This expression was expected to have type\n    '(.+)'    \nbut here has type\n    '(.+)'"
+    let [<Literal>] typeDoesNotMatchMessage = "The type '(.+)' does not match the type '(.+)'"
     let [<Literal>] elseBranchHasWrongTypeMessage = "All branches of an 'if' expression must return values implicitly convertible to the type of the first branch, which here is '(.+)'. This branch returns a value of type '(.+)'."
+    let [<Literal>] ifBranchSatisfyContextTypeRequirements = "The 'if' expression needs to have type '(.+)' to satisfy context type requirements\. It currently has type '(.+)'"
+    let [<Literal>] typeMisMatchTupleLengths = "Type mismatch. Expecting a\n    '(.+)'    \nbut given a\n    '(.+)'    \nThe tuples have differing lengths of \\d+ and \\d+"
 
     let isDirectiveSyntaxError number =
         number >= 232 && number <= 235
@@ -184,6 +187,17 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
                     | _ -> TypeEquationError(expectedType, actualType, expr, error.Message) :> _
                 else null
 
+            | Regex typeDoesNotMatchMessage [expectedType; actualType] ->
+                let expr = nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null)
+                TypeDoesNotMatchTypeError(expectedType, actualType, expr, error.Message)
+
+            | Regex ifBranchSatisfyContextTypeRequirements [expectedType; actualType] ->
+                let expr = nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null)
+                IfExpressionNeedsTypeToSatisfyTypeRequirementsError(expectedType, actualType, expr, error.Message)
+
+            | Regex typeMisMatchTupleLengths [expectedType; actualType] ->
+                let expr = nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null)
+                TypeMisMatchTuplesHaveDifferingLengthsError(expectedType, actualType, expr, error.Message)
             | _ -> createGenericHighlighting error range
 
         | NotAFunction ->
@@ -409,7 +423,7 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
                 let expr = getResultExpr expr
                 FunctionValueUnexpectedWarning(expr, error.Message) :> _
 
-            | Regex typeConstraintMismatchMessage [_; typeConstraint] ->
+            | Regex typeConstraintMismatchMessage [mismatchedType; typeConstraint] ->
                 let highlighting =
                     match typeConstraint with
                     | "unit" ->
@@ -420,7 +434,8 @@ type FcsErrorsStageProcessBase(fsFile, daemonProcess) =
 
                 if isNotNull highlighting then highlighting :> _ else
 
-                createHighlightingFromNodeWithMessage TypeConstraintMismatchError range error
+                let expr = nodeSelectionProvider.GetExpressionInRange(fsFile, range, false, null)
+                TypeConstraintMismatchError(mismatchedType, expr, error.Message)
 
             | _ -> null
 

ReSharper.FSharp/src/FSharp.Psi.Intentions/FSharp.Psi.Intentions.fsproj

@@ -88,6 +88,7 @@
     <Compile Include="src\QuickFixes\RemoveIndexerDotFix.fs" />
     <Compile Include="src\QuickFixes\FSharpImportTypeFix.fs" />
     <Compile Include="src\QuickFixes\ReplaceWithTripleQuotedInterpolatedStringFix.fs" />
+    <Compile Include="src\QuickFixes\ReplaceReturnTypeFix.fs" />
     <ErrorsGen Include="..\FSharp.Psi.Services\src\Daemon\Highlightings\Errors.xml">
       <Mode>QUICKFIX</Mode>
       <Namespace>JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.QuickFixes</Namespace>

ReSharper.FSharp/src/FSharp.Psi.Intentions/src/QuickFixes/ReplaceReturnTypeFix.fs

@@ -0,0 +1,85 @@
+namespace JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.QuickFixes
+
+open JetBrains.ReSharper.Psi.ExtensionsAPI.Tree
+open JetBrains.ReSharper.Plugins.FSharp.Psi
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Util
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Impl
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Features.Daemon.Highlightings
+open JetBrains.ReSharper.Plugins.FSharp.Psi.Tree
+open JetBrains.ReSharper.Psi.ExtensionsAPI
+open JetBrains.ReSharper.Resources.Shell
+
+type ReplaceReturnTypeFix(expr: IFSharpExpression, replacementTypeName: string) =
+    inherit FSharpQuickFixBase()
+
+    let mostOuterParentExpr = expr.GetOutermostParentExpressionFromItsReturn()
+
+    new (error: TypeConstraintMismatchError) =
+        // error FS0193: Type constraint mismatch. The type ↔    'A.B'    ↔is not compatible with type↔    'Thing'
+        ReplaceReturnTypeFix(error.Expr, error.MismatchedType)
+
+    new (error: TypeDoesNotMatchTypeError) =
+        // error FS0001: The type 'double' does not match the type 'int'
+        ReplaceReturnTypeFix(error.Expr, error.ActualType)
+
+    (*
+        match () with
+        | _ -> ""
+    *)
+    new (error: TypeEquationError) =
+        // error FS0001: This expression was expected to have type↔    'int'    ↔but here has type↔    'string'
+        ReplaceReturnTypeFix(error.Expr, error.ActualType)
+
+    new (error: IfExpressionNeedsTypeToSatisfyTypeRequirementsError) =
+        // error FS0001: The 'if' expression needs to have type 'string' to satisfy context type requirements. It currently has type 'int'.
+        ReplaceReturnTypeFix(error.Expr, error.ActualType)
+
+    new (error: TypeMisMatchTuplesHaveDifferingLengthsError) =
+        // Type mismatch. Expecting a
+        //     'string * string'    
+        // but given a
+        //     'string * string * 'a'
+        // The tuples have differing lengths of 2 and 3
+        ReplaceReturnTypeFix(error.Expr, error.ActualType)
+
+    override this.Text = "Replace return type"
+    override this.IsAvailable _ =
+        if isNull mostOuterParentExpr then false else
+        let binding = BindingNavigator.GetByExpression(mostOuterParentExpr)
+        if isNull binding then false else
+
+        // Some types cannot be replaced properly solely on the FCS error message.
+        // We will ignore these types for now.
+        match binding.ReturnTypeInfo.ReturnType.IgnoreParentParens() with
+        | :? ITupleTypeUsage
+        | :? IFunctionTypeUsage -> false
+        | _ ->
+            // An invalid binary infix application will yield a similar error and could be mistaken for an invalid return type.
+            // F.ex. 1 + "a", error FS0001: The type 'string' does not match the type 'int'
+            // We ignore this scenario for now.
+            match mostOuterParentExpr with
+            | :? IBinaryAppExpr -> false
+            | _ -> true
+
+    override this.ExecutePsiTransaction(_solution) =
+        let binding = BindingNavigator.GetByExpression(mostOuterParentExpr)
+
+        use writeCookie = WriteLockCookie.Create(binding.IsPhysical())
+        use disableFormatter = new DisableCodeFormatter()
+
+        let refPat = binding.HeadPattern.As<IReferencePat>()
+        if isNull refPat then () else
+
+        let symbolUse = refPat.GetFcsSymbolUse()
+        if isNull symbolUse then () else
+
+        if isNotNull binding.ReturnTypeInfo
+           && isNotNull binding.ReturnTypeInfo.ReturnType then
+            let factory = binding.CreateElementFactory()
+            let typeUsage = factory.CreateTypeUsage(replacementTypeName)
+            let returnType = binding.ReturnTypeInfo.ReturnType.IgnoreInnerParens()
+
+            match returnType with
+            | :? INamedTypeUsage as ntu ->
+                ModificationUtil.ReplaceChild(ntu, typeUsage) |> ignore
+            | _ -> ()

ReSharper.FSharp/src/FSharp.Psi.Services/src/Daemon/Highlightings/FcsErrors.xml

@@ -351,6 +351,7 @@
     <Range>expr.GetHighlightingRange()</Range>
     <Behavour overlapResolvePolicy="NONE"/>
     <QuickFix>ConvertTupleToArrayOrListElementsFix</QuickFix>
+    <QuickFix>ReplaceReturnTypeFix</QuickFix>
   </Error>
 
   <Error staticGroup="FSharpErrors" name="TypeAbbreviationsCannotHaveAugmentations" ID="FS0964: Type abbreviations cannot have augmentations">
@@ -373,6 +374,7 @@
   </Error>
 
   <Error staticGroup="FSharpErrors" name="TypeConstraintMismatch" ID="FS0193: Type constraint mismatch">
+    <Parameter type="string" name="mismatchedType"/>
     <Parameter type="IFSharpExpression" name="expr"/>
     <Parameter type="string" name="fcsMessage"/>
     <Message value="{0}">
@@ -381,6 +383,7 @@
     <Range>expr.GetHighlightingRange()</Range>
     <Behavour overlapResolvePolicy="NONE"/>
     <QuickFix>AddParensToTypedLikeExprFix</QuickFix>
+    <QuickFix>ReplaceReturnTypeFix</QuickFix>
   </Error>
 
   <Error staticGroup="FSharpErrors" name="IndeterminateType" ID="FS0072: Lookup on indeterminate type object">
@@ -496,5 +499,43 @@
     <Behavour overlapResolvePolicy="NONE"/>
     <QuickFix>ReplaceWithTripleQuotedInterpolatedStringFix</QuickFix>
   </Error>
+
+  <Error staticGroup="FSharpErrors" name="TypeDoesNotMatchType" ID="FS0001: The type does not match the type">
+    <Parameter type="string" name="expectedType"/>
+    <Parameter type="string" name="actualType"/>
+    <Parameter type="IFSharpExpression" name="expr"/>
+    <Parameter type="string" name="fcsMessage"/>
+    <Message value="{0}">
+      <Argument>fcsMessage</Argument>
+    </Message>
+    <Range>expr.GetHighlightingRange()</Range>
+    <Behavour overlapResolvePolicy="NONE"/>
+    <QuickFix>ReplaceReturnTypeFix</QuickFix>
+  </Error>
+
+  <Error staticGroup="FSharpErrors" name="IfExpressionNeedsTypeToSatisfyTypeRequirements" ID="FS0001: The 'if' expression needs to have type">
+    <Parameter type="string" name="expectedType"/>
+    <Parameter type="string" name="actualType"/>
+    <Parameter type="IFSharpExpression" name="expr"/>
+    <Parameter type="string" name="fcsMessage"/>
+    <Message value="{0}">
+      <Argument>fcsMessage</Argument>
+    </Message>
+    <Range>expr.GetHighlightingRange()</Range>
+    <Behavour overlapResolvePolicy="NONE"/>
+    <QuickFix>ReplaceReturnTypeFix</QuickFix>
+  </Error>
+
+  <Error staticGroup="FSharpErrors" name="TypeMisMatchTuplesHaveDifferingLengths" ID="FS0001: Type mismatch. Expecting">
+    <Parameter type="string" name="expectedType"/>
+    <Parameter type="string" name="actualType"/>
+    <Parameter type="IFSharpExpression" name="expr"/>
+    <Parameter type="string" name="fcsMessage"/>
+    <Message value="{0}">
+      <Argument>fcsMessage</Argument>
+    </Message>
+    <Range>expr.GetHighlightingRange()</Range>
+    <Behavour overlapResolvePolicy="NONE"/>
+  </Error>
 
 </Errors>

ReSharper.FSharp/src/FSharp.Psi/src/Util/FSharpExpressionUtil.cs

@@ -1,4 +1,5 @@
 using System;
+using System.Linq;
 using JetBrains.Annotations;
 using JetBrains.ReSharper.Plugins.FSharp.Psi.Impl;
 using JetBrains.ReSharper.Plugins.FSharp.Psi.Impl.Tree;
@@ -35,5 +36,40 @@ public static class FSharpExpressionUtil
 
     public static readonly Func<IFSharpExpression, bool> IsSimpleValueExpressionFunc = IsSimpleValueExpression;
     public static readonly Func<IFSharpExpression, bool> IsLiteralExpressionFunc = IsLiteralExpression;
+
+    // TODO: change name
+    public static IFSharpExpression GetOutermostParentExpressionFromItsReturn(this IFSharpExpression expression)
+    {
+      var currentExpr = expression;
+      while (true)
+      {
+        if (MatchClauseListOwnerExprNavigator.GetByClauseExpression(currentExpr) is { } matchExpr)
+        {
+          currentExpr = matchExpr as IFSharpExpression;
+          continue;
+        }
+
+        if (SequentialExprNavigator.GetByExpression(currentExpr) is { } seqExpr &&
+            seqExpr.ExpressionsEnumerable.Last() == currentExpr)
+        {
+          currentExpr = seqExpr;
+          continue;
+        }
+
+        if ((IfThenElseExprNavigator.GetByBranchExpression(currentExpr)) is {ElseExpr: { }} ifExpr)
+        {
+          currentExpr = ifExpr;
+          continue;
+        }
+
+        if (LetOrUseExprNavigator.GetByInExpression(currentExpr) is { } letOrUseExpr)
+        {
+          currentExpr = letOrUseExpr;
+          continue;
+        }
+
+        return currentExpr;
+      }
+    }
   }
 }

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Constraint Mismatch.fs

@@ -0,0 +1,11 @@
+type Thing() =
+    class
+    end
+
+module A =
+    type B() =
+        class
+        end
+
+
+let mkBee () : Thing = A.B(){caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Constraint Mismatch.fs.gold

@@ -0,0 +1,11 @@
+type Thing() =
+    class
+    end
+
+module A =
+    type B() =
+        class
+        end
+
+
+let mkBee () : A.B = A.B(){caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/FunctionType 01.fs

@@ -0,0 +1,2 @@
+let f1 _ : unit -> int =
+    fun _ -> ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/FunctionType 01.fs.gold

@@ -0,0 +1,2 @@
+let f1 _ : unit -> string =
+    fun _ -> ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/FunctionType 02.fs

@@ -0,0 +1,2 @@
+let f2 _ : unit -> int =
+    id{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/FunctionType 02.fs.gold

@@ -0,0 +1,2 @@
+let f2 _ : unit -> unit =
+    id{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/FunctionType 03.fs

@@ -0,0 +1 @@
+let x: int -> int = 1, 1{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/FunctionType 03.fs.gold

@@ -0,0 +1 @@
+let x: int * int = 1, 1{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/IfThenElse - Else.fs

@@ -0,0 +1 @@
+let v : string = if true then "" else 1{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/IfThenElse - Else.fs.gold

@@ -0,0 +1 @@
+let v : int = if true then "" else 1{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/IfThenElse - If.fs

@@ -0,0 +1 @@
+let v : string = if true then 0{caret} else ""

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/IfThenElse - If.fs.gold

@@ -0,0 +1 @@
+let v : int = if true then 0{caret} else ""

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Infix application.fs

@@ -0,0 +1 @@
+let sum (a: int) (b: int) : string = a + b{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Infix application.fs.gold

@@ -0,0 +1 @@
+let sum (a: int) (b: int) : int = a + b{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/LetOrUse.fs

@@ -0,0 +1,3 @@
+let x: int =
+    let _ = 1
+    ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/LetOrUse.fs.gold

@@ -0,0 +1,3 @@
+let x: string =
+    let _ = 1
+    ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/MatchClause.fs

@@ -0,0 +1,3 @@
+let f x : int =
+    match () with
+    | _ -> ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/MatchClause.fs.gold

@@ -0,0 +1,3 @@
+let f x : string =
+    match () with
+    | _ -> ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/MatchLambda.fs

@@ -0,0 +1,2 @@
+let v: 'a -> int = function
+    | _ -> ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/MatchLambda.fs.gold

@@ -0,0 +1,2 @@
+let v: 'a -> string = function
+    | _ -> ""{caret}

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/No highlighting 01.fs

@@ -0,0 +1,6 @@
+let f x : int =
+    match () with
+    | _ -> ""
+    | _ -> 1{caret}
+
+    1

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/No highlighting 01.gold

@@ -0,0 +1,6 @@
+let f x : int =
+    match () with
+    | _ -> ""
+    | _ -> 1{caret}
+
+    1

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/No highlighting 02.fs

@@ -0,0 +1,2 @@
+let v : string =
+    $"%s{42{caret}}"

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/No highlighting 02.gold

@@ -0,0 +1,2 @@
+let v : string =
+    $"%s{42{caret}}"

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/No highlighting 03.fs

@@ -0,0 +1,5 @@
+let forever () = true
+
+let meh : unit =
+    while forever ""{caret} do
+        ()

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/No highlighting 03.gold

@@ -0,0 +1,5 @@
+let forever () = true
+
+let meh : unit =
+    while forever ""{caret} do
+        ()

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 01.fs

@@ -0,0 +1,4 @@
+let f x : int =
+    "" + 1{caret}
+
+    1

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 01.gold

@@ -0,0 +1,4 @@
+let f x : int =
+    "" + 1{caret}
+
+    1

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 02.fs

@@ -0,0 +1 @@
+if (1{caret}: string) = 2 then () else ()

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 02.gold

@@ -0,0 +1 @@
+if (1{caret}: string) = 2 then () else ()

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 03.fs

@@ -0,0 +1,3 @@
+let s : unit =
+    for i = (0:string{caret}) to 9 do
+        ()

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 03.fs.gold

@@ -0,0 +1,3 @@
+let s : unit =
+    for i = (0:string{caret}) to 9 do
+        ()

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 04.fs

@@ -0,0 +1,3 @@
+let v : int =
+    let x = (1{caret}: string) in
+    (int) x

ReSharper.FSharp/test/data/features/quickFixes/replaceReturnType/Not available 04.fs.gold

@@ -0,0 +1,3 @@
+let v : int =
+    let x = (1{caret}: string) in
+    (int) x