(mostly) implement explicit type annotation codefix

src/FsAutoComplete.Core/FCSPatches.fs

@@ -331,6 +331,57 @@ type FSharpParseFileResults with
                         None
                 | _ -> defaultTraverse expr })
     )
+
+  member scope.IsTypeAnnotationGivenAtPositionPatched pos =
+        match scope.ParseTree with
+        | Some input ->
+          let result =
+              AstTraversal.Traverse(pos, input, { new AstTraversal.AstVisitorBase<_>() with
+                  member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) =
+                      match expr with
+                      | SynExpr.Typed (_expr, _typeExpr, range) when Pos.posEq range.Start pos ->
+                          Some range
+                      | _ -> defaultTraverse expr
+
+                  override _.VisitSimplePats(pats) =
+                      match pats with
+                      | [] -> None
+                      | _ ->
+                          let exprFunc pat =
+                              match pat with
+                              | SynSimplePat.Typed (_pat, _targetExpr, range) when Pos.posEq range.Start pos ->
+                                  Some range
+                              | _ ->
+                                  None
+
+                          pats |> List.tryPick exprFunc
+
+                  override _.VisitPat(defaultTraverse, pat) =
+                      match pat with
+                      | SynPat.Typed (_pat, _targetType, range) when Pos.posEq range.Start pos ->
+                          Some range
+                      | _ -> defaultTraverse pat })
+          result.IsSome
+        | None -> false
+
+  member scope.IsBindingALambdaAtPositionPatched pos =
+    match scope.ParseTree with
+    | Some input ->
+      let result =
+          AstTraversal.Traverse(pos, input, { new AstTraversal.AstVisitorBase<_>() with
+              member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) =
+                  defaultTraverse expr
+
+              override _.VisitBinding(defaultTraverse, binding) =
+                  match binding with
+                  | SynBinding.Binding(_, _, _, _, _, _, _, _, _, expr, range, _) when Pos.posEq range.Start pos ->
+                      match expr with
+                      | SynExpr.Lambda _ -> Some range
+                      | _ -> None
+                  | _ -> defaultTraverse binding })
+      result.IsSome
+    | None -> false
+
 module SyntaxTreeOps =
   open FSharp.Compiler.SyntaxTree
   let rec synExprContainsError inpExpr =

src/FsAutoComplete.Core/FileSystem.fs

@@ -21,7 +21,7 @@ type SourceTextExtensions =
   static member GetText(t: ISourceText, m: FSharp.Compiler.Text.Range): Result<string, string> =
     let allFileRange = Range.mkRange m.FileName Pos.pos0 (t.GetLastFilePosition())
     if not (Range.rangeContainsRange allFileRange m)
-    then Error "%A{m} is outside of the bounds of the file"
+    then Error $"%A{m} is outside of the bounds of the file"
     else
       if m.StartLine = m.EndLine then // slice of a single line, just do that
         let lineText = t.GetLineString (m.StartLine - 1)

src/FsAutoComplete.Core/Utils.fs

@@ -397,6 +397,15 @@ module Array =
         | _ when n >= xs.Length || n < 0 -> xs, [||]
         | _ -> xs.[0..n-1], xs.[n..]
 
+    let partitionResults (xs: _ []) =
+      let oks = ResizeArray(xs.Length)
+      let errors = ResizeArray(xs.Length)
+      for x in xs do
+        match x with
+        | Ok ok -> oks.Add ok
+        | Error err -> errors.Add err
+      oks.ToArray(), errors.ToArray()
+
 module List =
 
     ///Returns the greatest of all elements in the list that is less than the threshold

src/FsAutoComplete/CodeFixes.fs

@@ -25,6 +25,7 @@ module Types =
   type GetParseResultsForFile = string<LocalPath> -> FSharp.Compiler.Text.Pos -> Async<ResultOrString<ParseAndCheckResults * string * FSharp.Compiler.Text.ISourceText>>
   type GetProjectOptionsForFile = string<LocalPath> -> ResultOrString<FSharp.Compiler.SourceCodeServices.FSharpProjectOptions>
 
+  [<RequireQualifiedAccess>]
   type FixKind =
     | Fix
     | Refactor
@@ -37,7 +38,7 @@ module Types =
       SourceDiagnostic: Diagnostic option
       Kind: FixKind }
 
-  type CodeFix = CodeActionParams -> Async<Fix list>
+  type CodeFix = CodeActionParams -> Async<Result<Fix list, string>>
 
   type CodeAction with
     static member OfFix getFileVersion clientCapabilities (fix: Fix) =
