Skip to content

Commit

Permalink
Fix ionide/ionide-vscode-fsharp#1906 (#1152)
Browse files Browse the repository at this point in the history 
* Fix #1906

* You gotta be trolling me

* never seen fantomas used this way

* More tests

* Oops

* clarify error

* fix grammar
  • Loading branch information
@Happypig375
Happypig375 authored Sep 1, 2023
1 parent a68786a commit daf3619
Show file tree
Hide file tree
Showing 5 changed files with 271 additions and 139 deletions.
14 changes: 12 additions & 2 deletions src/FsAutoComplete.Core/FileSystem.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -214,7 +214,11 @@ type NamedText(fileName: string<LocalPath>, str: string) =

/// Provides safe access to a substring of the file via FCS-provided Range
member x.GetText(m: FSharp.Compiler.Text.Range) : Result<string, string> =
if not (Range.rangeContainsRange x.TotalRange m) then
// indexing into first line of empty file can be encountered when typing from an empty file
// if we don't check it, GetLineString will throw IndexOutOfRangeException
if (x :> ISourceText).GetLineCount() = 0 then
Ok ""
else 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 = (x :> ISourceText).GetLineString(m.StartLine - 1)
Expand Down Expand Up @@ -248,7 +252,10 @@ type NamedText(fileName: string<LocalPath>, str: string) =

/// 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 < 1 || pos.Line > getLines.Value.Length then
// indexing into first line of empty file can be encountered when typing from an empty file
if (x :> ISourceText).GetLineCount() = 0 then
Some ""
else if pos.Line < 1 || pos.Line > getLines.Value.Length then
None
else
Some(x.GetLineUnsafe pos)
Expand All @@ -265,6 +272,9 @@ type NamedText(fileName: string<LocalPath>, str: string) =
/// Also available in indexer form: <code lang="fsharp">x[pos]</code></summary>
member x.TryGetChar(pos: FSharp.Compiler.Text.Position) : char option =
option {
// indexing into first line of empty file can be encountered when typing from an empty file
// if we don't check it, GetLineUnsafe will throw IndexOutOfRangeException
do! Option.guard ((x :> ISourceText).GetLineCount() > 0)
do! Option.guard (Range.rangeContainsPos (x.TotalRange) pos)
let lineText = x.GetLineUnsafe(pos)

Expand Down
285 changes: 149 additions & 136 deletions src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -416,13 +416,16 @@ type AdaptiveFSharpLspServer
do
disposables.Add
<| fileChecked.Publish.Subscribe(fun (parseAndCheck, volatileFile, ct) ->
async {
let config = config |> AVal.force
do! builtInCompilerAnalyzers config volatileFile parseAndCheck
do! runAnalyzers config parseAndCheck volatileFile
if volatileFile.Source.Length = 0 then
() // Don't analyze and error on an empty file
else
async {
let config = config |> AVal.force
do! builtInCompilerAnalyzers config volatileFile parseAndCheck
do! runAnalyzers config parseAndCheck volatileFile

}
|> Async.StartWithCT ct)
}
|> Async.StartWithCT ct)


let handleCommandEvents (n: NotificationEvent, ct: CancellationToken) =
Expand Down Expand Up @@ -1055,15 +1058,21 @@ type AdaptiveFSharpLspServer
>> Log.addContextDestructured "file" file
)

use s = File.openFileStreamForReadingAsync file
if File.Exists(UMX.untag file) then
use s = File.openFileStreamForReadingAsync file

let! source = sourceTextFactory.Create(file, s) |> Async.AwaitCancellableValueTask
let! source = sourceTextFactory.Create(file, s) |> Async.AwaitCancellableValueTask

return
{ LastTouched = File.getLastWriteTimeOrDefaultNow file
Source = source
Version = 0 }
return
{ LastTouched = File.getLastWriteTimeOrDefaultNow file
Source = source
Version = 0 }

