Add some code fixes for type mismatch. (#1250)

build/ScaffoldCodeFix.fs

@@ -299,7 +299,7 @@ let wireCodeFixInAdaptiveFSharpLspServer codeFixName =
   try
     let array = findArrayInAdaptiveFSharpLspServer ()
 
-    appendItemToArrayOrList $"%s{codeFixName}.fix tryGetParseResultsForFile" AdaptiveServerStatePath array
+    appendItemToArrayOrList $"%s{codeFixName}.fix tryGetParseAndCheckResultsForFile" AdaptiveServerStatePath array
   with ex ->
     Trace.traceException ex
 

src/FsAutoComplete/CodeFixes/ExprTypeMismatch.fs

@@ -0,0 +1,117 @@
+module FsAutoComplete.CodeFix.ExprTypeMismatch
+
+#nowarn "57"
+
+open FSharp.Compiler.Diagnostics.ExtendedData
+open FSharp.Compiler.Syntax
+open FSharp.Compiler.Text
+open FsToolkit.ErrorHandling
+open Ionide.LanguageServerProtocol.Types
+open FsAutoComplete.CodeFix.Types
+open FsAutoComplete
+open FsAutoComplete.LspHelpers
+
+let findReturnType (cursor: pos) (tree: ParsedInput) =
+  let visitor =
+    { new SyntaxVisitorBase<range>() with
+        member _.VisitBinding(path, defaultTraverse, synBinding) =
+          match synBinding with
+          | SynBinding(returnInfo = Some(SynBindingReturnInfo(typeName = t)); expr = bodyExpr) when
+            Range.rangeContainsPos bodyExpr.Range cursor
+            ->
+            Some t.Range
+          | _ -> None }
+
+  SyntaxTraversal.Traverse(cursor, tree, visitor)
+
+let needParenthesisWhenWrappedInSome (diagnosticRange: range) (tree: ParsedInput) =
+  let visitor =
+    { new SyntaxVisitorBase<bool>() with
+        member _.VisitExpr(path, traverseSynExpr, defaultTraverse, synExpr) =
+          if not (Range.equals synExpr.Range diagnosticRange) then
+            defaultTraverse synExpr
+          else
+            match synExpr with
+            | SynExpr.Const _
+            | SynExpr.Ident _ -> Some false
+            | e -> defaultTraverse e }
+
+  SyntaxTraversal.Traverse(diagnosticRange.Start, tree, visitor)
+  |> Option.defaultValue true
+
+let title = "ExprTypeMismatch Codefix"
+
+let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
+  Run.ifDiagnosticByCode (set [ "1" ]) (fun diagnostic (codeActionParams: CodeActionParams) ->
+    asyncResult {
+      let fileName = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath
+      let fcsPos = protocolPosToPos diagnostic.Range.Start
+
+      let! (parseAndCheckResults: ParseAndCheckResults, _line: string, sourceText: IFSACSourceText) =
+        getParseResultsForFile fileName fcsPos
+
+      let diagnosticWithExtendedData =
+        parseAndCheckResults.GetCheckResults.Diagnostics
+        |> Array.tryPick (fun d ->
+          match d.ExtendedData with
+          | Some(:? TypeMismatchDiagnosticExtendedData as data) -> Some(d, data)
+          | _ -> None)
+
+      match diagnosticWithExtendedData with
+      | None -> return []
+      | Some(diagnostic, extendedData) ->
+        let updateReturnType =
+          findReturnType fcsPos parseAndCheckResults.GetParseResults.ParseTree
+          |> Option.map (fun mReturnType ->
+            let currentType = sourceText.GetSubTextFromRange mReturnType
+            let actualType = extendedData.ActualType.Format(extendedData.DisplayContext)
+
+            { SourceDiagnostic = None
+              Title = $"Update %s{currentType} to %s{actualType}"
+              File = codeActionParams.TextDocument
+              Edits =
+                [| { Range = fcsRangeToLsp mReturnType
+                     NewText = actualType } |]
+              Kind = FixKind.Fix })
+          |> Option.toList
+
+        let optionFixes =
+          if diagnostic.Range.StartLine <> diagnostic.Range.EndLine then
+            []
+          elif
+            extendedData.ExpectedType.BasicQualifiedName = "Microsoft.FSharp.Core.option`1"
+            || extendedData.ExpectedType.BasicQualifiedName = "Microsoft.FSharp.Core.voption`1"
+          then
+            let currentExpr = sourceText.GetSubTextFromRange diagnostic.Range
+
+            let isValueOption =
+              extendedData.ExpectedType.BasicQualifiedName = "Microsoft.FSharp.Core.voption`1"
+
+            let wrapIn = if isValueOption then "ValueSome" else "Some"
+            let replaceWithNone = if isValueOption then "ValueNone" else "None"
+
+            let needsParenthesis =
+              needParenthesisWhenWrappedInSome diagnostic.Range parseAndCheckResults.GetParseResults.ParseTree
+
+            let space, openP, closeP =
+              if not needsParenthesis then " ", "", "" else "", "(", ")"
+
+            [ { SourceDiagnostic = None
+                Title = $"Wrap expression in %s{wrapIn}"
+                File = codeActionParams.TextDocument
+                Edits =
+                  [| { Range = fcsRangeToLsp diagnostic.Range
+                       NewText = $"%s{wrapIn}%s{space}%s{openP}%s{currentExpr}%s{closeP}" } |]
+                Kind = FixKind.Fix }
+              { SourceDiagnostic = None
+                Title = $"Replace expression with %s{replaceWithNone}"
+                File = codeActionParams.TextDocument
+                Edits =
+                  [| { Range = fcsRangeToLsp diagnostic.Range
+                       NewText = replaceWithNone } |]
+                Kind = FixKind.Fix } ]
+          else
+            []
+
+        return [ yield! updateReturnType; yield! optionFixes ]
+    })

src/FsAutoComplete/CodeFixes/ExprTypeMismatch.fsi

@@ -0,0 +1,6 @@
+module FsAutoComplete.CodeFix.ExprTypeMismatch
+
+open FsAutoComplete.CodeFix.Types
+
+val title: string
+val fix: getParseResultsForFile: GetParseResultsForFile -> CodeFix

src/FsAutoComplete/LspServers/AdaptiveServerState.fs

@@ -1905,7 +1905,8 @@ type AdaptiveState(lspClient: FSharpLspClient, sourceTextFactory: ISourceTextFac
          ToInterpolatedString.fix tryGetParseAndCheckResultsForFile getLanguageVersion
          AdjustConstant.fix tryGetParseAndCheckResultsForFile
          UpdateValueInSignatureFile.fix tryGetParseAndCheckResultsForFile
-         RemoveUnnecessaryParentheses.fix forceFindSourceText |])
+         RemoveUnnecessaryParentheses.fix forceFindSourceText
+         ExprTypeMismatch.fix tryGetParseAndCheckResultsForFile |])
 
   let forgetDocument (uri: DocumentUri) =
     async {

test/FsAutoComplete.Tests.Lsp/CodeFixTests/ExprTypeMismatchTests.fs

@@ -0,0 +1,81 @@
+module private FsAutoComplete.Tests.CodeFixTests.ExprTypeMismatchTests
+
+open Expecto
+open Helpers
+open Utils.ServerTests
+open Utils.CursorbasedTests
+open FsAutoComplete.CodeFix
+
+let tests state =
+  serverTestList (nameof ExprTypeMismatch) state defaultConfigDto None (fun server ->
+    [ testCaseAsync "Update return type"
+      <| CodeFix.check
+        server
+        "let a b : int = $0\"meh\""
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Update int to string")
+        "let a b : string = \"meh\""
+
+      testCaseAsync "Wrap constant in Some"
+      <| CodeFix.check
+        server
+        "let a b : int option = 1$0"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Wrap expression in Some")
+        "let a b : int option = Some 1"
+
+      testCaseAsync "Wrap expr in Some"
+      <| CodeFix.check
+        server
+        "let a b : bool option = true$0 = false"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Wrap expression in Some")
+        "let a b : bool option = Some(true = false)"
+
+      testCaseAsync "Wrap single indent in Some"
+      <| CodeFix.check
+        server
+        "let a b : bool option = let x = true in $0x"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Wrap expression in Some")
+        "let a b : bool option = let x = true in Some x"
+
+      testCaseAsync "Replace expression with None"
+      <| CodeFix.check
+        server
+        "let a b : int option = 1$0"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Replace expression with None")
+        "let a b : int option = None"
+
+      testCaseAsync "Wrap constant in ValueSome"
+      <| CodeFix.check
+        server
+        "let a b : int voption = 1$0"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Wrap expression in ValueSome")
+        "let a b : int voption = ValueSome 1"
+
+      testCaseAsync "Wrap expr in ValueSome"
+      <| CodeFix.check
+        server
+        "let a b : bool voption = true$0 = false"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Wrap expression in ValueSome")
+        "let a b : bool voption = ValueSome(true = false)"
+
+      testCaseAsync "Wrap single indent in ValueSome"
+      <| CodeFix.check
+        server
+        "let a b : bool voption = let x = true in $0x"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Wrap expression in ValueSome")
+        "let a b : bool voption = let x = true in ValueSome x"
+
+      testCaseAsync "Replace expression with ValueNone"
+      <| CodeFix.check
+        server
+        "let a b : int voption = 1$0"
+        Diagnostics.acceptAll
+        (CodeFix.withTitle "Replace expression with ValueNone")
+        "let a b : int voption = ValueNone" ])

test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs

@@ -3454,4 +3454,5 @@ let tests textFactory state =
       removeRedundantAttributeSuffixTests state
       removePatternArgumentTests state
       UpdateValueInSignatureFileTests.tests state
-      removeUnnecessaryParenthesesTests state ]
+      removeUnnecessaryParenthesesTests state
+      ExprTypeMismatchTests.tests state ]