@@ -62,9 +63,9 @@ module Types =
         Kind =
           Some
             (match fixKind with
-             | Fix -> "quickfix"
-             | Refactor -> "refactor"
-             | Rewrite -> "refactor.rewrite")
+             | FixKind.Fix -> "quickfix"
+             | FixKind.Refactor -> "refactor"
+             | FixKind.Rewrite -> "refactor.rewrite")
         Diagnostics = diagnostic |> Option.map Array.singleton
         Edit = workspaceEdit
         Command = None }
@@ -157,20 +158,16 @@ module Run =
   open Types
 
   let ifEnabled enabled codeFix: CodeFix =
-    fun codeActionParams -> if enabled () then codeFix codeActionParams else async.Return []
+    fun codeActionParams -> if enabled () then codeFix codeActionParams else AsyncResult.retn []
 
   let private runDiagnostics pred handler: CodeFix =
-    let logger = LogProvider.getLoggerByName "CodeFixes"
     fun codeActionParams ->
       codeActionParams.Context.Diagnostics
       |> Array.choose (fun d -> if pred d then Some d else None)
       |> Array.toList
       |> List.traverseAsyncResultM (fun d -> handler d codeActionParams)
       |> AsyncResult.map List.concat
-      |> AsyncResult.foldResult id (fun errs ->
-        logger.warn (Log.setMessage "CodeFix returned an error: {error}" >> Log.addContextDestructured "error" errs)
-        []
-      )
+
 
   let ifDiagnosticByMessage (checkMessage: string) handler : CodeFix =
     runDiagnostics (fun d -> d.Message.Contains checkMessage) handler

src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs

@@ -0,0 +1,66 @@
+module FsAutoComplete.CodeFix.AddExplicitTypeToParameter
+
+open FsToolkit.ErrorHandling
+open FsAutoComplete.CodeFix.Navigation
+open FsAutoComplete.CodeFix.Types
+open LanguageServerProtocol.Types
+open FsAutoComplete
+open FsAutoComplete.LspHelpers
+open FSharp.Compiler.SourceCodeServices
+open FsAutoComplete.FCSPatches
+
+let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix =
+  fun codeActionParams ->
+    asyncResult {
+      let filePath = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath
+      let fcsStartPos = protocolPosToPos codeActionParams.Range.Start
+      let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsStartPos
+      let parseFileResults = parseAndCheck.GetParseResults
+      let! (rightCol, idents) =
+        Lexer.findLongIdents(fcsStartPos.Column, lineStr)
+        |> Result.ofOption (fun _ -> $"Couldn't find long ident at %A{fcsStartPos} in file %s{codeActionParams.TextDocument.GetFilePath()}")
+      let! symbolUse =
+        parseAndCheck.GetCheckResults.GetSymbolUseAtLocation(fcsStartPos.Line, rightCol, lineStr, List.ofArray idents)
+        |> Result.ofOption (fun _ -> $"Couldn't find symbolUse at %A{(fcsStartPos.Line, rightCol)} in file %s{codeActionParams.TextDocument.GetFilePath()}")
+
+      let isValidParameterWithoutTypeAnnotation (funcOrValue: FSharpMemberOrFunctionOrValue) (symbolUse: FSharpSymbolUse) =
+        // TODO: remove patched functions and uncomment this boolean check after FCS 40 update
+        let isLambdaIfFunction =
+        //     funcOrValue.IsFunction &&
+             parseFileResults.IsBindingALambdaAtPositionPatched symbolUse.RangeAlternate.Start
+
+        (funcOrValue.IsValue || isLambdaIfFunction) &&
+        parseFileResults.IsPositionContainedInACurriedParameter symbolUse.RangeAlternate.Start &&
+        not (parseFileResults.IsTypeAnnotationGivenAtPositionPatched symbolUse.RangeAlternate.Start) &&
+        not funcOrValue.IsMember &&
+        not funcOrValue.IsMemberThisValue &&
+        not funcOrValue.IsConstructorThisValue &&
+        not (PrettyNaming.IsOperatorName funcOrValue.DisplayName)
+
+      match symbolUse.Symbol with
+      | :? FSharpMemberOrFunctionOrValue as v when isValidParameterWithoutTypeAnnotation v symbolUse ->
+        let typeString = v.FullType.Format symbolUse.DisplayContext
+        let title = "Add explicit type annotation"
+        let fcsSymbolRange = symbolUse.RangeAlternate
+        let protocolSymbolRange = fcsRangeToLsp fcsSymbolRange
+        let! symbolText = sourceText.GetText(fcsSymbolRange)
+
+        let alreadyWrappedInParens =
+          let hasLeftParen = Navigation.walkBackUntilConditionWithTerminal sourceText protocolSymbolRange.Start (fun c -> c = '(') System.Char.IsWhiteSpace
+          let hasRightParen = Navigation.walkForwardUntilConditionWithTerminal sourceText protocolSymbolRange.End (fun c -> c = ')') System.Char.IsWhiteSpace
+          hasLeftParen.IsSome && hasRightParen.IsSome
+
+        let changedText, changedRange =
+          if alreadyWrappedInParens
+          then ": " + typeString, { Start = protocolSymbolRange.End; End = protocolSymbolRange.End }
+          else "(" + symbolText + ": " + typeString + ")", protocolSymbolRange
+        return [ {
+          Edits = [| { Range = changedRange; NewText = changedText } |]
+          File = codeActionParams.TextDocument
+          Title = title
+          SourceDiagnostic = None
+          Kind = FixKind.Refactor
+          } ]
+      | _ ->
+        return []
+    }