else // When a user does "File -> New Text File -> Select a language -> F#" without saving, the file won't exist
return
{ LastTouched = DateTime.UtcNow
Source = sourceTextFactory.Create(file, "")
Version = 0 }
with e ->
logger.warn (
Log.setMessage "Could not read file {file}"
Expand Down Expand Up @@ -2475,141 +2484,145 @@ type AdaptiveFSharpLspServer

let! volatileFile = forceFindOpenFileOrRead filePath |> AsyncResult.ofStringErr

let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr
if volatileFile.Source.Length = 0 then
return None // An empty file has empty completions. Otherwise we would error down there
else

if lineStr.StartsWith "#" then
let completionList =
{ IsIncomplete = false
Items = KeywordList.hashSymbolCompletionItems
ItemDefaults = None }
let! lineStr = volatileFile.Source |> tryGetLineStr pos |> Result.ofStringErr

if lineStr.StartsWith "#" then
let completionList =
{ IsIncomplete = false
Items = KeywordList.hashSymbolCompletionItems
ItemDefaults = None }

return! success (Some completionList)
else
let config = AVal.force config

let rec retryAsyncOption (delay: TimeSpan) timesLeft handleError action =
async {
match! action with
| Ok x -> return Ok x
| Error e when timesLeft >= 0 ->
let nextAction = handleError e
do! Async.Sleep(delay)
return! retryAsyncOption delay (timesLeft - 1) handleError nextAction
| Error e -> return Error e
}

let getCompletions forceGetTypeCheckResultsStale =
asyncResult {

let! volatileFile = forceFindOpenFileOrRead filePath
let! lineStr = volatileFile.Source |> tryGetLineStr pos

// TextDocumentCompletion will sometimes come in before TextDocumentDidChange
// This will require the trigger character to be at the place VSCode says it is
// Otherwise we'll fail here and our retry logic will come into place
do!
match p.Context with
| Some({ triggerKind = CompletionTriggerKind.TriggerCharacter } as context) ->
volatileFile.Source.TryGetChar pos = context.triggerCharacter
| _ -> true
|> Result.requireTrue $"TextDocumentCompletion was sent before TextDocumentDidChange"
return! success (Some completionList)
else
let config = AVal.force config

// Special characters like parentheses, brackets, etc. require a full type check
let isSpecialChar = Option.exists (Char.IsLetterOrDigit >> not)
let rec retryAsyncOption (delay: TimeSpan) timesLeft handleError action =
async {
match! action with
| Ok x -> return Ok x
| Error e when timesLeft >= 0 ->
let nextAction = handleError e
do! Async.Sleep(delay)
return! retryAsyncOption delay (timesLeft - 1) handleError nextAction
| Error e -> return Error e
}

let previousCharacter = volatileFile.Source.TryGetChar(FcsPos.subtractColumn pos 1)
let getCompletions forceGetTypeCheckResultsStale =
asyncResult {

let! typeCheckResults =
if isSpecialChar previousCharacter then
forceGetTypeCheckResults filePath
else
forceGetTypeCheckResultsStale filePath
let! volatileFile = forceFindOpenFileOrRead filePath
let! lineStr = volatileFile.Source |> tryGetLineStr pos

let getAllSymbols () =
if config.ExternalAutocomplete then
typeCheckResults.GetAllEntities true
else
[]

let! (decls, residue, shouldKeywords) =
Debug.measure "TextDocumentCompletion.TryGetCompletions" (fun () ->
typeCheckResults.TryGetCompletions pos lineStr None getAllSymbols
|> AsyncResult.ofOption (fun () -> "No TryGetCompletions results"))

do! Result.requireNotEmpty "Should not have empty completions" decls

return Some(decls, residue, shouldKeywords, typeCheckResults, getAllSymbols, volatileFile)
}

let handleError e =
match e with
| "Should not have empty completions" ->
// If we don't get any completions, assume we need to wait for a full typecheck
getCompletions forceGetTypeCheckResults
| _ -> getCompletions forceGetTypeCheckResultsStale

match!
retryAsyncOption
(TimeSpan.FromMilliseconds(15.))
100
handleError
(getCompletions forceGetTypeCheckResultsStale)
|> AsyncResult.ofStringErr
with
| None -> return! success (None)
| Some(decls, _, shouldKeywords, typeCheckResults, _, volatileFile) ->

return!
Debug.measure "TextDocumentCompletion.TryGetCompletions success"
<| fun () ->
transact (fun () ->
HashMap.OfList(
[ for d in decls do
d.NameInList, (d, pos, filePath, volatileFile.Source.GetLine, typeCheckResults.GetAST) ]
)
|> autoCompleteItems.UpdateTo)
|> ignore<bool>

let includeKeywords = config.KeywordsAutocomplete && shouldKeywords

let items =
decls
|> Array.mapi (fun id d ->
let code =
if
System.Text.RegularExpressions.Regex.IsMatch(d.NameInList, """^[a-zA-Z][a-zA-Z0-9']+$""")
then
d.NameInList
elif d.NamespaceToOpen.IsSome then
d.NameInList
else
FSharpKeywords.NormalizeIdentifierBackticks d.NameInList

let label =
match d.NamespaceToOpen with
| Some no -> sprintf "%s (open %s)" d.NameInList no
| None -> d.NameInList

{ CompletionItem.Create(d.NameInList) with
Kind = (AVal.force glyphToCompletionKind) d.Glyph
InsertText = Some code
SortText = Some(sprintf "%06d" id)
FilterText = Some d.NameInList
Label = label })

let its =
if not includeKeywords then
items
// TextDocumentCompletion will sometimes come in before TextDocumentDidChange
// This will require the trigger character to be at the place VSCode says it is
// Otherwise we'll fail here and our retry logic will come into place
do!
match p.Context with
| Some({ triggerKind = CompletionTriggerKind.TriggerCharacter } as context) ->
volatileFile.Source.TryGetChar pos = context.triggerCharacter
| _ -> true
|> Result.requireTrue $"TextDocumentCompletion was sent before TextDocumentDidChange"

// Special characters like parentheses, brackets, etc. require a full type check
let isSpecialChar = Option.exists (Char.IsLetterOrDigit >> not)

let previousCharacter = volatileFile.Source.TryGetChar(FcsPos.subtractColumn pos 1)

let! typeCheckResults =
if isSpecialChar previousCharacter then
forceGetTypeCheckResults filePath
else
Array.append items KeywordList.keywordCompletionItems
forceGetTypeCheckResultsStale filePath

let completionList =
{ IsIncomplete = false
Items = its
ItemDefaults = None }
let getAllSymbols () =
if config.ExternalAutocomplete then
typeCheckResults.GetAllEntities true
else
[]

let! (decls, residue, shouldKeywords) =
Debug.measure "TextDocumentCompletion.TryGetCompletions" (fun () ->
typeCheckResults.TryGetCompletions pos lineStr None getAllSymbols
|> AsyncResult.ofOption (fun () -> "No TryGetCompletions results"))

success (Some completionList)
do! Result.requireNotEmpty "Should not have empty completions" decls

return Some(decls, residue, shouldKeywords, typeCheckResults, getAllSymbols, volatileFile)
}

let handleError e =
match e with
| "Should not have empty completions" ->
// If we don't get any completions, assume we need to wait for a full typecheck
getCompletions forceGetTypeCheckResults
| _ -> getCompletions forceGetTypeCheckResultsStale

match!
retryAsyncOption
(TimeSpan.FromMilliseconds(15.))
100
handleError
(getCompletions forceGetTypeCheckResultsStale)
|> AsyncResult.ofStringErr
with
| None -> return! success (None)
| Some(decls, _, shouldKeywords, typeCheckResults, _, volatileFile) ->

return!
Debug.measure "TextDocumentCompletion.TryGetCompletions success"
<| fun () ->
transact (fun () ->
HashMap.OfList(
[ for d in decls do
d.NameInList, (d, pos, filePath, volatileFile.Source.GetLine, typeCheckResults.GetAST) ]
)
|> autoCompleteItems.UpdateTo)
|> ignore<bool>

let includeKeywords = config.KeywordsAutocomplete && shouldKeywords

let items =
decls
|> Array.mapi (fun id d ->
let code =
if
System.Text.RegularExpressions.Regex.IsMatch(d.NameInList, """^[a-zA-Z][a-zA-Z0-9']+$""")
then
d.NameInList
elif d.NamespaceToOpen.IsSome then
d.NameInList
else
FSharpKeywords.NormalizeIdentifierBackticks d.NameInList

let label =
match d.NamespaceToOpen with
| Some no -> sprintf "%s (open %s)" d.NameInList no
| None -> d.NameInList

{ CompletionItem.Create(d.NameInList) with
Kind = (AVal.force glyphToCompletionKind) d.Glyph
InsertText = Some code
SortText = Some(sprintf "%06d" id)
FilterText = Some d.NameInList
Label = label })

let its =
if not includeKeywords then
items
else
Array.append items KeywordList.keywordCompletionItems

let completionList =
{ IsIncomplete = false
Items = its
ItemDefaults = None }

success (Some completionList)

with e ->
trace |> Tracing.recordException e
Expand Down
Loading

0 comments on commit daf3619

Please sign in to comment.