diff --git a/src/fsharp/ErrorResolutionHints.fs b/src/fsharp/ErrorResolutionHints.fs index 2cf35d28d7b..1fd2caf23d7 100644 --- a/src/fsharp/ErrorResolutionHints.fs +++ b/src/fsharp/ErrorResolutionHints.fs @@ -26,6 +26,7 @@ let FilterPredictions (unknownIdent:string) (predictionsF:ErrorLogger.Suggestion |> Seq.map snd |> Seq.toList +/// Formats the given predictions according to the error style. let FormatPredictions errorStyle normalizeF (predictions: (float * string) list) = match predictions with | [] -> System.String.Empty diff --git a/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs b/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs new file mode 100644 index 00000000000..1483dd8e0f1 --- /dev/null +++ b/vsintegration/src/FSharp.Editor/CodeFix/ProposeUppercaseLabel.fs @@ -0,0 +1,31 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace rec Microsoft.VisualStudio.FSharp.Editor + +open System.Composition +open System.Collections.Immutable +open System.Threading.Tasks +open Microsoft.CodeAnalysis.CodeFixes +open Microsoft.CodeAnalysis.CodeActions + +[] +type internal FSharpProposeUpperCaseLabelCodeFixProvider + [] + ( + checkerProvider: FSharpCheckerProvider, + projectInfoManager: ProjectInfoManager + ) = + inherit CodeFixProvider() + let fixableDiagnosticIds = ["FS0053"] + + override __.FixableDiagnosticIds = fixableDiagnosticIds.ToImmutableArray() + + override __.RegisterCodeFixesAsync context : Task = + asyncMaybe { + let textChanger (originalText: string) = originalText.[0].ToString().ToUpper() + originalText.Substring(1) + let! solutionChanger, originalText = SymbolHelpers.changeAllSymbolReferences(context.Document, context.Span, textChanger, projectInfoManager, checkerProvider.Checker) + let title = FSComp.SR.replaceWithSuggestion (textChanger originalText) + context.RegisterCodeFix( + CodeAction.Create(title, solutionChanger, title), + (context.Diagnostics |> Seq.filter (fun x -> fixableDiagnosticIds |> List.contains x.Id)).ToImmutableArray()) + } |> Async.ignore |> CommonRoslynHelpers.StartAsyncUnitAsTask(context.CancellationToken) \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs b/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs index 2b00d7ddf34..dd13cf7b9f2 100644 --- a/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs +++ b/vsintegration/src/FSharp.Editor/CodeFix/ReplaceWithSuggestion.fs @@ -37,10 +37,10 @@ type internal FSharpReplaceWithSuggestionCodeFixProvider() = |> Seq.filter (fun x -> fixableDiagnosticIds |> Set.contains x.Id) |> Seq.iter (fun diagnostic -> let message = diagnostic.GetMessage() - let splitted = message.Split([|maybeString|], StringSplitOptions.None) - if splitted.Length > 1 then + let parts = message.Split([| maybeString |], StringSplitOptions.None) + if parts.Length > 1 then let suggestions = - splitted.[1].Split([|' '; '\r'; '\n'|], StringSplitOptions.RemoveEmptyEntries) + parts.[1].Split([|' '; '\r'; '\n'|], StringSplitOptions.RemoveEmptyEntries) |> Array.map (fun s -> s.Trim()) let diagnostics = [| diagnostic |].ToImmutableArray() diff --git a/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs b/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs index 96a6be4d791..2a222d65403 100644 --- a/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/CommonHelpers.fs @@ -416,6 +416,20 @@ module internal Extensions = try Path.GetFullPath path with _ -> path + type FSharpChecker with + member this.ParseAndCheckDocument(document: Document, options: FSharpProjectOptions) : Async<(Ast.ParsedInput * FSharpCheckFileResults) option> = + async { + let! cancellationToken = Async.CancellationToken + let! sourceText = document.GetTextAsync() + let! textVersion = document.GetTextVersionAsync(cancellationToken) + let! parseResults, checkFileAnswer = this.ParseAndCheckFileInProject(document.FilePath, textVersion.GetHashCode(), sourceText.ToString(), options) + return + match parseResults.ParseTree, checkFileAnswer with + | _, FSharpCheckFileAnswer.Aborted + | None, _ -> None + | Some parsedInput, FSharpCheckFileAnswer.Succeeded checkResults -> Some (parsedInput, checkResults) + } + type FSharpSymbol with member this.IsInternalToProject = match this with @@ -511,32 +525,4 @@ module internal Extensions = | GlyphMajor.Error -> Glyph.Error | _ -> Glyph.None - type Async<'a> with - /// Creates an asynchronous workflow that runs the asynchronous workflow given as an argument at most once. - /// When the returned workflow is started for the second time, it reuses the result of the previous execution. - static member Cache (input : Async<'T>) = - let agent = MailboxProcessor>.Start <| fun agent -> - async { - let! replyCh = agent.Receive () - let! res = input - replyCh.Reply res - while true do - let! replyCh = agent.Receive () - replyCh.Reply res - } - async { return! agent.PostAndAsyncReply id } - - static member inline Map (f: 'a -> 'b) (input: Async<'a>) : Async<'b> = - async { - let! result = input - return f result - } - - type AsyncBuilder with - member __.Bind(computation: System.Threading.Tasks.Task<'a>, binder: 'a -> Async<'b>): Async<'b> = - async { - let! a = Async.AwaitTask computation - return! binder a - } - - member __.ReturnFrom(computation: System.Threading.Tasks.Task<'a>): Async<'a> = Async.AwaitTask computation + \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Common/CommonRoslynHelpers.fs b/vsintegration/src/FSharp.Editor/Common/CommonRoslynHelpers.fs index 48c243d3ccf..367ac018ccf 100644 --- a/vsintegration/src/FSharp.Editor/Common/CommonRoslynHelpers.fs +++ b/vsintegration/src/FSharp.Editor/Common/CommonRoslynHelpers.fs @@ -94,4 +94,4 @@ module internal RoslynExtensions = member this.GetDependentProjects() = [ for project in this.Solution.Projects do if project.ProjectReferences |> Seq.exists (fun ref -> ref.ProjectId = this.Id) then - yield project ] + yield project ] \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Common/Pervasive.fs b/vsintegration/src/FSharp.Editor/Common/Pervasive.fs index b90fb224958..93254c2d10a 100644 --- a/vsintegration/src/FSharp.Editor/Common/Pervasive.fs +++ b/vsintegration/src/FSharp.Editor/Common/Pervasive.fs @@ -1,7 +1,8 @@ [] -module Microsoft.VisualStudio.FSharp.Pervasive +module Microsoft.VisualStudio.FSharp.Editor.Pervasive open System +open System.Diagnostics [] module String = @@ -24,3 +25,196 @@ type System.IServiceProvider with member x.GetService<'T>() = x.GetService(typeof<'T>) :?> 'T member x.GetService<'S, 'T>() = x.GetService(typeof<'S>) :?> 'T +[] +type MaybeBuilder () = + // 'T -> M<'T> + [] + member inline __.Return value: 'T option = + Some value + + // M<'T> -> M<'T> + [] + member inline __.ReturnFrom value: 'T option = + value + + // unit -> M<'T> + [] + member inline __.Zero (): unit option = + Some () // TODO: Should this be None? + + // (unit -> M<'T>) -> M<'T> + [] + member __.Delay (f: unit -> 'T option): 'T option = + f () + + // M<'T> -> M<'T> -> M<'T> + // or + // M -> M<'T> -> M<'T> + [] + member inline __.Combine (r1, r2: 'T option): 'T option = + match r1 with + | None -> + None + | Some () -> + r2 + + // M<'T> * ('T -> M<'U>) -> M<'U> + [] + member inline __.Bind (value, f: 'T -> 'U option): 'U option = + Option.bind f value + + // 'T * ('T -> M<'U>) -> M<'U> when 'U :> IDisposable + [] + member __.Using (resource: ('T :> System.IDisposable), body: _ -> _ option): _ option = + try body resource + finally + if not <| obj.ReferenceEquals (null, box resource) then + resource.Dispose () + + // (unit -> bool) * M<'T> -> M<'T> + [] + member x.While (guard, body: _ option): _ option = + if guard () then + // OPTIMIZE: This could be simplified so we don't need to make calls to Bind and While. + x.Bind (body, (fun () -> x.While (guard, body))) + else + x.Zero () + + // seq<'T> * ('T -> M<'U>) -> M<'U> + // or + // seq<'T> * ('T -> M<'U>) -> seq> + [] + member x.For (sequence: seq<_>, body: 'T -> unit option): _ option = + // OPTIMIZE: This could be simplified so we don't need to make calls to Using, While, Delay. + x.Using (sequence.GetEnumerator (), fun enum -> + x.While ( + enum.MoveNext, + x.Delay (fun () -> + body enum.Current))) + +let maybe = MaybeBuilder() + +[] +type AsyncMaybeBuilder () = + [] + member __.Return value : Async<'T option> = Some value |> async.Return + + [] + member __.ReturnFrom value : Async<'T option> = value + + [] + member __.ReturnFrom (value: 'T option) : Async<'T option> = async.Return value + + [] + member __.Zero () : Async = + Some () |> async.Return + + [] + member __.Delay (f : unit -> Async<'T option>) : Async<'T option> = f () + + [] + member __.Combine (r1, r2 : Async<'T option>) : Async<'T option> = + async { + let! r1' = r1 + match r1' with + | None -> return None + | Some () -> return! r2 + } + + [] + member __.Bind (value: Async<'T option>, f : 'T -> Async<'U option>) : Async<'U option> = + async { + let! value' = value + match value' with + | None -> return None + | Some result -> return! f result + } + + [] + member __.Bind (value: System.Threading.Tasks.Task<'T>, f : 'T -> Async<'U option>) : Async<'U option> = + async { + let! value' = Async.AwaitTask value + return! f value' + } + + [] + member __.Bind (value: 'T option, f : 'T -> Async<'U option>) : Async<'U option> = + async { + match value with + | None -> return None + | Some result -> return! f result + } + + [] + member __.Using (resource : ('T :> IDisposable), body : _ -> Async<_ option>) : Async<_ option> = + try body resource + finally if not (isNull resource) then resource.Dispose () + + [] + member x.While (guard, body : Async<_ option>) : Async<_ option> = + if guard () then + x.Bind (body, (fun () -> x.While (guard, body))) + else + x.Zero () + + [] + member x.For (sequence : seq<_>, body : 'T -> Async) : Async<_ option> = + x.Using (sequence.GetEnumerator (), fun enum -> + x.While (enum.MoveNext, x.Delay (fun () -> body enum.Current))) + + [] + member inline __.TryWith (computation : Async<'T option>, catchHandler : exn -> Async<'T option>) : Async<'T option> = + async.TryWith (computation, catchHandler) + + [] + member inline __.TryFinally (computation : Async<'T option>, compensation : unit -> unit) : Async<'T option> = + async.TryFinally (computation, compensation) + +let asyncMaybe = AsyncMaybeBuilder() + +let inline liftAsync (computation : Async<'T>) : Async<'T option> = + async { + let! a = computation + return Some a + } + +module Async = + let map (f: 'T -> 'U) (a: Async<'T>) : Async<'U> = + async { + let! a = a + return f a + } + + let ignore (a: Async<'T>) : Async = + async { + let! _ = a + return () + } + + /// Creates an asynchronous workflow that runs the asynchronous workflow given as an argument at most once. + /// When the returned workflow is started for the second time, it reuses the result of the previous execution. + let cache (input : Async<'T>) = + let agent = MailboxProcessor>.Start <| fun agent -> + async { + let! replyCh = agent.Receive () + let! res = input + replyCh.Reply res + while true do + let! replyCh = agent.Receive () + replyCh.Reply res + } + async { return! agent.PostAndAsyncReply id } + +type AsyncBuilder with + member __.Bind(computation: System.Threading.Tasks.Task<'a>, binder: 'a -> Async<'b>): Async<'b> = + async { + let! a = Async.AwaitTask computation + return! binder a + } + + member __.ReturnFrom(computation: System.Threading.Tasks.Task<'a>): Async<'a> = Async.AwaitTask computation + + +module Option = + let guard (x: bool) : Option = + if x then Some() else None \ No newline at end of file diff --git a/vsintegration/src/FSharp.Editor/Common/SymbolHelpers.fs b/vsintegration/src/FSharp.Editor/Common/SymbolHelpers.fs new file mode 100644 index 00000000000..c166a32201b --- /dev/null +++ b/vsintegration/src/FSharp.Editor/Common/SymbolHelpers.fs @@ -0,0 +1,101 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. + +namespace Microsoft.VisualStudio.FSharp.Editor + +open System +open System.Collections.Generic +open System.Collections.Immutable +open System.Threading +open System.Threading.Tasks +open System.Runtime.CompilerServices + +open Microsoft.CodeAnalysis +open Microsoft.CodeAnalysis.Classification +open Microsoft.CodeAnalysis.Text + +open Microsoft.VisualStudio.FSharp.LanguageService +open Microsoft.FSharp.Compiler +open Microsoft.FSharp.Compiler.SourceCodeServices +open Microsoft.FSharp.Compiler.SourceCodeServices.ItemDescriptionIcons + + +module internal SymbolHelpers = + let getSymbolUsesInSolution (symbol: FSharpSymbol, declLoc: SymbolDeclarationLocation, checkFileResults: FSharpCheckFileResults, + projectInfoManager: ProjectInfoManager, checker: FSharpChecker, solution: Solution) = + async { + let! symbolUses = + match declLoc with + | SymbolDeclarationLocation.CurrentDocument -> + checkFileResults.GetUsesOfSymbolInFile(symbol) + | SymbolDeclarationLocation.Projects (projects, isInternalToProject) -> + let projects = + if isInternalToProject then projects + else + [ for project in projects do + yield project + yield! project.GetDependentProjects() ] + |> List.distinctBy (fun x -> x.Id) + + projects + |> Seq.map (fun project -> + async { + match projectInfoManager.TryGetOptionsForProject(project.Id) with + | Some options -> + let! projectCheckResults = checker.ParseAndCheckProject(options) + return! projectCheckResults.GetUsesOfSymbol(symbol) + | None -> return [||] + }) + |> Async.Parallel + |> Async.map Array.concat + + return + (symbolUses + |> Seq.collect (fun symbolUse -> + solution.GetDocumentIdsWithFilePath(symbolUse.FileName) |> Seq.map (fun id -> id, symbolUse)) + |> Seq.groupBy fst + ).ToImmutableDictionary( + (fun (id, _) -> id), + fun (_, xs) -> xs |> Seq.map snd |> Seq.toArray) + } + + type OriginalText = string + + let changeAllSymbolReferences (document: Document, symbolSpan: TextSpan, textChanger: string -> string, projectInfoManager: ProjectInfoManager, checker: FSharpChecker) + : Async<(Func> * OriginalText) option> = + asyncMaybe { + do! Option.guard (symbolSpan.Length > 0) + let! cancellationToken = liftAsync Async.CancellationToken + let! sourceText = document.GetTextAsync(cancellationToken) + let originalText = sourceText.ToString(symbolSpan) + do! Option.guard (originalText.Length > 0) + let! options = projectInfoManager.TryGetOptionsForEditingDocumentOrProject document + let defines = CompilerEnvironment.GetCompilationDefinesForEditing(document.Name, options.OtherOptions |> Seq.toList) + let! symbol = CommonHelpers.getSymbolAtPosition(document.Id, sourceText, symbolSpan.Start, document.FilePath, defines, SymbolLookupKind.Fuzzy) + let! _, checkFileResults = checker.ParseAndCheckDocument(document, options) + let textLine = sourceText.Lines.GetLineFromPosition(symbolSpan.Start) + let textLinePos = sourceText.Lines.GetLinePosition(symbolSpan.Start) + let fcsTextLineNumber = textLinePos.Line + 1 + let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, symbol.RightColumn, textLine.Text.ToString(), [symbol.Text]) + let! declLoc = symbolUse.GetDeclarationLocation(document) + let newText = textChanger originalText + // defer finding all symbol uses throughout the solution + return + Func<_,_>(fun (cancellationToken: CancellationToken) -> + async { + let! symbolUsesByDocumentId = + getSymbolUsesInSolution(symbolUse.Symbol, declLoc, checkFileResults, projectInfoManager, checker, document.Project.Solution) + + let mutable solution = document.Project.Solution + + for KeyValue(documentId, symbolUses) in symbolUsesByDocumentId do + let document = document.Project.Solution.GetDocument(documentId) + let! sourceText = document.GetTextAsync(cancellationToken) + let mutable sourceText = sourceText + for symbolUse in symbolUses do + let textSpan = CommonHelpers.fixupSpan(sourceText, CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, symbolUse.RangeAlternate)) + sourceText <- sourceText.Replace(textSpan, newText) + solution <- solution.WithDocumentText(documentId, sourceText) + return solution + } |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken), + originalText + } diff --git a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj index 1193b8c4884..993d95175c6 100644 --- a/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj +++ b/vsintegration/src/FSharp.Editor/FSharp.Editor.fsproj @@ -38,6 +38,7 @@ + @@ -62,6 +63,7 @@ + diff --git a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs index f07d57211c8..297d2b9400f 100644 --- a/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs +++ b/vsintegration/src/FSharp.Editor/InlineRename/InlineRenameService.fs @@ -91,42 +91,9 @@ type internal InlineRenameInfo let span = CommonRoslynHelpers.FSharpRangeToTextSpan(sourceText, symbolUse.RangeAlternate) CommonHelpers.fixupSpan(sourceText, span) - let symbolUses = - async { - let! symbolUses = - match declLoc with - | SymbolDeclarationLocation.CurrentDocument -> - checkFileResults.GetUsesOfSymbolInFile(symbolUse.Symbol) - | SymbolDeclarationLocation.Projects (projects, isInternalToProject) -> - let projects = - if isInternalToProject then projects - else - [ for project in projects do - yield project - yield! project.GetDependentProjects() ] - |> List.distinctBy (fun x -> x.Id) - - projects - |> Seq.map (fun project -> - async { - match projectInfoManager.TryGetOptionsForProject(project.Id) with - | Some options -> - let! projectCheckResults = checker.ParseAndCheckProject(options) - return! projectCheckResults.GetUsesOfSymbol(symbolUse.Symbol) - | None -> return [||] - }) - |> Async.Parallel - |> Async.Map Array.concat - - return - (symbolUses - |> Seq.collect (fun symbolUse -> - document.Project.Solution.GetDocumentIdsWithFilePath(symbolUse.FileName) |> Seq.map (fun id -> id, symbolUse)) - |> Seq.groupBy fst - ).ToImmutableDictionary( - (fun (id, _) -> id), - fun (_, xs) -> xs |> Seq.map snd |> Seq.toArray) - } |> Async.Cache + let symbolUses = + SymbolHelpers.getSymbolUsesInSolution(symbolUse.Symbol, declLoc, checkFileResults, projectInfoManager, checker, document.Project.Solution) + |> Async.cache interface IInlineRenameInfo with member __.CanRename = true @@ -191,15 +158,14 @@ type internal InlineRenameService match checkFileAnswer with | FSharpCheckFileAnswer.Aborted -> return FailureInlineRenameInfo.Instance | FSharpCheckFileAnswer.Succeeded(checkFileResults) -> - - let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, symbol.RightColumn, textLine.Text.ToString(), [symbol.Text]) - - match symbolUse with - | Some symbolUse -> - match symbolUse.GetDeclarationLocation(document) with - | Some declLoc -> return InlineRenameInfo(checker, projectInfoManager, document, sourceText, symbolUse, declLoc, checkFileResults) :> IInlineRenameInfo + let! symbolUse = checkFileResults.GetSymbolUseAtLocation(fcsTextLineNumber, symbol.RightColumn, textLine.Text.ToString(), [symbol.Text]) + + match symbolUse with + | Some symbolUse -> + match symbolUse.GetDeclarationLocation(document) with + | Some declLoc -> return InlineRenameInfo(checker, projectInfoManager, document, sourceText, symbolUse, declLoc, checkFileResults) :> IInlineRenameInfo + | _ -> return FailureInlineRenameInfo.Instance | _ -> return FailureInlineRenameInfo.Instance - | _ -> return FailureInlineRenameInfo.Instance | None -> return FailureInlineRenameInfo.Instance }