src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs

@@ -61,7 +61,7 @@ let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix =
                       Edits =
                         [| { Range = symbolStartRange
                              NewText = "fun " } |]
-                      Kind = Fix } ]
+                      Kind = FixKind.Fix } ]
             | None -> return []
       }
       )

src/FsAutoComplete/CodeFixes/AddMissingRecKeyword.fs

@@ -67,7 +67,7 @@ let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix =
                       Edits =
                         [| { Range = { Start = endOfError; End = endOfError }
                              NewText = " rec" } |]
-                      Kind = Fix } ]
+                      Kind = FixKind.Fix } ]
             | None -> return []
       }
       )

src/FsAutoComplete/CodeFixes/AddTypeToIndeterminateValue.fs

@@ -50,7 +50,7 @@ let fix
                       Title = "Add explicit type annotation"
                       File = codeActionParams.TextDocument
                       SourceDiagnostic = Some diagnostic
-                      Kind = Fix
+                      Kind = FixKind.Fix
                       Edits = [| { Range = changedRange
                                    NewText = changedText } |] }]
         | _ -> return []

src/FsAutoComplete/CodeFixes/ChangeCSharpLambdaToFSharp.fs

@@ -38,7 +38,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getLineText: GetLineTe
                   Edits =
                     [| { Range = replacementRange
                          NewText = replacementText } |]
-                  Kind = Refactor } ]
+                  Kind = FixKind.Refactor } ]
         | None -> return []
       }
       )

src/FsAutoComplete/CodeFixes/ChangeComparisonToMutableAssignment.fs

@@ -47,7 +47,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
                                  { Start = equalsPos
                                    End = (inc lines equalsPos) }
                                NewText = "<-" } |]
-                        Kind = Refactor } ]
+                        Kind = FixKind.Refactor } ]
               | None -> return []
           | _ -> return []
       }

src/FsAutoComplete/CodeFixes/ChangeTypeOfNameToNameOf.fs

@@ -50,4 +50,3 @@ let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix =
         SourceDiagnostic = None
         Kind = FixKind.Refactor }]
     }
-    |> AsyncResult.foldResult id (fun _ -> [])

src/FsAutoComplete/CodeFixes/ColonInFieldType.fs

@@ -17,6 +17,6 @@ let fix: CodeFix =
                              Edits =
                                [| { Range = diagnostic.Range
                                     NewText = ":" } |]
-                             Kind = Fix } ]
+                             Kind = FixKind.Fix } ]
       else
         AsyncResult.retn [])

src/FsAutoComplete/CodeFixes/ConvertBangEqualsToInequality.fs

@@ -18,7 +18,7 @@ let fix (getRangeText: GetRangeText): CodeFix =
         return [{ Title = "Use <> for inequality check"
                   File = codeActionParams.TextDocument
                   SourceDiagnostic = Some diag
-                  Kind = Fix
+                  Kind = FixKind.Fix
                   Edits = [| { Range = diag.Range
                                NewText = "<>" } |] }]
 

src/FsAutoComplete/CodeFixes/ConvertInvalidRecordToAnonRecord.fs

@@ -40,7 +40,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
                          NewText = "|" }
                        { Range = endInsertRange
                          NewText = "|" } |]
-                  Kind = Refactor } ]
+                  Kind = FixKind.Refactor } ]
         | None -> return []
       }
       )

src/FsAutoComplete/CodeFixes/DoubleEqualsToSingleEquals.fs

@@ -23,7 +23,7 @@ let fix (getRangeText: GetRangeText) : CodeFix =
                   Edits =
                     [| { Range = diagnostic.Range
                          NewText = "=" } |]
-                  Kind = Fix } ]
+                  Kind = FixKind.Fix } ]
         | _ -> return []
       }
       )

src/FsAutoComplete/CodeFixes/ExternalSystemDiagnostics.fs

@@ -19,7 +19,7 @@ let private mapExternalDiagnostic diagnosticType =
                                  File = codeActionParams.TextDocument
                                  Title = $"Fix issue"
                                  Edits = fixes |> List.toArray
