diff --git a/CHANGELOG.md b/CHANGELOG.md index d125236a9..146a5ad5e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,11 @@ # Changelog -## [Unreleased] +## [0.50.1] - 2022-03-12 ### Fixed * [Fix textDocument/publishDiagnostics sometimes not getting sent](https://github.com/fsharp/FsAutoComplete/pull/887) (Thanks @Booksbaum!) +* [Fix completions in the middle of lines](https://github.com/fsharp/FsAutoComplete/pull/892) ## [0.50.0] - 2022-01-23 diff --git a/paket.lock b/paket.lock index f0f641c4d..3a40ba119 100644 --- a/paket.lock +++ b/paket.lock @@ -6,7 +6,7 @@ NUGET Argu (5.2) FSharp.Core (>= 4.3.2) System.Configuration.ConfigurationManager (>= 4.4) - CliWrap (3.4) + CliWrap (3.4.1) Microsoft.Bcl.AsyncInterfaces (>= 6.0) - restriction: || (&& (== net5.0) (>= net461)) (&& (== net5.0) (< netstandard2.1)) (== netstandard2.0) System.Buffers (>= 4.5.1) - restriction: || (&& (== net5.0) (>= net461)) (&& (== net5.0) (< netstandard2.1)) (== netstandard2.0) System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (&& (== net5.0) (>= net461)) (&& (== net5.0) (< netstandard2.1)) (== netstandard2.0) diff --git a/src/FsAutoComplete.BackgroundServices/Program.fs b/src/FsAutoComplete.BackgroundServices/Program.fs index 316e985f1..7338457af 100644 --- a/src/FsAutoComplete.BackgroundServices/Program.fs +++ b/src/FsAutoComplete.BackgroundServices/Program.fs @@ -395,7 +395,7 @@ type BackgroundServiceServer(state: State, client: FsacClient) = let file = Utils.normalizePath p.File.FilePath let vf = - { Lines = SourceText.ofString p.Content + { Lines = NamedText(file, p.Content) Touched = DateTime.Now Version = Some p.Version } state.Files.AddOrUpdate(file, (fun _ -> vf),( fun _ _ -> vf) ) |> ignore diff --git a/src/FsAutoComplete.BackgroundServices/paket.references b/src/FsAutoComplete.BackgroundServices/paket.references index 008f8a76d..fff32b46a 100644 --- a/src/FsAutoComplete.BackgroundServices/paket.references +++ b/src/FsAutoComplete.BackgroundServices/paket.references @@ -11,3 +11,4 @@ FSharp.UMX Microsoft.NETFramework.ReferenceAssemblies Ionide.LanguageServerProtocol Ionide.KeepAChangelog.Tasks +FsToolkit.ErrorHandling diff --git a/src/FsAutoComplete.Core/CodeGeneration.fs b/src/FsAutoComplete.Core/CodeGeneration.fs index 82093c30d..3a2612efd 100644 --- a/src/FsAutoComplete.Core/CodeGeneration.fs +++ b/src/FsAutoComplete.Core/CodeGeneration.fs @@ -9,20 +9,21 @@ open FSharp.Compiler.Text open FSharp.Compiler.Symbols open FSharp.Compiler.Tokenization open FSharp.Compiler.CodeAnalysis +open FsToolkit.ErrorHandling [] type Line0 [] type Line1 type CodeGenerationService(checker : FSharpCompilerServiceChecker, state : State) = member x.TokenizeLine(fileName, i) = - match state.TryGetFileCheckerOptionsWithLines fileName with - | ResultOrString.Error _ -> None - | ResultOrString.Ok (opts, text) -> - try - let line = text.GetLineString (i - 1) - Lexer.tokenizeLine [||] line |> Some - with - | _ -> None + option { + let! text = state.TryGetFileSource fileName |> Option.ofResult + try + let! line = text.GetLine (Position.mkPos (i - 1) 0) + return Lexer.tokenizeLine [||] line + with + | _ -> return! None + } member x.GetSymbolAtPosition(fileName, pos: Position) = match state.TryGetFileCheckerOptionsWithLinesAndLineStr(fileName, pos) with diff --git a/src/FsAutoComplete.Core/Commands.fs b/src/FsAutoComplete.Core/Commands.fs index 7d17cc525..a92d156b3 100644 --- a/src/FsAutoComplete.Core/Commands.fs +++ b/src/FsAutoComplete.Core/Commands.fs @@ -40,7 +40,7 @@ type CoreResponse<'a> = [] type FormatDocumentResponse = - | Formatted of source: ISourceText * formatted: string + | Formatted of source: NamedText * formatted: string | UnChanged | Ignored | ToolNotPresent @@ -376,7 +376,7 @@ type Commands | Some f -> Some(f.Lines) | None when File.Exists(UMX.untag file) -> let ctn = File.ReadAllText(UMX.untag file) - let text = SourceText.ofString ctn + let text = NamedText(file, ctn) state.Files.[file] <- { Touched = DateTime.Now @@ -425,11 +425,9 @@ type Commands GetLineText1 = fun i -> lines.GetLineString(i - 1) } let calculateNamespaceInsert (decl: DeclarationListItem) (pos: Position) getLine : CompletionNamespaceInsert option = - let getLine i = - try - getLine i - with - | _ -> "" + let getLine (p: Position) = + getLine p + |> Option.defaultValue "" let idents = decl.FullName.Split '.' @@ -441,13 +439,12 @@ type Commands |> Option.map (fun ic -> //TODO: unite with `CodeFix/ResolveNamespace` //TODO: Handle Nearest AND TopLevel. Currently it's just Nearest (vs. ResolveNamespace -> TopLevel) (#789) - let l, c = ic.Pos.Line, ic.Pos.Column let detectIndentation (line: string) = line |> Seq.takeWhile ((=) ' ') |> Seq.length // adjust line - let l = + let pos = match ic.ScopeKind with | ScopeKind.Namespace -> // for namespace `open` isn't created close at namespace, @@ -456,33 +453,31 @@ type Commands // this only happens when there are no other `open` // from insert position go up until first open OR namespace - seq { l - 1 .. -1 .. 0 } + ic.Pos.LinesToBeginning() |> Seq.tryFind (fun l -> let lineStr = getLine l // namespace MUST be top level -> no indentation lineStr.StartsWith "namespace ") |> function // move to the next line below "namespace" - | Some l -> l + 1 - | None -> l - | _ -> l + | Some l -> l.IncLine() + | None -> ic.Pos + | _ -> ic.Pos // adjust column - let c = - match l, c with - | 0, c -> c - | l, 0 -> - let prev = getLine (l - 1) + let pos = + match pos with + | Pos(0, c) -> pos + | Pos(l, 0) -> + let prev = getLine (pos.DecLine()) let indentation = detectIndentation prev if indentation <> 0 then // happens when there are already other `open`s - indentation + Position.mkPos l indentation else - 0 - | _, c -> c - - let pos = Position.mkPos l c + pos + | Pos(_, c) -> pos { Namespace = n Position = pos @@ -561,7 +556,7 @@ type Commands member __.LastCheckResult = lastCheckResult - member __.SetFileContent(file: string, lines: ISourceText, version, tfmIfScript) = + member __.SetFileContent(file: string, lines: NamedText, version, tfmIfScript) = state.AddFileText(file, lines, version) let payload = @@ -738,7 +733,7 @@ type Commands member x.TryGetFileVersion = state.TryGetFileVersion - member x.Parse file (text: ISourceText) version (isSdkScript: bool option) = + member x.Parse file (text: NamedText) version (isSdkScript: bool option) = let tmf = isSdkScript |> Option.map (fun n -> @@ -796,7 +791,7 @@ type Commands ) let hash = - text.Lines() + text.Lines |> Array.filter (fun n -> n.StartsWith "#r" || n.StartsWith "#load" @@ -905,8 +900,6 @@ type Commands match source with | None -> return CoreResponse.ErrorRes(sprintf "No help text available for symbol '%s'" sym) | Some source -> - let getSource = fun i -> source.GetLineString(i - 1) - let tip = match state.HelpText.TryFind sym with | Some tip -> tip @@ -917,7 +910,7 @@ type Commands let n = match state.CompletionNamespaceInsert.TryFind sym with - | None -> calculateNamespaceInsert decl pos getSource + | None -> calculateNamespaceInsert decl pos source.GetLine | Some s -> Some s return CoreResponse.Res(HelpText.Full(sym, tip, n)) @@ -933,7 +926,7 @@ type Commands (tyRes: ParseAndCheckResults) (pos: Position) lineStr - (lines: ISourceText) + (lines: NamedText) (fileName: string) filter includeKeywords @@ -951,7 +944,6 @@ type Commands match res with | Some (decls, residue, shouldKeywords) -> let declName (d: DeclarationListItem) = d.Name - let getLine = fun i -> lines.GetLineString(i - 1) //Init cache for current list state.Declarations.Clear() @@ -960,7 +952,7 @@ type Commands state.CurrentAST <- Some tyRes.GetAST //Fill cache for current list - do fillHelpTextInTheBackground decls pos fileName getLine + do fillHelpTextInTheBackground decls pos fileName lines.GetLine // Send the first help text without being requested. // This allows it to be displayed immediately in the editor. @@ -1079,7 +1071,7 @@ type Commands ( tyRes: ParseAndCheckResults, pos: Position, - lines: ISourceText, + lines: NamedText, triggerChar, possibleSessionKind ) = @@ -1374,7 +1366,7 @@ type Commands match tyResOpt with | None -> () | Some tyRes -> - let getSourceLine lineNo = source.GetLineString(lineNo - 1) + let getSourceLine lineNo = (source :> ISourceText).GetLineString(lineNo - 1) let! simplified = SimplifyNames.getSimplifiableNames (tyRes.GetCheckResults, getSourceLine) let simplified = Array.ofSeq simplified notify.Trigger(NotificationEvent.SimplifyNames(file, simplified)) @@ -1390,7 +1382,7 @@ type Commands match checker.TryGetRecentCheckResultsForFile(file, opts, source) with | None -> return () | Some tyRes -> - let! unused = UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, (fun i -> source.GetLineString(i - 1))) + let! unused = UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, (fun i -> (source: ISourceText).GetLineString(i - 1))) notify.Trigger(NotificationEvent.UnusedOpens(file, (unused |> List.toArray))) } @@ -1543,21 +1535,16 @@ type Commands let! contents = state.TryGetFileSource tyRes.FileName let getGenerics line (token: FSharpTokenInfo) = - let lineStr = contents.GetLineString line + option { + let! lineStr = contents.GetLine (Position.mkPos line 0) - let res = - tyRes.TryGetToolTip(Position.fromZ line token.RightColumn) lineStr + let! tip = + tyRes.TryGetToolTip(Position.fromZ line token.RightColumn) lineStr + |> Option.ofResult - match res with - | Ok tip -> TipFormatter.extractGenericParameters tip - | _ -> - commandsLogger.info ( - Log.setMessage "ParameterHints - No tooltips for token: '{token}'\n Line: \n{line}" - >> Log.addContextDestructured "token" token - >> Log.addContextDestructured "line" lineStr - ) - - [] + return TipFormatter.extractGenericParameters tip + } + |> Option.defaultValue [] let areTokensCommentOrWhitespace (tokens: FSharpTokenInfo list) = tokens @@ -1593,7 +1580,7 @@ type Commands | false, None -> currentIndex, false, acc let hints = - Array.init (contents.GetLineCount()) (fun line -> contents.GetLineString line) + Array.init ((contents: ISourceText).GetLineCount()) (fun line -> (contents: ISourceText).GetLineString line) |> Array.map (Lexer.tokenizeLine [||]) |> Array.mapi (fun currentIndex currentTokens -> currentIndex, currentTokens) |> Array.fold folder (0, false, []) diff --git a/src/FsAutoComplete.Core/CompilerServiceInterface.fs b/src/FsAutoComplete.Core/CompilerServiceInterface.fs index c358262a1..549337dc1 100644 --- a/src/FsAutoComplete.Core/CompilerServiceInterface.fs +++ b/src/FsAutoComplete.Core/CompilerServiceInterface.fs @@ -296,7 +296,7 @@ type FSharpCompilerServiceChecker(backgroundServiceEnabled, hasAnalyzers) = let path = UMX.untag fn checker.ParseFile(path, source, fpo) - member __.ParseAndCheckFileInProject(filePath: string, version, source, options) = + member __.ParseAndCheckFileInProject(filePath: string, version, source: NamedText, options) = async { let opName = sprintf "ParseAndCheckFileInProject - %A" filePath checkerLogger.info @@ -329,7 +329,7 @@ type FSharpCompilerServiceChecker(backgroundServiceEnabled, hasAnalyzers) = | ex -> return ResultOrString.Error(ex.ToString()) } - member __.TryGetRecentCheckResultsForFile(file: string, options, source) = + member __.TryGetRecentCheckResultsForFile(file: string, options, source: NamedText) = let opName = sprintf "TryGetRecentCheckResultsForFile - %A" file checkerLogger.info diff --git a/src/FsAutoComplete.Core/FCSPatches.fs b/src/FsAutoComplete.Core/FCSPatches.fs index f52569377..db1a98e54 100644 --- a/src/FsAutoComplete.Core/FCSPatches.fs +++ b/src/FsAutoComplete.Core/FCSPatches.fs @@ -95,7 +95,7 @@ type FSharpParseFileResults with function | SynExpr.App(ExprAtomicFlag.NonAtomic, false, SynExpr.App(ExprAtomicFlag.NonAtomic, true, Ident "op_EqualsGreater", actualParamListExpr, _), actualLambdaBodyExpr, _) -> Some (actualParamListExpr, actualLambdaBodyExpr) | _ -> None - + let visitor = { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, _, defaultTraverse, expr) = @@ -277,7 +277,7 @@ type FSharpParseFileResults with traverseSynExpr expr |> Option.map (fun expr -> expr) - + SyntaxTraversal.Traverse(pos, scope.ParseTree, { new SyntaxVisitorBase<_>() with member _.VisitExpr(_, traverseSynExpr, defaultTraverse, expr) = match expr with @@ -304,50 +304,6 @@ type FSharpParseFileResults with None | _ -> defaultTraverse expr }) - member scope.IsTypeAnnotationGivenAtPositionPatched pos = - let result = - SyntaxTraversal.Traverse(pos, scope.ParseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = - match expr with - | SynExpr.Typed (_expr, _typeExpr, range) when Position.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 Position.posEq range.Start pos -> - Some range - | _ -> - None - - pats |> List.tryPick exprFunc - - override _.VisitPat(_, defaultTraverse, pat) = - match pat with - | SynPat.Typed (_pat, _targetType, range) when Position.posEq range.Start pos -> - Some range - | _ -> defaultTraverse pat }) - result.IsSome - - member scope.IsBindingALambdaAtPositionPatched pos = - let result = - SyntaxTraversal.Traverse(pos, scope.ParseTree, { new SyntaxVisitorBase<_>() with - member _.VisitExpr(_path, _traverseSynExpr, defaultTraverse, expr) = - defaultTraverse expr - - override _.VisitBinding(_, defaultTraverse, binding) = - match binding with - | SynBinding(_, _, _, _, _, _, _, _, _, expr, range, _) when Position.posEq range.Start pos -> - match expr with - | SynExpr.Lambda _ -> Some range - | _ -> None - | _ -> defaultTraverse binding }) - result.IsSome - module SyntaxTreeOps = open FSharp.Compiler.Syntax let rec synExprContainsError inpExpr = diff --git a/src/FsAutoComplete.Core/FileSystem.fs b/src/FsAutoComplete.Core/FileSystem.fs index ae1b3c2e7..d549fb408 100644 --- a/src/FsAutoComplete.Core/FileSystem.fs +++ b/src/FsAutoComplete.Core/FileSystem.fs @@ -6,27 +6,95 @@ open FsAutoComplete.Logging open FSharp.UMX open FSharp.Compiler.Text open System.Runtime.CompilerServices - -type VolatileFile = - { Touched: DateTime - Lines: ISourceText - Version: int option } +open FsToolkit.ErrorHandling open System.IO open FSharp.Compiler.IO +[] +module PositionExtensions = + type FSharp.Compiler.Text.Position with + member x.LinesToBeginning() = + if x.Line <= 0 then Seq.empty + else seq { + for i = x.Line - 1 downto 0 do + yield Position.mkPos i 0 + } + member x.IncLine() = Position.mkPos (x.Line + 1) x.Column + member x.DecLine() = Position.mkPos (x.Line - 1) x.Column + + let inline (|Pos|) (p: FSharp.Compiler.Text.Position) = + p.Line, p.Column + +[] +/// A copy of the StringText type from F#.Compiler.Text, which is private. +/// Adds a UOM-typed filename to make range manipulation easier, as well as +/// safer traversals +type NamedText(fileName: string, str: string) = + + let getLines (str: string) = + use reader = new StringReader(str) + [| + let mutable line = reader.ReadLine() + while not (isNull line) do + yield line + line <- reader.ReadLine() + if str.EndsWith("\n", StringComparison.Ordinal) then + // last trailing space not returned + // http://stackoverflow.com/questions/19365404/stringreader-omits-trailing-linebreak + yield String.Empty + |] + + let getLines = + // This requires allocating and getting all the lines. + // However, likely whoever is calling it is using a different implementation of ISourceText + // So, it's ok that we do this for now. + lazy getLines str + + let lastCharPos = lazy ( + let lines = getLines.Value + if lines.Length > 0 then + (lines.Length, lines.[lines.Length - 1].Length) + else + (0, 0) + ) + + let safeLastCharPos = lazy ( + let (endLine, endChar) = lastCharPos.Value + Position.mkPos endLine endChar + ) + + member _.String = str + + override _.GetHashCode() = str.GetHashCode() + override _.Equals(obj: obj) = + match obj with + | :? NamedText as other -> other.String.Equals(str) + | :? string as other -> other.Equals(str) + | _ -> false + override _.ToString() = str -[] -type SourceTextExtensions = - [] - static member GetText(t: ISourceText, m: FSharp.Compiler.Text.Range) : Result = - let allFileRange = - Range.mkRange m.FileName Position.pos0 (t.GetLastFilePosition()) + /// The local absolute path of the file whose contents this NamedText represents + member x.FileName = fileName - if not (Range.rangeContainsRange allFileRange m) then + /// The unwrapped local abolute path of the file whose contents this NamedText represents. + /// Should only be used when interoping with the Compiler/Serialization + member x.RawFileName = UMX.untag fileName + + /// Cached representation of the final position in this file + member x.LastFilePosition = safeLastCharPos.Value + + /// Cached representation of the entire contents of the file, for inclusion checks + + member x.TotalRange = + Range.mkRange (UMX.untag fileName) Position.pos0 x.LastFilePosition + + /// Provides safe access to a substring of the file via FCS-provided Range + member x.GetText(m: FSharp.Compiler.Text.Range) : Result = + if not (Range.rangeContainsRange x.TotalRange m) 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) + let lineText = (x :> ISourceText).GetLineString(m.StartLine - 1) lineText.Substring(m.StartColumn, m.EndColumn - m.StartColumn) |> Ok @@ -34,32 +102,185 @@ type SourceTextExtensions = // multiline, use a builder let builder = new System.Text.StringBuilder() // slice of the first line - let firstLine = t.GetLineString(m.StartLine - 1) + let firstLine = (x :> ISourceText).GetLineString(m.StartLine - 1) builder.Append(firstLine.Substring(m.StartColumn)) |> ignore // whole intermediate lines for line in (m.StartLine + 1) .. (m.EndLine - 1) do - builder.AppendLine(t.GetLineString(line - 1)) + builder.AppendLine((x :> ISourceText).GetLineString(line - 1)) |> ignore // final part, potential slice - let lastLine = t.GetLineString(m.EndLine - 1) + let lastLine = (x :> ISourceText).GetLineString(m.EndLine - 1) builder.Append(lastLine.Substring(0, m.EndColumn)) |> ignore Ok(builder.ToString()) - [] - static member inline Lines(t: ISourceText) = - Array.init (t.GetLineCount()) t.GetLineString + member private x.GetLineUnsafe (pos: FSharp.Compiler.Text.Position) = + (x :> ISourceText).GetLineString(pos.Line - 1) - [] - /// a safe alternative to GetLastCharacterPosition, which returns untagged indexes. this version - /// returns a FCS Pos to prevent confusion about line index offsets - static member GetLastFilePosition(t: ISourceText) : Position = - let endLine, endChar = t.GetLastCharacterPosition() - Position.mkPos endLine endChar + /// Provides safe access to a line of the file via FCS-provided Position + member x.GetLine(pos: FSharp.Compiler.Text.Position): string option = + if pos.Line > getLines.Value.Length then None else Some (x.GetLineUnsafe pos) + + member x.GetLineLength(pos: FSharp.Compiler.Text.Position) = + if pos.Line > getLines.Value.Length then None else Some (x.GetLineUnsafe pos).Length + + member private x.GetCharUnsafe(pos: FSharp.Compiler.Text.Position): char = + x.GetLine(pos).Value[pos.Column] + + /// Provides safe access to a character of the file via FCS-provided Position. + /// Also available in indexer form: x[pos] + member x.TryGetChar(pos: FSharp.Compiler.Text.Position): char option = + option { + do! Option.guard (Range.rangeContainsPos (x.TotalRange) pos) + let lineText = x.GetLineUnsafe(pos) + if pos.Column = 0 then return! None + else + let lineIndex = pos.Column - 1 + if lineText.Length < lineIndex + then + return! None + else + return lineText[lineIndex] + } + + member x.NextLine(pos: FSharp.Compiler.Text.Position) = + if pos.Line < getLines.Value.Length then + Position.mkPos (pos.Line + 1) 0 + |> Some + else + None + + /// Provides safe incrementing of a position in the file via FCS-provided Position + member x.NextPos(pos: FSharp.Compiler.Text.Position): FSharp.Compiler.Text.Position option = + option { + let! currentLine = x.GetLine pos + if pos.Column - 1 = currentLine.Length then + if getLines.Value.Length > pos.Line + then + // advance to the beginning of the next line + return Position.mkPos (pos.Line + 1) 0 + else + return! None + else + return Position.mkPos pos.Line (pos.Column + 1) + } + + /// Provides safe incrementing of positions in a file while returning the character at the new position. + /// Intended use is for traversal loops. + member x.TryGetNextChar(pos: FSharp.Compiler.Text.Position): (FSharp.Compiler.Text.Position * char) option = + option { + let! np = x.NextPos pos + return np, x.GetCharUnsafe np + } + + /// Provides safe decrementing of a position in the file via FCS-provided Position + member x.PrevPos(pos: FSharp.Compiler.Text.Position): FSharp.Compiler.Text.Position option = + option { + if pos.Column <> 0 + then + return Position.mkPos pos.Line (pos.Column - 1) + else + if pos.Line = 0 + then + return! None + else + if getLines.Value.Length > pos.Line - 2 + then + let prevLine = (x :> ISourceText).GetLineString (pos.Line - 2) + // retreat to the end of the previous line + return Position.mkPos (pos.Line - 1) (prevLine.Length - 1) + else + return! None + } + + /// Provides safe decrementing of positions in a file while returning the character at the new position. + /// Intended use is for traversal loops. + member x.TryGetPrevChar(pos: FSharp.Compiler.Text.Position): (FSharp.Compiler.Text.Position * char) option = + option { + let! np = x.PrevPos pos + return np, x.GetCharUnsafe np + } + + /// Safe access to the contents of a file by Range + member x.Item with get (m: FSharp.Compiler.Text.Range) = x.GetText(m) + /// Safe access to the char in a file by Position + member x.Item with get (pos: FSharp.Compiler.Text.Position) = x.TryGetChar(pos) + + member private x.Walk(start: FSharp.Compiler.Text.Position, (posChange: FSharp.Compiler.Text.Position -> FSharp.Compiler.Text.Position option), terminal, condition) = + /// if the condition is never met, return None + + let firstPos = Position.pos0 + let finalPos = x.LastFilePosition + + let rec loop (pos: FSharp.Compiler.Text.Position): FSharp.Compiler.Text.Position option = option { + let! charAt = x[pos] + do! Option.guard (firstPos <> pos && finalPos <> pos) + do! Option.guard (not (terminal charAt)) + + if condition charAt + then + return pos + else + let! nextPos = posChange pos + return! loop nextPos + } + + loop start + + member x.WalkForward(start, terminal, condition) = x.Walk(start, x.NextPos, terminal, condition) + member x.WalkBackwards(start, terminal, condition) = x.Walk(start, x.PrevPos, terminal, condition) + + + /// Provides line-by-line access to the underlying text. + /// This can lead to unsafe access patterns, consider using one of the range or position-based + /// accessors instead + member x.Lines = getLines.Value + + interface ISourceText with + + member _.Item with get index = str.[index] + + member _.GetLastCharacterPosition() = lastCharPos.Value + + member _.GetLineString(lineIndex) = + getLines.Value.[lineIndex] + + member _.GetLineCount() = getLines.Value.Length + + member _.GetSubTextString(start, length) = + str.Substring(start, length) + + member _.SubTextEquals(target, startIndex) = + if startIndex < 0 || startIndex >= str.Length then + invalidArg "startIndex" "Out of range." + + if String.IsNullOrEmpty(target) then + invalidArg "target" "Is null or empty." + + let lastIndex = startIndex + target.Length + if lastIndex <= startIndex || lastIndex >= str.Length then + invalidArg "target" "Too big." + + str.IndexOf(target, startIndex, target.Length) <> -1 + + member _.Length = str.Length + + member this.ContentEquals(sourceText) = + match sourceText with + | :? NamedText as sourceText when sourceText = this || sourceText.String = str -> true + | _ -> false + + member _.CopyTo(sourceIndex, destination, destinationIndex, count) = + str.CopyTo(sourceIndex, destination, destinationIndex, count) + +type VolatileFile = + { Touched: DateTime + Lines: NamedText + Version: int option } type FileSystem(actualFs: IFileSystem, tryFindFile: string -> VolatileFile option) = let fsLogger = LogProvider.getLoggerByName "FileSystem" diff --git a/src/FsAutoComplete.Core/KeywordList.fs b/src/FsAutoComplete.Core/KeywordList.fs index 1fd99fdc5..a657b188b 100644 --- a/src/FsAutoComplete.Core/KeywordList.fs +++ b/src/FsAutoComplete.Core/KeywordList.fs @@ -48,8 +48,9 @@ module KeywordList = |> Seq.toArray let allKeywords : string list = - FSharpKeywords.KeywordsWithDescription - |> List.map fst + keywordDescriptions + |> Seq.map ((|KeyValue|) >> fst) + |> Seq.toList let keywordCompletionItems = allKeywords diff --git a/src/FsAutoComplete.Core/SignatureHelp.fs b/src/FsAutoComplete.Core/SignatureHelp.fs index 258ec5c97..178f37fd0 100644 --- a/src/FsAutoComplete.Core/SignatureHelp.fs +++ b/src/FsAutoComplete.Core/SignatureHelp.fs @@ -23,44 +23,9 @@ type SignatureHelpInfo = { SigHelpKind: SignatureHelpKind } -let private lineText (lines: ISourceText) (pos: Position) = lines.GetLineString(pos.Line - 1) - -let private charAt (lines: ISourceText) (pos: Position) = - (lineText lines pos).[pos.Column - 1] - -let dec (lines: ISourceText) (pos: Position): Position = - if pos.Column = 0 then - let prevLine = lines.GetLineString (pos.Line - 2) - // retreat to the end of the previous line - Position.mkPos (pos.Line - 1) (prevLine.Length - 1) - else - Position.mkPos pos.Line (pos.Column - 1) - -let inc (lines: ISourceText) (pos: Position): Position = - let currentLine = lineText lines pos - if pos.Column - 1 = currentLine.Length then - // advance to the beginning of the next line - Position.mkPos (pos.Line + 1) 0 - else - Position.mkPos pos.Line (pos.Column + 1) - -let getText (lines: ISourceText) (range: Range) = - if range.Start.Line = range.End.Line then - let line = lineText lines range.Start - line.Substring(range.StartColumn - 1, (range.End.Column - range.Start.Column)) - else - String.concat Environment.NewLine (seq { - let startLine = lineText lines range.Start - yield startLine.Substring(range.StartColumn - 1, (startLine.Length - 1 - range.Start.Column)) - for lineNo in (range.Start.Line+1)..(range.End.Line-1) do - yield lines.GetLineString(lineNo - 1) - let endLine = lineText lines range.End - yield endLine.Substring(0, range.End.Column - 1) - }) - -let private getSignatureHelpForFunctionApplication (tyRes: ParseAndCheckResults, caretPos: Position, endOfPreviousIdentPos: Position, lines: ISourceText) : Async = +let private getSignatureHelpForFunctionApplication (tyRes: ParseAndCheckResults, caretPos: Position, endOfPreviousIdentPos: Position, lines: NamedText) : Async = asyncMaybe { - let lineStr = lineText lines endOfPreviousIdentPos + let! lineStr = lines.GetLine endOfPreviousIdentPos let! possibleApplicationSymbolEnd = maybe { if tyRes.GetParseResults.IsPosContainedInApplicationPatched endOfPreviousIdentPos then let! funcRange = tyRes.GetParseResults.TryRangeOfFunctionOrMethodBeingAppliedPatched endOfPreviousIdentPos @@ -68,7 +33,7 @@ let private getSignatureHelpForFunctionApplication (tyRes: ParseAndCheckResults, else return endOfPreviousIdentPos } - let possibleApplicationSymbolLineStr = lineText lines possibleApplicationSymbolEnd + let! possibleApplicationSymbolLineStr = lines.GetLine possibleApplicationSymbolEnd let! (endCol, names) = Lexer.findLongIdents(possibleApplicationSymbolEnd.Column, possibleApplicationSymbolLineStr) let idents = List.ofArray names let! symbolUse = tyRes.GetCheckResults.GetSymbolUseAtLocation(possibleApplicationSymbolEnd.Line, endCol, lineStr, idents) @@ -115,7 +80,8 @@ let private getSignatureHelpForFunctionApplication (tyRes: ParseAndCheckResults, Some (numDefinedArgs - (numDefinedArgs - curriedArgsInSource.Length)) else None - let methods = tyRes.GetCheckResults.GetMethods(symbolStart.Line, symbolUse.Range.EndColumn, lineText lines symbolStart, None) + let! symbolStartLineText = lines.GetLine symbolStart + let methods = tyRes.GetCheckResults.GetMethods(symbolStart.Line, symbolUse.Range.EndColumn, symbolStartLineText, None) return { ActiveParameter = Some argumentIndex @@ -127,17 +93,17 @@ let private getSignatureHelpForFunctionApplication (tyRes: ParseAndCheckResults, return! None } -let private getSignatureHelpForMethod (tyRes: ParseAndCheckResults, caretPos: Position, lines: ISourceText, triggerChar) = +let private getSignatureHelpForMethod (tyRes: ParseAndCheckResults, caretPos: Position, lines: NamedText, triggerChar) = asyncMaybe { let! paramLocations = tyRes.GetParseResults.FindParameterLocations caretPos let names = paramLocations.LongId let lidEnd = paramLocations.LongIdEndLocation - let lineText = lineText lines lidEnd + let! lineText = lines.GetLine lidEnd let methodGroup = tyRes.GetCheckResults.GetMethods(lidEnd.Line, lidEnd.Column, lineText, Some names) let methods = methodGroup.Methods do! Option.guard (methods.Length > 0 && not(methodGroup.MethodName.EndsWith("> )"))) - let isStaticArgTip = charAt lines paramLocations.OpenParenLocation = '<' + let isStaticArgTip = lines.TryGetChar paramLocations.OpenParenLocation = Some '<' let filteredMethods = [| for m in methods do @@ -148,15 +114,19 @@ let private getSignatureHelpForMethod (tyRes: ParseAndCheckResults, caretPos: Po let endPos = let last = paramLocations.TupleEndLocations |> Array.last - if paramLocations.IsThereACloseParen then dec lines last else last + if paramLocations.IsThereACloseParen + then + lines.PrevPos last + |> Option.defaultValue last + else last - let startOfArgs = inc lines paramLocations.OpenParenLocation + let startOfArgs = lines.NextPos paramLocations.OpenParenLocation let tupleEnds = [| - startOfArgs + yield! Option.toList startOfArgs for i in 0..paramLocations.TupleEndLocations.Length-2 do - paramLocations.TupleEndLocations.[i] - endPos + yield paramLocations.TupleEndLocations.[i] + yield endPos |] // If we are pressing "(" or "<" or ",", then only pop up the info if this is one of the actual, real detected positions in the detected promptable call // @@ -197,21 +167,26 @@ let private getSignatureHelpForMethod (tyRes: ParseAndCheckResults, caretPos: Po } } -let getSignatureHelpFor (tyRes : ParseAndCheckResults, pos: Position, lines: ISourceText, triggerChar, possibleSessionKind) = +let getSignatureHelpFor (tyRes : ParseAndCheckResults, pos: Position, lines: NamedText, triggerChar, possibleSessionKind) = asyncResult { - let previousNonWhitespaceCharPos = + let previousNonWhitespaceChar = let rec loop ch pos = if Char.IsWhiteSpace ch then - let prevPos = dec lines pos - loop (charAt lines prevPos) prevPos + match lines.TryGetPrevChar pos with + | Some (prevPos, prevChar) -> + loop prevChar prevPos + | None -> None else - pos - let initialPos = dec lines pos - loop (charAt lines initialPos) initialPos + Some (pos, ch) + match lines.TryGetPrevChar pos with + | Some (prevPos, prevChar) -> + loop prevChar prevPos + | None -> + None - let charAtPos = match triggerChar with Some char -> char | None -> charAt lines pos + let! (previousNonWhitespaceCharPos, previousNonWhitespaceChar) = previousNonWhitespaceChar |> Result.ofOption (fun _ -> "Couldn't find previous non-whitespace char") + let! charAtPos = triggerChar |> Option.orElseWith (fun _ -> lines.TryGetChar pos) |> Result.ofOption (fun _ -> "Couldn't find a trigger char") - let previousNonWhitespaceChar = charAt lines previousNonWhitespaceCharPos match charAtPos, possibleSessionKind with // Generally ' ' indicates a function application, but it's also used commonly after a comma in a method call. // This means that the adjusted position relative to the caret could be a ',' or a '(' or '<', diff --git a/src/FsAutoComplete.Core/State.fs b/src/FsAutoComplete.Core/State.fs index cfbbb7d01..194f55171 100644 --- a/src/FsAutoComplete.Core/State.fs +++ b/src/FsAutoComplete.Core/State.fs @@ -10,6 +10,7 @@ open System.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.Syntax open FSharp.Compiler.CodeAnalysis +open FsToolkit.ErrorHandling type DeclName = string type CompletionNamespaceInsert = { Namespace: string; Position: Position; Scope : ScopeKind } @@ -48,7 +49,7 @@ type State = ScriptProjectOptions = ConcurrentDictionary() ColorizationOutput = false } - member x.RefreshCheckerOptions(file: string, text: ISourceText) : FSharpProjectOptions option = + member x.RefreshCheckerOptions(file: string, text: NamedText) : FSharpProjectOptions option = x.ProjectController.GetProjectOptions (UMX.untag file) |> Option.map (fun opts -> x.Files.[file] <- { Lines = text; Touched = DateTime.Now; Version = None } @@ -83,12 +84,12 @@ type State = member x.SetLastCheckedVersion (file: string) (version: int) = x.LastCheckedVersion.[file] <- version - member x.AddFileTextAndCheckerOptions(file: string, text: ISourceText, opts, version) = + member x.AddFileTextAndCheckerOptions(file: string, text: NamedText, opts, version) = let fileState = { Lines = text; Touched = DateTime.Now; Version = version } x.Files.[file] <- fileState x.ProjectController.SetProjectOptions(UMX.untag file, opts) - member x.AddFileText(file: string, text: ISourceText, version) = + member x.AddFileText(file: string, text: NamedText, version) = let fileState = { Lines = text; Touched = DateTime.Now; Version = version } x.Files.[file] <- fileState @@ -116,7 +117,7 @@ type State = OriginalLoadReferences = [] Stamp = None} - member x.TryGetFileCheckerOptionsWithLines(file: string) : ResultOrString = + member x.TryGetFileCheckerOptionsWithLines(file: string) : ResultOrString = match x.Files.TryFind(file) with | None -> ResultOrString.Error (sprintf "File '%s' not parsed" (UMX.untag file)) | Some (volFile) -> @@ -125,26 +126,19 @@ type State = | None -> Ok (State.FileWithoutProjectOptions(file), volFile.Lines) | Some opts -> Ok (opts, volFile.Lines) - member x.TryGetFileCheckerOptionsWithSource(file: string) : ResultOrString = + member x.TryGetFileCheckerOptionsWithSource(file: string) : ResultOrString = match x.TryGetFileCheckerOptionsWithLines(file) with | ResultOrString.Error x -> ResultOrString.Error x | Ok (opts, lines) -> Ok (opts, lines) - member x.TryGetFileSource(file: string) : ResultOrString = + member x.TryGetFileSource(file: string) : ResultOrString = match x.Files.TryFind(file) with | None -> ResultOrString.Error (sprintf "File '%s' not parsed" (UMX.untag file)) | Some f -> Ok f.Lines - member x.TryGetFileCheckerOptionsWithLinesAndLineStr(file: string, pos : Position) : ResultOrString = - match x.TryGetFileCheckerOptionsWithLines(file) with - | Error x -> Error x - | Ok (opts, text) -> - let lineCount = text.GetLineCount() - if pos.Line < 1 || pos.Line > lineCount then Error "Position is out of range" - else - let line = text.GetLineString (pos.Line - 1) - let lineLength = line.Length - if pos.Column < 0 || pos.Column > lineLength // since column is 0-based, lineLength is actually longer than the column is allowed to be - then Error "Position is out of range" - else - Ok (opts, text, line) + member x.TryGetFileCheckerOptionsWithLinesAndLineStr(file: string, pos : Position) : ResultOrString = + result { + let! (opts, text) = x.TryGetFileCheckerOptionsWithLines(file) + let! line = text.GetLine pos |> Result.ofOption (fun _ -> "Position is out of range") + return (opts, text, line) + } diff --git a/src/FsAutoComplete.Core/Utils.fs b/src/FsAutoComplete.Core/Utils.fs index 44e014946..90f7ff439 100644 --- a/src/FsAutoComplete.Core/Utils.fs +++ b/src/FsAutoComplete.Core/Utils.fs @@ -137,6 +137,7 @@ module Option = with | _ -> None + /// ensure the condition is true before continuing let inline guard (b) = if b then Some() else None [] @@ -151,6 +152,7 @@ module Result = | Some x -> Ok x | None -> Error(recover ()) + /// ensure the condition is true before continuing let inline guard condition errorValue = if condition () then Ok() diff --git a/src/FsAutoComplete/CodeFixes.fs b/src/FsAutoComplete/CodeFixes.fs index 90fa207de..1634f815b 100644 --- a/src/FsAutoComplete/CodeFixes.fs +++ b/src/FsAutoComplete/CodeFixes.fs @@ -20,9 +20,9 @@ module Types = type IsEnabled = unit -> bool type GetRangeText = string -> LspTypes.Range -> ResultOrString - type GetFileLines = string -> ResultOrString - type GetLineText = FSharp.Compiler.Text.ISourceText -> LspTypes.Range -> Result - type GetParseResultsForFile = string -> FSharp.Compiler.Text.Position -> Async> + type GetFileLines = string -> ResultOrString + type GetLineText = NamedText -> LspTypes.Range -> Result + type GetParseResultsForFile = string -> FSharp.Compiler.Text.Position -> Async> type GetProjectOptionsForFile = string -> ResultOrString [] @@ -98,64 +98,51 @@ module Navigation = fcsPos - /// advance along positions from a starting location, incrementing in a known way until a condition is met. - /// when the condition is met, return that position. - /// if the condition is never met, return None - let walkPos (lines: ISourceText) (pos: LspTypes.Position) posChange terminalCondition checkCondition: LspTypes.Position option = - let charAt (pos: LspTypes.Position) = lines.GetLineString(pos.Line).[pos.Character - 1] - - let firstPos = { Line = 0; Character = 0 } - let finalPos = fcsPosToLsp (lines.GetLastFilePosition()) - - let rec loop pos = - let charAt = charAt pos - if firstPos = pos || finalPos = pos - then None - else if terminalCondition charAt then None - else if not (checkCondition charAt) then loop (posChange pos) - else Some pos - - loop pos - - let inc (lines: ISourceText) (pos: LspTypes.Position): LspTypes.Position = - let lineLength = lines.GetLineString(pos.Line).Length - - if pos.Character = lineLength - 1 then - { Line = pos.Line + 1; Character = 0 } - else - { pos with - Character = pos.Character + 1 } - - let dec (lines: ISourceText) (pos: LspTypes.Position): LspTypes.Position = - if pos.Character = 0 then - let newLine = pos.Line - 1 - // decrement to end of previous line - { pos with - Line = newLine - Character = lines.GetLineString(newLine).Length - 1 } - else - { pos with - Character = pos.Character - 1 } + let inc (lines: NamedText) (pos: LspTypes.Position): LspTypes.Position option = + lines.NextPos (protocolPosToPos pos) + |> Option.map fcsPosToLsp + + let dec (lines: NamedText) (pos: LspTypes.Position): LspTypes.Position option = + lines.PrevPos (protocolPosToPos pos) + |> Option.map fcsPosToLsp let rec decMany lines pos count = - if count <= 0 then pos - else decMany lines (dec lines pos) (count - 1) + option { + let mutable pos = pos + let mutable count = count + while count > 0 do + let! nextPos = dec lines pos + pos <- nextPos + count <- count - 1 + return pos + } let rec incMany lines pos count = - if count <= 0 then pos - else incMany lines (inc lines pos) (count - 1) - - let walkBackUntilCondition (lines: ISourceText) (pos: LspTypes.Position) = - walkPos lines pos (dec lines) (fun c -> false) - - let walkForwardUntilCondition (lines: ISourceText) (pos: LspTypes.Position) = - walkPos lines pos (inc lines) (fun c -> false) - - let walkBackUntilConditionWithTerminal lines pos check terminal = - walkPos lines pos (dec lines) terminal check - - let walkForwardUntilConditionWithTerminal (lines: ISourceText) (pos: LspTypes.Position) check terminal = - walkPos lines pos (inc lines) terminal check + option { + let mutable pos = pos + let mutable count = count + while count > 0 do + let! nextPos = inc lines pos + pos <- nextPos + count <- count - 1 + return pos + } + + let walkBackUntilConditionWithTerminal (lines: NamedText) pos condition terminal = + let fcsStartPos = protocolPosToPos pos + lines.WalkBackwards(fcsStartPos, terminal, condition) + |> Option.map fcsPosToLsp + + let walkForwardUntilConditionWithTerminal (lines: NamedText) pos condition terminal = + let fcsStartPos = protocolPosToPos pos + lines.WalkForward(fcsStartPos, terminal, condition) + |> Option.map fcsPosToLsp + + let walkBackUntilCondition lines pos condition = + walkBackUntilConditionWithTerminal lines pos condition (fun _ -> false) + + let walkForwardUntilCondition lines pos condition = + walkForwardUntilConditionWithTerminal lines pos condition (fun _ -> false) module Run = open Types diff --git a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs index c02755a0c..f9858c587 100644 --- a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs +++ b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs @@ -26,14 +26,16 @@ let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix = |> 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.Range.Start + funcOrValue.IsFunction && + parseFileResults.IsBindingALambdaAtPosition symbolUse.Range.Start + + let IsPositionContainedInACurriedParameter = parseFileResults.IsPositionContainedInACurriedParameter symbolUse.Range.End + let IsTypeAnnotationGivenAtPosition = parseFileResults.IsTypeAnnotationGivenAtPosition symbolUse.Range.End (funcOrValue.IsValue || isLambdaIfFunction) && - parseFileResults.IsPositionContainedInACurriedParameter symbolUse.Range.Start && - not (parseFileResults.IsTypeAnnotationGivenAtPositionPatched symbolUse.Range.Start) && + IsPositionContainedInACurriedParameter && + not IsTypeAnnotationGivenAtPosition && not funcOrValue.IsMember && not funcOrValue.IsMemberThisValue && not funcOrValue.IsConstructorThisValue && @@ -45,7 +47,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile): CodeFix = let title = "Add explicit type annotation" let fcsSymbolRange = symbolUse.Range let protocolSymbolRange = fcsRangeToLsp fcsSymbolRange - let! symbolText = sourceText.GetText(fcsSymbolRange) + let! symbolText = sourceText.GetText fcsSymbolRange let alreadyWrappedInParens = let hasLeftParen = Navigation.walkBackUntilConditionWithTerminal sourceText protocolSymbolRange.Start (fun c -> c = '(') System.Char.IsWhiteSpace diff --git a/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs b/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs index af3d3296c..9a80970dd 100644 --- a/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs +++ b/src/FsAutoComplete/CodeFixes/AddMissingFunKeyword.fs @@ -20,8 +20,9 @@ let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix = let! errorText = getLineText lines diagnostic.Range do! Result.guard (fun _ -> errorText = "->") "Expected error source code text not matched" - let lineLen = - lines.GetLineString(diagnostic.Range.Start.Line).Length + let! lineLen = + lines.GetLineLength(protocolPosToPos diagnostic.Range.Start) + |> Result.ofOption (fun _ -> "Could not get line length") let! line = getLineText @@ -33,14 +34,9 @@ let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix = { diagnostic.Range.End with Character = lineLen } } - let charAtPos = - getLineText - lines - ({ Start = diagnostic.Range.Start - End = inc lines diagnostic.Range.Start }) - + let! prevPos = dec lines diagnostic.Range.Start |> Result.ofOption (fun _ -> "previous position wasn't valid") let adjustedPos = - walkBackUntilCondition lines (dec lines diagnostic.Range.Start) (System.Char.IsWhiteSpace >> not) + walkBackUntilCondition lines prevPos (System.Char.IsWhiteSpace >> not) match adjustedPos with | None -> return [] diff --git a/src/FsAutoComplete/CodeFixes/AddMissingRecKeyword.fs b/src/FsAutoComplete/CodeFixes/AddMissingRecKeyword.fs index b41ff3f0d..7f93d7cf5 100644 --- a/src/FsAutoComplete/CodeFixes/AddMissingRecKeyword.fs +++ b/src/FsAutoComplete/CodeFixes/AddMissingRecKeyword.fs @@ -26,16 +26,18 @@ let fix (getFileLines: GetFileLines) (getLineText: GetLineText): CodeFix = // * get the range of the symbol, in order to // * get the symbol name // * so we can format a nice message in the code fix + let! nextPos = inc lines endOfError |> Result.ofOption (fun _ -> "next position wasn't valid") let firstWhiteSpaceAfterError = - walkForwardUntilCondition lines (inc lines endOfError) (System.Char.IsWhiteSpace >> not) + walkForwardUntilCondition lines nextPos (System.Char.IsWhiteSpace >> not) match firstWhiteSpaceAfterError with | None -> return [] | Some startOfBindingName -> let fcsPos = protocolPosToPos startOfBindingName - let lineLen = - lines.GetLineString(diagnostic.Range.Start.Line).Length + let! lineLen = + lines.GetLineLength (protocolPosToPos diagnostic.Range.Start) + |> Result.ofOption (fun _ -> "Could not get line length") let! line = getLineText diff --git a/src/FsAutoComplete/CodeFixes/AddTypeToIndeterminateValue.fs b/src/FsAutoComplete/CodeFixes/AddTypeToIndeterminateValue.fs index c27e19875..1c300da35 100644 --- a/src/FsAutoComplete/CodeFixes/AddTypeToIndeterminateValue.fs +++ b/src/FsAutoComplete/CodeFixes/AddTypeToIndeterminateValue.fs @@ -27,7 +27,7 @@ let fix let! projectOptions = getProjectOptionsForFile typedFileName let protocolDeclRange = fcsRangeToLsp declRange let! declText = lines.GetText declRange - let declTextLine = lines.GetLineString protocolDeclRange.Start.Line + let! declTextLine = lines.GetLine declRange.Start |> Result.ofOption (fun _ -> "No line found at pos") let! declLexerSymbol = Lexer.getSymbol declRange.Start.Line declRange.Start.Column declText SymbolLookupKind.ByLongIdent projectOptions.OtherOptions |> Result.ofOption (fun _ -> "No lexer symbol for declaration") let! declSymbolUse = tyRes.GetCheckResults.GetSymbolUseAtLocation(declRange.Start.Line, declRange.End.Column, declTextLine, declLexerSymbol.Text.Split('.') |> List.ofArray) |> Result.ofOption (fun _ -> "No lexer symbol") match declSymbolUse.Symbol with diff --git a/src/FsAutoComplete/CodeFixes/ChangeCSharpLambdaToFSharp.fs b/src/FsAutoComplete/CodeFixes/ChangeCSharpLambdaToFSharp.fs index e18247812..a0b6b64e2 100644 --- a/src/FsAutoComplete/CodeFixes/ChangeCSharpLambdaToFSharp.fs +++ b/src/FsAutoComplete/CodeFixes/ChangeCSharpLambdaToFSharp.fs @@ -22,10 +22,10 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getLineText: GetLineTe match tyRes.GetParseResults.TryRangeOfParenEnclosingOpEqualsGreaterUsage fcsPos with | Some (fullParenRange, lambdaArgRange, lambdaBodyRange) -> - let argExprText = + let! argExprText = getLineText lines (fcsRangeToLsp lambdaArgRange) - let bodyExprText = + let! bodyExprText = getLineText lines (fcsRangeToLsp lambdaBodyRange) let replacementText = $"fun {argExprText} -> {bodyExprText}" diff --git a/src/FsAutoComplete/CodeFixes/ChangeComparisonToMutableAssignment.fs b/src/FsAutoComplete/CodeFixes/ChangeComparisonToMutableAssignment.fs index faa14deed..aee5896a3 100644 --- a/src/FsAutoComplete/CodeFixes/ChangeComparisonToMutableAssignment.fs +++ b/src/FsAutoComplete/CodeFixes/ChangeComparisonToMutableAssignment.fs @@ -24,7 +24,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix = | None -> return [] | Some endPos -> let fcsPos = protocolPosToPos endPos - let line = lines.GetLineString endPos.Line + let! line = lines.GetLine fcsPos |> Result.ofOption (fun _ -> "No line found at pos") let! symbol = tyRes.TryGetSymbolUse fcsPos line @@ -38,6 +38,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix = match walkForwardUntilCondition lines endOfMutableValue (fun c -> c = '=') with | Some equalsPos -> + let! nextPos = inc lines equalsPos |> Result.ofOption (fun _ -> "next position wasn't valid") return [ { File = codeActionParams.TextDocument Title = "Use '<-' to mutate value" @@ -45,7 +46,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix = Edits = [| { Range = { Start = equalsPos - End = (inc lines equalsPos) } + End = nextPos } NewText = "<-" } |] Kind = FixKind.Refactor } ] | None -> return [] diff --git a/src/FsAutoComplete/CodeFixes/ConvertInvalidRecordToAnonRecord.fs b/src/FsAutoComplete/CodeFixes/ConvertInvalidRecordToAnonRecord.fs index f7e2f81f4..a79e4c27d 100644 --- a/src/FsAutoComplete/CodeFixes/ConvertInvalidRecordToAnonRecord.fs +++ b/src/FsAutoComplete/CodeFixes/ConvertInvalidRecordToAnonRecord.fs @@ -23,13 +23,15 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix = | Some recordExpressionRange -> let recordExpressionRange = fcsRangeToLsp recordExpressionRange - let startInsertRange = - let next = inc lines recordExpressionRange.Start - { Start = next; End = next } + let! startInsertRange = + inc lines recordExpressionRange.Start + |> Option.map (fun next -> { Start = next; End = next }) + |> Result.ofOption (fun _ -> "No start insert range") - let endInsertRange = - let prev = dec lines recordExpressionRange.End - { Start = prev; End = prev } + let! endInsertRange = + dec lines recordExpressionRange.End + |> Option.map (fun prev -> { Start = prev; End = prev }) + |> Result.ofOption (fun _ -> "No end insert range") return [ { Title = "Convert to anonymous record" diff --git a/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs b/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs new file mode 100644 index 000000000..e1cce10cb --- /dev/null +++ b/src/FsAutoComplete/CodeFixes/ConvertPositionalDUToNamed.fs @@ -0,0 +1,162 @@ +/// A codefix that converts DU case matches from positional form to named form +/// +/// Given this type: +/// +/// type Person = Person of first: string * middle: string option * last: string +/// +/// +/// This codefix will take the following destructuring pattern: +/// +/// let (Person(f, m, l)) = person +/// +/// and convert it to the following pattern: +/// +/// let (Person(first = f; middle = m; last = l)) = person +/// +/// +module FsAutoComplete.CodeFix.ConvertPositionalDUToNamed + +open FsToolkit.ErrorHandling +open FsAutoComplete.CodeFix.Navigation +open FsAutoComplete.CodeFix.Types +open Ionide.LanguageServerProtocol.Types +open FsAutoComplete +open FsAutoComplete.LspHelpers +open FSharp.Compiler.CodeAnalysis +open FSharp.Compiler.Symbols +open FsAutoComplete.FCSPatches +open FSharp.Compiler.Syntax +open FSharp.Compiler.Syntax.SyntaxTraversal + +type ParseAndCheckResults with + member x.TryGetPositionalUnionPattern(pos: FcsPos) = + let rec (|UnionNameAndPatterns|_|) = + function + | SynPat.LongIdent (longDotId = ident + argPats = SynArgPats.Pats [ SynPat.Paren (pat = SynPat.Tuple (elementPats = duFieldPatterns) + range = parenRange) ]) -> + Some(ident, duFieldPatterns, parenRange) + | SynPat.LongIdent (longDotId = ident + argPats = SynArgPats.Pats [ SynPat.Paren (pat = singleDUFieldPattern; range = parenRange) ]) -> + Some(ident, [ singleDUFieldPattern ], parenRange) + | SynPat.Paren(pat = UnionNameAndPatterns (ident, duFieldPatterns, parenRange)) -> + Some(ident, duFieldPatterns, parenRange) + | SynPat.Paren(pat = UnionNameAndPatterns (ident, duFieldPatterns, parenRange)) -> + Some(ident, duFieldPatterns, parenRange) + | _ -> None + + let visitor = + { new SyntaxVisitorBase<_>() with + member x.VisitBinding(path, defaultTraverse, binding) = + match binding with + // DU case with multiple + | SynBinding(headPat = UnionNameAndPatterns (ident, duFieldPatterns, parenRange)) -> + Some(ident, duFieldPatterns, parenRange) + | _ -> defaultTraverse binding + + // I shouldn't have to override my own VisitExpr, but the default traversal doesn't seem to be triggering the `VisitMatchClause` method I've defined below. + member x.VisitExpr(path, traverse, defaultTraverse, expr) = + match expr with + | SynExpr.Match (expr = argExpr; clauses = clauses) -> + let path = SyntaxNode.SynExpr argExpr :: path + + match x.VisitExpr(path, traverse, defaultTraverse, argExpr) with + | Some x -> Some x + | None -> + clauses + |> List.tryPick (function + | SynMatchClause(pat = UnionNameAndPatterns (ident, duFieldPatterns, parenRange)) -> + Some(ident, duFieldPatterns, parenRange) + | _ -> None) + | _ -> defaultTraverse expr + + member x.VisitMatchClause(path, defaultTraverse, matchClause) = + match matchClause with + | SynMatchClause(pat = UnionNameAndPatterns (ident, duFieldPatterns, parenRange)) -> + Some(ident, duFieldPatterns, parenRange) + | _ -> defaultTraverse matchClause } + + Traverse(pos, x.GetParseResults.ParseTree, visitor) + +let private (|MatchedFields|UnmatchedFields|NotEnoughFields|) (astFields: SynPat list, unionFields: string list) = + let userFieldsCount = astFields.Length + let typeFieldsCount = unionFields.Length + + match compare userFieldsCount typeFieldsCount with + | -1 -> UnmatchedFields(List.zip astFields unionFields[0 .. userFieldsCount - 1], unionFields.[userFieldsCount..]) + | 0 -> MatchedFields(List.zip astFields unionFields) + | 1 -> NotEnoughFields + | _ -> failwith "impossible" + +let private createEdit (astField: SynPat, duField: string) : TextEdit list = + let prefix = $"{duField} = " + let startRange = astField.Range.Start |> fcsPosToProtocolRange + let suffix = "; " + let endRange = astField.Range.End |> fcsPosToProtocolRange + + [ { NewText = prefix; Range = startRange } + { NewText = suffix; Range = endRange } ] + +let private createWildCard endRange (duField: string) : TextEdit = + let wildcard = $"{duField} = _; " + let range = endRange + { NewText = wildcard; Range = range } + +let fix (getParseResultsForFile: GetParseResultsForFile) (getRangeText: GetRangeText) : CodeFix = + fun codeActionParams -> + asyncResult { + let filePath = + codeActionParams.TextDocument.GetFilePath() + |> Utils.normalizePath + + let fcsPos = protocolPosToPos codeActionParams.Range.Start + let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsPos + + let! (duIdent, duFields, parenRange) = + parseAndCheck.TryGetPositionalUnionPattern(fcsPos) + |> Result.ofOption (fun _ -> "Not inside a DU pattern") + + let! symbolUse = + parseAndCheck.TryGetSymbolUse duIdent.Range.Start lineStr + |> Result.ofOption (fun _ -> "No matching symbol for position") + + let! unionCase = + match symbolUse.Symbol with + | :? FSharpUnionCase as uc -> Ok uc + | _ -> Error "Not a union case" + + let allFieldNames = + unionCase.Fields + |> List.ofSeq + |> List.map (fun f -> f.Name) + + let! edits = + match (duFields, allFieldNames) with + | MatchedFields pairs -> pairs |> List.collect createEdit |> List.toArray |> Ok + + | UnmatchedFields (pairs, leftover) -> + result { + let! endPos = + dec sourceText (fcsPosToLsp parenRange.End) + |> Option.map protocolPosToRange + |> Result.ofOption (fun _ -> "No end position for range") + + let matchedEdits = pairs |> List.collect createEdit + let leftoverEdits = leftover |> List.map (createWildCard endPos) + + return + List.append matchedEdits leftoverEdits + |> List.toArray + } + | NotEnoughFields -> Ok [||] + + match edits with + | [||] -> return [] + | edits -> + return + [ { Edits = edits + File = codeActionParams.TextDocument + Title = "Convert to named patterns" + SourceDiagnostic = None + Kind = FixKind.Refactor } ] + } diff --git a/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs b/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs index a14570683..a8e135eb8 100644 --- a/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs +++ b/src/FsAutoComplete/CodeFixes/GenerateUnionCases.fs @@ -6,6 +6,7 @@ open FsAutoComplete.CodeFix.Types open Ionide.LanguageServerProtocol.Types open FsAutoComplete open FsAutoComplete.LspHelpers +open FsAutoComplete.CodeFix.Navigation /// a codefix that generates union cases for an incomplete match expression let fix (getFileLines: GetFileLines) @@ -21,9 +22,11 @@ let fix (getFileLines: GetFileLines) let! lines = getFileLines fileName // try to find the first case already written - let caseLine = diagnostic.Range.Start.Line + 1 - let caseCol = lines.GetLineString(caseLine).IndexOf('|') + 3 // Find column of first case in patern matching - let casePos = { Line = caseLine; Character = caseCol } + let fcsRange = protocolRangeToRange (FSharp.UMX.UMX.untag fileName) diagnostic.Range + let! nextLine = lines.NextLine fcsRange.Start |> Result.ofOption (fun _ -> "no next line") + let! caseLine = lines.GetLine (nextLine) |> Result.ofOption (fun _ -> "No case line") + let caseCol = caseLine.IndexOf('|') + 3 // Find column of first case in patern matching + let casePos = { Line = nextLine.Line - 1; Character = caseCol } let casePosFCS = protocolPosToPos casePos let! (tyRes, line, lines) = getParseResultsForFile fileName casePosFCS diff --git a/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs b/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs index 52f5fe745..7a837e4dc 100644 --- a/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs +++ b/src/FsAutoComplete/CodeFixes/MakeOuterBindingRecursive.fs @@ -17,14 +17,14 @@ let fix (getParseResultsForFile: GetParseResultsForFile) (getLineText: GetLineTe let errorRangeStart = protocolPosToPos diagnostic.Range.Start let! (tyres, _line, lines) = getParseResultsForFile fileName errorRangeStart - let missingMemberName = getLineText lines diagnostic.Range + let! missingMemberName = getLineText lines diagnostic.Range let! outerBindingRange = tyres.GetParseResults.TryRangeOfNameOfNearestOuterBindingContainingPos errorRangeStart |> Result.ofOption (fun _ -> "No outer binding found at pos") let lspOuterBindingRange = fcsRangeToLsp outerBindingRange - let outerBindingName = getLineText lines lspOuterBindingRange + let! outerBindingName = getLineText lines lspOuterBindingRange do! Result.guard (fun _ -> missingMemberName = outerBindingName) diff --git a/src/FsAutoComplete/CodeFixes/MissingEquals.fs b/src/FsAutoComplete/CodeFixes/MissingEquals.fs index 7517f6b50..9bbed1e91 100644 --- a/src/FsAutoComplete/CodeFixes/MissingEquals.fs +++ b/src/FsAutoComplete/CodeFixes/MissingEquals.fs @@ -19,10 +19,10 @@ let fix (getFileLines: GetFileLines) = codeActionParams.TextDocument.GetFilePath() |> Utils.normalizePath let! lines = getFileLines fileName - - match walkBackUntilCondition lines (dec lines diagnostic.Range.Start) (System.Char.IsWhiteSpace >> not) with + let! walkPos = dec lines diagnostic.Range.Start |> Result.ofOption (fun _ -> "No walk pos") + match walkBackUntilCondition lines walkPos (System.Char.IsWhiteSpace >> not) with | Some firstNonWhitespaceChar -> - let insertPos = inc lines firstNonWhitespaceChar + let! insertPos = inc lines firstNonWhitespaceChar |> Result.ofOption (fun _ -> "No insert pos") return [ { SourceDiagnostic = Some diagnostic diff --git a/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs b/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs index 830f206a1..13602d295 100644 --- a/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs +++ b/src/FsAutoComplete/CodeFixes/NegationToSubtraction.fs @@ -16,15 +16,16 @@ let fix (getFileLines: GetFileLines) : CodeFix = |> Utils.normalizePath let! lines = getFileLines fileName - - match walkForwardUntilCondition lines (inc lines diagnostic.Range.End) (fun ch -> ch = '-') with + let! walkPos = inc lines diagnostic.Range.End |> Result.ofOption (fun _ -> "No walk pos") + match walkForwardUntilCondition lines walkPos (fun ch -> ch = '-') with | Some dash -> + let! oneBack = dec lines dash |> Result.ofOption (fun _ -> "No one back") return [ { SourceDiagnostic = Some diagnostic Title = "Use subtraction instead of negation" File = codeActionParams.TextDocument Edits = - [| { Range = { Start = dash; End = dec lines dash } + [| { Range = { Start = oneBack; End = dash } NewText = "- " } |] Kind = FixKind.Fix } ] | None -> return [] diff --git a/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs b/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs index a432935ca..2b3255074 100644 --- a/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs +++ b/src/FsAutoComplete/CodeFixes/RemoveUnusedBinding.fs @@ -90,12 +90,13 @@ let fix (getParseResults: GetParseResultsForFile): CodeFix = | FullBinding bindingRangeWithPats -> let protocolRange = fcsRangeToLsp bindingRangeWithPats // the pos at the end of the previous keyword + let! walkPos = dec lines protocolRange.Start |> Result.ofOption (fun _ -> "failed to walk") let! endOfPrecedingKeyword = - Navigation.walkBackUntilCondition lines (dec lines protocolRange.Start) (System.Char.IsWhiteSpace >> not) + Navigation.walkBackUntilCondition lines walkPos (System.Char.IsWhiteSpace >> not) |> Result.ofOption (fun _ -> "failed to walk") // walk back to the start of the keyword, which is always `let` or `use` - let keywordStartColumn = decMany lines endOfPrecedingKeyword 3 + let! keywordStartColumn = decMany lines endOfPrecedingKeyword 3 |> Result.ofOption (fun _ -> "failed to walk") let replacementRange = { Start = keywordStartColumn; End = protocolRange.End } return [ { Title = "Remove unused binding" Edits = [| { Range = replacementRange; NewText = "" } |] diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs index 751d3ecee..4b67ac908 100644 --- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs +++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs @@ -25,6 +25,7 @@ open CliWrap.Buffered open FSharp.Compiler.Tokenization open FSharp.Compiler.EditorServices open FSharp.Compiler.Symbols +open FSharp.UMX module FcsRange = FSharp.Compiler.Text.Range type FcsRange = FSharp.Compiler.Text.Range @@ -230,7 +231,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS | Some contentChange, Some version -> if contentChange.Range.IsNone && contentChange.RangeLength.IsNone then - let content = SourceText.ofString contentChange.Text + let content = NamedText(filePath, contentChange.Text) let tfmConfig = config.UseSdkScripts logger.info ( @@ -576,7 +577,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS ///Helper function for handling Position requests using **recent** type check results member x.positionHandler<'a, 'b when 'b :> ITextDocumentPositionParams> - (f: 'b -> FcsPos -> ParseAndCheckResults -> string -> ISourceText -> AsyncLspResult<'a>) + (f: 'b -> FcsPos -> ParseAndCheckResults -> string -> NamedText -> AsyncLspResult<'a>) (arg: 'b) : AsyncLspResult<'a> = async { @@ -740,8 +741,8 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS commands.TryGetFileCheckerOptionsWithLines >> Result.map snd - let getLineText (lines: ISourceText) (range: Ionide.LanguageServerProtocol.Types.Range) = - lines.GetText(protocolRangeToRange "unknown.fsx" range) + let getLineText (lines: NamedText) (range: Ionide.LanguageServerProtocol.Types.Range) = + lines.GetText(protocolRangeToRange (UMX.untag lines.FileName) range) let getRangeText fileName (range: Ionide.LanguageServerProtocol.Types.Range) = getFileLines fileName @@ -817,7 +818,6 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS ChangeComparisonToMutableAssignment.fix tryGetParseResultsForFile ConvertInvalidRecordToAnonRecord.fix tryGetParseResultsForFile RemoveUnnecessaryReturnOrYield.fix tryGetParseResultsForFile getLineText - RemoveUnnecessaryReturnOrYield.fix tryGetParseResultsForFile getLineText ChangeCSharpLambdaToFSharp.fix tryGetParseResultsForFile getLineText AddMissingFunKeyword.fix getFileLines getLineText MakeOuterBindingRecursive.fix tryGetParseResultsForFile getLineText @@ -828,7 +828,8 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS AddTypeToIndeterminateValue.fix tryGetParseResultsForFile tryGetProjectOptions ChangeTypeOfNameToNameOf.fix tryGetParseResultsForFile AddMissingInstanceMember.fix - AddExplicitTypeToParameter.fix tryGetParseResultsForFile |] + AddExplicitTypeToParameter.fix tryGetParseResultsForFile + ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText |] match p.RootPath, c.AutomaticWorkspaceInit with @@ -944,7 +945,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS async { let doc = p.TextDocument let filePath = doc.GetFilePath() |> Utils.normalizePath - let content = SourceText.ofString doc.Text + let content = NamedText(filePath, doc.Text) let tfmConfig = config.UseSdkScripts logger.info ( @@ -985,7 +986,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS | Some contentChange, Some version -> if contentChange.Range.IsNone && contentChange.RangeLength.IsNone then - let content = SourceText.ofString contentChange.Text + let content = NamedText(filePath, contentChange.Text) commands.SetFileContent(filePath, content, Some version, config.ScriptTFM) else () @@ -1006,25 +1007,6 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS } override __.TextDocumentCompletion(p: CompletionParams) = - let ensureInBounds (lines: ISourceText) (line, col) = - let lineStr = lines.GetLineString line - - if line <= lines.Length - && line >= 0 - && col <= lineStr.Length + 1 - && col >= 0 then - Ok() - else - logger.info ( - Log.setMessage - "TextDocumentCompletion Not OK:\n COL: {col}\n LINE_STR: {lineStr}\n LINE_STR_LENGTH: {lineStrLength}" - >> Log.addContextDestructured "col" col - >> Log.addContextDestructured "lineStr" lineStr - >> Log.addContextDestructured "lineStrLength" lineStr.Length - ) - - Error(JsonRpc.Error.InternalErrorMessage "not ok") - asyncResult { logger.info ( Log.setMessage "TextDocumentCompletion Request: {context}" @@ -1037,22 +1019,15 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS let pos = p.GetFcsPos() - let! (options, lines) = - commands.TryGetFileCheckerOptionsWithLines file - |> Result.mapError JsonRpc.Error.InternalErrorMessage - - let line, col = p.Position.Line, p.Position.Character - let lineStr = lines.GetLineString line + match commands.TryGetFileCheckerOptionsWithLines file with + | Error _ -> return! success None + | Ok (options, lines) -> - let word = - lineStr.Substring(0, min col lineStr.Length) - - do! ensureInBounds lines (line, col) + match lines.GetLine pos with + | None -> return! success None + | Some lineStr -> - if (lineStr.StartsWith "#" - && (KeywordList.hashDirectives.Keys - |> Seq.exists (fun k -> k.StartsWith word) - || word.Contains "\n")) then + if lineStr.StartsWith "#" then let completionList = { IsIncomplete = false Items = KeywordList.hashSymbolCompletionItems } @@ -1544,7 +1519,7 @@ type FSharpLspServer(backgroundServiceEnabled: bool, state: State, lspClient: FS | Ok (FormatDocumentResponse.Formatted (lines, formatted)) -> let range = let zero = { Line = 0; Character = 0 } - let lastPos = lines.GetLastFilePosition() + let lastPos = lines.LastFilePosition { Start = zero End = fcsPosToLsp lastPos } diff --git a/src/FsAutoComplete/LspHelpers.fs b/src/FsAutoComplete/LspHelpers.fs index 9df8e5bdc..2fa2729f6 100644 --- a/src/FsAutoComplete/LspHelpers.fs +++ b/src/FsAutoComplete/LspHelpers.fs @@ -23,9 +23,13 @@ module Conversions = let protocolPosToPos (pos: Lsp.Position): FcsPos = FcsPos.mkPos (pos.Line + 1) (pos.Character) + let protocolPosToRange (pos: Lsp.Position): Lsp.Range = + { Start = pos; End = pos } + /// convert a compiler position to an LSP position - let fcsPosToLsp (pos: FcsPos): Lsp.Position = - { Line = pos.Line - 1; Character = pos.Column } + let fcsPosToLsp (pos: FcsPos) : Lsp.Position = + { Line = pos.Line - 1 + Character = pos.Column } /// convert a compiler range to an LSP range let fcsRangeToLsp(range: FcsRange): Lsp.Range = diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs index 01325bb8f..2fb5c347a 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests.fs @@ -67,7 +67,7 @@ let abstractClassGenerationTests state = | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Generate abstract class members" } |])) -> () | Ok other -> failtestf $"Should have generated the rest of the base class, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) let canGenerateForIdent = testCaseAsync @@ -90,7 +90,7 @@ let abstractClassGenerationTests state = | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Generate abstract class members" } |])) -> () | Ok other -> failtestf $"Should have generated the rest of the base class, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) testList "abstract class generation" @@ -100,8 +100,7 @@ let abstractClassGenerationTests state = let generateMatchTests state = let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MatchCaseGeneration") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MatchCaseGeneration") let! (server, events) = serverInitialize path { defaultConfigDto with UnionCaseStubGeneration = Some true } state do! waitForWorkspaceFinishedParsing events @@ -137,13 +136,12 @@ let generateMatchTests state = () | Ok other -> failtestf $"Should have generated the rest of match cases, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] let missingFunKeywordTests state = let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MissingFunKeyword") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MissingFunKeyword") let! (server, events) = serverInitialize path defaultConfigDto state do! waitForWorkspaceFinishedParsing events @@ -181,13 +179,12 @@ let missingFunKeywordTests state = () | Ok other -> failtestf $"Should have generated missing fun keyword, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] let outerBindingRecursiveTests state = let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "OuterBindingRecursive") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "OuterBindingRecursive") let! (server, events) = serverInitialize path defaultConfigDto state do! waitForWorkspaceFinishedParsing events @@ -225,7 +222,7 @@ let outerBindingRecursiveTests state = () | Ok other -> failtestf $"Should have generated a rec keyword, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] let nameofInsteadOfTypeofNameTests state = let server = @@ -269,13 +266,12 @@ let nameofInsteadOfTypeofNameTests state = () | Ok other -> failtestf $"Should have generated nameof, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] let missingInstanceMemberTests state = let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MissingInstanceMember") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "MissingInstanceMember") let! (server, events) = serverInitialize path defaultConfigDto state do! waitForWorkspaceFinishedParsing events @@ -313,7 +309,7 @@ let missingInstanceMemberTests state = () | Ok other -> failtestf $"Should have generated an instance member, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] let unusedValueTests state = let (|ActReplace|_|) = (|Refactor|_|) "Replace with _" "_" @@ -323,11 +319,9 @@ let unusedValueTests state = let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "UnusedValue") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "UnusedValue") - let cfg = - { defaultConfigDto with UnusedDeclarationsAnalyzer = Some true } + let cfg = { defaultConfigDto with UnusedDeclarationsAnalyzer = Some true } let! (server, events) = serverInitialize path cfg state do! waitForWorkspaceFinishedParsing events @@ -366,7 +360,7 @@ let unusedValueTests state = | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ActReplace |])) -> () | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) let canReplaceUnusedBinding = testCaseAsync @@ -390,7 +384,7 @@ let unusedValueTests state = | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ActReplace; ActPrefix "six" |])) -> () | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) let canReplaceUnusedParameter = testCaseAsync @@ -416,7 +410,7 @@ let unusedValueTests state = _ (* explicit type annotation codefix *) |])) -> () | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) testList "unused value" @@ -425,19 +419,15 @@ let unusedValueTests state = canReplaceUnusedParameter ] let removeUnusedBindingTests state = - let (|RemoveBinding|_|) = - (|Refactor|_|) "Remove unused binding" "" + let (|RemoveBinding|_|) = (|Refactor|_|) "Remove unused binding" "" - let (|RemoveParameter|_|) = - (|Refactor|_|) "Remove unused parameter" "" + let (|RemoveParameter|_|) = (|Refactor|_|) "Remove unused parameter" "" let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "RemoveUnusedBinding") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "RemoveUnusedBinding") - let cfg = - { defaultConfigDto with FSIExtraParameters = Some [| "--warnon:1182" |] } + let cfg = { defaultConfigDto with FSIExtraParameters = Some [| "--warnon:1182" |] } let! (server, events) = serverInitialize path cfg state do! waitForWorkspaceFinishedParsing events @@ -478,7 +468,7 @@ let removeUnusedBindingTests state = _ (* explicit type annotation codefix *) |])) -> () | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) let canRemoveUnusedSingleCharacterFunctionParameterInParens = testCaseAsync @@ -504,7 +494,7 @@ let removeUnusedBindingTests state = _ (* explicit type annotation codefix *) |])) -> () | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) let canRemoveUnusedBindingInsideTopLevel = testCaseAsync @@ -529,7 +519,7 @@ let removeUnusedBindingTests state = | Ok (Some (TextDocumentCodeActionResult.CodeActions [| RemoveBinding & AtRange replacementRange |])) -> () | Ok other -> failtestf $"Should have generated _, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) + }) testList @@ -560,8 +550,7 @@ let addExplicitTypeAnnotationTests state = } |> Async.Cache - let (|ExplicitAnnotation|_|) = - (|Refactor|_|) "Add explicit type annotation" + let (|ExplicitAnnotation|_|) = (|Refactor|_|) "Add explicit type annotation" testList "explicit type annotations" @@ -581,13 +570,12 @@ let addExplicitTypeAnnotationTests state = | Ok (Some (TextDocumentCodeActionResult.CodeActions [| ExplicitAnnotation "(f: Foo)" |])) -> () | Ok other -> failtestf $"Should have generated explicit type annotation, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] let negationToSubstraction state = let server = async { - let path = - Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "NegationToSubstraction") + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "NegationToSubstraction") let cfg = defaultConfigDto let! (server, events) = serverInitialize path cfg state @@ -605,8 +593,7 @@ let negationToSubstraction state = } |> Async.Cache - let (|NegationToSubstraction|_|) = - (|Refactor|_|) "Negation to substraction" + let (|NegationToSubstraction|_|) = (|Refactor|_|) "Negation to substraction" testList "negation to substraction" @@ -615,7 +602,6 @@ let negationToSubstraction state = (async { let! (server, filePath, diagnostics) = server - printfn "%A" diagnostics let diagnostic = diagnostics |> Array.tryFind (fun d -> d.Code = Some "3" && d.Range.Start.Line = 2) @@ -631,23 +617,163 @@ let negationToSubstraction state = match! server.TextDocumentCodeAction context with | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Use subtraction instead of negation" Kind = Some "quickfix" - Edit = Some { - DocumentChanges = Some [| { - Edits = [|{ - Range = { - Start = { - Line = 2; - Character = 16 }; - End = { - Line = 2; - Character = 15 } - }; - NewText = "- " - }|] }|] } } |])) - -> () + Edit = Some { DocumentChanges = Some [| { Edits = [| { Range = { Start = { Line = 2 + Character = 15 } + End = { Line = 2 + Character = 16 } } + NewText = "- " } |] } |] } } |])) -> + () | Ok other -> failtestf $"Should have converted negation to substraction, but instead generated %A{other}" | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" - }) ] + }) ] + +let positionalToNamedDUTests state = + let server = + async { + let path = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "PositionalToNamedDU") + + let cfg = defaultConfigDto + let! (server, events) = serverInitialize path cfg state + do! waitForWorkspaceFinishedParsing events + let path = Path.Combine(path, "Script.fsx") + let tdop: DidOpenTextDocumentParams = { TextDocument = loadDocument path } + do! server.TextDocumentDidOpen tdop + + let! diagnostics = + events + |> waitForParseResultsForFile "Script.fsx" + |> AsyncResult.bimap (fun _ -> failtest "Should have had errors") id + + return (server, path) + } + |> Async.Cache + + let expectEdits invokePos edits = + async { + let! (server, filePath) = server + + let context: CodeActionParams = + { Context = { Diagnostics = [||] } + Range = invokePos + TextDocument = { Uri = Path.FilePathToUri filePath } } + + match! server.TextDocumentCodeAction context with + | Ok (Some (TextDocumentCodeActionResult.CodeActions [| { Title = "Convert to named patterns" + Kind = Some "refactor" + Edit = Some { DocumentChanges = Some [| { Edits = es } |] } } |])) when + es = edits + -> + () + | Ok other -> failtestf $"Should have converted positional DUs to named patterns, but instead generated %A{other}" + | Error reason -> failtestf $"Should have succeeded, but failed with %A{reason}" + } + + testList + "convert positional DU match to named" + [ testCaseAsync + "in parenthesized let binding" + (let patternPos = + { Start = { Line = 2; Character = 9 } + End = { Line = 2; Character = 10 } } + + let edits = + [| { Range = + { Start = { Line = 2; Character = 7 } + End = { Line = 2; Character = 7 } } + NewText = "a = " } + { Range = + { Start = { Line = 2; Character = 8 } + End = { Line = 2; Character = 8 } } + NewText = "; " } + { Range = + { Start = { Line = 2; Character = 10 } + End = { Line = 2; Character = 10 } } + NewText = "b = " } + { Range = + { Start = { Line = 2; Character = 11 } + End = { Line = 2; Character = 11 } } + NewText = "; " } |] + + expectEdits patternPos edits) + testCaseAsync + "in simple match" + (let patternPos = + { Start = { Line = 5; Character = 5 } + End = { Line = 5; Character = 6 } } + + let edits = + [| { Range = + { Start = { Line = 5; Character = 4 } + End = { Line = 5; Character = 4 } } + NewText = "a = " } + { Range = + { Start = { Line = 5; Character = 5 } + End = { Line = 5; Character = 5 } } + NewText = "; " } + { Range = + { Start = { Line = 5; Character = 7 } + End = { Line = 5; Character = 7 } } + NewText = "b = " } + { Range = + { Start = { Line = 5; Character = 8 } + End = { Line = 5; Character = 8 } } + NewText = "; " } |] + + expectEdits patternPos edits) + testCaseAsync + "in parenthesized match" + (let patternPos = + { Start = { Line = 8; Character = 7 } + End = { Line = 8; Character = 8 } } + + let edits = + [| { Range = + { Start = { Line = 8; Character = 5 } + End = { Line = 8; Character = 5 } } + NewText = "a = " } + { Range = + { Start = { Line = 8; Character = 6 } + End = { Line = 8; Character = 6 } } + NewText = "; " } + { Range = + { Start = { Line = 8; Character = 8 } + End = { Line = 8; Character = 8 } } + NewText = "b = " } + { Range = + { Start = { Line = 8; Character = 9 } + End = { Line = 8; Character = 9 } } + NewText = "; " } |] + + expectEdits patternPos edits) + testCaseAsync + "when there are new fields on the DU" + (let patternPos = + { Start = { Line = 12; Character = 29 } + End = { Line = 12; Character = 30 } } + + let edits = + [| { Range = + { Start = { Line = 12; Character = 28 } + End = { Line = 12; Character = 28 } } + NewText = "a = " } + { Range = + { Start = { Line = 12; Character = 29 } + End = { Line = 12; Character = 29 } } + NewText = "; " } + { Range = + { Start = { Line = 12; Character = 31 } + End = { Line = 12; Character = 31 } } + NewText = "b = " } + { Range = + { Start = { Line = 12; Character = 32 } + End = { Line = 12; Character = 32 } } + NewText = "; " } + { Range = + { Start = { Line = 12; Character = 32 } + End = { Line = 12; Character = 32 } } + NewText = "c = _; " } |] + + expectEdits patternPos edits) ] let tests state = testList @@ -661,5 +787,5 @@ let tests state = unusedValueTests state addExplicitTypeAnnotationTests state negationToSubstraction state - // removeUnusedBindingTests state - ] + removeUnusedBindingTests state + positionalToNamedDUTests state ] diff --git a/test/FsAutoComplete.Tests.Lsp/CompletionTests.fs b/test/FsAutoComplete.Tests.Lsp/CompletionTests.fs index b6a7be8c0..b2bfe5422 100644 --- a/test/FsAutoComplete.Tests.Lsp/CompletionTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CompletionTests.fs @@ -41,6 +41,46 @@ let tests state = | Error e -> failtestf "Got an error while retrieving completions: %A" e }) + + testCaseAsync "completion at start of line" (async { + let! server, path = server + let completionParams : CompletionParams = + { + TextDocument = { Uri = Path.FilePathToUri path } + Position = { Line = 6; Character = 5 } // the '.' in 'List.' + Context = Some { triggerKind = CompletionTriggerKind.TriggerCharacter; triggerCharacter = Some '.' } + } + let! response = server.TextDocumentCompletion completionParams + match response with + | Ok (Some completions) -> + Expect.equal completions.Items.Length 106 "at time of writing the List module has 106 exposed members" + let firstItem = completions.Items.[0] + Expect.equal firstItem.Label "Empty" "first member should be List.Empty, since properties are preferred over functions" + | Ok None -> + failtest "Should have gotten some completion items" + | Error e -> + failtestf "Got an error while retrieving completions: %A" e + }) + + testCaseAsync "completion at end of line" (async { + let! server, path = server + let completionParams : CompletionParams = + { + TextDocument = { Uri = Path.FilePathToUri path } + Position = { Line = 8; Character = 16 } // the '.' in 'List.' + Context = Some { triggerKind = CompletionTriggerKind.TriggerCharacter; triggerCharacter = Some '.' } + } + let! response = server.TextDocumentCompletion completionParams + match response with + | Ok (Some completions) -> + Expect.equal completions.Items.Length 106 "at time of writing the List module has 106 exposed members" + let firstItem = completions.Items.[0] + Expect.equal firstItem.Label "Empty" "first member should be List.Empty, since properties are preferred over functions" + | Ok None -> + failtest "Should have gotten some completion items" + | Error e -> + failtestf "Got an error while retrieving completions: %A" e + }) ] ///Tests for getting autocomplete @@ -243,7 +283,7 @@ let autoOpenTests state = return (edit, ns, openPos) | Ok _ -> return failtest $"Quick fix on `{word}` doesn't contain open action" } - + let test (compareWithQuickFix: bool) (name: string option) (server: Async) (word: string, ns: string) (cursor: Position) (expectedOpen: Position) pending = let name = name |> Option.defaultWith (fun _ -> sprintf "completion on `Regex` at (%i, %i) should `open System.Text.RegularExpressions` at (%i, %i) (0-based)" (cursor.Line) (cursor.Character) (expectedOpen.Line) (expectedOpen.Character)) let runner = if pending then ptestCaseAsync else testCaseAsync @@ -369,7 +409,7 @@ let autoOpenTests state = do! server.Shutdown() }) ] - + let ptestScript name scriptName = testList name [ let scriptPath = Path.Combine(dirPath, scriptName) diff --git a/test/FsAutoComplete.Tests.Lsp/Helpers.fs b/test/FsAutoComplete.Tests.Lsp/Helpers.fs index d2e9dfc4b..7a69725c6 100644 --- a/test/FsAutoComplete.Tests.Lsp/Helpers.fs +++ b/test/FsAutoComplete.Tests.Lsp/Helpers.fs @@ -274,7 +274,8 @@ open Expecto.Logging open Expecto.Logging.Message open System.Threading open FsAutoComplete.CommandResponse - +open CliWrap +open CliWrap.Buffered let logEvent (name, payload) = logger.debug (eventX "{name}: {payload}" >> setField "name" name >> setField "payload" payload) @@ -289,43 +290,21 @@ let dotnetCleanup baseDir = |> List.filter Directory.Exists |> List.iter (fun path -> Directory.Delete(path, true)) -let runProcess (log: string -> unit) (workingDir: string) (exePath: string) (args: string) = async { - let psi = System.Diagnostics.ProcessStartInfo() - psi.FileName <- exePath - psi.WorkingDirectory <- workingDir - psi.RedirectStandardOutput <- true - psi.RedirectStandardError <- true - psi.Arguments <- args - psi.CreateNoWindow <- true - psi.UseShellExecute <- false - - use p = new System.Diagnostics.Process() - p.StartInfo <- psi - - p.OutputDataReceived.Add(fun ea -> log (ea.Data)) - - p.ErrorDataReceived.Add(fun ea -> log (ea.Data)) - +let runProcess (workingDir: string) (exePath: string) (args: string) = async { let! ctok = Async.CancellationToken - p.Start() |> ignore - p.BeginOutputReadLine() - p.BeginErrorReadLine() - do! p.WaitForExitAsync(ctok) |> Async.AwaitTask - - let exitCode = p.ExitCode - - return exitCode, (workingDir, exePath, args) + let! result = Cli.Wrap(exePath).WithArguments(args).WithWorkingDirectory(workingDir).WithValidation(CommandResultValidation.None).ExecuteBufferedAsync(ctok).Task |> Async.AwaitTask + return result } -let inline expectExitCodeZero (exitCode, _) = - Expect.equal exitCode 0 (sprintf "expected exit code zero but was %i" exitCode) +let inline expectExitCodeZero (r: BufferedCommandResult) = + Expect.equal r.ExitCode 0 $"Expected exit code zero but was %i{r.ExitCode}.\nStdOut: %s{r.StandardOutput}\nStdErr: %s{r.StandardError}" let dotnetRestore dir = - runProcess (logDotnetRestore ("Restore" + dir)) dir "dotnet" "restore" + runProcess dir "dotnet" "restore" |> Async.map expectExitCodeZero let dotnetToolRestore dir = - runProcess (logDotnetRestore ("ToolRestore" + dir)) dir "dotnet" "tool restore" + runProcess dir "dotnet" "tool restore" |> Async.map expectExitCodeZero let serverInitialize path (config: FSharpConfigDto) state = async { diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/Completion/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/Completion/Script.fsx index ca288d4bd..a37d4d040 100644 --- a/test/FsAutoComplete.Tests.Lsp/TestCases/Completion/Script.fsx +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/Completion/Script.fsx @@ -2,3 +2,8 @@ async { return 1 } |> Async. // completion at this `.` should not have a billion suggestions + + +List. + +let tail = List. diff --git a/test/FsAutoComplete.Tests.Lsp/TestCases/PositionalToNamedDU/Script.fsx b/test/FsAutoComplete.Tests.Lsp/TestCases/PositionalToNamedDU/Script.fsx new file mode 100644 index 000000000..136ec8017 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/TestCases/PositionalToNamedDU/Script.fsx @@ -0,0 +1,13 @@ +type A = A of a: int * b: bool + +let (A(a, b)) = A(1, true) + +match A(1, true) with +| A(a, b) -> () + +match A(1, true) with +| (A(a, b)) -> () + +type ThirdFieldWasJustAdded = ThirdFieldWasJustAdded of a: int * b: bool * c: char + +let (ThirdFieldWasJustAdded(a, b)) = ThirdFieldWasJustAdded(1, true, 'c') diff --git a/test/FsAutoComplete.Tests.Lsp/paket.references b/test/FsAutoComplete.Tests.Lsp/paket.references index a0102ea94..af68b4db7 100644 --- a/test/FsAutoComplete.Tests.Lsp/paket.references +++ b/test/FsAutoComplete.Tests.Lsp/paket.references @@ -7,6 +7,7 @@ Microsoft.NET.Test.Sdk YoloDev.Expecto.TestSdk AltCover GitHubActionsTestLogger +CliWrap Microsoft.Build copy_local:false Microsoft.Build.Framework copy_local:false