From ef7b0677664b741bfb9585ad1137539d029b58c3 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sun, 8 May 2022 19:56:39 +0200
Subject: [PATCH 01/29] Add functions to extract different cursors from text
---
.../Utils/TextEdit.Tests.fs | 46 ++++++++++++
.../Utils/TextEdit.fs | 73 ++++++++++++++-----
2 files changed, 101 insertions(+), 18 deletions(-)
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs
index bf71ba69a..ecb09f86e 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs
@@ -203,6 +203,18 @@ printfn "Result=%i" b
]
]
]
+
+ let private tryExtractPositionMarkedWithAnyOfTests = testList (nameof Cursor.tryExtractPositionMarkedWithAnyOf) [
+ testCase "exact first of many cursors" <| fun _ ->
+ let text = "let $Avalue$B = $C42"
+ let actual =
+ text
+ |> Cursor.tryExtractPositionMarkedWithAnyOf [|"$B"; "$C"; "$A"|]
+ let expected = Some (("$A", pos 0 4), "let value$B = $C42")
+
+ actual
+ |> Expect.equal "should be correct marker" expected
+ ]
let private tryExtractPositionTests = testList (nameof Cursor.tryExtractPosition) [
testList "no cursor" [
@@ -945,6 +957,7 @@ $0printfn "$0Result=%i" b$0
let tests = testList (nameof Cursor) [
tryExtractIndexTests
+ tryExtractPositionMarkedWithAnyOfTests
tryExtractPositionTests
tryExtractRangeTests
beforeIndexTests
@@ -1053,8 +1066,41 @@ printfn "Result=%i" b$0
|> Cursors.iter
|> Expect.equal "should have returned all strings with single cursor" expected
]
+
+ let private extractWithTests = testList (nameof Cursors.extractWith) [
+ testCase "can extract all cursors" <| fun _ ->
+ let text = !- """
+ let $Ff a b = a + b
+ let $Vvalue = 42
+ let $0res = $Ff $Vvalue 3
+ ()
+ """
+ let actual =
+ text
+ |> Cursors.extractWith [|"$F"; "$V"; "$0" |]
+
+ let expectedText = !- """
+ let f a b = a + b
+ let value = 42
+ let res = f value 3
+ ()
+ """
+ let expectedPoss = [
+ ("$F", pos 0 4)
+ ("$V", pos 1 4)
+ ("$0", pos 2 4)
+ ("$F", pos 2 10)
+ ("$V", pos 2 12)
+ ]
+ let expected = (expectedText, expectedPoss)
+
+ actual
+ |> Expect.equal "markers should match" expected
+ ]
+
let tests = testList (nameof Cursors) [
iterTests
+ extractWithTests
]
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
index 860010a1f..015eb1898 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
@@ -59,34 +59,50 @@ module Cursor =
tryExtractIndex
>> Option.defaultWith (fun _ -> failtest "No cursor")
- /// Returns Position of first `$0` (`Cursor.Marker`) and the updated input text without the cursor marker.
- /// Only the first `$0` is processed.
- ///
- /// Note: Cursor Position is BETWEEN characters and might be outside of text range (cursor AFTER last character)
- let tryExtractPosition (text: string) =
- let tryFindCursorInLine (line: string) =
- match line.IndexOf Marker with
- | -1 -> None
- | column ->
- let line = line.Substring(0, column) + line.Substring(column + Marker.Length)
- Some (column, line)
+ /// Extracts first cursor marked with any of `markers`. Remaining cursors aren't touched
+ let tryExtractPositionMarkedWithAnyOf (markers: string[]) (text: string) =
+ let tryFindAnyCursorInLine (line: string) =
+ let markersInLine =
+ markers
+ |> Array.choose (fun marker ->
+ match line.IndexOf marker with
+ | -1 -> None
+ | column -> Some (marker, column)
+ )
+ match markersInLine with
+ | [||] -> None
+ | _ ->
+ let (marker, column) = markersInLine |> Array.minBy snd
+ let line = line.Substring(0, column) + line.Substring(column + marker.Length)
+ Some (marker, column, line)
// Note: Input `lines` gets mutated to remove cursor
- let tryFindCursor (lines: string[]) =
+ let tryFindAnyCursor (lines: string[]) =
lines
|> Seq.mapi (fun i l -> (i,l))
- |> Seq.tryPick (fun (i,line) -> tryFindCursorInLine line |> Option.map (fun (c, line) -> (pos i c, line)))
+ |> Seq.tryPick (fun (i,line) ->
+ tryFindAnyCursorInLine line
+ |> Option.map (fun (marker, c, line) -> (marker, pos i c, line))
+ )
|> function
| None -> None
- | Some (p,line) ->
+ | Some (marker, p,line) ->
lines.[p.Line] <- line
- Some (p, lines)
+ Some ((marker, p), lines)
let lines = text |> Text.lines
- match tryFindCursor lines with
+ match tryFindAnyCursor lines with
| None -> None
- | Some (p, lines) ->
+ | Some ((marker, p), lines) ->
let text = lines |> String.concat "\n"
- Some (p, text)
+ Some ((marker, p), text)
+
+ /// Returns Position of first `$0` (`Cursor.Marker`) and the updated input text without the cursor marker.
+ /// Only the first `$0` is processed.
+ ///
+ /// Note: Cursor Position is BETWEEN characters and might be outside of text range (cursor AFTER last character)
+ let tryExtractPosition =
+ tryExtractPositionMarkedWithAnyOf [| Marker |]
+ >> Option.map (fun ((_, pos), line) -> (pos, line))
/// `tryExtractPosition`, but fails when there's no cursor
let assertExtractPosition =
tryExtractPosition
@@ -170,6 +186,27 @@ module Cursors =
(text, poss)
+ /// Like `extract`, but instead of just extracting Cursors marked with `Cursor.Marker` (`$0`),
+ /// this here extract all specified markers.
+ let extractWith (markers: string[]) (text: string) =
+ let rec collect poss text =
+ match Cursor.tryExtractPositionMarkedWithAnyOf markers text with
+ | None -> (text,poss)
+ | Some ((marker, pos), text) ->
+ let poss = (marker, pos) :: poss
+ collect poss text
+ let (text, cursors) = collect [] text
+ (text, cursors |> List.rev)
+ /// Like `extractWith`, but additional groups cursor positions by marker
+ let extractGroupedWith (markers: string[]) (text: string) =
+ let (text, cursors) = extractWith markers text
+ let cursors =
+ cursors
+ |> List.groupBy fst
+ |> List.map (fun (marker, poss) -> (marker, poss |> List.map snd))
+ |> Map.ofList
+ (text, cursors)
+
module Text =
From a10620bea9a2841f51f320a23f79202ef171fd66 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sun, 8 May 2022 19:58:23 +0200
Subject: [PATCH 02/29] Add LSP InlayHint types
Note: for LSP 3.17.0 -> still in proposed state
---
src/FsAutoComplete/FsAutoComplete.fsproj | 1 +
src/FsAutoComplete/LSP.Preview.fs | 136 +++++++++++++++++++++++
2 files changed, 137 insertions(+)
create mode 100644 src/FsAutoComplete/LSP.Preview.fs
diff --git a/src/FsAutoComplete/FsAutoComplete.fsproj b/src/FsAutoComplete/FsAutoComplete.fsproj
index 3bb16dea7..b79d38a04 100644
--- a/src/FsAutoComplete/FsAutoComplete.fsproj
+++ b/src/FsAutoComplete/FsAutoComplete.fsproj
@@ -17,6 +17,7 @@
+
diff --git a/src/FsAutoComplete/LSP.Preview.fs b/src/FsAutoComplete/LSP.Preview.fs
new file mode 100644
index 000000000..30b6c5434
--- /dev/null
+++ b/src/FsAutoComplete/LSP.Preview.fs
@@ -0,0 +1,136 @@
+/// LSP Types for [LSP 3.17.0](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/)
+/// -- which isn't released yet!
+/// -> proposed state
+module Ionide.LanguageServerProtocol.Types
+
+open Ionide.LanguageServerProtocol.Types
+
+/// Inlay hint client capabilities.
+type InlayHintClientCapabilitiesResolveSupport = {
+ /// The properties that a client can resolve lazily.
+ Properties: string[]
+}
+type InlayHintClientCapabilities = {
+ /// Whether inlay hints support dynamic registration.
+ DynamicRegistration: bool option
+ /// Indicates which properties a client can resolve lazily on a inlay
+ /// hint.
+ ResolveSupport: InlayHintClientCapabilitiesResolveSupport option
+}
+
+
+/// Inlay hint options used during static registration.
+type InlayHintOptions = (*WorkDoneProgressOptions &*) {
+ /// The server provides support to resolve additional
+ /// information for an inlay hint item.
+ ResolveProvider: bool option
+}
+/// Inlay hint options used during static or dynamic registration.
+type InlayHintRegistrationOptions = InlayHintOptions (*& TextDocumentRegistrationOptions & StaticRegistrationOptions*)
+
+
+/// A parameter literal used in inlay hint requests.
+type InlayHintParams = (*WorkDoneProgressParams &*) {
+ /// The text document.
+ TextDocument: TextDocumentIdentifier
+ /// The visible document range for which inlay hints should be computed.
+ Range: Range
+}
+
+/// Inlay hint kinds.
+[]
+type InlayHintKind =
+ /// An inlay hint that for a type annotation.
+ | Type = 1
+ /// An inlay hint that is for a parameter.
+ | Parameter = 2
+[]
+[]
+type InlayHintTooltip =
+ | String of string
+ | Markup of MarkupContent
+/// An inlay hint label part allows for interactive and composite labels
+/// of inlay hints.
+type InlayHintLabelPart = {
+ /// The value of this label part.
+ Value: string
+ /// The tooltip text when you hover over this label part. Depending on
+ /// the client capability `inlayHint.resolveSupport` clients might resolve
+ /// this property late using the resolve request.
+ Tooltip: InlayHintTooltip option
+ /// An optional source code location that represents this
+ /// label part.
+ ///
+ /// The editor will use this location for the hover and for code navigation
+ /// features: This part will become a clickable link that resolves to the
+ /// definition of the symbol at the given location (not necessarily the
+ /// location itself), it shows the hover that shows at the given location,
+ /// and it shows a context menu with further code navigation commands.
+ ///
+ /// Depending on the client capability `inlayHint.resolveSupport` clients
+ /// might resolve this property late using the resolve request.
+ Location: Location option
+ /// An optional command for this label part.
+ ///
+ /// Depending on the client capability `inlayHint.resolveSupport` clients
+ /// might resolve this property late using the resolve request.
+ Command: Command option
+}
+[]
+[]
+type InlayHintLabel =
+ | String of string
+ | Parts of InlayHintLabelPart[]
+/// Inlay hint information.
+type InlayHint = {
+ /// The position of this hint.
+ Position: Position
+ /// The label of this hint. A human readable string or an array of
+ /// InlayHintLabelPart label parts.
+ ///
+ /// *Note* that neither the string nor the label part can be empty.
+ Label: InlayHintLabel
+ /// he kind of this hint. Can be omitted in which case the client
+ /// should fall back to a reasonable default.
+ Kind: InlayHintKind option
+ /// Optional text edits that are performed when accepting this inlay hint.
+ ///
+ /// *Note* that edits are expected to change the document so that the inlay
+ /// hint (or its nearest variant) is now part of the document and the inlay
+ /// hint itself is now obsolete.
+ ///
+ /// Depending on the client capability `inlayHint.resolveSupport` clients
+ /// might resolve this property late using the resolve request.
+ TextEdits: TextEdit[] option
+ /// The tooltip text when you hover over this item.
+ ///
+ /// Depending on the client capability `inlayHint.resolveSupport` clients
+ /// might resolve this property late using the resolve request.
+ Tooltip: InlayHintTooltip option
+ /// Render padding before the hint.
+ ///
+ /// Note: Padding should use the editor's background color, not the
+ /// background color of the hint itself. That means padding can be used
+ /// to visually align/separate an inlay hint.
+ PaddingLeft: bool option
+ /// Render padding after the hint.
+ ///
+ /// Note: Padding should use the editor's background color, not the
+ /// background color of the hint itself. That means padding can be used
+ /// to visually align/separate an inlay hint.
+ PaddingRight: bool option
+
+ //TODO: `Data` is missing
+}
+
+/// Client workspace capabilities specific to inlay hints.
+type InlayHintWorkspaceClientCapabilities = {
+ /// Whether the client implementation supports a refresh request sent from
+ /// the server to the client.
+ ///
+ /// Note that this event is global and will force the client to refresh all
+ /// inlay hints currently shown. It should be used with absolute care and
+ /// is useful for situation where a server for example detects a project wide
+ /// change that requires such a calculation.
+ RefreshSupport: bool option
+}
From 85062559e6284fed8ea2eb13ac9a4f0588ab81bd Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Wed, 11 May 2022 17:54:11 +0200
Subject: [PATCH 03/29] Make `InlayHint` generic
`Data` is of type `LSPAny`:
```typescript
export type LSPAny = LSPObject | LSPArray | string | integer | uinteger |
decimal | boolean | null;
export type LSPObject = { [key: string]: LSPAny };
export type LSPArray = LSPAny[];
```
-> Not really able to express in F#
-> ~ `any` (TS/JS) or `obj` (F#) with just basic types in leaves and array(-serializable) as container
For practical reasons: Generic instead of `obj`.
But no checking for correctness according to specs
---
src/FsAutoComplete/LSP.Preview.fs | 14 ++++++++++++--
1 file changed, 12 insertions(+), 2 deletions(-)
diff --git a/src/FsAutoComplete/LSP.Preview.fs b/src/FsAutoComplete/LSP.Preview.fs
index 30b6c5434..3d957a0ac 100644
--- a/src/FsAutoComplete/LSP.Preview.fs
+++ b/src/FsAutoComplete/LSP.Preview.fs
@@ -82,7 +82,7 @@ type InlayHintLabel =
| String of string
| Parts of InlayHintLabelPart[]
/// Inlay hint information.
-type InlayHint = {
+type InlayHint<'Data> = {
/// The position of this hint.
Position: Position
/// The label of this hint. A human readable string or an array of
@@ -120,7 +120,17 @@ type InlayHint = {
/// to visually align/separate an inlay hint.
PaddingRight: bool option
- //TODO: `Data` is missing
+ /// A data entry field that is preserved on a inlay hint between
+ /// a `textDocument/inlayHint` and a `inlayHint/resolve` request.
+ ///
+ /// Note: In LSP specs: of type `LSPAny`:
+ /// ```typescript
+ /// export type LSPAny = LSPObject | LSPArray | string | integer | uinteger | decimal | boolean | null;
+ /// export type LSPObject = { [key: string]: LSPAny };
+ /// export type LSPArray = LSPAny[];
+ /// ```
+ /// -> `'Data` must adhere to specs
+ Data: 'Data option
}
/// Client workspace capabilities specific to inlay hints.
From ed2dd4d481d52b2004d8505544228bdff1caa933 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Wed, 11 May 2022 19:41:10 +0200
Subject: [PATCH 04/29] Add SyntaxTraversal from FCS
Necessary because of bugs and missing features:
* Doesn't go into `SynMatchClause`
* Fixed in `dotnet/fsharp` main, but not in just released FCS `41.0.4` (I think)
* Doesn't walk into `SynPat.As` & `SynPat.Record`
* `SynPat.As` gets visited in `dotnet/fsharp` main, not not in FCS `41.0.4`
* `SynPat.Record`: dotnet/fsharp#13114
-> Remove `ServiceParseTreeWalk` once FCS gets updated (probably `42.0`? -> lots of changes of Syntax Elements)
---
.../FsAutoComplete.Core.fsproj | 1 +
.../Workaround/ServiceParseTreeWalk.fs | 834 ++++++++++++++++++
2 files changed, 835 insertions(+)
create mode 100644 src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
diff --git a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj
index 6f864500d..faec87e16 100644
--- a/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj
+++ b/src/FsAutoComplete.Core/FsAutoComplete.Core.fsproj
@@ -8,6 +8,7 @@
+
diff --git a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
new file mode 100644
index 000000000..33f2fbf85
--- /dev/null
+++ b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
@@ -0,0 +1,834 @@
+/// Current (and older) FCS Visitors don't walk into into `SynMatchClause`s in `SynExpr.Match` (at least not into their patterns)
+/// -> Cannot walk to `SynPat.Named` inside Match Case
+///
+/// That's fixed in `main` FCS
+/// -> This here is a copy of [`ServiceParseTreeWalk.fs`@`3a610e0`](https://github.com/dotnet/fsharp/blob/3a610e06d07f47f405168be5ea05495d48fcec6d/src/fsharp/service/ServiceParseTreeWalk.fs) with slight adjustments so it compiles
+///
+/// **Remove once it's available as nuget package and updated here in FSAC**
+///
+/// Additional: `traversePat.defaultTraverse` walks down `SynPat.As` & `SynPat.Record` (see dotnet/fsharp#13114)
+module internal FsAutoComplete.Core.Workaround.ServiceParseTreeWalk
+//TODO: Use FSC once newer nuget package is available
+
+open FSharp.Compiler.Syntax
+open FSharp.Compiler.Text
+open FSharp.Compiler.Text.Position
+open FSharp.Compiler.Text.Range
+
+
+type private Range with
+ member m.ToShortString() = sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn
+
+let rec private stripParenTypes synType =
+ match synType with
+ | SynType.Paren (innerType, _) -> stripParenTypes innerType
+ | _ -> synType
+
+let private (|StripParenTypes|) synType =
+ stripParenTypes synType
+
+[]
+type SyntaxVisitorBase<'T>() =
+ abstract VisitExpr: path: SyntaxVisitorPath * traverseSynExpr: (SynExpr -> 'T option) * defaultTraverse: (SynExpr -> 'T option) * synExpr: SynExpr -> 'T option
+ default _.VisitExpr(path: SyntaxVisitorPath, traverseSynExpr: SynExpr -> 'T option, defaultTraverse: SynExpr -> 'T option, synExpr: SynExpr) =
+ ignore (path, traverseSynExpr, defaultTraverse, synExpr)
+ None
+
+ /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
+ abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
+ default _.VisitTypeAbbrev(path, synType, range) =
+ ignore (path, synType, range)
+ None
+
+ /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
+ abstract VisitImplicitInherit: path: SyntaxVisitorPath * defaultTraverse: (SynExpr -> 'T option) * inheritedType: SynType * synArgs: SynExpr * range: range -> 'T option
+ default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
+ ignore (path, inheritedType, range)
+ defaultTraverse synArgs
+
+ /// VisitModuleDecl allows overriding module declaration behavior
+ abstract VisitModuleDecl: path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
+ default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
+ ignore path
+ defaultTraverse synModuleDecl
+
+ /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
+ abstract VisitBinding: path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
+ default _.VisitBinding(path, defaultTraverse, synBinding) =
+ ignore path
+ defaultTraverse synBinding
+
+ /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
+ abstract VisitMatchClause: path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
+ default _.VisitMatchClause(path, defaultTraverse, matchClause) =
+ ignore path
+ defaultTraverse matchClause
+
+ /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
+ abstract VisitInheritSynMemberDefn: path: SyntaxVisitorPath * componentInfo: SynComponentInfo * typeDefnKind: SynTypeDefnKind * SynType * SynMemberDefns * range -> 'T option
+ default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
+ ignore (path, componentInfo, typeDefnKind, synType, members, range)
+ None
+
+ /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
+ abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
+ default _.VisitRecordDefn(path, fields, range) =
+ ignore (path, fields, range)
+ None
+
+ /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
+ abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
+ default _.VisitUnionDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
+ abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
+ default _.VisitEnumDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
+ abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
+ default _.VisitInterfaceSynMemberDefnType(path, synType) =
+ ignore (path, synType)
+ None
+
+ /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
+ abstract VisitRecordField: path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: LongIdentWithDots option -> 'T option
+ default _.VisitRecordField (path, copyOpt, recordField) =
+ ignore (path, copyOpt, recordField)
+ None
+
+ /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
+ abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
+ default _.VisitHashDirective (path, hashDirective, range) =
+ ignore (path, hashDirective, range)
+ None
+
+ /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
+ abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
+ default _.VisitModuleOrNamespace (path, synModuleOrNamespace) =
+ ignore (path, synModuleOrNamespace)
+ None
+
+ /// VisitComponentInfo allows overriding behavior when visiting type component infos
+ abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
+ default _.VisitComponentInfo (path, synComponentInfo) =
+ ignore (path, synComponentInfo)
+ None
+
+ /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
+ abstract VisitLetOrUse: path: SyntaxVisitorPath * isRecursive: bool * defaultTraverse: (SynBinding -> 'T option) * bindings: SynBinding list * range: range -> 'T option
+ default _.VisitLetOrUse (path, isRecursive, defaultTraverse, bindings, range) =
+ ignore (path, isRecursive, defaultTraverse, bindings, range)
+ None
+
+ /// VisitType allows overriding behavior when visiting simple pats
+ abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
+ default _.VisitSimplePats (path, synPats) =
+ ignore (path, synPats)
+ None
+
+ /// VisitPat allows overriding behavior when visiting patterns
+ abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
+ default _.VisitPat (path, defaultTraverse, synPat) =
+ ignore path
+ defaultTraverse synPat
+
+ /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
+ abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
+ default _.VisitType (path, defaultTraverse, synType) =
+ ignore path
+ defaultTraverse synType
+
+/// A range of utility functions to assist with traversing an AST
+module SyntaxTraversal =
+
+ // treat ranges as though they are half-open: [,)
+ let rangeContainsPosLeftEdgeInclusive (m1:range) p =
+ if posEq m1.Start m1.End then
+ // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
+ // we treat the range [n,n) as containing position n
+ posGeq p m1.Start &&
+ posGeq m1.End p
+ else
+ posGeq p m1.Start && // [
+ posGt m1.End p // )
+
+ // treat ranges as though they are fully open: (,)
+ let rangeContainsPosEdgesExclusive (m1:range) p = posGt p m1.Start && posGt m1.End p
+
+ let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1:range) p = posGt p m1.Start && posGeq m1.End p
+
+ let dive node range project =
+ range,(fun() -> project node)
+
+ let pick pos (outerRange:range) (debugObj:obj) (diveResults:list) =
+ match diveResults with
+ | [] -> None
+ | _ ->
+ let isOrdered =
+#if DEBUG
+ // ranges in a dive-and-pick group should be ordered
+ diveResults |> Seq.pairwise |> Seq.forall (fun ((r1,_),(r2,_)) -> posGeq r2.Start r1.End)
+#else
+ true
+#endif
+ if not isOrdered then
+ let s = sprintf "ServiceParseTreeWalk: not isOrdered: %A" (diveResults |> List.map (fun (r,_) -> r.ToShortString()))
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let outerContainsInner =
+#if DEBUG
+ // ranges in a dive-and-pick group should be "under" the thing that contains them
+ let innerTotalRange = diveResults |> List.map fst |> List.reduce unionRanges
+ rangeContainsRange outerRange innerTotalRange
+#else
+ ignore(outerRange)
+ true
+#endif
+ if not outerContainsInner then
+ let s = sprintf "ServiceParseTreeWalk: not outerContainsInner: %A : %A" (outerRange.ToShortString()) (diveResults |> List.map (fun (r,_) -> r.ToShortString()))
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let isZeroWidth(r:range) =
+ posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
+ match List.choose (fun (r,f) -> if rangeContainsPosLeftEdgeInclusive r pos && not(isZeroWidth r) then Some(f) else None) diveResults with
+ | [] ->
+ // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
+ // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
+ let mutable e = diveResults.Head
+ for r in diveResults do
+ if posGt pos (fst r).Start then
+ e <- r
+ snd(e)()
+ | [x] -> x()
+ | _ ->
+#if DEBUG
+ assert false
+ failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
+#else
+ ignore debugObj
+ None
+#endif
+
+ /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
+ ///
+ let Traverse(pos:pos, parseTree, visitor:SyntaxVisitorBase<'T>) =
+ let pick x = pick pos x
+ let rec traverseSynModuleDecl origPath (decl:SynModuleDecl) =
+ let pick = pick decl.Range
+ let defaultTraverse m =
+ let path = SyntaxNode.SynModule m :: origPath
+ match m with
+ | SynModuleDecl.ModuleAbbrev(_ident, _longIdent, _range) -> None
+ | SynModuleDecl.NestedModule(decls=synModuleDecls) -> synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick decl
+ | SynModuleDecl.Let(isRecursive, synBindingList, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick decl
+ // | SynModuleDecl.Expr(synExpr, _range) -> traverseSynExpr path synExpr
+ | SynModuleDecl.DoExpr(_, synExpr, _range) -> traverseSynExpr path synExpr
+ | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl
+ | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None
+ | SynModuleDecl.Open(_target, _range) -> None
+ | SynModuleDecl.Attributes(_synAttributes, _range) -> None
+ | SynModuleDecl.HashDirective(parsedHashDirective, range) -> visitor.VisitHashDirective (path, parsedHashDirective, range)
+ | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace
+ visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
+
+ and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace(_longIdent, _isRec, _isModule, synModuleDecls, _preXmlDoc, _synAttributes, _synAccessOpt, range) as mors) =
+ match visitor.VisitModuleOrNamespace(origPath, mors) with
+ | Some x -> Some x
+ | None ->
+ let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
+ synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors
+
+ and traverseSynExpr origPath (expr:SynExpr) =
+ let pick = pick expr.Range
+ let defaultTraverse e =
+ let path = SyntaxNode.SynExpr e :: origPath
+ let traverseSynExpr = traverseSynExpr path
+ let traverseSynType = traverseSynType path
+ let traversePat = traversePat path
+ match e with
+
+ | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
+
+ | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
+ [//dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.Const (_synConst, _range) -> None
+
+ | SynExpr.InterpolatedString (parts, _, _) ->
+ [ for part in parts do
+ match part with
+ | SynInterpolatedStringPart.String _ -> ()
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) ->
+ yield dive fillExpr fillExpr.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Typed (synExpr, synType, _range) ->
+ match traverseSynExpr synExpr with
+ | None -> traverseSynType synType
+ | x -> x
+
+ | SynExpr.Tuple (_, synExprList, _, _range)
+ | SynExpr.ArrayOrList (_, synExprList, _range) ->
+ synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr
+
+ | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
+ [ match copyOpt with
+ | Some(expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+ yield dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField (path, Some expr, None)
+ else
+ None
+ )
+ | _ -> ()
+ for _, _, x in synExprList do
+ yield dive x x.Range traverseSynExpr
+ ] |> pick expr
+
+ | SynExpr.Record (inheritOpt,copyOpt,fields, _range) ->
+ [
+ let diveIntoSeparator offsideColumn scPosOpt copyOpt =
+ match scPosOpt with
+ | Some scPos ->
+ if posGeq pos scPos then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else None
+ | None ->
+ //semicolon position is not available - use offside rule
+ if pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else None
+
+ match inheritOpt with
+ | Some(_ty,expr, _range, sepOpt, inheritRange) ->
+ // dive into argument
+ yield dive expr expr.Range (fun expr ->
+ // special-case:caret is located in the offside position below inherit
+ // inherit A()
+ // $
+ if not (rangeContainsPos expr.Range pos) && sepOpt.IsNone && pos.Column = inheritRange.StartColumn then
+ visitor.VisitRecordField(path, None, None)
+ else
+ traverseSynExpr expr
+ )
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield dive () sep (fun () ->
+ // special case: caret is below 'inherit' + one or more fields are already defined
+ // inherit A()
+ // $
+ // field1 = 5
+ diveIntoSeparator inheritRange.StartColumn scPosOpt None
+ )
+ | None -> ()
+ | _ -> ()
+ match copyOpt with
+ | Some(expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+ yield dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField (path, Some expr, None)
+ else
+ None
+ )
+ | _ -> ()
+ let copyOpt = Option.map fst copyOpt
+ for SynExprRecordField(fieldName=(field, _); expr=e; blockSeparator=sepOpt) in fields do
+ yield dive (path, copyOpt, Some field) field.Range (fun r ->
+ if rangeContainsPos field.Range pos then
+ visitor.VisitRecordField r
+ else
+ None
+ )
+ let offsideColumn =
+ match inheritOpt with
+ | Some(_,_, _, _, inheritRange) -> inheritRange.StartColumn
+ | None -> field.Range.StartColumn
+
+ match e with
+ | Some e -> yield dive e e.Range (fun expr ->
+ // special case: caret is below field binding
+ // field x = 5
+ // $
+ if not (rangeContainsPos e.Range pos) && sepOpt.IsNone && pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None)
+ else
+ traverseSynExpr expr
+ )
+ | None -> ()
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield dive () sep (fun () ->
+ // special case: caret is between field bindings
+ // field1 = 5
+ // $
+ // field2 = 5
+ diveIntoSeparator offsideColumn scPosOpt copyOpt
+ )
+ | _ -> ()
+
+ ] |> pick expr
+
+ | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
+ | SynExpr.ObjExpr (objType=ty; argOptions=baseCallOpt; bindings=binds; members=ms; extraImpls=ifaces) ->
+ let unionBindingAndMembers (bindings: SynBinding list) (members: SynMemberDefn list): SynBinding list =
+ [ yield! bindings
+ yield! List.choose (function | SynMemberDefn.Member(b,_) -> Some b | _ -> None) members ]
+ let binds = unionBindingAndMembers binds ms
+ let result =
+ ifaces
+ |> Seq.map (fun (SynInterfaceImpl(interfaceTy=ty)) -> ty)
+ |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
+
+ if result.IsSome then
+ result
+ else
+ [
+ match baseCallOpt with
+ | Some(expr,_) ->
+ // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
+ let newCall = SynExpr.New (false, ty, expr, unionRanges ty.Range expr.Range)
+ yield dive newCall newCall.Range traverseSynExpr
+ | _ -> ()
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
+ for SynInterfaceImpl(bindings=binds) in ifaces do
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
+ ] |> pick expr
+
+ | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.For (identBody=synExpr; toBody=synExpr2; doBody=synExpr3) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
+ [dive synPat synPat.Range traversePat
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ComputationExpr (_, synExpr, _range) ->
+ // now parser treats this syntactic expression as computation expression
+ // { identifier }
+ // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
+ // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
+ let isPartOfArrayOrList =
+ match origPath with
+ | SyntaxNode.SynExpr(SynExpr.ArrayOrListComputed _) :: _ -> true
+ | _ -> false
+ let ok =
+ match isPartOfArrayOrList, synExpr with
+ | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some (LongIdentWithDots([ident], [])))
+ | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
+ | _ -> None
+ if ok.IsSome then ok
+ else
+ traverseSynExpr synExpr
+
+ | SynExpr.Lambda (args=synSimplePats; body=synExpr) ->
+ match synSimplePats with
+ | SynSimplePats.SimplePats(pats,_) ->
+ match visitor.VisitSimplePats(path, pats) with
+ | None -> traverseSynExpr synExpr
+ | x -> x
+ | _ -> traverseSynExpr synExpr
+
+ | SynExpr.MatchLambda (_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) ->
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ |> pick expr
+
+ | SynExpr.Match (expr=synExpr; clauses=synMatchClauseList) ->
+ [yield dive synExpr synExpr.Range traverseSynExpr
+ yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
+ |> pick expr
+
+ | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
+
+ | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
+ if isInfix then
+ [dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr synExpr.Range traverseSynExpr] // reverse the args
+ |> pick expr
+ else
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | None ->
+ [yield! synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ yield dive synExpr synExpr.Range traverseSynExpr]
+ |> pick expr
+ | x -> x
+
+ | SynExpr.TryWith (tryExpr=synExpr; withCases=synMatchClauseList) ->
+ [yield dive synExpr synExpr.Range traverseSynExpr
+ yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
+ |> pick expr
+
+ | SynExpr.TryFinally (tryExpr=synExpr; finallyExpr=synExpr2) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
+
+ | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.IfThenElse (ifExpr=synExpr; thenExpr=synExpr2; elseExpr=synExprOpt) ->
+ [yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ match synExprOpt with
+ | None -> ()
+ | Some x -> yield dive x x.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.Ident _ident -> None
+
+ | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
+
+ | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Set (synExpr, synExpr2, _)
+
+ | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
+ [ match expr1 with Some e -> dive e e.Range traverseSynExpr | None -> ()
+ match expr2 with Some e -> dive e e.Range traverseSynExpr | None -> () ]
+ |> pick expr
+
+ | SynExpr.IndexFromEnd (e, _) ->
+ traverseSynExpr e
+
+ | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
+ [yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
+ [yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
+ [dive synExpr1 synExpr1.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr]
+ |> pick expr
+
+ | SynExpr.TypeTest (synExpr, synType, _range)
+
+ | SynExpr.Upcast (synExpr, synType, _range)
+
+ | SynExpr.Downcast (synExpr, synType, _range) ->
+ [dive synExpr synExpr.Range traverseSynExpr
+ dive synType synType.Range traverseSynType]
+ |> pick expr
+
+ | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Null _range -> None
+
+ | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
+
+ | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ImplicitZero _range -> None
+
+ | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUseBang(pat=synPat; rhs=synExpr; andBangs=andBangSynExprs; body=synExpr2) ->
+ [
+ yield dive synPat synPat.Range traversePat
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ [ for SynExprAndBang(pat=andBangSynPat; body=andBangSynExpr) in andBangSynExprs do
+ yield (dive andBangSynPat andBangSynPat.Range traversePat)
+ yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)]
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.MatchBang (expr=synExpr; clauses=synMatchClauseList) ->
+ [yield dive synExpr synExpr.Range traverseSynExpr
+ yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
+ |> pick expr
+
+ | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LibraryOnlyILAssembly _ -> None
+
+ | SynExpr.LibraryOnlyStaticOptimization _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
+
+ | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
+
+ | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
+
+ visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
+
+ and traversePat origPath (pat: SynPat) =
+ let defaultTraverse p =
+ let path = SyntaxNode.SynPat p :: origPath
+ match p with
+ | SynPat.Paren (p, _) -> traversePat path p
+ | SynPat.Or (p1, p2, _, _) -> [ p1; p2] |> List.tryPick (traversePat path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
+ | SynPat.Attrib (p, _, _) -> traversePat path p
+ | SynPat.LongIdent(argPats=args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
+ | SynArgPats.NamePatPairs (ps, _) ->
+ ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path)
+ | SynPat.Typed (p, ty, _) ->
+ match traversePat path p with
+ | None -> traverseSynType path ty
+ | x -> x
+ //TODO: added
+ | SynPat.As (lhsPat=lhs; rhsPat=rhs) ->
+ [lhs; rhs] |> List.tryPick (traversePat path)
+ //TODO: added
+ | SynPat.Record (fieldPats=fieldPats) ->
+ fieldPats
+ |> List.map (fun (_,_,pat) -> pat)
+ |> List.tryPick (traversePat path)
+ | _ -> None
+
+ visitor.VisitPat (origPath, defaultTraverse, pat)
+
+ and traverseSynType origPath (StripParenTypes ty) =
+ let defaultTraverse ty =
+ let path = SyntaxNode.SynType ty :: origPath
+ match ty with
+ | SynType.App (typeName, _, typeArgs, _, _, _, _)
+ | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
+ [ yield typeName
+ yield! typeArgs ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.Fun (ty1, ty2, _) -> [ty1; ty2] |> List.tryPick (traverseSynType path)
+ | SynType.MeasurePower (ty, _, _)
+ | SynType.HashConstraint (ty, _)
+ | SynType.WithGlobalConstraints (ty, _, _)
+ | SynType.Array (_, ty, _) -> traverseSynType path ty
+ | SynType.StaticConstantNamed (ty1, ty2, _)
+ | SynType.MeasureDivide (ty1, ty2, _) -> [ty1; ty2] |> List.tryPick (traverseSynType path)
+ | SynType.Tuple (_, tys, _) -> tys |> List.map snd |> List.tryPick (traverseSynType path)
+ | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
+ | SynType.Anon _ -> None
+ | _ -> None
+
+ visitor.VisitType (origPath, defaultTraverse, ty)
+
+ and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit (synMemberDefns:SynMemberDefns) =
+ synMemberDefns
+ // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
+ |> Seq.groupBy (fun x -> x.Range)
+ |> Seq.choose (fun (r, mems) ->
+ match mems |> Seq.toList with
+ | [mem] -> // the typical case, a single member has this range 'r'
+ Some (dive mem r (traverseSynMemberDefn path traverseInherit))
+ | [SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid1; extraId=Some(info1)))) as mem1
+ SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid2; extraId=Some(info2)))) as mem2] -> // can happen if one is a getter and one is a setter
+ // ensure same long id
+ assert( (lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText) )
+ // ensure one is getter, other is setter
+ assert( (info1.idText="set" && info2.idText="get") ||
+ (info2.idText="set" && info1.idText="get") )
+ Some (
+ r,(fun() ->
+ // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
+ match traverseSynMemberDefn path (fun _ -> None) mem1 with
+ | Some _ as x -> x
+ | _ -> traverseSynMemberDefn path (fun _ -> None) mem2 )
+ )
+ | [] ->
+#if DEBUG
+ assert false
+ failwith "impossible, Seq.groupBy never returns empty results"
+#else
+ // swallow AST error and recover silently
+ None
+#endif
+ | _ ->
+#if DEBUG
+ assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
+ failwith "bug in AST"
+#else
+ // swallow AST error and recover silently
+ None
+#endif
+ )
+
+ and traverseSynTypeDefn origPath (SynTypeDefn(synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef) =
+ let path = SyntaxNode.SynTypeDefn tydef :: origPath
+
+ match visitor.VisitComponentInfo (origPath, synComponentInfo) with
+ | Some x -> Some x
+ | None ->
+ [
+ match synTypeDefnRepr with
+ | SynTypeDefnRepr.Exception _ ->
+ // This node is generated in CheckExpressions.fs, not in the AST.
+ // But note exception declarations are missing from this tree walk.
+ ()
+ | SynTypeDefnRepr.ObjectModel(synTypeDefnKind, synMemberDefns, _oRange) ->
+ // traverse inherit function is used to capture type specific data required for processing Inherit part
+ let traverseInherit (synType: SynType, range: range) =
+ visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
+ yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
+ | SynTypeDefnRepr.Simple(synTypeDefnSimpleRepr, _range) ->
+ match synTypeDefnSimpleRepr with
+ | SynTypeDefnSimpleRepr.Record(_synAccessOption, fields, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
+ | SynTypeDefnSimpleRepr.Union(_synAccessOption, cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.Enum(cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.TypeAbbrev(_, synType, m) ->
+ yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
+ | _ ->
+ ()
+ yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None)
+ ] |> pick tRange tydef
+
+ and traverseSynMemberDefn path traverseInherit (m:SynMemberDefn) =
+ let pick (debugObj:obj) = pick m.Range debugObj
+ let path = SyntaxNode.SynMemberDefn m :: path
+ match m with
+ | SynMemberDefn.Open(_longIdent, _range) -> None
+ | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding
+ | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
+ match simplePats with
+ | SynSimplePats.SimplePats(simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
+ | _ -> None
+ | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) ->
+ [
+ dive () synType.Range (fun () ->
+ match traverseInherit (synType, range) with
+ | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
+ | x -> x)
+ dive () synExpr.Range (fun() ->
+ visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
+ )
+ ] |> pick m
+ | SynMemberDefn.AutoProperty(synExpr=synExpr) -> traverseSynExpr path synExpr
+ | SynMemberDefn.LetBindings(synBindingList, isRecursive, _, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick m
+ | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None
+ | SynMemberDefn.Interface(interfaceType=synType; members=synMemberDefnsOption) ->
+ match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
+ | None ->
+ match synMemberDefnsOption with
+ | None -> None
+ | Some(x) -> [ yield! x |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick x
+ | ok -> ok
+ | SynMemberDefn.Inherit(synType, _identOption, range) -> traverseInherit (synType, range)
+ | SynMemberDefn.ValField(_synField, _range) -> None
+ | SynMemberDefn.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
+
+ and traverseSynMatchClause origPath mc =
+ let defaultTraverse mc =
+ let path = SyntaxNode.SynMatchClause mc :: origPath
+ match mc with
+ | SynMatchClause(pat=synPat; whenExpr=synExprOption; resultExpr=synExpr) as all ->
+ [dive synPat synPat.Range (traversePat path) ]
+ @
+ ([
+ match synExprOption with
+ | None -> ()
+ | Some guard -> yield guard
+ yield synExpr
+ ]
+ |> List.map (fun x -> dive x x.Range (traverseSynExpr path))
+ )|> pick all.Range all
+ visitor.VisitMatchClause(origPath, defaultTraverse, mc)
+
+ and traverseSynBinding origPath b =
+ let defaultTraverse b =
+ let path = SyntaxNode.SynBinding b :: origPath
+ match b with
+ | SynBinding(headPat=synPat; expr=synExpr) ->
+ match traversePat path synPat with
+ | None -> traverseSynExpr path synExpr
+ | x -> x
+ visitor.VisitBinding(origPath, defaultTraverse ,b)
+
+ match parseTree with
+ | ParsedInput.ImplFile (ParsedImplFileInput (modules = l))->
+ let fileRange =
+#if DEBUG
+ match l with [] -> range0 | _ -> l |> List.map (fun x -> x.Range) |> List.reduce unionRanges
+#else
+ range0 // only used for asserting, does not matter in non-debug
+#endif
+ l |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace [])) |> pick fileRange l
+ | ParsedInput.SigFile _sigFile -> None
From 623190f02e42a5528e17843a0f03826654ead660 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Thu, 12 May 2022 11:22:01 +0200
Subject: [PATCH 05/29] Add `textDocument/inlayHint` & `inlayHint/resolve`
Change InlayHints to use multiple inserts instead of just single one
-> for parens
Enhance logic to determine edits to add explicit type should include parens or not
Note: not yet every possible position tests -> might still trigger for unwanted location
Use same logic for `InlayHint`s & `AddExplicitTypeToParameter`
Note: trigger logic was slightly changed (-> less tests, but more complex check for explicit type which includes some trigger logic)
-> not sure there are locations hints are missings or hints are shown when they shouldn't -> needs more tests
TODO: change name of `AddExplicitTypeToParameter`
-> Isn't limited to parameter any more but all (non-function) bindings
Note: No tests yet for `textDocument/inlayHint` & `inlayHint/resolve`
Note: Tooltips for InlayHints aren't yet implemented
Note: several tests fail: Existing InlayHint tests aren't updated to handle TextEdits
Note: still unfinished and lots of TODOs and necessary tests
Note: `inlayHint/resolve` isn't really necessary: `TextEdit`s get currently created when creating InlayHint (-> because needs Explicit Type checks which produce everything necessary for `TextEdit`s)
Note: No InlayHints Capabilities handling or checking
Note: Because of rebase: Remove `LSP.Preview.fs`
---
src/FsAutoComplete.Core/InlayHints.fs | 579 ++++++++++--
.../CodeFixes/AddExplicitTypeToParameter.fs | 189 ++--
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 151 +++-
src/FsAutoComplete/FsAutoComplete.fsproj | 1 -
src/FsAutoComplete/LSP.Preview.fs | 146 ---
.../AddExplicitTypeToParameterTests.fs | 100 +++
.../InlayHintTests.fs | 834 +++++++++++++++++-
7 files changed, 1675 insertions(+), 325 deletions(-)
delete mode 100644 src/FsAutoComplete/LSP.Preview.fs
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 5039df33c..0408ca74e 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -10,16 +10,26 @@ open FSharp.UMX
open System.Linq
open System.Collections.Immutable
open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.Text.Range
+open FsAutoComplete.Core.Workaround.ServiceParseTreeWalk
type HintKind =
| Parameter
| Type
-type Hint =
- { Text: string
- InsertText: string option
- Pos: Position
- Kind: HintKind }
+type HintInsertion = {
+ Pos: Position
+ Text: string
+}
+type Hint = {
+ IdentRange: Range
+ Kind: HintKind
+ Pos: Position
+ Text: string
+ Insertions: HintInsertion[] option
+ //TODO: allow xml doc
+ Tooltip: string option
+}
let private getArgumentsFor (state: FsAutoComplete.State, p: ParseAndCheckResults, identText: Range) =
option {
@@ -101,22 +111,19 @@ let truncated (s: string) =
else
s
-let private createParamHint (range: Range) (paramName: string) =
+let private createParamHint
+ (identRange: Range)
+ (paramName: string)
+ =
let format p = p + " ="
-
- { Text = format (truncated paramName)
- InsertText = None
- Pos = range.Start
- Kind = Parameter }
-
-let private createTypeHint (range: Range) (ty: FSharpType) (displayContext: FSharpDisplayContext) =
- let ty = ty.Format displayContext
- let format ty = ": " + ty
-
- { Text = format (truncated ty)
- InsertText = Some(format ty)
- Pos = range.End
- Kind = Type }
+ {
+ IdentRange = identRange
+ Pos = identRange.Start
+ Kind = Parameter
+ Text = format (truncated paramName)
+ Insertions = None
+ Tooltip = None
+ }
module private ShouldCreate =
let private isNotWellKnownName =
@@ -314,46 +321,516 @@ module private ShouldCreate =
&& (not (isParamNamePostfixOfFuncName func p.DisplayName))
-let provideHints (text: NamedText, p: ParseAndCheckResults, range: Range) : Async =
+type TypeName = string
+type TypeNameForAnnotation = TypeName
+type SpecialRule =
+ /// For Optional: `?v` -> `?v: int`, NOT `v: int option`
+ /// And parens must include optional, not just `v`
+ | RemoveOptionFromType
+type SpecialRules = SpecialRule list
+[]
+type Parens =
+ | Forbidden
+ /// Technically `Optional` too: Usually additional parens are ok
+ ///
+ /// Note: `additionalParens` are inside of existing parens:
+ /// `(|ident|)`
+ /// * `()`: existing parens
+ /// * `||`: additional parens location
+ | Exist of additionalParens:Range
+ | Optional of Range
+ | Required of Range
+type MissingExplicitType =
+ {
+ Ident: Range
+ InsertAt: Position
+ Parens: Parens
+ SpecialRules: SpecialRules
+ }
+type MissingExplicitType with
+ ///
+ /// * type name
+ /// * type name formatted with `SpecialRules`
+ /// -> to use as type annotation
+ ///
+ member x.FormatType (ty: FSharpType, displayContext: FSharpDisplayContext) : TypeName*TypeNameForAnnotation =
+ //TODO: Format vs FormatWithConstraints?
+ let typeName = ty.Format displayContext
+ let anno =
+ if x.SpecialRules |> List.contains RemoveOptionFromType then
+ // Optional parameter:
+ // `static member F(?a) =` -> `: int`, NOT `: int option`
+ if typeName.EndsWith " option" then
+ typeName.Substring(0, typeName.Length - " option".Length)
+ else
+ // TODO: always just trailing `option`? or can be `Option`? -- maybe even with Namespace?
+ typeName
+ else
+ typeName
+ (typeName, anno)
+
+ member x.CreateEdits (typeForAnnotation) =
+ [|
+ match x.Parens with
+ | Parens.Required range ->
+ { Pos = range.Start; Text = "(" }
+ | _ -> ()
+
+ { Pos = x.InsertAt; Text = ": " }
+ { Pos = x.InsertAt; Text = typeForAnnotation }
+
+ match x.Parens with
+ | Parens.Required range ->
+ { Pos = range.End; Text = ")" }
+ | _ -> ()
+ |]
+ member x.TypeAndEdits (ty: FSharpType, displayContext: FSharpDisplayContext) =
+ let (ty, tyForAnntotation) = x.FormatType (ty, displayContext)
+ let edits = x.CreateEdits (tyForAnntotation)
+ (ty, edits)
+ /// Note: No validation of `mfv`!
+ member x.TypeAndEdits (mfv: FSharpMemberOrFunctionOrValue, displayContext: FSharpDisplayContext) =
+ x.TypeAndEdits (mfv.FullType, displayContext)
+
+
+/// Note: Missing considers only directly typed, not parently (or ancestorly) typed:
+/// ```fsharp
+/// let (value: int, _) = (1,2)
+/// // ^^^^^ directly typed -> Exists
+/// let (value,_): int*int = (1,2)
+/// // ^^^ parently typed -> Missing
+/// ```
+[]
+type ExplicitType =
+ /// in for loop (only indent allowed -- nothing else (neither type nor parens))
+ | Invalid
+ | Exists
+ | Missing of MissingExplicitType
+ //TODO: remove
+ | Debug of string
+
+type ExplicitType with
+ member x.TryGetTypeAndEdits (ty: FSharpType, displayContext: FSharpDisplayContext) =
+ match x with
+ | ExplicitType.Missing data ->
+ data.TypeAndEdits (ty, displayContext)
+ |> Some
+ | _ -> None
+
+/// Type Annotation must be directly for identifier, not somewhere up the line:
+/// `v: int` -> directly typed
+/// `(v,_): int*int` -> parently typed
+///
+/// Still considered directly typed:
+/// * Parentheses: `(v): int`
+/// * Attributes: `([]v): int`
+let rec private isDirectlyTyped (identStart: Position) (path: SyntaxVisitorPath) =
+ //TODO: handle SynExpr.Typed? -> not at binding, but usage
+ match path with
+ | [] -> false
+ | SyntaxNode.SynPat (SynPat.Typed (pat=pat)) :: _ when rangeContainsPos pat.Range identStart ->
+ true
+ | SyntaxNode.SynPat (SynPat.Paren _) :: path ->
+ isDirectlyTyped identStart path
+ | SyntaxNode.SynPat (SynPat.Attrib (pat=pat)) :: path when rangeContainsPos pat.Range identStart ->
+ isDirectlyTyped identStart path
+ | SyntaxNode.SynBinding (SynBinding (headPat=headPat; returnInfo=Some(SynBindingReturnInfo(typeName=SynType.LongIdent(_))))) :: _ when rangeContainsPos headPat.Range identStart ->
+ true
+ | SyntaxNode.SynExpr (SynExpr.Paren _) :: path ->
+ isDirectlyTyped identStart path
+ | SyntaxNode.SynExpr (SynExpr.Typed (expr=expr)) :: _ when rangeContainsPos expr.Range identStart ->
+ true
+ | _ -> false
+
+/// Note: FULL range of pattern -> everything in parens
+/// For `SynPat.Named`: Neither `range` nor `ident.idRange` span complete range: Neither includes Accessibility:
+/// `let private (a: int)` is not valid, must include private: `let (private a: int)`
+let rec private getParsenForPatternWithIdent (patternRange: Range) (identStart: Position) (path: SyntaxVisitorPath) =
+ match path with
+ | SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
+ // (x)
+ Parens.Exist patternRange
+ | SyntaxNode.SynBinding (SynBinding(headPat=headPat)) :: _ when rangeContainsPos headPat.Range identStart ->
+ // let x =
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.Tuple (isStruct=true)) :: _ ->
+ // struct (x,y)
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.Tuple _) :: SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
+ // (x,y)
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.Tuple _) :: _ ->
+ // x,y
+ Parens.Required patternRange
+ | SyntaxNode.SynPat (SynPat.ArrayOrList _) :: _ ->
+ // [x;y;z]
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As (rhsPat=pat)) :: _ when rangeContainsPos pat.Range identStart ->
+ // _ as (value: int)
+ Parens.Required patternRange
+ | SyntaxNode.SynPat (SynPat.As (lhsPat=pat)) :: _ when rangeContainsPos pat.Range identStart ->
+ // value: int as _
+ // ^^^^^^^^^^ unlike rhs this here doesn't require parens...
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.Record _) :: _ ->
+ // { Value=value }
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.LongIdent (argPats=SynArgPats.NamePatPairs (range=range))) :: _ when rangeContainsPos range identStart ->
+ // U (Value=value)
+ // ^ ^
+ // must exist to be valid
+ Parens.Optional patternRange
+ | SyntaxNode.SynExpr (SynExpr.LetOrUseBang (isUse=true)) :: _ ->
+ // use! x =
+ // Note: Type is forbidden too...
+ Parens.Forbidden
+ | SyntaxNode.SynExpr (SynExpr.LetOrUseBang (isUse=false)) :: _ ->
+ // let! x =
+ Parens.Required patternRange
+ | SyntaxNode.SynExpr (SynExpr.ForEach _) :: _ ->
+ // for i in [1..4] do
+ Parens.Optional patternRange
+ | [] // should not happen?
+ | _ ->
+ Parens.Required patternRange
+
+/// Gets range of `SynPat.Named`
+///
+/// Issue with range of `SynPat.Named`:
+/// `pat.range` only covers ident (-> `= ident.idRange`),
+/// not `accessibility`.
+///
+/// Note: doesn't handle when accessibility is on prev line
+let private rangeOfNamedPat (text: NamedText) (pat: SynPat) =
+ match pat with
+ | SynPat.Named (accessibility=None) ->
+ pat.Range
+ | SynPat.Named (ident=ident; accessibility=Some(access)) ->
+ maybe {
+ let start = ident.idRange.Start
+ let! line = text.GetLine start
+
+ let access = access.ToString().ToLowerInvariant().AsSpan()
+ // word before ident must be access
+ let pre = line.AsSpan(0, start.Column)
+ match pre.LastIndexOf(access) with
+ | -1 -> return! None
+ | c ->
+ // must be directly before ident
+ let word = pre.Slice(c).TrimEnd()
+ if word.Length = access.Length then
+ let start = Position.mkPos start.Line c
+ let range =
+ let range = ident.idRange
+ Range.mkRange range.FileName start range.End
+ return range
+ else
+ return! None
+ }
+ |> Option.defaultValue pat.Range
+ | _ -> failwith "Pattern must be Named!"
+
+/// Note: (deliberately) fails when `pat` is neither `Named` nor `OptionalVal`
+let rec private getParensForIdentPat (text: NamedText) (pat: SynPat) (path: SyntaxVisitorPath) =
+ match pat with
+ | SynPat.Named (ident=ident) ->
+ // neither `range`, not `pat.Range` includes `accessibility`...
+ // `let private (a: int)` is not valid, must include private: `let (private a: int)`
+ let patternRange = rangeOfNamedPat text pat
+ let identStart = ident.idRange.Start
+ getParsenForPatternWithIdent patternRange identStart path
+ | SynPat.OptionalVal (ident=ident) ->
+ let patternRange = pat.Range
+ let identStart = ident.idRange.Start
+ getParsenForPatternWithIdent patternRange identStart path
+ | _ -> failwith "Pattern must be Named or OptionalVal!"
+
+/// `traversePat`from `SyntaxTraversal.Traverse`
+///
+/// Reason for extra function:
+/// * can be used to traverse when traversal isn't available via `defaultTraverse` (for example: in `VisitExpr`, and want traverse a `SynPat`)
+/// * visits `SynPat.As(lhsPat, rhsPat)` & `SynPat.Record(fieldPats)`
+///
+/// Note: doesn't visit `SynPat.Typed(targetType)`: requires traversal into `SynType` (`SynPat.Typed(pat)` gets visited!)
+let rec private traversePat (visitor: SyntaxVisitorBase<_>) origPath pat =
+ let defaultTraverse p =
+ let path = SyntaxNode.SynPat p :: origPath
+ match p with
+ | SynPat.Paren (p, _) -> traversePat visitor path p
+ | SynPat.Or (p1, p2, _, _) -> [ p1; p2] |> List.tryPick (traversePat visitor path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat visitor path)
+ | SynPat.Attrib (p, _, _) -> traversePat visitor path p
+ | SynPat.LongIdent(argPats=args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat visitor path)
+ | SynArgPats.NamePatPairs (ps, _) ->
+ ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat visitor path)
+ | SynPat.Typed (p, _, _) ->
+ traversePat visitor path p
+ | SynPat.As (lhsPat=lhs; rhsPat=rhs) ->
+ [lhs; rhs] |> List.tryPick (traversePat visitor path)
+ | SynPat.Record (fieldPats=fieldPats) ->
+ fieldPats
+ |> List.map (fun (_,_,pat) -> pat)
+ |> List.tryPick (traversePat visitor path)
+ | _ -> None
+ visitor.VisitPat(origPath, defaultTraverse, pat)
+
+let tryGetExplicitTypeInfo
+ (text: NamedText, ast: ParsedInput)
+ (pos: Position)
+ : ExplicitType option
+ =
+ SyntaxTraversal.Traverse(pos, ast, { new SyntaxVisitorBase<_>() with
+ member x.VisitExpr(path, traverseSynExpr, defaultTraverse, expr) =
+ match expr with
+ // special case:
+ // for loop:
+ // for i = 1 to 3 do
+ // ^ -> just Ident (neither SynPat nor SynSimplePat)
+ // -> no type allowed (not even parens)...
+ | SynExpr.For (ident=ident) when rangeContainsPos ident.idRange pos ->
+ ExplicitType.Invalid
+ |> Some
+ | SynExpr.Lambda (parsedData=Some (args, body)) ->
+ // original visitor walks down `SynExpr.Lambda(args; body)`
+ // Issue:
+ // `args` are `SynSimplePats` -> no complex pattern
+ // When pattern: is in body. In `args` then generated Identifier:
+ // * `let f1 = fun v -> v + 1`
+ // -> `v` is in `args` (-> SynSimplePat)
+ // * `let f2 = fun (Value v) -> v + 1`
+ // -> compiler generated `_arg1` in `args`,
+ // and `v` is inside match expression in `body` & `parsedData` (-> `SynPat` )
+ // -> unify by looking into `parsedData` (-> args & body):
+ // -> `parsedData |> fst` contains `args` as `SynPat`
+ //TODO: always correct?
+ let arg =
+ args
+ |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
+ if arg |> Option.isSome then
+ let pat = arg.Value
+ traversePat x (SyntaxNode.SynExpr(expr)::path) pat
+ elif rangeContainsPos body.Range pos then
+ traverseSynExpr body
+ else
+ None
+ | _ -> defaultTraverse expr
+
+ member _.VisitPat(path, defaultTraverse, pat) =
+ let invalidPositionForTypeAnnotation (pos: Position) (path: SyntaxNode list) =
+ match path with
+ | SyntaxNode.SynExpr (SynExpr.LetOrUseBang (isUse=true)) :: _ ->
+ // use! value =
+ true
+ | _ -> false
+
+ //TODO: differentiate between directly typed and parently typed?
+ // (maybe even further ancestorly typed?)
+ // ```fsharp
+ // let (a: int,b) = (1,2)
+ // // ^^^ directly typed
+ // let (a,b): int*int = (1,2)
+ // // ^^^ parently typed
+ // ```
+ // currently: only directly typed is typed
+ match pat with
+ // no simple way out: Range for `SynPat.LongIdent` doesn't cover full pats (just ident)...
+ // | _ when not (rangeContainsPos pat.Range pos) -> None
+ | SynPat.Named (ident=ident)
+ when
+ rangeContainsPos ident.idRange pos
+ &&
+ invalidPositionForTypeAnnotation pos path
+ ->
+ ExplicitType.Invalid
+ |> Some
+ | SynPat.Named (ident=ident; isThisVal=false) when rangeContainsPos ident.idRange pos ->
+ let typed = isDirectlyTyped ident.idRange.Start path
+ if typed then
+ ExplicitType.Exists
+ |> Some
+ else
+ let parens = getParensForIdentPat text pat path
+ ExplicitType.Missing {
+ Ident = ident.idRange
+ InsertAt = ident.idRange.End
+ Parens = parens
+ SpecialRules = []
+ }
+ |> Some
+ | SynPat.OptionalVal (ident=ident) when rangeContainsPos ident.idRange pos ->
+ let typed = isDirectlyTyped ident.idRange.Start path
+ if typed then
+ ExplicitType.Exists
+ |> Some
+ else
+ let parens = getParensForIdentPat text pat path
+ ExplicitType.Missing {
+ Ident = ident.idRange
+ InsertAt = ident.idRange.End
+ Parens = parens
+ SpecialRules = [RemoveOptionFromType]
+ // ^^^^^^^^^^^^^^^^^^^^
+ // `?v: int`, NOT `?v: int option`
+ }
+ |> Some
+ | _ -> defaultTraverse pat //todo: custom traverse? -> doesn't require FCS to handle `SynPat.Record`
+
+ member _.VisitSimplePats(path, pats) =
+ // SynSimplePats at:
+ // * Primary ctor:
+ // * SynMemberDefn.ImplicitCtor.ctorArgs
+ // * SynTypeDefnSimpleRepr.General.implicitCtorSynPats
+ // //TODO: when? example?
+ // * Lambda: SynExpr.Lambda.args
+ // * issue: might or might not be actual identifier
+ // * `let f1 = fun v -> v + 1`
+ // -> `v` is in `args` (-> SynSimplePat)
+ // * `let f2 = fun (Value v) -> v + 1`
+ // -> compiler generated `_arg1` in `args`,
+ // and `v` is inside match expression in `body` & `parsedData` (-> `SynPat` )
+ maybe {
+ let! pat =
+ pats
+ |> List.tryFind (fun p -> rangeContainsPos p.Range pos)
+ let rec tryGetIdent pat =
+ match pat with
+ | SynSimplePat.Id (ident=ident) when rangeContainsPos ident.idRange pos ->
+ Some pat
+ | SynSimplePat.Attrib (pat=pat) when rangeContainsPos pat.Range pos ->
+ tryGetIdent pat
+ | SynSimplePat.Typed (pat=pat) when rangeContainsPos pat.Range pos ->
+ tryGetIdent pat
+ | _ -> None
+ let! ident = tryGetIdent pat
+ match ident with
+ | SynSimplePat.Id (isCompilerGenerated=false) ->
+ let rec isTyped =
+ function
+ | SynSimplePat.Typed _ -> true
+ | SynSimplePat.Id _ -> false
+ | SynSimplePat.Attrib (pat=pat) -> isTyped pat
+ let typed = isTyped pat
+ if typed then
+ return ExplicitType.Exists
+ else
+ let isCtor =
+ path
+ |> List.tryHead
+ |> Option.map (
+ function
+ // normal ctor in type: `type A(v) = ...`
+ | SyntaxNode.SynMemberDefn (SynMemberDefn.ImplicitCtor _) -> true
+ //TODO: when? example?
+ | SyntaxNode.SynTypeDefn (SynTypeDefn(typeRepr=SynTypeDefnRepr.Simple(simpleRepr=SynTypeDefnSimpleRepr.General(implicitCtorSynPats=Some(ctorPats)))))
+ when
+ rangeContainsPos ctorPats.Range pos
+ ->
+ true
+ | _ -> false
+ )
+ |> Option.defaultValue false
+ if isCtor then
+ return ExplicitType.Missing {
+ Ident = ident.Range
+ InsertAt = ident.Range.End
+ Parens = Parens.Forbidden
+ SpecialRules = []
+ }
+ else
+ // lambda
+ return! None
+ | _ -> return! None
+ }
+ })
+
+/// Note: No exhausting check. Doesn't check for:
+/// * is already typed (-> done by getting `ExplicitType`)
+/// * Filters like excluding functions (vs. lambda functions)
+/// * `mfv.IsFromDefinition`
+let isPotentialTargetForTypeAnnotation (symbolUse: FSharpSymbolUse, mfv: FSharpMemberOrFunctionOrValue) =
+ mfv.IsValue
+ &&
+ not (
+ mfv.IsMember
+ ||
+ mfv.IsMemberThisValue
+ ||
+ mfv.IsConstructorThisValue
+ ||
+ PrettyNaming.IsOperatorDisplayName mfv.DisplayName
+ )
+
+let tryGetDetailedExplicitTypeInfo
+ (isValidTarget: FSharpSymbolUse * FSharpMemberOrFunctionOrValue -> bool)
+ (text: NamedText, parseAndCheck: ParseAndCheckResults)
+ (pos: Position)
+ = maybe {
+ let! line = text.GetLine pos
+ let! symbolUse = parseAndCheck.TryGetSymbolUse pos line
+ match symbolUse.Symbol with
+ | :? FSharpMemberOrFunctionOrValue as mfv
+ when
+ isValidTarget (symbolUse, mfv)
+ ->
+ let! explTy = tryGetExplicitTypeInfo (text, parseAndCheck.GetAST) pos
+ return (symbolUse, mfv, explTy)
+ | _ -> return! None
+ }
+
+let private tryCreateTypeHint
+ (explicitType: ExplicitType)
+ (ty: FSharpType)
+ (displayContext: FSharpDisplayContext)
+ =
+ match explicitType with
+ | ExplicitType.Missing data ->
+ let (ty, tyForAnno) = data.FormatType (ty, displayContext)
+ {
+ IdentRange = data.Ident
+ Pos = data.InsertAt
+ Kind = Type
+ // TODO: or use tyForAnno?
+ Text = ": " + ty
+ //TODO: delay for resolve?
+ Insertions = Some <| data.CreateEdits tyForAnno
+ //TODO: implement? delay for resolve?
+ Tooltip = None
+ }
+ |> Some
+ | _ -> None
+
+let provideHints
+ (text: NamedText, parseAndCheck: ParseAndCheckResults, range: Range)
+ : Async
+ =
asyncResult {
- let parseFileResults, checkFileResults = p.GetParseResults, p.GetCheckResults
let! cancellationToken = Async.CancellationToken
-
let symbolUses =
- checkFileResults.GetAllUsesOfAllSymbolsInFile(cancellationToken)
- |> Seq.filter (fun su -> Range.rangeContainsRange range su.Range)
- |> Seq.toList
+ parseAndCheck.GetCheckResults.GetAllUsesOfAllSymbolsInFile(cancellationToken)
+ |> Seq.filter (fun su -> rangeContainsRange range su.Range)
let typeHints = ImmutableArray.CreateBuilder()
let parameterHints = ImmutableArray.CreateBuilder()
- let isValidForTypeHint (funcOrValue: FSharpMemberOrFunctionOrValue) (symbolUse: FSharpSymbolUse) =
- let isLambdaIfFunction =
- funcOrValue.IsFunction
- && parseFileResults.IsBindingALambdaAtPosition symbolUse.Range.Start
-
- let isTypedPat (r: Range) =
- parseFileResults.IsTypeAnnotationGivenAtPositionPatched r.Start
-
- (funcOrValue.IsValue || isLambdaIfFunction)
- && not (isTypedPat symbolUse.Range)
- && symbolUse.IsFromDefinition
- && not funcOrValue.IsMember
- && not funcOrValue.IsMemberThisValue
- && not funcOrValue.IsConstructorThisValue
- && not (PrettyNaming.IsOperatorDisplayName funcOrValue.DisplayName)
-
for symbolUse in symbolUses do
match symbolUse.Symbol with
- | :? FSharpMemberOrFunctionOrValue as funcOrValue when isValidForTypeHint funcOrValue symbolUse ->
- let hint =
- createTypeHint symbolUse.Range funcOrValue.ReturnParameter.Type symbolUse.DisplayContext
-
- typeHints.Add(hint)
+ | :? FSharpMemberOrFunctionOrValue as mfv
+ when
+ symbolUse.IsFromDefinition
+ &&
+ isPotentialTargetForTypeAnnotation (symbolUse, mfv)
+ ->
+ tryGetExplicitTypeInfo (text, parseAndCheck.GetAST) symbolUse.Range.Start
+ |> Option.bind (fun explTy -> tryCreateTypeHint explTy mfv.FullType symbolUse.DisplayContext)
+ |> Option.iter typeHints.Add
| :? FSharpMemberOrFunctionOrValue as func when func.IsFunction && not symbolUse.IsFromDefinition ->
let appliedArgRangesOpt =
- parseFileResults.GetAllArgumentsForFunctionApplicationAtPostion symbolUse.Range.Start
+ parseAndCheck.GetParseResults.GetAllArgumentsForFunctionApplicationAtPostion symbolUse.Range.Start
match appliedArgRangesOpt with
| None -> ()
@@ -378,7 +855,6 @@ let provideHints (text: NamedText, p: ParseAndCheckResults, range: Range) : Asyn
if ShouldCreate.paramHint func definitionArg appliedArgText then
let hint = createParamHint appliedArgRange definitionArgName
parameterHints.Add(hint)
-
| :? FSharpMemberOrFunctionOrValue as methodOrConstructor when methodOrConstructor.IsConstructor -> // TODO: support methods when this API comes into FCS
let endPosForMethod = symbolUse.Range.End
let line, _ = Position.toZ endPosForMethod
@@ -387,10 +863,10 @@ let provideHints (text: NamedText, p: ParseAndCheckResults, range: Range) : Asyn
getFirstPositionAfterParen (text.Lines.[line].ToString()) (endPosForMethod.Column)
let tupledParamInfos =
- parseFileResults.FindParameterLocations(Position.fromZ line afterParenPosInLine)
+ parseAndCheck.GetParseResults.FindParameterLocations(Position.fromZ line afterParenPosInLine)
let appliedArgRanges =
- parseFileResults.GetAllArgumentsForFunctionApplicationAtPostion symbolUse.Range.Start
+ parseAndCheck.GetParseResults.GetAllArgumentsForFunctionApplicationAtPostion symbolUse.Range.Start
match tupledParamInfos, appliedArgRanges with
| None, None -> ()
@@ -430,6 +906,7 @@ let provideHints (text: NamedText, p: ParseAndCheckResults, range: Range) : Asyn
if ShouldCreate.paramHint methodOrConstructor definitionArg appliedArgText then
let hint = createParamHint appliedArgRange definitionArg.DisplayName
parameterHints.Add(hint)
+
| _ -> ()
let typeHints = typeHints.ToImmutableArray()
diff --git a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
index d33868f34..835f0f190 100644
--- a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
+++ b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
@@ -1,5 +1,6 @@
module FsAutoComplete.CodeFix.AddExplicitTypeToParameter
+open System
open FsToolkit.ErrorHandling
open FsAutoComplete.CodeFix.Types
open Ionide.LanguageServerProtocol.Types
@@ -9,7 +10,17 @@ open FSharp.Compiler.CodeAnalysis
open FSharp.Compiler.Symbols
open FSharp.Compiler.Syntax
open FSharp.Compiler.Text.Range
+open FsAutoComplete.Core.InlayHints
+open FsAutoComplete.Core
+
+let toLspEdit ({ Pos=insertAt; Text=text}: HintInsertion) =
+ { Range = fcsPosToProtocolRange insertAt; NewText = text }
+
+let toLspEdits (edits: HintInsertion[]) =
+ edits |> Array.map toLspEdit
+
+[] //TODO: correct?
let private isPositionContainedInUntypedImplicitCtorParameter input pos =
let result =
SyntaxTraversal.Traverse(
@@ -18,38 +29,59 @@ let private isPositionContainedInUntypedImplicitCtorParameter input pos =
{ new SyntaxVisitorBase<_>() with
member _.VisitModuleDecl(_, defaultTraverse, decl) =
match decl with
- | SynModuleDecl.Types (typeDefns = typeDefns) ->
- maybe {
- let! ctorArgs =
- typeDefns
- |> List.tryPick (function
- | SynTypeDefn(implicitConstructor = Some (SynMemberDefn.ImplicitCtor (ctorArgs = args))) when
- rangeContainsPos args.Range pos
- ->
- Some args
- | _ -> None)
-
- match ctorArgs with
- | SynSimplePats.SimplePats (pats = pats) ->
- let! pat =
- pats
- |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
-
- let rec tryGetUntypedIdent =
- function
- | SynSimplePat.Id (ident = ident) when rangeContainsPos ident.idRange pos -> Some ident
- | SynSimplePat.Attrib (pat = pat) when rangeContainsPos pat.Range pos -> tryGetUntypedIdent pat
- | SynSimplePat.Typed _
- | _ -> None
-
- return! tryGetUntypedIdent pat
- | _ -> return! None
- }
- |> Option.orElseWith (fun _ -> defaultTraverse decl)
- | _ -> defaultTraverse decl }
+ | SynModuleDecl.Types(typeDefns = typeDefns) ->
+ maybe {
+ let! ctorArgs =
+ typeDefns
+ |> List.tryPick (
+ function
+ | SynTypeDefn(implicitConstructor=Some(SynMemberDefn.ImplicitCtor(ctorArgs = args))) when rangeContainsPos args.Range pos ->
+ Some args
+ | _ -> None
+ )
+
+ match ctorArgs with
+ | SynSimplePats.SimplePats (pats=pats) ->
+ let! pat =
+ pats
+ |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
+ let rec tryGetUntypedIdent =
+ function
+ | SynSimplePat.Id (ident=ident) when rangeContainsPos ident.idRange pos ->
+ Some ident
+ | SynSimplePat.Attrib (pat=pat) when rangeContainsPos pat.Range pos ->
+ tryGetUntypedIdent pat
+ | SynSimplePat.Typed _
+ | _ ->
+ None
+ return! tryGetUntypedIdent pat
+ | _ -> return! None
+ }
+ |> Option.orElseWith (fun _ -> defaultTraverse decl)
+ | _ -> defaultTraverse decl
+ })
+ result.IsSome
+[] //TODO: correct
+let private isSymbolToTriggerTypeAnnotation (funcOrValue: FSharpMemberOrFunctionOrValue) (symbolUse: FSharpSymbolUse) (parseFileResults: FSharpParseFileResults) =
+ (
+ funcOrValue.IsValue
+ ||
+ (
+ funcOrValue.IsFunction
+ &&
+ parseFileResults.IsBindingALambdaAtPosition symbolUse.Range.Start
)
+ )
+ //TODO: check here for curried parameter? necessary? Or handled by `tryGetExplicitTypeInfo`?
+ &&
+ not funcOrValue.IsMember
+ &&
+ not funcOrValue.IsMemberThisValue
+ &&
+ not funcOrValue.IsConstructorThisValue
+ &&
+ not (PrettyNaming.IsOperatorDisplayName funcOrValue.DisplayName)
- result.IsSome
let title = "Add explicit type annotation"
@@ -62,83 +94,22 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
let fcsStartPos = protocolPosToPos codeActionParams.Range.Start
let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsStartPos
- let parseFileResults = parseAndCheck.GetParseResults
-
- let! (rightCol, idents) =
- Lexer.findLongIdents (fcsStartPos.Column, lineStr)
- |> Result.ofOption (fun _ ->
- $"Couldn't find long ident at %A{fcsStartPos} in file %s{codeActionParams.TextDocument.GetFilePath()}")
-
- let! symbolUse =
- parseAndCheck.GetCheckResults.GetSymbolUseAtLocation(fcsStartPos.Line, rightCol, lineStr, List.ofArray idents)
- |> Result.ofOption (fun _ ->
- $"Couldn't find symbolUse at %A{(fcsStartPos.Line, rightCol)} in file %s{codeActionParams.TextDocument.GetFilePath()}")
-
- let isValidParameterWithoutTypeAnnotation
- (funcOrValue: FSharpMemberOrFunctionOrValue)
- (symbolUse: FSharpSymbolUse)
- =
- let isLambdaIfFunction =
- funcOrValue.IsFunction
- && parseFileResults.IsBindingALambdaAtPosition symbolUse.Range.Start
-
- (funcOrValue.IsValue || isLambdaIfFunction)
- && ((parseFileResults.IsPositionContainedInACurriedParameter symbolUse.Range.Start
- && not (parseFileResults.IsTypeAnnotationGivenAtPosition symbolUse.Range.Start))
- || (isPositionContainedInUntypedImplicitCtorParameter parseFileResults.ParseTree symbolUse.Range.Start))
- && not funcOrValue.IsMember
- && not funcOrValue.IsMemberThisValue
- && not funcOrValue.IsConstructorThisValue
- && not (PrettyNaming.IsOperatorDisplayName funcOrValue.DisplayName)
-
- match symbolUse.Symbol with
- | :? FSharpMemberOrFunctionOrValue as v when isValidParameterWithoutTypeAnnotation v symbolUse ->
- let typeString = v.FullType.Format symbolUse.DisplayContext
- let title = title
- let fcsSymbolRange = symbolUse.Range
- let protocolSymbolRange = fcsRangeToLsp fcsSymbolRange
- let! symbolText = sourceText.GetText fcsSymbolRange
-
- let requiresParens =
- if isPositionContainedInUntypedImplicitCtorParameter parseFileResults.ParseTree symbolUse.Range.Start then
- // no patterns in primary ctor allowed -> `type A((a))` is invalid
- false
- else
- // `(a, b, c)`
- // -> between `,` and parens (there might be spaces between)
- let left =
- sourceText.WalkBackwards(fcsSymbolRange.Start, (fun _ -> false), ((<>) ' '))
- |> Option.bind (sourceText.TryGetChar)
-
- let right =
- sourceText.NextPos fcsSymbolRange.End // end is on last char of identifier
- |> Option.bind (fun pos -> sourceText.WalkForward(pos, (fun _ -> false), ((<>) ' ')))
- |> Option.bind (sourceText.TryGetChar)
-
- match left, right with
- | Some left, Some right ->
- let isContained =
- (left = '(' || left = ',')
- && (right = ',' || right = ')')
-
- not isContained
- | _, _ -> true
-
- let changedText, changedRange =
- if requiresParens then
- "(" + symbolText + ": " + typeString + ")", protocolSymbolRange
- else
- ": " + typeString,
- { Start = protocolSymbolRange.End
- End = protocolSymbolRange.End }
-
- return
- [ { Edits =
- [| { Range = changedRange
- NewText = changedText } |]
- File = codeActionParams.TextDocument
- Title = title
- SourceDiagnostic = None
- Kind = FixKind.Refactor } ]
- | _ -> return []
+ let res =
+ InlayHints.tryGetDetailedExplicitTypeInfo
+ InlayHints.isPotentialTargetForTypeAnnotation
+ (sourceText, parseAndCheck)
+ fcsStartPos
+ match res with
+ | None -> return []
+ | Some (symbolUse, mfv, explTy) ->
+ match explTy.TryGetTypeAndEdits (mfv.FullType, symbolUse.DisplayContext) with
+ | None -> return []
+ | Some (_, edits) ->
+ return [{
+ File = codeActionParams.TextDocument
+ Title = title
+ Edits = edits |> toLspEdits
+ Kind = FixKind.Refactor
+ SourceDiagnostic = None
+ }]
}
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 0875e80c2..dbe5809e2 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -5,6 +5,7 @@ open System.IO
open System.Threading
open System.Diagnostics
open FsAutoComplete
+open FsAutoComplete.Core
open FsAutoComplete.LspHelpers
open FsAutoComplete.Utils
open FsAutoComplete.CodeFix
@@ -56,6 +57,11 @@ type LSPInlayHint =
Pos: Types.Position
Kind: InlayHintKind }
+type InlayHintData = {
+ TextDocument: TextDocumentIdentifier
+ Range: Types.Range
+}
+
module Result =
let ofCoreResponse (r: CoreResponse<'a>) =
match r with
@@ -2640,21 +2646,133 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
)
p.TextDocument
- |> x.fileHandler (fun fn tyRes lines ->
- async {
- let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
- let! hints = commands.InlayHints(lines, tyRes, fcsRange)
-
- let lspHints =
- hints
- |> Array.map (fun h ->
- { Text = h.Text
- InsertText = h.InsertText
- Pos = fcsPosToLsp h.Pos
- Kind = mapHintKind h.Kind })
-
- return success lspHints
- })
+ |> x.fileHandler (fun fn tyRes lines -> async {
+ let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
+ let! hints = commands.InlayHints(lines, tyRes, fcsRange)
+ let lspHints =
+ hints
+ |> Array.map (fun h -> {
+ Text = h.Text
+ InsertText = None
+ Pos = fcsPosToLsp h.Pos
+ Kind = mapHintKind h.Kind
+ })
+ return success lspHints
+ })
+
+ override x.TextDocumentInlayHint (p: InlayHintParams) : AsyncLspResult =
+ logger.info (
+ Log.setMessage "TextDocumentInlayHint Request: {parms}"
+ >> Log.addContextDestructured "parms" p
+ )
+
+ p.TextDocument
+ |> x.fileHandler (fun fn tyRes lines -> async {
+ let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
+ let! hints = commands.InlayHints (lines, tyRes, fcsRange)
+ let hints: InlayHint[] =
+ hints
+ |> Array.map (fun h -> {
+ Position = fcsPosToLsp h.Pos
+ Label = InlayHintLabel.String h.Text
+ Kind =
+ match h.Kind with
+ | InlayHints.HintKind.Type -> Types.InlayHintKind.Type
+ | InlayHints.HintKind.Parameter -> Types.InlayHintKind.Parameter
+ |> Some
+ //TODO: lazy -> resolve?
+ TextEdits =
+ match h.Insertions with
+ | None -> None
+ // Note: Including no insertions via empty array:
+ // Difference:
+ // * `None` -> no `TextEdits` element specified -> can be `resolve`d
+ // * `Some [||]` -> `TextEdits` gets serialized -> no `resolve`
+ //TODO: always emit `Some [||]` (instead of `None`) for `Parameter` -> prevent `resolve`
+ | Some insertions ->
+ insertions
+ |> Array.map (fun insertion -> {
+ Range = fcsPosToProtocolRange insertion.Pos
+ NewText = insertion.Text
+ })
+ |> Some
+ //TODO: lazy -> resolve?
+ Tooltip = h.Tooltip |> Option.map (InlayHintTooltip.String)
+ PaddingLeft =
+ match h.Kind with
+ | InlayHints.HintKind.Type -> Some true
+ | _ -> None
+ PaddingRight =
+ match h.Kind with
+ | InlayHints.HintKind.Parameter -> Some true
+ | _ -> None
+ Data =
+ {
+ TextDocument = p.TextDocument
+ Range = fcsRangeToLsp h.IdentRange
+ }
+ |> serialize
+ |> Some
+ })
+
+ return success (Some hints)
+ })
+ /// Note: Requires `InlayHintData` in `InlayHint.Data` element.
+ /// Required to relate `InlayHint` to a document and position inside
+ ///
+ /// Note: Currently only resolves `Tooltip` and `TextEdits`
+ ///
+ /// Note: Resolving `Tooltip` is currently not implement -> above *Note* is a lie...
+ override x.InlayHintResolve (p: InlayHint): AsyncLspResult =
+ logger.info (
+ Log.setMessage "InlayHintResolve Request: {parms}"
+ >> Log.addContextDestructured "parms" p
+ )
+
+ match p.Data with
+ | None -> Async.singleton <| invalidParams "InlayHint doesn't specify contain `Data`"
+ | _ when p.Tooltip |> Option.isSome && p.TextEdits |> Option.isSome ->
+ // nothing to resolve
+ Async.singleton <| success p
+ | Some data ->
+ let data: InlayHintData = deserialize data
+ let range = data.Range
+ data.TextDocument
+ |> x.fileHandler (fun fn tyRes lines -> asyncResult {
+ // update Tooltip
+ let! p =
+ match p.Tooltip with
+ | Some _ -> Ok p
+ | None ->
+ //TODO: implement
+ Ok p
+ // update TextEdits
+ let! p =
+ match p.Kind, p.TextEdits with
+ | Some (Types.InlayHintKind.Parameter), _ -> Ok p
+ | _, Some _ -> Ok p
+ | _, None ->
+ maybe {
+ let! (symbolUse, mfv, explTy) =
+ InlayHints.tryGetDetailedExplicitTypeInfo
+ InlayHints.isPotentialTargetForTypeAnnotation
+ (lines, tyRes)
+ (protocolPosToPos range.Start)
+ let! (_, edits) = explTy.TryGetTypeAndEdits (mfv.FullType, symbolUse.DisplayContext)
+ let p =
+ { p with
+ TextEdits =
+ edits
+ |> AddExplicitTypeToParameter.toLspEdits
+ |> Some
+ }
+ return p
+ }
+ |> Option.defaultValue p
+ |> Ok
+
+ return p
+ })
member x.FSharpPipelineHints(p: FSharpPipelineHintRequest) =
logger.info (
@@ -2708,6 +2826,9 @@ let startCore toolsPath stateStorageDir workspaceLoaderFactory =
|> Map.add "fsproj/addFileBelow" (serverRequestHandling (fun s p -> s.FsProjAddFileBelow(p)))
|> Map.add "fsproj/addFile" (serverRequestHandling (fun s p -> s.FsProjAddFile(p)))
|> Map.add "fsharp/inlayHints" (serverRequestHandling (fun s p -> s.FSharpInlayHints(p)))
+ //TODO: Move to Ionide.LanguageServerProtocol with LSP 3.17
+ |> Map.add "textDocument/inlayHint" (serverRequestHandling (fun s p -> s.TextDocumentInlayHint(p)))
+ |> Map.add "inlayHint/resolve" (serverRequestHandling (fun s p -> s.InlayHintResolve(p)))
let state = State.Initial toolsPath stateStorageDir workspaceLoaderFactory
diff --git a/src/FsAutoComplete/FsAutoComplete.fsproj b/src/FsAutoComplete/FsAutoComplete.fsproj
index b79d38a04..3bb16dea7 100644
--- a/src/FsAutoComplete/FsAutoComplete.fsproj
+++ b/src/FsAutoComplete/FsAutoComplete.fsproj
@@ -17,7 +17,6 @@
-
diff --git a/src/FsAutoComplete/LSP.Preview.fs b/src/FsAutoComplete/LSP.Preview.fs
deleted file mode 100644
index 3d957a0ac..000000000
--- a/src/FsAutoComplete/LSP.Preview.fs
+++ /dev/null
@@ -1,146 +0,0 @@
-/// LSP Types for [LSP 3.17.0](https://microsoft.github.io/language-server-protocol/specifications/lsp/3.17/specification/)
-/// -- which isn't released yet!
-/// -> proposed state
-module Ionide.LanguageServerProtocol.Types
-
-open Ionide.LanguageServerProtocol.Types
-
-/// Inlay hint client capabilities.
-type InlayHintClientCapabilitiesResolveSupport = {
- /// The properties that a client can resolve lazily.
- Properties: string[]
-}
-type InlayHintClientCapabilities = {
- /// Whether inlay hints support dynamic registration.
- DynamicRegistration: bool option
- /// Indicates which properties a client can resolve lazily on a inlay
- /// hint.
- ResolveSupport: InlayHintClientCapabilitiesResolveSupport option
-}
-
-
-/// Inlay hint options used during static registration.
-type InlayHintOptions = (*WorkDoneProgressOptions &*) {
- /// The server provides support to resolve additional
- /// information for an inlay hint item.
- ResolveProvider: bool option
-}
-/// Inlay hint options used during static or dynamic registration.
-type InlayHintRegistrationOptions = InlayHintOptions (*& TextDocumentRegistrationOptions & StaticRegistrationOptions*)
-
-
-/// A parameter literal used in inlay hint requests.
-type InlayHintParams = (*WorkDoneProgressParams &*) {
- /// The text document.
- TextDocument: TextDocumentIdentifier
- /// The visible document range for which inlay hints should be computed.
- Range: Range
-}
-
-/// Inlay hint kinds.
-[]
-type InlayHintKind =
- /// An inlay hint that for a type annotation.
- | Type = 1
- /// An inlay hint that is for a parameter.
- | Parameter = 2
-[]
-[]
-type InlayHintTooltip =
- | String of string
- | Markup of MarkupContent
-/// An inlay hint label part allows for interactive and composite labels
-/// of inlay hints.
-type InlayHintLabelPart = {
- /// The value of this label part.
- Value: string
- /// The tooltip text when you hover over this label part. Depending on
- /// the client capability `inlayHint.resolveSupport` clients might resolve
- /// this property late using the resolve request.
- Tooltip: InlayHintTooltip option
- /// An optional source code location that represents this
- /// label part.
- ///
- /// The editor will use this location for the hover and for code navigation
- /// features: This part will become a clickable link that resolves to the
- /// definition of the symbol at the given location (not necessarily the
- /// location itself), it shows the hover that shows at the given location,
- /// and it shows a context menu with further code navigation commands.
- ///
- /// Depending on the client capability `inlayHint.resolveSupport` clients
- /// might resolve this property late using the resolve request.
- Location: Location option
- /// An optional command for this label part.
- ///
- /// Depending on the client capability `inlayHint.resolveSupport` clients
- /// might resolve this property late using the resolve request.
- Command: Command option
-}
-[]
-[]
-type InlayHintLabel =
- | String of string
- | Parts of InlayHintLabelPart[]
-/// Inlay hint information.
-type InlayHint<'Data> = {
- /// The position of this hint.
- Position: Position
- /// The label of this hint. A human readable string or an array of
- /// InlayHintLabelPart label parts.
- ///
- /// *Note* that neither the string nor the label part can be empty.
- Label: InlayHintLabel
- /// he kind of this hint. Can be omitted in which case the client
- /// should fall back to a reasonable default.
- Kind: InlayHintKind option
- /// Optional text edits that are performed when accepting this inlay hint.
- ///
- /// *Note* that edits are expected to change the document so that the inlay
- /// hint (or its nearest variant) is now part of the document and the inlay
- /// hint itself is now obsolete.
- ///
- /// Depending on the client capability `inlayHint.resolveSupport` clients
- /// might resolve this property late using the resolve request.
- TextEdits: TextEdit[] option
- /// The tooltip text when you hover over this item.
- ///
- /// Depending on the client capability `inlayHint.resolveSupport` clients
- /// might resolve this property late using the resolve request.
- Tooltip: InlayHintTooltip option
- /// Render padding before the hint.
- ///
- /// Note: Padding should use the editor's background color, not the
- /// background color of the hint itself. That means padding can be used
- /// to visually align/separate an inlay hint.
- PaddingLeft: bool option
- /// Render padding after the hint.
- ///
- /// Note: Padding should use the editor's background color, not the
- /// background color of the hint itself. That means padding can be used
- /// to visually align/separate an inlay hint.
- PaddingRight: bool option
-
- /// A data entry field that is preserved on a inlay hint between
- /// a `textDocument/inlayHint` and a `inlayHint/resolve` request.
- ///
- /// Note: In LSP specs: of type `LSPAny`:
- /// ```typescript
- /// export type LSPAny = LSPObject | LSPArray | string | integer | uinteger | decimal | boolean | null;
- /// export type LSPObject = { [key: string]: LSPAny };
- /// export type LSPArray = LSPAny[];
- /// ```
- /// -> `'Data` must adhere to specs
- Data: 'Data option
-}
-
-/// Client workspace capabilities specific to inlay hints.
-type InlayHintWorkspaceClientCapabilities = {
- /// Whether the client implementation supports a refresh request sent from
- /// the server to the client.
- ///
- /// Note that this event is global and will force the client to refresh all
- /// inlay hints currently shown. It should be used with absolute care and
- /// is useful for situation where a server for example detects a project wide
- /// change that requires such a calculation.
- RefreshSupport: bool option
-}
diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
index 38c2255fb..f384a3a2c 100644
--- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
@@ -363,5 +363,105 @@ let tests state =
) =
member _.F(b) = a + b
"""
+
+ testCaseAsync "emit type for optional parameter without option" <|
+ CodeFix.check server
+ """
+ type A =
+ static member F(?$0a) = a |> Option.map ((+) 1)
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ type A =
+ static member F(?a: int) = a |> Option.map ((+) 1)
+ """
+ testCaseAsync "adds parens to optional parameter" <|
+ CodeFix.check server
+ """
+ type A =
+ static member F?$0a = a |> Option.map ((+) 1)
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ type A =
+ static member F(?a: int) = a |> Option.map ((+) 1)
+ """
+ testCaseAsync "adds parens to ident in match case" <|
+ CodeFix.check server
+ """
+ match 4 with
+ | $0value -> ()
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ match 4 with
+ | (value: int) -> ()
+ """
+
+ testCaseAsync "doesn't add parens to let" <|
+ CodeFix.check server
+ """
+ let $0value = 42
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ let value: int = 42
+ """
+ testCaseAsync "adds parens to let!" <|
+ CodeFix.check server
+ """
+ async {
+ let! $0value = async { return 4 }
+ ()
+ } |> ignore
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ async {
+ let! (value: int) = async { return 4 }
+ ()
+ } |> ignore
+ """
+ testCaseAsync "doesn't add parens to use" <|
+ CodeFix.check server
+ """
+ open System
+ let d = { new IDisposable with
+ member _.Dispose () = ()
+ }
+ let _ =
+ use $0value = d
+ ()
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ open System
+ let d = { new IDisposable with
+ member _.Dispose () = ()
+ }
+ let _ =
+ use value: IDisposable = d
+ ()
+ """
+ testCaseAsync "doesn't trigger for use!" <|
+ CodeFix.checkNotApplicable server
+ """
+ open System
+ let d = { new IDisposable with
+ member _.Dispose () = ()
+ }
+ async {
+ use! $0value = async { return d }
+ ()
+ } |> ignore
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
]
])
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index aba350b12..813a543e8 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -2,13 +2,11 @@ module FsAutoComplete.Tests.InlayHintTests
open Expecto
open System
-open System.IO
open Ionide.LanguageServerProtocol.Types
open FsAutoComplete
open Helpers
open FsToolkit.ErrorHandling
open Utils.ServerTests
-open Expecto.Logging.Global
open FsAutoComplete.Core
open FsAutoComplete.Lsp
@@ -17,7 +15,6 @@ module InlayHints =
open Utils.Tests
open Utils.Utils
open Utils.TextEdit
- open FSharpx.Control
let private at (text, pos, kind) : LSPInlayHint =
{ Text =
@@ -550,3 +547,834 @@ let tests state =
]
]
])
+
+open FSharp.Compiler.CodeAnalysis
+open FSharp.Compiler.Text
+open Utils.TextEdit
+open Utils.Utils
+open FsAutoComplete.Core.InlayHints
+open FSharp.UMX
+open FsAutoComplete.LspHelpers
+open Ionide.LanguageServerProtocol.Types
+
+let explicitTypeInfoTests =
+ let file = "test.fsx"
+ let checker = lazy ( FSharpChecker.Create() )
+ let getAst input = async {
+ let checker = checker.Value
+ // Get compiler options for the 'project' implied by a single script file
+ let! projOptions, diagnostics =
+ checker.GetProjectOptionsFromScript(file, input, assumeDotNetFramework=false)
+ // Expect.isEmpty diagnostics "There should be no diagnostics"
+ Expect.hasLength diagnostics 0 "There should be no diagnostics"
+
+ let parsingOptions, errors = checker.GetParsingOptionsFromProjectOptions(projOptions)
+ // Expect.isEmpty errors "There should be no errors"
+ Expect.hasLength errors 0 "There should be no errors"
+
+ // Run the first phase (untyped parsing) of the compiler
+ let! parseFileResults =
+ checker.ParseFile(file, input, parsingOptions)
+ // Expect.isEmpty parseFileResults.Diagnostics "There should be no parse diagnostics"
+ Expect.hasLength parseFileResults.Diagnostics 0 "There should be no parse diagnostics"
+
+ return parseFileResults.ParseTree
+ }
+
+ let getExplicitTypeInfo (pos: Position) (text: string) = async {
+ let text = NamedText(UMX.tag file, text)
+ let! ast = getAst text
+
+ let pos = protocolPosToPos pos
+
+ let explTy = InlayHints.tryGetExplicitTypeInfo (text, ast) pos
+ return explTy
+ }
+
+ let fromCursor = Position.pos0
+ let fromCursors = Range.Zero
+ let fromCursorAndInsert = Range.mkRange fromCursors.FileName (Position.mkPos 12345 12345) (Position.mkPos 12345 12345)
+
+ let cursor = "$0"
+ let (openParenCursor, closeParenCursor) = "$(", "$)"
+ let insertCursor = "$I"
+ let identCursor = "$|"
+ let markers = [| cursor; openParenCursor; closeParenCursor; insertCursor; identCursor |]
+
+ let wantsExactlyOne msg vs =
+ Expect.hasLength vs 1 msg
+ vs |> List.exactlyOne
+ let extractCursor (marker: string) cursors =
+ let pos = cursors |> List.filter (fst >> (=) marker) |> List.map snd |> wantsExactlyOne $"There should be exactly one cursor marker '{marker}'"
+ let cursors = cursors |> List.filter (fst >> (<>) marker)
+ (pos, cursors)
+ let toFcsPos (pos, cursors) =
+ let pos = protocolPosToPos pos
+ (pos, cursors)
+
+ /// Cursors:
+ /// * $0: Cursor
+ /// * $(: Open Paren
+ /// * $): Close Paren
+ /// * $I: Insert Pos
+ /// * $|: Ident range
+ let testExplicitType'
+ (textWithCursors: string)
+ (expected: ExplicitType option)
+ = async {
+ let (text, cursors) =
+ textWithCursors
+ |> Text.trimTripleQuotation
+ |> Cursors.extractWith markers
+ let (pos, cursors) = cursors |> extractCursor cursor
+
+ let updateExpected cursors (expected: ExplicitType) =
+ let expected, cursors =
+ match expected with
+ | ExplicitType.Debug _ -> expected, cursors
+ | ExplicitType.Invalid -> ExplicitType.Invalid, cursors
+ | ExplicitType.Exists -> ExplicitType.Exists, cursors
+ | ExplicitType.Missing ({ Ident=ident; InsertAt=insertAt; Parens=parens } as data) ->
+ let insertAt, cursors =
+ if insertAt = fromCursor then
+ cursors |> extractCursor insertCursor |> toFcsPos
+ else
+ insertAt, cursors
+ let (parens, cursors) =
+ let extractParensRange cursors =
+ let (openParen, cursors) = cursors |> extractCursor openParenCursor |> toFcsPos
+ let (closeParen, cursors) = cursors |> extractCursor closeParenCursor |> toFcsPos
+ let range = Range.mkRange file openParen closeParen
+ range, cursors
+ match parens with
+ | Parens.Exist range when range = fromCursors ->
+ let range, cursors = extractParensRange cursors
+ (Parens.Exist range), cursors
+ | Parens.Optional range when range = fromCursors ->
+ let range, cursors = extractParensRange cursors
+ (Parens.Optional range), cursors
+ | Parens.Required range when range = fromCursors ->
+ let range, cursors = extractParensRange cursors
+ (Parens.Required range), cursors
+ | _ -> parens, cursors
+ let ident, cursors =
+ if ident = fromCursorAndInsert then
+ let range = Range.mkRange file (protocolPosToPos pos) insertAt
+ (range, cursors)
+ elif ident = fromCursors then
+ let range =
+ let poss =
+ cursors
+ |> List.filter (fst >> ((=) identCursor))
+ |> List.map snd
+ Expect.hasLength poss 2 "There should be exactly 2 cursors for ident"
+ let (start, fin) = (protocolPosToPos poss[0], protocolPosToPos poss[1])
+ Range.mkRange file start fin
+ let cursors = cursors |> List.filter (fst >> ((<>) identCursor))
+ (range, cursors)
+ else
+ (ident, cursors)
+
+ let data =
+ { data with
+ Ident = ident
+ InsertAt=insertAt
+ Parens=parens
+ }
+ let updated = ExplicitType.Missing data
+ updated, cursors
+
+ Expect.hasLength cursors 0 "There are unused cursors!"
+ expected
+ let expected = expected |> Option.map (updateExpected cursors)
+
+ let! actual = getExplicitTypeInfo pos text
+ Expect.equal actual expected "Incorrect Explicit Type Info"
+ }
+ let testExplicitType
+ textWithCursor
+ expected
+ =
+ testExplicitType' textWithCursor (Some expected)
+
+ testList "detect type and parens" [
+ testList "Expr" [
+ testList "For loop" [
+ // for loop is special: no pattern, no simple pattern, just ident
+ // -> no type allowed
+ testCaseAsync "explicit type is invalid" <|
+ testExplicitType
+ """
+ for $0i = 1 to 5 do
+ ()
+ """
+ ExplicitType.Invalid
+ ]
+ ]
+ testList "Bindings" [
+ testList "simple let" [
+ testCaseAsync "let value = 1" <|
+ testExplicitType
+ """
+ let $($0value$I$) = 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "let (value) = 1" <|
+ testExplicitType
+ """
+ let ($($0value$I$)) = 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Exist fromCursors; SpecialRules = [] })
+ testCaseAsync "let value: int = 1" <|
+ testExplicitType
+ """
+ let $0value: int = 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let (value: int) = 1" <|
+ testExplicitType
+ """
+ let ($0value: int) = 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let (value): int = 1" <|
+ testExplicitType
+ """
+ let ($0value): int = 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let [] value = 1" <|
+ testExplicitType
+ """
+ type Attr() =
+ inherit System.Attribute()
+ let [] $($0value$I$) = 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ // Attributes are not allowed inside parens: `let ([] value) = ...` is invalid!
+ testCaseAsync "let [] (value) = 1" <|
+ testExplicitType
+ """
+ type Attr() =
+ inherit System.Attribute()
+ let [] ($($0value$I$)) = 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Exist fromCursors; SpecialRules = [] })
+ testCaseAsync "let [] value: int = 1" <|
+ testExplicitType
+ """
+ type Attr() =
+ inherit System.Attribute()
+ let [] $0value: int = 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let [] (value: int) = 1" <|
+ testExplicitType
+ """
+ type Attr() =
+ inherit System.Attribute()
+ let [] ($0value: int) = 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let private value = 1" <|
+ testExplicitType
+ """
+ let $(private $0value$I$) = 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "let private value: int = 1" <|
+ testExplicitType
+ """
+ let private $0value: int = 1
+ """
+ (ExplicitType.Exists)
+ ]
+ testList "let with multiple vars" [
+ testCaseAsync "let value1, value2, value3 = (1,2,3)" <|
+ testExplicitType
+ """
+ let value1, $($0value2$I$), value3 = (1,2,3)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "let (value1, value2, value3) = (1,2,3)" <|
+ testExplicitType
+ """
+ let (value1, $($0value2$I$), value3) = (1,2,3)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "let (value1, value2: int, value3) = (1,2,3)" <|
+ testExplicitType
+ """
+ let (value1, $0value: int, value3) = (1,2,3)
+ """
+ (ExplicitType.Exists)
+ ]
+
+ testList "use" [
+ testCaseAsync "use value = ..." <|
+ testExplicitType
+ """
+ let d = { new System.IDisposable with
+ member _.Dispose() = ()
+ }
+ let _ =
+ use $($0value$I$) = d
+ ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "use value: IDisposable = ..." <|
+ testExplicitType
+ """
+ open System
+ let d = { new System.IDisposable with
+ member _.Dispose() = ()
+ }
+ let _ =
+ use $0value: IDisposable = d
+ ()
+ """
+ (ExplicitType.Exists)
+ ]
+
+ testList "let!" [
+ testCaseAsync "let! value = ..." <|
+ testExplicitType
+ """
+ async {
+ let! $($0value$I$) = async { return 1 }
+ ()
+ } |> ignore
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "let! (value: int) = ..." <|
+ testExplicitType
+ """
+ async {
+ let! ($0value: int) = async { return 1 }
+ ()
+ } |> ignore
+ """
+ (ExplicitType.Exists)
+ ]
+
+ testList "use!" [
+ testCaseAsync "use! value = ..." <|
+ testExplicitType
+ """
+ let d = { new System.IDisposable with
+ member _.Dispose() = ()
+ }
+ async {
+ use! $0value = async { return d }
+ ()
+ } |> ignore
+ """
+ (ExplicitType.Invalid)
+ ]
+
+ testList "foreach loop" [
+ testCaseAsync "for value in [1..5]" <|
+ testExplicitType
+ """
+ for $($0value$I$) in [1..5] do
+ ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "for value: int in [1..5]" <|
+ testExplicitType
+ """
+ for $0value: int in [1..5] do
+ ()
+ """
+ (ExplicitType.Exists)
+ ]
+ ]
+ testList "Patterns" [
+ testList "tuple" [
+ testCaseAsync "let (value,_) = (1,2)" <|
+ testExplicitType
+ """
+ let ($($0value$I$),_) = (1,2)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "let value,_ = (1,2)" <|
+ testExplicitType
+ """
+ let $($0value$I$),_ = (1,2)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "let (value: int,_) = (1,2)" <|
+ testExplicitType
+ """
+ let ($0value: int,_) = (1,2)
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let (value: int),_ = (1,2)" <|
+ testExplicitType
+ """
+ let ($0value: int),_ = (1,2)
+ """
+ (ExplicitType.Exists)
+ //TODO: Distinguish between direct and parently/ancestorly typed?
+ testCaseAsync "let (value,_): int*int = (1,2)" <|
+ testExplicitType
+ """
+ let ($($0value$I$),_): int*int = (1,2)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "let value,_ : int*int = (1,2)" <|
+ testExplicitType
+ """
+ let $($0value$I$),_ : int*int = (1,2)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ ]
+ testList "struct" [
+ testCaseAsync "let struct (value,_) =" <|
+ testExplicitType
+ """
+ let struct ($($0value$I$),_) = struct (1,2)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ ]
+ testList "Union" [
+ testCaseAsync "let U value = U 42" <|
+ testExplicitType
+ """
+ type U = U of int
+ let U $($0value$I$) = U 42
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "let U (value) = U 42" <|
+ testExplicitType
+ """
+ type U = U of int
+ let U ($($0value$I$)) = U 42
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Exist fromCursors; SpecialRules = [] })
+ testCaseAsync "let ActPat v = U 42" <|
+ testExplicitType
+ """
+ let (|ActPat|) v = ActPat v
+ let ActPat $($0value$I$) = 42
+ """
+ // For ActivePattern parens aren't actually required -- but cannot distinguish from Union Case which requires Parens (because type of union, not type of value)
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "| U (Beta=value) ->" <|
+ testExplicitType
+ """
+ type U = U of Alpha:int * Beta: int* Gamma: int
+
+ match U (1,2,3) with
+ | U (Beta=$($0value$I$)) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| U (Beta=value: int) ->" <|
+ testExplicitType
+ """
+ type U = U of Alpha:int * Beta: int* Gamma: int
+
+ match U (1,2,3) with
+ | U (Beta=$0value: int) -> ()
+ """
+ (ExplicitType.Exists)
+ ]
+ testList "record" [
+ testCaseAsync "let { Value1=value1 } =" <|
+ testExplicitType
+ """
+ type R = { Value1: int; Value2: int; Value3: int}
+ let r = { Value1=1; Value2=2; Value3=3 }
+
+ let { Value1=$($0value1$I$) } = r
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "let { Value1=value1: int } =" <|
+ testExplicitType
+ """
+ type R = { Value1: int; Value2: int; Value3: int}
+ let r = { Value1=1; Value2=2; Value3=3 }
+
+ let { Value1=$0value1: int } = r
+ """
+ (ExplicitType.Exists)
+
+ // No pattern matching for anon records
+ ]
+
+ testList "Optional" [
+ // Parens must include `?` too
+ // Note for Insert Explicit Type Annotation: must not include `option` -> `: int`, NOT `: int option`
+ testCaseAsync "static member DoStuff ?value = ..." <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff $(?$0value$I$) = value |> Option.map ((+)1)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [RemoveOptionFromType] })
+ testCaseAsync "static member DoStuff (?value) = ..." <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff ($(?$0value$I$)) = value |> Option.map ((+)1)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Exist fromCursors; SpecialRules = [RemoveOptionFromType] })
+ testCaseAsync "static member DoStuff (?value: int) = ..." <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff ($0value: int) = value |> Option.map ((+)1)
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "static member DoStuff (a, b, ?value) = ..." <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff (a, b, $(?$0value$I$)) = value |> Option.map (fun v -> v + a + b)
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [RemoveOptionFromType] })
+ testCaseAsync "static member DoStuff (a, b, ?value: int) = ..." <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff (a, b, $0value: int) = value |> Option.map (fun v -> v + a + b)
+ """
+ (ExplicitType.Exists)
+ ]
+
+ testList "nested" [
+ testCaseAsync "options & tuples in option" <|
+ testExplicitType
+ """
+ let v = Some (Some (1, (2,Some 3)))
+ match v with
+ | Some (Some (_, (_, Some $(?$0value$I$)))) -> ()
+ | _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [RemoveOptionFromType] })
+ testCaseAsync "options & tuples in tuple" <|
+ testExplicitType
+ """
+ let v = Some (Some (1, (2,Some 3)))
+ match v with
+ | Some (Some (_, ($(?$0value$I$), Some _))) -> ()
+ | _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [RemoveOptionFromType] })
+
+ ]
+ ]
+ testList "let function" [
+ testList "params" [
+ testCaseAsync "let f value = value + 1" <|
+ testExplicitType
+ """
+ let f $($0value$I$) = value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "let f (value) = value + 1" <|
+ testExplicitType
+ """
+ let f ($($0value$I$)) = value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Exist fromCursors; SpecialRules = [] })
+ testCaseAsync "let f (value: int) = value + 1" <|
+ testExplicitType
+ """
+ let f ($0value: int) = value + 1
+ """
+ (ExplicitType.Exists)
+
+ testCaseAsync "let f a value b = ..." <|
+ testExplicitType
+ """
+ let f a $($0value$I$) b = value + b + a + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "let f a (value: int) b = ..." <|
+ testExplicitType
+ """
+ let f a ($0value: int) b = value + a + b + 1
+ """
+ (ExplicitType.Exists)
+ ]
+ testList "function" [
+ // not (yet?) supported
+ testCaseAsync "let f value = value + 1" <|
+ testExplicitType'
+ """
+ let $0f value = value + 1
+ """
+ None
+ ]
+
+ testList "member" [
+ testCaseAsync "static member DoStuff value =" <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff $($0value$I$) = value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "static member DoStuff (value) =" <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff ($($0value$I$)) = value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Exist fromCursors; SpecialRules = [] })
+ testCaseAsync "static member DoStuff (value: int) =" <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff ($0value: int) = value + 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "static member DoStuff a value b =" <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff a $($0value$I$) b = value + a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "static member DoStuff(a, value, b) =" <|
+ testExplicitType
+ """
+ type A =
+ static member DoStuff(a, $($0value$I$), b) = value + a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+
+ testCaseAsync "member x.DoStuff(a, value, b) =" <|
+ testExplicitType
+ """
+ type A() =
+ member x.DoStuff(a, $($0value$I$), b) = value + a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "doesn't handle this" <|
+ testExplicitType'
+ """
+ type A() =
+ member $0x.DoStuff(a, value, b) = value + a + b + 1
+ """
+ None
+ // not (yet?) supported
+ testCaseAsync "doesn't handle function" <|
+ testExplicitType'
+ """
+ type A() =
+ member x.$0DoStuff(a, value, b) = value + a + b + 1
+ """
+ None
+ ]
+ testList "secondary ctor" [
+ testCaseAsync "new (a, value) =" <|
+ testExplicitType
+ """
+ type A(a: int) =
+ new (a, $($0value$I$)) = A(a+value)
+ member _.DoStuff(v) = v + a + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+
+ ]
+ ]
+ testList "pattern match" [
+ testCaseAsync "| value ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | $($0value$I$) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "| Some value ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | Some $($0value$I$) -> ()
+ | _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync " Choice1Of2 value | Choice2Of2 value ->" <|
+ testExplicitType
+ """
+ match Choice1Of2 3 with
+ | Choice1Of2 value | Choice2Of2 $($0value$I$) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "| _ as value ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | _ as $($0value$I$) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "| value as _ ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | $($0value$I$) as _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| (_, value) ->" <|
+ testExplicitType
+ """
+ match (4,2) with
+ | (_, $($0value$I$)) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| [value] ->" <|
+ testExplicitType
+ """
+ match [] with
+ | [$($0value$I$)] -> ()
+ | _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| [_; value; _] ->" <|
+ testExplicitType
+ """
+ match [] with
+ | [_; $($0value$I$); _] -> ()
+ | _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+
+ testList "match!" [
+ testCaseAsync "| value ->" <|
+ testExplicitType
+ """
+ async {
+ match async {return 2} with
+ | $($0value$I$) -> ()
+ }
+ |> ignore
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+
+ ]
+ ]
+ testList "lambda" [
+ testCaseAsync "fun value ->" <|
+ testExplicitType
+ """
+ let f = fun $($0value$I$) -> value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "fun a value b ->" <|
+ testExplicitType
+ """
+ let f = fun a $($0value$I$) b -> value + a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "fun (a, value, b) ->" <|
+ testExplicitType
+ """
+ let f = fun (a, $($0value$I$), b) -> value + a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testList "let f a = fun b -> a + b + 1" [
+ testCaseAsync "f" <|
+ testExplicitType'
+ """
+ let $0f a = fun b -> a + b + 1
+ """
+ None
+ testCaseAsync "a" <|
+ testExplicitType
+ """
+ let f $($0a$I$) = fun b -> a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "b" <|
+ testExplicitType
+ """
+ let f a = fun $($0b$I$)-> a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+
+ testCaseAsync "f typed" <|
+ testExplicitType'
+ """
+ let $0f a : int -> int = fun b -> a + b + 1
+ """
+ None
+ testCaseAsync "a typed" <|
+ testExplicitType
+ """
+ let f ($0a: int) = fun b -> a + b + 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "b typed" <|
+ testExplicitType
+ """
+ let f a = fun ($0b: int) -> a + b + 1
+ """
+ (ExplicitType.Exists)
+ ]
+ ]
+ testList "SimplePats" [
+ // primary ctor args & lambda args
+ // * primary ctor: no parens allowed
+ // * lambda args: absolutely fucked up -- in fact so fucked up I use the f-word to describe how fucked up it is...
+ // TODO: remove `fuck`s
+ // TODO: replace with something stronger?
+ // -> special handling for `SynExpr.Lambda` and then `parsedData |> fst` (-> `SynPat` instead of `SynSimplePat`)
+
+ testList "primary ctor" [
+ testCaseAsync "T(a)" <|
+ testExplicitType
+ """
+ type A($0a$I) =
+ member _.F(b) = a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Forbidden; SpecialRules = [] })
+ testCaseAsync "T(a: int)" <|
+ testExplicitType
+ """
+ type A($0a: int) =
+ member _.F(b) = a + b + 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "T(a, b, c, d)" <|
+ testExplicitType
+ """
+ type A(a, b, $0c$I, d) =
+ member _.F(b) = a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Forbidden; SpecialRules = [] })
+ testCaseAsync "T(a, b, c: int, d)" <|
+ testExplicitType
+ """
+ type A(a, b, $0c: int, d) =
+ member _.F(b) = a + b + 1
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "T([]a)" <|
+ testExplicitType
+ """
+ type Attr() =
+ inherit System.Attribute()
+ type A([]$0a$I) =
+ member _.F(b) = a + b + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Forbidden; SpecialRules = [] })
+ ]
+ ]
+
+ testList "detect existing annotation" [
+ testCaseAsync "let (value): int =" <|
+ testExplicitType
+ """
+ let ($0value): int = 3
+ """
+ (ExplicitType.Exists)
+ testCaseAsync "let ((value)): int =" <|
+ testExplicitType
+ """
+ let (($0value)): int = 3
+ """
+ (ExplicitType.Exists)
+ ]
+ ]
From 417e99ea8a205f79a22adfdaf8ad88a038454e02 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Thu, 12 May 2022 11:49:08 +0200
Subject: [PATCH 06/29] Fix: type hint isn't truncated
Fix: no `InsertText` for `fsharp/inlayHints`
Note: Simple, hacky solution which throws away everything not directly inserted at Hint Location and everything that's just parens
-> doesn't always produce correct solution -> use `textDocument/inlayHint` instead
Fix: tests fail because of missing inserts
---
src/FsAutoComplete.Core/InlayHints.fs | 2 +-
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 10 +++++++++-
2 files changed, 10 insertions(+), 2 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 0408ca74e..1e8bde25d 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -794,7 +794,7 @@ let private tryCreateTypeHint
Pos = data.InsertAt
Kind = Type
// TODO: or use tyForAnno?
- Text = ": " + ty
+ Text = ": " + (truncated ty)
//TODO: delay for resolve?
Insertions = Some <| data.CreateEdits tyForAnno
//TODO: implement? delay for resolve?
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index dbe5809e2..4154ffe54 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2653,7 +2653,15 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
hints
|> Array.map (fun h -> {
Text = h.Text
- InsertText = None
+ InsertText =
+ match h.Insertions with
+ | None -> None
+ | Some inserts ->
+ inserts
+ |> Seq.filter (fun i -> i.Pos = h.Pos && i.Text <> ")" && i.Text <> "(")
+ |> Seq.map (fun i -> i.Text)
+ |> String.concat ""
+ |> Some
Pos = fcsPosToLsp h.Pos
Kind = mapHintKind h.Kind
})
From fd76700c8476db2ef6349e960634b6e6326e47a2 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Thu, 12 May 2022 11:59:50 +0200
Subject: [PATCH 07/29] Add some location tests
---
.../InlayHintTests.fs | 34 +++++++++++++++++++
1 file changed, 34 insertions(+)
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index 813a543e8..dc4780986 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -1377,4 +1377,38 @@ let explicitTypeInfoTests =
"""
(ExplicitType.Exists)
]
+
+ testList "trigger location" [
+ testList "let f p = p + 2" [
+ testCaseAsync "trigger for p binding" <|
+ testExplicitType
+ """
+ let f $($0p$I$) = p + 2
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "doesn't trigger for f binding" <|
+ // ENHANCEMENT: handle
+ testExplicitType'
+ """
+ let $0f p = p + 2
+ """
+ None
+ testCaseAsync "doesn't trigger for p usage" <|
+ testExplicitType'
+ """
+ let f p = $0p + 2
+ """
+ None
+ ]
+ testCaseAsync "nested let" <|
+ testExplicitType
+ """
+ let f a b =
+ let res =
+ let $($0t$I$) = a + b
+ t + a
+ res + 3
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ ]
]
From ef4a73c8a8180cad7d23831a9c818aa0c312681e Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 13 May 2022 18:45:46 +0200
Subject: [PATCH 08/29] Handle func values
Examples: (`f`):
* `let f = fun a b -> a + b`
* `let map f v = f v`
* Note: note functions with parameters:
`let f a b = a + b`
Able to add type annotation via AddExplicitType CodeFix,
but disable for InlayHint (for now)
---
src/FsAutoComplete.Core/InlayHints.fs | 16 +++++--
.../CodeFixes/AddExplicitTypeToParameter.fs | 2 +-
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 2 +-
.../AddExplicitTypeToParameterTests.fs | 47 +++++++++++++++++++
4 files changed, 61 insertions(+), 6 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 1e8bde25d..50a29bd25 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -434,7 +434,7 @@ let rec private isDirectlyTyped (identStart: Position) (path: SyntaxVisitorPath)
isDirectlyTyped identStart path
| SyntaxNode.SynPat (SynPat.Attrib (pat=pat)) :: path when rangeContainsPos pat.Range identStart ->
isDirectlyTyped identStart path
- | SyntaxNode.SynBinding (SynBinding (headPat=headPat; returnInfo=Some(SynBindingReturnInfo(typeName=SynType.LongIdent(_))))) :: _ when rangeContainsPos headPat.Range identStart ->
+ | SyntaxNode.SynBinding (SynBinding (headPat=headPat; returnInfo=Some(SynBindingReturnInfo _))) :: _ when rangeContainsPos headPat.Range identStart ->
true
| SyntaxNode.SynExpr (SynExpr.Paren _) :: path ->
isDirectlyTyped identStart path
@@ -751,8 +751,16 @@ let tryGetExplicitTypeInfo
/// * is already typed (-> done by getting `ExplicitType`)
/// * Filters like excluding functions (vs. lambda functions)
/// * `mfv.IsFromDefinition`
-let isPotentialTargetForTypeAnnotation (symbolUse: FSharpSymbolUse, mfv: FSharpMemberOrFunctionOrValue) =
- mfv.IsValue
+///
+/// `allowFunctionValues`: `let f = fun a b -> a + b`
+/// -> enabled: `f` is target
+/// Note: NOT actual functions with direct parameters:
+/// `let f a b = a + b` -> `f` isn't target
+/// Note: can be parameters too:
+/// `let map f v = f v` -> `f` is target
+let isPotentialTargetForTypeAnnotation (allowFunctionValues: bool) (symbolUse: FSharpSymbolUse, mfv: FSharpMemberOrFunctionOrValue) =
+ //ENHANCEMENT: extract settings
+ (mfv.IsValue || (allowFunctionValues && mfv.IsFunction))
&&
not (
mfv.IsMember
@@ -822,7 +830,7 @@ let provideHints
when
symbolUse.IsFromDefinition
&&
- isPotentialTargetForTypeAnnotation (symbolUse, mfv)
+ isPotentialTargetForTypeAnnotation false (symbolUse, mfv)
->
tryGetExplicitTypeInfo (text, parseAndCheck.GetAST) symbolUse.Range.Start
|> Option.bind (fun explTy -> tryCreateTypeHint explTy mfv.FullType symbolUse.DisplayContext)
diff --git a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
index 835f0f190..eeaf29548 100644
--- a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
+++ b/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
@@ -96,7 +96,7 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsStartPos
let res =
InlayHints.tryGetDetailedExplicitTypeInfo
- InlayHints.isPotentialTargetForTypeAnnotation
+ (InlayHints.isPotentialTargetForTypeAnnotation true)
(sourceText, parseAndCheck)
fcsStartPos
match res with
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 4154ffe54..04844adcf 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2763,7 +2763,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
maybe {
let! (symbolUse, mfv, explTy) =
InlayHints.tryGetDetailedExplicitTypeInfo
- InlayHints.isPotentialTargetForTypeAnnotation
+ (InlayHints.isPotentialTargetForTypeAnnotation false)
(lines, tyRes)
(protocolPosToPos range.Start)
let! (_, edits) = explTy.TryGetTypeAndEdits (mfv.FullType, symbolUse.DisplayContext)
diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
index f384a3a2c..db58fd313 100644
--- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
@@ -178,6 +178,53 @@ let tests state =
new(a: int, b) = A(a+b)
member _.F() = a + 1
"""
+ testCaseAsync "can add type to function parameter" <|
+ CodeFix.check server
+ """
+ let map $0f v = f (v+1) + 1
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ let map (f: int -> int) v = f (v+1) + 1
+ """
+ testCaseAsync "can add type to function member parameter" <|
+ CodeFix.check server
+ """
+ type A(a) =
+ member _.F(b, $0f) = f (a+b) + 1
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ type A(a) =
+ member _.F(b, f: int -> int) = f (a+b) + 1
+ """
+ testCaseAsync "can add type to function value" <|
+ CodeFix.check server
+ """
+ let $0f = fun a b -> a + b
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ """
+ let f: int -> int -> int = fun a b -> a + b
+ """
+ testCaseAsync "doesn't trigger for function value with existing type annotation" <|
+ CodeFix.checkNotApplicable server
+ """
+ let $0f: int -> int -> int = fun a b -> a + b
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+ testCaseAsync "doesn't trigger for function parameter with existing type annotation" <|
+ CodeFix.checkNotApplicable server
+ """
+ let map ($0f: int -> int) v = f (v+1) + 1
+ """
+ (Diagnostics.acceptAll)
+ selectCodeFix
+
testList "parens" [
testCaseAsync "single param without parens -> add parens" <|
CodeFix.check server
From e1d54c539ac3813c2c29799cb51a967fe65f3c16 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 13 May 2022 18:23:30 +0200
Subject: [PATCH 09/29] Rename `AddExplicitTypeToParameter` to
`AddExplicitTypeAnnotation`
(Already) handles other bindings too
---
...licitTypeToParameter.fs => AddExplicitTypeAnnotation.fs} | 2 +-
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 4 ++--
.../CodeFixTests/AddExplicitTypeToParameterTests.fs | 6 +++---
test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs | 2 +-
4 files changed, 7 insertions(+), 7 deletions(-)
rename src/FsAutoComplete/CodeFixes/{AddExplicitTypeToParameter.fs => AddExplicitTypeAnnotation.fs} (98%)
diff --git a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs b/src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs
similarity index 98%
rename from src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
rename to src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs
index eeaf29548..c2acc7c61 100644
--- a/src/FsAutoComplete/CodeFixes/AddExplicitTypeToParameter.fs
+++ b/src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs
@@ -1,4 +1,4 @@
-module FsAutoComplete.CodeFix.AddExplicitTypeToParameter
+module FsAutoComplete.CodeFix.AddExplicitTypeAnnotation
open System
open FsToolkit.ErrorHandling
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 04844adcf..1939b3c19 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -893,7 +893,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
AddTypeToIndeterminateValue.fix tryGetParseResultsForFile tryGetProjectOptions
ChangeTypeOfNameToNameOf.fix tryGetParseResultsForFile
AddMissingInstanceMember.fix
- AddExplicitTypeToParameter.fix tryGetParseResultsForFile
+ AddExplicitTypeAnnotation.fix tryGetParseResultsForFile
ConvertPositionalDUToNamed.fix tryGetParseResultsForFile getRangeText
UseTripleQuotedInterpolation.fix tryGetParseResultsForFile getRangeText
RenameParamToMatchSignature.fix tryGetParseResultsForFile |]
@@ -2771,7 +2771,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
{ p with
TextEdits =
edits
- |> AddExplicitTypeToParameter.toLspEdits
+ |> AddExplicitTypeAnnotation.toLspEdits
|> Some
}
return p
diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
index db58fd313..4b699826d 100644
--- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
@@ -1,4 +1,4 @@
-module private FsAutoComplete.Tests.CodeFixTests.AddExplicitTypeToParameterTests
+module private FsAutoComplete.Tests.CodeFixTests.AddExplicitTypeAnnotationTests
open Expecto
open Helpers
@@ -7,8 +7,8 @@ open Utils.CursorbasedTests
open FsAutoComplete.CodeFix
let tests state =
- serverTestList (nameof AddExplicitTypeToParameter) state defaultConfigDto None (fun server -> [
- let selectCodeFix = CodeFix.withTitle AddExplicitTypeToParameter.title
+ serverTestList (nameof AddExplicitTypeAnnotation) state defaultConfigDto None (fun server -> [
+ let selectCodeFix = CodeFix.withTitle AddExplicitTypeAnnotation.title
testCaseAsync "can suggest explicit parameter for record-typed function parameters" <|
CodeFix.check server
"""
diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs
index 5083d3560..adffad2a2 100644
--- a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/Tests.fs
@@ -1481,7 +1481,7 @@ let private wrapExpressionInParenthesesTests state =
let tests state = testList "CodeFix tests" [
HelpersTests.tests
- AddExplicitTypeToParameterTests.tests state
+ AddExplicitTypeAnnotationTests.tests state
addMissingEqualsToTypeDefinitionTests state
addMissingFunKeywordTests state
addMissingInstanceMemberTests state
From 33df930c893573cc81ca1074386618afad66b364 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 13 May 2022 19:50:51 +0200
Subject: [PATCH 10/29] ~~Uglify~~ Format Code
---
src/FsAutoComplete.Core/InlayHints.fs | 760 ++++----
.../Workaround/ServiceParseTreeWalk.fs | 1728 +++++++++--------
.../CodeFixes/AddExplicitTypeAnnotation.fs | 122 +-
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 209 +-
4 files changed, 1499 insertions(+), 1320 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 50a29bd25..bb5e1eb88 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -17,19 +17,16 @@ type HintKind =
| Parameter
| Type
-type HintInsertion = {
- Pos: Position
- Text: string
-}
-type Hint = {
- IdentRange: Range
- Kind: HintKind
- Pos: Position
- Text: string
- Insertions: HintInsertion[] option
- //TODO: allow xml doc
- Tooltip: string option
-}
+type HintInsertion = { Pos: Position; Text: string }
+
+type Hint =
+ { IdentRange: Range
+ Kind: HintKind
+ Pos: Position
+ Text: string
+ Insertions: HintInsertion[] option
+ //TODO: allow xml doc
+ Tooltip: string option }
let private getArgumentsFor (state: FsAutoComplete.State, p: ParseAndCheckResults, identText: Range) =
option {
@@ -111,19 +108,15 @@ let truncated (s: string) =
else
s
-let private createParamHint
- (identRange: Range)
- (paramName: string)
- =
+let private createParamHint (identRange: Range) (paramName: string) =
let format p = p + " ="
- {
- IdentRange = identRange
+
+ { IdentRange = identRange
Pos = identRange.Start
Kind = Parameter
Text = format (truncated paramName)
Insertions = None
- Tooltip = None
- }
+ Tooltip = None }
module private ShouldCreate =
let private isNotWellKnownName =
@@ -323,41 +316,46 @@ module private ShouldCreate =
type TypeName = string
type TypeNameForAnnotation = TypeName
+
type SpecialRule =
- /// For Optional: `?v` -> `?v: int`, NOT `v: int option`
- /// And parens must include optional, not just `v`
+ /// For Optional: `?v` -> `?v: int`, NOT `v: int option`
+ /// And parens must include optional, not just `v`
| RemoveOptionFromType
+
type SpecialRules = SpecialRule list
+
[]
type Parens =
| Forbidden
- /// Technically `Optional` too: Usually additional parens are ok
- ///
- /// Note: `additionalParens` are inside of existing parens:
- /// `(|ident|)`
- /// * `()`: existing parens
- /// * `||`: additional parens location
- | Exist of additionalParens:Range
+ /// Technically `Optional` too: Usually additional parens are ok
+ ///
+ /// Note: `additionalParens` are inside of existing parens:
+ /// `(|ident|)`
+ /// * `()`: existing parens
+ /// * `||`: additional parens location
+ | Exist of additionalParens: Range
| Optional of Range
| Required of Range
-type MissingExplicitType =
- {
- Ident: Range
+
+type MissingExplicitType =
+ { Ident: Range
InsertAt: Position
Parens: Parens
- SpecialRules: SpecialRules
- }
+ SpecialRules: SpecialRules }
+
type MissingExplicitType with
///
/// * type name
/// * type name formatted with `SpecialRules`
/// -> to use as type annotation
///
- member x.FormatType (ty: FSharpType, displayContext: FSharpDisplayContext) : TypeName*TypeNameForAnnotation =
+ member x.FormatType(ty: FSharpType, displayContext: FSharpDisplayContext) : TypeName * TypeNameForAnnotation =
//TODO: Format vs FormatWithConstraints?
let typeName = ty.Format displayContext
+
let anno =
- if x.SpecialRules |> List.contains RemoveOptionFromType then
+ if x.SpecialRules
+ |> List.contains RemoveOptionFromType then
// Optional parameter:
// `static member F(?a) =` -> `: int`, NOT `: int option`
if typeName.EndsWith " option" then
@@ -367,30 +365,30 @@ type MissingExplicitType with
typeName
else
typeName
+
(typeName, anno)
- member x.CreateEdits (typeForAnnotation) =
- [|
- match x.Parens with
- | Parens.Required range ->
- { Pos = range.Start; Text = "(" }
- | _ -> ()
+ member x.CreateEdits(typeForAnnotation) =
+ [| match x.Parens with
+ | Parens.Required range -> { Pos = range.Start; Text = "(" }
+ | _ -> ()
- { Pos = x.InsertAt; Text = ": " }
- { Pos = x.InsertAt; Text = typeForAnnotation }
+ { Pos = x.InsertAt; Text = ": " }
+ { Pos = x.InsertAt
+ Text = typeForAnnotation }
- match x.Parens with
- | Parens.Required range ->
- { Pos = range.End; Text = ")" }
- | _ -> ()
- |]
- member x.TypeAndEdits (ty: FSharpType, displayContext: FSharpDisplayContext) =
- let (ty, tyForAnntotation) = x.FormatType (ty, displayContext)
- let edits = x.CreateEdits (tyForAnntotation)
+ match x.Parens with
+ | Parens.Required range -> { Pos = range.End; Text = ")" }
+ | _ -> () |]
+
+ member x.TypeAndEdits(ty: FSharpType, displayContext: FSharpDisplayContext) =
+ let (ty, tyForAnntotation) = x.FormatType(ty, displayContext)
+ let edits = x.CreateEdits(tyForAnntotation)
(ty, edits)
+
/// Note: No validation of `mfv`!
- member x.TypeAndEdits (mfv: FSharpMemberOrFunctionOrValue, displayContext: FSharpDisplayContext) =
- x.TypeAndEdits (mfv.FullType, displayContext)
+ member x.TypeAndEdits(mfv: FSharpMemberOrFunctionOrValue, displayContext: FSharpDisplayContext) =
+ x.TypeAndEdits(mfv.FullType, displayContext)
/// Note: Missing considers only directly typed, not parently (or ancestorly) typed:
@@ -402,7 +400,7 @@ type MissingExplicitType with
/// ```
[]
type ExplicitType =
- /// in for loop (only indent allowed -- nothing else (neither type nor parens))
+ /// in for loop (only indent allowed -- nothing else (neither type nor parens))
| Invalid
| Exists
| Missing of MissingExplicitType
@@ -410,17 +408,15 @@ type ExplicitType =
| Debug of string
type ExplicitType with
- member x.TryGetTypeAndEdits (ty: FSharpType, displayContext: FSharpDisplayContext) =
+ member x.TryGetTypeAndEdits(ty: FSharpType, displayContext: FSharpDisplayContext) =
match x with
- | ExplicitType.Missing data ->
- data.TypeAndEdits (ty, displayContext)
- |> Some
+ | ExplicitType.Missing data -> data.TypeAndEdits(ty, displayContext) |> Some
| _ -> None
/// Type Annotation must be directly for identifier, not somewhere up the line:
/// `v: int` -> directly typed
/// `(v,_): int*int` -> parently typed
-///
+///
/// Still considered directly typed:
/// * Parentheses: `(v): int`
/// * Attributes: `([]v): int`
@@ -428,18 +424,16 @@ let rec private isDirectlyTyped (identStart: Position) (path: SyntaxVisitorPath)
//TODO: handle SynExpr.Typed? -> not at binding, but usage
match path with
| [] -> false
- | SyntaxNode.SynPat (SynPat.Typed (pat=pat)) :: _ when rangeContainsPos pat.Range identStart ->
- true
- | SyntaxNode.SynPat (SynPat.Paren _) :: path ->
- isDirectlyTyped identStart path
- | SyntaxNode.SynPat (SynPat.Attrib (pat=pat)) :: path when rangeContainsPos pat.Range identStart ->
- isDirectlyTyped identStart path
- | SyntaxNode.SynBinding (SynBinding (headPat=headPat; returnInfo=Some(SynBindingReturnInfo _))) :: _ when rangeContainsPos headPat.Range identStart ->
- true
- | SyntaxNode.SynExpr (SynExpr.Paren _) :: path ->
- isDirectlyTyped identStart path
- | SyntaxNode.SynExpr (SynExpr.Typed (expr=expr)) :: _ when rangeContainsPos expr.Range identStart ->
- true
+ | SyntaxNode.SynPat (SynPat.Typed (pat = pat)) :: _ when rangeContainsPos pat.Range identStart -> true
+ | SyntaxNode.SynPat (SynPat.Paren _) :: path -> isDirectlyTyped identStart path
+ | SyntaxNode.SynPat (SynPat.Attrib (pat = pat)) :: path when rangeContainsPos pat.Range identStart ->
+ isDirectlyTyped identStart path
+ | SyntaxNode.SynBinding (SynBinding (headPat = headPat; returnInfo = Some (SynBindingReturnInfo _))) :: _ when
+ rangeContainsPos headPat.Range identStart
+ ->
+ true
+ | SyntaxNode.SynExpr (SynExpr.Paren _) :: path -> isDirectlyTyped identStart path
+ | SyntaxNode.SynExpr (SynExpr.Typed (expr = expr)) :: _ when rangeContainsPos expr.Range identStart -> true
| _ -> false
/// Note: FULL range of pattern -> everything in parens
@@ -448,105 +442,109 @@ let rec private isDirectlyTyped (identStart: Position) (path: SyntaxVisitorPath)
let rec private getParsenForPatternWithIdent (patternRange: Range) (identStart: Position) (path: SyntaxVisitorPath) =
match path with
| SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
- // (x)
- Parens.Exist patternRange
- | SyntaxNode.SynBinding (SynBinding(headPat=headPat)) :: _ when rangeContainsPos headPat.Range identStart ->
- // let x =
- Parens.Optional patternRange
- | SyntaxNode.SynPat (SynPat.Tuple (isStruct=true)) :: _ ->
- // struct (x,y)
- Parens.Optional patternRange
+ // (x)
+ Parens.Exist patternRange
+ | SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _ when rangeContainsPos headPat.Range identStart ->
+ // let x =
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.Tuple(isStruct = true)) :: _ ->
+ // struct (x,y)
+ Parens.Optional patternRange
| SyntaxNode.SynPat (SynPat.Tuple _) :: SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
- // (x,y)
- Parens.Optional patternRange
+ // (x,y)
+ Parens.Optional patternRange
| SyntaxNode.SynPat (SynPat.Tuple _) :: _ ->
- // x,y
- Parens.Required patternRange
+ // x,y
+ Parens.Required patternRange
| SyntaxNode.SynPat (SynPat.ArrayOrList _) :: _ ->
- // [x;y;z]
- Parens.Optional patternRange
- | SyntaxNode.SynPat (SynPat.As (rhsPat=pat)) :: _ when rangeContainsPos pat.Range identStart ->
- // _ as (value: int)
- Parens.Required patternRange
- | SyntaxNode.SynPat (SynPat.As (lhsPat=pat)) :: _ when rangeContainsPos pat.Range identStart ->
- // value: int as _
- // ^^^^^^^^^^ unlike rhs this here doesn't require parens...
- Parens.Optional patternRange
+ // [x;y;z]
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As (rhsPat = pat)) :: _ when rangeContainsPos pat.Range identStart ->
+ // _ as (value: int)
+ Parens.Required patternRange
+ | SyntaxNode.SynPat (SynPat.As (lhsPat = pat)) :: _ when rangeContainsPos pat.Range identStart ->
+ // value: int as _
+ // ^^^^^^^^^^ unlike rhs this here doesn't require parens...
+ Parens.Optional patternRange
| SyntaxNode.SynPat (SynPat.Record _) :: _ ->
- // { Value=value }
- Parens.Optional patternRange
- | SyntaxNode.SynPat (SynPat.LongIdent (argPats=SynArgPats.NamePatPairs (range=range))) :: _ when rangeContainsPos range identStart ->
- // U (Value=value)
- // ^ ^
- // must exist to be valid
- Parens.Optional patternRange
- | SyntaxNode.SynExpr (SynExpr.LetOrUseBang (isUse=true)) :: _ ->
- // use! x =
- // Note: Type is forbidden too...
- Parens.Forbidden
- | SyntaxNode.SynExpr (SynExpr.LetOrUseBang (isUse=false)) :: _ ->
- // let! x =
- Parens.Required patternRange
- | SyntaxNode.SynExpr (SynExpr.ForEach _) :: _ ->
- // for i in [1..4] do
- Parens.Optional patternRange
- | [] // should not happen?
- | _ ->
- Parens.Required patternRange
+ // { Value=value }
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.LongIdent(argPats = SynArgPats.NamePatPairs (range = range))) :: _ when
+ rangeContainsPos range identStart
+ ->
+ // U (Value=value)
+ // ^ ^
+ // must exist to be valid
+ Parens.Optional patternRange
+ | SyntaxNode.SynExpr (SynExpr.LetOrUseBang(isUse = true)) :: _ ->
+ // use! x =
+ // Note: Type is forbidden too...
+ Parens.Forbidden
+ | SyntaxNode.SynExpr (SynExpr.LetOrUseBang(isUse = false)) :: _ ->
+ // let! x =
+ Parens.Required patternRange
+ | SyntaxNode.SynExpr (SynExpr.ForEach _) :: _ ->
+ // for i in [1..4] do
+ Parens.Optional patternRange
+ | []
+ | _ -> Parens.Required patternRange
/// Gets range of `SynPat.Named`
-///
-/// Issue with range of `SynPat.Named`:
+///
+/// Issue with range of `SynPat.Named`:
/// `pat.range` only covers ident (-> `= ident.idRange`),
/// not `accessibility`.
-///
+///
/// Note: doesn't handle when accessibility is on prev line
let private rangeOfNamedPat (text: NamedText) (pat: SynPat) =
match pat with
- | SynPat.Named (accessibility=None) ->
- pat.Range
- | SynPat.Named (ident=ident; accessibility=Some(access)) ->
- maybe {
- let start = ident.idRange.Start
- let! line = text.GetLine start
-
- let access = access.ToString().ToLowerInvariant().AsSpan()
- // word before ident must be access
- let pre = line.AsSpan(0, start.Column)
- match pre.LastIndexOf(access) with
- | -1 -> return! None
- | c ->
- // must be directly before ident
- let word = pre.Slice(c).TrimEnd()
- if word.Length = access.Length then
- let start = Position.mkPos start.Line c
- let range =
- let range = ident.idRange
- Range.mkRange range.FileName start range.End
- return range
- else
- return! None
- }
- |> Option.defaultValue pat.Range
+ | SynPat.Named(accessibility = None) -> pat.Range
+ | SynPat.Named (ident = ident; accessibility = Some (access)) ->
+ maybe {
+ let start = ident.idRange.Start
+ let! line = text.GetLine start
+
+ let access = access.ToString().ToLowerInvariant().AsSpan()
+ // word before ident must be access
+ let pre = line.AsSpan(0, start.Column)
+
+ match pre.LastIndexOf(access) with
+ | -1 -> return! None
+ | c ->
+ // must be directly before ident
+ let word = pre.Slice(c).TrimEnd()
+
+ if word.Length = access.Length then
+ let start = Position.mkPos start.Line c
+
+ let range =
+ let range = ident.idRange
+ Range.mkRange range.FileName start range.End
+
+ return range
+ else
+ return! None
+ }
+ |> Option.defaultValue pat.Range
| _ -> failwith "Pattern must be Named!"
/// Note: (deliberately) fails when `pat` is neither `Named` nor `OptionalVal`
let rec private getParensForIdentPat (text: NamedText) (pat: SynPat) (path: SyntaxVisitorPath) =
match pat with
- | SynPat.Named (ident=ident) ->
- // neither `range`, not `pat.Range` includes `accessibility`...
- // `let private (a: int)` is not valid, must include private: `let (private a: int)`
- let patternRange = rangeOfNamedPat text pat
- let identStart = ident.idRange.Start
- getParsenForPatternWithIdent patternRange identStart path
- | SynPat.OptionalVal (ident=ident) ->
- let patternRange = pat.Range
- let identStart = ident.idRange.Start
- getParsenForPatternWithIdent patternRange identStart path
+ | SynPat.Named (ident = ident) ->
+ // neither `range`, not `pat.Range` includes `accessibility`...
+ // `let private (a: int)` is not valid, must include private: `let (private a: int)`
+ let patternRange = rangeOfNamedPat text pat
+ let identStart = ident.idRange.Start
+ getParsenForPatternWithIdent patternRange identStart path
+ | SynPat.OptionalVal (ident = ident) ->
+ let patternRange = pat.Range
+ let identStart = ident.idRange.Start
+ getParsenForPatternWithIdent patternRange identStart path
| _ -> failwith "Pattern must be Named or OptionalVal!"
/// `traversePat`from `SyntaxTraversal.Traverse`
-///
+///
/// Reason for extra function:
/// * can be used to traverse when traversal isn't available via `defaultTraverse` (for example: in `VisitExpr`, and want traverse a `SynPat`)
/// * visits `SynPat.As(lhsPat, rhsPat)` & `SynPat.Record(fieldPats)`
@@ -554,269 +552,263 @@ let rec private getParensForIdentPat (text: NamedText) (pat: SynPat) (path: Synt
/// Note: doesn't visit `SynPat.Typed(targetType)`: requires traversal into `SynType` (`SynPat.Typed(pat)` gets visited!)
let rec private traversePat (visitor: SyntaxVisitorBase<_>) origPath pat =
let defaultTraverse p =
- let path = SyntaxNode.SynPat p :: origPath
- match p with
- | SynPat.Paren (p, _) -> traversePat visitor path p
- | SynPat.Or (p1, p2, _, _) -> [ p1; p2] |> List.tryPick (traversePat visitor path)
- | SynPat.Ands (ps, _)
- | SynPat.Tuple (_, ps, _)
- | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat visitor path)
- | SynPat.Attrib (p, _, _) -> traversePat visitor path p
- | SynPat.LongIdent(argPats=args) ->
- match args with
- | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat visitor path)
- | SynArgPats.NamePatPairs (ps, _) ->
- ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat visitor path)
- | SynPat.Typed (p, _, _) ->
- traversePat visitor path p
- | SynPat.As (lhsPat=lhs; rhsPat=rhs) ->
- [lhs; rhs] |> List.tryPick (traversePat visitor path)
- | SynPat.Record (fieldPats=fieldPats) ->
- fieldPats
- |> List.map (fun (_,_,pat) -> pat)
- |> List.tryPick (traversePat visitor path)
- | _ -> None
+ let path = SyntaxNode.SynPat p :: origPath
+
+ match p with
+ | SynPat.Paren (p, _) -> traversePat visitor path p
+ | SynPat.Or (p1, p2, _, _) ->
+ [ p1; p2 ]
+ |> List.tryPick (traversePat visitor path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat visitor path)
+ | SynPat.Attrib (p, _, _) -> traversePat visitor path p
+ | SynPat.LongIdent (argPats = args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat visitor path)
+ | SynArgPats.NamePatPairs (ps, _) ->
+ ps
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat visitor path)
+ | SynPat.Typed (p, _, _) -> traversePat visitor path p
+ | SynPat.As (lhsPat = lhs; rhsPat = rhs) ->
+ [ lhs; rhs ]
+ |> List.tryPick (traversePat visitor path)
+ | SynPat.Record (fieldPats = fieldPats) ->
+ fieldPats
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat visitor path)
+ | _ -> None
+
visitor.VisitPat(origPath, defaultTraverse, pat)
-let tryGetExplicitTypeInfo
- (text: NamedText, ast: ParsedInput)
- (pos: Position)
- : ExplicitType option
- =
- SyntaxTraversal.Traverse(pos, ast, { new SyntaxVisitorBase<_>() with
- member x.VisitExpr(path, traverseSynExpr, defaultTraverse, expr) =
- match expr with
- // special case:
- // for loop:
- // for i = 1 to 3 do
- // ^ -> just Ident (neither SynPat nor SynSimplePat)
- // -> no type allowed (not even parens)...
- | SynExpr.For (ident=ident) when rangeContainsPos ident.idRange pos ->
- ExplicitType.Invalid
- |> Some
- | SynExpr.Lambda (parsedData=Some (args, body)) ->
- // original visitor walks down `SynExpr.Lambda(args; body)`
- // Issue:
- // `args` are `SynSimplePats` -> no complex pattern
- // When pattern: is in body. In `args` then generated Identifier:
- // * `let f1 = fun v -> v + 1`
- // -> `v` is in `args` (-> SynSimplePat)
- // * `let f2 = fun (Value v) -> v + 1`
- // -> compiler generated `_arg1` in `args`,
- // and `v` is inside match expression in `body` & `parsedData` (-> `SynPat` )
- // -> unify by looking into `parsedData` (-> args & body):
- // -> `parsedData |> fst` contains `args` as `SynPat`
- //TODO: always correct?
- let arg =
- args
- |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
- if arg |> Option.isSome then
- let pat = arg.Value
- traversePat x (SyntaxNode.SynExpr(expr)::path) pat
- elif rangeContainsPos body.Range pos then
- traverseSynExpr body
- else
- None
- | _ -> defaultTraverse expr
-
- member _.VisitPat(path, defaultTraverse, pat) =
- let invalidPositionForTypeAnnotation (pos: Position) (path: SyntaxNode list) =
- match path with
- | SyntaxNode.SynExpr (SynExpr.LetOrUseBang (isUse=true)) :: _ ->
- // use! value =
- true
- | _ -> false
-
- //TODO: differentiate between directly typed and parently typed?
- // (maybe even further ancestorly typed?)
- // ```fsharp
- // let (a: int,b) = (1,2)
- // // ^^^ directly typed
- // let (a,b): int*int = (1,2)
- // // ^^^ parently typed
- // ```
- // currently: only directly typed is typed
- match pat with
- // no simple way out: Range for `SynPat.LongIdent` doesn't cover full pats (just ident)...
- // | _ when not (rangeContainsPos pat.Range pos) -> None
- | SynPat.Named (ident=ident)
- when
- rangeContainsPos ident.idRange pos
- &&
- invalidPositionForTypeAnnotation pos path
- ->
- ExplicitType.Invalid
- |> Some
- | SynPat.Named (ident=ident; isThisVal=false) when rangeContainsPos ident.idRange pos ->
- let typed = isDirectlyTyped ident.idRange.Start path
- if typed then
- ExplicitType.Exists
- |> Some
- else
- let parens = getParensForIdentPat text pat path
- ExplicitType.Missing {
- Ident = ident.idRange
- InsertAt = ident.idRange.End
- Parens = parens
- SpecialRules = []
- }
- |> Some
- | SynPat.OptionalVal (ident=ident) when rangeContainsPos ident.idRange pos ->
- let typed = isDirectlyTyped ident.idRange.Start path
- if typed then
- ExplicitType.Exists
- |> Some
- else
- let parens = getParensForIdentPat text pat path
- ExplicitType.Missing {
- Ident = ident.idRange
- InsertAt = ident.idRange.End
- Parens = parens
- SpecialRules = [RemoveOptionFromType]
- // ^^^^^^^^^^^^^^^^^^^^
- // `?v: int`, NOT `?v: int option`
- }
- |> Some
- | _ -> defaultTraverse pat //todo: custom traverse? -> doesn't require FCS to handle `SynPat.Record`
-
- member _.VisitSimplePats(path, pats) =
- // SynSimplePats at:
- // * Primary ctor:
- // * SynMemberDefn.ImplicitCtor.ctorArgs
- // * SynTypeDefnSimpleRepr.General.implicitCtorSynPats
- // //TODO: when? example?
- // * Lambda: SynExpr.Lambda.args
- // * issue: might or might not be actual identifier
- // * `let f1 = fun v -> v + 1`
- // -> `v` is in `args` (-> SynSimplePat)
- // * `let f2 = fun (Value v) -> v + 1`
- // -> compiler generated `_arg1` in `args`,
- // and `v` is inside match expression in `body` & `parsedData` (-> `SynPat` )
- maybe {
- let! pat =
- pats
- |> List.tryFind (fun p -> rangeContainsPos p.Range pos)
- let rec tryGetIdent pat =
+let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) : ExplicitType option =
+ SyntaxTraversal.Traverse(
+ pos,
+ ast,
+ { new SyntaxVisitorBase<_>() with
+ member x.VisitExpr(path, traverseSynExpr, defaultTraverse, expr) =
+ match expr with
+ // special case:
+ // for loop:
+ // for i = 1 to 3 do
+ // ^ -> just Ident (neither SynPat nor SynSimplePat)
+ // -> no type allowed (not even parens)...
+ | SynExpr.For (ident = ident) when rangeContainsPos ident.idRange pos -> ExplicitType.Invalid |> Some
+ | SynExpr.Lambda(parsedData = Some (args, body)) ->
+ // original visitor walks down `SynExpr.Lambda(args; body)`
+ // Issue:
+ // `args` are `SynSimplePats` -> no complex pattern
+ // When pattern: is in body. In `args` then generated Identifier:
+ // * `let f1 = fun v -> v + 1`
+ // -> `v` is in `args` (-> SynSimplePat)
+ // * `let f2 = fun (Value v) -> v + 1`
+ // -> compiler generated `_arg1` in `args`,
+ // and `v` is inside match expression in `body` & `parsedData` (-> `SynPat` )
+ // -> unify by looking into `parsedData` (-> args & body):
+ // -> `parsedData |> fst` contains `args` as `SynPat`
+ //TODO: always correct?
+ let arg =
+ args
+ |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
+
+ if arg |> Option.isSome then
+ let pat = arg.Value
+ traversePat x (SyntaxNode.SynExpr(expr) :: path) pat
+ elif rangeContainsPos body.Range pos then
+ traverseSynExpr body
+ else
+ None
+ | _ -> defaultTraverse expr
+
+ member _.VisitPat(path, defaultTraverse, pat) =
+ let invalidPositionForTypeAnnotation (pos: Position) (path: SyntaxNode list) =
+ match path with
+ | SyntaxNode.SynExpr (SynExpr.LetOrUseBang(isUse = true)) :: _ ->
+ // use! value =
+ true
+ | _ -> false
+
+ //TODO: differentiate between directly typed and parently typed?
+ // (maybe even further ancestorly typed?)
+ // ```fsharp
+ // let (a: int,b) = (1,2)
+ // // ^^^ directly typed
+ // let (a,b): int*int = (1,2)
+ // // ^^^ parently typed
+ // ```
+ // currently: only directly typed is typed
match pat with
- | SynSimplePat.Id (ident=ident) when rangeContainsPos ident.idRange pos ->
- Some pat
- | SynSimplePat.Attrib (pat=pat) when rangeContainsPos pat.Range pos ->
- tryGetIdent pat
- | SynSimplePat.Typed (pat=pat) when rangeContainsPos pat.Range pos ->
- tryGetIdent pat
- | _ -> None
- let! ident = tryGetIdent pat
- match ident with
- | SynSimplePat.Id (isCompilerGenerated=false) ->
- let rec isTyped =
- function
- | SynSimplePat.Typed _ -> true
- | SynSimplePat.Id _ -> false
- | SynSimplePat.Attrib (pat=pat) -> isTyped pat
- let typed = isTyped pat
+ // no simple way out: Range for `SynPat.LongIdent` doesn't cover full pats (just ident)...
+ // | _ when not (rangeContainsPos pat.Range pos) -> None
+ | SynPat.Named (ident = ident) when
+ rangeContainsPos ident.idRange pos
+ && invalidPositionForTypeAnnotation pos path
+ ->
+ ExplicitType.Invalid |> Some
+ | SynPat.Named (ident = ident; isThisVal = false) when rangeContainsPos ident.idRange pos ->
+ let typed = isDirectlyTyped ident.idRange.Start path
+
if typed then
- return ExplicitType.Exists
+ ExplicitType.Exists |> Some
else
- let isCtor =
- path
- |> List.tryHead
- |> Option.map (
- function
- // normal ctor in type: `type A(v) = ...`
- | SyntaxNode.SynMemberDefn (SynMemberDefn.ImplicitCtor _) -> true
- //TODO: when? example?
- | SyntaxNode.SynTypeDefn (SynTypeDefn(typeRepr=SynTypeDefnRepr.Simple(simpleRepr=SynTypeDefnSimpleRepr.General(implicitCtorSynPats=Some(ctorPats)))))
- when
- rangeContainsPos ctorPats.Range pos
- ->
- true
- | _ -> false
- )
- |> Option.defaultValue false
- if isCtor then
- return ExplicitType.Missing {
- Ident = ident.Range
- InsertAt = ident.Range.End
- Parens = Parens.Forbidden
- SpecialRules = []
+ let parens = getParensForIdentPat text pat path
+
+ ExplicitType.Missing
+ { Ident = ident.idRange
+ InsertAt = ident.idRange.End
+ Parens = parens
+ SpecialRules = [] }
+ |> Some
+ | SynPat.OptionalVal (ident = ident) when rangeContainsPos ident.idRange pos ->
+ let typed = isDirectlyTyped ident.idRange.Start path
+
+ if typed then
+ ExplicitType.Exists |> Some
+ else
+ let parens = getParensForIdentPat text pat path
+
+ ExplicitType.Missing
+ { Ident = ident.idRange
+ InsertAt = ident.idRange.End
+ Parens = parens
+ SpecialRules = [ RemoveOptionFromType ]
+ // ^^^^^^^^^^^^^^^^^^^^
+ // `?v: int`, NOT `?v: int option`
}
+ |> Some
+ | _ -> defaultTraverse pat //todo: custom traverse? -> doesn't require FCS to handle `SynPat.Record`
+
+ member _.VisitSimplePats(path, pats) =
+ // SynSimplePats at:
+ // * Primary ctor:
+ // * SynMemberDefn.ImplicitCtor.ctorArgs
+ // * SynTypeDefnSimpleRepr.General.implicitCtorSynPats
+ // //TODO: when? example?
+ // * Lambda: SynExpr.Lambda.args
+ // * issue: might or might not be actual identifier
+ // * `let f1 = fun v -> v + 1`
+ // -> `v` is in `args` (-> SynSimplePat)
+ // * `let f2 = fun (Value v) -> v + 1`
+ // -> compiler generated `_arg1` in `args`,
+ // and `v` is inside match expression in `body` & `parsedData` (-> `SynPat` )
+ maybe {
+ let! pat =
+ pats
+ |> List.tryFind (fun p -> rangeContainsPos p.Range pos)
+
+ let rec tryGetIdent pat =
+ match pat with
+ | SynSimplePat.Id (ident = ident) when rangeContainsPos ident.idRange pos -> Some pat
+ | SynSimplePat.Attrib (pat = pat) when rangeContainsPos pat.Range pos -> tryGetIdent pat
+ | SynSimplePat.Typed (pat = pat) when rangeContainsPos pat.Range pos -> tryGetIdent pat
+ | _ -> None
+
+ let! ident = tryGetIdent pat
+
+ match ident with
+ | SynSimplePat.Id(isCompilerGenerated = false) ->
+ let rec isTyped =
+ function
+ | SynSimplePat.Typed _ -> true
+ | SynSimplePat.Id _ -> false
+ | SynSimplePat.Attrib (pat = pat) -> isTyped pat
+
+ let typed = isTyped pat
+
+ if typed then
+ return ExplicitType.Exists
else
- // lambda
- return! None
- | _ -> return! None
- }
- })
+ let isCtor =
+ path
+ |> List.tryHead
+ |> Option.map (function
+ // normal ctor in type: `type A(v) = ...`
+ | SyntaxNode.SynMemberDefn (SynMemberDefn.ImplicitCtor _) -> true
+ //TODO: when? example?
+ | SyntaxNode.SynTypeDefn (SynTypeDefn(typeRepr = SynTypeDefnRepr.Simple(simpleRepr = SynTypeDefnSimpleRepr.General(implicitCtorSynPats = Some (ctorPats))))) when
+ rangeContainsPos ctorPats.Range pos
+ ->
+ true
+ | _ -> false)
+ |> Option.defaultValue false
+
+ if isCtor then
+ return
+ ExplicitType.Missing
+ { Ident = ident.Range
+ InsertAt = ident.Range.End
+ Parens = Parens.Forbidden
+ SpecialRules = [] }
+ else
+ // lambda
+ return! None
+ | _ -> return! None
+ } }
+ )
/// Note: No exhausting check. Doesn't check for:
/// * is already typed (-> done by getting `ExplicitType`)
/// * Filters like excluding functions (vs. lambda functions)
/// * `mfv.IsFromDefinition`
-///
-/// `allowFunctionValues`: `let f = fun a b -> a + b`
-/// -> enabled: `f` is target
+///
+/// `allowFunctionValues`: `let f = fun a b -> a + b`
+/// -> enabled: `f` is target
/// Note: NOT actual functions with direct parameters:
-/// `let f a b = a + b` -> `f` isn't target
+/// `let f a b = a + b` -> `f` isn't target
/// Note: can be parameters too:
/// `let map f v = f v` -> `f` is target
-let isPotentialTargetForTypeAnnotation (allowFunctionValues: bool) (symbolUse: FSharpSymbolUse, mfv: FSharpMemberOrFunctionOrValue) =
+let isPotentialTargetForTypeAnnotation
+ (allowFunctionValues: bool)
+ (symbolUse: FSharpSymbolUse, mfv: FSharpMemberOrFunctionOrValue)
+ =
//ENHANCEMENT: extract settings
- (mfv.IsValue || (allowFunctionValues && mfv.IsFunction))
- &&
- not (
+ (mfv.IsValue
+ || (allowFunctionValues && mfv.IsFunction))
+ && not (
mfv.IsMember
- ||
- mfv.IsMemberThisValue
- ||
- mfv.IsConstructorThisValue
- ||
- PrettyNaming.IsOperatorDisplayName mfv.DisplayName
+ || mfv.IsMemberThisValue
+ || mfv.IsConstructorThisValue
+ || PrettyNaming.IsOperatorDisplayName mfv.DisplayName
)
let tryGetDetailedExplicitTypeInfo
(isValidTarget: FSharpSymbolUse * FSharpMemberOrFunctionOrValue -> bool)
(text: NamedText, parseAndCheck: ParseAndCheckResults)
(pos: Position)
- = maybe {
+ =
+ maybe {
let! line = text.GetLine pos
let! symbolUse = parseAndCheck.TryGetSymbolUse pos line
+
match symbolUse.Symbol with
- | :? FSharpMemberOrFunctionOrValue as mfv
- when
- isValidTarget (symbolUse, mfv)
- ->
+ | :? FSharpMemberOrFunctionOrValue as mfv when isValidTarget (symbolUse, mfv) ->
let! explTy = tryGetExplicitTypeInfo (text, parseAndCheck.GetAST) pos
return (symbolUse, mfv, explTy)
| _ -> return! None
}
-let private tryCreateTypeHint
- (explicitType: ExplicitType)
- (ty: FSharpType)
- (displayContext: FSharpDisplayContext)
- =
+let private tryCreateTypeHint (explicitType: ExplicitType) (ty: FSharpType) (displayContext: FSharpDisplayContext) =
match explicitType with
| ExplicitType.Missing data ->
- let (ty, tyForAnno) = data.FormatType (ty, displayContext)
- {
- IdentRange = data.Ident
- Pos = data.InsertAt
- Kind = Type
- // TODO: or use tyForAnno?
- Text = ": " + (truncated ty)
- //TODO: delay for resolve?
- Insertions = Some <| data.CreateEdits tyForAnno
- //TODO: implement? delay for resolve?
- Tooltip = None
- }
- |> Some
+ let (ty, tyForAnno) = data.FormatType(ty, displayContext)
+
+ { IdentRange = data.Ident
+ Pos = data.InsertAt
+ Kind = Type
+ // TODO: or use tyForAnno?
+ Text = ": " + (truncated ty)
+ //TODO: delay for resolve?
+ Insertions = Some <| data.CreateEdits tyForAnno
+ //TODO: implement? delay for resolve?
+ Tooltip = None }
+ |> Some
| _ -> None
-let provideHints
- (text: NamedText, parseAndCheck: ParseAndCheckResults, range: Range)
- : Async
- =
+let provideHints (text: NamedText, parseAndCheck: ParseAndCheckResults, range: Range) : Async =
asyncResult {
let! cancellationToken = Async.CancellationToken
+
let symbolUses =
parseAndCheck.GetCheckResults.GetAllUsesOfAllSymbolsInFile(cancellationToken)
|> Seq.filter (fun su -> rangeContainsRange range su.Range)
@@ -826,11 +818,9 @@ let provideHints
for symbolUse in symbolUses do
match symbolUse.Symbol with
- | :? FSharpMemberOrFunctionOrValue as mfv
- when
- symbolUse.IsFromDefinition
- &&
- isPotentialTargetForTypeAnnotation false (symbolUse, mfv)
+ | :? FSharpMemberOrFunctionOrValue as mfv when
+ symbolUse.IsFromDefinition
+ && isPotentialTargetForTypeAnnotation false (symbolUse, mfv)
->
tryGetExplicitTypeInfo (text, parseAndCheck.GetAST) symbolUse.Range.Start
|> Option.bind (fun explTy -> tryCreateTypeHint explTy mfv.FullType symbolUse.DisplayContext)
@@ -914,7 +904,7 @@ let provideHints
if ShouldCreate.paramHint methodOrConstructor definitionArg appliedArgText then
let hint = createParamHint appliedArgRange definitionArg.DisplayName
parameterHints.Add(hint)
-
+
| _ -> ()
let typeHints = typeHints.ToImmutableArray()
diff --git a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
index 33f2fbf85..da594eebe 100644
--- a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
+++ b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
@@ -1,11 +1,11 @@
/// Current (and older) FCS Visitors don't walk into into `SynMatchClause`s in `SynExpr.Match` (at least not into their patterns)
/// -> Cannot walk to `SynPat.Named` inside Match Case
-///
-/// That's fixed in `main` FCS
+///
+/// That's fixed in `main` FCS
/// -> This here is a copy of [`ServiceParseTreeWalk.fs`@`3a610e0`](https://github.com/dotnet/fsharp/blob/3a610e06d07f47f405168be5ea05495d48fcec6d/src/fsharp/service/ServiceParseTreeWalk.fs) with slight adjustments so it compiles
-///
+///
/// **Remove once it's available as nuget package and updated here in FSAC**
-///
+///
/// Additional: `traversePat.defaultTraverse` walks down `SynPat.As` & `SynPat.Record` (see dotnet/fsharp#13114)
module internal FsAutoComplete.Core.Workaround.ServiceParseTreeWalk
//TODO: Use FSC once newer nuget package is available
@@ -17,818 +17,1002 @@ open FSharp.Compiler.Text.Range
type private Range with
- member m.ToShortString() = sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn
+ member m.ToShortString() =
+ sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn
let rec private stripParenTypes synType =
- match synType with
- | SynType.Paren (innerType, _) -> stripParenTypes innerType
- | _ -> synType
+ match synType with
+ | SynType.Paren (innerType, _) -> stripParenTypes innerType
+ | _ -> synType
-let private (|StripParenTypes|) synType =
- stripParenTypes synType
+let private (|StripParenTypes|) synType = stripParenTypes synType
[]
type SyntaxVisitorBase<'T>() =
- abstract VisitExpr: path: SyntaxVisitorPath * traverseSynExpr: (SynExpr -> 'T option) * defaultTraverse: (SynExpr -> 'T option) * synExpr: SynExpr -> 'T option
- default _.VisitExpr(path: SyntaxVisitorPath, traverseSynExpr: SynExpr -> 'T option, defaultTraverse: SynExpr -> 'T option, synExpr: SynExpr) =
- ignore (path, traverseSynExpr, defaultTraverse, synExpr)
- None
-
- /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
- abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
- default _.VisitTypeAbbrev(path, synType, range) =
- ignore (path, synType, range)
- None
-
- /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
- abstract VisitImplicitInherit: path: SyntaxVisitorPath * defaultTraverse: (SynExpr -> 'T option) * inheritedType: SynType * synArgs: SynExpr * range: range -> 'T option
- default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
- ignore (path, inheritedType, range)
- defaultTraverse synArgs
-
- /// VisitModuleDecl allows overriding module declaration behavior
- abstract VisitModuleDecl: path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
- default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
- ignore path
- defaultTraverse synModuleDecl
-
- /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
- abstract VisitBinding: path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
- default _.VisitBinding(path, defaultTraverse, synBinding) =
- ignore path
- defaultTraverse synBinding
-
- /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
- abstract VisitMatchClause: path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
- default _.VisitMatchClause(path, defaultTraverse, matchClause) =
- ignore path
- defaultTraverse matchClause
-
- /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
- abstract VisitInheritSynMemberDefn: path: SyntaxVisitorPath * componentInfo: SynComponentInfo * typeDefnKind: SynTypeDefnKind * SynType * SynMemberDefns * range -> 'T option
- default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
- ignore (path, componentInfo, typeDefnKind, synType, members, range)
- None
-
- /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
- abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
- default _.VisitRecordDefn(path, fields, range) =
- ignore (path, fields, range)
- None
-
- /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
- abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
- default _.VisitUnionDefn(path, cases, range) =
- ignore (path, cases, range)
- None
+ abstract VisitExpr:
+ path: SyntaxVisitorPath *
+ traverseSynExpr: (SynExpr -> 'T option) *
+ defaultTraverse: (SynExpr -> 'T option) *
+ synExpr: SynExpr ->
+ 'T option
+
+ default _.VisitExpr
+ (
+ path: SyntaxVisitorPath,
+ traverseSynExpr: SynExpr -> 'T option,
+ defaultTraverse: SynExpr -> 'T option,
+ synExpr: SynExpr
+ ) =
+ ignore (path, traverseSynExpr, defaultTraverse, synExpr)
+ None
+
+ /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
+ abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
+
+ default _.VisitTypeAbbrev(path, synType, range) =
+ ignore (path, synType, range)
+ None
+
+ /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
+ abstract VisitImplicitInherit:
+ path: SyntaxVisitorPath *
+ defaultTraverse: (SynExpr -> 'T option) *
+ inheritedType: SynType *
+ synArgs: SynExpr *
+ range: range ->
+ 'T option
+
+ default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
+ ignore (path, inheritedType, range)
+ defaultTraverse synArgs
+
+ /// VisitModuleDecl allows overriding module declaration behavior
+ abstract VisitModuleDecl:
+ path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
+
+ default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
+ ignore path
+ defaultTraverse synModuleDecl
+
+ /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
+ abstract VisitBinding:
+ path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
+
+ default _.VisitBinding(path, defaultTraverse, synBinding) =
+ ignore path
+ defaultTraverse synBinding
+
+ /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
+ abstract VisitMatchClause:
+ path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
+
+ default _.VisitMatchClause(path, defaultTraverse, matchClause) =
+ ignore path
+ defaultTraverse matchClause
+
+ /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
+ abstract VisitInheritSynMemberDefn:
+ path: SyntaxVisitorPath *
+ componentInfo: SynComponentInfo *
+ typeDefnKind: SynTypeDefnKind *
+ SynType *
+ SynMemberDefns *
+ range ->
+ 'T option
+
+ default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
+ ignore (path, componentInfo, typeDefnKind, synType, members, range)
+ None
+
+ /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
+ abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
+
+ default _.VisitRecordDefn(path, fields, range) =
+ ignore (path, fields, range)
+ None
+
+ /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
+ abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
+
+ default _.VisitUnionDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
+ abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
+
+ default _.VisitEnumDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
+ abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
+
+ default _.VisitInterfaceSynMemberDefnType(path, synType) =
+ ignore (path, synType)
+ None
+
+ /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
+ abstract VisitRecordField:
+ path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: LongIdentWithDots option -> 'T option
+
+ default _.VisitRecordField(path, copyOpt, recordField) =
+ ignore (path, copyOpt, recordField)
+ None
+
+ /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
+ abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
+
+ default _.VisitHashDirective(path, hashDirective, range) =
+ ignore (path, hashDirective, range)
+ None
+
+ /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
+ abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
+
+ default _.VisitModuleOrNamespace(path, synModuleOrNamespace) =
+ ignore (path, synModuleOrNamespace)
+ None
+
+ /// VisitComponentInfo allows overriding behavior when visiting type component infos
+ abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
- /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
- abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
- default _.VisitEnumDefn(path, cases, range) =
- ignore (path, cases, range)
- None
-
- /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
- abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
- default _.VisitInterfaceSynMemberDefnType(path, synType) =
- ignore (path, synType)
- None
+ default _.VisitComponentInfo(path, synComponentInfo) =
+ ignore (path, synComponentInfo)
+ None
- /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
- abstract VisitRecordField: path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: LongIdentWithDots option -> 'T option
- default _.VisitRecordField (path, copyOpt, recordField) =
- ignore (path, copyOpt, recordField)
- None
+ /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
+ abstract VisitLetOrUse:
+ path: SyntaxVisitorPath *
+ isRecursive: bool *
+ defaultTraverse: (SynBinding -> 'T option) *
+ bindings: SynBinding list *
+ range: range ->
+ 'T option
- /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
- abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
- default _.VisitHashDirective (path, hashDirective, range) =
- ignore (path, hashDirective, range)
- None
+ default _.VisitLetOrUse(path, isRecursive, defaultTraverse, bindings, range) =
+ ignore (path, isRecursive, defaultTraverse, bindings, range)
+ None
- /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
- abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
- default _.VisitModuleOrNamespace (path, synModuleOrNamespace) =
- ignore (path, synModuleOrNamespace)
- None
+ /// VisitType allows overriding behavior when visiting simple pats
+ abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
- /// VisitComponentInfo allows overriding behavior when visiting type component infos
- abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
- default _.VisitComponentInfo (path, synComponentInfo) =
- ignore (path, synComponentInfo)
- None
+ default _.VisitSimplePats(path, synPats) =
+ ignore (path, synPats)
+ None
- /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
- abstract VisitLetOrUse: path: SyntaxVisitorPath * isRecursive: bool * defaultTraverse: (SynBinding -> 'T option) * bindings: SynBinding list * range: range -> 'T option
- default _.VisitLetOrUse (path, isRecursive, defaultTraverse, bindings, range) =
- ignore (path, isRecursive, defaultTraverse, bindings, range)
- None
+ /// VisitPat allows overriding behavior when visiting patterns
+ abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
- /// VisitType allows overriding behavior when visiting simple pats
- abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
- default _.VisitSimplePats (path, synPats) =
- ignore (path, synPats)
- None
+ default _.VisitPat(path, defaultTraverse, synPat) =
+ ignore path
+ defaultTraverse synPat
- /// VisitPat allows overriding behavior when visiting patterns
- abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
- default _.VisitPat (path, defaultTraverse, synPat) =
- ignore path
- defaultTraverse synPat
+ /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
+ abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
- /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
- abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
- default _.VisitType (path, defaultTraverse, synType) =
- ignore path
- defaultTraverse synType
+ default _.VisitType(path, defaultTraverse, synType) =
+ ignore path
+ defaultTraverse synType
/// A range of utility functions to assist with traversing an AST
module SyntaxTraversal =
- // treat ranges as though they are half-open: [,)
- let rangeContainsPosLeftEdgeInclusive (m1:range) p =
- if posEq m1.Start m1.End then
- // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
- // we treat the range [n,n) as containing position n
- posGeq p m1.Start &&
- posGeq m1.End p
- else
- posGeq p m1.Start && // [
- posGt m1.End p // )
-
- // treat ranges as though they are fully open: (,)
- let rangeContainsPosEdgesExclusive (m1:range) p = posGt p m1.Start && posGt m1.End p
-
- let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1:range) p = posGt p m1.Start && posGeq m1.End p
-
- let dive node range project =
- range,(fun() -> project node)
-
- let pick pos (outerRange:range) (debugObj:obj) (diveResults:list) =
- match diveResults with
- | [] -> None
- | _ ->
- let isOrdered =
+ // treat ranges as though they are half-open: [,)
+ let rangeContainsPosLeftEdgeInclusive (m1: range) p =
+ if posEq m1.Start m1.End then
+ // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
+ // we treat the range [n,n) as containing position n
+ posGeq p m1.Start && posGeq m1.End p
+ else
+ posGeq p m1.Start
+ && // [
+ posGt m1.End p // )
+
+ // treat ranges as though they are fully open: (,)
+ let rangeContainsPosEdgesExclusive (m1: range) p = posGt p m1.Start && posGt m1.End p
+
+ let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1: range) p = posGt p m1.Start && posGeq m1.End p
+
+ let dive node range project = range, (fun () -> project node)
+
+ let pick pos (outerRange: range) (debugObj: obj) (diveResults: list) =
+ match diveResults with
+ | [] -> None
+ | _ ->
+ let isOrdered =
#if DEBUG
- // ranges in a dive-and-pick group should be ordered
- diveResults |> Seq.pairwise |> Seq.forall (fun ((r1,_),(r2,_)) -> posGeq r2.Start r1.End)
+ // ranges in a dive-and-pick group should be ordered
+ diveResults
+ |> Seq.pairwise
+ |> Seq.forall (fun ((r1, _), (r2, _)) -> posGeq r2.Start r1.End)
#else
- true
+ true
#endif
- if not isOrdered then
- let s = sprintf "ServiceParseTreeWalk: not isOrdered: %A" (diveResults |> List.map (fun (r,_) -> r.ToShortString()))
- ignore s
- //System.Diagnostics.Debug.Assert(false, s)
- let outerContainsInner =
+ if not isOrdered then
+ let s =
+ sprintf
+ "ServiceParseTreeWalk: not isOrdered: %A"
+ (diveResults
+ |> List.map (fun (r, _) -> r.ToShortString()))
+
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let outerContainsInner =
#if DEBUG
- // ranges in a dive-and-pick group should be "under" the thing that contains them
- let innerTotalRange = diveResults |> List.map fst |> List.reduce unionRanges
- rangeContainsRange outerRange innerTotalRange
+ // ranges in a dive-and-pick group should be "under" the thing that contains them
+ let innerTotalRange =
+ diveResults
+ |> List.map fst
+ |> List.reduce unionRanges
+
+ rangeContainsRange outerRange innerTotalRange
#else
- ignore(outerRange)
- true
+ ignore (outerRange)
+ true
#endif
- if not outerContainsInner then
- let s = sprintf "ServiceParseTreeWalk: not outerContainsInner: %A : %A" (outerRange.ToShortString()) (diveResults |> List.map (fun (r,_) -> r.ToShortString()))
- ignore s
- //System.Diagnostics.Debug.Assert(false, s)
- let isZeroWidth(r:range) =
- posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
- match List.choose (fun (r,f) -> if rangeContainsPosLeftEdgeInclusive r pos && not(isZeroWidth r) then Some(f) else None) diveResults with
- | [] ->
- // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
- // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
- let mutable e = diveResults.Head
- for r in diveResults do
- if posGt pos (fst r).Start then
- e <- r
- snd(e)()
- | [x] -> x()
- | _ ->
+ if not outerContainsInner then
+ let s =
+ sprintf
+ "ServiceParseTreeWalk: not outerContainsInner: %A : %A"
+ (outerRange.ToShortString())
+ (diveResults
+ |> List.map (fun (r, _) -> r.ToShortString()))
+
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let isZeroWidth (r: range) = posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
+
+ match
+ List.choose
+ (fun (r, f) ->
+ if
+ rangeContainsPosLeftEdgeInclusive r pos
+ && not (isZeroWidth r)
+ then
+ Some(f)
+ else
+ None)
+ diveResults
+ with
+ | [] ->
+ // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
+ // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
+ let mutable e = diveResults.Head
+
+ for r in diveResults do
+ if posGt pos (fst r).Start then e <- r
+
+ snd (e) ()
+ | [ x ] -> x ()
+ | _ ->
#if DEBUG
- assert false
- failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
+ assert false
+ failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
#else
- ignore debugObj
- None
+ ignore debugObj
+ None
#endif
- /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
- ///
- let Traverse(pos:pos, parseTree, visitor:SyntaxVisitorBase<'T>) =
- let pick x = pick pos x
- let rec traverseSynModuleDecl origPath (decl:SynModuleDecl) =
- let pick = pick decl.Range
- let defaultTraverse m =
- let path = SyntaxNode.SynModule m :: origPath
- match m with
- | SynModuleDecl.ModuleAbbrev(_ident, _longIdent, _range) -> None
- | SynModuleDecl.NestedModule(decls=synModuleDecls) -> synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick decl
- | SynModuleDecl.Let(isRecursive, synBindingList, range) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | Some x -> Some x
- | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick decl
- // | SynModuleDecl.Expr(synExpr, _range) -> traverseSynExpr path synExpr
- | SynModuleDecl.DoExpr(_, synExpr, _range) -> traverseSynExpr path synExpr
- | SynModuleDecl.Types(synTypeDefnList, _range) -> synTypeDefnList |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path)) |> pick decl
- | SynModuleDecl.Exception(_synExceptionDefn, _range) -> None
- | SynModuleDecl.Open(_target, _range) -> None
- | SynModuleDecl.Attributes(_synAttributes, _range) -> None
- | SynModuleDecl.HashDirective(parsedHashDirective, range) -> visitor.VisitHashDirective (path, parsedHashDirective, range)
- | SynModuleDecl.NamespaceFragment(synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace
- visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
-
- and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace(_longIdent, _isRec, _isModule, synModuleDecls, _preXmlDoc, _synAttributes, _synAccessOpt, range) as mors) =
- match visitor.VisitModuleOrNamespace(origPath, mors) with
- | Some x -> Some x
- | None ->
- let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
- synModuleDecls |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path)) |> pick range mors
-
- and traverseSynExpr origPath (expr:SynExpr) =
- let pick = pick expr.Range
- let defaultTraverse e =
- let path = SyntaxNode.SynExpr e :: origPath
- let traverseSynExpr = traverseSynExpr path
- let traverseSynType = traverseSynType path
- let traversePat = traversePat path
- match e with
-
- | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
-
- | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
- [//dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.Const (_synConst, _range) -> None
-
- | SynExpr.InterpolatedString (parts, _, _) ->
- [ for part in parts do
- match part with
- | SynInterpolatedStringPart.String _ -> ()
- | SynInterpolatedStringPart.FillExpr (fillExpr, _) ->
- yield dive fillExpr fillExpr.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.Typed (synExpr, synType, _range) ->
- match traverseSynExpr synExpr with
- | None -> traverseSynType synType
- | x -> x
-
- | SynExpr.Tuple (_, synExprList, _, _range)
- | SynExpr.ArrayOrList (_, synExprList, _range) ->
- synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr
-
- | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
- [ match copyOpt with
- | Some(expr, (withRange, _)) ->
- yield dive expr expr.Range traverseSynExpr
- yield dive () withRange (fun () ->
- if posGeq pos withRange.End then
- // special case: caret is after WITH
- // { x with $ }
- visitor.VisitRecordField (path, Some expr, None)
- else
- None
- )
- | _ -> ()
- for _, _, x in synExprList do
- yield dive x x.Range traverseSynExpr
- ] |> pick expr
-
- | SynExpr.Record (inheritOpt,copyOpt,fields, _range) ->
- [
- let diveIntoSeparator offsideColumn scPosOpt copyOpt =
- match scPosOpt with
- | Some scPos ->
- if posGeq pos scPos then
- visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
- else None
- | None ->
- //semicolon position is not available - use offside rule
- if pos.Column = offsideColumn then
- visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
- else None
-
- match inheritOpt with
- | Some(_ty,expr, _range, sepOpt, inheritRange) ->
- // dive into argument
- yield dive expr expr.Range (fun expr ->
- // special-case:caret is located in the offside position below inherit
- // inherit A()
- // $
- if not (rangeContainsPos expr.Range pos) && sepOpt.IsNone && pos.Column = inheritRange.StartColumn then
- visitor.VisitRecordField(path, None, None)
- else
- traverseSynExpr expr
- )
- match sepOpt with
- | Some (sep, scPosOpt) ->
- yield dive () sep (fun () ->
- // special case: caret is below 'inherit' + one or more fields are already defined
- // inherit A()
- // $
- // field1 = 5
- diveIntoSeparator inheritRange.StartColumn scPosOpt None
- )
- | None -> ()
- | _ -> ()
- match copyOpt with
- | Some(expr, (withRange, _)) ->
- yield dive expr expr.Range traverseSynExpr
- yield dive () withRange (fun () ->
- if posGeq pos withRange.End then
- // special case: caret is after WITH
- // { x with $ }
- visitor.VisitRecordField (path, Some expr, None)
- else
- None
- )
- | _ -> ()
- let copyOpt = Option.map fst copyOpt
- for SynExprRecordField(fieldName=(field, _); expr=e; blockSeparator=sepOpt) in fields do
- yield dive (path, copyOpt, Some field) field.Range (fun r ->
- if rangeContainsPos field.Range pos then
- visitor.VisitRecordField r
- else
- None
- )
- let offsideColumn =
- match inheritOpt with
- | Some(_,_, _, _, inheritRange) -> inheritRange.StartColumn
- | None -> field.Range.StartColumn
-
- match e with
- | Some e -> yield dive e e.Range (fun expr ->
- // special case: caret is below field binding
- // field x = 5
- // $
- if not (rangeContainsPos e.Range pos) && sepOpt.IsNone && pos.Column = offsideColumn then
- visitor.VisitRecordField(path, copyOpt, None)
- else
- traverseSynExpr expr
- )
- | None -> ()
-
- match sepOpt with
- | Some (sep, scPosOpt) ->
- yield dive () sep (fun () ->
- // special case: caret is between field bindings
- // field1 = 5
- // $
- // field2 = 5
- diveIntoSeparator offsideColumn scPosOpt copyOpt
- )
- | _ -> ()
-
- ] |> pick expr
-
- | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
- | SynExpr.ObjExpr (objType=ty; argOptions=baseCallOpt; bindings=binds; members=ms; extraImpls=ifaces) ->
- let unionBindingAndMembers (bindings: SynBinding list) (members: SynMemberDefn list): SynBinding list =
- [ yield! bindings
- yield! List.choose (function | SynMemberDefn.Member(b,_) -> Some b | _ -> None) members ]
- let binds = unionBindingAndMembers binds ms
- let result =
- ifaces
- |> Seq.map (fun (SynInterfaceImpl(interfaceTy=ty)) -> ty)
- |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
-
- if result.IsSome then
- result
- else
- [
- match baseCallOpt with
- | Some(expr,_) ->
- // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
- let newCall = SynExpr.New (false, ty, expr, unionRanges ty.Range expr.Range)
- yield dive newCall newCall.Range traverseSynExpr
- | _ -> ()
- for b in binds do
- yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
- for SynInterfaceImpl(bindings=binds) in ifaces do
- for b in binds do
- yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
- ] |> pick expr
-
- | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.For (identBody=synExpr; toBody=synExpr2; doBody=synExpr3) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr3 synExpr3.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
- [dive synPat synPat.Range traversePat
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.ComputationExpr (_, synExpr, _range) ->
- // now parser treats this syntactic expression as computation expression
- // { identifier }
- // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
- // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
- let isPartOfArrayOrList =
- match origPath with
- | SyntaxNode.SynExpr(SynExpr.ArrayOrListComputed _) :: _ -> true
- | _ -> false
- let ok =
- match isPartOfArrayOrList, synExpr with
- | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some (LongIdentWithDots([ident], [])))
- | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
- | _ -> None
- if ok.IsSome then ok
- else
- traverseSynExpr synExpr
-
- | SynExpr.Lambda (args=synSimplePats; body=synExpr) ->
- match synSimplePats with
- | SynSimplePats.SimplePats(pats,_) ->
- match visitor.VisitSimplePats(path, pats) with
- | None -> traverseSynExpr synExpr
- | x -> x
- | _ -> traverseSynExpr synExpr
-
- | SynExpr.MatchLambda (_isExnMatch,_argm,synMatchClauseList,_spBind,_wholem) ->
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
- |> pick expr
-
- | SynExpr.Match (expr=synExpr; clauses=synMatchClauseList) ->
- [yield dive synExpr synExpr.Range traverseSynExpr
- yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
- |> pick expr
-
- | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
-
- | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
- if isInfix then
- [dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr synExpr.Range traverseSynExpr] // reverse the args
- |> pick expr
+ /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
+ ///
+ let Traverse (pos: pos, parseTree, visitor: SyntaxVisitorBase<'T>) =
+ let pick x = pick pos x
+
+ let rec traverseSynModuleDecl origPath (decl: SynModuleDecl) =
+ let pick = pick decl.Range
+
+ let defaultTraverse m =
+ let path = SyntaxNode.SynModule m :: origPath
+
+ match m with
+ | SynModuleDecl.ModuleAbbrev (_ident, _longIdent, _range) -> None
+ | SynModuleDecl.NestedModule (decls = synModuleDecls) ->
+ synModuleDecls
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
+ |> pick decl
+ | SynModuleDecl.Let (isRecursive, synBindingList, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None ->
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ |> pick decl
+ // | SynModuleDecl.Expr(synExpr, _range) -> traverseSynExpr path synExpr
+ | SynModuleDecl.DoExpr (_, synExpr, _range) -> traverseSynExpr path synExpr
+ | SynModuleDecl.Types (synTypeDefnList, _range) ->
+ synTypeDefnList
+ |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path))
+ |> pick decl
+ | SynModuleDecl.Exception (_synExceptionDefn, _range) -> None
+ | SynModuleDecl.Open (_target, _range) -> None
+ | SynModuleDecl.Attributes (_synAttributes, _range) -> None
+ | SynModuleDecl.HashDirective (parsedHashDirective, range) ->
+ visitor.VisitHashDirective(path, parsedHashDirective, range)
+ | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) ->
+ traverseSynModuleOrNamespace path synModuleOrNamespace
+
+ visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
+
+ and traverseSynModuleOrNamespace
+ origPath
+ (SynModuleOrNamespace (_longIdent,
+ _isRec,
+ _isModule,
+ synModuleDecls,
+ _preXmlDoc,
+ _synAttributes,
+ _synAccessOpt,
+ range) as mors)
+ =
+ match visitor.VisitModuleOrNamespace(origPath, mors) with
+ | Some x -> Some x
+ | None ->
+ let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
+
+ synModuleDecls
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
+ |> pick range mors
+
+ and traverseSynExpr origPath (expr: SynExpr) =
+ let pick = pick expr.Range
+
+ let defaultTraverse e =
+ let path = SyntaxNode.SynExpr e :: origPath
+ let traverseSynExpr = traverseSynExpr path
+ let traverseSynType = traverseSynType path
+ let traversePat = traversePat path
+
+ match e with
+
+ | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
+
+ | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
+ [ //dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Const (_synConst, _range) -> None
+
+ | SynExpr.InterpolatedString (parts, _, _) ->
+ [ for part in parts do
+ match part with
+ | SynInterpolatedStringPart.String _ -> ()
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield dive fillExpr fillExpr.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Typed (synExpr, synType, _range) ->
+ match traverseSynExpr synExpr with
+ | None -> traverseSynType synType
+ | x -> x
+
+ | SynExpr.Tuple (_, synExprList, _, _range)
+ | SynExpr.ArrayOrList (_, synExprList, _range) ->
+ synExprList
+ |> List.map (fun x -> dive x x.Range traverseSynExpr)
+ |> pick expr
+
+ | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
+ [ match copyOpt with
+ | Some (expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+
+ yield
+ dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField(path, Some expr, None)
+ else
+ None)
+ | _ -> ()
+ for _, _, x in synExprList do
+ yield dive x x.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Record (inheritOpt, copyOpt, fields, _range) ->
+ [ let diveIntoSeparator offsideColumn scPosOpt copyOpt =
+ match scPosOpt with
+ | Some scPos ->
+ if posGeq pos scPos then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else
+ None
+ | None ->
+ //semicolon position is not available - use offside rule
+ if pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else
+ None
+
+ match inheritOpt with
+ | Some (_ty, expr, _range, sepOpt, inheritRange) ->
+ // dive into argument
+ yield
+ dive expr expr.Range (fun expr ->
+ // special-case:caret is located in the offside position below inherit
+ // inherit A()
+ // $
+ if not (rangeContainsPos expr.Range pos)
+ && sepOpt.IsNone
+ && pos.Column = inheritRange.StartColumn then
+ visitor.VisitRecordField(path, None, None)
+ else
+ traverseSynExpr expr)
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield
+ dive () sep (fun () ->
+ // special case: caret is below 'inherit' + one or more fields are already defined
+ // inherit A()
+ // $
+ // field1 = 5
+ diveIntoSeparator inheritRange.StartColumn scPosOpt None)
+ | None -> ()
+ | _ -> ()
+
+ match copyOpt with
+ | Some (expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+
+ yield
+ dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField(path, Some expr, None)
+ else
+ None)
+ | _ -> ()
+
+ let copyOpt = Option.map fst copyOpt
+
+ for SynExprRecordField (fieldName = (field, _); expr = e; blockSeparator = sepOpt) in fields do
+ yield
+ dive (path, copyOpt, Some field) field.Range (fun r ->
+ if rangeContainsPos field.Range pos then
+ visitor.VisitRecordField r
+ else
+ None)
+
+ let offsideColumn =
+ match inheritOpt with
+ | Some (_, _, _, _, inheritRange) -> inheritRange.StartColumn
+ | None -> field.Range.StartColumn
+
+ match e with
+ | Some e ->
+ yield
+ dive e e.Range (fun expr ->
+ // special case: caret is below field binding
+ // field x = 5
+ // $
+ if not (rangeContainsPos e.Range pos)
+ && sepOpt.IsNone
+ && pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None)
else
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
+ traverseSynExpr expr)
+ | None -> ()
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield
+ dive () sep (fun () ->
+ // special case: caret is between field bindings
+ // field1 = 5
+ // $
+ // field2 = 5
+ diveIntoSeparator offsideColumn scPosOpt copyOpt)
+ | _ -> ()
+
+ ]
+ |> pick expr
+
+ | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
+ | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) ->
+ let unionBindingAndMembers (bindings: SynBinding list) (members: SynMemberDefn list) : SynBinding list =
+ [ yield! bindings
+ yield!
+ List.choose
+ (function
+ | SynMemberDefn.Member (b, _) -> Some b
+ | _ -> None)
+ members ]
+
+ let binds = unionBindingAndMembers binds ms
+
+ let result =
+ ifaces
+ |> Seq.map (fun (SynInterfaceImpl (interfaceTy = ty)) -> ty)
+ |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
+
+ if result.IsSome then
+ result
+ else
+ [ match baseCallOpt with
+ | Some (expr, _) ->
+ // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
+ let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range)
+ yield dive newCall newCall.Range traverseSynExpr
+ | _ -> ()
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
+ for SynInterfaceImpl (bindings = binds) in ifaces do
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) ]
+ |> pick expr
+
+ | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.For (identBody = synExpr; toBody = synExpr2; doBody = synExpr3) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
+ [ dive synPat synPat.Range traversePat
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ComputationExpr (_, synExpr, _range) ->
+ // now parser treats this syntactic expression as computation expression
+ // { identifier }
+ // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
+ // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
+ let isPartOfArrayOrList =
+ match origPath with
+ | SyntaxNode.SynExpr (SynExpr.ArrayOrListComputed _) :: _ -> true
+ | _ -> false
+
+ let ok =
+ match isPartOfArrayOrList, synExpr with
+ | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some(LongIdentWithDots([ ident ], [])))
+ | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
+ | _ -> None
+
+ if ok.IsSome then
+ ok
+ else
+ traverseSynExpr synExpr
+
+ | SynExpr.Lambda (args = synSimplePats; body = synExpr) ->
+ match synSimplePats with
+ | SynSimplePats.SimplePats (pats, _) ->
+ match visitor.VisitSimplePats(path, pats) with
+ | None -> traverseSynExpr synExpr
+ | x -> x
+ | _ -> traverseSynExpr synExpr
+
+ | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) ->
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ |> pick expr
+
+ | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
+ |> pick expr
+
+ | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
+
+ | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
+ if isInfix then
+ [ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr synExpr.Range traverseSynExpr ] // reverse the args
+ |> pick expr
+ else
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | None ->
+ [ yield!
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ yield dive synExpr synExpr.Range traverseSynExpr ]
+ |> pick expr
+ | x -> x
+
+ | SynExpr.TryWith (tryExpr = synExpr; withCases = synMatchClauseList) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
+ |> pick expr
+
+ | SynExpr.TryFinally (tryExpr = synExpr; finallyExpr = synExpr2) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
+
+ | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.IfThenElse (ifExpr = synExpr; thenExpr = synExpr2; elseExpr = synExprOpt) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ match synExprOpt with
+ | None -> ()
+ | Some x -> yield dive x x.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Ident _ident -> None
+
+ | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
+
+ | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
- | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | None ->
- [yield! synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- yield dive synExpr synExpr.Range traverseSynExpr]
- |> pick expr
- | x -> x
+ | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
- | SynExpr.TryWith (tryExpr=synExpr; withCases=synMatchClauseList) ->
- [yield dive synExpr synExpr.Range traverseSynExpr
- yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
- |> pick expr
+ | SynExpr.Set (synExpr, synExpr2, _)
- | SynExpr.TryFinally (tryExpr=synExpr; finallyExpr=synExpr2) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
+ | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
- | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+ | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
+ [ match expr1 with
+ | Some e -> dive e e.Range traverseSynExpr
+ | None -> ()
+ match expr2 with
+ | Some e -> dive e e.Range traverseSynExpr
+ | None -> () ]
+ |> pick expr
- | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
+ | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e
- | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
+ | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr ]
+ |> pick expr
- | SynExpr.IfThenElse (ifExpr=synExpr; thenExpr=synExpr2; elseExpr=synExprOpt) ->
- [yield dive synExpr synExpr.Range traverseSynExpr
- yield dive synExpr2 synExpr2.Range traverseSynExpr
- match synExprOpt with
- | None -> ()
- | Some x -> yield dive x x.Range traverseSynExpr]
- |> pick expr
+ | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
- | SynExpr.Ident _ident -> None
-
- | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
-
- | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Set (synExpr, synExpr2, _)
-
- | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
- [ match expr1 with Some e -> dive e e.Range traverseSynExpr | None -> ()
- match expr2 with Some e -> dive e e.Range traverseSynExpr | None -> () ]
- |> pick expr
-
- | SynExpr.IndexFromEnd (e, _) ->
- traverseSynExpr e
-
- | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
- [yield dive synExpr synExpr.Range traverseSynExpr
- yield dive indexArgs indexArgs.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
- [yield dive synExpr synExpr.Range traverseSynExpr
- yield dive indexArgs indexArgs.Range traverseSynExpr
- yield dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
- [dive synExpr1 synExpr1.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr3 synExpr3.Range traverseSynExpr]
- |> pick expr
-
- | SynExpr.TypeTest (synExpr, synType, _range)
-
- | SynExpr.Upcast (synExpr, synType, _range)
-
- | SynExpr.Downcast (synExpr, synType, _range) ->
- [dive synExpr synExpr.Range traverseSynExpr
- dive synType synType.Range traverseSynType]
- |> pick expr
-
- | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Null _range -> None
-
- | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
-
- | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.ImplicitZero _range -> None
-
- | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LetOrUseBang(pat=synPat; rhs=synExpr; andBangs=andBangSynExprs; body=synExpr2) ->
- [
- yield dive synPat synPat.Range traversePat
- yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- [ for SynExprAndBang(pat=andBangSynPat; body=andBangSynExpr) in andBangSynExprs do
- yield (dive andBangSynPat andBangSynPat.Range traversePat)
- yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)]
- yield dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.MatchBang (expr=synExpr; clauses=synMatchClauseList) ->
- [yield dive synExpr synExpr.Range traverseSynExpr
- yield! synMatchClauseList |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))]
- |> pick expr
-
- | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LibraryOnlyILAssembly _ -> None
-
- | SynExpr.LibraryOnlyStaticOptimization _ -> None
-
- | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
-
- | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
-
- | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
-
- | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
-
- visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
-
- and traversePat origPath (pat: SynPat) =
- let defaultTraverse p =
- let path = SyntaxNode.SynPat p :: origPath
- match p with
- | SynPat.Paren (p, _) -> traversePat path p
- | SynPat.Or (p1, p2, _, _) -> [ p1; p2] |> List.tryPick (traversePat path)
- | SynPat.Ands (ps, _)
- | SynPat.Tuple (_, ps, _)
- | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
- | SynPat.Attrib (p, _, _) -> traversePat path p
- | SynPat.LongIdent(argPats=args) ->
- match args with
- | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
- | SynArgPats.NamePatPairs (ps, _) ->
- ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path)
- | SynPat.Typed (p, ty, _) ->
- match traversePat path p with
- | None -> traverseSynType path ty
- | x -> x
- //TODO: added
- | SynPat.As (lhsPat=lhs; rhsPat=rhs) ->
- [lhs; rhs] |> List.tryPick (traversePat path)
- //TODO: added
- | SynPat.Record (fieldPats=fieldPats) ->
- fieldPats
- |> List.map (fun (_,_,pat) -> pat)
- |> List.tryPick (traversePat path)
- | _ -> None
-
- visitor.VisitPat (origPath, defaultTraverse, pat)
-
- and traverseSynType origPath (StripParenTypes ty) =
- let defaultTraverse ty =
- let path = SyntaxNode.SynType ty :: origPath
- match ty with
- | SynType.App (typeName, _, typeArgs, _, _, _, _)
- | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
- [ yield typeName
- yield! typeArgs ]
- |> List.tryPick (traverseSynType path)
- | SynType.Fun (ty1, ty2, _) -> [ty1; ty2] |> List.tryPick (traverseSynType path)
- | SynType.MeasurePower (ty, _, _)
- | SynType.HashConstraint (ty, _)
- | SynType.WithGlobalConstraints (ty, _, _)
- | SynType.Array (_, ty, _) -> traverseSynType path ty
- | SynType.StaticConstantNamed (ty1, ty2, _)
- | SynType.MeasureDivide (ty1, ty2, _) -> [ty1; ty2] |> List.tryPick (traverseSynType path)
- | SynType.Tuple (_, tys, _) -> tys |> List.map snd |> List.tryPick (traverseSynType path)
- | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
- | SynType.Anon _ -> None
- | _ -> None
-
- visitor.VisitType (origPath, defaultTraverse, ty)
-
- and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit (synMemberDefns:SynMemberDefns) =
- synMemberDefns
- // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
- |> Seq.groupBy (fun x -> x.Range)
- |> Seq.choose (fun (r, mems) ->
- match mems |> Seq.toList with
- | [mem] -> // the typical case, a single member has this range 'r'
- Some (dive mem r (traverseSynMemberDefn path traverseInherit))
- | [SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid1; extraId=Some(info1)))) as mem1
- SynMemberDefn.Member(memberDefn=SynBinding(headPat=SynPat.LongIdent(longDotId=lid2; extraId=Some(info2)))) as mem2] -> // can happen if one is a getter and one is a setter
- // ensure same long id
- assert( (lid1.Lid,lid2.Lid) ||> List.forall2 (fun x y -> x.idText = y.idText) )
- // ensure one is getter, other is setter
- assert( (info1.idText="set" && info2.idText="get") ||
- (info2.idText="set" && info1.idText="get") )
- Some (
- r,(fun() ->
- // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
- match traverseSynMemberDefn path (fun _ -> None) mem1 with
- | Some _ as x -> x
- | _ -> traverseSynMemberDefn path (fun _ -> None) mem2 )
- )
- | [] ->
+ | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
+ [ dive synExpr1 synExpr1.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.TypeTest (synExpr, synType, _range)
+
+ | SynExpr.Upcast (synExpr, synType, _range)
+
+ | SynExpr.Downcast (synExpr, synType, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synType synType.Range traverseSynType ]
+ |> pick expr
+
+ | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Null _range -> None
+
+ | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
+
+ | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ImplicitZero _range -> None
+
+ | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUseBang (pat = synPat; rhs = synExpr; andBangs = andBangSynExprs; body = synExpr2) ->
+ [ yield dive synPat synPat.Range traversePat
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ [ for SynExprAndBang (pat = andBangSynPat; body = andBangSynExpr) in andBangSynExprs do
+ yield (dive andBangSynPat andBangSynPat.Range traversePat)
+ yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr) ]
+ yield dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
+ |> pick expr
+
+ | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LibraryOnlyILAssembly _ -> None
+
+ | SynExpr.LibraryOnlyStaticOptimization _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
+
+ | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
+
+ | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
+
+ visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
+
+ and traversePat origPath (pat: SynPat) =
+ let defaultTraverse p =
+ let path = SyntaxNode.SynPat p :: origPath
+
+ match p with
+ | SynPat.Paren (p, _) -> traversePat path p
+ | SynPat.Or (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
+ | SynPat.Attrib (p, _, _) -> traversePat path p
+ | SynPat.LongIdent (argPats = args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
+ | SynArgPats.NamePatPairs (ps, _) ->
+ ps
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat path)
+ | SynPat.Typed (p, ty, _) ->
+ match traversePat path p with
+ | None -> traverseSynType path ty
+ | x -> x
+ //TODO: added
+ | SynPat.As (lhsPat = lhs; rhsPat = rhs) -> [ lhs; rhs ] |> List.tryPick (traversePat path)
+ //TODO: added
+ | SynPat.Record (fieldPats = fieldPats) ->
+ fieldPats
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat path)
+ | _ -> None
+
+ visitor.VisitPat(origPath, defaultTraverse, pat)
+
+ and traverseSynType origPath (StripParenTypes ty) =
+ let defaultTraverse ty =
+ let path = SyntaxNode.SynType ty :: origPath
+
+ match ty with
+ | SynType.App (typeName, _, typeArgs, _, _, _, _)
+ | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
+ [ yield typeName; yield! typeArgs ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.Fun (ty1, ty2, _) ->
+ [ ty1; ty2 ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.MeasurePower (ty, _, _)
+ | SynType.HashConstraint (ty, _)
+ | SynType.WithGlobalConstraints (ty, _, _)
+ | SynType.Array (_, ty, _) -> traverseSynType path ty
+ | SynType.StaticConstantNamed (ty1, ty2, _)
+ | SynType.MeasureDivide (ty1, ty2, _) ->
+ [ ty1; ty2 ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.Tuple (_, tys, _) ->
+ tys
+ |> List.map snd
+ |> List.tryPick (traverseSynType path)
+ | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
+ | SynType.Anon _ -> None
+ | _ -> None
+
+ visitor.VisitType(origPath, defaultTraverse, ty)
+
+ and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters
+ path
+ traverseInherit
+ (synMemberDefns: SynMemberDefns)
+ =
+ synMemberDefns
+ // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
+ |> Seq.groupBy (fun x -> x.Range)
+ |> Seq.choose (fun (r, mems) ->
+ match mems |> Seq.toList with
+ | [ mem ] -> // the typical case, a single member has this range 'r'
+ Some(dive mem r (traverseSynMemberDefn path traverseInherit))
+ | [ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1
+ extraId = Some (info1)))) as mem1
+ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2
+ extraId = Some (info2)))) as mem2 ] -> // can happen if one is a getter and one is a setter
+ // ensure same long id
+ assert
+ ((lid1.Lid, lid2.Lid)
+ ||> List.forall2 (fun x y -> x.idText = y.idText))
+ // ensure one is getter, other is setter
+ assert
+ ((info1.idText = "set" && info2.idText = "get")
+ || (info2.idText = "set" && info1.idText = "get"))
+
+ Some(
+ r,
+ (fun () ->
+ // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
+ match traverseSynMemberDefn path (fun _ -> None) mem1 with
+ | Some _ as x -> x
+ | _ -> traverseSynMemberDefn path (fun _ -> None) mem2)
+ )
+ | [] ->
#if DEBUG
- assert false
- failwith "impossible, Seq.groupBy never returns empty results"
+ assert false
+ failwith "impossible, Seq.groupBy never returns empty results"
#else
- // swallow AST error and recover silently
- None
+ // swallow AST error and recover silently
+ None
#endif
- | _ ->
+ | _ ->
#if DEBUG
- assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
- failwith "bug in AST"
+ assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
+ failwith "bug in AST"
#else
- // swallow AST error and recover silently
- None
+ // swallow AST error and recover silently
+ None
#endif
- )
-
- and traverseSynTypeDefn origPath (SynTypeDefn(synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef) =
- let path = SyntaxNode.SynTypeDefn tydef :: origPath
-
- match visitor.VisitComponentInfo (origPath, synComponentInfo) with
- | Some x -> Some x
- | None ->
- [
- match synTypeDefnRepr with
- | SynTypeDefnRepr.Exception _ ->
- // This node is generated in CheckExpressions.fs, not in the AST.
- // But note exception declarations are missing from this tree walk.
- ()
- | SynTypeDefnRepr.ObjectModel(synTypeDefnKind, synMemberDefns, _oRange) ->
- // traverse inherit function is used to capture type specific data required for processing Inherit part
- let traverseInherit (synType: SynType, range: range) =
- visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
- yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
- | SynTypeDefnRepr.Simple(synTypeDefnSimpleRepr, _range) ->
- match synTypeDefnSimpleRepr with
- | SynTypeDefnSimpleRepr.Record(_synAccessOption, fields, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
- | SynTypeDefnSimpleRepr.Union(_synAccessOption, cases, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
- | SynTypeDefnSimpleRepr.Enum(cases, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
- | SynTypeDefnSimpleRepr.TypeAbbrev(_, synType, m) ->
- yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
- | _ ->
- ()
- yield! synMemberDefns |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None)
- ] |> pick tRange tydef
-
- and traverseSynMemberDefn path traverseInherit (m:SynMemberDefn) =
- let pick (debugObj:obj) = pick m.Range debugObj
- let path = SyntaxNode.SynMemberDefn m :: path
- match m with
- | SynMemberDefn.Open(_longIdent, _range) -> None
- | SynMemberDefn.Member(synBinding, _range) -> traverseSynBinding path synBinding
- | SynMemberDefn.ImplicitCtor(_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
- match simplePats with
- | SynSimplePats.SimplePats(simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
- | _ -> None
- | SynMemberDefn.ImplicitInherit(synType, synExpr, _identOption, range) ->
- [
- dive () synType.Range (fun () ->
- match traverseInherit (synType, range) with
- | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
- | x -> x)
- dive () synExpr.Range (fun() ->
- visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
- )
- ] |> pick m
- | SynMemberDefn.AutoProperty(synExpr=synExpr) -> traverseSynExpr path synExpr
- | SynMemberDefn.LetBindings(synBindingList, isRecursive, _, range) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | Some x -> Some x
- | None -> synBindingList |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path)) |> pick m
- | SynMemberDefn.AbstractSlot(_synValSig, _memberFlags, _range) -> None
- | SynMemberDefn.Interface(interfaceType=synType; members=synMemberDefnsOption) ->
- match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
- | None ->
- match synMemberDefnsOption with
- | None -> None
- | Some(x) -> [ yield! x |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ] |> pick x
- | ok -> ok
- | SynMemberDefn.Inherit(synType, _identOption, range) -> traverseInherit (synType, range)
- | SynMemberDefn.ValField(_synField, _range) -> None
- | SynMemberDefn.NestedType(synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
-
- and traverseSynMatchClause origPath mc =
- let defaultTraverse mc =
- let path = SyntaxNode.SynMatchClause mc :: origPath
- match mc with
- | SynMatchClause(pat=synPat; whenExpr=synExprOption; resultExpr=synExpr) as all ->
- [dive synPat synPat.Range (traversePat path) ]
- @
- ([
- match synExprOption with
- | None -> ()
- | Some guard -> yield guard
- yield synExpr
- ]
- |> List.map (fun x -> dive x x.Range (traverseSynExpr path))
- )|> pick all.Range all
- visitor.VisitMatchClause(origPath, defaultTraverse, mc)
-
- and traverseSynBinding origPath b =
- let defaultTraverse b =
- let path = SyntaxNode.SynBinding b :: origPath
- match b with
- | SynBinding(headPat=synPat; expr=synExpr) ->
- match traversePat path synPat with
- | None -> traverseSynExpr path synExpr
- | x -> x
- visitor.VisitBinding(origPath, defaultTraverse ,b)
-
- match parseTree with
- | ParsedInput.ImplFile (ParsedImplFileInput (modules = l))->
- let fileRange =
+ )
+
+ and traverseSynTypeDefn
+ origPath
+ (SynTypeDefn (synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef)
+ =
+ let path = SyntaxNode.SynTypeDefn tydef :: origPath
+
+ match visitor.VisitComponentInfo(origPath, synComponentInfo) with
+ | Some x -> Some x
+ | None ->
+ [ match synTypeDefnRepr with
+ | SynTypeDefnRepr.Exception _ ->
+ // This node is generated in CheckExpressions.fs, not in the AST.
+ // But note exception declarations are missing from this tree walk.
+ ()
+ | SynTypeDefnRepr.ObjectModel (synTypeDefnKind, synMemberDefns, _oRange) ->
+ // traverse inherit function is used to capture type specific data required for processing Inherit part
+ let traverseInherit (synType: SynType, range: range) =
+ visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
+
+ yield!
+ synMemberDefns
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
+ | SynTypeDefnRepr.Simple (synTypeDefnSimpleRepr, _range) ->
+ match synTypeDefnSimpleRepr with
+ | SynTypeDefnSimpleRepr.Record (_synAccessOption, fields, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
+ | SynTypeDefnSimpleRepr.Union (_synAccessOption, cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.Enum (cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.TypeAbbrev (_, synType, m) ->
+ yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
+ | _ -> ()
+ yield!
+ synMemberDefns
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ]
+ |> pick tRange tydef
+
+ and traverseSynMemberDefn path traverseInherit (m: SynMemberDefn) =
+ let pick (debugObj: obj) = pick m.Range debugObj
+ let path = SyntaxNode.SynMemberDefn m :: path
+
+ match m with
+ | SynMemberDefn.Open (_longIdent, _range) -> None
+ | SynMemberDefn.Member (synBinding, _range) -> traverseSynBinding path synBinding
+ | SynMemberDefn.ImplicitCtor (_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
+ match simplePats with
+ | SynSimplePats.SimplePats (simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
+ | _ -> None
+ | SynMemberDefn.ImplicitInherit (synType, synExpr, _identOption, range) ->
+ [ dive () synType.Range (fun () ->
+ match traverseInherit (synType, range) with
+ | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
+ | x -> x)
+ dive () synExpr.Range (fun () ->
+ visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)) ]
+ |> pick m
+ | SynMemberDefn.AutoProperty (synExpr = synExpr) -> traverseSynExpr path synExpr
+ | SynMemberDefn.LetBindings (synBindingList, isRecursive, _, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None ->
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ |> pick m
+ | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None
+ | SynMemberDefn.Interface (interfaceType = synType; members = synMemberDefnsOption) ->
+ match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
+ | None ->
+ match synMemberDefnsOption with
+ | None -> None
+ | Some (x) ->
+ [ yield!
+ x
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ]
+ |> pick x
+ | ok -> ok
+ | SynMemberDefn.Inherit (synType, _identOption, range) -> traverseInherit (synType, range)
+ | SynMemberDefn.ValField (_synField, _range) -> None
+ | SynMemberDefn.NestedType (synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
+
+ and traverseSynMatchClause origPath mc =
+ let defaultTraverse mc =
+ let path = SyntaxNode.SynMatchClause mc :: origPath
+
+ match mc with
+ | SynMatchClause (pat = synPat; whenExpr = synExprOption; resultExpr = synExpr) as all ->
+ [ dive synPat synPat.Range (traversePat path) ]
+ @ ([ match synExprOption with
+ | None -> ()
+ | Some guard -> yield guard
+ yield synExpr ]
+ |> List.map (fun x -> dive x x.Range (traverseSynExpr path)))
+ |> pick all.Range all
+
+ visitor.VisitMatchClause(origPath, defaultTraverse, mc)
+
+ and traverseSynBinding origPath b =
+ let defaultTraverse b =
+ let path = SyntaxNode.SynBinding b :: origPath
+
+ match b with
+ | SynBinding (headPat = synPat; expr = synExpr) ->
+ match traversePat path synPat with
+ | None -> traverseSynExpr path synExpr
+ | x -> x
+
+ visitor.VisitBinding(origPath, defaultTraverse, b)
+
+ match parseTree with
+ | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) ->
+ let fileRange =
#if DEBUG
- match l with [] -> range0 | _ -> l |> List.map (fun x -> x.Range) |> List.reduce unionRanges
+ match l with
+ | [] -> range0
+ | _ ->
+ l
+ |> List.map (fun x -> x.Range)
+ |> List.reduce unionRanges
#else
- range0 // only used for asserting, does not matter in non-debug
+ range0 // only used for asserting, does not matter in non-debug
#endif
- l |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace [])) |> pick fileRange l
- | ParsedInput.SigFile _sigFile -> None
+ l
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace []))
+ |> pick fileRange l
+ | ParsedInput.SigFile _sigFile -> None
diff --git a/src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs b/src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs
index c2acc7c61..046dc5152 100644
--- a/src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs
+++ b/src/FsAutoComplete/CodeFixes/AddExplicitTypeAnnotation.fs
@@ -14,13 +14,13 @@ open FsAutoComplete.Core.InlayHints
open FsAutoComplete.Core
-let toLspEdit ({ Pos=insertAt; Text=text}: HintInsertion) =
- { Range = fcsPosToProtocolRange insertAt; NewText = text }
+let toLspEdit ({ Pos = insertAt; Text = text }: HintInsertion) =
+ { Range = fcsPosToProtocolRange insertAt
+ NewText = text }
-let toLspEdits (edits: HintInsertion[]) =
- edits |> Array.map toLspEdit
+let toLspEdits (edits: HintInsertion[]) = edits |> Array.map toLspEdit
-[] //TODO: correct?
+[] //TODO: correct?
let private isPositionContainedInUntypedImplicitCtorParameter input pos =
let result =
SyntaxTraversal.Traverse(
@@ -29,58 +29,53 @@ let private isPositionContainedInUntypedImplicitCtorParameter input pos =
{ new SyntaxVisitorBase<_>() with
member _.VisitModuleDecl(_, defaultTraverse, decl) =
match decl with
- | SynModuleDecl.Types(typeDefns = typeDefns) ->
- maybe {
- let! ctorArgs =
- typeDefns
- |> List.tryPick (
- function
- | SynTypeDefn(implicitConstructor=Some(SynMemberDefn.ImplicitCtor(ctorArgs = args))) when rangeContainsPos args.Range pos ->
- Some args
- | _ -> None
- )
-
- match ctorArgs with
- | SynSimplePats.SimplePats (pats=pats) ->
- let! pat =
- pats
- |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
- let rec tryGetUntypedIdent =
- function
- | SynSimplePat.Id (ident=ident) when rangeContainsPos ident.idRange pos ->
- Some ident
- | SynSimplePat.Attrib (pat=pat) when rangeContainsPos pat.Range pos ->
- tryGetUntypedIdent pat
- | SynSimplePat.Typed _
- | _ ->
- None
- return! tryGetUntypedIdent pat
- | _ -> return! None
- }
- |> Option.orElseWith (fun _ -> defaultTraverse decl)
- | _ -> defaultTraverse decl
- })
- result.IsSome
-[] //TODO: correct
-let private isSymbolToTriggerTypeAnnotation (funcOrValue: FSharpMemberOrFunctionOrValue) (symbolUse: FSharpSymbolUse) (parseFileResults: FSharpParseFileResults) =
- (
- funcOrValue.IsValue
- ||
- (
- funcOrValue.IsFunction
- &&
- parseFileResults.IsBindingALambdaAtPosition symbolUse.Range.Start
+ | SynModuleDecl.Types (typeDefns = typeDefns) ->
+ maybe {
+ let! ctorArgs =
+ typeDefns
+ |> List.tryPick (function
+ | SynTypeDefn(implicitConstructor = Some (SynMemberDefn.ImplicitCtor (ctorArgs = args))) when
+ rangeContainsPos args.Range pos
+ ->
+ Some args
+ | _ -> None)
+
+ match ctorArgs with
+ | SynSimplePats.SimplePats (pats = pats) ->
+ let! pat =
+ pats
+ |> List.tryFind (fun pat -> rangeContainsPos pat.Range pos)
+
+ let rec tryGetUntypedIdent =
+ function
+ | SynSimplePat.Id (ident = ident) when rangeContainsPos ident.idRange pos -> Some ident
+ | SynSimplePat.Attrib (pat = pat) when rangeContainsPos pat.Range pos -> tryGetUntypedIdent pat
+ | SynSimplePat.Typed _
+ | _ -> None
+
+ return! tryGetUntypedIdent pat
+ | _ -> return! None
+ }
+ |> Option.orElseWith (fun _ -> defaultTraverse decl)
+ | _ -> defaultTraverse decl }
)
- )
+
+ result.IsSome
+
+[] //TODO: correct
+let private isSymbolToTriggerTypeAnnotation
+ (funcOrValue: FSharpMemberOrFunctionOrValue)
+ (symbolUse: FSharpSymbolUse)
+ (parseFileResults: FSharpParseFileResults)
+ =
+ (funcOrValue.IsValue
+ || (funcOrValue.IsFunction
+ && parseFileResults.IsBindingALambdaAtPosition symbolUse.Range.Start))
//TODO: check here for curried parameter? necessary? Or handled by `tryGetExplicitTypeInfo`?
- &&
- not funcOrValue.IsMember
- &&
- not funcOrValue.IsMemberThisValue
- &&
- not funcOrValue.IsConstructorThisValue
- &&
- not (PrettyNaming.IsOperatorDisplayName funcOrValue.DisplayName)
+ && not funcOrValue.IsMember
+ && not funcOrValue.IsMemberThisValue
+ && not funcOrValue.IsConstructorThisValue
+ && not (PrettyNaming.IsOperatorDisplayName funcOrValue.DisplayName)
let title = "Add explicit type annotation"
@@ -94,22 +89,23 @@ let fix (getParseResultsForFile: GetParseResultsForFile) : CodeFix =
let fcsStartPos = protocolPosToPos codeActionParams.Range.Start
let! (parseAndCheck, lineStr, sourceText) = getParseResultsForFile filePath fcsStartPos
+
let res =
- InlayHints.tryGetDetailedExplicitTypeInfo
+ InlayHints.tryGetDetailedExplicitTypeInfo
(InlayHints.isPotentialTargetForTypeAnnotation true)
(sourceText, parseAndCheck)
fcsStartPos
+
match res with
| None -> return []
| Some (symbolUse, mfv, explTy) ->
- match explTy.TryGetTypeAndEdits (mfv.FullType, symbolUse.DisplayContext) with
- | None -> return []
- | Some (_, edits) ->
- return [{
- File = codeActionParams.TextDocument
+ match explTy.TryGetTypeAndEdits(mfv.FullType, symbolUse.DisplayContext) with
+ | None -> return []
+ | Some (_, edits) ->
+ return
+ [ { File = codeActionParams.TextDocument
Title = title
Edits = edits |> toLspEdits
Kind = FixKind.Refactor
- SourceDiagnostic = None
- }]
+ SourceDiagnostic = None } ]
}
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 1939b3c19..b11825a94 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -57,10 +57,9 @@ type LSPInlayHint =
Pos: Types.Position
Kind: InlayHintKind }
-type InlayHintData = {
- TextDocument: TextDocumentIdentifier
- Range: Types.Range
-}
+type InlayHintData =
+ { TextDocument: TextDocumentIdentifier
+ Range: Types.Range }
module Result =
let ofCoreResponse (r: CoreResponse<'a>) =
@@ -2646,138 +2645,148 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
)
p.TextDocument
- |> x.fileHandler (fun fn tyRes lines -> async {
- let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
- let! hints = commands.InlayHints(lines, tyRes, fcsRange)
- let lspHints =
- hints
- |> Array.map (fun h -> {
- Text = h.Text
- InsertText =
- match h.Insertions with
- | None -> None
- | Some inserts ->
- inserts
- |> Seq.filter (fun i -> i.Pos = h.Pos && i.Text <> ")" && i.Text <> "(")
- |> Seq.map (fun i -> i.Text)
- |> String.concat ""
- |> Some
- Pos = fcsPosToLsp h.Pos
- Kind = mapHintKind h.Kind
- })
- return success lspHints
- })
+ |> x.fileHandler (fun fn tyRes lines ->
+ async {
+ let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
+ let! hints = commands.InlayHints(lines, tyRes, fcsRange)
+
+ let lspHints =
+ hints
+ |> Array.map (fun h ->
+ { Text = h.Text
+ InsertText =
+ match h.Insertions with
+ | None -> None
+ | Some inserts ->
+ inserts
+ |> Seq.filter (fun i -> i.Pos = h.Pos && i.Text <> ")" && i.Text <> "(")
+ |> Seq.map (fun i -> i.Text)
+ |> String.concat ""
+ |> Some
+ Pos = fcsPosToLsp h.Pos
+ Kind = mapHintKind h.Kind })
- override x.TextDocumentInlayHint (p: InlayHintParams) : AsyncLspResult =
+ return success lspHints
+ })
+
+ override x.TextDocumentInlayHint(p: InlayHintParams) : AsyncLspResult =
logger.info (
Log.setMessage "TextDocumentInlayHint Request: {parms}"
>> Log.addContextDestructured "parms" p
)
p.TextDocument
- |> x.fileHandler (fun fn tyRes lines -> async {
- let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
- let! hints = commands.InlayHints (lines, tyRes, fcsRange)
- let hints: InlayHint[] =
- hints
- |> Array.map (fun h -> {
- Position = fcsPosToLsp h.Pos
- Label = InlayHintLabel.String h.Text
- Kind =
- match h.Kind with
- | InlayHints.HintKind.Type -> Types.InlayHintKind.Type
- | InlayHints.HintKind.Parameter -> Types.InlayHintKind.Parameter
- |> Some
- //TODO: lazy -> resolve?
- TextEdits =
- match h.Insertions with
- | None -> None
+ |> x.fileHandler (fun fn tyRes lines ->
+ async {
+ let fcsRange = protocolRangeToRange (UMX.untag fn) p.Range
+ let! hints = commands.InlayHints(lines, tyRes, fcsRange)
+
+ let hints: InlayHint[] =
+ hints
+ |> Array.map (fun h ->
+ { Position = fcsPosToLsp h.Pos
+ Label = InlayHintLabel.String h.Text
+ Kind =
+ match h.Kind with
+ | InlayHints.HintKind.Type -> Types.InlayHintKind.Type
+ | InlayHints.HintKind.Parameter -> Types.InlayHintKind.Parameter
+ |> Some
+ //TODO: lazy -> resolve?
+ TextEdits =
+ match h.Insertions with
+ | None -> None
// Note: Including no insertions via empty array:
// Difference:
// * `None` -> no `TextEdits` element specified -> can be `resolve`d
// * `Some [||]` -> `TextEdits` gets serialized -> no `resolve`
//TODO: always emit `Some [||]` (instead of `None`) for `Parameter` -> prevent `resolve`
- | Some insertions ->
+ | Some insertions ->
insertions
- |> Array.map (fun insertion -> {
- Range = fcsPosToProtocolRange insertion.Pos
- NewText = insertion.Text
- })
+ |> Array.map (fun insertion ->
+ { Range = fcsPosToProtocolRange insertion.Pos
+ NewText = insertion.Text })
|> Some
- //TODO: lazy -> resolve?
- Tooltip = h.Tooltip |> Option.map (InlayHintTooltip.String)
- PaddingLeft =
- match h.Kind with
- | InlayHints.HintKind.Type -> Some true
- | _ -> None
- PaddingRight =
- match h.Kind with
- | InlayHints.HintKind.Parameter -> Some true
- | _ -> None
- Data =
- {
- TextDocument = p.TextDocument
- Range = fcsRangeToLsp h.IdentRange
- }
- |> serialize
- |> Some
- })
+ //TODO: lazy -> resolve?
+ Tooltip = h.Tooltip |> Option.map (InlayHintTooltip.String)
+ PaddingLeft =
+ match h.Kind with
+ | InlayHints.HintKind.Type -> Some true
+ | _ -> None
+ PaddingRight =
+ match h.Kind with
+ | InlayHints.HintKind.Parameter -> Some true
+ | _ -> None
+ Data =
+ { TextDocument = p.TextDocument
+ Range = fcsRangeToLsp h.IdentRange }
+ |> serialize
+ |> Some })
+
+ return success (Some hints)
+ })
- return success (Some hints)
- })
- /// Note: Requires `InlayHintData` in `InlayHint.Data` element.
+ /// Note: Requires `InlayHintData` in `InlayHint.Data` element.
/// Required to relate `InlayHint` to a document and position inside
///
/// Note: Currently only resolves `Tooltip` and `TextEdits`
///
/// Note: Resolving `Tooltip` is currently not implement -> above *Note* is a lie...
- override x.InlayHintResolve (p: InlayHint): AsyncLspResult =
+ override x.InlayHintResolve(p: InlayHint) : AsyncLspResult =
logger.info (
Log.setMessage "InlayHintResolve Request: {parms}"
>> Log.addContextDestructured "parms" p
)
-
+
match p.Data with
- | None -> Async.singleton <| invalidParams "InlayHint doesn't specify contain `Data`"
- | _ when p.Tooltip |> Option.isSome && p.TextEdits |> Option.isSome ->
- // nothing to resolve
- Async.singleton <| success p
+ | None ->
+ Async.singleton
+ <| invalidParams "InlayHint doesn't specify contain `Data`"
+ | _ when
+ p.Tooltip |> Option.isSome
+ && p.TextEdits |> Option.isSome
+ ->
+ // nothing to resolve
+ Async.singleton <| success p
| Some data ->
- let data: InlayHintData = deserialize data
- let range = data.Range
- data.TextDocument
- |> x.fileHandler (fun fn tyRes lines -> asyncResult {
+ let data: InlayHintData = deserialize data
+ let range = data.Range
+
+ data.TextDocument
+ |> x.fileHandler (fun fn tyRes lines ->
+ asyncResult {
// update Tooltip
let! p =
match p.Tooltip with
| Some _ -> Ok p
- | None ->
- //TODO: implement
- Ok p
+ | None ->
+ //TODO: implement
+ Ok p
// update TextEdits
let! p =
match p.Kind, p.TextEdits with
| Some (Types.InlayHintKind.Parameter), _ -> Ok p
| _, Some _ -> Ok p
| _, None ->
- maybe {
- let! (symbolUse, mfv, explTy) =
- InlayHints.tryGetDetailedExplicitTypeInfo
- (InlayHints.isPotentialTargetForTypeAnnotation false)
- (lines, tyRes)
- (protocolPosToPos range.Start)
- let! (_, edits) = explTy.TryGetTypeAndEdits (mfv.FullType, symbolUse.DisplayContext)
- let p =
- { p with
- TextEdits =
- edits
- |> AddExplicitTypeAnnotation.toLspEdits
- |> Some
- }
- return p
- }
- |> Option.defaultValue p
- |> Ok
+ maybe {
+ let! (symbolUse, mfv, explTy) =
+ InlayHints.tryGetDetailedExplicitTypeInfo
+ (InlayHints.isPotentialTargetForTypeAnnotation false)
+ (lines, tyRes)
+ (protocolPosToPos range.Start)
+
+ let! (_, edits) = explTy.TryGetTypeAndEdits(mfv.FullType, symbolUse.DisplayContext)
+
+ let p =
+ { p with
+ TextEdits =
+ edits
+ |> AddExplicitTypeAnnotation.toLspEdits
+ |> Some }
+
+ return p
+ }
+ |> Option.defaultValue p
+ |> Ok
return p
})
From 6745b43e8e5ea41276f7dd6999fbe5fa316ce9d3 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 13 May 2022 20:08:44 +0200
Subject: [PATCH 11/29] Fix: Test for no CodeFix gets CodeFix
Reason: `AddExplicitType` now handles more than just parameters
-> triggers for let binding
---
test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs
index a6f3c3063..a7c467d02 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/CursorbasedTests.Tests.fs
@@ -41,7 +41,7 @@ module private CodeFix =
CodeFix.checkNotApplicable
server
"""
- let a$0 = 42
+ l$0et a = 42
a + 42
"""
ignore
From e28fb4a7567c632736b10a9f8c6abb098fde5cb0 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sat, 14 May 2022 15:31:58 +0200
Subject: [PATCH 12/29] Change InlayHint.Data to JToken
---
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 9 ++++-----
1 file changed, 4 insertions(+), 5 deletions(-)
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index b11825a94..ade41c7ba 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2738,18 +2738,17 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
)
match p.Data with
- | None ->
- Async.singleton
- <| invalidParams "InlayHint doesn't specify contain `Data`"
| _ when
p.Tooltip |> Option.isSome
&& p.TextEdits |> Option.isSome
->
// nothing to resolve
Async.singleton <| success p
+ | None ->
+ Async.singleton
+ <| invalidParams "InlayHint doesn't contain `Data`"
| Some data ->
let data: InlayHintData = deserialize data
- let range = data.Range
data.TextDocument
|> x.fileHandler (fun fn tyRes lines ->
@@ -2772,7 +2771,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
InlayHints.tryGetDetailedExplicitTypeInfo
(InlayHints.isPotentialTargetForTypeAnnotation false)
(lines, tyRes)
- (protocolPosToPos range.Start)
+ (protocolPosToPos data.Range.Start)
let! (_, edits) = explTy.TryGetTypeAndEdits(mfv.FullType, symbolUse.DisplayContext)
From 6060279ba03f976f00b26ed5ec8bfe20bda5f499 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sun, 15 May 2022 19:37:27 +0200
Subject: [PATCH 13/29] Add test functions to test LSP Inlay Hints
---
.../InlayHintTests.fs | 250 +++++++++++++++++-
test/FsAutoComplete.Tests.Lsp/Utils/Server.fs | 28 +-
.../Utils/TextEdit.fs | 8 +
3 files changed, 273 insertions(+), 13 deletions(-)
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index dc4780986..663bec141 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -10,7 +10,7 @@ open Utils.ServerTests
open FsAutoComplete.Core
open FsAutoComplete.Lsp
-module InlayHints =
+module private InlayHints =
open Utils.Server
open Utils.Tests
open Utils.Utils
@@ -46,7 +46,7 @@ module InlayHints =
| [||] -> ()
| diags -> failtest $"Should not have had check errors, but instead had %A{diags}"
- let! actual = Document.inlayHintsAt range doc
+ let! actual = Document.fsharpInlayHintsAt range doc
Expect.equal actual expected "Expected the given set of hints"
}
let check (server: CachedServer) (documentText: string) (expectedHints: _ list) = async {
@@ -81,10 +81,10 @@ module InlayHints =
do! check' server text range expected
}
-let param (name: string) = (name, InlayHintKind.Parameter)
-let ty (name: string) = (name, InlayHintKind.Type)
+let private param (name: string) = (name, InlayHintKind.Parameter)
+let private ty (name: string) = (name, InlayHintKind.Type)
-let tests state =
+let private fsharpInlayHintsTests state =
serverTestList (nameof Core.InlayHints) state defaultConfigDto None (fun server -> [
testList "type hint" [
testCaseAsync "let-bound function parameter type hints"
@@ -548,6 +548,246 @@ let tests state =
]
])
+module private LspInlayHints =
+ open Utils.Server
+ open Utils.Tests
+ open Utils.Utils
+ open Utils.TextEdit
+ open Ionide.LanguageServerProtocol.Types
+
+ let checkInRange
+ (server: CachedServer)
+ (text: string)
+ (range: Range)
+ (validateInlayHints: Document -> string -> InlayHint[] -> Async)
+ = async {
+ let! (doc, diags) = server |> Server.createUntitledDocument text
+ use doc = doc
+ // Expect.isEmpty diags "Should not have had check errors"
+ Expect.hasLength diags 0 "Should not have had check errors"
+
+ let! hints = doc |> Document.inlayHintsAt range
+ do! validateInlayHints doc text hints
+ }
+
+ let private validateHint
+ (doc: Document)
+ (expectedBase: InlayHint)
+ (textAfterEdits: string option)
+ (text: string)
+ (actual: InlayHint)
+ = async {
+ // Edits are checked by applying -> only check Edits None or Some
+ let mkDummyEdits o = o |> Option.bind (fun _ -> Some [||])
+ let ignoreData (hint: InlayHint) = { hint with Data = None }
+
+ let actualWithoutEdits = { actual with TextEdits = mkDummyEdits actual.TextEdits } |> ignoreData
+ let expectedWithoutExpected = { expectedBase with TextEdits = mkDummyEdits textAfterEdits }
+
+ Expect.equal actualWithoutEdits expectedWithoutExpected "Hint doesn't match expectations (Note: `TextEdits` are handled separately. Here just `None` or `Some`)"
+
+ match actual.TextEdits, textAfterEdits with
+ | Some edits, Some textAfterEdits ->
+ let appliedText =
+ text
+ |> TextEdits.applyWithErrorCheck (edits |> List.ofArray)
+ |> Flip.Expect.wantOk "TextEdits are erroneous"
+ Expect.equal appliedText textAfterEdits "Text after applying TextEdits does not match expected"
+ | _ -> ()
+
+ //TODO: handle capabilities
+ //TODO: en/disable?
+ let toResolve =
+ { actual with
+ Tooltip = None
+ TextEdits = None
+ }
+ let! resolved = doc |> Document.resolveInlayHint toResolve
+ Expect.equal resolved actual "`textDocument/inlayHint` and `inlayHint/resolve` should result in same InlayHint"
+
+ //todo: compare with AddExplicitType?
+ }
+
+ let rangeMarker = "$|"
+
+ let checkAllInMarkedRange
+ (server: CachedServer)
+ (textWithCursors: string)
+ (expected: (InlayHint * (string option)) list)
+ = async {
+ let (text, cursors) =
+ textWithCursors
+ |> Text.trimTripleQuotation
+ |> Cursors.extractGroupedWith [| rangeMarker; Cursor.Marker |]
+ let range =
+ let poss =
+ cursors
+ |> Map.tryFind rangeMarker
+ |> Flip.Expect.wantSome "There should be range markers"
+ Expect.hasLength poss 2 "There should be two range markers"
+ { Start = poss[0]; End = poss[1] }
+ let cursors =
+ cursors
+ |> Map.tryFind Cursor.Marker
+ |> Flip.Expect.wantSome "There should be range markers"
+ Expect.hasLength cursors (expected.Length) $"Number of Cursors & expected hints don't match ({cursors.Length} cursors, {expected.Length} expected hints)"
+ let expected =
+ List.zip expected cursors
+ |> List.map (fun ((hint, textAfterEdits), cursor) ->
+ let hint = { hint with Position = cursor}
+ (hint, textAfterEdits)
+ )
+
+ let validateHints doc (text: string) (hints: InlayHint[]) = async {
+ Expect.hasLength hints expected.Length "Number of actual hints and expected hints don't match"
+
+ for (actual, (expected, textAfterEdits)) in Seq.zip hints expected do
+ do! validateHint doc expected textAfterEdits text actual
+ }
+
+ do! checkInRange server text range validateHints
+ }
+
+ let private fromCursor: Position = { Line = -1; Character = -1 }
+
+ let private mkBasicHint
+ (kind: InlayHintKind)
+ (pos: Position)
+ (label: string)
+ : InlayHint
+ =
+ {
+ Kind = Some kind
+ Position = pos
+ Label = InlayHintLabel.String label
+ TextEdits = None
+ Tooltip = None
+ PaddingLeft = match kind with | InlayHintKind.Type -> Some true | _ -> None
+ PaddingRight = match kind with | InlayHintKind.Parameter -> Some true | _ -> None
+ Data = None
+ }
+ let paramHint
+ (paramName: string)
+ =
+ let label = $"{paramName} ="
+ let hint = mkBasicHint InlayHintKind.Parameter fromCursor label
+ (hint, None)
+ let typeHint
+ (typeName: string)
+ (expectedAfterEdits: string)
+ =
+ let label = $": {typeName}"
+ let hint = mkBasicHint InlayHintKind.Type fromCursor label
+ let expectedAfterEdits =
+ expectedAfterEdits
+ |> Text.trimTripleQuotation
+ (hint, Some expectedAfterEdits)
+
+open LspInlayHints
+let private paramHintTests state =
+ serverTestList "param hints" state defaultConfigDto None (fun server -> [
+ testCaseAsync "can show param hint" <|
+ checkAllInMarkedRange server
+ """
+ let f beta = ()
+ $|f $042$|
+ """
+ [
+ paramHint "beta"
+ ]
+ ])
+let private typeHintTests state =
+ serverTestList "type hints" state defaultConfigDto None (fun server -> [
+ testCaseAsync "can show type hint" <|
+ checkAllInMarkedRange server
+ """
+ $|let f beta$0 = beta + 1$|
+ """
+ [
+ typeHint "int"
+ """
+ let f (beta: int) = beta + 1
+ """
+ ]
+ ])
+let private mixedHintTests state =
+ serverTestList "inlay hints" state defaultConfigDto None (fun server -> [
+ testCaseAsync "can show all hints" <|
+ checkAllInMarkedRange server
+ """
+ $|open System
+ let f alpha$0 beta$0 =
+ let beta$0 = Int32.Parse beta
+ let value$0 = alpha + beta + 2
+ value * 2
+ let res$0 = f $042 $0"13" + f $01 $0"2"$|
+ """
+ [
+ typeHint "int"
+ """
+ open System
+ let f (alpha: int) beta =
+ let beta = Int32.Parse beta
+ let value = alpha + beta + 2
+ value * 2
+ let res = f 42 "13" + f 1 "2"
+ """
+ typeHint "string"
+ """
+ open System
+ let f alpha (beta: string) =
+ let beta = Int32.Parse beta
+ let value = alpha + beta + 2
+ value * 2
+ let res = f 42 "13" + f 1 "2"
+ """
+ typeHint "int"
+ """
+ open System
+ let f alpha beta =
+ let beta: int = Int32.Parse beta
+ let value = alpha + beta + 2
+ value * 2
+ let res = f 42 "13" + f 1 "2"
+ """
+ typeHint "int"
+ """
+ open System
+ let f alpha beta =
+ let beta = Int32.Parse beta
+ let value: int = alpha + beta + 2
+ value * 2
+ let res = f 42 "13" + f 1 "2"
+ """
+ typeHint "int"
+ """
+ open System
+ let f alpha beta =
+ let beta = Int32.Parse beta
+ let value = alpha + beta + 2
+ value * 2
+ let res: int = f 42 "13" + f 1 "2"
+ """
+ paramHint "alpha"
+ paramHint "beta"
+ paramHint "alpha"
+ paramHint "beta"
+ ]
+ ])
+let private inlayHintTests state =
+ testList "LSP InlayHints" [
+ paramHintTests state
+ typeHintTests state
+ mixedHintTests state
+ ]
+
+let tests state =
+ testList (nameof InlayHint) [
+ fsharpInlayHintsTests state
+ inlayHintTests state
+ ]
+
+
open FSharp.Compiler.CodeAnalysis
open FSharp.Compiler.Text
open Utils.TextEdit
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs
index 20911ec68..7d16f2dfa 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs
@@ -359,12 +359,24 @@ module Document =
return res |> assertOk
}
- let inlayHintsAt range (doc: Document) =
- async {
- let ps: FSharpInlayHintsRequest =
- { Range = range
- TextDocument = doc.TextDocumentIdentifier }
-
- let! res = doc.Server.Server.FSharpInlayHints(ps)
- return res |> assertOk
+ let fsharpInlayHintsAt range (doc: Document) = async {
+ let ps: FSharpInlayHintsRequest = {
+ Range = range
+ TextDocument = doc.TextDocumentIdentifier
+ }
+ let! res = doc.Server.Server.FSharpInlayHints(ps)
+ return res |> assertOk
+ }
+
+ let inlayHintsAt range (doc: Document) = async {
+ let ps: InlayHintParams = {
+ Range = range
+ TextDocument = doc.TextDocumentIdentifier
}
+ let! res = doc.Server.Server.TextDocumentInlayHint ps
+ return res |> assertOk
+ }
+ let resolveInlayHint inlayHint (doc: Document) = async {
+ let! res = doc.Server.Server.InlayHintResolve inlayHint
+ return res |> assertOk
+ }
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
index 015eb1898..da1e5fdfc 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
@@ -381,6 +381,14 @@ module TextEdits =
let edits = edits |> sortByRange |> List.rev
List.fold (fun text edit -> text |> Result.bind (TextEdit.apply edit)) (Ok text) edits
+ /// `tryFindError` before `apply`
+ let applyWithErrorCheck edits text =
+ match tryFindError edits with
+ | Some error -> Error error
+ | None ->
+ text
+ |> apply edits
+
module WorkspaceEdit =
/// Extract `TextEdit[]` from either `DocumentChanges` or `Changes`.
/// All edits MUST be for passed `textDocument`.
From ab9b5a9a08b1b726104e2d2b668a0f2ec12dc79d Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Mon, 16 May 2022 12:18:42 +0200
Subject: [PATCH 14/29] Add test for type nested in another generic type
Issue: Incorrect type format: ``ImmutableArray`1.Builder`` instead of ``ImmutableArray.Builder``
//TODO: how to format correctly?
---
.../InlayHintTests.fs | 31 +++++++++++++++++++
1 file changed, 31 insertions(+)
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index 663bec141..0c6334ec3 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -709,6 +709,37 @@ let private typeHintTests state =
let f (beta: int) = beta + 1
"""
]
+ testCaseAsync "can show type for generic actual type" <|
+ checkAllInMarkedRange server
+ """
+ open System.Collections.Generic
+ $|let list$0 = List()$|
+ list.Add 2
+ """
+ [
+ typeHint "List"
+ """
+ open System.Collections.Generic
+ let list: List = List()
+ list.Add 2
+ """
+ ]
+ ptestCaseAsync "can show type hint for nested inside generic actual type" <|
+ checkAllInMarkedRange server
+ """
+ open System.Collections.Immutable
+ $|let arr$0 = ImmutableArray.CreateBuilder()$|
+ arr.Add 2
+ """
+ [
+ //Currently: `ImmutableArray`1.Builder`
+ typeHint "ImmutableArray.Builder"
+ """
+ open System.Collections.Immutable
+ let arr: ImmutableArray.Builder = ImmutableArray.CreateBuilder()
+ arr.Add 2
+ """
+ ]
])
let private mixedHintTests state =
serverTestList "inlay hints" state defaultConfigDto None (fun server -> [
From d2f3f29b686d64cb98aa97875098839d761ad8d5 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 27 May 2022 14:43:39 +0200
Subject: [PATCH 15/29] Add Tooltip with full name when truncated
Remove Tooltip from `inlayHint/resolve`
Add tests for LSP InlayHints
* Including TextEdits
* Move Tests from F# InlayHints to LSP Inlay Hints
* F# Inlay Hints contain just very few basic tests to check it's still working
but all real tests of InlayHints are now for LSP InlayHints
Enable `explicitTypeInfoTests` (calling of tests wasn't checked in before...)
---
src/FsAutoComplete.Core/InlayHints.fs | 34 +-
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 17 +-
.../InlayHintTests.fs | 1098 ++++++++++-------
test/FsAutoComplete.Tests.Lsp/Program.fs | 1 +
4 files changed, 652 insertions(+), 498 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index bb5e1eb88..14ca65d40 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -25,7 +25,7 @@ type Hint =
Pos: Position
Text: string
Insertions: HintInsertion[] option
- //TODO: allow xml doc
+ //ENHANCEMENT: allow xml doc
Tooltip: string option }
let private getArgumentsFor (state: FsAutoComplete.State, p: ParseAndCheckResults, identText: Range) =
@@ -102,21 +102,28 @@ let private getFirstPositionAfterParen (str: string) startPos =
let private maxHintLength = 30
-let truncated (s: string) =
- if s.Length > maxHintLength then
- s.Substring(0, maxHintLength) + "..."
+let inline private shouldTruncate (s: string) = s.Length > maxHintLength
+
+let inline private tryTruncate (s: string) =
+ if shouldTruncate s then
+ s.Substring(0, maxHintLength) + "..." |> Some
else
- s
+ None
+
+let truncated (s: string) = tryTruncate s |> Option.defaultValue s
let private createParamHint (identRange: Range) (paramName: string) =
- let format p = p + " ="
+ let (truncated, tooltip) =
+ match tryTruncate paramName with
+ | None -> (paramName, None)
+ | Some truncated -> (truncated, Some paramName)
{ IdentRange = identRange
Pos = identRange.Start
Kind = Parameter
- Text = format (truncated paramName)
+ Text = truncated + " ="
Insertions = None
- Tooltip = None }
+ Tooltip = tooltip }
module private ShouldCreate =
let private isNotWellKnownName =
@@ -793,15 +800,18 @@ let private tryCreateTypeHint (explicitType: ExplicitType) (ty: FSharpType) (dis
| ExplicitType.Missing data ->
let (ty, tyForAnno) = data.FormatType(ty, displayContext)
+ let (truncated, tooltip) =
+ match tryTruncate ty with
+ | None -> (ty, None)
+ | Some truncated -> (truncated, Some ty)
+
{ IdentRange = data.Ident
Pos = data.InsertAt
Kind = Type
// TODO: or use tyForAnno?
- Text = ": " + (truncated ty)
- //TODO: delay for resolve?
+ Text = ": " + truncated
Insertions = Some <| data.CreateEdits tyForAnno
- //TODO: implement? delay for resolve?
- Tooltip = None }
+ Tooltip = tooltip }
|> Some
| _ -> None
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index ade41c7ba..4869934fa 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2725,12 +2725,11 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
return success (Some hints)
})
+ //TODO: remove?
/// Note: Requires `InlayHintData` in `InlayHint.Data` element.
/// Required to relate `InlayHint` to a document and position inside
///
- /// Note: Currently only resolves `Tooltip` and `TextEdits`
- ///
- /// Note: Resolving `Tooltip` is currently not implement -> above *Note* is a lie...
+ /// Note: Currently only resolves `TextEdits`
override x.InlayHintResolve(p: InlayHint) : AsyncLspResult =
logger.info (
Log.setMessage "InlayHintResolve Request: {parms}"
@@ -2738,10 +2737,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
)
match p.Data with
- | _ when
- p.Tooltip |> Option.isSome
- && p.TextEdits |> Option.isSome
- ->
+ | _ when p.TextEdits |> Option.isSome ->
// nothing to resolve
Async.singleton <| success p
| None ->
@@ -2753,13 +2749,6 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
data.TextDocument
|> x.fileHandler (fun fn tyRes lines ->
asyncResult {
- // update Tooltip
- let! p =
- match p.Tooltip with
- | Some _ -> Ok p
- | None ->
- //TODO: implement
- Ok p
// update TextEdits
let! p =
match p.Kind, p.TextEdits with
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index 0c6334ec3..10412f56a 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -10,7 +10,7 @@ open Utils.ServerTests
open FsAutoComplete.Core
open FsAutoComplete.Lsp
-module private InlayHints =
+module private FSharpInlayHints =
open Utils.Server
open Utils.Tests
open Utils.Utils
@@ -81,472 +81,34 @@ module private InlayHints =
do! check' server text range expected
}
-let private param (name: string) = (name, InlayHintKind.Parameter)
-let private ty (name: string) = (name, InlayHintKind.Type)
-
-let private fsharpInlayHintsTests state =
- serverTestList (nameof Core.InlayHints) state defaultConfigDto None (fun server -> [
- testList "type hint" [
- testCaseAsync "let-bound function parameter type hints"
- <| InlayHints.check
- server
- """
- $0let tryFindFile p = p + "hi"$0
- """
- [ "string", (0, 17), InlayHintKind.Type ]
-
- testCaseAsync "value let binding type hint"
- <| InlayHints.check
- server
- """
- $0let f = "hi"$0
- """
- [ "string", (0, 5), InlayHintKind.Type ]
-
- testCaseAsync "no type hint for an explicitly-typed binding"
- <| InlayHints.check server """$0let s: string = "hi"$0""" []
-
- testCaseAsync "type hints are truncated to 30 characters"
- <| InlayHints.check
- server
- """
- $0let t = Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some ()))))))))))))))$0
- """
- [ "unit option option option option option option option option option option option option option option option",
- (0, 5),
- InlayHintKind.Type ]
- ]
-
- testList "parameter hint" [
-
- testCaseAsync "parameter names aren't yet implemented, will fail when we update FCS"
- <| InlayHints.check server """$0 System.Environment.GetEnvironmentVariable "Blah" |> ignore$0""" []
-
- testCaseAsync "doesn't show hint for well-known parameter names"
- <| InlayHints.check server """$0sprintf "thing %s" "blah" |> ignore$0""" []
-
- testCaseAsync "doesn't show hints for short parameter names"
- <| InlayHints.check
- server
- """
- let someFunction s = s
- let noHintForShortParameter = $0someFunction "hi"$0
- """
- []
-
- testCaseAsync "doesn't show hints for parameter names that match user text"
- <| InlayHints.check
- server
- """
- let anotherFunction (kind: string) = ()
- let kind = "hi"
- $0anotherFunction kind$0
- """
- []
-
- testCaseAsync "no hint for a function with a short parameter name"
- <| InlayHints.check
- server
- """
- // shows that no parameter name hint is shown for a function with a short parameter name
- let someFunction s = s
- let noHintForShortParameter = $0someFunction "hi"$0
- """
- []
-
- testCaseAsync "show: param & variable have different names" <|
- InlayHints.checkRange server
- """
- let f beta = ()
- let alpha = 42
-
- $0f $0alpha$0
- """
- [ param "beta" ]
-
- testCaseAsync "hide: param & variable have same name" <|
- InlayHints.checkRange server
- """
- let f alpha = ()
- let alpha = 42
-
- $0f alpha$0
- """
- [ ]
- testCaseAsync "hide: variable prefix of param" <|
- InlayHints.checkRange server
- """
- let f rangeCoveringExpr = ()
- let range = 2
-
- $0f range$0
- """
- [ ]
- testCaseAsync "hide: variable postfix of param" <|
- InlayHints.checkRange server
- """
- let f exactRange = ()
- let range = 2
-
- $0f range$0
- """
- [ ]
- testCaseAsync "show: variable infix of param" <|
- InlayHints.checkRange server
- """
- let f exactRangeCoveringExpr = ()
- let range = 2
-
- $0f $0range$0
- """
- [ param "exactRangeCoveringExpr" ]
- testCaseAsync "show: variable prefix of param, but no word boundary" <|
- InlayHints.checkRange server
- """
- let f rangecover = ()
- let range = 2
-
- $0f $0range$0
- """
- [ param "rangecover" ]
- testCaseAsync "show: variable postfix of param, but no word boundary" <|
- InlayHints.checkRange server
- """
- let f exactrange = ()
- let range = 2
-
- $0f $0range$0
- """
- [ param "exactrange" ]
-
- testCaseAsync "hide: arg is prefix of param with leading _" <|
- InlayHints.checkRange server
- """
- let f _rangeCoveringExpr = ()
- let range = 2
-
- $0f range$0
- """
- []
- testCaseAsync "hide: arg is postfix of param with trailing '" <|
- InlayHints.checkRange server
- """
- let f exactRange' = ()
- let range = 2
-
- $0f range$0
- """
- []
- testCaseAsync "hide: arg is prefix of param with trailing ' in arg" <|
- InlayHints.checkRange server
- """
- let f rangeCoveringExpr = ()
- let range' = 2
-
- $0f range'$0
- """
- []
-
- testCaseAsync "hide: param prefix of arg" <|
- InlayHints.checkRange server
- """
- let f range = ()
- let rangeCoveringExpr = 2
-
- $0f rangeCoveringExpr$0
- """
- []
- testCaseAsync "hide: param postfix of arg" <|
- InlayHints.checkRange server
- """
- let f range = ()
- let exactRange = 2
-
- $0f exactRange$0
- """
- []
-
- testCaseAsync "hide: arg is field access with same name as param (upper case start)" <|
- InlayHints.checkRange server
- """
- type Data = {
- Range: int
- }
- let f range = ()
- let data: Data = { Range = 2 }
-
- $0f data.Range$0
- """
- []
- testCaseAsync "hide: arg is field access with same name as param (lower case start)" <|
- InlayHints.checkRange server
- """
- type Data = {
- range: int
- }
- let f range = ()
- let data: Data = { range = 2 }
-
- $0f data.range$0
- """
- []
- testCaseAsync "hide: arg is field access prefix of param (upper case start)" <|
- InlayHints.checkRange server
- """
- type Data = {
- Range: int
- }
- let f rangeCoveringExpr = ()
- let data: Data = { Range = 2 }
-
- $0f data.Range$0
- """
- []
- testCaseAsync "hide: arg is field access, param is prefix of arg" <|
- InlayHints.checkRange server
- """
- type Data = {
- RangeCoveringExpr: int
- }
- let f range = ()
- let data: Data = { RangeCoveringExpr = 2 }
-
- $0f data.RangeCoveringExpr$0
- """
- []
-
- testCaseAsync "hide: arg in parens same as param" <|
- InlayHints.checkRange server
- """
- let f alpha = ()
- let alpha = 42
-
- $0f (alpha)$0
- """
- [ ]
- testCaseAsync "hide: arg in parens and spaces same as param" <|
- InlayHints.checkRange server
- """
- let f alpha = ()
- let alpha = 42
-
- $0f ( alpha )$0
- """
- [ ]
- testCaseAsync "show: expr including param name in parens" <|
- InlayHints.checkRange server
- """
- let f alpha = ()
- let alpha x = x + 3
-
- $0f $0(1 |> alpha)$0
- """
- [ param "alpha" ]
-
- //ENHANCEMENT: detect some common expressions like:
- // * receiving end of pipe: `1 |> alpha`, `alpha <| 1`, `1 |> toAlpha`
- // * last function: `1.ToAlpha()`
- // * often used convert functions: `string alpha`, `alpha.ToString()`
- testCaseAsync "show: any expression" <|
- InlayHints.checkRange server
- """
- let f (alpha, beta, gamma) = ()
- let alpha = 1
- let beta = 2
- let gamma = 2
-
- $0f ($0string alpha, $0beta.ToString(), $0gamma |> string)$0
- """
- [ param "alpha"; param "beta"; param "gamma" ]
-
- testCaseAsync "hide: unary operator" <|
- InlayHints.checkRange server
- """
- let (~+.) listWithNumbers = List.map ((+) 1) listWithNumbers
- let data = [1..5]
-
- $0+. data$0
- """
- []
- testCaseAsync "hide: binary operator" <|
- InlayHints.checkRange server
- """
- let (+.) listWithNumbers numberToAdd = List.map ((+) numberToAdd) listWithNumbers
- let data = [1..5]
-
- $0data +. 5$0
- """
- []
+ let private param (name: string) = (name, InlayHintKind.Parameter)
+ let private ty (name: string) = (name, InlayHintKind.Type)
- testCaseAsync "hide: func name ends with param name" <|
- InlayHints.checkRange server
- """
- let validateRange range = ()
- let data = 42
+ let tests state =
+ serverTestList "F# Inlay Hints" state defaultConfigDto None (fun server -> [
+ testList "type hint" [
+ testCaseAsync "can show type hint" <|
+ checkRange server
+ """
+ $0let f beta$0 = beta + 1$0
+ """
+ [
+ ty "int"
+ ]
+ ]
- $0validateRange data$0
- """
- []
-
- testList "special names" [
- testList "mapping" [
- testCaseAsync "hide: for List" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.map id$0
- """
- []
- testCaseAsync "hide: for Array" <|
- InlayHints.checkRange server
- """
- $0[|1..3|] |> Array.map id$0
- """
- []
- testCaseAsync "show: for custom function" <|
- InlayHints.checkRange server
- """
- let doStuff mapping = ()
- $0doStuff $042$0
- """
- [ param "mapping" ]
- ]
- testList "in collections" [
- testCaseAsync "hide: predicate" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.filter ((<) 2)$0
- """
- []
- testCaseAsync "hide: chooser" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.tryPick Some$0
- """
- []
- testCaseAsync "hide: value" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.contains 2$0
- """
- []
- testCaseAsync "hide: projection" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.sumBy id$0
- """
- []
- testCaseAsync "hide: action" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.iter (printfn "%i")$0
- """
- []
- testCaseAsync "hide: folder & state" <|
- InlayHints.checkRange server
- """
- $0[1..3] |> List.fold (+) 0$0
- """
- []
-
-
- testCaseAsync "hide: list" <|
- InlayHints.checkRange server
- """
- $0List.tryLast [1..3]$0
- """
- []
- testCaseAsync "hide: array" <|
- InlayHints.checkRange server
- """
- $0Array.tryLast [|1..3|]$0
- """
- []
- testCaseAsync "hide: source" <|
- InlayHints.checkRange server
- """
- $0Seq.tryLast [1..3]$0
- """
- []
- testCaseAsync "hide: lists" <|
- InlayHints.checkRange server
- """
- $0List.concat []$0
- """
- []
- testCaseAsync "hide: arrays" <|
- InlayHints.checkRange server
- """
- $0Array.concat [||]$0
- """
- []
- testCaseAsync "hide: sources" <|
- InlayHints.checkRange server
- """
- $0Seq.concat []$0
- """
- []
- ]
- testList "option" [
- testCaseAsync "hide: for Option" <|
- InlayHints.checkRange server
- """
- $0Option.count (Some 3)$0
- """
- []
- testCaseAsync "show: for custom function" <|
- InlayHints.checkRange server
- """
- let doStuff option = ()
- $0doStuff $042$0
- """
- [ param "option" ]
- ]
- testList "voption" [
- testCaseAsync "hide: for ValueOption" <|
- InlayHints.checkRange server
- """
- $0ValueOption.count (ValueSome 3)$0
- """
- []
- testCaseAsync "show: for custom function" <|
- InlayHints.checkRange server
- """
- let doStuff voption = ()
- $0doStuff $042$0
- """
- [ param "voption" ]
- ]
- testList "format" [
- testCaseAsync "hide: in printfn" <|
- InlayHints.checkRange server
- """
- $0printfn "foo"$0
- """
- []
- testCaseAsync "hide: in sprintf" <|
- InlayHints.checkRange server
- """
- $0sprintf "foo"$0
- """
- []
- testCaseAsync "hide: in Core.Printf" <|
- // "normal" printf is in `Microsoft.FSharp.Core.ExtraTopLevelOperators`
- InlayHints.checkRange server
- """
- $0Microsoft.FSharp.Core.Printf.printfn "foo"$0
- """
- []
- testCaseAsync "show: for custom function" <|
- InlayHints.checkRange server
- """
- let doStuff format = ()
- $0doStuff $042$0
- """
- [ param "format" ]
- ]
+ testList "parameter hint" [
+ testCaseAsync "can show param hint" <|
+ checkRange server
+ """
+ let f beta = ()
+ $0f $042$0
+ """
+ [
+ param "beta"
+ ]
]
- ]
- ])
+ ])
module private LspInlayHints =
open Utils.Server
@@ -563,10 +125,12 @@ module private LspInlayHints =
= async {
let! (doc, diags) = server |> Server.createUntitledDocument text
use doc = doc
- // Expect.isEmpty diags "Should not have had check errors"
Expect.hasLength diags 0 "Should not have had check errors"
- let! hints = doc |> Document.inlayHintsAt range
+ let! hints =
+ doc
+ |> Document.inlayHintsAt range
+ let hints = hints |> Option.defaultValue [||]
do! validateInlayHints doc text hints
}
@@ -595,17 +159,14 @@ module private LspInlayHints =
Expect.equal appliedText textAfterEdits "Text after applying TextEdits does not match expected"
| _ -> ()
- //TODO: handle capabilities
+ //TODO: handle capabilities?
//TODO: en/disable?
let toResolve =
{ actual with
- Tooltip = None
TextEdits = None
}
let! resolved = doc |> Document.resolveInlayHint toResolve
Expect.equal resolved actual "`textDocument/inlayHint` and `inlayHint/resolve` should result in same InlayHint"
-
- //todo: compare with AddExplicitType?
}
let rangeMarker = "$|"
@@ -629,7 +190,7 @@ module private LspInlayHints =
let cursors =
cursors
|> Map.tryFind Cursor.Marker
- |> Flip.Expect.wantSome "There should be range markers"
+ |> Option.defaultValue []
Expect.hasLength cursors (expected.Length) $"Number of Cursors & expected hints don't match ({cursors.Length} cursors, {expected.Length} expected hints)"
let expected =
List.zip expected cursors
@@ -682,10 +243,42 @@ module private LspInlayHints =
expectedAfterEdits
|> Text.trimTripleQuotation
(hint, Some expectedAfterEdits)
+ let truncated (hint: InlayHint, edits) =
+ let label =
+ match hint.Label with
+ | InlayHintLabel.String label -> label
+ | _ -> failtestf "invalid label: %A" hint.Label
+ let (name, kind) =
+ match hint.Kind with
+ | Some InlayHintKind.Parameter ->
+ let name = label.Substring(0, label.Length-2)
+ name, InlayHintKind.Parameter
+ | Some InlayHintKind.Type ->
+ let name = label.Substring(2)
+ name, InlayHintKind.Type
+ | _ -> failtestf "invalid kind: %A" hint.Kind
+ let truncatedName = InlayHints.truncated name
+ Expect.notEqual truncatedName name "Truncated name should be different from untruncated one"
+ let hint =
+ { hint with
+ Label =
+ match kind with
+ | InlayHintKind.Parameter ->
+ truncatedName + " ="
+ | InlayHintKind.Type ->
+ ": " + truncatedName
+ | _ -> failwith "unreachable"
+ |> InlayHintLabel.String
+ Tooltip =
+ InlayHintTooltip.String name
+ |> Some
+ }
+ (hint, edits)
open LspInlayHints
let private paramHintTests state =
serverTestList "param hints" state defaultConfigDto None (fun server -> [
+ //todo: with ````
testCaseAsync "can show param hint" <|
checkAllInMarkedRange server
"""
@@ -695,6 +288,499 @@ let private paramHintTests state =
[
paramHint "beta"
]
+ testCaseAsync "can show all param hints" <|
+ checkAllInMarkedRange server
+ """
+ let f alpha beta = ()
+ $|f $042 $013
+ f $01 $02$|
+ """
+ [
+ paramHint "alpha"; paramHint "beta"
+ paramHint "alpha"; paramHint "beta"
+ ]
+ testCaseAsync "can get tooltip for truncated hint" <|
+ checkAllInMarkedRange server
+ """
+ let f averylongnamenotjustlongbutextremelylongandjusttobesureevenlonger = ()
+ $|f $042$|
+ """
+ [
+ truncated <| paramHint "averylongnamenotjustlongbutextremelylongandjusttobesureevenlonger"
+ ]
+
+ testCaseAsync "doesn't show hint for well-known parameter name" <|
+ checkAllInMarkedRange server
+ """
+ $|sprintf "thing %s" "blah" |> ignore$|
+ """
+ []
+ testCaseAsync "doesn't show hints for short parameter names" <|
+ checkAllInMarkedRange server
+ """
+ let someFunction s = s
+ let noHintForShortParameter = $|someFunction "hi"$|
+ """
+ []
+ testCaseAsync "doesn't show hints for parameter names that match user text" <|
+ checkAllInMarkedRange server
+ """
+ let anotherFunction (kind: string) = ()
+ let kind = "hi"
+ $|anotherFunction kind$|
+ """
+ []
+
+ testCaseAsync "show: param & variable have different names" <|
+ checkAllInMarkedRange server
+ """
+ let f beta = ()
+ let alpha = 42
+
+ $|f $0alpha$|
+ """
+ [ paramHint "beta" ]
+
+ testCaseAsync "hide: param & variable have same name" <|
+ checkAllInMarkedRange server
+ """
+ let f alpha = ()
+ let alpha = 42
+
+ $|f alpha$|
+ """
+ [ ]
+ testCaseAsync "hide: variable prefix of param" <|
+ checkAllInMarkedRange server
+ """
+ let f rangeCoveringExpr = ()
+ let range = 2
+
+ $|f range$|
+ """
+ [ ]
+ testCaseAsync "hide: variable postfix of param" <|
+ checkAllInMarkedRange server
+ """
+ let f exactRange = ()
+ let range = 2
+
+ $|f range$|
+ """
+ [ ]
+ testCaseAsync "show: variable infix of param" <|
+ checkAllInMarkedRange server
+ """
+ let f exactRangeCoveringExpr = ()
+ let range = 2
+
+ $|f $0range$|
+ """
+ [ paramHint "exactRangeCoveringExpr" ]
+ testCaseAsync "show: variable prefix of param, but no word boundary" <|
+ checkAllInMarkedRange server
+ """
+ let f rangecover = ()
+ let range = 2
+
+ $|f $0range$|
+ """
+ [ paramHint "rangecover" ]
+ testCaseAsync "show: variable postfix of param, but no word boundary" <|
+ checkAllInMarkedRange server
+ """
+ let f exactrange = ()
+ let range = 2
+
+ $|f $0range$|
+ """
+ [ paramHint "exactrange" ]
+
+ testCaseAsync "hide: arg is prefix of param with leading _" <|
+ checkAllInMarkedRange server
+ """
+ let f _rangeCoveringExpr = ()
+ let range = 2
+
+ $|f range$|
+ """
+ []
+ testCaseAsync "hide: arg is postfix of param with trailing '" <|
+ checkAllInMarkedRange server
+ """
+ let f exactRange' = ()
+ let range = 2
+
+ $|f range$|
+ """
+ []
+ testCaseAsync "hide: arg is prefix of param with trailing ' in arg" <|
+ checkAllInMarkedRange server
+ """
+ let f rangeCoveringExpr = ()
+ let range' = 2
+
+ $|f range'$|
+ """
+ []
+
+ testCaseAsync "hide: param prefix of arg" <|
+ checkAllInMarkedRange server
+ """
+ let f range = ()
+ let rangeCoveringExpr = 2
+
+ $|f rangeCoveringExpr$|
+ """
+ []
+ testCaseAsync "hide: param postfix of arg" <|
+ checkAllInMarkedRange server
+ """
+ let f range = ()
+ let exactRange = 2
+
+ $|f exactRange$|
+ """
+ []
+
+ testCaseAsync "hide: arg is field access with same name as param (upper case start)" <|
+ checkAllInMarkedRange server
+ """
+ type Data = {
+ Range: int
+ }
+ let f range = ()
+ let data: Data = { Range = 2 }
+
+ $|f data.Range$|
+ """
+ []
+ testCaseAsync "hide: arg is field access with same name as param (lower case start)" <|
+ checkAllInMarkedRange server
+ """
+ type Data = {
+ range: int
+ }
+ let f range = ()
+ let data: Data = { range = 2 }
+
+ $|f data.range$|
+ """
+ []
+ testCaseAsync "hide: arg is field access prefix of param (upper case start)" <|
+ checkAllInMarkedRange server
+ """
+ type Data = {
+ Range: int
+ }
+ let f rangeCoveringExpr = ()
+ let data: Data = { Range = 2 }
+
+ $|f data.Range$|
+ """
+ []
+ testCaseAsync "hide: arg is field access, param is prefix of arg" <|
+ checkAllInMarkedRange server
+ """
+ type Data = {
+ RangeCoveringExpr: int
+ }
+ let f range = ()
+ let data: Data = { RangeCoveringExpr = 2 }
+
+ $|f data.RangeCoveringExpr$|
+ """
+ []
+
+ testCaseAsync "hide: arg in parens same as param" <|
+ checkAllInMarkedRange server
+ """
+ let f alpha = ()
+ let alpha = 42
+
+ $|f (alpha)$|
+ """
+ [ ]
+ testCaseAsync "hide: arg in parens and spaces same as param" <|
+ checkAllInMarkedRange server
+ """
+ let f alpha = ()
+ let alpha = 42
+
+ $|f ( alpha )$|
+ """
+ [ ]
+ testCaseAsync "show: expr including param name in parens" <|
+ checkAllInMarkedRange server
+ """
+ let f alpha = ()
+ let alpha x = x + 3
+
+ $|f $0(1 |> alpha)$|
+ """
+ [ paramHint "alpha" ]
+
+ //ENHANCEMENT: detect some common expressions like:
+ // * receiving end of pipe: `1 |> alpha`, `alpha <| 1`, `1 |> toAlpha`
+ // * last function: `1.ToAlpha()`
+ // * often used convert functions: `string alpha`, `alpha.ToString()`
+ testCaseAsync "show: any expression" <|
+ checkAllInMarkedRange server
+ """
+ let f (alpha, beta, gamma) = ()
+ let alpha = 1
+ let beta = 2
+ let gamma = 2
+
+ $|f ($0string alpha, $0beta.ToString(), $0gamma |> string)$|
+ """
+ [ paramHint "alpha"; paramHint "beta"; paramHint "gamma" ]
+
+ testCaseAsync "hide: unary operator" <|
+ checkAllInMarkedRange server
+ """
+ let (~+.) listWithNumbers = List.map ((+) 1) listWithNumbers
+ let data = [1..5]
+
+ $|+. data$|
+ """
+ []
+ testCaseAsync "hide: binary operator" <|
+ checkAllInMarkedRange server
+ """
+ let (+.) listWithNumbers numberToAdd = List.map ((+) numberToAdd) listWithNumbers
+ let data = [1..5]
+
+ $|data +. 5$|
+ """
+ []
+
+ testCaseAsync "hide: func name ends with param name" <|
+ checkAllInMarkedRange server
+ """
+ let validateRange range = ()
+ let data = 42
+
+ $|validateRange data$|
+ """
+ []
+
+ testList "special names" [
+ testList "mapping" [
+ testCaseAsync "hide: for List" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.map id$|
+ """
+ []
+ testCaseAsync "hide: for Array" <|
+ checkAllInMarkedRange server
+ """
+ $|[|1..3|] |> Array.map id$|
+ """
+ []
+ testCaseAsync "show: for custom function" <|
+ checkAllInMarkedRange server
+ """
+ let doStuff mapping = ()
+ $|doStuff $042$|
+ """
+ [ paramHint "mapping" ]
+ ]
+ testList "in collections" [
+ testCaseAsync "hide: predicate" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.filter ((<) 2)$|
+ """
+ []
+ testCaseAsync "hide: chooser" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.tryPick Some$|
+ """
+ []
+ testCaseAsync "hide: value" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.contains 2$|
+ """
+ []
+ testCaseAsync "hide: projection" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.sumBy id$|
+ """
+ []
+ testCaseAsync "hide: action" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.iter (printfn "%i")$|
+ """
+ []
+ testCaseAsync "hide: folder & state" <|
+ checkAllInMarkedRange server
+ """
+ $|[1..3] |> List.fold (+) 0$|
+ """
+ []
+
+
+ testCaseAsync "hide: list" <|
+ checkAllInMarkedRange server
+ """
+ $|List.tryLast [1..3]$|
+ """
+ []
+ testCaseAsync "hide: array" <|
+ checkAllInMarkedRange server
+ """
+ $|Array.tryLast [|1..3|]$|
+ """
+ []
+ testCaseAsync "hide: source" <|
+ checkAllInMarkedRange server
+ """
+ $|Seq.tryLast [1..3]$|
+ """
+ []
+ testCaseAsync "hide: lists" <|
+ checkAllInMarkedRange server
+ """
+ $|List.concat []$|
+ """
+ []
+ testCaseAsync "hide: arrays" <|
+ checkAllInMarkedRange server
+ """
+ $|Array.concat [||]$|
+ """
+ []
+ testCaseAsync "hide: sources" <|
+ checkAllInMarkedRange server
+ """
+ $|Seq.concat []$|
+ """
+ []
+ ]
+ testList "option" [
+ testCaseAsync "hide: for Option" <|
+ checkAllInMarkedRange server
+ """
+ $|Option.count (Some 3)$|
+ """
+ []
+ testCaseAsync "show: for custom function" <|
+ checkAllInMarkedRange server
+ """
+ let doStuff option = ()
+ $|doStuff $042$|
+ """
+ [ paramHint "option" ]
+ ]
+ testList "voption" [
+ testCaseAsync "hide: for ValueOption" <|
+ checkAllInMarkedRange server
+ """
+ $|ValueOption.count (ValueSome 3)$|
+ """
+ []
+ testCaseAsync "show: for custom function" <|
+ checkAllInMarkedRange server
+ """
+ let doStuff voption = ()
+ $|doStuff $042$|
+ """
+ [ paramHint "voption" ]
+ ]
+ testList "format" [
+ testCaseAsync "hide: in printfn" <|
+ checkAllInMarkedRange server
+ """
+ $|printfn "foo"$|
+ """
+ []
+ testCaseAsync "hide: in sprintf" <|
+ checkAllInMarkedRange server
+ """
+ $|sprintf "foo"$|
+ """
+ []
+ testCaseAsync "hide: in Core.Printf" <|
+ // "normal" printf is in `Microsoft.FSharp.Core.ExtraTopLevelOperators`
+ checkAllInMarkedRange server
+ """
+ $|Microsoft.FSharp.Core.Printf.printfn "foo"$|
+ """
+ []
+ testCaseAsync "show: for custom function" <|
+ checkAllInMarkedRange server
+ """
+ let doStuff format = ()
+ $|doStuff $042$|
+ """
+ [ paramHint "format" ]
+ ]
+ ]
+
+ ptestList "ionide/ionide-vscode-fsharp#1714" [
+ testCaseAsync "can show param hint for tuple param without individual names" <|
+ checkAllInMarkedRange server
+ """
+ let f tupleParam = ()
+ $|f $0(1,2)$|
+ """
+ [
+ paramHint "tupleParam"
+ ]
+ testCaseAsync "can show param hint for tuple-var param without individual names" <|
+ checkAllInMarkedRange server
+ """
+ let f tupleParam = ()
+ let myTuple = (1,2)
+ $|f $0myTuple$|
+ """
+ [
+ paramHint "tupleParam"
+ ]
+ testCaseAsync "can show param hints for tuple param with individual names" <|
+ checkAllInMarkedRange server
+ """
+ let f (alpha, beta) = ()
+ $|f ($01, $02)$|
+ """
+ [
+ paramHint "alpha"
+ paramHint "beta"
+ ]
+ testCaseAsync "can show param hint for tuple-var param with individual names" <|
+ checkAllInMarkedRange server
+ """
+ let f (alpha, beta) = ()
+ let myTuple = (1,2)
+ $|f $0myTuple$|
+ """
+ [
+ paramHint "(alpha,beta)" //TODO: ?
+ ]
+ ]
+ ptestCaseAsync "doesn't show param for func with args pipe in" <|
+ // currently: shows param hint ... in front of `f`
+ checkAllInMarkedRange server
+ """
+ let f tupleParam = ()
+ $|f <| 2$|
+ """
+ []
+ ptestCaseAsync "can show param for method" <|
+ checkAllInMarkedRange server
+ """
+ $|System.Environment.GetEnvironmentVariable "Blah"
+ |> ignore$|
+ """
+ [
+ paramHint "variable"
+ ]
])
let private typeHintTests state =
serverTestList "type hints" state defaultConfigDto None (fun server -> [
@@ -709,6 +795,74 @@ let private typeHintTests state =
let f (beta: int) = beta + 1
"""
]
+ testCaseAsync "can show all type hints" <|
+ checkAllInMarkedRange server
+ """
+ let fromString (v: string) = int v
+ let fromFloat (v: float) = int v
+ $|let f alpha$0 beta$0 gamma$0 $|= (fromFloat alpha) + beta + (fromString gamma) + 1
+ """
+ [
+ typeHint "float"
+ """
+ let fromString (v: string) = int v
+ let fromFloat (v: float) = int v
+ let f (alpha: float) beta gamma = (fromFloat alpha) + beta + (fromString gamma) + 1
+ """
+ typeHint "int"
+ """
+ let fromString (v: string) = int v
+ let fromFloat (v: float) = int v
+ let f alpha (beta: int) gamma = (fromFloat alpha) + beta + (fromString gamma) + 1
+ """
+ typeHint "string"
+ """
+ let fromString (v: string) = int v
+ let fromFloat (v: float) = int v
+ let f alpha beta (gamma: string) = (fromFloat alpha) + beta + (fromString gamma) + 1
+ """
+ ]
+ testCaseAsync "let-bound function parameter type hints" <|
+ checkAllInMarkedRange server
+ """
+ $|let tryFindFile p$0 = p + "hi"$|
+ """
+ [
+ typeHint "string"
+ """
+ let tryFindFile (p: string) = p + "hi"
+ """
+ ]
+ testCaseAsync "value let binding type hint" <|
+ checkAllInMarkedRange server
+ """
+ $|let s$0 = "hi"$|
+ """
+ [
+ typeHint "string"
+ """
+ let s: string = "hi"
+ """
+ ]
+ testCaseAsync "no type hint for an explicitly-typed binding" <|
+ checkAllInMarkedRange server
+ """
+ $|let s: string = "hi"$|
+ """
+ []
+ testCaseAsync "long type hint gets truncated" <|
+ checkAllInMarkedRange server
+ """
+ $|let t$0 = Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some ()))))))))))))))$|
+ """
+ [
+ truncated <| typeHint "unit option option option option option option option option option option option option option option option"
+ """
+ let t: unit option option option option option option option option option option option option option option option = Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some (Some ()))))))))))))))
+ """
+ ]
+
+
testCaseAsync "can show type for generic actual type" <|
checkAllInMarkedRange server
"""
@@ -814,7 +968,7 @@ let private inlayHintTests state =
let tests state =
testList (nameof InlayHint) [
- fsharpInlayHintsTests state
+ FSharpInlayHints.tests state
inlayHintTests state
]
diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs
index 78c8d9874..0ccee9186 100644
--- a/test/FsAutoComplete.Tests.Lsp/Program.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Program.fs
@@ -97,6 +97,7 @@ let tests = testList "FSAC" [
Utils.Tests.Utils.tests
Utils.Tests.TextEdit.tests
]
+ InlayHintTests.explicitTypeInfoTests
lspTests
]
From 2310440be069c6180a29c185ecc4b73aa5b27a2b Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 27 May 2022 18:23:10 +0200
Subject: [PATCH 16/29] Disable Resolve for InlayHint (for now)
---
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 4869934fa..a8c50de56 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -996,7 +996,8 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
{ Legend =
createTokenLegend
Range = Some(U2.First true)
- Full = Some(U2.First true) } } }
+ Full = Some(U2.First true) }
+ InlayHintProvider = Some { ResolveProvider = Some false } } }
|> success
}
From 202443535e27e5fc199b2b49b14e0a4ee35a67eb Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sat, 28 May 2022 19:45:38 +0200
Subject: [PATCH 17/29] Add ref to corresponding issue
---
test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs | 1 +
1 file changed, 1 insertion(+)
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index 10412f56a..b6d583230 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -879,6 +879,7 @@ let private typeHintTests state =
"""
]
ptestCaseAsync "can show type hint for nested inside generic actual type" <|
+ // see dotnet/fsharp#13202
checkAllInMarkedRange server
"""
open System.Collections.Immutable
From 08bfc891271f585784e68c2bea59ab8db07b2cbd Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Wed, 15 Jun 2022 20:49:28 +0200
Subject: [PATCH 18/29] `ServiceParseTreeWalk` is now required solely for
`SynMatchClause`s
-> should be easier to adopt new version once available
---
src/FsAutoComplete.Core/InlayHints.fs | 86 +-
.../Workaround/ServiceParseTreeWalk.fs | 1931 +++++++++--------
.../InlayHintTests.fs | 3 +-
3 files changed, 1016 insertions(+), 1004 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 14ca65d40..11b7ded5b 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -13,6 +13,45 @@ open FSharp.Compiler.CodeAnalysis
open FSharp.Compiler.Text.Range
open FsAutoComplete.Core.Workaround.ServiceParseTreeWalk
+/// `traversePat`from `SyntaxTraversal.Traverse`
+///
+/// Reason for extra function:
+/// * can be used to traverse when traversal isn't available via `defaultTraverse` (for example: in `VisitExpr`, and want traverse a `SynPat`)
+/// * visits `SynPat.Record(fieldPats)`
+///
+/// Note: doesn't visit `SynPat.Typed(targetType)`: requires traversal into `SynType` (`SynPat.Typed(pat)` gets visited!)
+let rec private traversePat (visitor: SyntaxVisitorBase<_>) origPath pat =
+ let defaultTraverse = defaultTraversePat visitor origPath
+ visitor.VisitPat(origPath, defaultTraverse, pat)
+and private defaultTraversePat visitor origPath pat =
+ let path = SyntaxNode.SynPat pat :: origPath
+
+ match pat with
+ | SynPat.Paren (p, _) -> traversePat visitor path p
+ | SynPat.As (p1, p2, _)
+ | SynPat.Or (p1, p2, _, _) ->
+ [ p1; p2 ]
+ |> List.tryPick (traversePat visitor path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat visitor path)
+ | SynPat.Attrib (p, _, _) -> traversePat visitor path p
+ | SynPat.LongIdent (argPats = args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat visitor path)
+ | SynArgPats.NamePatPairs (ps, _) ->
+ ps
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat visitor path)
+ | SynPat.Typed (p, _ty, _) ->
+ traversePat visitor path p
+ // no access to `traverseSynType` -> no traversing into `ty`
+ | SynPat.Record (fieldPats = fieldPats) ->
+ fieldPats
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat visitor path)
+ | _ -> None
+
type HintKind =
| Parameter
| Type
@@ -79,10 +118,10 @@ type private FSharp.Compiler.CodeAnalysis.FSharpParseFileResults with
pats |> List.tryPick exprFunc
- override _.VisitPat(_path, defaultTraverse, pat) =
+ override visitor.VisitPat(path, defaultTraverse, pat) =
match pat with
| SynPat.Typed (_pat, _targetType, range) when Position.posEq range.Start pos -> Some range
- | _ -> defaultTraverse pat
+ | _ -> defaultTraversePat visitor path pat
override _.VisitBinding(_path, defaultTraverse, binding) =
match binding with
@@ -550,45 +589,6 @@ let rec private getParensForIdentPat (text: NamedText) (pat: SynPat) (path: Synt
getParsenForPatternWithIdent patternRange identStart path
| _ -> failwith "Pattern must be Named or OptionalVal!"
-/// `traversePat`from `SyntaxTraversal.Traverse`
-///
-/// Reason for extra function:
-/// * can be used to traverse when traversal isn't available via `defaultTraverse` (for example: in `VisitExpr`, and want traverse a `SynPat`)
-/// * visits `SynPat.As(lhsPat, rhsPat)` & `SynPat.Record(fieldPats)`
-///
-/// Note: doesn't visit `SynPat.Typed(targetType)`: requires traversal into `SynType` (`SynPat.Typed(pat)` gets visited!)
-let rec private traversePat (visitor: SyntaxVisitorBase<_>) origPath pat =
- let defaultTraverse p =
- let path = SyntaxNode.SynPat p :: origPath
-
- match p with
- | SynPat.Paren (p, _) -> traversePat visitor path p
- | SynPat.Or (p1, p2, _, _) ->
- [ p1; p2 ]
- |> List.tryPick (traversePat visitor path)
- | SynPat.Ands (ps, _)
- | SynPat.Tuple (_, ps, _)
- | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat visitor path)
- | SynPat.Attrib (p, _, _) -> traversePat visitor path p
- | SynPat.LongIdent (argPats = args) ->
- match args with
- | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat visitor path)
- | SynArgPats.NamePatPairs (ps, _) ->
- ps
- |> List.map (fun (_, _, pat) -> pat)
- |> List.tryPick (traversePat visitor path)
- | SynPat.Typed (p, _, _) -> traversePat visitor path p
- | SynPat.As (lhsPat = lhs; rhsPat = rhs) ->
- [ lhs; rhs ]
- |> List.tryPick (traversePat visitor path)
- | SynPat.Record (fieldPats = fieldPats) ->
- fieldPats
- |> List.map (fun (_, _, pat) -> pat)
- |> List.tryPick (traversePat visitor path)
- | _ -> None
-
- visitor.VisitPat(origPath, defaultTraverse, pat)
-
let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) : ExplicitType option =
SyntaxTraversal.Traverse(
pos,
@@ -628,7 +628,7 @@ let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) :
None
| _ -> defaultTraverse expr
- member _.VisitPat(path, defaultTraverse, pat) =
+ member visitor.VisitPat(path, defaultTraverse, pat) =
let invalidPositionForTypeAnnotation (pos: Position) (path: SyntaxNode list) =
match path with
| SyntaxNode.SynExpr (SynExpr.LetOrUseBang(isUse = true)) :: _ ->
@@ -684,7 +684,7 @@ let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) :
// `?v: int`, NOT `?v: int option`
}
|> Some
- | _ -> defaultTraverse pat //todo: custom traverse? -> doesn't require FCS to handle `SynPat.Record`
+ | _ -> defaultTraversePat visitor path pat
member _.VisitSimplePats(path, pats) =
// SynSimplePats at:
diff --git a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
index da594eebe..09f90086b 100644
--- a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
+++ b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
@@ -1,24 +1,43 @@
+// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
+
+//----------------------------------------------------------------------------
+// Open up the compiler as an incremental service for parsing,
+// type checking and intellisense-like environment-reporting.
+//--------------------------------------------------------------------------
+
/// Current (and older) FCS Visitors don't walk into into `SynMatchClause`s in `SynExpr.Match` (at least not into their patterns)
/// -> Cannot walk to `SynPat.Named` inside Match Case
///
/// That's fixed in `main` FCS
-/// -> This here is a copy of [`ServiceParseTreeWalk.fs`@`3a610e0`](https://github.com/dotnet/fsharp/blob/3a610e06d07f47f405168be5ea05495d48fcec6d/src/fsharp/service/ServiceParseTreeWalk.fs) with slight adjustments so it compiles
+/// -> This here is a copy of [`ServiceParseTreeWalk.fs`@`0155fd5`](https://github.com/dotnet/fsharp/blob/a65ace7698c159c34bd00f6408c7d4beb89b687d/src/Compiler/Service/ServiceParseTreeWalk.fs) with slight adjustments so it compiles
///
/// **Remove once it's available as nuget package and updated here in FSAC**
-///
-/// Additional: `traversePat.defaultTraverse` walks down `SynPat.As` & `SynPat.Record` (see dotnet/fsharp#13114)
module internal FsAutoComplete.Core.Workaround.ServiceParseTreeWalk
-//TODO: Use FSC once newer nuget package is available
+//TOOD: Use new FCS one available
open FSharp.Compiler.Syntax
open FSharp.Compiler.Text
open FSharp.Compiler.Text.Position
open FSharp.Compiler.Text.Range
-
+// Adjustments to compile with older FCS version
+type SynLongIdent = LongIdentWithDots
+let SynLongIdent (id, r, _) = LongIdentWithDots (id, r)
+type LongIdentWithDots with
+ member lid.LongIdent = lid.Lid
+
type private Range with
member m.ToShortString() =
sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn
+let unionBindingAndMembers (bindings: SynBinding list) (members: SynMemberDefn list) : SynBinding list =
+ [ yield! bindings
+ yield!
+ List.choose
+ (function
+ | SynMemberDefn.Member (b, _) -> Some b
+ | _ -> None)
+ members
+ ]
let rec private stripParenTypes synType =
match synType with
@@ -27,992 +46,986 @@ let rec private stripParenTypes synType =
let private (|StripParenTypes|) synType = stripParenTypes synType
+
+// copied ServiceParseTreeWalk
+
+// /// used to track route during traversal AST
+// []
+// type SyntaxNode =
+// | SynPat of SynPat
+// | SynType of SynType
+// | SynExpr of SynExpr
+// | SynModule of SynModuleDecl
+// | SynModuleOrNamespace of SynModuleOrNamespace
+// | SynTypeDefn of SynTypeDefn
+// | SynMemberDefn of SynMemberDefn
+// | SynMatchClause of SynMatchClause
+// | SynBinding of SynBinding
+
+// type SyntaxVisitorPath = SyntaxNode list
+
[]
type SyntaxVisitorBase<'T>() =
- abstract VisitExpr:
- path: SyntaxVisitorPath *
- traverseSynExpr: (SynExpr -> 'T option) *
- defaultTraverse: (SynExpr -> 'T option) *
- synExpr: SynExpr ->
- 'T option
-
- default _.VisitExpr
- (
- path: SyntaxVisitorPath,
- traverseSynExpr: SynExpr -> 'T option,
- defaultTraverse: SynExpr -> 'T option,
- synExpr: SynExpr
- ) =
- ignore (path, traverseSynExpr, defaultTraverse, synExpr)
- None
-
- /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
- abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
-
- default _.VisitTypeAbbrev(path, synType, range) =
- ignore (path, synType, range)
- None
-
- /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
- abstract VisitImplicitInherit:
- path: SyntaxVisitorPath *
- defaultTraverse: (SynExpr -> 'T option) *
- inheritedType: SynType *
- synArgs: SynExpr *
- range: range ->
- 'T option
-
- default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
- ignore (path, inheritedType, range)
- defaultTraverse synArgs
-
- /// VisitModuleDecl allows overriding module declaration behavior
- abstract VisitModuleDecl:
- path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
-
- default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
- ignore path
- defaultTraverse synModuleDecl
-
- /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
- abstract VisitBinding:
- path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
-
- default _.VisitBinding(path, defaultTraverse, synBinding) =
- ignore path
- defaultTraverse synBinding
-
- /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
- abstract VisitMatchClause:
- path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
-
- default _.VisitMatchClause(path, defaultTraverse, matchClause) =
- ignore path
- defaultTraverse matchClause
-
- /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
- abstract VisitInheritSynMemberDefn:
- path: SyntaxVisitorPath *
- componentInfo: SynComponentInfo *
- typeDefnKind: SynTypeDefnKind *
- SynType *
- SynMemberDefns *
- range ->
- 'T option
-
- default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
- ignore (path, componentInfo, typeDefnKind, synType, members, range)
- None
-
- /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
- abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
-
- default _.VisitRecordDefn(path, fields, range) =
- ignore (path, fields, range)
- None
-
- /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
- abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
-
- default _.VisitUnionDefn(path, cases, range) =
- ignore (path, cases, range)
- None
-
- /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
- abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
-
- default _.VisitEnumDefn(path, cases, range) =
- ignore (path, cases, range)
- None
-
- /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
- abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
-
- default _.VisitInterfaceSynMemberDefnType(path, synType) =
- ignore (path, synType)
- None
-
- /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
- abstract VisitRecordField:
- path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: LongIdentWithDots option -> 'T option
-
- default _.VisitRecordField(path, copyOpt, recordField) =
- ignore (path, copyOpt, recordField)
- None
-
- /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
- abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
-
- default _.VisitHashDirective(path, hashDirective, range) =
- ignore (path, hashDirective, range)
- None
-
- /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
- abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
-
- default _.VisitModuleOrNamespace(path, synModuleOrNamespace) =
- ignore (path, synModuleOrNamespace)
- None
-
- /// VisitComponentInfo allows overriding behavior when visiting type component infos
- abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
+ abstract VisitExpr:
+ path: SyntaxVisitorPath * traverseSynExpr: (SynExpr -> 'T option) * defaultTraverse: (SynExpr -> 'T option) * synExpr: SynExpr ->
+ 'T option
+
+ default _.VisitExpr
+ (
+ path: SyntaxVisitorPath,
+ traverseSynExpr: SynExpr -> 'T option,
+ defaultTraverse: SynExpr -> 'T option,
+ synExpr: SynExpr
+ ) =
+ ignore (path, traverseSynExpr, defaultTraverse, synExpr)
+ None
+
+ /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
+ abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
+
+ default _.VisitTypeAbbrev(path, synType, range) =
+ ignore (path, synType, range)
+ None
+
+ /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
+ abstract VisitImplicitInherit:
+ path: SyntaxVisitorPath * defaultTraverse: (SynExpr -> 'T option) * inheritedType: SynType * synArgs: SynExpr * range: range ->
+ 'T option
+
+ default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
+ ignore (path, inheritedType, range)
+ defaultTraverse synArgs
+
+ /// VisitModuleDecl allows overriding module declaration behavior
+ abstract VisitModuleDecl:
+ path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
+
+ default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
+ ignore path
+ defaultTraverse synModuleDecl
+
+ /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
+ abstract VisitBinding: path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
+
+ default _.VisitBinding(path, defaultTraverse, synBinding) =
+ ignore path
+ defaultTraverse synBinding
- default _.VisitComponentInfo(path, synComponentInfo) =
- ignore (path, synComponentInfo)
- None
+ /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
+ abstract VisitMatchClause:
+ path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
- /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
- abstract VisitLetOrUse:
- path: SyntaxVisitorPath *
- isRecursive: bool *
- defaultTraverse: (SynBinding -> 'T option) *
- bindings: SynBinding list *
- range: range ->
- 'T option
+ default _.VisitMatchClause(path, defaultTraverse, matchClause) =
+ ignore path
+ defaultTraverse matchClause
- default _.VisitLetOrUse(path, isRecursive, defaultTraverse, bindings, range) =
- ignore (path, isRecursive, defaultTraverse, bindings, range)
- None
+ /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
+ abstract VisitInheritSynMemberDefn:
+ path: SyntaxVisitorPath * componentInfo: SynComponentInfo * typeDefnKind: SynTypeDefnKind * SynType * SynMemberDefns * range ->
+ 'T option
- /// VisitType allows overriding behavior when visiting simple pats
- abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
+ default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
+ ignore (path, componentInfo, typeDefnKind, synType, members, range)
+ None
+
+ /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
+ abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
+
+ default _.VisitRecordDefn(path, fields, range) =
+ ignore (path, fields, range)
+ None
+
+ /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
+ abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
+
+ default _.VisitUnionDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
+ abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
+
+ default _.VisitEnumDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
+ abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
- default _.VisitSimplePats(path, synPats) =
- ignore (path, synPats)
- None
+ default _.VisitInterfaceSynMemberDefnType(path, synType) =
+ ignore (path, synType)
+ None
- /// VisitPat allows overriding behavior when visiting patterns
- abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
+ /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
+ abstract VisitRecordField: path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: SynLongIdent option -> 'T option
+
+ default _.VisitRecordField(path, copyOpt, recordField) =
+ ignore (path, copyOpt, recordField)
+ None
- default _.VisitPat(path, defaultTraverse, synPat) =
- ignore path
- defaultTraverse synPat
+ /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
+ abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
- /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
- abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
+ default _.VisitHashDirective(path, hashDirective, range) =
+ ignore (path, hashDirective, range)
+ None
+
+ /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
+ abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
+
+ default _.VisitModuleOrNamespace(path, synModuleOrNamespace) =
+ ignore (path, synModuleOrNamespace)
+ None
- default _.VisitType(path, defaultTraverse, synType) =
- ignore path
- defaultTraverse synType
+ /// VisitComponentInfo allows overriding behavior when visiting type component infos
+ abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
+
+ default _.VisitComponentInfo(path, synComponentInfo) =
+ ignore (path, synComponentInfo)
+ None
+
+ /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
+ abstract VisitLetOrUse:
+ path: SyntaxVisitorPath * isRecursive: bool * defaultTraverse: (SynBinding -> 'T option) * bindings: SynBinding list * range: range ->
+ 'T option
+
+ default _.VisitLetOrUse(path, isRecursive, defaultTraverse, bindings, range) =
+ ignore (path, isRecursive, defaultTraverse, bindings, range)
+ None
+
+ /// VisitType allows overriding behavior when visiting simple pats
+ abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
+
+ default _.VisitSimplePats(path, synPats) =
+ ignore (path, synPats)
+ None
+
+ /// VisitPat allows overriding behavior when visiting patterns
+ abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
+
+ default _.VisitPat(path, defaultTraverse, synPat) =
+ ignore path
+ defaultTraverse synPat
+
+ /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
+ abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
+
+ default _.VisitType(path, defaultTraverse, synType) =
+ ignore path
+ defaultTraverse synType
/// A range of utility functions to assist with traversing an AST
module SyntaxTraversal =
- // treat ranges as though they are half-open: [,)
- let rangeContainsPosLeftEdgeInclusive (m1: range) p =
- if posEq m1.Start m1.End then
- // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
- // we treat the range [n,n) as containing position n
- posGeq p m1.Start && posGeq m1.End p
- else
- posGeq p m1.Start
- && // [
- posGt m1.End p // )
-
- // treat ranges as though they are fully open: (,)
- let rangeContainsPosEdgesExclusive (m1: range) p = posGt p m1.Start && posGt m1.End p
-
- let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1: range) p = posGt p m1.Start && posGeq m1.End p
-
- let dive node range project = range, (fun () -> project node)
-
- let pick pos (outerRange: range) (debugObj: obj) (diveResults: list) =
- match diveResults with
- | [] -> None
- | _ ->
- let isOrdered =
+ // treat ranges as though they are half-open: [,)
+ let rangeContainsPosLeftEdgeInclusive (m1: range) p =
+ if posEq m1.Start m1.End then
+ // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
+ // we treat the range [n,n) as containing position n
+ posGeq p m1.Start && posGeq m1.End p
+ else
+ posGeq p m1.Start
+ && // [
+ posGt m1.End p // )
+
+ // treat ranges as though they are fully open: (,)
+ let rangeContainsPosEdgesExclusive (m1: range) p = posGt p m1.Start && posGt m1.End p
+
+ let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1: range) p = posGt p m1.Start && posGeq m1.End p
+
+ let dive node range project = range, (fun () -> project node)
+
+ let pick pos (outerRange: range) (debugObj: obj) (diveResults: (range * _) list) =
+ match diveResults with
+ | [] -> None
+ | _ ->
+ let isOrdered =
#if DEBUG
- // ranges in a dive-and-pick group should be ordered
- diveResults
- |> Seq.pairwise
- |> Seq.forall (fun ((r1, _), (r2, _)) -> posGeq r2.Start r1.End)
+ // ranges in a dive-and-pick group should be ordered
+ diveResults
+ |> Seq.pairwise
+ |> Seq.forall (fun ((r1, _), (r2, _)) -> posGeq r2.Start r1.End)
#else
- true
+ true
#endif
- if not isOrdered then
- let s =
- sprintf
- "ServiceParseTreeWalk: not isOrdered: %A"
- (diveResults
- |> List.map (fun (r, _) -> r.ToShortString()))
-
- ignore s
- //System.Diagnostics.Debug.Assert(false, s)
- let outerContainsInner =
-#if DEBUG
- // ranges in a dive-and-pick group should be "under" the thing that contains them
- let innerTotalRange =
- diveResults
- |> List.map fst
- |> List.reduce unionRanges
+ if not isOrdered then
+ let s =
+ sprintf "ServiceParseTreeWalk: not isOrdered: %A" (diveResults |> List.map (fun (r, _) -> r.ToShortString()))
- rangeContainsRange outerRange innerTotalRange
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let outerContainsInner =
+#if DEBUG
+ // ranges in a dive-and-pick group should be "under" the thing that contains them
+ let innerTotalRange = diveResults |> List.map fst |> List.reduce unionRanges
+ rangeContainsRange outerRange innerTotalRange
#else
- ignore (outerRange)
- true
+ ignore (outerRange)
+ true
#endif
- if not outerContainsInner then
- let s =
- sprintf
- "ServiceParseTreeWalk: not outerContainsInner: %A : %A"
- (outerRange.ToShortString())
- (diveResults
- |> List.map (fun (r, _) -> r.ToShortString()))
-
- ignore s
- //System.Diagnostics.Debug.Assert(false, s)
- let isZeroWidth (r: range) = posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
-
- match
- List.choose
- (fun (r, f) ->
- if
- rangeContainsPosLeftEdgeInclusive r pos
- && not (isZeroWidth r)
- then
- Some(f)
- else
- None)
- diveResults
- with
- | [] ->
- // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
- // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
- let mutable e = diveResults.Head
-
- for r in diveResults do
- if posGt pos (fst r).Start then e <- r
-
- snd (e) ()
- | [ x ] -> x ()
- | _ ->
+ if not outerContainsInner then
+ let s =
+ sprintf
+ "ServiceParseTreeWalk: not outerContainsInner: %A : %A"
+ (outerRange.ToShortString())
+ (diveResults |> List.map (fun (r, _) -> r.ToShortString()))
+
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let isZeroWidth (r: range) = posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
+
+ match
+ List.choose
+ (fun (r, f) ->
+ if rangeContainsPosLeftEdgeInclusive r pos && not (isZeroWidth r) then
+ Some(f)
+ else
+ None)
+ diveResults
+ with
+ | [] ->
+ // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
+ // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
+ let mutable e = diveResults.Head
+
+ for r in diveResults do
+ if posGt pos (fst r).Start then e <- r
+
+ snd (e) ()
+ | [ x ] -> x ()
+ | _ ->
#if DEBUG
- assert false
- failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
+ assert false
+ failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
#else
- ignore debugObj
- None
+ ignore debugObj
+ None
#endif
- /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
- ///
- let Traverse (pos: pos, parseTree, visitor: SyntaxVisitorBase<'T>) =
- let pick x = pick pos x
-
- let rec traverseSynModuleDecl origPath (decl: SynModuleDecl) =
- let pick = pick decl.Range
-
- let defaultTraverse m =
- let path = SyntaxNode.SynModule m :: origPath
-
- match m with
- | SynModuleDecl.ModuleAbbrev (_ident, _longIdent, _range) -> None
- | SynModuleDecl.NestedModule (decls = synModuleDecls) ->
- synModuleDecls
- |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
- |> pick decl
- | SynModuleDecl.Let (isRecursive, synBindingList, range) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | Some x -> Some x
- | None ->
- synBindingList
- |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- |> pick decl
- // | SynModuleDecl.Expr(synExpr, _range) -> traverseSynExpr path synExpr
- | SynModuleDecl.DoExpr (_, synExpr, _range) -> traverseSynExpr path synExpr
- | SynModuleDecl.Types (synTypeDefnList, _range) ->
- synTypeDefnList
- |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path))
- |> pick decl
- | SynModuleDecl.Exception (_synExceptionDefn, _range) -> None
- | SynModuleDecl.Open (_target, _range) -> None
- | SynModuleDecl.Attributes (_synAttributes, _range) -> None
- | SynModuleDecl.HashDirective (parsedHashDirective, range) ->
- visitor.VisitHashDirective(path, parsedHashDirective, range)
- | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) ->
- traverseSynModuleOrNamespace path synModuleOrNamespace
-
- visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
-
- and traverseSynModuleOrNamespace
- origPath
- (SynModuleOrNamespace (_longIdent,
- _isRec,
- _isModule,
- synModuleDecls,
- _preXmlDoc,
- _synAttributes,
- _synAccessOpt,
- range) as mors)
- =
- match visitor.VisitModuleOrNamespace(origPath, mors) with
- | Some x -> Some x
- | None ->
- let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
-
- synModuleDecls
- |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
- |> pick range mors
-
- and traverseSynExpr origPath (expr: SynExpr) =
- let pick = pick expr.Range
-
- let defaultTraverse e =
- let path = SyntaxNode.SynExpr e :: origPath
- let traverseSynExpr = traverseSynExpr path
- let traverseSynType = traverseSynType path
- let traversePat = traversePat path
-
- match e with
-
- | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
-
- | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
- [ //dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.Const (_synConst, _range) -> None
-
- | SynExpr.InterpolatedString (parts, _, _) ->
- [ for part in parts do
- match part with
- | SynInterpolatedStringPart.String _ -> ()
- | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield dive fillExpr fillExpr.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.Typed (synExpr, synType, _range) ->
- match traverseSynExpr synExpr with
- | None -> traverseSynType synType
- | x -> x
-
- | SynExpr.Tuple (_, synExprList, _, _range)
- | SynExpr.ArrayOrList (_, synExprList, _range) ->
- synExprList
- |> List.map (fun x -> dive x x.Range traverseSynExpr)
- |> pick expr
-
- | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
- [ match copyOpt with
- | Some (expr, (withRange, _)) ->
- yield dive expr expr.Range traverseSynExpr
-
- yield
- dive () withRange (fun () ->
- if posGeq pos withRange.End then
- // special case: caret is after WITH
- // { x with $ }
- visitor.VisitRecordField(path, Some expr, None)
- else
- None)
- | _ -> ()
- for _, _, x in synExprList do
- yield dive x x.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.Record (inheritOpt, copyOpt, fields, _range) ->
- [ let diveIntoSeparator offsideColumn scPosOpt copyOpt =
- match scPosOpt with
- | Some scPos ->
- if posGeq pos scPos then
- visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
- else
- None
- | None ->
- //semicolon position is not available - use offside rule
- if pos.Column = offsideColumn then
- visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
- else
- None
-
- match inheritOpt with
- | Some (_ty, expr, _range, sepOpt, inheritRange) ->
- // dive into argument
- yield
- dive expr expr.Range (fun expr ->
- // special-case:caret is located in the offside position below inherit
- // inherit A()
- // $
- if not (rangeContainsPos expr.Range pos)
- && sepOpt.IsNone
- && pos.Column = inheritRange.StartColumn then
- visitor.VisitRecordField(path, None, None)
- else
- traverseSynExpr expr)
-
- match sepOpt with
- | Some (sep, scPosOpt) ->
- yield
- dive () sep (fun () ->
- // special case: caret is below 'inherit' + one or more fields are already defined
- // inherit A()
- // $
- // field1 = 5
- diveIntoSeparator inheritRange.StartColumn scPosOpt None)
- | None -> ()
- | _ -> ()
-
- match copyOpt with
- | Some (expr, (withRange, _)) ->
- yield dive expr expr.Range traverseSynExpr
-
- yield
- dive () withRange (fun () ->
- if posGeq pos withRange.End then
- // special case: caret is after WITH
- // { x with $ }
- visitor.VisitRecordField(path, Some expr, None)
- else
- None)
- | _ -> ()
-
- let copyOpt = Option.map fst copyOpt
-
- for SynExprRecordField (fieldName = (field, _); expr = e; blockSeparator = sepOpt) in fields do
- yield
- dive (path, copyOpt, Some field) field.Range (fun r ->
- if rangeContainsPos field.Range pos then
- visitor.VisitRecordField r
- else
- None)
-
- let offsideColumn =
- match inheritOpt with
- | Some (_, _, _, _, inheritRange) -> inheritRange.StartColumn
- | None -> field.Range.StartColumn
-
- match e with
- | Some e ->
- yield
- dive e e.Range (fun expr ->
- // special case: caret is below field binding
- // field x = 5
- // $
- if not (rangeContainsPos e.Range pos)
- && sepOpt.IsNone
- && pos.Column = offsideColumn then
- visitor.VisitRecordField(path, copyOpt, None)
+ /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
+ ///
+ let Traverse (pos: pos, parseTree, visitor: SyntaxVisitorBase<'T>) =
+ let pick x = pick pos x
+
+ let rec traverseSynModuleDecl origPath (decl: SynModuleDecl) =
+ let pick = pick decl.Range
+
+ let defaultTraverse m =
+ let path = SyntaxNode.SynModule m :: origPath
+
+ match m with
+ | SynModuleDecl.ModuleAbbrev (_ident, _longIdent, _range) -> None
+ | SynModuleDecl.NestedModule (decls = synModuleDecls) ->
+ synModuleDecls
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
+ |> pick decl
+ | SynModuleDecl.Let (isRecursive, synBindingList, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None ->
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ |> pick decl
+ | SynModuleDecl.Expr (synExpr, _range) -> traverseSynExpr path synExpr
+ | SynModuleDecl.Types (synTypeDefnList, _range) ->
+ synTypeDefnList
+ |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path))
+ |> pick decl
+ | SynModuleDecl.Exception (_synExceptionDefn, _range) -> None
+ | SynModuleDecl.Open (_target, _range) -> None
+ | SynModuleDecl.Attributes (_synAttributes, _range) -> None
+ | SynModuleDecl.HashDirective (parsedHashDirective, range) -> visitor.VisitHashDirective(path, parsedHashDirective, range)
+ | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace
+
+ visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
+
+ and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace (decls = synModuleDecls; range = range) as mors) =
+ match visitor.VisitModuleOrNamespace(origPath, mors) with
+ | Some x -> Some x
+ | None ->
+ let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
+
+ synModuleDecls
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
+ |> pick range mors
+
+ and traverseSynExpr origPath (expr: SynExpr) =
+ let pick = pick expr.Range
+
+ let defaultTraverse e =
+ let path = SyntaxNode.SynExpr e :: origPath
+ let traverseSynExpr = traverseSynExpr path
+ let traverseSynType = traverseSynType path
+ let traversePat = traversePat path
+
+ match e with
+
+ | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
+
+ | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
+ [ //dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.Const (_synConst, _range) -> None
+
+ | SynExpr.InterpolatedString (parts, _, _) ->
+ [
+ for part in parts do
+ match part with
+ | SynInterpolatedStringPart.String _ -> ()
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield dive fillExpr fillExpr.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.Typed (synExpr, synType, _range) ->
+ match traverseSynExpr synExpr with
+ | None -> traverseSynType synType
+ | x -> x
+
+ | SynExpr.Tuple (_, synExprList, _, _range)
+ | SynExpr.ArrayOrList (_, synExprList, _range) ->
+ synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr
+
+ | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
+ [
+ match copyOpt with
+ | Some (expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+
+ yield
+ dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField(path, Some expr, None)
+ else
+ None)
+ | _ -> ()
+ for _, _, x in synExprList do
+ yield dive x x.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.Record (inheritOpt, copyOpt, fields, _range) ->
+ [
+ let diveIntoSeparator offsideColumn scPosOpt copyOpt =
+ match scPosOpt with
+ | Some scPos ->
+ if posGeq pos scPos then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else
+ None
+ | None ->
+ //semicolon position is not available - use offside rule
+ if pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else
+ None
+
+ match inheritOpt with
+ | Some (_ty, expr, _range, sepOpt, inheritRange) ->
+ // dive into argument
+ yield
+ dive expr expr.Range (fun expr ->
+ // special-case:caret is located in the offside position below inherit
+ // inherit A()
+ // $
+ if not (rangeContainsPos expr.Range pos)
+ && sepOpt.IsNone
+ && pos.Column = inheritRange.StartColumn then
+ visitor.VisitRecordField(path, None, None)
+ else
+ traverseSynExpr expr)
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield
+ dive () sep (fun () ->
+ // special case: caret is below 'inherit' + one or more fields are already defined
+ // inherit A()
+ // $
+ // field1 = 5
+ diveIntoSeparator inheritRange.StartColumn scPosOpt None)
+ | None -> ()
+ | _ -> ()
+
+ match copyOpt with
+ | Some (expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+
+ yield
+ dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField(path, Some expr, None)
+ else
+ None)
+ | _ -> ()
+
+ let copyOpt = Option.map fst copyOpt
+
+ for SynExprRecordField (fieldName = (field, _); expr = e; blockSeparator = sepOpt) in fields do
+ yield
+ dive (path, copyOpt, Some field) field.Range (fun r ->
+ if rangeContainsPos field.Range pos then
+ visitor.VisitRecordField r
+ else
+ None)
+
+ let offsideColumn =
+ match inheritOpt with
+ | Some (_, _, _, _, inheritRange) -> inheritRange.StartColumn
+ | None -> field.Range.StartColumn
+
+ match e with
+ | Some e ->
+ yield
+ dive e e.Range (fun expr ->
+ // special case: caret is below field binding
+ // field x = 5
+ // $
+ if not (rangeContainsPos e.Range pos)
+ && sepOpt.IsNone
+ && pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None)
+ else
+ traverseSynExpr expr)
+ | None -> ()
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield
+ dive () sep (fun () ->
+ // special case: caret is between field bindings
+ // field1 = 5
+ // $
+ // field2 = 5
+ diveIntoSeparator offsideColumn scPosOpt copyOpt)
+ | _ -> ()
+
+ ]
+ |> pick expr
+
+ | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
+ | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) ->
+ let binds = unionBindingAndMembers binds ms
+
+ let result =
+ ifaces
+ |> Seq.map (fun (SynInterfaceImpl (interfaceTy = ty)) -> ty)
+ |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
+
+ if result.IsSome then
+ result
else
- traverseSynExpr expr)
- | None -> ()
-
- match sepOpt with
- | Some (sep, scPosOpt) ->
- yield
- dive () sep (fun () ->
- // special case: caret is between field bindings
- // field1 = 5
- // $
- // field2 = 5
- diveIntoSeparator offsideColumn scPosOpt copyOpt)
- | _ -> ()
-
- ]
- |> pick expr
-
- | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
- | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) ->
- let unionBindingAndMembers (bindings: SynBinding list) (members: SynMemberDefn list) : SynBinding list =
- [ yield! bindings
- yield!
- List.choose
- (function
- | SynMemberDefn.Member (b, _) -> Some b
- | _ -> None)
- members ]
-
- let binds = unionBindingAndMembers binds ms
-
- let result =
- ifaces
- |> Seq.map (fun (SynInterfaceImpl (interfaceTy = ty)) -> ty)
- |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
-
- if result.IsSome then
- result
- else
- [ match baseCallOpt with
- | Some (expr, _) ->
- // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
- let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range)
- yield dive newCall newCall.Range traverseSynExpr
- | _ -> ()
- for b in binds do
- yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
- for SynInterfaceImpl (bindings = binds) in ifaces do
- for b in binds do
- yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) ]
- |> pick expr
-
- | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.For (identBody = synExpr; toBody = synExpr2; doBody = synExpr3) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr3 synExpr3.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
- [ dive synPat synPat.Range traversePat
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.ComputationExpr (_, synExpr, _range) ->
- // now parser treats this syntactic expression as computation expression
- // { identifier }
- // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
- // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
- let isPartOfArrayOrList =
- match origPath with
- | SyntaxNode.SynExpr (SynExpr.ArrayOrListComputed _) :: _ -> true
- | _ -> false
-
- let ok =
- match isPartOfArrayOrList, synExpr with
- | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some(LongIdentWithDots([ ident ], [])))
- | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
- | _ -> None
-
- if ok.IsSome then
- ok
- else
- traverseSynExpr synExpr
-
- | SynExpr.Lambda (args = synSimplePats; body = synExpr) ->
- match synSimplePats with
- | SynSimplePats.SimplePats (pats, _) ->
- match visitor.VisitSimplePats(path, pats) with
- | None -> traverseSynExpr synExpr
- | x -> x
- | _ -> traverseSynExpr synExpr
-
- | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) ->
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
- |> pick expr
-
- | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) ->
- [ yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
- |> pick expr
-
- | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
-
- | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
- if isInfix then
- [ dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr synExpr.Range traverseSynExpr ] // reverse the args
- |> pick expr
- else
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | None ->
- [ yield!
- synBindingList
- |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- yield dive synExpr synExpr.Range traverseSynExpr ]
- |> pick expr
- | x -> x
-
- | SynExpr.TryWith (tryExpr = synExpr; withCases = synMatchClauseList) ->
- [ yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
- |> pick expr
-
- | SynExpr.TryFinally (tryExpr = synExpr; finallyExpr = synExpr2) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
-
- | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.IfThenElse (ifExpr = synExpr; thenExpr = synExpr2; elseExpr = synExprOpt) ->
- [ yield dive synExpr synExpr.Range traverseSynExpr
- yield dive synExpr2 synExpr2.Range traverseSynExpr
- match synExprOpt with
- | None -> ()
- | Some x -> yield dive x x.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.Ident _ident -> None
-
- | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
-
- | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Set (synExpr, synExpr2, _)
-
- | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
- [ match expr1 with
- | Some e -> dive e e.Range traverseSynExpr
- | None -> ()
- match expr2 with
- | Some e -> dive e e.Range traverseSynExpr
- | None -> () ]
- |> pick expr
-
- | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e
-
- | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
- [ yield dive synExpr synExpr.Range traverseSynExpr
- yield dive indexArgs indexArgs.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
- [ yield dive synExpr synExpr.Range traverseSynExpr
- yield dive indexArgs indexArgs.Range traverseSynExpr
- yield dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
- [ dive synExpr1 synExpr1.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr3 synExpr3.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.TypeTest (synExpr, synType, _range)
-
- | SynExpr.Upcast (synExpr, synType, _range)
-
- | SynExpr.Downcast (synExpr, synType, _range) ->
- [ dive synExpr synExpr.Range traverseSynExpr
- dive synType synType.Range traverseSynType ]
- |> pick expr
-
- | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Null _range -> None
-
- | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
-
- | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.ImplicitZero _range -> None
-
- | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LetOrUseBang (pat = synPat; rhs = synExpr; andBangs = andBangSynExprs; body = synExpr2) ->
- [ yield dive synPat synPat.Range traversePat
- yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- [ for SynExprAndBang (pat = andBangSynPat; body = andBangSynExpr) in andBangSynExprs do
- yield (dive andBangSynPat andBangSynPat.Range traversePat)
- yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr) ]
- yield dive synExpr2 synExpr2.Range traverseSynExpr ]
- |> pick expr
-
- | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
- [ yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
- |> pick expr
-
- | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LibraryOnlyILAssembly _ -> None
-
- | SynExpr.LibraryOnlyStaticOptimization _ -> None
-
- | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
-
- | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
-
- | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
-
- | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
-
- visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
-
- and traversePat origPath (pat: SynPat) =
- let defaultTraverse p =
- let path = SyntaxNode.SynPat p :: origPath
-
- match p with
- | SynPat.Paren (p, _) -> traversePat path p
- | SynPat.Or (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path)
- | SynPat.Ands (ps, _)
- | SynPat.Tuple (_, ps, _)
- | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
- | SynPat.Attrib (p, _, _) -> traversePat path p
- | SynPat.LongIdent (argPats = args) ->
- match args with
- | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
- | SynArgPats.NamePatPairs (ps, _) ->
- ps
- |> List.map (fun (_, _, pat) -> pat)
- |> List.tryPick (traversePat path)
- | SynPat.Typed (p, ty, _) ->
- match traversePat path p with
- | None -> traverseSynType path ty
- | x -> x
- //TODO: added
- | SynPat.As (lhsPat = lhs; rhsPat = rhs) -> [ lhs; rhs ] |> List.tryPick (traversePat path)
- //TODO: added
- | SynPat.Record (fieldPats = fieldPats) ->
- fieldPats
- |> List.map (fun (_, _, pat) -> pat)
- |> List.tryPick (traversePat path)
- | _ -> None
-
- visitor.VisitPat(origPath, defaultTraverse, pat)
-
- and traverseSynType origPath (StripParenTypes ty) =
- let defaultTraverse ty =
- let path = SyntaxNode.SynType ty :: origPath
-
- match ty with
- | SynType.App (typeName, _, typeArgs, _, _, _, _)
- | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
- [ yield typeName; yield! typeArgs ]
- |> List.tryPick (traverseSynType path)
- | SynType.Fun (ty1, ty2, _) ->
- [ ty1; ty2 ]
- |> List.tryPick (traverseSynType path)
- | SynType.MeasurePower (ty, _, _)
- | SynType.HashConstraint (ty, _)
- | SynType.WithGlobalConstraints (ty, _, _)
- | SynType.Array (_, ty, _) -> traverseSynType path ty
- | SynType.StaticConstantNamed (ty1, ty2, _)
- | SynType.MeasureDivide (ty1, ty2, _) ->
- [ ty1; ty2 ]
- |> List.tryPick (traverseSynType path)
- | SynType.Tuple (_, tys, _) ->
- tys
- |> List.map snd
- |> List.tryPick (traverseSynType path)
- | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
- | SynType.Anon _ -> None
- | _ -> None
-
- visitor.VisitType(origPath, defaultTraverse, ty)
-
- and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters
- path
- traverseInherit
- (synMemberDefns: SynMemberDefns)
- =
- synMemberDefns
- // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
- |> Seq.groupBy (fun x -> x.Range)
- |> Seq.choose (fun (r, mems) ->
- match mems |> Seq.toList with
- | [ mem ] -> // the typical case, a single member has this range 'r'
- Some(dive mem r (traverseSynMemberDefn path traverseInherit))
- | [ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1
- extraId = Some (info1)))) as mem1
- SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2
- extraId = Some (info2)))) as mem2 ] -> // can happen if one is a getter and one is a setter
- // ensure same long id
- assert
- ((lid1.Lid, lid2.Lid)
- ||> List.forall2 (fun x y -> x.idText = y.idText))
- // ensure one is getter, other is setter
- assert
- ((info1.idText = "set" && info2.idText = "get")
- || (info2.idText = "set" && info1.idText = "get"))
-
- Some(
- r,
- (fun () ->
- // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
- match traverseSynMemberDefn path (fun _ -> None) mem1 with
- | Some _ as x -> x
- | _ -> traverseSynMemberDefn path (fun _ -> None) mem2)
- )
- | [] ->
+ [
+ match baseCallOpt with
+ | Some (expr, _) ->
+ // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
+ let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range)
+ yield dive newCall newCall.Range traverseSynExpr
+ | _ -> ()
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
+ for SynInterfaceImpl (bindings = binds) in ifaces do
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
+ ]
+ |> pick expr
+
+ | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.For (identBody = synExpr; toBody = synExpr2; doBody = synExpr3) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
+ [
+ dive synPat synPat.Range traversePat
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ComputationExpr (_, synExpr, _range) ->
+ // now parser treats this syntactic expression as computation expression
+ // { identifier }
+ // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
+ // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
+ let isPartOfArrayOrList =
+ match origPath with
+ | SyntaxNode.SynExpr (SynExpr.ArrayOrListComputed _) :: _ -> true
+ | _ -> false
+
+ let ok =
+ match isPartOfArrayOrList, synExpr with
+ | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some(SynLongIdent([ ident ], [], [ None ])))
+ | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
+ | _ -> None
+
+ if ok.IsSome then ok else traverseSynExpr synExpr
+
+ | SynExpr.Lambda (args = synSimplePats; body = synExpr) ->
+ match synSimplePats with
+ | SynSimplePats.SimplePats (pats, _) ->
+ match visitor.VisitSimplePats(path, pats) with
+ | None -> traverseSynExpr synExpr
+ | x -> x
+ | _ -> traverseSynExpr synExpr
+
+ | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) ->
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ |> pick expr
+
+ | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) ->
+ [
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ ]
+ |> pick expr
+
+ | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
+
+ // | SynExpr.Dynamic _ -> None
+
+ | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
+ if isInfix then
+ [
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr synExpr.Range traverseSynExpr
+ ] // reverse the args
+ |> pick expr
+ else
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | None ->
+ [
+ yield!
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ yield dive synExpr synExpr.Range traverseSynExpr
+ ]
+ |> pick expr
+ | x -> x
+
+ | SynExpr.TryWith (tryExpr = synExpr; withCases = synMatchClauseList) ->
+ [
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ ]
+ |> pick expr
+
+ | SynExpr.TryFinally (tryExpr = synExpr; finallyExpr = synExpr2) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
+
+ | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.IfThenElse (ifExpr = synExpr; thenExpr = synExpr2; elseExpr = synExprOpt) ->
+ [
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ match synExprOpt with
+ | None -> ()
+ | Some x -> yield dive x x.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.Ident _ident -> None
+
+ | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
+
+ | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Set (synExpr, synExpr2, _)
+
+ | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
+ [
+ match expr1 with
+ | Some e -> dive e e.Range traverseSynExpr
+ | None -> ()
+ match expr2 with
+ | Some e -> dive e e.Range traverseSynExpr
+ | None -> ()
+ ]
+ |> pick expr
+
+ | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e
+
+ | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
+ [
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
+ [
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
+ [
+ dive synExpr1 synExpr1.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.TypeTest (synExpr, synType, _range)
+
+ | SynExpr.Upcast (synExpr, synType, _range)
+
+ | SynExpr.Downcast (synExpr, synType, _range) ->
+ [
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synType synType.Range traverseSynType
+ ]
+ |> pick expr
+
+ | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Null _range -> None
+
+ | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
+
+ | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ImplicitZero _range -> None
+
+ | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUseBang (pat = synPat; rhs = synExpr; andBangs = andBangSynExprs; body = synExpr2) ->
+ [
+ yield dive synPat synPat.Range traversePat
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ [
+ for SynExprAndBang (pat = andBangSynPat; body = andBangSynExpr) in andBangSynExprs do
+ yield (dive andBangSynPat andBangSynPat.Range traversePat)
+ yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)
+ ]
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ ]
+ |> pick expr
+
+ | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
+ [
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ ]
+ |> pick expr
+
+ | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LibraryOnlyILAssembly _ -> None
+
+ | SynExpr.LibraryOnlyStaticOptimization _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
+
+ | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
+
+ | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
+
+ visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
+
+ and traversePat origPath (pat: SynPat) =
+ let defaultTraverse p =
+ let path = SyntaxNode.SynPat p :: origPath
+
+ match p with
+ | SynPat.Paren (p, _) -> traversePat path p
+ | SynPat.As (p1, p2, _)
+ | SynPat.Or (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
+ | SynPat.Attrib (p, _, _) -> traversePat path p
+ | SynPat.LongIdent (argPats = args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
+ | SynArgPats.NamePatPairs (ps, _) -> ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path)
+ | SynPat.Typed (p, ty, _) ->
+ match traversePat path p with
+ | None -> traverseSynType path ty
+ | x -> x
+ | _ -> None
+
+ visitor.VisitPat(origPath, defaultTraverse, pat)
+
+ and traverseSynType origPath (StripParenTypes ty) =
+ let defaultTraverse ty =
+ let path = SyntaxNode.SynType ty :: origPath
+
+ match ty with
+ | SynType.App (typeName, _, typeArgs, _, _, _, _)
+ | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
+ [ yield typeName; yield! typeArgs ] |> List.tryPick (traverseSynType path)
+ | SynType.Fun (ty1, ty2, _) -> [ ty1; ty2 ] |> List.tryPick (traverseSynType path)
+ | SynType.MeasurePower (ty, _, _)
+ | SynType.HashConstraint (ty, _)
+ | SynType.WithGlobalConstraints (ty, _, _)
+ | SynType.Array (_, ty, _) -> traverseSynType path ty
+ | SynType.StaticConstantNamed (ty1, ty2, _)
+ | SynType.MeasureDivide (ty1, ty2, _) -> [ ty1; ty2 ] |> List.tryPick (traverseSynType path)
+ | SynType.Tuple (_, tys, _) -> tys |> List.map snd |> List.tryPick (traverseSynType path)
+ | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
+ | SynType.Anon _ -> None
+ | _ -> None
+
+ visitor.VisitType(origPath, defaultTraverse, ty)
+
+ and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit (synMemberDefns: SynMemberDefns) =
+ synMemberDefns
+ // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
+ |> Seq.groupBy (fun x -> x.Range)
+ |> Seq.choose (fun (r, mems) ->
+ match mems |> Seq.toList with
+ | [ mem ] -> // the typical case, a single member has this range 'r'
+ Some(dive mem r (traverseSynMemberDefn path traverseInherit))
+ | [ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1; extraId = Some (info1)))) as mem1
+ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2; extraId = Some (info2)))) as mem2 ] -> // can happen if one is a getter and one is a setter
+ // ensure same long id
+ assert
+ ((lid1.LongIdent, lid2.LongIdent)
+ ||> List.forall2 (fun x y -> x.idText = y.idText))
+ // ensure one is getter, other is setter
+ assert
+ ((info1.idText = "set" && info2.idText = "get")
+ || (info2.idText = "set" && info1.idText = "get"))
+
+ Some(
+ r,
+ (fun () ->
+ // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
+ match traverseSynMemberDefn path (fun _ -> None) mem1 with
+ | Some _ as x -> x
+ | _ -> traverseSynMemberDefn path (fun _ -> None) mem2)
+ )
+ | [] ->
#if DEBUG
- assert false
- failwith "impossible, Seq.groupBy never returns empty results"
+ assert false
+ failwith "impossible, Seq.groupBy never returns empty results"
#else
- // swallow AST error and recover silently
- None
+ // swallow AST error and recover silently
+ None
#endif
- | _ ->
+ | _ ->
#if DEBUG
- assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
- failwith "bug in AST"
+ assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
+ failwith "bug in AST"
#else
- // swallow AST error and recover silently
- None
+ // swallow AST error and recover silently
+ None
#endif
- )
-
- and traverseSynTypeDefn
- origPath
- (SynTypeDefn (synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef)
- =
- let path = SyntaxNode.SynTypeDefn tydef :: origPath
-
- match visitor.VisitComponentInfo(origPath, synComponentInfo) with
- | Some x -> Some x
- | None ->
- [ match synTypeDefnRepr with
- | SynTypeDefnRepr.Exception _ ->
- // This node is generated in CheckExpressions.fs, not in the AST.
- // But note exception declarations are missing from this tree walk.
- ()
- | SynTypeDefnRepr.ObjectModel (synTypeDefnKind, synMemberDefns, _oRange) ->
- // traverse inherit function is used to capture type specific data required for processing Inherit part
- let traverseInherit (synType: SynType, range: range) =
- visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
-
- yield!
- synMemberDefns
- |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
- | SynTypeDefnRepr.Simple (synTypeDefnSimpleRepr, _range) ->
- match synTypeDefnSimpleRepr with
- | SynTypeDefnSimpleRepr.Record (_synAccessOption, fields, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
- | SynTypeDefnSimpleRepr.Union (_synAccessOption, cases, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
- | SynTypeDefnSimpleRepr.Enum (cases, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
- | SynTypeDefnSimpleRepr.TypeAbbrev (_, synType, m) ->
- yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
- | _ -> ()
- yield!
- synMemberDefns
- |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ]
- |> pick tRange tydef
-
- and traverseSynMemberDefn path traverseInherit (m: SynMemberDefn) =
- let pick (debugObj: obj) = pick m.Range debugObj
- let path = SyntaxNode.SynMemberDefn m :: path
-
- match m with
- | SynMemberDefn.Open (_longIdent, _range) -> None
- | SynMemberDefn.Member (synBinding, _range) -> traverseSynBinding path synBinding
- | SynMemberDefn.ImplicitCtor (_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
- match simplePats with
- | SynSimplePats.SimplePats (simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
- | _ -> None
- | SynMemberDefn.ImplicitInherit (synType, synExpr, _identOption, range) ->
- [ dive () synType.Range (fun () ->
- match traverseInherit (synType, range) with
- | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
- | x -> x)
- dive () synExpr.Range (fun () ->
- visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)) ]
- |> pick m
- | SynMemberDefn.AutoProperty (synExpr = synExpr) -> traverseSynExpr path synExpr
- | SynMemberDefn.LetBindings (synBindingList, isRecursive, _, range) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | Some x -> Some x
- | None ->
- synBindingList
- |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- |> pick m
- | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None
- | SynMemberDefn.Interface (interfaceType = synType; members = synMemberDefnsOption) ->
- match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
- | None ->
- match synMemberDefnsOption with
- | None -> None
- | Some (x) ->
- [ yield!
- x
- |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ]
- |> pick x
- | ok -> ok
- | SynMemberDefn.Inherit (synType, _identOption, range) -> traverseInherit (synType, range)
- | SynMemberDefn.ValField (_synField, _range) -> None
- | SynMemberDefn.NestedType (synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
-
- and traverseSynMatchClause origPath mc =
- let defaultTraverse mc =
- let path = SyntaxNode.SynMatchClause mc :: origPath
-
- match mc with
- | SynMatchClause (pat = synPat; whenExpr = synExprOption; resultExpr = synExpr) as all ->
- [ dive synPat synPat.Range (traversePat path) ]
- @ ([ match synExprOption with
- | None -> ()
- | Some guard -> yield guard
- yield synExpr ]
- |> List.map (fun x -> dive x x.Range (traverseSynExpr path)))
- |> pick all.Range all
-
- visitor.VisitMatchClause(origPath, defaultTraverse, mc)
-
- and traverseSynBinding origPath b =
- let defaultTraverse b =
- let path = SyntaxNode.SynBinding b :: origPath
-
- match b with
- | SynBinding (headPat = synPat; expr = synExpr) ->
- match traversePat path synPat with
- | None -> traverseSynExpr path synExpr
- | x -> x
-
- visitor.VisitBinding(origPath, defaultTraverse, b)
-
- match parseTree with
- | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) ->
- let fileRange =
+ )
+
+ and traverseSynTypeDefn origPath (SynTypeDefn (synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef) =
+ let path = SyntaxNode.SynTypeDefn tydef :: origPath
+
+ match visitor.VisitComponentInfo(origPath, synComponentInfo) with
+ | Some x -> Some x
+ | None ->
+ [
+ match synTypeDefnRepr with
+ | SynTypeDefnRepr.Exception _ ->
+ // This node is generated in CheckExpressions.fs, not in the AST.
+ // But note exception declarations are missing from this tree walk.
+ ()
+ | SynTypeDefnRepr.ObjectModel (synTypeDefnKind, synMemberDefns, _oRange) ->
+ // traverse inherit function is used to capture type specific data required for processing Inherit part
+ let traverseInherit (synType: SynType, range: range) =
+ visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
+
+ yield!
+ synMemberDefns
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
+ | SynTypeDefnRepr.Simple (synTypeDefnSimpleRepr, _range) ->
+ match synTypeDefnSimpleRepr with
+ | SynTypeDefnSimpleRepr.Record (_synAccessOption, fields, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
+ | SynTypeDefnSimpleRepr.Union (_synAccessOption, cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.Enum (cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.TypeAbbrev (_, synType, m) ->
+ yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
+ | _ -> ()
+ yield!
+ synMemberDefns
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None)
+ ]
+ |> pick tRange tydef
+
+ and traverseSynMemberDefn path traverseInherit (m: SynMemberDefn) =
+ let pick (debugObj: obj) = pick m.Range debugObj
+ let path = SyntaxNode.SynMemberDefn m :: path
+
+ match m with
+ | SynMemberDefn.Open (_longIdent, _range) -> None
+ | SynMemberDefn.Member (synBinding, _range) -> traverseSynBinding path synBinding
+ | SynMemberDefn.ImplicitCtor (_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
+ match simplePats with
+ | SynSimplePats.SimplePats (simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
+ | _ -> None
+ | SynMemberDefn.ImplicitInherit (synType, synExpr, _identOption, range) ->
+ [
+ dive () synType.Range (fun () ->
+ match traverseInherit (synType, range) with
+ | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
+ | x -> x)
+ dive () synExpr.Range (fun () -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range))
+ ]
+ |> pick m
+ | SynMemberDefn.AutoProperty (synExpr = synExpr) -> traverseSynExpr path synExpr
+ | SynMemberDefn.LetBindings (synBindingList, isRecursive, _, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None ->
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ |> pick m
+ | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None
+ | SynMemberDefn.Interface (interfaceType = synType; members = synMemberDefnsOption) ->
+ match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
+ | None ->
+ match synMemberDefnsOption with
+ | None -> None
+ | Some (x) ->
+ [
+ yield!
+ x
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None)
+ ]
+ |> pick x
+ | ok -> ok
+ | SynMemberDefn.Inherit (synType, _identOption, range) -> traverseInherit (synType, range)
+ | SynMemberDefn.ValField (_synField, _range) -> None
+ | SynMemberDefn.NestedType (synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
+
+ and traverseSynMatchClause origPath mc =
+ let defaultTraverse mc =
+ let path = SyntaxNode.SynMatchClause mc :: origPath
+
+ match mc with
+ | SynMatchClause (pat = synPat; whenExpr = synExprOption; resultExpr = synExpr) as all ->
+ [ dive synPat synPat.Range (traversePat path) ]
+ @ ([
+ match synExprOption with
+ | None -> ()
+ | Some guard -> yield guard
+ yield synExpr
+ ]
+ |> List.map (fun x -> dive x x.Range (traverseSynExpr path)))
+ |> pick all.Range all
+
+ visitor.VisitMatchClause(origPath, defaultTraverse, mc)
+
+ and traverseSynBinding origPath b =
+ let defaultTraverse b =
+ let path = SyntaxNode.SynBinding b :: origPath
+
+ match b with
+ | SynBinding (headPat = synPat; expr = synExpr) ->
+ match traversePat path synPat with
+ | None -> traverseSynExpr path synExpr
+ | x -> x
+
+ visitor.VisitBinding(origPath, defaultTraverse, b)
+
+ match parseTree with
+ | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) ->
+ let fileRange =
#if DEBUG
- match l with
- | [] -> range0
- | _ ->
- l
- |> List.map (fun x -> x.Range)
- |> List.reduce unionRanges
+ match l with
+ | [] -> range0
+ | _ -> l |> List.map (fun x -> x.Range) |> List.reduce unionRanges
#else
- range0 // only used for asserting, does not matter in non-debug
+ range0 // only used for asserting, does not matter in non-debug
#endif
- l
- |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace []))
- |> pick fileRange l
- | ParsedInput.SigFile _sigFile -> None
+ l
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace []))
+ |> pick fileRange l
+ | ParsedInput.SigFile _sigFile -> None
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index b6d583230..ff83376f5 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -1487,7 +1487,6 @@ let explicitTypeInfoTests =
| _ -> ()
"""
(ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [RemoveOptionFromType] })
-
]
]
testList "let function" [
@@ -1622,7 +1621,7 @@ let explicitTypeInfoTests =
| _ -> ()
"""
(ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
- testCaseAsync " Choice1Of2 value | Choice2Of2 value ->" <|
+ testCaseAsync "Choice1Of2 value | Choice2Of2 value ->" <|
testExplicitType
"""
match Choice1Of2 3 with
From e6040a19f35a4fecf316006456228103ac4871bc Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Tue, 21 Jun 2022 15:43:39 +0200
Subject: [PATCH 19/29] Add tests to check Inlay Type Hint and Add Explicit
Type together
Note: There are now 3 test locations for Inlay Type Hints:
* `explicitTypeInfoTests`: test type annotation
* `inlayTypeHintAndAddExplicitTypeTests`: test Inlay hint existence, and type annotation edits (-> together with Add Explicit Type)
* `typeHintTests`: test Inlay Hint properties (like label)
---
src/FsAutoComplete.Core/InlayHints.fs | 6 +-
.../InlayHintTests.fs | 274 +++++++++++++++++-
2 files changed, 269 insertions(+), 11 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 11b7ded5b..a2fd0019e 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -485,7 +485,7 @@ let rec private isDirectlyTyped (identStart: Position) (path: SyntaxVisitorPath)
/// Note: FULL range of pattern -> everything in parens
/// For `SynPat.Named`: Neither `range` nor `ident.idRange` span complete range: Neither includes Accessibility:
/// `let private (a: int)` is not valid, must include private: `let (private a: int)`
-let rec private getParsenForPatternWithIdent (patternRange: Range) (identStart: Position) (path: SyntaxVisitorPath) =
+let rec private getParensForPatternWithIdent (patternRange: Range) (identStart: Position) (path: SyntaxVisitorPath) =
match path with
| SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
// (x)
@@ -582,11 +582,11 @@ let rec private getParensForIdentPat (text: NamedText) (pat: SynPat) (path: Synt
// `let private (a: int)` is not valid, must include private: `let (private a: int)`
let patternRange = rangeOfNamedPat text pat
let identStart = ident.idRange.Start
- getParsenForPatternWithIdent patternRange identStart path
+ getParensForPatternWithIdent patternRange identStart path
| SynPat.OptionalVal (ident = ident) ->
let patternRange = pat.Range
let identStart = ident.idRange.Start
- getParsenForPatternWithIdent patternRange identStart path
+ getParensForPatternWithIdent patternRange identStart path
| _ -> failwith "Pattern must be Named or OptionalVal!"
let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) : ExplicitType option =
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index ff83376f5..9b597604a 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -159,14 +159,15 @@ module private LspInlayHints =
Expect.equal appliedText textAfterEdits "Text after applying TextEdits does not match expected"
| _ -> ()
- //TODO: handle capabilities?
- //TODO: en/disable?
- let toResolve =
- { actual with
- TextEdits = None
- }
- let! resolved = doc |> Document.resolveInlayHint toResolve
- Expect.equal resolved actual "`textDocument/inlayHint` and `inlayHint/resolve` should result in same InlayHint"
+ //TODO: handle or remove resolve
+ // //TODO: handle capabilities?
+ // //TODO: en/disable?
+ // let toResolve =
+ // { actual with
+ // TextEdits = None
+ // }
+ // let! resolved = doc |> Document.resolveInlayHint toResolve
+ // Expect.equal resolved actual "`textDocument/inlayHint` and `inlayHint/resolve` should result in same InlayHint"
}
let rangeMarker = "$|"
@@ -967,10 +968,267 @@ let private inlayHintTests state =
mixedHintTests state
]
+module InlayHintAndExplicitType =
+ open Utils.Server
+ open Utils.Tests
+ open Utils.Utils
+ open Utils.TextEdit
+
+ let tryGetInlayHintAt pos doc = async {
+ let allRange = { Start = { Line = 0; Character = 0 }; End = { Line = 1234; Character = 1234 }}
+ let! hints =
+ doc
+ |> Document.inlayHintsAt allRange
+ |> Async.map (Option.defaultValue [||])
+ return hints
+ |> Array.tryFind (fun h -> h.Position = pos)
+ }
+ let tryGetCodeFixAt pos doc = async {
+ let range = { Start = pos; End = pos}
+ let! codeFixes =
+ doc
+ |> Document.codeActionAt [||] range
+ return
+ match codeFixes with
+ | None -> None
+ | Some (TextDocumentCodeActionResult.Commands _) -> None
+ | Some (TextDocumentCodeActionResult.CodeActions codeActions) ->
+ codeActions
+ |> Array.tryFind (fun ca -> ca.Title = CodeFix.AddExplicitTypeAnnotation.title)
+ }
+ let private checkInlayHintAndCodeFix
+ (server: CachedServer)
+ (textWithCursor: string)
+ (validateInlayHint: (Document * string * Position) -> InlayHint option -> Async)
+ (validateCodeFix: (Document * string * Position) -> CodeAction option -> Async)
+ = async {
+ // Cursors:
+ // * $0: normal cursor
+ // * $I: optional insert inlay hint here
+ // * when not specified: location of $0
+ let text = textWithCursor |> Text.trimTripleQuotation
+ let (cursor, text) = Cursor.assertExtractPosition text
+ let (hintPos, text) =
+ Cursor.tryExtractPositionMarkedWithAnyOf [|"$I"|] text
+ |> Option.map (fun ((_,pos), text) -> (pos,text))
+ |> Option.defaultValue (cursor, text)
+
+ let! (doc, diags) = server |> Server.createUntitledDocument text
+ use doc = doc
+ Expect.hasLength diags 0 "Document should not have had errors"
+
+ let! hint = doc |> tryGetInlayHintAt hintPos
+ let! codeFix = doc |> tryGetCodeFixAt cursor
+
+ do! validateInlayHint (doc, text, hintPos) hint
+ do! validateCodeFix (doc, text, cursor) codeFix
+ }
+
+ type Expected =
+ /// Edit for InlayHint as well as AddExplicitType CodeFix
+ | Edit of textAfterEdits: string
+ /// Edit for AddExplicitType CodeFix,
+ /// but no InlayHint
+ | JustCodeFix of textAfterEdits: string
+ /// Just display of InlayHint, but no Edits or CodeFix
+ ///
+ /// Label must not contain leading `:` (& following space)
+ | JustInlayHint of label: string
+ /// Neither InlayHint nor CodeFix
+ | Nothing
+
+ let check
+ (recheckAfterAppliedTextEdits: bool)
+ (server: CachedServer)
+ (textWithCursor: string)
+ (expected: Expected)
+ =
+ //TODO: Add tests
+ //TODO: Extract into `Cursor`
+ let calcCursorPositionAfterTextEdits (pos: Position) (edits: TextEdit list) =
+ edits
+ |> List.filter (fun edit -> edit.Range.Start < pos)
+ |> List.fold (fun pos edit ->
+ // remove deleted range from pos
+ let pos =
+ let (s,e) = (edit.Range.Start, edit.Range.End)
+ if s = e then
+ // just insert
+ pos
+ elif edit.Range |> Range.containsLoosely pos then
+ // fall to start of delete
+ edit.Range.Start
+ else
+ // everything to delete is before cursor
+ let deltaLine = e.Line - s.Line
+ let deltaChar =
+ if e.Line < pos.Line then
+ 0
+ elif deltaLine = 0 then
+ // edit is on single line
+ e.Character - s.Character
+ else
+ // edit over multiple lines
+ e.Character
+ { Line = pos.Line - deltaLine; Character = pos.Line - deltaChar }
+ // add new text to pos
+ let pos =
+ if String.IsNullOrEmpty edit.NewText then
+ pos
+ else
+ let lines = edit.NewText |> Text.removeCarriageReturn |> Text.lines
+ let deltaLine = lines.Length - 1
+ let deltaChar =
+ if edit.Range.Start.Line = pos.Line then
+ let lastLine = lines |> Array.last
+ lastLine.Length
+ else
+ 0
+ { Line = pos.Line + deltaLine; Character = pos.Line + deltaChar }
+ pos
+ ) pos
+
+ let rec validateInlayHint (doc, text, pos) (inlayHint: InlayHint option) = async {
+ match expected with
+ | JustCodeFix _
+ | Nothing -> Expect.isNone inlayHint "There should be no Inlay Hint"
+ | JustInlayHint label ->
+ let inlayHint = Expect.wantSome inlayHint "There should be a Inlay Hint"
+ let actual =
+ match inlayHint.Label with
+ | InlayHintLabel.String lbl -> lbl
+ | InlayHintLabel.Parts parts ->
+ parts
+ |> Array.map (fun part -> part.Value)
+ |> String.concat ""
+ let actual =
+ let actual = actual.TrimStart()
+ if actual.StartsWith ':' then
+ actual.Substring(1).TrimStart()
+ else
+ actual
+ Expect.equal actual label "Inlay Hint Label is incorrect"
+
+ let textEdits = inlayHint.TextEdits |> Option.defaultValue [||]
+ Expect.isEmpty textEdits "There should be no text edits"
+ | Edit textAfterEdits ->
+ let inlayHint = Expect.wantSome inlayHint "There should be a Inlay Hint"
+ let textEdits =
+ Expect.wantSome inlayHint.TextEdits "There should be TextEdits"
+ |> List.ofArray
+ let actual =
+ text
+ |> TextEdits.apply textEdits
+ |> Flip.Expect.wantOk "TextEdits should succeed"
+ let expected = textAfterEdits |> Text.trimTripleQuotation
+ Expect.equal actual expected "Text after TextEdits is incorrect"
+
+ if recheckAfterAppliedTextEdits then
+ let! (doc, _) = Server.createUntitledDocument actual (doc.Server |> Async.singleton)
+ use doc = doc
+ let! inlayHint = doc |> tryGetInlayHintAt pos
+ Expect.isNone inlayHint "There shouldn't be a inlay hint after inserting inlay hint text edit"
+ let! codeFix = doc |> tryGetCodeFixAt pos
+ Expect.isNone codeFix "There shouldn't be a code fix after inserting code fix text edit"
+ }
+ let validateCodeFix (doc: Document, text, pos) (codeFix: CodeAction option) = async {
+ match expected with
+ | JustInlayHint _
+ | Nothing ->
+ Expect.isNone codeFix "There should be no Code Fix"
+ | JustCodeFix textAfterEdits
+ | Edit textAfterEdits ->
+ let codeFix = Expect.wantSome codeFix "There should be a Code Fix"
+ let edits =
+ Expect.wantSome codeFix.Edit "There should be TextEdits"
+ |> WorkspaceEdit.tryExtractTextEditsInSingleFile (doc.VersionedTextDocumentIdentifier)
+ |> Flip.Expect.wantOk "WorkspaceEdit should be valid"
+ let actual =
+ text
+ |> TextEdits.apply edits
+ |> Flip.Expect.wantOk "TextEdits should succeed"
+ let expected = textAfterEdits |> Text.trimTripleQuotation
+ Expect.equal actual expected "Text after TextEdits is incorrect"
+
+ if recheckAfterAppliedTextEdits then
+ let! (doc, _) = Server.createUntitledDocument actual (doc.Server |> Async.singleton)
+ use doc = doc
+ let! inlayHint = doc |> tryGetInlayHintAt pos
+ Expect.isNone inlayHint "There shouldn't be a inlay hint after inserting inlay hint text edit"
+ let! codeFix = doc |> tryGetCodeFixAt pos
+ Expect.isNone codeFix "There shouldn't be a code fix after inserting code fix text edit"
+ }
+
+ checkInlayHintAndCodeFix server
+ textWithCursor
+ validateInlayHint
+ validateCodeFix
+
+open InlayHintAndExplicitType
+//TODO: pending: no valid annotation location ... but InlayHint should be displayed (but currently isn't)
+/// Test Inlay Type Hints & Add Explicit Type Code Fix:
+/// * At most locations Type Hint & Code Fix should be valid at same location and contain same TextEdit -> checked together
+/// * Checked by applying TextEdits
+/// * Additional test: After applying TextEdit (-> add type annotation), neither Type Hint nor Code Fix are available any more
+///
+/// vs. `explicitTypeInfoTests`:
+/// * `explicitTypeInfoTests`:
+/// * Does Type Annotation exists
+/// * Is Type Annotation valid
+/// * Are parens required
+/// * Where to parens go
+/// * low-level -> doesn't use LSP Server, but instead calls `tryGetExplicitTypeInfo` directly
+/// * `inlayTypeHintAndAddExplicitTypeTests`
+/// * Is (and should) Inlay Type Hint be displayed here
+/// * Does "Add Explicit Type" Code Fix get triggered
+/// * Produce both correct Text Edits
+/// * Are both not triggered any more after Text Edit
+/// * high-level: LSP Server with `textDocument/inlayHint` & `textDocument/codeAction` commands
+///
+/// vs. `typeHintTests`:
+/// * `typeHintTests`:
+/// * Tests all properties of InlayHint like label, location
+/// * Checks all InlayHint in a certain range (including their absent)
+/// * `inlayTypeHintAndAddExplicitTypeTests`
+/// * InlayHint at single location
+/// * Tests just TextEdits
+/// * Additional checks "Add Explicit Type" Code Fix
+///
+///
+/// ->
+/// * `explicitTypeInfoTests`: test type annotation
+/// * `inlayTypeHintAndAddExplicitTypeTests`: test type annotation edit and Inlay Hint existence (vs. "Add Explicit Type")
+/// * Tests when inlay hints should not be displayed should go here
+/// * `typeHintTests`: test data in InlayHint (like label)
+let private inlayTypeHintAndAddExplicitTypeTests state =
+ let check = check true
+ let checkAll server pre post = check server pre (Edit post)
+ serverTestList "LSP InlayHint (type) & AddExplicitType" state defaultConfigDto None (fun server -> [
+ testCaseAsync "can add type annotation" <|
+ checkAll server
+ """
+ let value$0 = 42
+ """
+ """
+ let value: int = 42
+ """
+ testCaseAsync "neither Type Hint nor Code Fix when type annotation already exists" <|
+ check server
+ """
+ let value$0: int = 42
+ """
+ Nothing
+
+ testList "hide type hint" [
+ //ENHANCEMENT: add cases when Inlay Type Hint should not trigger (like `let str = "..."`?)
+ ]
+ ])
+
let tests state =
testList (nameof InlayHint) [
FSharpInlayHints.tests state
inlayHintTests state
+ inlayTypeHintAndAddExplicitTypeTests state
]
From d9c9e1cef2c5f383b31d0e243ea80051753e9026 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Tue, 21 Jun 2022 16:07:57 +0200
Subject: [PATCH 20/29] Remove `inlayHint/resolve` -> not handled (yet)
---
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 67 +-----------------------
1 file changed, 1 insertion(+), 66 deletions(-)
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index a8c50de56..803146d29 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2692,22 +2692,15 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
| InlayHints.HintKind.Type -> Types.InlayHintKind.Type
| InlayHints.HintKind.Parameter -> Types.InlayHintKind.Parameter
|> Some
- //TODO: lazy -> resolve?
TextEdits =
match h.Insertions with
| None -> None
- // Note: Including no insertions via empty array:
- // Difference:
- // * `None` -> no `TextEdits` element specified -> can be `resolve`d
- // * `Some [||]` -> `TextEdits` gets serialized -> no `resolve`
- //TODO: always emit `Some [||]` (instead of `None`) for `Parameter` -> prevent `resolve`
| Some insertions ->
insertions
|> Array.map (fun insertion ->
{ Range = fcsPosToProtocolRange insertion.Pos
NewText = insertion.Text })
|> Some
- //TODO: lazy -> resolve?
Tooltip = h.Tooltip |> Option.map (InlayHintTooltip.String)
PaddingLeft =
match h.Kind with
@@ -2717,69 +2710,11 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
match h.Kind with
| InlayHints.HintKind.Parameter -> Some true
| _ -> None
- Data =
- { TextDocument = p.TextDocument
- Range = fcsRangeToLsp h.IdentRange }
- |> serialize
- |> Some })
+ Data = None } )
return success (Some hints)
})
- //TODO: remove?
- /// Note: Requires `InlayHintData` in `InlayHint.Data` element.
- /// Required to relate `InlayHint` to a document and position inside
- ///
- /// Note: Currently only resolves `TextEdits`
- override x.InlayHintResolve(p: InlayHint) : AsyncLspResult =
- logger.info (
- Log.setMessage "InlayHintResolve Request: {parms}"
- >> Log.addContextDestructured "parms" p
- )
-
- match p.Data with
- | _ when p.TextEdits |> Option.isSome ->
- // nothing to resolve
- Async.singleton <| success p
- | None ->
- Async.singleton
- <| invalidParams "InlayHint doesn't contain `Data`"
- | Some data ->
- let data: InlayHintData = deserialize data
-
- data.TextDocument
- |> x.fileHandler (fun fn tyRes lines ->
- asyncResult {
- // update TextEdits
- let! p =
- match p.Kind, p.TextEdits with
- | Some (Types.InlayHintKind.Parameter), _ -> Ok p
- | _, Some _ -> Ok p
- | _, None ->
- maybe {
- let! (symbolUse, mfv, explTy) =
- InlayHints.tryGetDetailedExplicitTypeInfo
- (InlayHints.isPotentialTargetForTypeAnnotation false)
- (lines, tyRes)
- (protocolPosToPos data.Range.Start)
-
- let! (_, edits) = explTy.TryGetTypeAndEdits(mfv.FullType, symbolUse.DisplayContext)
-
- let p =
- { p with
- TextEdits =
- edits
- |> AddExplicitTypeAnnotation.toLspEdits
- |> Some }
-
- return p
- }
- |> Option.defaultValue p
- |> Ok
-
- return p
- })
-
member x.FSharpPipelineHints(p: FSharpPipelineHintRequest) =
logger.info (
Log.setMessage "FSharpPipelineHints Request: {parms}"
From e9937a3c6b0def1039479da9427304157cd3bc90 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Tue, 21 Jun 2022 21:46:43 +0200
Subject: [PATCH 21/29] Cleanup
---
src/FsAutoComplete.Core/InlayHints.fs | 13 +++----
.../InlayHintTests.fs | 34 +++++++------------
2 files changed, 18 insertions(+), 29 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index a2fd0019e..9c2b64de9 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -396,7 +396,6 @@ type MissingExplicitType with
/// -> to use as type annotation
///
member x.FormatType(ty: FSharpType, displayContext: FSharpDisplayContext) : TypeName * TypeNameForAnnotation =
- //TODO: Format vs FormatWithConstraints?
let typeName = ty.Format displayContext
let anno =
@@ -407,7 +406,6 @@ type MissingExplicitType with
if typeName.EndsWith " option" then
typeName.Substring(0, typeName.Length - " option".Length)
else
- // TODO: always just trailing `option`? or can be `Option`? -- maybe even with Namespace?
typeName
else
typeName
@@ -450,7 +448,6 @@ type ExplicitType =
| Invalid
| Exists
| Missing of MissingExplicitType
- //TODO: remove
| Debug of string
type ExplicitType with
@@ -467,7 +464,7 @@ type ExplicitType with
/// * Parentheses: `(v): int`
/// * Attributes: `([]v): int`
let rec private isDirectlyTyped (identStart: Position) (path: SyntaxVisitorPath) =
- //TODO: handle SynExpr.Typed? -> not at binding, but usage
+ //ENHANCEMENT: handle SynExpr.Typed? -> not at binding, but usage
match path with
| [] -> false
| SyntaxNode.SynPat (SynPat.Typed (pat = pat)) :: _ when rangeContainsPos pat.Range identStart -> true
@@ -636,7 +633,7 @@ let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) :
true
| _ -> false
- //TODO: differentiate between directly typed and parently typed?
+ //ENHANCEMENT: differentiate between directly typed and parently typed?
// (maybe even further ancestorly typed?)
// ```fsharp
// let (a: int,b) = (1,2)
@@ -646,7 +643,8 @@ let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) :
// ```
// currently: only directly typed is typed
match pat with
- // no simple way out: Range for `SynPat.LongIdent` doesn't cover full pats (just ident)...
+ // no simple way out: Range for `SynPat.LongIdent` doesn't cover full pats (just ident)
+ // see dotnet/fsharp#13115
// | _ when not (rangeContainsPos pat.Range pos) -> None
| SynPat.Named (ident = ident) when
rangeContainsPos ident.idRange pos
@@ -691,7 +689,6 @@ let tryGetExplicitTypeInfo (text: NamedText, ast: ParsedInput) (pos: Position) :
// * Primary ctor:
// * SynMemberDefn.ImplicitCtor.ctorArgs
// * SynTypeDefnSimpleRepr.General.implicitCtorSynPats
- // //TODO: when? example?
// * Lambda: SynExpr.Lambda.args
// * issue: might or might not be actual identifier
// * `let f1 = fun v -> v + 1`
@@ -808,7 +805,7 @@ let private tryCreateTypeHint (explicitType: ExplicitType) (ty: FSharpType) (dis
{ IdentRange = data.Ident
Pos = data.InsertAt
Kind = Type
- // TODO: or use tyForAnno?
+ // TODO: or use tyForAnno?: `?value: int`, but type is `int option`
Text = ": " + truncated
Insertions = Some <| data.CreateEdits tyForAnno
Tooltip = tooltip }
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index 9b597604a..ff750ef37 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -22,7 +22,6 @@ module private FSharpInlayHints =
| InlayHintKind.Type -> ": " + InlayHints.truncated text
| InlayHintKind.Parameter -> InlayHints.truncated text + " ="
// this is for truncated text, which we do not currently hit in our tests
- // TODO: add tests to cover this case
InsertText =
match kind with
| InlayHintKind.Type -> Some(": " + text)
@@ -158,16 +157,6 @@ module private LspInlayHints =
|> Flip.Expect.wantOk "TextEdits are erroneous"
Expect.equal appliedText textAfterEdits "Text after applying TextEdits does not match expected"
| _ -> ()
-
- //TODO: handle or remove resolve
- // //TODO: handle capabilities?
- // //TODO: en/disable?
- // let toResolve =
- // { actual with
- // TextEdits = None
- // }
- // let! resolved = doc |> Document.resolveInlayHint toResolve
- // Expect.equal resolved actual "`textDocument/inlayHint` and `inlayHint/resolve` should result in same InlayHint"
}
let rangeMarker = "$|"
@@ -279,7 +268,6 @@ module private LspInlayHints =
open LspInlayHints
let private paramHintTests state =
serverTestList "param hints" state defaultConfigDto None (fun server -> [
- //todo: with ````
testCaseAsync "can show param hint" <|
checkAllInMarkedRange server
"""
@@ -776,12 +764,23 @@ let private paramHintTests state =
ptestCaseAsync "can show param for method" <|
checkAllInMarkedRange server
"""
- $|System.Environment.GetEnvironmentVariable "Blah"
+ $|System.Environment.GetEnvironmentVariable $0"Blah"
|> ignore$|
"""
[
paramHint "variable"
]
+
+ testCaseAsync "can show param for name in backticks" <|
+ checkAllInMarkedRange server
+ """
+ let f ``foo bar`` = ``foo bar`` + 1
+ $|f $042$|
+ |> ignore
+ """
+ [
+ paramHint "``foo bar``"
+ ]
])
let private typeHintTests state =
serverTestList "type hints" state defaultConfigDto None (fun server -> [
@@ -1165,7 +1164,6 @@ module InlayHintAndExplicitType =
validateCodeFix
open InlayHintAndExplicitType
-//TODO: pending: no valid annotation location ... but InlayHint should be displayed (but currently isn't)
/// Test Inlay Type Hints & Add Explicit Type Code Fix:
/// * At most locations Type Hint & Code Fix should be valid at same location and contain same TextEdit -> checked together
/// * Checked by applying TextEdits
@@ -1599,7 +1597,7 @@ let explicitTypeInfoTests =
let ($0value: int),_ = (1,2)
"""
(ExplicitType.Exists)
- //TODO: Distinguish between direct and parently/ancestorly typed?
+ //ENHANCEMENT: Distinguish between direct and parently/ancestorly typed?
testCaseAsync "let (value,_): int*int = (1,2)" <|
testExplicitType
"""
@@ -1999,12 +1997,6 @@ let explicitTypeInfoTests =
]
testList "SimplePats" [
// primary ctor args & lambda args
- // * primary ctor: no parens allowed
- // * lambda args: absolutely fucked up -- in fact so fucked up I use the f-word to describe how fucked up it is...
- // TODO: remove `fuck`s
- // TODO: replace with something stronger?
- // -> special handling for `SynExpr.Lambda` and then `parsedData |> fst` (-> `SynPat` instead of `SynSimplePat`)
-
testList "primary ctor" [
testCaseAsync "T(a)" <|
testExplicitType
From 55654210da97bd89192ab1b833e1f030df13244c Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Wed, 22 Jun 2022 20:29:09 +0200
Subject: [PATCH 22/29] Adjust file name to match `AddExplicitTypeAnnotation`
CodeFix
CodeFix was already renamed
---
...tTypeToParameterTests.fs => AddExplicitTypeAnnotationTests.fs} | 0
1 file changed, 0 insertions(+), 0 deletions(-)
rename test/FsAutoComplete.Tests.Lsp/CodeFixTests/{AddExplicitTypeToParameterTests.fs => AddExplicitTypeAnnotationTests.fs} (100%)
diff --git a/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeAnnotationTests.fs
similarity index 100%
rename from test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeToParameterTests.fs
rename to test/FsAutoComplete.Tests.Lsp/CodeFixTests/AddExplicitTypeAnnotationTests.fs
From e66e0ae8719b048c58143f8472a85716695546f2 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Wed, 22 Jun 2022 21:30:30 +0200
Subject: [PATCH 23/29] Fix: Difference in required/optional parens in `let`
and `match` case
---
src/FsAutoComplete.Core/InlayHints.fs | 22 ++++
.../InlayHintTests.fs | 106 +++++++++++++++---
2 files changed, 114 insertions(+), 14 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 9c2b64de9..602a77bb3 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -502,6 +502,28 @@ let rec private getParensForPatternWithIdent (patternRange: Range) (identStart:
| SyntaxNode.SynPat (SynPat.ArrayOrList _) :: _ ->
// [x;y;z]
Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As _) :: SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As (rhsPat = pat)) :: SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _
+ when
+ rangeContainsPos pat.Range identStart
+ && rangeContainsPos headPat.Range identStart
+ ->
+ // let _ as value =
+ // ->
+ // let _ as value: int =
+ // (new `: int` belongs to let binding, NOT as pattern)
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As (lhsPat = pat)) :: SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _
+ when
+ rangeContainsPos pat.Range identStart
+ && rangeContainsPos headPat.Range identStart
+ ->
+ // let value as _ =
+ // ->
+ // let (value: int) as _ =
+ // (`: int` belongs to as pattern, but let bindings tries to parse type annotation eagerly -> without parens let binding finished after `: int` -> as not pattern)
+ Parens.Required patternRange
| SyntaxNode.SynPat (SynPat.As (rhsPat = pat)) :: _ when rangeContainsPos pat.Range identStart ->
// _ as (value: int)
Parens.Required patternRange
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index ff750ef37..b196594ca 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -1884,20 +1884,98 @@ let explicitTypeInfoTests =
| Choice1Of2 value | Choice2Of2 $($0value$I$) -> ()
"""
(ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
- testCaseAsync "| _ as value ->" <|
- testExplicitType
- """
- match 4 with
- | _ as $($0value$I$) -> ()
- """
- (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
- testCaseAsync "| value as _ ->" <|
- testExplicitType
- """
- match 4 with
- | $($0value$I$) as _ -> ()
- """
- (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testList "as" [
+ // strange `as`:
+ // * `let _ as value: int = ...` -> ok
+ // * `| _ as value: int -> ...` -> error
+ // * `static member F (_ as value: int) = ...` -> ok
+ //
+ // * `let value: int as _ = ...` -> error
+ // * `| value: int as _ -> ...` -> ok
+ // * `static member F (value: int as _) = ...` -> ok
+
+ // ->
+ // trailing type anno:
+ // * in `let`: trailing type anno part of `let` binding, NOT pattern -> ok
+ // * similar when with parens: `(pat: type)` with `pat=_ as _`
+ // * in `case`: just pattern -> no trailing type annotation part of case definition
+ //
+ // type anno in first binding position: don't know
+ // Probably eager type annotation matching of let binding? -> `as` is now in pos of parameter
+ // Other Patterns require parens too:
+ // * `let Some value = Some 42` -> function named `Some` with argument `value: 'a` returning `Some 42`
+ // * `let (Some value) = Some 42` -> destructure of `Some 42` to `value: int = 42`
+
+ testCaseAsync "let _ as value =" <|
+ testExplicitType
+ """
+ let _ as $($0value$I$) = 42
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| _ as value ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | _ as $($0value$I$) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "static member F (_ as value) =" <|
+ testExplicitType
+ """
+ type A =
+ static member F (_ as $($0value$I$)) = value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+
+ testCaseAsync "let value as _ =" <|
+ testExplicitType
+ """
+ let $($0value$I$) as _ = 42
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Required fromCursors; SpecialRules = [] })
+ testCaseAsync "| value as _ ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | $($0value$I$) as _ -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "static member F (value as _) =" <|
+ testExplicitType
+ """
+ type A =
+ static member F ($($0value$I$) as _) = value + 1
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+
+ testCaseAsync "let (_ as value) =" <|
+ testExplicitType
+ """
+ let (_ as $($0value$I$)) = 42
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| (_ as value) ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | (_ as $($0value$I$)) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+
+ testCaseAsync "let (value as _) =" <|
+ testExplicitType
+ """
+ let ($($0value$I$) as _) = 42
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ testCaseAsync "| (value as _) ->" <|
+ testExplicitType
+ """
+ match 4 with
+ | ($($0value$I$) as _) -> ()
+ """
+ (ExplicitType.Missing { Ident=fromCursorAndInsert; InsertAt=fromCursor; Parens=Parens.Optional fromCursors; SpecialRules = [] })
+ ]
testCaseAsync "| (_, value) ->" <|
testExplicitType
"""
From c8cdd539aa1b37a7f900ed51a08d54e678c8d5ad Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 24 Jun 2022 13:51:45 +0200
Subject: [PATCH 24/29] Add `Cursor.afterEdits` to calc cursor pos after all
edits
Extracted & Fixed from InlayHintTests
---
.../Utils/TextEdit.Tests.fs | 355 +++++++++++++++++-
.../Utils/TextEdit.fs | 90 +++++
2 files changed, 444 insertions(+), 1 deletion(-)
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs
index ecb09f86e..e2af34854 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.Tests.fs
@@ -9,6 +9,8 @@ open Utils.Utils
let private logger = Expecto.Logging.Log.create (sprintf "%s.%s" (nameof Utils.Tests) (nameof Utils.TextEdit))
let inline private pos line column: Position = { Line = line; Character = column }
+let inline private range start fin = { Start = start; End = fin}
+let inline private posRange pos = range pos pos
let inline private (!-) text = Text.trimTripleQuotation text
module private Cursor =
@@ -955,6 +957,357 @@ $0printfn "$0Result=%i" b$0
]
]
+ let afterEditsTests = testList (nameof Cursor.afterEdits) [
+ testCase "doesn't move cursor when insert after cursor in different line" <| fun _ ->
+ let cursor = pos 1 2
+ let edits = [
+ {
+ Range = posRange (pos 2 5)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+ testCase "doesn't move cursor when remove after cursor in different line" <| fun _ ->
+ let cursor = pos 1 2
+ let edits = [
+ {
+ Range = range (pos 2 5) (pos 3 4)
+ NewText = ""
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+ testCase "doesn't move cursor when replace after cursor in different line" <| fun _ ->
+ let cursor = pos 1 2
+ let edits = [
+ {
+ Range = range (pos 2 5) (pos 3 4)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+
+ testCase "doesn't move cursor when insert before cursor in different line and just inside line" <| fun _ ->
+ let cursor = pos 2 2
+ let edits = [
+ {
+ Range = posRange (pos 1 5)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+ testCase "doesn't move cursor when remove before cursor in different line and just inside line" <| fun _ ->
+ let cursor = pos 2 2
+ let edits = [
+ {
+ Range = range (pos 1 5) (pos 1 7)
+ NewText = ""
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+ testCase "doesn't move cursor when replace before cursor in different line and just inside line" <| fun _ ->
+ let cursor = pos 2 2
+ let edits = [
+ {
+ Range = range (pos 1 5) (pos 1 7)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+
+ testCase "moves cursor down a line when inserting new line before cursor in different line" <| fun _ ->
+ let cursor = pos 2 2
+ let edits = [
+ {
+ Range = posRange (pos 1 5)
+ NewText = "foo\nbar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move down a line" { cursor with Line = cursor.Line + 1 }
+ testCase "moves cursor up a line when removing line before cursor in different line" <| fun _ ->
+ let cursor = pos 3 2
+ let edits = [
+ {
+ Range = range (pos 1 5) (pos 2 4)
+ NewText = ""
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move up a line" { cursor with Line = cursor.Line - 1 }
+
+ testCase "moves cursor up a line when removing a line and inserting inside line before cursor in different line" <| fun _ ->
+ let cursor = pos 3 2
+ let edits = [
+ {
+ Range = range (pos 1 5) (pos 2 4)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move up a line" { cursor with Line = cursor.Line - 1 }
+ testCase "doesn't move cursor when removing a line and inserting a line before cursor in different line" <| fun _ ->
+ let cursor = pos 3 2
+ let edits = [
+ {
+ Range = range (pos 1 5) (pos 2 4)
+ NewText = "foo\nbar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should not move" cursor
+ testCase "moves cursor down when removing a line and inserting two lines before cursor in different line" <| fun _ ->
+ let cursor = pos 3 2
+ let edits = [
+ {
+ Range = range (pos 1 5) (pos 2 4)
+ NewText = "foo\nbar\nbaz"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move down a line" { cursor with Line = cursor.Line + 1 }
+
+ testCase "moves cursor back when inserting inside same line in front of cursor" <| fun _ ->
+ let cursor = pos 3 2
+ let edits = [
+ {
+ Range = posRange (pos 3 1)
+ NewText = "foo"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move back" { cursor with Character = cursor.Character + 3 }
+ testCase "moves cursor forward when deleting inside same line in front of cursor" <| fun _ ->
+ let cursor = pos 3 7
+ let edits = [
+ {
+ Range = range (pos 3 2) (pos 3 5)
+ NewText = ""
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move forward" { cursor with Character = 4 }
+
+ testCase "moves cursor forward and up when deleting inside and pre same line in front of cursor" <| fun _ ->
+ let cursor = pos 3 7
+ let edits = [
+ {
+ Range = range (pos 2 2) (pos 3 5)
+ NewText = ""
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move forward and up" (pos 2 4)
+
+
+ testCase "moves cursor to front of delete when cursor inside" <| fun _ ->
+ let cursor = pos 3 7
+ let edits = [
+ {
+ Range = range (pos 2 2) (pos 3 10)
+ NewText = ""
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move to start of delete" (pos 2 2)
+
+ testCase "cursor stays when insert at cursor position" <| fun _ ->
+ let cursor = pos 2 5
+ let edits = [
+ {
+ Range = posRange (pos 2 5)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move to start of delete" cursor
+
+ testCase "cursor moves to front when replacement with cursor inside" <| fun _ ->
+ let cursor = pos 3 7
+ let edits = [
+ {
+ Range = range (pos 2 3) (pos 5 2)
+ NewText = "foo bar"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move to start of delete" { Line = 2; Character = 3 }
+
+ testList "multiple edits" [
+ let data = lazy (
+ let textWithCursors =
+ """
+ let $1foo$1 = 42
+ let $2bar = "baz"
+
+ let $2f a $3b =
+ (a +$3 b) * 2$4
+ let$4 inline$5 $6in$0cr$6 v = v + 1
+ let inline decr v = v - 1
+
+ let $7res$7 = f (incr 4) (decr 3)
+ """
+ // match res with
+ // | _ when res < 0 -> failwith "negative"
+ // | 0 -> None
+ // | i -> Some i
+ // """
+ |> Text.trimTripleQuotation
+ let edits = [
+ // doesn't change cursor
+ {|
+ Marker = "$1"
+ NewText = "barbaz"
+ |}
+ // - 2 lines + 1 line
+ {|
+ Marker = "$2"
+ NewText = "baz = 42\nlet "
+ |}
+ // -1 line + 2 lines
+ {|
+ Marker = "$3"
+ NewText = "c\n b =\n (a+c-"
+ |}
+ // -1 line - 3 chars
+ {|
+ Marker = "$4"
+ NewText = ""
+ |}
+ // +3 line -all chars + couple new chars
+ {|
+ Marker = "$5"
+ NewText = " static\n\n\n mutable"
+ |}
+ // move to front of edit chars
+ {|
+ Marker = "$6"
+ NewText = "incrementNumber"
+ |}
+ // doesn't change cursor
+ {|
+ Marker = "$7"
+ NewText = "foo bar\nbaz\nlorem ipsum"
+ |}
+ ]
+ let markers =
+ edits
+ |> List.map (fun e -> e.Marker)
+ |> List.append ["$0"]
+ |> List.toArray
+
+ let (text, cursors) =
+ textWithCursors
+ |> Cursors.extractGroupedWith markers
+ let cursor = cursors["$0"] |> List.head
+
+ let edits =
+ edits
+ |> List.map (fun e ->
+ let range =
+ match cursors[e.Marker] with
+ | [s;e] -> range s e
+ | [pos] -> posRange pos
+ | cs -> failwith $"invalid number of cursors `{e.Marker}`. Expected 1 or 2, but was {cs.Length}"
+ {
+ Range = range
+ NewText = e.NewText
+ }
+ )
+ |> TextEdits.sortByRange
+
+ {|
+ Text = text
+ Cursor = cursor
+ Edits = edits
+ |}
+ )
+
+ testCase "cursor moves according to multiple edits" <| fun _ ->
+ let data = data.Value
+ let (text, cursor, edits) = data.Text, data.Cursor, data.Edits
+
+ let textAfterEdits =
+ text
+ |> TextEdits.apply edits
+ |> Expect.wantOk "Edits should be valid"
+ // cursor should be at start of `incrementNumber`
+ let expected =
+ textAfterEdits
+ |> Text.lines
+ |> Seq.indexed
+ |> Seq.choose (fun (l, line) ->
+ match line.IndexOf "incrementNumber" with
+ | -1 -> None
+ | c -> Some (pos l c)
+ )
+ |> Seq.exactlyOne
+
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move according to edits" expected
+
+ testCase "moving cursor for all edits together is same as moving cursor for each edit" <| fun _ ->
+ let data = data.Value
+ let (cursor, edits) = data.Cursor, data.Edits
+
+ let individually =
+ edits
+ |> List.rev
+ |> List.fold (fun cursor edit ->
+ cursor |> Cursor.afterEdits [edit]
+ ) cursor
+ let together =
+ cursor
+ |> Cursor.afterEdits edits
+
+ Expecto.Expect.equal together individually "Moving cursor for all edits together should be same as moving cursor for each edit"
+ ]
+
+ testCase "Can add type annotation with parens while cursor stays at end of identifier" <| fun _ ->
+ // `let foo$0 = 42`
+ let cursor = pos 0 7
+ let edits = [
+ {
+ Range = posRange (pos 0 4)
+ NewText = "("
+ }
+ {
+ Range = posRange (pos 0 7)
+ NewText = ": int"
+ }
+ {
+ Range = posRange (pos 0 7)
+ NewText = ")"
+ }
+ ]
+ cursor
+ |> Cursor.afterEdits edits
+ |> Expect.equal "Cursor should move to end of identifier" { cursor with Character = cursor.Character + 1 }
+ ]
+
let tests = testList (nameof Cursor) [
tryExtractIndexTests
tryExtractPositionMarkedWithAnyOfTests
@@ -963,6 +1316,7 @@ $0printfn "$0Result=%i" b$0
beforeIndexTests
tryIndexOfTests
identityTests
+ afterEditsTests
]
module private Cursors =
@@ -1106,7 +1460,6 @@ printfn "Result=%i" b$0
module private Text =
open Expecto.Flip
- let inline private range start fin = { Start = start; End = fin}
let private removeTests = testList (nameof Text.remove) [
testList "start=end should remove nothing" [
diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
index da1e5fdfc..f0f3aed18 100644
--- a/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
+++ b/test/FsAutoComplete.Tests.Lsp/Utils/TextEdit.fs
@@ -156,6 +156,96 @@ module Cursor =
tryIndexOf pos
>> Result.valueOr (failtestf "Invalid position: %s")
+ /// Calculates cursors position after all edits are applied.
+ ///
+ /// When cursor inside a changed area:
+ /// * deleted: cursor moves to start of deletion:
+ /// ```fsharp
+ /// let foo = 42 $|+ $013 $|+ 123
+ /// ```
+ /// -> delete inside `$|`
+ /// ```fsharp
+ /// let foo = 42 $0+ 123
+ /// ```
+ /// * inserted: cursor stays at start of insert
+ /// ```fsharp
+ /// let foo = 42 $0+ 123
+ /// ```
+ /// -> insert at cursor pos
+ /// ```fsharp
+ /// let foo = 42 $0+ 13 + 123
+ /// ```
+ /// * changes: cursors moved to start of replacement
+ /// ```fsharp
+ /// let foo = 42 $|+ $013 $|+ 123
+ /// ```
+ /// -> replace inside `$|`
+ /// ```fsharp
+ /// let foo = 42 $0- 7 + 123
+ /// ```
+ /// -> like deletion
+ /// * Implementation detail:
+ /// Replacement is considered: First delete (-> move cursor to front), then insert (-> cursor stays)
+ ///
+ /// Note: `edits` must be sorted by range!
+ let afterEdits (edits: TextEdit list) (pos: Position) =
+ edits
+ |> List.filter (fun edit -> edit.Range.Start < pos)
+ |> List.rev
+ |> List.fold (fun pos edit ->
+ // remove deleted range from pos
+ let pos =
+ if Range.isPosition edit.Range then
+ // just insert
+ pos
+ elif edit.Range |> Range.containsLoosely pos then
+ // pos inside edit -> fall to start of delete
+ edit.Range.Start
+ else
+ // everything to delete is before cursor
+ let (s,e) = edit.Range.Start, edit.Range.End
+ // always <= 0 (nothing gets inserted here)
+ let deltaLine = s.Line - e.Line
+ let deltaChar =
+ if e.Line < pos.Line then
+ // doesn't touch line of pos
+ 0
+ else
+ - e.Character + s.Character
+ { Line = pos.Line + deltaLine; Character = pos.Character + deltaChar }
+
+ // add new text to pos
+ let pos =
+ if System.String.IsNullOrEmpty edit.NewText then
+ // just delete
+ pos
+ elif pos <= edit.Range.Start then
+ // insert is after pos -> doesn't change cursor
+ // happens when cursor inside replacement -> cursor move to front of deletion
+ pos
+ else
+ let lines =
+ edit.NewText
+ |> Text.removeCarriageReturn
+ |> Text.lines
+ let deltaLine = lines.Length - 1
+ let deltaChar =
+ if edit.Range.Start.Line = pos.Line then
+ let lastLine = lines |> Array.last
+ if lines.Length = 1 then
+ // doesn't introduce new line
+ lastLine.Length
+ else
+ // inserts new line
+ - edit.Range.Start.Character + lastLine.Length
+ else
+ // doesn't touch line of pos
+ 0
+ { Line = pos.Line + deltaLine; Character = pos.Character + deltaChar }
+
+ pos
+ ) pos
+
module Cursors =
/// For each cursor (`$0`) in text: return text with just that one cursor
///
From cbaff16feac07fc4a864044ddc13b470001a376d Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 24 Jun 2022 14:58:36 +0200
Subject: [PATCH 25/29] Update tests to use `Cursor.afterEdits`
---
.../InlayHintTests.fs | 75 ++++---------------
1 file changed, 15 insertions(+), 60 deletions(-)
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index b196594ca..fc1029c33 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -1042,50 +1042,15 @@ module InlayHintAndExplicitType =
(textWithCursor: string)
(expected: Expected)
=
- //TODO: Add tests
- //TODO: Extract into `Cursor`
- let calcCursorPositionAfterTextEdits (pos: Position) (edits: TextEdit list) =
- edits
- |> List.filter (fun edit -> edit.Range.Start < pos)
- |> List.fold (fun pos edit ->
- // remove deleted range from pos
- let pos =
- let (s,e) = (edit.Range.Start, edit.Range.End)
- if s = e then
- // just insert
- pos
- elif edit.Range |> Range.containsLoosely pos then
- // fall to start of delete
- edit.Range.Start
- else
- // everything to delete is before cursor
- let deltaLine = e.Line - s.Line
- let deltaChar =
- if e.Line < pos.Line then
- 0
- elif deltaLine = 0 then
- // edit is on single line
- e.Character - s.Character
- else
- // edit over multiple lines
- e.Character
- { Line = pos.Line - deltaLine; Character = pos.Line - deltaChar }
- // add new text to pos
- let pos =
- if String.IsNullOrEmpty edit.NewText then
- pos
- else
- let lines = edit.NewText |> Text.removeCarriageReturn |> Text.lines
- let deltaLine = lines.Length - 1
- let deltaChar =
- if edit.Range.Start.Line = pos.Line then
- let lastLine = lines |> Array.last
- lastLine.Length
- else
- 0
- { Line = pos.Line + deltaLine; Character = pos.Line + deltaChar }
- pos
- ) pos
+ let recheckAfterAppliedEdits (doc: Document) (cursorBeforeEdits: Position) (edits: TextEdit list) (textAfterEdits: string) = async {
+ let! (doc, _) = Server.createUntitledDocument textAfterEdits (doc.Server |> Async.singleton)
+ use doc = doc
+ let pos = cursorBeforeEdits |> Cursor.afterEdits edits
+ let! inlayHint = doc |> tryGetInlayHintAt pos
+ Expect.isNone inlayHint "There shouldn't be a inlay hint after inserting inlay hint text edit"
+ let! codeFix = doc |> tryGetCodeFixAt pos
+ Expect.isNone codeFix "There shouldn't be a code fix after inserting code fix text edit"
+ }
let rec validateInlayHint (doc, text, pos) (inlayHint: InlayHint option) = async {
match expected with
@@ -1108,27 +1073,22 @@ module InlayHintAndExplicitType =
actual
Expect.equal actual label "Inlay Hint Label is incorrect"
- let textEdits = inlayHint.TextEdits |> Option.defaultValue [||]
- Expect.isEmpty textEdits "There should be no text edits"
+ let edits = inlayHint.TextEdits |> Option.defaultValue [||]
+ Expect.isEmpty edits "There should be no text edits"
| Edit textAfterEdits ->
let inlayHint = Expect.wantSome inlayHint "There should be a Inlay Hint"
- let textEdits =
+ let edits =
Expect.wantSome inlayHint.TextEdits "There should be TextEdits"
|> List.ofArray
let actual =
text
- |> TextEdits.apply textEdits
+ |> TextEdits.apply edits
|> Flip.Expect.wantOk "TextEdits should succeed"
let expected = textAfterEdits |> Text.trimTripleQuotation
Expect.equal actual expected "Text after TextEdits is incorrect"
if recheckAfterAppliedTextEdits then
- let! (doc, _) = Server.createUntitledDocument actual (doc.Server |> Async.singleton)
- use doc = doc
- let! inlayHint = doc |> tryGetInlayHintAt pos
- Expect.isNone inlayHint "There shouldn't be a inlay hint after inserting inlay hint text edit"
- let! codeFix = doc |> tryGetCodeFixAt pos
- Expect.isNone codeFix "There shouldn't be a code fix after inserting code fix text edit"
+ do! recheckAfterAppliedEdits doc pos edits actual
}
let validateCodeFix (doc: Document, text, pos) (codeFix: CodeAction option) = async {
match expected with
@@ -1150,12 +1110,7 @@ module InlayHintAndExplicitType =
Expect.equal actual expected "Text after TextEdits is incorrect"
if recheckAfterAppliedTextEdits then
- let! (doc, _) = Server.createUntitledDocument actual (doc.Server |> Async.singleton)
- use doc = doc
- let! inlayHint = doc |> tryGetInlayHintAt pos
- Expect.isNone inlayHint "There shouldn't be a inlay hint after inserting inlay hint text edit"
- let! codeFix = doc |> tryGetCodeFixAt pos
- Expect.isNone codeFix "There shouldn't be a code fix after inserting code fix text edit"
+ do! recheckAfterAppliedEdits doc pos edits actual
}
checkInlayHintAndCodeFix server
From b71125ad5b657e15c41f8712f212c56c468e2198 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Fri, 24 Jun 2022 15:46:15 +0200
Subject: [PATCH 26/29] Remove `textDocument/inlayHint` because added to
`Ionide.LSP`
Note: usage requires updated Client too (vscode-languageclient 8)
---
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 3 ---
1 file changed, 3 deletions(-)
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 803146d29..8374238fc 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2767,9 +2767,6 @@ let startCore toolsPath stateStorageDir workspaceLoaderFactory =
|> Map.add "fsproj/addFileBelow" (serverRequestHandling (fun s p -> s.FsProjAddFileBelow(p)))
|> Map.add "fsproj/addFile" (serverRequestHandling (fun s p -> s.FsProjAddFile(p)))
|> Map.add "fsharp/inlayHints" (serverRequestHandling (fun s p -> s.FSharpInlayHints(p)))
- //TODO: Move to Ionide.LanguageServerProtocol with LSP 3.17
- |> Map.add "textDocument/inlayHint" (serverRequestHandling (fun s p -> s.TextDocumentInlayHint(p)))
- |> Map.add "inlayHint/resolve" (serverRequestHandling (fun s p -> s.InlayHintResolve(p)))
let state = State.Initial toolsPath stateStorageDir workspaceLoaderFactory
From cf59eddb197bb5e46912f3b73046e287dcbe19c1 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sun, 26 Jun 2022 20:58:45 +0200
Subject: [PATCH 27/29] Add test for fun variable
-> CodeFix, but no type hint
---
test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs | 11 +++++++++++
1 file changed, 11 insertions(+)
diff --git a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
index fc1029c33..60694d9ce 100644
--- a/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
+++ b/test/FsAutoComplete.Tests.Lsp/InlayHintTests.fs
@@ -1173,6 +1173,17 @@ let private inlayTypeHintAndAddExplicitTypeTests state =
Nothing
testList "hide type hint" [
+ testCaseAsync "CodeFix for func variable, but no type hint" <|
+ check server
+ """
+ let f$0 = fun a -> a + 1
+ """
+ (JustCodeFix
+ """
+ let f: int -> int = fun a -> a + 1
+ """
+ )
+
//ENHANCEMENT: add cases when Inlay Type Hint should not trigger (like `let str = "..."`?)
]
])
From d27a3b3126a10fb06de9b184b8dd43947b25f708 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sun, 26 Jun 2022 21:27:09 +0200
Subject: [PATCH 28/29] Format code
---
src/FsAutoComplete.Core/InlayHints.fs | 47 +-
.../Workaround/ServiceParseTreeWalk.fs | 1880 +++++++++--------
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 2 +-
3 files changed, 964 insertions(+), 965 deletions(-)
diff --git a/src/FsAutoComplete.Core/InlayHints.fs b/src/FsAutoComplete.Core/InlayHints.fs
index 602a77bb3..c366327b3 100644
--- a/src/FsAutoComplete.Core/InlayHints.fs
+++ b/src/FsAutoComplete.Core/InlayHints.fs
@@ -23,6 +23,7 @@ open FsAutoComplete.Core.Workaround.ServiceParseTreeWalk
let rec private traversePat (visitor: SyntaxVisitorBase<_>) origPath pat =
let defaultTraverse = defaultTraversePat visitor origPath
visitor.VisitPat(origPath, defaultTraverse, pat)
+
and private defaultTraversePat visitor origPath pat =
let path = SyntaxNode.SynPat pat :: origPath
@@ -43,9 +44,8 @@ and private defaultTraversePat visitor origPath pat =
ps
|> List.map (fun (_, _, pat) -> pat)
|> List.tryPick (traversePat visitor path)
- | SynPat.Typed (p, _ty, _) ->
- traversePat visitor path p
- // no access to `traverseSynType` -> no traversing into `ty`
+ | SynPat.Typed (p, _ty, _) -> traversePat visitor path p
+ // no access to `traverseSynType` -> no traversing into `ty`
| SynPat.Record (fieldPats = fieldPats) ->
fieldPats
|> List.map (fun (_, _, pat) -> pat)
@@ -502,28 +502,25 @@ let rec private getParensForPatternWithIdent (patternRange: Range) (identStart:
| SyntaxNode.SynPat (SynPat.ArrayOrList _) :: _ ->
// [x;y;z]
Parens.Optional patternRange
- | SyntaxNode.SynPat (SynPat.As _) :: SyntaxNode.SynPat (SynPat.Paren _) :: _ ->
- Parens.Optional patternRange
- | SyntaxNode.SynPat (SynPat.As (rhsPat = pat)) :: SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _
- when
- rangeContainsPos pat.Range identStart
- && rangeContainsPos headPat.Range identStart
- ->
- // let _ as value =
- // ->
- // let _ as value: int =
- // (new `: int` belongs to let binding, NOT as pattern)
- Parens.Optional patternRange
- | SyntaxNode.SynPat (SynPat.As (lhsPat = pat)) :: SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _
- when
- rangeContainsPos pat.Range identStart
- && rangeContainsPos headPat.Range identStart
- ->
- // let value as _ =
- // ->
- // let (value: int) as _ =
- // (`: int` belongs to as pattern, but let bindings tries to parse type annotation eagerly -> without parens let binding finished after `: int` -> as not pattern)
- Parens.Required patternRange
+ | SyntaxNode.SynPat (SynPat.As _) :: SyntaxNode.SynPat (SynPat.Paren _) :: _ -> Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As (rhsPat = pat)) :: SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _ when
+ rangeContainsPos pat.Range identStart
+ && rangeContainsPos headPat.Range identStart
+ ->
+ // let _ as value =
+ // ->
+ // let _ as value: int =
+ // (new `: int` belongs to let binding, NOT as pattern)
+ Parens.Optional patternRange
+ | SyntaxNode.SynPat (SynPat.As (lhsPat = pat)) :: SyntaxNode.SynBinding (SynBinding (headPat = headPat)) :: _ when
+ rangeContainsPos pat.Range identStart
+ && rangeContainsPos headPat.Range identStart
+ ->
+ // let value as _ =
+ // ->
+ // let (value: int) as _ =
+ // (`: int` belongs to as pattern, but let bindings tries to parse type annotation eagerly -> without parens let binding finished after `: int` -> as not pattern)
+ Parens.Required patternRange
| SyntaxNode.SynPat (SynPat.As (rhsPat = pat)) :: _ when rangeContainsPos pat.Range identStart ->
// _ as (value: int)
Parens.Required patternRange
diff --git a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
index 09f90086b..98d44f3f1 100644
--- a/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
+++ b/src/FsAutoComplete.Core/Workaround/ServiceParseTreeWalk.fs
@@ -22,22 +22,23 @@ open FSharp.Compiler.Text.Range
// Adjustments to compile with older FCS version
type SynLongIdent = LongIdentWithDots
-let SynLongIdent (id, r, _) = LongIdentWithDots (id, r)
+let SynLongIdent (id, r, _) = LongIdentWithDots(id, r)
+
type LongIdentWithDots with
- member lid.LongIdent = lid.Lid
-
+ member lid.LongIdent = lid.Lid
+
type private Range with
member m.ToShortString() =
sprintf "(%d,%d--%d,%d)" m.StartLine m.StartColumn m.EndLine m.EndColumn
+
let unionBindingAndMembers (bindings: SynBinding list) (members: SynMemberDefn list) : SynBinding list =
- [ yield! bindings
- yield!
- List.choose
- (function
- | SynMemberDefn.Member (b, _) -> Some b
- | _ -> None)
- members
- ]
+ [ yield! bindings
+ yield!
+ List.choose
+ (function
+ | SynMemberDefn.Member (b, _) -> Some b
+ | _ -> None)
+ members ]
let rec private stripParenTypes synType =
match synType with
@@ -66,966 +67,967 @@ let private (|StripParenTypes|) synType = stripParenTypes synType
[]
type SyntaxVisitorBase<'T>() =
- abstract VisitExpr:
- path: SyntaxVisitorPath * traverseSynExpr: (SynExpr -> 'T option) * defaultTraverse: (SynExpr -> 'T option) * synExpr: SynExpr ->
- 'T option
-
- default _.VisitExpr
- (
- path: SyntaxVisitorPath,
- traverseSynExpr: SynExpr -> 'T option,
- defaultTraverse: SynExpr -> 'T option,
- synExpr: SynExpr
- ) =
- ignore (path, traverseSynExpr, defaultTraverse, synExpr)
- None
-
- /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
- abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
-
- default _.VisitTypeAbbrev(path, synType, range) =
- ignore (path, synType, range)
- None
-
- /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
- abstract VisitImplicitInherit:
- path: SyntaxVisitorPath * defaultTraverse: (SynExpr -> 'T option) * inheritedType: SynType * synArgs: SynExpr * range: range ->
- 'T option
-
- default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
- ignore (path, inheritedType, range)
- defaultTraverse synArgs
-
- /// VisitModuleDecl allows overriding module declaration behavior
- abstract VisitModuleDecl:
- path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
-
- default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
- ignore path
- defaultTraverse synModuleDecl
-
- /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
- abstract VisitBinding: path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
-
- default _.VisitBinding(path, defaultTraverse, synBinding) =
- ignore path
- defaultTraverse synBinding
-
- /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
- abstract VisitMatchClause:
- path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
-
- default _.VisitMatchClause(path, defaultTraverse, matchClause) =
- ignore path
- defaultTraverse matchClause
-
- /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
- abstract VisitInheritSynMemberDefn:
- path: SyntaxVisitorPath * componentInfo: SynComponentInfo * typeDefnKind: SynTypeDefnKind * SynType * SynMemberDefns * range ->
- 'T option
+ abstract VisitExpr:
+ path: SyntaxVisitorPath *
+ traverseSynExpr: (SynExpr -> 'T option) *
+ defaultTraverse: (SynExpr -> 'T option) *
+ synExpr: SynExpr ->
+ 'T option
+
+ default _.VisitExpr
+ (
+ path: SyntaxVisitorPath,
+ traverseSynExpr: SynExpr -> 'T option,
+ defaultTraverse: SynExpr -> 'T option,
+ synExpr: SynExpr
+ ) =
+ ignore (path, traverseSynExpr, defaultTraverse, synExpr)
+ None
+
+ /// VisitTypeAbbrev(ty,m), defaults to ignoring this leaf of the AST
+ abstract VisitTypeAbbrev: path: SyntaxVisitorPath * synType: SynType * range: range -> 'T option
+
+ default _.VisitTypeAbbrev(path, synType, range) =
+ ignore (path, synType, range)
+ None
+
+ /// VisitImplicitInherit(defaultTraverse,ty,expr,m), defaults to just visiting expr
+ abstract VisitImplicitInherit:
+ path: SyntaxVisitorPath *
+ defaultTraverse: (SynExpr -> 'T option) *
+ inheritedType: SynType *
+ synArgs: SynExpr *
+ range: range ->
+ 'T option
+
+ default _.VisitImplicitInherit(path, defaultTraverse, inheritedType, synArgs, range) =
+ ignore (path, inheritedType, range)
+ defaultTraverse synArgs
+
+ /// VisitModuleDecl allows overriding module declaration behavior
+ abstract VisitModuleDecl:
+ path: SyntaxVisitorPath * defaultTraverse: (SynModuleDecl -> 'T option) * synModuleDecl: SynModuleDecl -> 'T option
+
+ default _.VisitModuleDecl(path, defaultTraverse, synModuleDecl) =
+ ignore path
+ defaultTraverse synModuleDecl
+
+ /// VisitBinding allows overriding binding behavior (note: by default it would defaultTraverse expression)
+ abstract VisitBinding:
+ path: SyntaxVisitorPath * defaultTraverse: (SynBinding -> 'T option) * synBinding: SynBinding -> 'T option
+
+ default _.VisitBinding(path, defaultTraverse, synBinding) =
+ ignore path
+ defaultTraverse synBinding
+
+ /// VisitMatchClause allows overriding clause behavior (note: by default it would defaultTraverse expression)
+ abstract VisitMatchClause:
+ path: SyntaxVisitorPath * defaultTraverse: (SynMatchClause -> 'T option) * matchClause: SynMatchClause -> 'T option
+
+ default _.VisitMatchClause(path, defaultTraverse, matchClause) =
+ ignore path
+ defaultTraverse matchClause
+
+ /// VisitInheritSynMemberDefn allows overriding inherit behavior (by default do nothing)
+ abstract VisitInheritSynMemberDefn:
+ path: SyntaxVisitorPath *
+ componentInfo: SynComponentInfo *
+ typeDefnKind: SynTypeDefnKind *
+ SynType *
+ SynMemberDefns *
+ range ->
+ 'T option
+
+ default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
+ ignore (path, componentInfo, typeDefnKind, synType, members, range)
+ None
+
+ /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
+ abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
+
+ default _.VisitRecordDefn(path, fields, range) =
+ ignore (path, fields, range)
+ None
+
+ /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
+ abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
+
+ default _.VisitUnionDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
+ abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
+
+ default _.VisitEnumDefn(path, cases, range) =
+ ignore (path, cases, range)
+ None
+
+ /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
+ abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
+
+ default _.VisitInterfaceSynMemberDefnType(path, synType) =
+ ignore (path, synType)
+ None
+
+ /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
+ abstract VisitRecordField:
+ path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: SynLongIdent option -> 'T option
+
+ default _.VisitRecordField(path, copyOpt, recordField) =
+ ignore (path, copyOpt, recordField)
+ None
+
+ /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
+ abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
+
+ default _.VisitHashDirective(path, hashDirective, range) =
+ ignore (path, hashDirective, range)
+ None
+
+ /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
+ abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
+
+ default _.VisitModuleOrNamespace(path, synModuleOrNamespace) =
+ ignore (path, synModuleOrNamespace)
+ None
+
+ /// VisitComponentInfo allows overriding behavior when visiting type component infos
+ abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
- default _.VisitInheritSynMemberDefn(path, componentInfo, typeDefnKind, synType, members, range) =
- ignore (path, componentInfo, typeDefnKind, synType, members, range)
- None
-
- /// VisitRecordDefn allows overriding behavior when visiting record definitions (by default do nothing)
- abstract VisitRecordDefn: path: SyntaxVisitorPath * fields: SynField list * range -> 'T option
-
- default _.VisitRecordDefn(path, fields, range) =
- ignore (path, fields, range)
- None
-
- /// VisitUnionDefn allows overriding behavior when visiting union definitions (by default do nothing)
- abstract VisitUnionDefn: path: SyntaxVisitorPath * cases: SynUnionCase list * range -> 'T option
-
- default _.VisitUnionDefn(path, cases, range) =
- ignore (path, cases, range)
- None
-
- /// VisitEnumDefn allows overriding behavior when visiting enum definitions (by default do nothing)
- abstract VisitEnumDefn: path: SyntaxVisitorPath * cases: SynEnumCase list * range -> 'T option
+ default _.VisitComponentInfo(path, synComponentInfo) =
+ ignore (path, synComponentInfo)
+ None
- default _.VisitEnumDefn(path, cases, range) =
- ignore (path, cases, range)
- None
-
- /// VisitInterfaceSynMemberDefnType allows overriding behavior for visiting interface member in types (by default - do nothing)
- abstract VisitInterfaceSynMemberDefnType: path: SyntaxVisitorPath * synType: SynType -> 'T option
-
- default _.VisitInterfaceSynMemberDefnType(path, synType) =
- ignore (path, synType)
- None
+ /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
+ abstract VisitLetOrUse:
+ path: SyntaxVisitorPath *
+ isRecursive: bool *
+ defaultTraverse: (SynBinding -> 'T option) *
+ bindings: SynBinding list *
+ range: range ->
+ 'T option
- /// VisitRecordField allows overriding behavior when visiting l.h.s. of constructed record instances
- abstract VisitRecordField: path: SyntaxVisitorPath * copyOpt: SynExpr option * recordField: SynLongIdent option -> 'T option
+ default _.VisitLetOrUse(path, isRecursive, defaultTraverse, bindings, range) =
+ ignore (path, isRecursive, defaultTraverse, bindings, range)
+ None
- default _.VisitRecordField(path, copyOpt, recordField) =
- ignore (path, copyOpt, recordField)
- None
+ /// VisitType allows overriding behavior when visiting simple pats
+ abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
- /// VisitHashDirective allows overriding behavior when visiting hash directives in FSX scripts, like #r, #load and #I.
- abstract VisitHashDirective: path: SyntaxVisitorPath * hashDirective: ParsedHashDirective * range: range -> 'T option
+ default _.VisitSimplePats(path, synPats) =
+ ignore (path, synPats)
+ None
- default _.VisitHashDirective(path, hashDirective, range) =
- ignore (path, hashDirective, range)
- None
+ /// VisitPat allows overriding behavior when visiting patterns
+ abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
- /// VisitModuleOrNamespace allows overriding behavior when visiting module or namespaces
- abstract VisitModuleOrNamespace: path: SyntaxVisitorPath * synModuleOrNamespace: SynModuleOrNamespace -> 'T option
+ default _.VisitPat(path, defaultTraverse, synPat) =
+ ignore path
+ defaultTraverse synPat
- default _.VisitModuleOrNamespace(path, synModuleOrNamespace) =
- ignore (path, synModuleOrNamespace)
- None
+ /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
+ abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
- /// VisitComponentInfo allows overriding behavior when visiting type component infos
- abstract VisitComponentInfo: path: SyntaxVisitorPath * synComponentInfo: SynComponentInfo -> 'T option
+ default _.VisitType(path, defaultTraverse, synType) =
+ ignore path
+ defaultTraverse synType
- default _.VisitComponentInfo(path, synComponentInfo) =
- ignore (path, synComponentInfo)
- None
+/// A range of utility functions to assist with traversing an AST
+module SyntaxTraversal =
- /// VisitLetOrUse allows overriding behavior when visiting module or local let or use bindings
- abstract VisitLetOrUse:
- path: SyntaxVisitorPath * isRecursive: bool * defaultTraverse: (SynBinding -> 'T option) * bindings: SynBinding list * range: range ->
- 'T option
+ // treat ranges as though they are half-open: [,)
+ let rangeContainsPosLeftEdgeInclusive (m1: range) p =
+ if posEq m1.Start m1.End then
+ // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
+ // we treat the range [n,n) as containing position n
+ posGeq p m1.Start && posGeq m1.End p
+ else
+ posGeq p m1.Start
+ && // [
+ posGt m1.End p // )
+
+ // treat ranges as though they are fully open: (,)
+ let rangeContainsPosEdgesExclusive (m1: range) p = posGt p m1.Start && posGt m1.End p
+
+ let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1: range) p = posGt p m1.Start && posGeq m1.End p
+
+ let dive node range project = range, (fun () -> project node)
+
+ let pick pos (outerRange: range) (debugObj: obj) (diveResults: (range * _) list) =
+ match diveResults with
+ | [] -> None
+ | _ ->
+ let isOrdered =
+#if DEBUG
+ // ranges in a dive-and-pick group should be ordered
+ diveResults
+ |> Seq.pairwise
+ |> Seq.forall (fun ((r1, _), (r2, _)) -> posGeq r2.Start r1.End)
+#else
+ true
+#endif
+ if not isOrdered then
+ let s =
+ sprintf
+ "ServiceParseTreeWalk: not isOrdered: %A"
+ (diveResults
+ |> List.map (fun (r, _) -> r.ToShortString()))
+
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let outerContainsInner =
+#if DEBUG
+ // ranges in a dive-and-pick group should be "under" the thing that contains them
+ let innerTotalRange =
+ diveResults
+ |> List.map fst
+ |> List.reduce unionRanges
- default _.VisitLetOrUse(path, isRecursive, defaultTraverse, bindings, range) =
- ignore (path, isRecursive, defaultTraverse, bindings, range)
+ rangeContainsRange outerRange innerTotalRange
+#else
+ ignore (outerRange)
+ true
+#endif
+ if not outerContainsInner then
+ let s =
+ sprintf
+ "ServiceParseTreeWalk: not outerContainsInner: %A : %A"
+ (outerRange.ToShortString())
+ (diveResults
+ |> List.map (fun (r, _) -> r.ToShortString()))
+
+ ignore s
+ //System.Diagnostics.Debug.Assert(false, s)
+ let isZeroWidth (r: range) = posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
+
+ match
+ List.choose
+ (fun (r, f) ->
+ if
+ rangeContainsPosLeftEdgeInclusive r pos
+ && not (isZeroWidth r)
+ then
+ Some(f)
+ else
+ None)
+ diveResults
+ with
+ | [] ->
+ // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
+ // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
+ let mutable e = diveResults.Head
+
+ for r in diveResults do
+ if posGt pos (fst r).Start then e <- r
+
+ snd (e) ()
+ | [ x ] -> x ()
+ | _ ->
+#if DEBUG
+ assert false
+ failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
+#else
+ ignore debugObj
None
+#endif
- /// VisitType allows overriding behavior when visiting simple pats
- abstract VisitSimplePats: path: SyntaxVisitorPath * synPats: SynSimplePat list -> 'T option
+ /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
+ ///
+ let Traverse (pos: pos, parseTree, visitor: SyntaxVisitorBase<'T>) =
+ let pick x = pick pos x
+
+ let rec traverseSynModuleDecl origPath (decl: SynModuleDecl) =
+ let pick = pick decl.Range
+
+ let defaultTraverse m =
+ let path = SyntaxNode.SynModule m :: origPath
+
+ match m with
+ | SynModuleDecl.ModuleAbbrev (_ident, _longIdent, _range) -> None
+ | SynModuleDecl.NestedModule (decls = synModuleDecls) ->
+ synModuleDecls
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
+ |> pick decl
+ | SynModuleDecl.Let (isRecursive, synBindingList, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None ->
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ |> pick decl
+ | SynModuleDecl.Expr (synExpr, _range) -> traverseSynExpr path synExpr
+ | SynModuleDecl.Types (synTypeDefnList, _range) ->
+ synTypeDefnList
+ |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path))
+ |> pick decl
+ | SynModuleDecl.Exception (_synExceptionDefn, _range) -> None
+ | SynModuleDecl.Open (_target, _range) -> None
+ | SynModuleDecl.Attributes (_synAttributes, _range) -> None
+ | SynModuleDecl.HashDirective (parsedHashDirective, range) ->
+ visitor.VisitHashDirective(path, parsedHashDirective, range)
+ | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) ->
+ traverseSynModuleOrNamespace path synModuleOrNamespace
+
+ visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
+
+ and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace (decls = synModuleDecls; range = range) as mors) =
+ match visitor.VisitModuleOrNamespace(origPath, mors) with
+ | Some x -> Some x
+ | None ->
+ let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
+
+ synModuleDecls
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
+ |> pick range mors
+
+ and traverseSynExpr origPath (expr: SynExpr) =
+ let pick = pick expr.Range
+
+ let defaultTraverse e =
+ let path = SyntaxNode.SynExpr e :: origPath
+ let traverseSynExpr = traverseSynExpr path
+ let traverseSynType = traverseSynType path
+ let traversePat = traversePat path
+
+ match e with
+
+ | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
+
+ | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
+ [ //dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Const (_synConst, _range) -> None
+
+ | SynExpr.InterpolatedString (parts, _, _) ->
+ [ for part in parts do
+ match part with
+ | SynInterpolatedStringPart.String _ -> ()
+ | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield dive fillExpr fillExpr.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Typed (synExpr, synType, _range) ->
+ match traverseSynExpr synExpr with
+ | None -> traverseSynType synType
+ | x -> x
+
+ | SynExpr.Tuple (_, synExprList, _, _range)
+ | SynExpr.ArrayOrList (_, synExprList, _range) ->
+ synExprList
+ |> List.map (fun x -> dive x x.Range traverseSynExpr)
+ |> pick expr
+
+ | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
+ [ match copyOpt with
+ | Some (expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+
+ yield
+ dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField(path, Some expr, None)
+ else
+ None)
+ | _ -> ()
+ for _, _, x in synExprList do
+ yield dive x x.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Record (inheritOpt, copyOpt, fields, _range) ->
+ [ let diveIntoSeparator offsideColumn scPosOpt copyOpt =
+ match scPosOpt with
+ | Some scPos ->
+ if posGeq pos scPos then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else
+ None
+ | None ->
+ //semicolon position is not available - use offside rule
+ if pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
+ else
+ None
+
+ match inheritOpt with
+ | Some (_ty, expr, _range, sepOpt, inheritRange) ->
+ // dive into argument
+ yield
+ dive expr expr.Range (fun expr ->
+ // special-case:caret is located in the offside position below inherit
+ // inherit A()
+ // $
+ if not (rangeContainsPos expr.Range pos)
+ && sepOpt.IsNone
+ && pos.Column = inheritRange.StartColumn then
+ visitor.VisitRecordField(path, None, None)
+ else
+ traverseSynExpr expr)
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield
+ dive () sep (fun () ->
+ // special case: caret is below 'inherit' + one or more fields are already defined
+ // inherit A()
+ // $
+ // field1 = 5
+ diveIntoSeparator inheritRange.StartColumn scPosOpt None)
+ | None -> ()
+ | _ -> ()
+
+ match copyOpt with
+ | Some (expr, (withRange, _)) ->
+ yield dive expr expr.Range traverseSynExpr
+
+ yield
+ dive () withRange (fun () ->
+ if posGeq pos withRange.End then
+ // special case: caret is after WITH
+ // { x with $ }
+ visitor.VisitRecordField(path, Some expr, None)
+ else
+ None)
+ | _ -> ()
+
+ let copyOpt = Option.map fst copyOpt
+
+ for SynExprRecordField (fieldName = (field, _); expr = e; blockSeparator = sepOpt) in fields do
+ yield
+ dive (path, copyOpt, Some field) field.Range (fun r ->
+ if rangeContainsPos field.Range pos then
+ visitor.VisitRecordField r
+ else
+ None)
+
+ let offsideColumn =
+ match inheritOpt with
+ | Some (_, _, _, _, inheritRange) -> inheritRange.StartColumn
+ | None -> field.Range.StartColumn
+
+ match e with
+ | Some e ->
+ yield
+ dive e e.Range (fun expr ->
+ // special case: caret is below field binding
+ // field x = 5
+ // $
+ if not (rangeContainsPos e.Range pos)
+ && sepOpt.IsNone
+ && pos.Column = offsideColumn then
+ visitor.VisitRecordField(path, copyOpt, None)
+ else
+ traverseSynExpr expr)
+ | None -> ()
+
+ match sepOpt with
+ | Some (sep, scPosOpt) ->
+ yield
+ dive () sep (fun () ->
+ // special case: caret is between field bindings
+ // field1 = 5
+ // $
+ // field2 = 5
+ diveIntoSeparator offsideColumn scPosOpt copyOpt)
+ | _ -> ()
+
+ ]
+ |> pick expr
+
+ | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
+ | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) ->
+ let binds = unionBindingAndMembers binds ms
+
+ let result =
+ ifaces
+ |> Seq.map (fun (SynInterfaceImpl (interfaceTy = ty)) -> ty)
+ |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
+
+ if result.IsSome then
+ result
+ else
+ [ match baseCallOpt with
+ | Some (expr, _) ->
+ // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
+ let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range)
+ yield dive newCall newCall.Range traverseSynExpr
+ | _ -> ()
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
+ for SynInterfaceImpl (bindings = binds) in ifaces do
+ for b in binds do
+ yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path) ]
+ |> pick expr
+
+ | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.For (identBody = synExpr; toBody = synExpr2; doBody = synExpr3) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
+ [ dive synPat synPat.Range traversePat
+ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ComputationExpr (_, synExpr, _range) ->
+ // now parser treats this syntactic expression as computation expression
+ // { identifier }
+ // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
+ // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
+ let isPartOfArrayOrList =
+ match origPath with
+ | SyntaxNode.SynExpr (SynExpr.ArrayOrListComputed _) :: _ -> true
+ | _ -> false
+
+ let ok =
+ match isPartOfArrayOrList, synExpr with
+ | false, SynExpr.Ident ident ->
+ visitor.VisitRecordField(path, None, Some(SynLongIdent([ ident ], [], [ None ])))
+ | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
+ | _ -> None
+
+ if ok.IsSome then
+ ok
+ else
+ traverseSynExpr synExpr
+
+ | SynExpr.Lambda (args = synSimplePats; body = synExpr) ->
+ match synSimplePats with
+ | SynSimplePats.SimplePats (pats, _) ->
+ match visitor.VisitSimplePats(path, pats) with
+ | None -> traverseSynExpr synExpr
+ | x -> x
+ | _ -> traverseSynExpr synExpr
+
+ | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) ->
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
+ |> pick expr
+
+ | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
+ |> pick expr
+
+ | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
+
+ // | SynExpr.Dynamic _ -> None
+
+ | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
+ if isInfix then
+ [ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr synExpr.Range traverseSynExpr ] // reverse the args
+ |> pick expr
+ else
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | None ->
+ [ yield!
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ yield dive synExpr synExpr.Range traverseSynExpr ]
+ |> pick expr
+ | x -> x
+
+ | SynExpr.TryWith (tryExpr = synExpr; withCases = synMatchClauseList) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
+ |> pick expr
+
+ | SynExpr.TryFinally (tryExpr = synExpr; finallyExpr = synExpr2) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
+
+ | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.IfThenElse (ifExpr = synExpr; thenExpr = synExpr2; elseExpr = synExprOpt) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr
+ match synExprOpt with
+ | None -> ()
+ | Some x -> yield dive x x.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.Ident _ident -> None
+
+ | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
- default _.VisitSimplePats(path, synPats) =
- ignore (path, synPats)
- None
+ | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
- /// VisitPat allows overriding behavior when visiting patterns
- abstract VisitPat: path: SyntaxVisitorPath * defaultTraverse: (SynPat -> 'T option) * synPat: SynPat -> 'T option
+ | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
- default _.VisitPat(path, defaultTraverse, synPat) =
- ignore path
- defaultTraverse synPat
+ | SynExpr.Set (synExpr, synExpr2, _)
- /// VisitType allows overriding behavior when visiting type hints (x: ..., etc.)
- abstract VisitType: path: SyntaxVisitorPath * defaultTraverse: (SynType -> 'T option) * synType: SynType -> 'T option
+ | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
- default _.VisitType(path, defaultTraverse, synType) =
- ignore path
- defaultTraverse synType
+ | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
+ [ match expr1 with
+ | Some e -> dive e e.Range traverseSynExpr
+ | None -> ()
+ match expr2 with
+ | Some e -> dive e e.Range traverseSynExpr
+ | None -> () ]
+ |> pick expr
-/// A range of utility functions to assist with traversing an AST
-module SyntaxTraversal =
+ | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e
- // treat ranges as though they are half-open: [,)
- let rangeContainsPosLeftEdgeInclusive (m1: range) p =
- if posEq m1.Start m1.End then
- // the parser doesn't produce zero-width ranges, except in one case, for e.g. a block of lets that lacks a body
- // we treat the range [n,n) as containing position n
- posGeq p m1.Start && posGeq m1.End p
- else
- posGeq p m1.Start
- && // [
- posGt m1.End p // )
+ | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr ]
+ |> pick expr
- // treat ranges as though they are fully open: (,)
- let rangeContainsPosEdgesExclusive (m1: range) p = posGt p m1.Start && posGt m1.End p
+ | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield dive indexArgs indexArgs.Range traverseSynExpr
+ yield dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
- let rangeContainsPosLeftEdgeExclusiveAndRightEdgeInclusive (m1: range) p = posGt p m1.Start && posGeq m1.End p
+ | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
+ [ dive synExpr1 synExpr1.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
- let dive node range project = range, (fun () -> project node)
+ | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
- let pick pos (outerRange: range) (debugObj: obj) (diveResults: (range * _) list) =
- match diveResults with
- | [] -> None
- | _ ->
- let isOrdered =
+ | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synExpr2 synExpr2.Range traverseSynExpr
+ dive synExpr3 synExpr3.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.TypeTest (synExpr, synType, _range)
+
+ | SynExpr.Upcast (synExpr, synType, _range)
+
+ | SynExpr.Downcast (synExpr, synType, _range) ->
+ [ dive synExpr synExpr.Range traverseSynExpr
+ dive synType synType.Range traverseSynType ]
+ |> pick expr
+
+ | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.Null _range -> None
+
+ | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
+
+ | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.ImplicitZero _range -> None
+
+ | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LetOrUseBang (pat = synPat; rhs = synExpr; andBangs = andBangSynExprs; body = synExpr2) ->
+ [ yield dive synPat synPat.Range traversePat
+ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ [ for SynExprAndBang (pat = andBangSynPat; body = andBangSynExpr) in andBangSynExprs do
+ yield (dive andBangSynPat andBangSynPat.Range traversePat)
+ yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr) ]
+ yield dive synExpr2 synExpr2.Range traverseSynExpr ]
+ |> pick expr
+
+ | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
+ [ yield dive synExpr synExpr.Range traverseSynExpr
+ yield!
+ synMatchClauseList
+ |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path)) ]
+ |> pick expr
+
+ | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.LibraryOnlyILAssembly _ -> None
+
+ | SynExpr.LibraryOnlyStaticOptimization _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
+
+ | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
+
+ | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
+
+ | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
+
+ | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
+
+ visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
+
+ and traversePat origPath (pat: SynPat) =
+ let defaultTraverse p =
+ let path = SyntaxNode.SynPat p :: origPath
+
+ match p with
+ | SynPat.Paren (p, _) -> traversePat path p
+ | SynPat.As (p1, p2, _)
+ | SynPat.Or (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path)
+ | SynPat.Ands (ps, _)
+ | SynPat.Tuple (_, ps, _)
+ | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
+ | SynPat.Attrib (p, _, _) -> traversePat path p
+ | SynPat.LongIdent (argPats = args) ->
+ match args with
+ | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
+ | SynArgPats.NamePatPairs (ps, _) ->
+ ps
+ |> List.map (fun (_, _, pat) -> pat)
+ |> List.tryPick (traversePat path)
+ | SynPat.Typed (p, ty, _) ->
+ match traversePat path p with
+ | None -> traverseSynType path ty
+ | x -> x
+ | _ -> None
+
+ visitor.VisitPat(origPath, defaultTraverse, pat)
+
+ and traverseSynType origPath (StripParenTypes ty) =
+ let defaultTraverse ty =
+ let path = SyntaxNode.SynType ty :: origPath
+
+ match ty with
+ | SynType.App (typeName, _, typeArgs, _, _, _, _)
+ | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
+ [ yield typeName; yield! typeArgs ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.Fun (ty1, ty2, _) ->
+ [ ty1; ty2 ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.MeasurePower (ty, _, _)
+ | SynType.HashConstraint (ty, _)
+ | SynType.WithGlobalConstraints (ty, _, _)
+ | SynType.Array (_, ty, _) -> traverseSynType path ty
+ | SynType.StaticConstantNamed (ty1, ty2, _)
+ | SynType.MeasureDivide (ty1, ty2, _) ->
+ [ ty1; ty2 ]
+ |> List.tryPick (traverseSynType path)
+ | SynType.Tuple (_, tys, _) ->
+ tys
+ |> List.map snd
+ |> List.tryPick (traverseSynType path)
+ | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
+ | SynType.Anon _ -> None
+ | _ -> None
+
+ visitor.VisitType(origPath, defaultTraverse, ty)
+
+ and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters
+ path
+ traverseInherit
+ (synMemberDefns: SynMemberDefns)
+ =
+ synMemberDefns
+ // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
+ |> Seq.groupBy (fun x -> x.Range)
+ |> Seq.choose (fun (r, mems) ->
+ match mems |> Seq.toList with
+ | [ mem ] -> // the typical case, a single member has this range 'r'
+ Some(dive mem r (traverseSynMemberDefn path traverseInherit))
+ | [ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1
+ extraId = Some (info1)))) as mem1
+ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2
+ extraId = Some (info2)))) as mem2 ] -> // can happen if one is a getter and one is a setter
+ // ensure same long id
+ assert
+ ((lid1.LongIdent, lid2.LongIdent)
+ ||> List.forall2 (fun x y -> x.idText = y.idText))
+ // ensure one is getter, other is setter
+ assert
+ ((info1.idText = "set" && info2.idText = "get")
+ || (info2.idText = "set" && info1.idText = "get"))
+
+ Some(
+ r,
+ (fun () ->
+ // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
+ match traverseSynMemberDefn path (fun _ -> None) mem1 with
+ | Some _ as x -> x
+ | _ -> traverseSynMemberDefn path (fun _ -> None) mem2)
+ )
+ | [] ->
#if DEBUG
- // ranges in a dive-and-pick group should be ordered
- diveResults
- |> Seq.pairwise
- |> Seq.forall (fun ((r1, _), (r2, _)) -> posGeq r2.Start r1.End)
+ assert false
+ failwith "impossible, Seq.groupBy never returns empty results"
#else
- true
+ // swallow AST error and recover silently
+ None
#endif
- if not isOrdered then
- let s =
- sprintf "ServiceParseTreeWalk: not isOrdered: %A" (diveResults |> List.map (fun (r, _) -> r.ToShortString()))
-
- ignore s
- //System.Diagnostics.Debug.Assert(false, s)
- let outerContainsInner =
-#if DEBUG
- // ranges in a dive-and-pick group should be "under" the thing that contains them
- let innerTotalRange = diveResults |> List.map fst |> List.reduce unionRanges
- rangeContainsRange outerRange innerTotalRange
-#else
- ignore (outerRange)
- true
-#endif
- if not outerContainsInner then
- let s =
- sprintf
- "ServiceParseTreeWalk: not outerContainsInner: %A : %A"
- (outerRange.ToShortString())
- (diveResults |> List.map (fun (r, _) -> r.ToShortString()))
-
- ignore s
- //System.Diagnostics.Debug.Assert(false, s)
- let isZeroWidth (r: range) = posEq r.Start r.End // the parser inserts some zero-width elements to represent the completions of incomplete constructs, but we should never 'dive' into them, since they don't represent actual user code
-
- match
- List.choose
- (fun (r, f) ->
- if rangeContainsPosLeftEdgeInclusive r pos && not (isZeroWidth r) then
- Some(f)
- else
- None)
- diveResults
- with
- | [] ->
- // No entity's range contained the desired position. However the ranges in the parse tree only span actual characters present in the file.
- // The cursor may be at whitespace between entities or after everything, so find the nearest entity with the range left of the position.
- let mutable e = diveResults.Head
-
- for r in diveResults do
- if posGt pos (fst r).Start then e <- r
-
- snd (e) ()
- | [ x ] -> x ()
- | _ ->
+ | _ ->
#if DEBUG
- assert false
- failwithf "multiple disjoint AST node ranges claimed to contain (%A) from %+A" pos debugObj
+ assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
+ failwith "bug in AST"
#else
- ignore debugObj
- None
+ // swallow AST error and recover silently
+ None
#endif
-
- /// traverse an implementation file walking all the way down to SynExpr or TypeAbbrev at a particular location
- ///
- let Traverse (pos: pos, parseTree, visitor: SyntaxVisitorBase<'T>) =
- let pick x = pick pos x
-
- let rec traverseSynModuleDecl origPath (decl: SynModuleDecl) =
- let pick = pick decl.Range
-
- let defaultTraverse m =
- let path = SyntaxNode.SynModule m :: origPath
-
- match m with
- | SynModuleDecl.ModuleAbbrev (_ident, _longIdent, _range) -> None
- | SynModuleDecl.NestedModule (decls = synModuleDecls) ->
- synModuleDecls
- |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
- |> pick decl
- | SynModuleDecl.Let (isRecursive, synBindingList, range) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | Some x -> Some x
- | None ->
- synBindingList
- |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- |> pick decl
- | SynModuleDecl.Expr (synExpr, _range) -> traverseSynExpr path synExpr
- | SynModuleDecl.Types (synTypeDefnList, _range) ->
- synTypeDefnList
- |> List.map (fun x -> dive x x.Range (traverseSynTypeDefn path))
- |> pick decl
- | SynModuleDecl.Exception (_synExceptionDefn, _range) -> None
- | SynModuleDecl.Open (_target, _range) -> None
- | SynModuleDecl.Attributes (_synAttributes, _range) -> None
- | SynModuleDecl.HashDirective (parsedHashDirective, range) -> visitor.VisitHashDirective(path, parsedHashDirective, range)
- | SynModuleDecl.NamespaceFragment (synModuleOrNamespace) -> traverseSynModuleOrNamespace path synModuleOrNamespace
-
- visitor.VisitModuleDecl(origPath, defaultTraverse, decl)
-
- and traverseSynModuleOrNamespace origPath (SynModuleOrNamespace (decls = synModuleDecls; range = range) as mors) =
- match visitor.VisitModuleOrNamespace(origPath, mors) with
- | Some x -> Some x
- | None ->
- let path = SyntaxNode.SynModuleOrNamespace mors :: origPath
-
- synModuleDecls
- |> List.map (fun x -> dive x x.Range (traverseSynModuleDecl path))
- |> pick range mors
-
- and traverseSynExpr origPath (expr: SynExpr) =
- let pick = pick expr.Range
-
- let defaultTraverse e =
- let path = SyntaxNode.SynExpr e :: origPath
- let traverseSynExpr = traverseSynExpr path
- let traverseSynType = traverseSynType path
- let traversePat = traversePat path
-
- match e with
-
- | SynExpr.Paren (synExpr, _, _, _parenRange) -> traverseSynExpr synExpr
-
- | SynExpr.Quote (_synExpr, _, synExpr2, _, _range) ->
- [ //dive synExpr synExpr.Range traverseSynExpr // TODO, what is this?
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.Const (_synConst, _range) -> None
-
- | SynExpr.InterpolatedString (parts, _, _) ->
- [
- for part in parts do
- match part with
- | SynInterpolatedStringPart.String _ -> ()
- | SynInterpolatedStringPart.FillExpr (fillExpr, _) -> yield dive fillExpr fillExpr.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.Typed (synExpr, synType, _range) ->
- match traverseSynExpr synExpr with
- | None -> traverseSynType synType
- | x -> x
-
- | SynExpr.Tuple (_, synExprList, _, _range)
- | SynExpr.ArrayOrList (_, synExprList, _range) ->
- synExprList |> List.map (fun x -> dive x x.Range traverseSynExpr) |> pick expr
-
- | SynExpr.AnonRecd (_isStruct, copyOpt, synExprList, _range) ->
- [
- match copyOpt with
- | Some (expr, (withRange, _)) ->
- yield dive expr expr.Range traverseSynExpr
-
- yield
- dive () withRange (fun () ->
- if posGeq pos withRange.End then
- // special case: caret is after WITH
- // { x with $ }
- visitor.VisitRecordField(path, Some expr, None)
- else
- None)
- | _ -> ()
- for _, _, x in synExprList do
- yield dive x x.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.Record (inheritOpt, copyOpt, fields, _range) ->
- [
- let diveIntoSeparator offsideColumn scPosOpt copyOpt =
- match scPosOpt with
- | Some scPos ->
- if posGeq pos scPos then
- visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
- else
- None
- | None ->
- //semicolon position is not available - use offside rule
- if pos.Column = offsideColumn then
- visitor.VisitRecordField(path, copyOpt, None) // empty field after the inherits
- else
- None
-
- match inheritOpt with
- | Some (_ty, expr, _range, sepOpt, inheritRange) ->
- // dive into argument
- yield
- dive expr expr.Range (fun expr ->
- // special-case:caret is located in the offside position below inherit
- // inherit A()
- // $
- if not (rangeContainsPos expr.Range pos)
- && sepOpt.IsNone
- && pos.Column = inheritRange.StartColumn then
- visitor.VisitRecordField(path, None, None)
- else
- traverseSynExpr expr)
-
- match sepOpt with
- | Some (sep, scPosOpt) ->
- yield
- dive () sep (fun () ->
- // special case: caret is below 'inherit' + one or more fields are already defined
- // inherit A()
- // $
- // field1 = 5
- diveIntoSeparator inheritRange.StartColumn scPosOpt None)
- | None -> ()
- | _ -> ()
-
- match copyOpt with
- | Some (expr, (withRange, _)) ->
- yield dive expr expr.Range traverseSynExpr
-
- yield
- dive () withRange (fun () ->
- if posGeq pos withRange.End then
- // special case: caret is after WITH
- // { x with $ }
- visitor.VisitRecordField(path, Some expr, None)
- else
- None)
- | _ -> ()
-
- let copyOpt = Option.map fst copyOpt
-
- for SynExprRecordField (fieldName = (field, _); expr = e; blockSeparator = sepOpt) in fields do
- yield
- dive (path, copyOpt, Some field) field.Range (fun r ->
- if rangeContainsPos field.Range pos then
- visitor.VisitRecordField r
- else
- None)
-
- let offsideColumn =
- match inheritOpt with
- | Some (_, _, _, _, inheritRange) -> inheritRange.StartColumn
- | None -> field.Range.StartColumn
-
- match e with
- | Some e ->
- yield
- dive e e.Range (fun expr ->
- // special case: caret is below field binding
- // field x = 5
- // $
- if not (rangeContainsPos e.Range pos)
- && sepOpt.IsNone
- && pos.Column = offsideColumn then
- visitor.VisitRecordField(path, copyOpt, None)
- else
- traverseSynExpr expr)
- | None -> ()
-
- match sepOpt with
- | Some (sep, scPosOpt) ->
- yield
- dive () sep (fun () ->
- // special case: caret is between field bindings
- // field1 = 5
- // $
- // field2 = 5
- diveIntoSeparator offsideColumn scPosOpt copyOpt)
- | _ -> ()
-
- ]
- |> pick expr
-
- | SynExpr.New (_, _synType, synExpr, _range) -> traverseSynExpr synExpr
- | SynExpr.ObjExpr (objType = ty; argOptions = baseCallOpt; bindings = binds; members = ms; extraImpls = ifaces) ->
- let binds = unionBindingAndMembers binds ms
-
- let result =
- ifaces
- |> Seq.map (fun (SynInterfaceImpl (interfaceTy = ty)) -> ty)
- |> Seq.tryPick (fun ty -> visitor.VisitInterfaceSynMemberDefnType(path, ty))
-
- if result.IsSome then
- result
- else
- [
- match baseCallOpt with
- | Some (expr, _) ->
- // this is like a call to 'new', so mock up a 'new' so we can recurse and use that existing logic
- let newCall = SynExpr.New(false, ty, expr, unionRanges ty.Range expr.Range)
- yield dive newCall newCall.Range traverseSynExpr
- | _ -> ()
- for b in binds do
- yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
- for SynInterfaceImpl (bindings = binds) in ifaces do
- for b in binds do
- yield dive b b.RangeOfBindingWithRhs (traverseSynBinding path)
- ]
- |> pick expr
-
- | SynExpr.While (_spWhile, synExpr, synExpr2, _range) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.For (identBody = synExpr; toBody = synExpr2; doBody = synExpr3) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr3 synExpr3.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.ForEach (_spFor, _spIn, _seqExprOnly, _isFromSource, synPat, synExpr, synExpr2, _range) ->
- [
- dive synPat synPat.Range traversePat
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.ArrayOrListComputed (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.ComputationExpr (_, synExpr, _range) ->
- // now parser treats this syntactic expression as computation expression
- // { identifier }
- // here we detect this situation and treat ComputationExpr { Identifier } as attempt to create record
- // note: sequence expressions use SynExpr.ComputationExpr too - they need to be filtered out
- let isPartOfArrayOrList =
- match origPath with
- | SyntaxNode.SynExpr (SynExpr.ArrayOrListComputed _) :: _ -> true
- | _ -> false
-
- let ok =
- match isPartOfArrayOrList, synExpr with
- | false, SynExpr.Ident ident -> visitor.VisitRecordField(path, None, Some(SynLongIdent([ ident ], [], [ None ])))
- | false, SynExpr.LongIdent (false, lidwd, _, _) -> visitor.VisitRecordField(path, None, Some lidwd)
- | _ -> None
-
- if ok.IsSome then ok else traverseSynExpr synExpr
-
- | SynExpr.Lambda (args = synSimplePats; body = synExpr) ->
- match synSimplePats with
- | SynSimplePats.SimplePats (pats, _) ->
- match visitor.VisitSimplePats(path, pats) with
- | None -> traverseSynExpr synExpr
- | x -> x
- | _ -> traverseSynExpr synExpr
-
- | SynExpr.MatchLambda (_isExnMatch, _argm, synMatchClauseList, _spBind, _wholem) ->
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
- |> pick expr
-
- | SynExpr.Match (expr = synExpr; clauses = synMatchClauseList) ->
- [
- yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
- ]
- |> pick expr
-
- | SynExpr.Do (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Assert (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Fixed (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DebugPoint (_, _, synExpr) -> traverseSynExpr synExpr
-
- // | SynExpr.Dynamic _ -> None
-
- | SynExpr.App (_exprAtomicFlag, isInfix, synExpr, synExpr2, _range) ->
- if isInfix then
- [
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr synExpr.Range traverseSynExpr
- ] // reverse the args
- |> pick expr
- else
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.TypeApp (synExpr, _, _synTypeList, _commas, _, _, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LetOrUse (_, isRecursive, synBindingList, synExpr, range, _) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | None ->
- [
- yield!
- synBindingList
- |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- yield dive synExpr synExpr.Range traverseSynExpr
- ]
- |> pick expr
- | x -> x
-
- | SynExpr.TryWith (tryExpr = synExpr; withCases = synMatchClauseList) ->
- [
- yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
- ]
- |> pick expr
-
- | SynExpr.TryFinally (tryExpr = synExpr; finallyExpr = synExpr2) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.Lazy (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.SequentialOrImplicitYield (_sequencePointInfoForSequential, synExpr, synExpr2, _, _range)
-
- | SynExpr.Sequential (_sequencePointInfoForSequential, _, synExpr, synExpr2, _range) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.IfThenElse (ifExpr = synExpr; thenExpr = synExpr2; elseExpr = synExprOpt) ->
- [
- yield dive synExpr synExpr.Range traverseSynExpr
- yield dive synExpr2 synExpr2.Range traverseSynExpr
- match synExprOpt with
- | None -> ()
- | Some x -> yield dive x x.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.Ident _ident -> None
-
- | SynExpr.LongIdent (_, _longIdent, _altNameRefCell, _range) -> None
-
- | SynExpr.LongIdentSet (_longIdent, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DotGet (synExpr, _dotm, _longIdent, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Set (synExpr, synExpr2, _)
-
- | SynExpr.DotSet (synExpr, _, synExpr2, _) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.IndexRange (expr1, _, expr2, _, _, _) ->
- [
- match expr1 with
- | Some e -> dive e e.Range traverseSynExpr
- | None -> ()
- match expr2 with
- | Some e -> dive e e.Range traverseSynExpr
- | None -> ()
- ]
- |> pick expr
-
- | SynExpr.IndexFromEnd (e, _) -> traverseSynExpr e
-
- | SynExpr.DotIndexedGet (synExpr, indexArgs, _range, _range2) ->
- [
- yield dive synExpr synExpr.Range traverseSynExpr
- yield dive indexArgs indexArgs.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.DotIndexedSet (synExpr, indexArgs, synExpr2, _, _range, _range2) ->
- [
- yield dive synExpr synExpr.Range traverseSynExpr
- yield dive indexArgs indexArgs.Range traverseSynExpr
- yield dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.JoinIn (synExpr1, _range, synExpr2, _range2) ->
- [
- dive synExpr1 synExpr1.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.NamedIndexedPropertySet (_longIdent, synExpr, synExpr2, _range) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.DotNamedIndexedPropertySet (synExpr, _longIdent, synExpr2, synExpr3, _range) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synExpr2 synExpr2.Range traverseSynExpr
- dive synExpr3 synExpr3.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.TypeTest (synExpr, synType, _range)
-
- | SynExpr.Upcast (synExpr, synType, _range)
-
- | SynExpr.Downcast (synExpr, synType, _range) ->
- [
- dive synExpr synExpr.Range traverseSynExpr
- dive synType synType.Range traverseSynType
- ]
- |> pick expr
-
- | SynExpr.InferredUpcast (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.InferredDowncast (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.Null _range -> None
-
- | SynExpr.AddressOf (_, synExpr, _range, _range2) -> traverseSynExpr synExpr
-
- | SynExpr.TraitCall (_synTyparList, _synMemberSig, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.ImplicitZero _range -> None
-
- | SynExpr.YieldOrReturn (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.YieldOrReturnFrom (_, synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LetOrUseBang (pat = synPat; rhs = synExpr; andBangs = andBangSynExprs; body = synExpr2) ->
- [
- yield dive synPat synPat.Range traversePat
- yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- [
- for SynExprAndBang (pat = andBangSynPat; body = andBangSynExpr) in andBangSynExprs do
- yield (dive andBangSynPat andBangSynPat.Range traversePat)
- yield (dive andBangSynExpr andBangSynExpr.Range traverseSynExpr)
- ]
- yield dive synExpr2 synExpr2.Range traverseSynExpr
- ]
- |> pick expr
-
- | SynExpr.MatchBang (expr = synExpr; clauses = synMatchClauseList) ->
- [
- yield dive synExpr synExpr.Range traverseSynExpr
- yield!
- synMatchClauseList
- |> List.map (fun x -> dive x x.Range (traverseSynMatchClause path))
- ]
- |> pick expr
-
- | SynExpr.DoBang (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.LibraryOnlyILAssembly _ -> None
-
- | SynExpr.LibraryOnlyStaticOptimization _ -> None
-
- | SynExpr.LibraryOnlyUnionCaseFieldGet _ -> None
-
- | SynExpr.LibraryOnlyUnionCaseFieldSet _ -> None
-
- | SynExpr.ArbitraryAfterError (_debugStr, _range) -> None
-
- | SynExpr.FromParseError (synExpr, _range) -> traverseSynExpr synExpr
-
- | SynExpr.DiscardAfterMissingQualificationAfterDot (synExpr, _range) -> traverseSynExpr synExpr
-
- visitor.VisitExpr(origPath, traverseSynExpr origPath, defaultTraverse, expr)
-
- and traversePat origPath (pat: SynPat) =
- let defaultTraverse p =
- let path = SyntaxNode.SynPat p :: origPath
-
- match p with
- | SynPat.Paren (p, _) -> traversePat path p
- | SynPat.As (p1, p2, _)
- | SynPat.Or (p1, p2, _, _) -> [ p1; p2 ] |> List.tryPick (traversePat path)
- | SynPat.Ands (ps, _)
- | SynPat.Tuple (_, ps, _)
- | SynPat.ArrayOrList (_, ps, _) -> ps |> List.tryPick (traversePat path)
- | SynPat.Attrib (p, _, _) -> traversePat path p
- | SynPat.LongIdent (argPats = args) ->
- match args with
- | SynArgPats.Pats ps -> ps |> List.tryPick (traversePat path)
- | SynArgPats.NamePatPairs (ps, _) -> ps |> List.map (fun (_, _, pat) -> pat) |> List.tryPick (traversePat path)
- | SynPat.Typed (p, ty, _) ->
- match traversePat path p with
- | None -> traverseSynType path ty
- | x -> x
- | _ -> None
-
- visitor.VisitPat(origPath, defaultTraverse, pat)
-
- and traverseSynType origPath (StripParenTypes ty) =
- let defaultTraverse ty =
- let path = SyntaxNode.SynType ty :: origPath
-
- match ty with
- | SynType.App (typeName, _, typeArgs, _, _, _, _)
- | SynType.LongIdentApp (typeName, _, _, typeArgs, _, _, _) ->
- [ yield typeName; yield! typeArgs ] |> List.tryPick (traverseSynType path)
- | SynType.Fun (ty1, ty2, _) -> [ ty1; ty2 ] |> List.tryPick (traverseSynType path)
- | SynType.MeasurePower (ty, _, _)
- | SynType.HashConstraint (ty, _)
- | SynType.WithGlobalConstraints (ty, _, _)
- | SynType.Array (_, ty, _) -> traverseSynType path ty
- | SynType.StaticConstantNamed (ty1, ty2, _)
- | SynType.MeasureDivide (ty1, ty2, _) -> [ ty1; ty2 ] |> List.tryPick (traverseSynType path)
- | SynType.Tuple (_, tys, _) -> tys |> List.map snd |> List.tryPick (traverseSynType path)
- | SynType.StaticConstantExpr (expr, _) -> traverseSynExpr [] expr
- | SynType.Anon _ -> None
- | _ -> None
-
- visitor.VisitType(origPath, defaultTraverse, ty)
-
- and normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit (synMemberDefns: SynMemberDefns) =
+ )
+
+ and traverseSynTypeDefn
+ origPath
+ (SynTypeDefn (synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef)
+ =
+ let path = SyntaxNode.SynTypeDefn tydef :: origPath
+
+ match visitor.VisitComponentInfo(origPath, synComponentInfo) with
+ | Some x -> Some x
+ | None ->
+ [ match synTypeDefnRepr with
+ | SynTypeDefnRepr.Exception _ ->
+ // This node is generated in CheckExpressions.fs, not in the AST.
+ // But note exception declarations are missing from this tree walk.
+ ()
+ | SynTypeDefnRepr.ObjectModel (synTypeDefnKind, synMemberDefns, _oRange) ->
+ // traverse inherit function is used to capture type specific data required for processing Inherit part
+ let traverseInherit (synType: SynType, range: range) =
+ visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
+
+ yield!
+ synMemberDefns
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
+ | SynTypeDefnRepr.Simple (synTypeDefnSimpleRepr, _range) ->
+ match synTypeDefnSimpleRepr with
+ | SynTypeDefnSimpleRepr.Record (_synAccessOption, fields, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
+ | SynTypeDefnSimpleRepr.Union (_synAccessOption, cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.Enum (cases, m) ->
+ yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
+ | SynTypeDefnSimpleRepr.TypeAbbrev (_, synType, m) ->
+ yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
+ | _ -> ()
+ yield!
synMemberDefns
- // property getters are setters are two members that can have the same range, so do some somersaults to deal with this
- |> Seq.groupBy (fun x -> x.Range)
- |> Seq.choose (fun (r, mems) ->
- match mems |> Seq.toList with
- | [ mem ] -> // the typical case, a single member has this range 'r'
- Some(dive mem r (traverseSynMemberDefn path traverseInherit))
- | [ SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid1; extraId = Some (info1)))) as mem1
- SynMemberDefn.Member(memberDefn = SynBinding(headPat = SynPat.LongIdent (longDotId = lid2; extraId = Some (info2)))) as mem2 ] -> // can happen if one is a getter and one is a setter
- // ensure same long id
- assert
- ((lid1.LongIdent, lid2.LongIdent)
- ||> List.forall2 (fun x y -> x.idText = y.idText))
- // ensure one is getter, other is setter
- assert
- ((info1.idText = "set" && info2.idText = "get")
- || (info2.idText = "set" && info1.idText = "get"))
-
- Some(
- r,
- (fun () ->
- // both mem1 and mem2 have same range, would violate dive-and-pick assertions, so just try the first one, else try the second one:
- match traverseSynMemberDefn path (fun _ -> None) mem1 with
- | Some _ as x -> x
- | _ -> traverseSynMemberDefn path (fun _ -> None) mem2)
- )
- | [] ->
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ]
+ |> pick tRange tydef
+
+ and traverseSynMemberDefn path traverseInherit (m: SynMemberDefn) =
+ let pick (debugObj: obj) = pick m.Range debugObj
+ let path = SyntaxNode.SynMemberDefn m :: path
+
+ match m with
+ | SynMemberDefn.Open (_longIdent, _range) -> None
+ | SynMemberDefn.Member (synBinding, _range) -> traverseSynBinding path synBinding
+ | SynMemberDefn.ImplicitCtor (_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
+ match simplePats with
+ | SynSimplePats.SimplePats (simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
+ | _ -> None
+ | SynMemberDefn.ImplicitInherit (synType, synExpr, _identOption, range) ->
+ [ dive () synType.Range (fun () ->
+ match traverseInherit (synType, range) with
+ | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
+ | x -> x)
+ dive () synExpr.Range (fun () ->
+ visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)) ]
+ |> pick m
+ | SynMemberDefn.AutoProperty (synExpr = synExpr) -> traverseSynExpr path synExpr
+ | SynMemberDefn.LetBindings (synBindingList, isRecursive, _, range) ->
+ match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
+ | Some x -> Some x
+ | None ->
+ synBindingList
+ |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
+ |> pick m
+ | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None
+ | SynMemberDefn.Interface (interfaceType = synType; members = synMemberDefnsOption) ->
+ match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
+ | None ->
+ match synMemberDefnsOption with
+ | None -> None
+ | Some (x) ->
+ [ yield!
+ x
+ |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None) ]
+ |> pick x
+ | ok -> ok
+ | SynMemberDefn.Inherit (synType, _identOption, range) -> traverseInherit (synType, range)
+ | SynMemberDefn.ValField (_synField, _range) -> None
+ | SynMemberDefn.NestedType (synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
+
+ and traverseSynMatchClause origPath mc =
+ let defaultTraverse mc =
+ let path = SyntaxNode.SynMatchClause mc :: origPath
+
+ match mc with
+ | SynMatchClause (pat = synPat; whenExpr = synExprOption; resultExpr = synExpr) as all ->
+ [ dive synPat synPat.Range (traversePat path) ]
+ @ ([ match synExprOption with
+ | None -> ()
+ | Some guard -> yield guard
+ yield synExpr ]
+ |> List.map (fun x -> dive x x.Range (traverseSynExpr path)))
+ |> pick all.Range all
+
+ visitor.VisitMatchClause(origPath, defaultTraverse, mc)
+
+ and traverseSynBinding origPath b =
+ let defaultTraverse b =
+ let path = SyntaxNode.SynBinding b :: origPath
+
+ match b with
+ | SynBinding (headPat = synPat; expr = synExpr) ->
+ match traversePat path synPat with
+ | None -> traverseSynExpr path synExpr
+ | x -> x
+
+ visitor.VisitBinding(origPath, defaultTraverse, b)
+
+ match parseTree with
+ | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) ->
+ let fileRange =
#if DEBUG
- assert false
- failwith "impossible, Seq.groupBy never returns empty results"
-#else
- // swallow AST error and recover silently
- None
-#endif
- | _ ->
-#if DEBUG
- assert false // more than 2 members claim to have the same range, this indicates a bug in the AST
- failwith "bug in AST"
-#else
- // swallow AST error and recover silently
- None
-#endif
- )
-
- and traverseSynTypeDefn origPath (SynTypeDefn (synComponentInfo, synTypeDefnRepr, synMemberDefns, _, tRange, _) as tydef) =
- let path = SyntaxNode.SynTypeDefn tydef :: origPath
-
- match visitor.VisitComponentInfo(origPath, synComponentInfo) with
- | Some x -> Some x
- | None ->
- [
- match synTypeDefnRepr with
- | SynTypeDefnRepr.Exception _ ->
- // This node is generated in CheckExpressions.fs, not in the AST.
- // But note exception declarations are missing from this tree walk.
- ()
- | SynTypeDefnRepr.ObjectModel (synTypeDefnKind, synMemberDefns, _oRange) ->
- // traverse inherit function is used to capture type specific data required for processing Inherit part
- let traverseInherit (synType: SynType, range: range) =
- visitor.VisitInheritSynMemberDefn(path, synComponentInfo, synTypeDefnKind, synType, synMemberDefns, range)
-
- yield!
- synMemberDefns
- |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path traverseInherit
- | SynTypeDefnRepr.Simple (synTypeDefnSimpleRepr, _range) ->
- match synTypeDefnSimpleRepr with
- | SynTypeDefnSimpleRepr.Record (_synAccessOption, fields, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitRecordDefn(path, fields, m))
- | SynTypeDefnSimpleRepr.Union (_synAccessOption, cases, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitUnionDefn(path, cases, m))
- | SynTypeDefnSimpleRepr.Enum (cases, m) ->
- yield dive () synTypeDefnRepr.Range (fun () -> visitor.VisitEnumDefn(path, cases, m))
- | SynTypeDefnSimpleRepr.TypeAbbrev (_, synType, m) ->
- yield dive synTypeDefnRepr synTypeDefnRepr.Range (fun _ -> visitor.VisitTypeAbbrev(path, synType, m))
- | _ -> ()
- yield!
- synMemberDefns
- |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None)
- ]
- |> pick tRange tydef
-
- and traverseSynMemberDefn path traverseInherit (m: SynMemberDefn) =
- let pick (debugObj: obj) = pick m.Range debugObj
- let path = SyntaxNode.SynMemberDefn m :: path
-
- match m with
- | SynMemberDefn.Open (_longIdent, _range) -> None
- | SynMemberDefn.Member (synBinding, _range) -> traverseSynBinding path synBinding
- | SynMemberDefn.ImplicitCtor (_synAccessOption, _synAttributes, simplePats, _identOption, _doc, _range) ->
- match simplePats with
- | SynSimplePats.SimplePats (simplePats, _) -> visitor.VisitSimplePats(path, simplePats)
- | _ -> None
- | SynMemberDefn.ImplicitInherit (synType, synExpr, _identOption, range) ->
- [
- dive () synType.Range (fun () ->
- match traverseInherit (synType, range) with
- | None -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range)
- | x -> x)
- dive () synExpr.Range (fun () -> visitor.VisitImplicitInherit(path, traverseSynExpr path, synType, synExpr, range))
- ]
- |> pick m
- | SynMemberDefn.AutoProperty (synExpr = synExpr) -> traverseSynExpr path synExpr
- | SynMemberDefn.LetBindings (synBindingList, isRecursive, _, range) ->
- match visitor.VisitLetOrUse(path, isRecursive, traverseSynBinding path, synBindingList, range) with
- | Some x -> Some x
- | None ->
- synBindingList
- |> List.map (fun x -> dive x x.RangeOfBindingWithRhs (traverseSynBinding path))
- |> pick m
- | SynMemberDefn.AbstractSlot (_synValSig, _memberFlags, _range) -> None
- | SynMemberDefn.Interface (interfaceType = synType; members = synMemberDefnsOption) ->
- match visitor.VisitInterfaceSynMemberDefnType(path, synType) with
- | None ->
- match synMemberDefnsOption with
- | None -> None
- | Some (x) ->
- [
- yield!
- x
- |> normalizeMembersToDealWithPeculiaritiesOfGettersAndSetters path (fun _ -> None)
- ]
- |> pick x
- | ok -> ok
- | SynMemberDefn.Inherit (synType, _identOption, range) -> traverseInherit (synType, range)
- | SynMemberDefn.ValField (_synField, _range) -> None
- | SynMemberDefn.NestedType (synTypeDefn, _synAccessOption, _range) -> traverseSynTypeDefn path synTypeDefn
-
- and traverseSynMatchClause origPath mc =
- let defaultTraverse mc =
- let path = SyntaxNode.SynMatchClause mc :: origPath
-
- match mc with
- | SynMatchClause (pat = synPat; whenExpr = synExprOption; resultExpr = synExpr) as all ->
- [ dive synPat synPat.Range (traversePat path) ]
- @ ([
- match synExprOption with
- | None -> ()
- | Some guard -> yield guard
- yield synExpr
- ]
- |> List.map (fun x -> dive x x.Range (traverseSynExpr path)))
- |> pick all.Range all
-
- visitor.VisitMatchClause(origPath, defaultTraverse, mc)
-
- and traverseSynBinding origPath b =
- let defaultTraverse b =
- let path = SyntaxNode.SynBinding b :: origPath
-
- match b with
- | SynBinding (headPat = synPat; expr = synExpr) ->
- match traversePat path synPat with
- | None -> traverseSynExpr path synExpr
- | x -> x
-
- visitor.VisitBinding(origPath, defaultTraverse, b)
-
- match parseTree with
- | ParsedInput.ImplFile (ParsedImplFileInput (modules = l)) ->
- let fileRange =
-#if DEBUG
- match l with
- | [] -> range0
- | _ -> l |> List.map (fun x -> x.Range) |> List.reduce unionRanges
+ match l with
+ | [] -> range0
+ | _ ->
+ l
+ |> List.map (fun x -> x.Range)
+ |> List.reduce unionRanges
#else
- range0 // only used for asserting, does not matter in non-debug
+ range0 // only used for asserting, does not matter in non-debug
#endif
- l
- |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace []))
- |> pick fileRange l
- | ParsedInput.SigFile _sigFile -> None
+ l
+ |> List.map (fun x -> dive x x.Range (traverseSynModuleOrNamespace []))
+ |> pick fileRange l
+ | ParsedInput.SigFile _sigFile -> None
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index 8374238fc..dc62f863d 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -2710,7 +2710,7 @@ type FSharpLspServer(state: State, lspClient: FSharpLspClient) =
match h.Kind with
| InlayHints.HintKind.Parameter -> Some true
| _ -> None
- Data = None } )
+ Data = None })
return success (Some hints)
})
From 8c8d04c835eb6b34129ec0579f194fdf2915a925 Mon Sep 17 00:00:00 2001
From: BooksBaum <15612932+Booksbaum@users.noreply.github.com>
Date: Sun, 26 Jun 2022 21:52:31 +0200
Subject: [PATCH 29/29] Remove unused InlayHintData
---
src/FsAutoComplete/FsAutoComplete.Lsp.fs | 4 ----
1 file changed, 4 deletions(-)
diff --git a/src/FsAutoComplete/FsAutoComplete.Lsp.fs b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
index dc62f863d..2cce3c763 100644
--- a/src/FsAutoComplete/FsAutoComplete.Lsp.fs
+++ b/src/FsAutoComplete/FsAutoComplete.Lsp.fs
@@ -57,10 +57,6 @@ type LSPInlayHint =
Pos: Types.Position
Kind: InlayHintKind }
-type InlayHintData =
- { TextDocument: TextDocumentIdentifier
- Range: Types.Range }
-
module Result =
let ofCoreResponse (r: CoreResponse<'a>) =
match r with