-                                 Kind = Fix } ]
+                                 Kind = FixKind.Fix } ]
 
           | _ -> AsyncResult.retn []
         )

src/FsAutoComplete/CodeFixes/GenerateAbstractClassStub.fs

@@ -51,7 +51,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile)
                   Edits =
                     [| { Range = fcsPosToProtocolRange position
                          NewText = replaced } |]
-                  Kind = Fix } ]
+                  Kind = FixKind.Fix } ]
         | _ -> return []
       }
       )

src/FsAutoComplete/CodeFixes/GenerateInterfaceStub.fs

@@ -38,8 +38,6 @@ let fix (getParseResultsForFile: GetParseResultsForFile)
                 Edits =
                   [| { Range = fcsPosToProtocolRange position
                        NewText = replaced } |]
-                Kind = Fix } ]
+                Kind = FixKind.Fix } ]
       | _ -> return []
-
     }
-    |> AsyncResult.foldResult id (fun _ -> [])

src/FsAutoComplete/CodeFixes/GenerateRecordStub.fs

@@ -36,7 +36,6 @@ let fix (getParseResultsForFile: GetParseResultsForFile)
                 Edits =
                   [| { Range = fcsPosToProtocolRange position
                        NewText = replaced } |]
-                Kind = Fix } ]
+                Kind = FixKind.Fix } ]
       | _ -> return []
     }
-    |> AsyncResult.foldResult id (fun _ -> [])

src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs

@@ -45,7 +45,7 @@ let fix (getFileLines: GetFileLines)
                   File = codeActionParams.TextDocument
                   Title = "Generate union pattern match cases"
                   Edits = [| { Range = range; NewText = replaced } |]
-                  Kind = Fix } ]
+                  Kind = FixKind.Fix } ]
 
           | _ -> return []
         }

src/FsAutoComplete/CodeFixes/MakeDeclarationMutable.fs

@@ -40,7 +40,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile)
                                  { Start = lspRange.Start
                                    End = lspRange.Start }
                                NewText = "mutable " } |]
-                        Kind = Refactor } ]
+                        Kind = FixKind.Refactor } ]
             | _ -> return []
         | None -> return []
       }

src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs

@@ -34,7 +34,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getLineText: GetLineTe
           [ { Title = "Make outer binding recursive"
               File = codeActionParams.TextDocument
               SourceDiagnostic = Some diagnostic
-              Kind = Fix
+              Kind = FixKind.Fix
               Edits =
                 [| { Range =
                        { Start = lspOuterBindingRange.Start

src/FsAutoComplete/CodeFixes/MissingEquals.fs

@@ -31,7 +31,7 @@ let fix (getFileLines: GetFileLines) =
                     Edits =
                       [| { Range = { Start = insertPos; End = insertPos }
                            NewText = " =" } |]
-                    Kind = Fix } ]
+                    Kind = FixKind.Fix } ]
           | None -> return []
         else
           return []

src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs

@@ -27,7 +27,7 @@ let fix (getFileLines: GetFileLines): CodeFix =
                   Edits =
                     [| { Range = { Start = dash; End = inc lines dash }
                          NewText = "- " } |]
-                  Kind = Fix } ]
+                  Kind = FixKind.Fix } ]
         | None -> return []
       }
       )

src/FsAutoComplete/CodeFixes/NewWithDisposables.fs

@@ -20,5 +20,5 @@ let fix (getRangeText: GetRangeText) =
                                Edits =
                                  [| { Range = diagnostic.Range
                                       NewText = $"new %s{errorText}" } |]
-                               Kind = Refactor } ]
+                               Kind = FixKind.Refactor } ]
       | Error _ -> AsyncResult.retn [])

src/FsAutoComplete/CodeFixes/ParenthesizeExpression.fs

@@ -19,5 +19,5 @@ let fix (getRangeText: GetRangeText): CodeFix =
                                Edits =
                                  [| { Range = diagnostic.Range
                                       NewText = $"(%s{erroringExpression})" } |]
-                               Kind = Fix } ]
+                               Kind = FixKind.Fix } ]
       | Error _ -> AsyncResult.retn [])

src/FsAutoComplete/CodeFixes/RedundantQualifier.fs

@@ -16,4 +16,4 @@ let fix =
                            File = codeActionParams.TextDocument
                            Title = "Remove redundant qualifier"
                            SourceDiagnostic = Some diagnostic
-                           Kind = Refactor } ])
+                           Kind = FixKind.Refactor } ])

src/FsAutoComplete/CodeFixes/RefCellAccessToNot.fs

@@ -27,7 +27,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix =
                   Edits =
                     [| { Range = fcsRangeToLsp derefRange
                          NewText = "not " } |]
-                  Kind = Fix } ]
+                  Kind = FixKind.Fix } ]
         | None -> return []
       }
       )