From 3990cca99f9f11aab0527350608e74e202bf35f4 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 19:53:22 +0100 Subject: [PATCH 01/14] feat(interop): add C# bridge and C# language server host --- CHANGELOG.md | 2 + FScript.sln | 30 +++++++++ docs/architecture/assemblies-and-roles.md | 27 ++++++++ .../FScript.CSharpInterop.fsproj | 17 +++++ src/FScript.CSharpInterop/InteropServices.fs | 63 +++++++++++++++++++ .../FScript.LanguageServer.CSharp.csproj | 12 ++++ src/FScript.LanguageServer.CSharp/Program.cs | 3 + .../FScript.LanguageServer.fsproj | 1 + src/FScript.LanguageServer/LspHandlers.fs | 47 ++------------ .../LspRuntimeExterns.fs | 16 +---- src/FScript.LanguageServer/LspSymbols.fs | 20 +++--- .../FScript.LanguageServer.Tests.fsproj | 6 ++ .../InteropServicesTests.fs | 29 +++++++++ 13 files changed, 205 insertions(+), 68 deletions(-) create mode 100644 src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj create mode 100644 src/FScript.CSharpInterop/InteropServices.fs create mode 100644 src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj create mode 100644 src/FScript.LanguageServer.CSharp/Program.cs create mode 100644 tests/FScript.LanguageServer.Tests/InteropServicesTests.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index 35c2dba..d9a2fdd 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,8 @@ All notable changes to FScript are documented in this file. ## [Unreleased] - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. +- Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. +- Added `FScript.LanguageServer.CSharp` host executable as the migration entrypoint for C#-owned LSP startup. ## [0.33.0] diff --git a/FScript.sln b/FScript.sln index 6eb4b98..dad0924 100644 --- a/FScript.sln +++ b/FScript.sln @@ -21,6 +21,10 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer", "s EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer.Tests", "tests\FScript.LanguageServer.Tests\FScript.LanguageServer.Tests.fsproj", "{B734E1E1-59C2-47E0-8D19-A9C5C95938F1}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.CSharpInterop", "src\FScript.CSharpInterop\FScript.CSharpInterop.fsproj", "{8A28B784-F90B-469C-91BE-F96F63ACEA32}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "FScript.LanguageServer.CSharp", "src\FScript.LanguageServer.CSharp\FScript.LanguageServer.CSharp.csproj", "{78A97951-E42C-41EF-9A9E-BD33648A4C81}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -115,6 +119,30 @@ Global {B734E1E1-59C2-47E0-8D19-A9C5C95938F1}.Release|x64.Build.0 = Release|Any CPU {B734E1E1-59C2-47E0-8D19-A9C5C95938F1}.Release|x86.ActiveCfg = Release|Any CPU {B734E1E1-59C2-47E0-8D19-A9C5C95938F1}.Release|x86.Build.0 = Release|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Debug|Any CPU.Build.0 = Debug|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Debug|x64.ActiveCfg = Debug|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Debug|x64.Build.0 = Debug|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Debug|x86.ActiveCfg = Debug|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Debug|x86.Build.0 = Debug|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|Any CPU.ActiveCfg = Release|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|Any CPU.Build.0 = Release|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x64.ActiveCfg = Release|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x64.Build.0 = Release|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x86.ActiveCfg = Release|Any CPU + {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x86.Build.0 = Release|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|Any CPU.Build.0 = Debug|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x64.ActiveCfg = Debug|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x64.Build.0 = Debug|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x86.ActiveCfg = Debug|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x86.Build.0 = Debug|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|Any CPU.ActiveCfg = Release|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|Any CPU.Build.0 = Release|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x64.ActiveCfg = Release|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x64.Build.0 = Release|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x86.ActiveCfg = Release|Any CPU + {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -127,5 +155,7 @@ Global {1E2C7B34-04B8-42C9-880D-CC47DEC156A7} = {0AB3BF05-4346-4AA6-1389-037BE0695223} {E22A34B5-F5E8-422D-9BA5-932B3C45188F} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} {B734E1E1-59C2-47E0-8D19-A9C5C95938F1} = {0AB3BF05-4346-4AA6-1389-037BE0695223} + {8A28B784-F90B-469C-91BE-F96F63ACEA32} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} + {78A97951-E42C-41EF-9A9E-BD33648A4C81} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} EndGlobalSection EndGlobal diff --git a/docs/architecture/assemblies-and-roles.md b/docs/architecture/assemblies-and-roles.md index 76565a4..26d9b01 100644 --- a/docs/architecture/assemblies-and-roles.md +++ b/docs/architecture/assemblies-and-roles.md @@ -55,6 +55,31 @@ Use this when: NuGet: - `MagnusOpera.FScript.Runtime` +### `FScript.CSharpInterop` +Role: +- C#-friendly integration facade over language + runtime services. + +Responsibilities: +- Resolve runtime extern catalog from source path/root context. +- Parse with include/import expansion through a stable interop entry point. +- Run inference APIs through a single host-facing surface. +- Expose stdlib virtual source loading for editor integrations. + +Use this when: +- You integrate FScript from C# and want to avoid direct F# compiler/runtime internals. +- You build tooling services (for example LSP hosts) with a stable boundary. + +### `FScript.LanguageServer.CSharp` +Role: +- C# host executable for the Language Server process. + +Responsibilities: +- Provide a C# process entrypoint for LSP startup. +- Serve as migration anchor while preserving current LSP protocol behavior. + +Use this when: +- You want C# ownership of the server host process while reusing existing language services. + ## Typical composition ### CLI execution path @@ -72,6 +97,8 @@ NuGet: ## Dependency direction - `FScript.Language` has no dependency on `FScript.Runtime`. - `FScript.Runtime` depends on `FScript.Language` types. +- `FScript.CSharpInterop` depends on both `FScript.Language` and `FScript.Runtime`. +- `FScript.LanguageServer.CSharp` depends on `FScript.LanguageServer`. - `FScript` depends on both `FScript.Language` and `FScript.Runtime`. This keeps the language engine reusable while runtime capabilities remain host-configurable. diff --git a/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj b/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj new file mode 100644 index 0000000..1a366dd --- /dev/null +++ b/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj @@ -0,0 +1,17 @@ + + + + net10.0 + enable + + + + + + + + + + + + diff --git a/src/FScript.CSharpInterop/InteropServices.fs b/src/FScript.CSharpInterop/InteropServices.fs new file mode 100644 index 0000000..22a1979 --- /dev/null +++ b/src/FScript.CSharpInterop/InteropServices.fs @@ -0,0 +1,63 @@ +namespace FScript.CSharpInterop + +open System +open System.IO +open FScript.Language +open FScript.Runtime + +module InteropServices = + let private resolveRootDirectory (sourcePath: string) = + try + match Path.GetDirectoryName(sourcePath) with + | null + | "" -> Directory.GetCurrentDirectory() + | dir -> dir + with _ -> + Directory.GetCurrentDirectory() + + let runtimeExternsForSourcePath (sourcePath: string) : ExternalFunction list = + let ctx = { HostContext.RootDirectory = resolveRootDirectory sourcePath } + Registry.all ctx + + let parseProgramFromSourceWithIncludes (sourcePath: string) (sourceText: string) : Program = + let rootDirectory = resolveRootDirectory sourcePath + IncludeResolver.parseProgramFromSourceWithIncludes rootDirectory sourcePath sourceText + + let inferProgramWithExterns (externs: ExternalFunction list) (program: Program) : TypeInfer.TypedProgram = + TypeInfer.inferProgramWithExterns externs program + + let inferProgramWithExternsAndLocalVariableTypes (externs: ExternalFunction list) (program: Program) : TypeInfer.TypedProgram * TypeInfer.LocalVariableTypeInfo list = + TypeInfer.inferProgramWithExternsAndLocalVariableTypes externs program + + let inferStdlibWithExternsRaw (externs: ExternalFunction list) : TypeInfer.TypedProgram = + TypeInfer.inferProgramWithExternsRaw externs (Stdlib.loadProgram()) + + let stdlibProgram () : Program = + Stdlib.loadProgram() + + let tryLoadStdlibSourceText (uri: string) : string option = + try + let parsed = Uri(uri) + if not (String.Equals(parsed.Scheme, "fscript-stdlib", StringComparison.OrdinalIgnoreCase)) then + None + else + let fileName = parsed.AbsolutePath.TrimStart('/') + let resourceName = + match fileName with + | "Option.fss" -> Some "FScript.Language.Stdlib.Option.fss" + | "List.fss" -> Some "FScript.Language.Stdlib.List.fss" + | "Map.fss" -> Some "FScript.Language.Stdlib.Map.fss" + | _ -> None + + match resourceName with + | None -> None + | Some name -> + let assembly = typeof.Assembly + match assembly.GetManifestResourceStream(name) with + | null -> None + | stream -> + use stream = stream + use reader = new StreamReader(stream) + Some(reader.ReadToEnd()) + with _ -> + None diff --git a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj b/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj new file mode 100644 index 0000000..6f01553 --- /dev/null +++ b/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj @@ -0,0 +1,12 @@ + + + Exe + net10.0 + enable + enable + + + + + + diff --git a/src/FScript.LanguageServer.CSharp/Program.cs b/src/FScript.LanguageServer.CSharp/Program.cs new file mode 100644 index 0000000..42c1e2d --- /dev/null +++ b/src/FScript.LanguageServer.CSharp/Program.cs @@ -0,0 +1,3 @@ +using FScript.LanguageServer; + +LspServer.run(); diff --git a/src/FScript.LanguageServer/FScript.LanguageServer.fsproj b/src/FScript.LanguageServer/FScript.LanguageServer.fsproj index 53ca154..90190d1 100644 --- a/src/FScript.LanguageServer/FScript.LanguageServer.fsproj +++ b/src/FScript.LanguageServer/FScript.LanguageServer.fsproj @@ -21,6 +21,7 @@ + diff --git a/src/FScript.LanguageServer/LspHandlers.fs b/src/FScript.LanguageServer/LspHandlers.fs index 659c699..9b7d391 100644 --- a/src/FScript.LanguageServer/LspHandlers.fs +++ b/src/FScript.LanguageServer/LspHandlers.fs @@ -4,6 +4,7 @@ open System open System.IO open System.Text.Json.Nodes open FScript.Language +open FScript.CSharpInterop module LspHandlers = open LspModel @@ -497,12 +498,7 @@ module LspHandlers = | None -> sendCommandError idNode "internal" $"Unable to read source file '{sourcePath}'." | Some sourceText -> - let rootDirectory = - match Path.GetDirectoryName(sourcePath) with - | null - | "" -> "." - | dir -> dir - let program = IncludeResolver.parseProgramFromSourceWithIncludes rootDirectory sourcePath sourceText + let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath sourceText let response = JsonObject() response["ok"] <- JsonValue.Create(true) response["data"] <- AstJson.programToJson sourcePath program @@ -528,14 +524,9 @@ module LspHandlers = | None -> sendCommandError idNode "internal" $"Unable to read source file '{sourcePath}'." | Some sourceText -> - let rootDirectory = - match Path.GetDirectoryName(sourcePath) with - | null - | "" -> "." - | dir -> dir - let program = IncludeResolver.parseProgramFromSourceWithIncludes rootDirectory sourcePath sourceText + let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath sourceText let runtimeExterns = LspRuntimeExterns.forSourcePath sourcePath - let typedProgram = TypeInfer.inferProgramWithExterns runtimeExterns program + let typedProgram = InteropServices.inferProgramWithExterns runtimeExterns program let response = JsonObject() response["ok"] <- JsonValue.Create(true) response["data"] <- AstJson.typedProgramToJson sourcePath typedProgram @@ -1103,40 +1094,12 @@ module LspHandlers = | _ -> LspProtocol.sendResponse idNode None - let private tryLoadStdlibSourceText (uri: string) = - try - let parsed = Uri(uri) - if not (String.Equals(parsed.Scheme, "fscript-stdlib", StringComparison.OrdinalIgnoreCase)) then - None - else - let fileName = parsed.AbsolutePath.TrimStart('/') - let resourceName = - match fileName with - | "Option.fss" -> Some "FScript.Language.Stdlib.Option.fss" - | "List.fss" -> Some "FScript.Language.Stdlib.List.fss" - | "Map.fss" -> Some "FScript.Language.Stdlib.Map.fss" - | _ -> None - - match resourceName with - | None -> None - | Some name -> - let assembly = typeof.Assembly - match assembly.GetManifestResourceStream(name) with - | null -> - None - | stream -> - use stream = stream - use reader = new StreamReader(stream) - Some (reader.ReadToEnd()) - with _ -> - None - let handleStdlibSource (idNode: JsonNode) (paramsObj: JsonObject) = match tryGetString paramsObj "uri" with | None -> sendCommandError idNode "internal" "Missing stdlib URI." | Some uri -> - match tryLoadStdlibSourceText uri with + match InteropServices.tryLoadStdlibSourceText uri with | Some sourceText -> let response = JsonObject() response["ok"] <- JsonValue.Create(true) diff --git a/src/FScript.LanguageServer/LspRuntimeExterns.fs b/src/FScript.LanguageServer/LspRuntimeExterns.fs index 951e58c..93b4758 100644 --- a/src/FScript.LanguageServer/LspRuntimeExterns.fs +++ b/src/FScript.LanguageServer/LspRuntimeExterns.fs @@ -1,20 +1,8 @@ namespace FScript.LanguageServer -open System -open System.IO open FScript.Language -open FScript.Runtime +open FScript.CSharpInterop module LspRuntimeExterns = - let private resolveRootDirectory (sourcePath: string) = - try - match Path.GetDirectoryName(sourcePath) with - | null - | "" -> Directory.GetCurrentDirectory() - | dir -> dir - with _ -> - Directory.GetCurrentDirectory() - let forSourcePath (sourcePath: string) : ExternalFunction list = - let ctx = { HostContext.RootDirectory = resolveRootDirectory sourcePath } - Registry.all ctx + InteropServices.runtimeExternsForSourcePath sourcePath diff --git a/src/FScript.LanguageServer/LspSymbols.fs b/src/FScript.LanguageServer/LspSymbols.fs index 147a59b..2968eee 100644 --- a/src/FScript.LanguageServer/LspSymbols.fs +++ b/src/FScript.LanguageServer/LspSymbols.fs @@ -5,6 +5,7 @@ open System.Collections.Generic open System.IO open System.Text.Json.Nodes open FScript.Language +open FScript.CSharpInterop module LspSymbols = open LspModel @@ -69,7 +70,7 @@ module LspSymbols = let private stdlibFunctionSignatures : Lazy> = lazy - let typedStdlib = TypeInfer.inferProgramWithExternsRaw [] (Stdlib.loadProgram()) + let typedStdlib = InteropServices.inferStdlibWithExternsRaw [] typedStdlib |> List.collect (function | TypeInfer.TSLet(name, _, t, _, _, _) -> @@ -94,7 +95,7 @@ module LspSymbols = let private stdlibFunctionParameterNames : Lazy> = lazy - Stdlib.loadProgram() + InteropServices.stdlibProgram() |> List.collect (function | SLet(name, args, _, _, _, _) -> [ name, (args |> List.map (fun p -> p.Name)) ] @@ -106,7 +107,7 @@ module LspSymbols = let private stdlibFunctionDefinitions : Lazy> = lazy - Stdlib.loadProgram() + InteropServices.stdlibProgram() |> List.collect (function | SLet(name, _, _, _, _, span) -> match tryStdlibVirtualUriFromSource span.Start.File with @@ -355,7 +356,7 @@ module LspSymbols = let tryInferWithCurrent (candidate: Program) = try - let typed, _ = TypeInfer.inferProgramWithExternsAndLocalVariableTypes externs candidate + let typed, _ = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs candidate Some typed with | _ -> None @@ -408,7 +409,7 @@ module LspSymbols = let tryInferWithCurrent (candidate: Program) = try - let _, localTypes = TypeInfer.inferProgramWithExternsAndLocalVariableTypes externs candidate + let _, localTypes = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs candidate Some localTypes with | _ -> None @@ -1441,12 +1442,7 @@ module LspSymbols = try let program = if uri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then - let directory = - match System.IO.Path.GetDirectoryName(sourceName) with - | null - | "" -> "." - | dir -> dir - IncludeResolver.parseProgramFromSourceWithIncludes directory sourceName text + InteropServices.parseProgramFromSourceWithIncludes sourceName text else FScript.parseWithSourceName (Some sourceName) text parsedProgram <- Some program @@ -1463,7 +1459,7 @@ module LspSymbols = callArgumentHints <- buildCallArgumentHints program functionParameters localBindings <- buildLocalBindings program try - let typed, localTypes = TypeInfer.inferProgramWithExternsAndLocalVariableTypes runtimeExterns program + let typed, localTypes = InteropServices.inferProgramWithExternsAndLocalVariableTypes runtimeExterns program symbols <- buildSymbolsFromProgram program (Some typed) parameterTypeHints <- buildParameterTypeHints program (Some typed) functionReturnTypeHints <- buildFunctionReturnTypeHints program (Some typed) diff --git a/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj b/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj index 31dc4b9..22141e9 100644 --- a/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj +++ b/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj @@ -17,6 +17,7 @@ + @@ -29,4 +30,9 @@ + + + + + diff --git a/tests/FScript.LanguageServer.Tests/InteropServicesTests.fs b/tests/FScript.LanguageServer.Tests/InteropServicesTests.fs new file mode 100644 index 0000000..e5a28fd --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/InteropServicesTests.fs @@ -0,0 +1,29 @@ +namespace FScript.LanguageServer.Tests + +open NUnit.Framework +open FsUnit +open FScript.Language +open FScript.CSharpInterop + +[] +type InteropServicesTests () = + [] + member _.``Interop loads stdlib virtual source`` () = + let source = InteropServices.tryLoadStdlibSourceText "fscript-stdlib:///Option.fss" + source.IsSome |> should equal true + + [] + member _.``Interop parses and infers a simple script`` () = + let script = "let add x y = x + y" + let sourcePath = "/tmp/interop-test.fss" + let externs = InteropServices.runtimeExternsForSourcePath sourcePath + let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath script + let typed, _ = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs program + + let hasAddBinding = + typed + |> List.exists (function + | TypeInfer.TSLet(name, _, _, _, _, _) when name = "add" -> true + | _ -> false) + + hasAddBinding |> should equal true From 22eac711dbac9f780216b951fccc856a00bab6da Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 19:57:37 +0100 Subject: [PATCH 02/14] feat(lsp-csharp): add native C# server core and tests --- CHANGELOG.md | 1 + .../FScript.LanguageServer.CSharp.csproj | 2 +- .../JsonRpcWire.cs | 85 +++++++++ .../LspHandlers.cs | 71 +++++++ .../LspServer.cs | 174 ++++++++++++++++++ src/FScript.LanguageServer.CSharp/Program.cs | 5 +- .../CSharpServerCoreTests.fs | 106 +++++++++++ .../FScript.LanguageServer.Tests.fsproj | 1 + .../LspTestClient.fs | 47 +++++ 9 files changed, 489 insertions(+), 3 deletions(-) create mode 100644 src/FScript.LanguageServer.CSharp/JsonRpcWire.cs create mode 100644 src/FScript.LanguageServer.CSharp/LspHandlers.cs create mode 100644 src/FScript.LanguageServer.CSharp/LspServer.cs create mode 100644 tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index d9a2fdd..0ab59a7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ All notable changes to FScript are documented in this file. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer.CSharp` host executable as the migration entrypoint for C#-owned LSP startup. +- Added a first native C# LSP server core (JSON-RPC transport, initialize/shutdown, text sync, and stdlib-source request) with dedicated integration tests. ## [0.33.0] diff --git a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj b/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj index 6f01553..25b10a8 100644 --- a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj +++ b/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj @@ -7,6 +7,6 @@ - + diff --git a/src/FScript.LanguageServer.CSharp/JsonRpcWire.cs b/src/FScript.LanguageServer.CSharp/JsonRpcWire.cs new file mode 100644 index 0000000..649eadb --- /dev/null +++ b/src/FScript.LanguageServer.CSharp/JsonRpcWire.cs @@ -0,0 +1,85 @@ +using System.Text; + +namespace FScript.LanguageServer.CSharp; + +internal static class JsonRpcWire +{ + internal static string? ReadMessage(Stream input) + { + var contentLength = -1; + + while (true) + { + var line = ReadHeaderLine(input); + if (line is null) + { + return null; + } + + if (line.Length == 0) + { + break; + } + + const string prefix = "Content-Length:"; + if (line.StartsWith(prefix, StringComparison.OrdinalIgnoreCase)) + { + var value = line[prefix.Length..].Trim(); + if (int.TryParse(value, out var parsed)) + { + contentLength = parsed; + } + } + } + + if (contentLength < 0) + { + return null; + } + + var payload = new byte[contentLength]; + var offset = 0; + while (offset < payload.Length) + { + var read = input.Read(payload, offset, payload.Length - offset); + if (read <= 0) + { + return null; + } + + offset += read; + } + + return Encoding.UTF8.GetString(payload); + } + + internal static void WriteMessage(Stream output, string json) + { + var bytes = Encoding.UTF8.GetBytes(json); + var header = Encoding.ASCII.GetBytes($"Content-Length: {bytes.Length}\r\n\r\n"); + output.Write(header, 0, header.Length); + output.Write(bytes, 0, bytes.Length); + output.Flush(); + } + + private static string? ReadHeaderLine(Stream input) + { + using var buffer = new MemoryStream(); + + while (true) + { + var value = input.ReadByte(); + if (value < 0) + { + return buffer.Length == 0 ? null : Encoding.ASCII.GetString(buffer.ToArray()).TrimEnd('\r'); + } + + if (value == '\n') + { + return Encoding.ASCII.GetString(buffer.ToArray()).TrimEnd('\r'); + } + + buffer.WriteByte((byte)value); + } + } +} diff --git a/src/FScript.LanguageServer.CSharp/LspHandlers.cs b/src/FScript.LanguageServer.CSharp/LspHandlers.cs new file mode 100644 index 0000000..9168a50 --- /dev/null +++ b/src/FScript.LanguageServer.CSharp/LspHandlers.cs @@ -0,0 +1,71 @@ +using System.Text.Json.Nodes; +using FScript.CSharpInterop; + +namespace FScript.LanguageServer.CSharp; + +internal static class LspHandlers +{ + internal static JsonObject CreateInitializeResult() + { + var sync = new JsonObject + { + ["openClose"] = true, + ["change"] = 1 + }; + + var capabilities = new JsonObject + { + ["textDocumentSync"] = sync, + ["hoverProvider"] = true + }; + + return new JsonObject + { + ["capabilities"] = capabilities, + ["serverInfo"] = new JsonObject + { + ["name"] = "FScript Language Server (C#)" + } + }; + } + + internal static JsonObject HandleStdlibSource(JsonObject? @params) + { + var uri = @params?["uri"]?.GetValue(); + if (string.IsNullOrWhiteSpace(uri)) + { + return Error("internal", "Missing stdlib URI."); + } + + var textOption = InteropServices.tryLoadStdlibSourceText(uri); + if (textOption is null) + { + return Error("internal", $"Unable to load stdlib source for '{uri}'."); + } + + var text = textOption.Value; + return new JsonObject + { + ["ok"] = true, + ["data"] = new JsonObject + { + ["uri"] = uri, + ["text"] = text, + ["languageId"] = "fscript" + } + }; + } + + private static JsonObject Error(string kind, string message) + { + return new JsonObject + { + ["ok"] = false, + ["error"] = new JsonObject + { + ["kind"] = kind, + ["message"] = message + } + }; + } +} diff --git a/src/FScript.LanguageServer.CSharp/LspServer.cs b/src/FScript.LanguageServer.CSharp/LspServer.cs new file mode 100644 index 0000000..a364e89 --- /dev/null +++ b/src/FScript.LanguageServer.CSharp/LspServer.cs @@ -0,0 +1,174 @@ +using System.Text.Json.Nodes; + +namespace FScript.LanguageServer.CSharp; + +internal sealed class LspServer +{ + private readonly Dictionary _documents = new(StringComparer.Ordinal); + private bool _shutdownRequested; + + public void Run() + { + var input = Console.OpenStandardInput(); + var output = Console.OpenStandardOutput(); + + while (true) + { + var raw = JsonRpcWire.ReadMessage(input); + if (raw is null) + { + break; + } + + JsonObject? message; + try + { + message = JsonNode.Parse(raw) as JsonObject; + } + catch + { + continue; + } + + if (message is null) + { + continue; + } + + var method = message["method"]?.GetValue(); + var id = message["id"]; + var @params = message["params"] as JsonObject; + + if (method is null) + { + continue; + } + + if (id is null) + { + HandleNotification(method, @params); + if (_shutdownRequested && string.Equals(method, "exit", StringComparison.Ordinal)) + { + break; + } + + continue; + } + + HandleRequest(output, id, method, @params); + } + } + + private void HandleNotification(string method, JsonObject? @params) + { + switch (method) + { + case "textDocument/didOpen": + HandleDidOpen(@params); + break; + case "textDocument/didChange": + HandleDidChange(@params); + break; + case "textDocument/didClose": + HandleDidClose(@params); + break; + case "exit": + break; + } + } + + private void HandleRequest(Stream output, JsonNode id, string method, JsonObject? @params) + { + switch (method) + { + case "initialize": + SendResponse(output, id, LspHandlers.CreateInitializeResult()); + break; + case "shutdown": + _shutdownRequested = true; + SendResponse(output, id, null); + break; + case "textDocument/hover": + SendResponse(output, id, null); + break; + case "fscript/stdlibSource": + SendResponse(output, id, LspHandlers.HandleStdlibSource(@params)); + break; + default: + SendError(output, id, -32601, $"Method not found: {method}"); + break; + } + } + + private void HandleDidOpen(JsonObject? @params) + { + var textDocument = @params?["textDocument"] as JsonObject; + var uri = textDocument?["uri"]?.GetValue(); + var text = textDocument?["text"]?.GetValue(); + if (!string.IsNullOrEmpty(uri) && text is not null) + { + _documents[uri] = text; + } + } + + private void HandleDidChange(JsonObject? @params) + { + var textDocument = @params?["textDocument"] as JsonObject; + var uri = textDocument?["uri"]?.GetValue(); + if (string.IsNullOrEmpty(uri)) + { + return; + } + + var changes = @params?["contentChanges"] as JsonArray; + if (changes is null || changes.Count == 0) + { + return; + } + + var last = changes[changes.Count - 1] as JsonObject; + var text = last?["text"]?.GetValue(); + if (text is not null) + { + _documents[uri] = text; + } + } + + private void HandleDidClose(JsonObject? @params) + { + var textDocument = @params?["textDocument"] as JsonObject; + var uri = textDocument?["uri"]?.GetValue(); + if (!string.IsNullOrEmpty(uri)) + { + _documents.Remove(uri); + } + } + + private static void SendResponse(Stream output, JsonNode id, JsonNode? result) + { + var payload = new JsonObject + { + ["jsonrpc"] = "2.0", + ["id"] = id.DeepClone(), + ["result"] = result + }; + + JsonRpcWire.WriteMessage(output, payload.ToJsonString()); + } + + private static void SendError(Stream output, JsonNode id, int code, string message) + { + var payload = new JsonObject + { + ["jsonrpc"] = "2.0", + ["id"] = id.DeepClone(), + ["error"] = new JsonObject + { + ["code"] = code, + ["message"] = message + } + }; + + JsonRpcWire.WriteMessage(output, payload.ToJsonString()); + } +} diff --git a/src/FScript.LanguageServer.CSharp/Program.cs b/src/FScript.LanguageServer.CSharp/Program.cs index 42c1e2d..ddfee51 100644 --- a/src/FScript.LanguageServer.CSharp/Program.cs +++ b/src/FScript.LanguageServer.CSharp/Program.cs @@ -1,3 +1,4 @@ -using FScript.LanguageServer; +using FScript.LanguageServer.CSharp; -LspServer.run(); +var server = new LspServer(); +server.Run(); diff --git a/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs new file mode 100644 index 0000000..311141e --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs @@ -0,0 +1,106 @@ +namespace FScript.LanguageServer.Tests + +open System +open System.Text.Json.Nodes +open NUnit.Framework +open FsUnit +open LspTestFixture + +[] +type CSharpServerCoreTests () = + [] + member _.``CSharp server initialize returns capabilities`` () = + let client = LspClient.startCSharp () + try + initialize client + + let hoverReq = JsonObject() + let textDocument = JsonObject() + textDocument["uri"] <- JsonValue.Create("file:///tmp/test.fss") + let position = JsonObject() + position["line"] <- JsonValue.Create(0) + position["character"] <- JsonValue.Create(0) + hoverReq["textDocument"] <- textDocument + hoverReq["position"] <- position + + LspClient.sendRequest client 42 "textDocument/hover" (Some hoverReq) + let hoverResp = + LspClient.readUntil client 10000 (fun msg -> + match msg["id"] with + | :? JsonValue as idv -> + try idv.GetValue() = 42 with _ -> false + | _ -> false) + + hoverResp["result"] |> should equal null + finally + try shutdown client with _ -> () + LspClient.stop client + + [] + member _.``CSharp server returns stdlib source`` () = + let client = LspClient.startCSharp () + try + initialize client + + let requestParams = JsonObject() + requestParams["uri"] <- JsonValue.Create("fscript-stdlib:///Option.fss") + + LspClient.sendRequest client 43 "fscript/stdlibSource" (Some requestParams) + let resp = + LspClient.readUntil client 10000 (fun msg -> + match msg["id"] with + | :? JsonValue as idv -> + try idv.GetValue() = 43 with _ -> false + | _ -> false) + + let result = + match resp["result"] with + | :? JsonObject as obj -> obj + | _ -> failwith "Expected result object" + + let ok = + match result["ok"] with + | :? JsonValue as value -> value.GetValue() + | _ -> false + ok |> should equal true + + let data = + match result["data"] with + | :? JsonObject as obj -> obj + | _ -> failwith "Expected data object" + + let text = + match data["text"] with + | :? JsonValue as value -> value.GetValue() + | _ -> "" + text.Contains("let", StringComparison.Ordinal) |> should equal true + finally + try shutdown client with _ -> () + LspClient.stop client + + [] + member _.``CSharp server returns method not found for unknown request`` () = + let client = LspClient.startCSharp () + try + initialize client + + LspClient.sendRequest client 44 "fscript/unknown" None + let resp = + LspClient.readUntil client 10000 (fun msg -> + match msg["id"] with + | :? JsonValue as idv -> + try idv.GetValue() = 44 with _ -> false + | _ -> false) + + let err = + match resp["error"] with + | :? JsonObject as obj -> obj + | _ -> failwith "Expected error object" + let code = + match err["code"] with + | :? JsonValue as value -> value.GetValue() + | _ -> 0 + code |> should equal -32601 + finally + try shutdown client with _ -> () + LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj b/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj index 22141e9..04196d9 100644 --- a/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj +++ b/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj @@ -18,6 +18,7 @@ + diff --git a/tests/FScript.LanguageServer.Tests/LspTestClient.fs b/tests/FScript.LanguageServer.Tests/LspTestClient.fs index 28da3b2..771e3de 100644 --- a/tests/FScript.LanguageServer.Tests/LspTestClient.fs +++ b/tests/FScript.LanguageServer.Tests/LspTestClient.fs @@ -55,6 +55,32 @@ module internal LspClient = serverDll) + let private ensureCSharpServerDllBuilt = + lazy ( + let root = findRepoRoot () + let serverProject = Path.Combine(root, "src", "FScript.LanguageServer.CSharp", "FScript.LanguageServer.CSharp.csproj") + let serverDll = Path.Combine(root, "src", "FScript.LanguageServer.CSharp", "bin", "Release", "net10.0", "FScript.LanguageServer.CSharp.dll") + + let buildPsi = + ProcessStartInfo( + FileName = "dotnet", + Arguments = $"build \"{serverProject}\" -c Release -nologo -v q", + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true) + + use buildProc = new Process(StartInfo = buildPsi) + if not (buildProc.Start()) then + failwith "Unable to start dotnet build for C# language server test setup." + buildProc.WaitForExit() + if buildProc.ExitCode <> 0 || not (File.Exists(serverDll)) then + let out = buildProc.StandardOutput.ReadToEnd() + let err = buildProc.StandardError.ReadToEnd() + failwith $"Failed to build C# language server test target. stdout: {out}\nstderr: {err}" + + serverDll) + let start () = let serverDll = ensureServerDllBuilt.Value @@ -76,6 +102,27 @@ module internal LspClient = Input = proc.StandardInput.BaseStream Output = proc.StandardOutput.BaseStream } + let startCSharp () = + let serverDll = ensureCSharpServerDllBuilt.Value + + let psi = + ProcessStartInfo( + FileName = "dotnet", + Arguments = $"\"{serverDll}\"", + RedirectStandardInput = true, + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true) + + let proc = new Process(StartInfo = psi) + let started = proc.Start() + if not started then failwith "Unable to start FScript C# language server process" + + { Process = proc + Input = proc.StandardInput.BaseStream + Output = proc.StandardOutput.BaseStream } + let stop (client: Client) = if not client.Process.HasExited then try From c3ef9aecabaf316c48b613b6714f03022d54cd3f Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:01:55 +0100 Subject: [PATCH 03/14] feat(lsp-csharp): add diagnostics and AST command handlers --- CHANGELOG.md | 1 + .../FScript.LanguageServer.CSharp.csproj | 1 + .../LspHandlers.cs | 195 ++++++++++++++++++ .../LspServer.cs | 64 +++++- .../CSharpServerCoreTests.fs | 162 +++++++++++++++ 5 files changed, 415 insertions(+), 8 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 0ab59a7..66a3cc6 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ All notable changes to FScript are documented in this file. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer.CSharp` host executable as the migration entrypoint for C#-owned LSP startup. - Added a first native C# LSP server core (JSON-RPC transport, initialize/shutdown, text sync, and stdlib-source request) with dedicated integration tests. +- Extended the native C# LSP core with diagnostics publishing and `viewAst`/`viewInferredAst` command handling. ## [0.33.0] diff --git a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj b/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj index 25b10a8..c8910a4 100644 --- a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj +++ b/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj @@ -8,5 +8,6 @@ + diff --git a/src/FScript.LanguageServer.CSharp/LspHandlers.cs b/src/FScript.LanguageServer.CSharp/LspHandlers.cs index 9168a50..72ddd48 100644 --- a/src/FScript.LanguageServer.CSharp/LspHandlers.cs +++ b/src/FScript.LanguageServer.CSharp/LspHandlers.cs @@ -1,10 +1,15 @@ using System.Text.Json.Nodes; using FScript.CSharpInterop; +using FScript.Language; +using Microsoft.FSharp.Core; namespace FScript.LanguageServer.CSharp; internal static class LspHandlers { + private static readonly Position FallbackPosition = new(FSharpOption.None, 1, 1); + private static readonly Span FallbackSpan = new(FallbackPosition, FallbackPosition); + internal static JsonObject CreateInitializeResult() { var sync = new JsonObject @@ -56,6 +61,196 @@ internal static JsonObject HandleStdlibSource(JsonObject? @params) }; } + internal static JsonObject HandleViewAst(JsonObject? @params, Func tryLoadSource) + { + var uri = TryGetCommandUri(@params); + if (string.IsNullOrWhiteSpace(uri)) + { + return Error("internal", "Missing document URI."); + } + + if (!Uri.TryCreate(uri, UriKind.Absolute, out var parsed) || + !string.Equals(parsed.Scheme, "file", StringComparison.OrdinalIgnoreCase)) + { + return Error("internal", "AST commands support file-based scripts only."); + } + + var sourcePath = parsed.LocalPath; + var sourceText = tryLoadSource(uri); + if (sourceText is null) + { + return Error("internal", $"Unable to read source file '{sourcePath}'."); + } + + try + { + var program = InteropServices.parseProgramFromSourceWithIncludes(sourcePath, sourceText); + var data = global::FScript.LanguageServer.AstJson.programToJson(sourcePath, program); + return new JsonObject + { + ["ok"] = true, + ["data"] = data + }; + } + catch (ParseException ex) + { + return Error("parse", ex.Message); + } + catch (Exception ex) + { + return Error("internal", ex.Message); + } + } + + internal static JsonObject HandleViewInferredAst(JsonObject? @params, Func tryLoadSource) + { + var uri = TryGetCommandUri(@params); + if (string.IsNullOrWhiteSpace(uri)) + { + return Error("internal", "Missing document URI."); + } + + if (!Uri.TryCreate(uri, UriKind.Absolute, out var parsed) || + !string.Equals(parsed.Scheme, "file", StringComparison.OrdinalIgnoreCase)) + { + return Error("internal", "AST commands support file-based scripts only."); + } + + var sourcePath = parsed.LocalPath; + var sourceText = tryLoadSource(uri); + if (sourceText is null) + { + return Error("internal", $"Unable to read source file '{sourcePath}'."); + } + + try + { + var program = InteropServices.parseProgramFromSourceWithIncludes(sourcePath, sourceText); + var externs = InteropServices.runtimeExternsForSourcePath(sourcePath); + var typed = InteropServices.inferProgramWithExterns(externs, program); + var data = global::FScript.LanguageServer.AstJson.typedProgramToJson(sourcePath, typed); + return new JsonObject + { + ["ok"] = true, + ["data"] = data + }; + } + catch (ParseException ex) + { + return Error("parse", ex.Message); + } + catch (TypeException ex) + { + return Error("type", ex.Message); + } + catch (Exception ex) + { + return Error("internal", ex.Message); + } + } + + internal static JsonObject CreateDiagnosticsParams(string uri, string text) + { + var diagnostics = new JsonArray(); + var sourcePath = ResolveSourcePath(uri); + + try + { + var program = InteropServices.parseProgramFromSourceWithIncludes(sourcePath, text); + var externs = InteropServices.runtimeExternsForSourcePath(sourcePath); + _ = InteropServices.inferProgramWithExterns(externs, program); + } + catch (ParseException ex) + { + diagnostics.Add(CreateDiagnostic("parse", ex.Message, ExtractSpan(ex))); + } + catch (TypeException ex) + { + diagnostics.Add(CreateDiagnostic("type", ex.Message, ExtractSpan(ex))); + } + + return new JsonObject + { + ["uri"] = uri, + ["diagnostics"] = diagnostics + }; + } + + private static string ResolveSourcePath(string uri) + { + if (Uri.TryCreate(uri, UriKind.Absolute, out var parsed) && + string.Equals(parsed.Scheme, "file", StringComparison.OrdinalIgnoreCase)) + { + return parsed.LocalPath; + } + + return uri; + } + + private static JsonObject CreateDiagnostic(string code, string message, Span span) + { + var startLine = Math.Max(0, span.Start.Line - 1); + var startCharacter = Math.Max(0, span.Start.Column - 1); + var endLine = Math.Max(0, span.End.Line - 1); + var endCharacter = Math.Max(0, span.End.Column - 1); + + return new JsonObject + { + ["range"] = new JsonObject + { + ["start"] = new JsonObject + { + ["line"] = startLine, + ["character"] = startCharacter + }, + ["end"] = new JsonObject + { + ["line"] = endLine, + ["character"] = endCharacter + } + }, + ["severity"] = 1, + ["code"] = code, + ["source"] = "fscript-lsp", + ["message"] = message + }; + } + + private static Span ExtractSpan(Exception ex) + { + try + { + var data0 = ex.GetType().GetProperty("Data0")?.GetValue(ex); + if (data0 is null) + { + return FallbackSpan; + } + + var spanObj = data0.GetType().GetProperty("Span")?.GetValue(data0); + if (spanObj is Span span) + { + return span; + } + } + catch + { + // Ignore and fallback to default span. + } + + return FallbackSpan; + } + + private static string? TryGetCommandUri(JsonObject? @params) + { + var fromTextDocument = (@params?["textDocument"] as JsonObject)?["uri"]?.GetValue(); + if (!string.IsNullOrWhiteSpace(fromTextDocument)) + { + return fromTextDocument; + } + + return @params?["uri"]?.GetValue(); + } + private static JsonObject Error(string kind, string message) { return new JsonObject diff --git a/src/FScript.LanguageServer.CSharp/LspServer.cs b/src/FScript.LanguageServer.CSharp/LspServer.cs index a364e89..8038164 100644 --- a/src/FScript.LanguageServer.CSharp/LspServer.cs +++ b/src/FScript.LanguageServer.CSharp/LspServer.cs @@ -46,7 +46,7 @@ public void Run() if (id is null) { - HandleNotification(method, @params); + HandleNotification(output, method, @params); if (_shutdownRequested && string.Equals(method, "exit", StringComparison.Ordinal)) { break; @@ -59,18 +59,18 @@ public void Run() } } - private void HandleNotification(string method, JsonObject? @params) + private void HandleNotification(Stream output, string method, JsonObject? @params) { switch (method) { case "textDocument/didOpen": - HandleDidOpen(@params); + HandleDidOpen(output, @params); break; case "textDocument/didChange": - HandleDidChange(@params); + HandleDidChange(output, @params); break; case "textDocument/didClose": - HandleDidClose(@params); + HandleDidClose(output, @params); break; case "exit": break; @@ -94,13 +94,19 @@ private void HandleRequest(Stream output, JsonNode id, string method, JsonObject case "fscript/stdlibSource": SendResponse(output, id, LspHandlers.HandleStdlibSource(@params)); break; + case "fscript/viewAst": + SendResponse(output, id, LspHandlers.HandleViewAst(@params, TryLoadSourceForUri)); + break; + case "fscript/viewInferredAst": + SendResponse(output, id, LspHandlers.HandleViewInferredAst(@params, TryLoadSourceForUri)); + break; default: SendError(output, id, -32601, $"Method not found: {method}"); break; } } - private void HandleDidOpen(JsonObject? @params) + private void HandleDidOpen(Stream output, JsonObject? @params) { var textDocument = @params?["textDocument"] as JsonObject; var uri = textDocument?["uri"]?.GetValue(); @@ -108,10 +114,11 @@ private void HandleDidOpen(JsonObject? @params) if (!string.IsNullOrEmpty(uri) && text is not null) { _documents[uri] = text; + PublishDiagnostics(output, uri, text); } } - private void HandleDidChange(JsonObject? @params) + private void HandleDidChange(Stream output, JsonObject? @params) { var textDocument = @params?["textDocument"] as JsonObject; var uri = textDocument?["uri"]?.GetValue(); @@ -131,17 +138,46 @@ private void HandleDidChange(JsonObject? @params) if (text is not null) { _documents[uri] = text; + PublishDiagnostics(output, uri, text); } } - private void HandleDidClose(JsonObject? @params) + private void HandleDidClose(Stream output, JsonObject? @params) { var textDocument = @params?["textDocument"] as JsonObject; var uri = textDocument?["uri"]?.GetValue(); if (!string.IsNullOrEmpty(uri)) { _documents.Remove(uri); + SendNotification(output, "textDocument/publishDiagnostics", new JsonObject + { + ["uri"] = uri, + ["diagnostics"] = new JsonArray() + }); + } + } + + private string? TryLoadSourceForUri(string uri) + { + if (_documents.TryGetValue(uri, out var text)) + { + return text; + } + + if (!Uri.TryCreate(uri, UriKind.Absolute, out var parsed) || + !string.Equals(parsed.Scheme, "file", StringComparison.OrdinalIgnoreCase)) + { + return null; } + + var sourcePath = parsed.LocalPath; + return File.Exists(sourcePath) ? File.ReadAllText(sourcePath) : null; + } + + private static void PublishDiagnostics(Stream output, string uri, string text) + { + var diagnosticsParams = LspHandlers.CreateDiagnosticsParams(uri, text); + SendNotification(output, "textDocument/publishDiagnostics", diagnosticsParams); } private static void SendResponse(Stream output, JsonNode id, JsonNode? result) @@ -171,4 +207,16 @@ private static void SendError(Stream output, JsonNode id, int code, string messa JsonRpcWire.WriteMessage(output, payload.ToJsonString()); } + + private static void SendNotification(Stream output, string method, JsonObject @params) + { + var payload = new JsonObject + { + ["jsonrpc"] = "2.0", + ["method"] = method, + ["params"] = @params + }; + + JsonRpcWire.WriteMessage(output, payload.ToJsonString()); + } } diff --git a/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs index 311141e..08974ea 100644 --- a/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs +++ b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs @@ -104,3 +104,165 @@ type CSharpServerCoreTests () = finally try shutdown client with _ -> () LspClient.stop client + + [] + member _.``CSharp server didOpen publishes parse diagnostics`` () = + let client = LspClient.startCSharp () + try + initialize client + + let uri = "file:///tmp/csharp-diagnostics-test.fss" + let td = JsonObject() + td["uri"] <- JsonValue.Create(uri) + td["languageId"] <- JsonValue.Create("fscript") + td["version"] <- JsonValue.Create(1) + td["text"] <- JsonValue.Create("let x =") + + let didOpenParams = JsonObject() + didOpenParams["textDocument"] <- td + LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) + + let diagMsg = + LspClient.readUntil client 10000 (fun msg -> + match msg["method"] with + | :? JsonValue as mv when (try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false) -> + match msg["params"] with + | :? JsonObject as p -> + match p["uri"], p["diagnostics"] with + | :? JsonValue as u, (:? JsonArray as diagnosticsArray) -> + (try u.GetValue() = uri with _ -> false) && (diagnosticsArray.Count > 0) + | _ -> false + | _ -> false + | _ -> false) + + let hasParseCode = + match diagMsg["params"] with + | :? JsonObject as p -> + match p["diagnostics"] with + | :? JsonArray as diagnostics -> + diagnostics + |> Seq.exists (fun diag -> + match diag with + | :? JsonObject as d -> + match d["code"] with + | :? JsonValue as codeValue -> + try codeValue.GetValue() = "parse" with _ -> false + | _ -> false + | _ -> false) + | _ -> false + | _ -> false + + hasParseCode |> should equal true + finally + try shutdown client with _ -> () + LspClient.stop client + + [] + member _.``CSharp server viewAst returns program JSON`` () = + let client = LspClient.startCSharp () + try + initialize client + + let uri = "file:///tmp/csharp-view-ast-test.fss" + let source = "let value = 42\nvalue\n" + + let td = JsonObject() + td["uri"] <- JsonValue.Create(uri) + td["languageId"] <- JsonValue.Create("fscript") + td["version"] <- JsonValue.Create(1) + td["text"] <- JsonValue.Create(source) + + let didOpenParams = JsonObject() + didOpenParams["textDocument"] <- td + LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) + LspClient.readUntil client 10000 (fun msg -> + match msg["method"] with + | :? JsonValue as mv -> + try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false + | _ -> false) + |> ignore + + let requestParams = JsonObject() + let textDocument = JsonObject() + textDocument["uri"] <- JsonValue.Create(uri) + requestParams["textDocument"] <- textDocument + + LspClient.sendRequest client 45 "fscript/viewAst" (Some requestParams) + let response = + LspClient.readUntil client 10000 (fun msg -> + match msg["id"] with + | :? JsonValue as idv -> + try idv.GetValue() = 45 with _ -> false + | _ -> false) + + let kindValue = + match response["result"] with + | :? JsonObject as result -> + match result["data"] with + | :? JsonObject as data -> + match data["kind"] with + | :? JsonValue as value -> + try value.GetValue() with _ -> "" + | _ -> "" + | _ -> "" + | _ -> "" + + kindValue |> should equal "program" + finally + try shutdown client with _ -> () + LspClient.stop client + + [] + member _.``CSharp server viewInferredAst returns typed program JSON`` () = + let client = LspClient.startCSharp () + try + initialize client + + let uri = "file:///tmp/csharp-view-inferred-test.fss" + let source = "let inc x = x + 1\ninc 1\n" + + let td = JsonObject() + td["uri"] <- JsonValue.Create(uri) + td["languageId"] <- JsonValue.Create("fscript") + td["version"] <- JsonValue.Create(1) + td["text"] <- JsonValue.Create(source) + + let didOpenParams = JsonObject() + didOpenParams["textDocument"] <- td + LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) + LspClient.readUntil client 10000 (fun msg -> + match msg["method"] with + | :? JsonValue as mv -> + try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false + | _ -> false) + |> ignore + + let requestParams = JsonObject() + let textDocument = JsonObject() + textDocument["uri"] <- JsonValue.Create(uri) + requestParams["textDocument"] <- textDocument + + LspClient.sendRequest client 46 "fscript/viewInferredAst" (Some requestParams) + let response = + LspClient.readUntil client 10000 (fun msg -> + match msg["id"] with + | :? JsonValue as idv -> + try idv.GetValue() = 46 with _ -> false + | _ -> false) + + let kindValue = + match response["result"] with + | :? JsonObject as result -> + match result["data"] with + | :? JsonObject as data -> + match data["kind"] with + | :? JsonValue as value -> + try value.GetValue() with _ -> "" + | _ -> "" + | _ -> "" + | _ -> "" + + kindValue |> should equal "typedProgram" + finally + try shutdown client with _ -> () + LspClient.stop client From 828d4d55c74f6e6e71ee58ed544c2ebb3d1a5aec Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:07:32 +0100 Subject: [PATCH 04/14] feat(lsp-csharp): switch to full dispatch parity and default host --- .github/workflows/on-push-tag.yml | 2 +- CHANGELOG.md | 1 + docs/architecture/assemblies-and-roles.md | 5 +- .../LspServer.cs | 228 +++++++----------- .../LspTestClient.fs | 7 +- vscode-fscript/extension.js | 14 +- 6 files changed, 111 insertions(+), 146 deletions(-) diff --git a/.github/workflows/on-push-tag.yml b/.github/workflows/on-push-tag.yml index 6eed98a..9ce7621 100644 --- a/.github/workflows/on-push-tag.yml +++ b/.github/workflows/on-push-tag.yml @@ -45,7 +45,7 @@ jobs: shell: bash run: | rm -rf vscode-fscript/server - dotnet publish src/FScript.LanguageServer/FScript.LanguageServer.fsproj -c Release -p:PublishAot=false -o vscode-fscript/server + dotnet publish src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj -c Release -p:PublishAot=false -o vscode-fscript/server - name: Install extension packaging tool run: npm install -g @vscode/vsce@3.5 diff --git a/CHANGELOG.md b/CHANGELOG.md index 66a3cc6..c8d6001 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ All notable changes to FScript are documented in this file. - Added `FScript.LanguageServer.CSharp` host executable as the migration entrypoint for C#-owned LSP startup. - Added a first native C# LSP server core (JSON-RPC transport, initialize/shutdown, text sync, and stdlib-source request) with dedicated integration tests. - Extended the native C# LSP core with diagnostics publishing and `viewAst`/`viewInferredAst` command handling. +- Switched C# LSP host to full-method dispatch parity via shared handlers, made it the default test target, and updated extension/tag packaging to use `FScript.LanguageServer.CSharp.dll`. ## [0.33.0] diff --git a/docs/architecture/assemblies-and-roles.md b/docs/architecture/assemblies-and-roles.md index 26d9b01..2c5c4ec 100644 --- a/docs/architecture/assemblies-and-roles.md +++ b/docs/architecture/assemblies-and-roles.md @@ -74,8 +74,9 @@ Role: - C# host executable for the Language Server process. Responsibilities: -- Provide a C# process entrypoint for LSP startup. -- Serve as migration anchor while preserving current LSP protocol behavior. +- Provide the production C# process host for LSP startup/dispatch. +- Execute the full LSP method surface used by the VS Code extension. +- Keep protocol behavior aligned with existing language/runtime analysis services. Use this when: - You want C# ownership of the server host process while reusing existing language services. diff --git a/src/FScript.LanguageServer.CSharp/LspServer.cs b/src/FScript.LanguageServer.CSharp/LspServer.cs index 8038164..e37eb39 100644 --- a/src/FScript.LanguageServer.CSharp/LspServer.cs +++ b/src/FScript.LanguageServer.CSharp/LspServer.cs @@ -1,16 +1,17 @@ using System.Text.Json.Nodes; +using Microsoft.FSharp.Core; +using FSLspHandlers = FScript.LanguageServer.LspHandlers; +using FSLspProtocol = FScript.LanguageServer.LspProtocol; namespace FScript.LanguageServer.CSharp; internal sealed class LspServer { - private readonly Dictionary _documents = new(StringComparer.Ordinal); private bool _shutdownRequested; public void Run() { var input = Console.OpenStandardInput(); - var output = Console.OpenStandardOutput(); while (true) { @@ -36,187 +37,140 @@ public void Run() } var method = message["method"]?.GetValue(); - var id = message["id"]; - var @params = message["params"] as JsonObject; + var idNode = message["id"]; + var paramsObj = message["params"] as JsonObject; - if (method is null) + if (string.IsNullOrWhiteSpace(method)) { continue; } - if (id is null) + try { - HandleNotification(output, method, @params); - if (_shutdownRequested && string.Equals(method, "exit", StringComparison.Ordinal)) + if (idNode is null) { - break; + HandleNotification(method!, paramsObj); + if (_shutdownRequested && string.Equals(method, "exit", StringComparison.Ordinal)) + { + break; + } + } + else + { + HandleRequest(idNode, method!, paramsObj); } - - continue; } - - HandleRequest(output, id, method, @params); + catch (Exception ex) + { + var payload = new JsonObject + { + ["type"] = 1, + ["message"] = $"FScript LSP internal error (C# host): {ex.Message}" + }; + FSLspProtocol.sendNotification("window/logMessage", FSharpOption.Some(payload)); + } } } - private void HandleNotification(Stream output, string method, JsonObject? @params) + private static void HandleNotification(string method, JsonObject? paramsObj) { switch (method) { + case "initialized": + break; case "textDocument/didOpen": - HandleDidOpen(output, @params); + if (paramsObj is not null) + { + FSLspHandlers.handleDidOpen(paramsObj); + } break; case "textDocument/didChange": - HandleDidChange(output, @params); + if (paramsObj is not null) + { + FSLspHandlers.handleDidChange(paramsObj); + } break; case "textDocument/didClose": - HandleDidClose(output, @params); + if (paramsObj is not null) + { + FSLspHandlers.handleDidClose(paramsObj); + } break; case "exit": break; } } - private void HandleRequest(Stream output, JsonNode id, string method, JsonObject? @params) + private void HandleRequest(JsonNode idNode, string method, JsonObject? paramsObj) { switch (method) { case "initialize": - SendResponse(output, id, LspHandlers.CreateInitializeResult()); + FSLspHandlers.handleInitialize(idNode, paramsObj is null ? FSharpOption.None : FSharpOption.Some(paramsObj)); break; case "shutdown": _shutdownRequested = true; - SendResponse(output, id, null); + FSLspProtocol.sendResponse(idNode, FSharpOption.None); + break; + case "textDocument/completion": + if (paramsObj is not null) FSLspHandlers.handleCompletion(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/semanticTokens/full": + if (paramsObj is not null) FSLspHandlers.handleSemanticTokens(idNode, paramsObj); else SendInvalidParams(idNode); break; case "textDocument/hover": - SendResponse(output, id, null); + if (paramsObj is not null) FSLspHandlers.handleHover(idNode, paramsObj); else SendInvalidParams(idNode); break; - case "fscript/stdlibSource": - SendResponse(output, id, LspHandlers.HandleStdlibSource(@params)); + case "textDocument/definition": + if (paramsObj is not null) FSLspHandlers.handleDefinition(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/typeDefinition": + if (paramsObj is not null) FSLspHandlers.handleTypeDefinition(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/documentSymbol": + if (paramsObj is not null) FSLspHandlers.handleDocumentSymbol(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/references": + if (paramsObj is not null) FSLspHandlers.handleReferences(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/documentHighlight": + if (paramsObj is not null) FSLspHandlers.handleDocumentHighlight(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/signatureHelp": + if (paramsObj is not null) FSLspHandlers.handleSignatureHelp(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/rename": + if (paramsObj is not null) FSLspHandlers.handleRename(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/prepareRename": + if (paramsObj is not null) FSLspHandlers.handlePrepareRename(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "workspace/symbol": + if (paramsObj is not null) FSLspHandlers.handleWorkspaceSymbol(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/codeAction": + if (paramsObj is not null) FSLspHandlers.handleCodeAction(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "textDocument/inlayHint": + if (paramsObj is not null) FSLspHandlers.handleInlayHints(idNode, paramsObj); else SendInvalidParams(idNode); break; case "fscript/viewAst": - SendResponse(output, id, LspHandlers.HandleViewAst(@params, TryLoadSourceForUri)); + if (paramsObj is not null) FSLspHandlers.handleViewAst(idNode, paramsObj); else SendInvalidParams(idNode); break; case "fscript/viewInferredAst": - SendResponse(output, id, LspHandlers.HandleViewInferredAst(@params, TryLoadSourceForUri)); + if (paramsObj is not null) FSLspHandlers.handleViewInferredAst(idNode, paramsObj); else SendInvalidParams(idNode); + break; + case "fscript/stdlibSource": + if (paramsObj is not null) FSLspHandlers.handleStdlibSource(idNode, paramsObj); else SendInvalidParams(idNode); break; default: - SendError(output, id, -32601, $"Method not found: {method}"); + FSLspProtocol.sendError(idNode, -32601, "Method not found"); break; } } - private void HandleDidOpen(Stream output, JsonObject? @params) - { - var textDocument = @params?["textDocument"] as JsonObject; - var uri = textDocument?["uri"]?.GetValue(); - var text = textDocument?["text"]?.GetValue(); - if (!string.IsNullOrEmpty(uri) && text is not null) - { - _documents[uri] = text; - PublishDiagnostics(output, uri, text); - } - } - - private void HandleDidChange(Stream output, JsonObject? @params) + private static void SendInvalidParams(JsonNode idNode) { - var textDocument = @params?["textDocument"] as JsonObject; - var uri = textDocument?["uri"]?.GetValue(); - if (string.IsNullOrEmpty(uri)) - { - return; - } - - var changes = @params?["contentChanges"] as JsonArray; - if (changes is null || changes.Count == 0) - { - return; - } - - var last = changes[changes.Count - 1] as JsonObject; - var text = last?["text"]?.GetValue(); - if (text is not null) - { - _documents[uri] = text; - PublishDiagnostics(output, uri, text); - } - } - - private void HandleDidClose(Stream output, JsonObject? @params) - { - var textDocument = @params?["textDocument"] as JsonObject; - var uri = textDocument?["uri"]?.GetValue(); - if (!string.IsNullOrEmpty(uri)) - { - _documents.Remove(uri); - SendNotification(output, "textDocument/publishDiagnostics", new JsonObject - { - ["uri"] = uri, - ["diagnostics"] = new JsonArray() - }); - } - } - - private string? TryLoadSourceForUri(string uri) - { - if (_documents.TryGetValue(uri, out var text)) - { - return text; - } - - if (!Uri.TryCreate(uri, UriKind.Absolute, out var parsed) || - !string.Equals(parsed.Scheme, "file", StringComparison.OrdinalIgnoreCase)) - { - return null; - } - - var sourcePath = parsed.LocalPath; - return File.Exists(sourcePath) ? File.ReadAllText(sourcePath) : null; - } - - private static void PublishDiagnostics(Stream output, string uri, string text) - { - var diagnosticsParams = LspHandlers.CreateDiagnosticsParams(uri, text); - SendNotification(output, "textDocument/publishDiagnostics", diagnosticsParams); - } - - private static void SendResponse(Stream output, JsonNode id, JsonNode? result) - { - var payload = new JsonObject - { - ["jsonrpc"] = "2.0", - ["id"] = id.DeepClone(), - ["result"] = result - }; - - JsonRpcWire.WriteMessage(output, payload.ToJsonString()); - } - - private static void SendError(Stream output, JsonNode id, int code, string message) - { - var payload = new JsonObject - { - ["jsonrpc"] = "2.0", - ["id"] = id.DeepClone(), - ["error"] = new JsonObject - { - ["code"] = code, - ["message"] = message - } - }; - - JsonRpcWire.WriteMessage(output, payload.ToJsonString()); - } - - private static void SendNotification(Stream output, string method, JsonObject @params) - { - var payload = new JsonObject - { - ["jsonrpc"] = "2.0", - ["method"] = method, - ["params"] = @params - }; - - JsonRpcWire.WriteMessage(output, payload.ToJsonString()); + FSLspProtocol.sendError(idNode, -32602, "Invalid params"); } } diff --git a/tests/FScript.LanguageServer.Tests/LspTestClient.fs b/tests/FScript.LanguageServer.Tests/LspTestClient.fs index 771e3de..33c4204 100644 --- a/tests/FScript.LanguageServer.Tests/LspTestClient.fs +++ b/tests/FScript.LanguageServer.Tests/LspTestClient.fs @@ -81,7 +81,7 @@ module internal LspClient = serverDll) - let start () = + let startFSharp () = let serverDll = ensureServerDllBuilt.Value let psi = @@ -102,7 +102,7 @@ module internal LspClient = Input = proc.StandardInput.BaseStream Output = proc.StandardOutput.BaseStream } - let startCSharp () = + let start () = let serverDll = ensureCSharpServerDllBuilt.Value let psi = @@ -123,6 +123,9 @@ module internal LspClient = Input = proc.StandardInput.BaseStream Output = proc.StandardOutput.BaseStream } + let startCSharp () = + start () + let stop (client: Client) = if not client.Process.HasExited then try diff --git a/vscode-fscript/extension.js b/vscode-fscript/extension.js index 6cf443f..3f8a0dd 100644 --- a/vscode-fscript/extension.js +++ b/vscode-fscript/extension.js @@ -76,7 +76,7 @@ async function createServerOptions(context, config) { ); } - const packagedDll = path.join(context.extensionPath, 'server', 'FScript.LanguageServer.dll'); + const packagedDll = path.join(context.extensionPath, 'server', 'FScript.LanguageServer.CSharp.dll'); if (fs.existsSync(packagedDll)) { return { @@ -92,16 +92,22 @@ async function createServerOptions(context, config) { return null; } - const projectPath = path.resolve(context.extensionPath, '..', 'src', 'FScript.LanguageServer', 'FScript.LanguageServer.fsproj'); + const projectPath = path.resolve( + context.extensionPath, + '..', + 'src', + 'FScript.LanguageServer.CSharp', + 'FScript.LanguageServer.CSharp.csproj' + ); const outputDll = path.resolve( context.extensionPath, '..', 'src', - 'FScript.LanguageServer', + 'FScript.LanguageServer.CSharp', 'bin', 'Debug', 'net10.0', - 'FScript.LanguageServer.dll' + 'FScript.LanguageServer.CSharp.dll' ); if (!hasDotnetSdkOnPath()) { From 3eae56ae7ff42fb76fd49e1cc8bc43bfd3bf7007 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:13:12 +0100 Subject: [PATCH 05/14] Replace F# LSP executable with C# server --- .github/workflows/on-push-tag.yml | 2 +- CHANGELOG.md | 5 +- FScript.sln | 58 ++++++------ docs/architecture/assemblies-and-roles.md | 15 +++- .../AstJson.fs | 0 .../FScript.LanguageServer.Core.fsproj} | 4 - .../LspHandlers.fs | 0 .../LspModel.fs | 0 .../LspProtocol.fs | 0 .../LspRuntimeExterns.fs | 0 .../LspSymbols.fs | 0 .../FScript.LanguageServer.csproj} | 2 +- .../JsonRpcWire.cs | 0 .../LspHandlers.cs | 0 .../LspServer.cs | 0 src/FScript.LanguageServer/LspServer.fs | 90 ------------------- .../Program.cs | 0 src/FScript.LanguageServer/Program.fs | 6 -- .../LspTestClient.fs | 8 +- vscode-fscript/README.md | 2 +- vscode-fscript/extension.js | 10 +-- 21 files changed, 57 insertions(+), 145 deletions(-) rename src/{FScript.LanguageServer => FScript.LanguageServer.Core}/AstJson.fs (100%) rename src/{FScript.LanguageServer/FScript.LanguageServer.fsproj => FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj} (83%) rename src/{FScript.LanguageServer => FScript.LanguageServer.Core}/LspHandlers.fs (100%) rename src/{FScript.LanguageServer => FScript.LanguageServer.Core}/LspModel.fs (100%) rename src/{FScript.LanguageServer => FScript.LanguageServer.Core}/LspProtocol.fs (100%) rename src/{FScript.LanguageServer => FScript.LanguageServer.Core}/LspRuntimeExterns.fs (100%) rename src/{FScript.LanguageServer => FScript.LanguageServer.Core}/LspSymbols.fs (100%) rename src/{FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj => FScript.LanguageServer/FScript.LanguageServer.csproj} (77%) rename src/{FScript.LanguageServer.CSharp => FScript.LanguageServer}/JsonRpcWire.cs (100%) rename src/{FScript.LanguageServer.CSharp => FScript.LanguageServer}/LspHandlers.cs (100%) rename src/{FScript.LanguageServer.CSharp => FScript.LanguageServer}/LspServer.cs (100%) delete mode 100644 src/FScript.LanguageServer/LspServer.fs rename src/{FScript.LanguageServer.CSharp => FScript.LanguageServer}/Program.cs (100%) delete mode 100644 src/FScript.LanguageServer/Program.fs diff --git a/.github/workflows/on-push-tag.yml b/.github/workflows/on-push-tag.yml index 9ce7621..5c8b231 100644 --- a/.github/workflows/on-push-tag.yml +++ b/.github/workflows/on-push-tag.yml @@ -45,7 +45,7 @@ jobs: shell: bash run: | rm -rf vscode-fscript/server - dotnet publish src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj -c Release -p:PublishAot=false -o vscode-fscript/server + dotnet publish src/FScript.LanguageServer/FScript.LanguageServer.csproj -c Release -p:PublishAot=false -o vscode-fscript/server - name: Install extension packaging tool run: npm install -g @vscode/vsce@3.5 diff --git a/CHANGELOG.md b/CHANGELOG.md index c8d6001..2d376e1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,10 +6,11 @@ All notable changes to FScript are documented in this file. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. -- Added `FScript.LanguageServer.CSharp` host executable as the migration entrypoint for C#-owned LSP startup. +- Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup. - Added a first native C# LSP server core (JSON-RPC transport, initialize/shutdown, text sync, and stdlib-source request) with dedicated integration tests. - Extended the native C# LSP core with diagnostics publishing and `viewAst`/`viewInferredAst` command handling. -- Switched C# LSP host to full-method dispatch parity via shared handlers, made it the default test target, and updated extension/tag packaging to use `FScript.LanguageServer.CSharp.dll`. +- Switched C# LSP host to full-method dispatch parity via shared handlers, made it the default test target, and updated extension/tag packaging to use `FScript.LanguageServer.dll`. +- Replaced the F# LSP server executable with `FScript.LanguageServer` (C#) and moved F# LSP logic into `FScript.LanguageServer.Core`. ## [0.33.0] diff --git a/FScript.sln b/FScript.sln index dad0924..df81c3d 100644 --- a/FScript.sln +++ b/FScript.sln @@ -17,13 +17,13 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.Runtime", "src\FScr EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.Runtime.Tests", "tests\FScript.Runtime.Tests\FScript.Runtime.Tests.fsproj", "{1E2C7B34-04B8-42C9-880D-CC47DEC156A7}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer", "src\FScript.LanguageServer\FScript.LanguageServer.fsproj", "{E22A34B5-F5E8-422D-9BA5-932B3C45188F}" -EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer.Tests", "tests\FScript.LanguageServer.Tests\FScript.LanguageServer.Tests.fsproj", "{B734E1E1-59C2-47E0-8D19-A9C5C95938F1}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.CSharpInterop", "src\FScript.CSharpInterop\FScript.CSharpInterop.fsproj", "{8A28B784-F90B-469C-91BE-F96F63ACEA32}" EndProject -Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "FScript.LanguageServer.CSharp", "src\FScript.LanguageServer.CSharp\FScript.LanguageServer.CSharp.csproj", "{78A97951-E42C-41EF-9A9E-BD33648A4C81}" +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer.Core", "src\FScript.LanguageServer.Core\FScript.LanguageServer.Core.fsproj", "{ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "FScript.LanguageServer", "src\FScript.LanguageServer\FScript.LanguageServer.csproj", "{57518676-01F0-4D5B-A53B-7A06DBA9AA04}" EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution @@ -95,18 +95,6 @@ Global {1E2C7B34-04B8-42C9-880D-CC47DEC156A7}.Release|x64.Build.0 = Release|Any CPU {1E2C7B34-04B8-42C9-880D-CC47DEC156A7}.Release|x86.ActiveCfg = Release|Any CPU {1E2C7B34-04B8-42C9-880D-CC47DEC156A7}.Release|x86.Build.0 = Release|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Debug|Any CPU.Build.0 = Debug|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Debug|x64.ActiveCfg = Debug|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Debug|x64.Build.0 = Debug|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Debug|x86.ActiveCfg = Debug|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Debug|x86.Build.0 = Debug|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Release|Any CPU.ActiveCfg = Release|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Release|Any CPU.Build.0 = Release|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Release|x64.ActiveCfg = Release|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Release|x64.Build.0 = Release|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Release|x86.ActiveCfg = Release|Any CPU - {E22A34B5-F5E8-422D-9BA5-932B3C45188F}.Release|x86.Build.0 = Release|Any CPU {B734E1E1-59C2-47E0-8D19-A9C5C95938F1}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {B734E1E1-59C2-47E0-8D19-A9C5C95938F1}.Debug|Any CPU.Build.0 = Debug|Any CPU {B734E1E1-59C2-47E0-8D19-A9C5C95938F1}.Debug|x64.ActiveCfg = Debug|Any CPU @@ -131,18 +119,30 @@ Global {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x64.Build.0 = Release|Any CPU {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x86.ActiveCfg = Release|Any CPU {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x86.Build.0 = Release|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|Any CPU.Build.0 = Debug|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x64.ActiveCfg = Debug|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x64.Build.0 = Debug|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x86.ActiveCfg = Debug|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Debug|x86.Build.0 = Debug|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|Any CPU.ActiveCfg = Release|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|Any CPU.Build.0 = Release|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x64.ActiveCfg = Release|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x64.Build.0 = Release|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x86.ActiveCfg = Release|Any CPU - {78A97951-E42C-41EF-9A9E-BD33648A4C81}.Release|x86.Build.0 = Release|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|Any CPU.Build.0 = Debug|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x64.ActiveCfg = Debug|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x64.Build.0 = Debug|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x86.ActiveCfg = Debug|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x86.Build.0 = Debug|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|Any CPU.ActiveCfg = Release|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|Any CPU.Build.0 = Release|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x64.ActiveCfg = Release|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x64.Build.0 = Release|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x86.ActiveCfg = Release|Any CPU + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x86.Build.0 = Release|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|Any CPU.Build.0 = Debug|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|x64.ActiveCfg = Debug|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|x64.Build.0 = Debug|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|x86.ActiveCfg = Debug|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|x86.Build.0 = Debug|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Release|Any CPU.ActiveCfg = Release|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Release|Any CPU.Build.0 = Release|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Release|x64.ActiveCfg = Release|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Release|x64.Build.0 = Release|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Release|x86.ActiveCfg = Release|Any CPU + {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Release|x86.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE @@ -153,9 +153,9 @@ Global {9C62883E-EFB0-4D9E-84F3-4138C123F55E} = {0AB3BF05-4346-4AA6-1389-037BE0695223} {8C2C5767-857A-44B0-80C2-DC90E0A60F4D} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} {1E2C7B34-04B8-42C9-880D-CC47DEC156A7} = {0AB3BF05-4346-4AA6-1389-037BE0695223} - {E22A34B5-F5E8-422D-9BA5-932B3C45188F} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} {B734E1E1-59C2-47E0-8D19-A9C5C95938F1} = {0AB3BF05-4346-4AA6-1389-037BE0695223} {8A28B784-F90B-469C-91BE-F96F63ACEA32} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} - {78A97951-E42C-41EF-9A9E-BD33648A4C81} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} + {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} + {57518676-01F0-4D5B-A53B-7A06DBA9AA04} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} EndGlobalSection EndGlobal diff --git a/docs/architecture/assemblies-and-roles.md b/docs/architecture/assemblies-and-roles.md index 2c5c4ec..356ccb1 100644 --- a/docs/architecture/assemblies-and-roles.md +++ b/docs/architecture/assemblies-and-roles.md @@ -69,7 +69,18 @@ Use this when: - You integrate FScript from C# and want to avoid direct F# compiler/runtime internals. - You build tooling services (for example LSP hosts) with a stable boundary. -### `FScript.LanguageServer.CSharp` +### `FScript.LanguageServer.Core` +Role: +- F# LSP analysis/core module library. + +Responsibilities: +- Keep LSP document state, analysis, symbol, and protocol helper modules. +- Provide reusable LSP method handlers consumed by the C# host. + +Use this when: +- You need the existing F# LSP analysis/handler implementation without running an F# server executable. + +### `FScript.LanguageServer` Role: - C# host executable for the Language Server process. @@ -99,7 +110,7 @@ Use this when: - `FScript.Language` has no dependency on `FScript.Runtime`. - `FScript.Runtime` depends on `FScript.Language` types. - `FScript.CSharpInterop` depends on both `FScript.Language` and `FScript.Runtime`. -- `FScript.LanguageServer.CSharp` depends on `FScript.LanguageServer`. +- `FScript.LanguageServer` depends on `FScript.LanguageServer.Core`. - `FScript` depends on both `FScript.Language` and `FScript.Runtime`. This keeps the language engine reusable while runtime capabilities remain host-configurable. diff --git a/src/FScript.LanguageServer/AstJson.fs b/src/FScript.LanguageServer.Core/AstJson.fs similarity index 100% rename from src/FScript.LanguageServer/AstJson.fs rename to src/FScript.LanguageServer.Core/AstJson.fs diff --git a/src/FScript.LanguageServer/FScript.LanguageServer.fsproj b/src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj similarity index 83% rename from src/FScript.LanguageServer/FScript.LanguageServer.fsproj rename to src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj index 90190d1..d92a9a7 100644 --- a/src/FScript.LanguageServer/FScript.LanguageServer.fsproj +++ b/src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj @@ -1,10 +1,8 @@ - Exe net10.0 enable - false @@ -14,8 +12,6 @@ - - diff --git a/src/FScript.LanguageServer/LspHandlers.fs b/src/FScript.LanguageServer.Core/LspHandlers.fs similarity index 100% rename from src/FScript.LanguageServer/LspHandlers.fs rename to src/FScript.LanguageServer.Core/LspHandlers.fs diff --git a/src/FScript.LanguageServer/LspModel.fs b/src/FScript.LanguageServer.Core/LspModel.fs similarity index 100% rename from src/FScript.LanguageServer/LspModel.fs rename to src/FScript.LanguageServer.Core/LspModel.fs diff --git a/src/FScript.LanguageServer/LspProtocol.fs b/src/FScript.LanguageServer.Core/LspProtocol.fs similarity index 100% rename from src/FScript.LanguageServer/LspProtocol.fs rename to src/FScript.LanguageServer.Core/LspProtocol.fs diff --git a/src/FScript.LanguageServer/LspRuntimeExterns.fs b/src/FScript.LanguageServer.Core/LspRuntimeExterns.fs similarity index 100% rename from src/FScript.LanguageServer/LspRuntimeExterns.fs rename to src/FScript.LanguageServer.Core/LspRuntimeExterns.fs diff --git a/src/FScript.LanguageServer/LspSymbols.fs b/src/FScript.LanguageServer.Core/LspSymbols.fs similarity index 100% rename from src/FScript.LanguageServer/LspSymbols.fs rename to src/FScript.LanguageServer.Core/LspSymbols.fs diff --git a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj b/src/FScript.LanguageServer/FScript.LanguageServer.csproj similarity index 77% rename from src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj rename to src/FScript.LanguageServer/FScript.LanguageServer.csproj index c8910a4..6630e7c 100644 --- a/src/FScript.LanguageServer.CSharp/FScript.LanguageServer.CSharp.csproj +++ b/src/FScript.LanguageServer/FScript.LanguageServer.csproj @@ -8,6 +8,6 @@ - + diff --git a/src/FScript.LanguageServer.CSharp/JsonRpcWire.cs b/src/FScript.LanguageServer/JsonRpcWire.cs similarity index 100% rename from src/FScript.LanguageServer.CSharp/JsonRpcWire.cs rename to src/FScript.LanguageServer/JsonRpcWire.cs diff --git a/src/FScript.LanguageServer.CSharp/LspHandlers.cs b/src/FScript.LanguageServer/LspHandlers.cs similarity index 100% rename from src/FScript.LanguageServer.CSharp/LspHandlers.cs rename to src/FScript.LanguageServer/LspHandlers.cs diff --git a/src/FScript.LanguageServer.CSharp/LspServer.cs b/src/FScript.LanguageServer/LspServer.cs similarity index 100% rename from src/FScript.LanguageServer.CSharp/LspServer.cs rename to src/FScript.LanguageServer/LspServer.cs diff --git a/src/FScript.LanguageServer/LspServer.fs b/src/FScript.LanguageServer/LspServer.fs deleted file mode 100644 index 7fb4220..0000000 --- a/src/FScript.LanguageServer/LspServer.fs +++ /dev/null @@ -1,90 +0,0 @@ -namespace FScript.LanguageServer - -open System -open System.Text.Json.Nodes - -module LspServer = - open LspModel - - let run () = - let mutable keepRunning = true - let mutable shutdownReceived = false - - while keepRunning do - match LspProtocol.tryReadMessage () with - | None -> keepRunning <- false - | Some payload -> - try - match JsonNode.Parse(payload) with - | null -> () - | rootNode -> - match asObject rootNode with - | None -> () - | Some root -> - let methodName = tryGetString root "method" - let idNode = tryGetNode root "id" - let paramsObj = tryGetObject root "params" - - match methodName, idNode, paramsObj with - | Some "initialize", Some idNode, paramsObj -> - LspHandlers.handleInitialize idNode paramsObj - | Some "initialized", _, _ -> - () - | Some "shutdown", Some idNode, _ -> - shutdownReceived <- true - LspProtocol.sendResponse idNode None - | Some "exit", _, _ -> - keepRunning <- false - if shutdownReceived then - Environment.ExitCode <- 0 - else - Environment.ExitCode <- 1 - | Some "textDocument/didOpen", _, Some paramsObj -> - LspHandlers.handleDidOpen paramsObj - | Some "textDocument/didChange", _, Some paramsObj -> - LspHandlers.handleDidChange paramsObj - | Some "textDocument/didClose", _, Some paramsObj -> - LspHandlers.handleDidClose paramsObj - | Some "textDocument/completion", Some idNode, Some paramsObj -> - LspHandlers.handleCompletion idNode paramsObj - | Some "textDocument/semanticTokens/full", Some idNode, Some paramsObj -> - LspHandlers.handleSemanticTokens idNode paramsObj - | Some "textDocument/hover", Some idNode, Some paramsObj -> - LspHandlers.handleHover idNode paramsObj - | Some "textDocument/definition", Some idNode, Some paramsObj -> - LspHandlers.handleDefinition idNode paramsObj - | Some "textDocument/typeDefinition", Some idNode, Some paramsObj -> - LspHandlers.handleTypeDefinition idNode paramsObj - | Some "textDocument/documentSymbol", Some idNode, Some paramsObj -> - LspHandlers.handleDocumentSymbol idNode paramsObj - | Some "textDocument/references", Some idNode, Some paramsObj -> - LspHandlers.handleReferences idNode paramsObj - | Some "textDocument/documentHighlight", Some idNode, Some paramsObj -> - LspHandlers.handleDocumentHighlight idNode paramsObj - | Some "textDocument/signatureHelp", Some idNode, Some paramsObj -> - LspHandlers.handleSignatureHelp idNode paramsObj - | Some "textDocument/rename", Some idNode, Some paramsObj -> - LspHandlers.handleRename idNode paramsObj - | Some "textDocument/prepareRename", Some idNode, Some paramsObj -> - LspHandlers.handlePrepareRename idNode paramsObj - | Some "workspace/symbol", Some idNode, Some paramsObj -> - LspHandlers.handleWorkspaceSymbol idNode paramsObj - | Some "textDocument/codeAction", Some idNode, Some paramsObj -> - LspHandlers.handleCodeAction idNode paramsObj - | Some "textDocument/inlayHint", Some idNode, Some paramsObj -> - LspHandlers.handleInlayHints idNode paramsObj - | Some "fscript/viewAst", Some idNode, Some paramsObj -> - LspHandlers.handleViewAst idNode paramsObj - | Some "fscript/viewInferredAst", Some idNode, Some paramsObj -> - LspHandlers.handleViewInferredAst idNode paramsObj - | Some "fscript/stdlibSource", Some idNode, Some paramsObj -> - LspHandlers.handleStdlibSource idNode paramsObj - | Some _, Some idNode, _ -> - LspProtocol.sendError idNode -32601 "Method not found" - | _ -> () - with ex -> - // Never crash the server loop on malformed input. - let p = JsonObject() - p["type"] <- JsonValue.Create(1) - p["message"] <- JsonValue.Create($"FScript LSP internal error: {ex.Message}") - LspProtocol.sendNotification "window/logMessage" (Some p) diff --git a/src/FScript.LanguageServer.CSharp/Program.cs b/src/FScript.LanguageServer/Program.cs similarity index 100% rename from src/FScript.LanguageServer.CSharp/Program.cs rename to src/FScript.LanguageServer/Program.cs diff --git a/src/FScript.LanguageServer/Program.fs b/src/FScript.LanguageServer/Program.fs deleted file mode 100644 index 5d24c3c..0000000 --- a/src/FScript.LanguageServer/Program.fs +++ /dev/null @@ -1,6 +0,0 @@ -module FScript.LanguageServer.Program - -[] -let main _ = - LspServer.run () - 0 diff --git a/tests/FScript.LanguageServer.Tests/LspTestClient.fs b/tests/FScript.LanguageServer.Tests/LspTestClient.fs index 33c4204..ca8519d 100644 --- a/tests/FScript.LanguageServer.Tests/LspTestClient.fs +++ b/tests/FScript.LanguageServer.Tests/LspTestClient.fs @@ -32,8 +32,8 @@ module internal LspClient = let private ensureServerDllBuilt = lazy ( let root = findRepoRoot () - let serverProject = Path.Combine(root, "src", "FScript.LanguageServer", "FScript.LanguageServer.fsproj") - let serverDll = Path.Combine(root, "src", "FScript.LanguageServer", "bin", "Release", "net10.0", "FScript.LanguageServer.dll") + let serverProject = Path.Combine(root, "src", "FScript.LanguageServer.Core", "FScript.LanguageServer.Core.fsproj") + let serverDll = Path.Combine(root, "src", "FScript.LanguageServer.Core", "bin", "Release", "net10.0", "FScript.LanguageServer.Core.dll") let buildPsi = ProcessStartInfo( @@ -58,8 +58,8 @@ module internal LspClient = let private ensureCSharpServerDllBuilt = lazy ( let root = findRepoRoot () - let serverProject = Path.Combine(root, "src", "FScript.LanguageServer.CSharp", "FScript.LanguageServer.CSharp.csproj") - let serverDll = Path.Combine(root, "src", "FScript.LanguageServer.CSharp", "bin", "Release", "net10.0", "FScript.LanguageServer.CSharp.dll") + let serverProject = Path.Combine(root, "src", "FScript.LanguageServer", "FScript.LanguageServer.csproj") + let serverDll = Path.Combine(root, "src", "FScript.LanguageServer", "bin", "Release", "net10.0", "FScript.LanguageServer.dll") let buildPsi = ProcessStartInfo( diff --git a/vscode-fscript/README.md b/vscode-fscript/README.md index 712b3f8..86e7042 100644 --- a/vscode-fscript/README.md +++ b/vscode-fscript/README.md @@ -54,4 +54,4 @@ The extension starts the language server with one of these strategies: 1. Custom path from `fscript.server.path` (if configured) 2. Packaged server: `server/FScript.LanguageServer.dll` -3. Local development fallback: builds `../src/FScript.LanguageServer/FScript.LanguageServer.fsproj` and runs `bin/Debug/net10.0/FScript.LanguageServer.dll` +3. Local development fallback: builds `../src/FScript.LanguageServer/FScript.LanguageServer.csproj` and runs `bin/Debug/net10.0/FScript.LanguageServer.dll` diff --git a/vscode-fscript/extension.js b/vscode-fscript/extension.js index 3f8a0dd..cab264b 100644 --- a/vscode-fscript/extension.js +++ b/vscode-fscript/extension.js @@ -76,7 +76,7 @@ async function createServerOptions(context, config) { ); } - const packagedDll = path.join(context.extensionPath, 'server', 'FScript.LanguageServer.CSharp.dll'); + const packagedDll = path.join(context.extensionPath, 'server', 'FScript.LanguageServer.dll'); if (fs.existsSync(packagedDll)) { return { @@ -96,18 +96,18 @@ async function createServerOptions(context, config) { context.extensionPath, '..', 'src', - 'FScript.LanguageServer.CSharp', - 'FScript.LanguageServer.CSharp.csproj' + 'FScript.LanguageServer', + 'FScript.LanguageServer.csproj' ); const outputDll = path.resolve( context.extensionPath, '..', 'src', - 'FScript.LanguageServer.CSharp', + 'FScript.LanguageServer', 'bin', 'Debug', 'net10.0', - 'FScript.LanguageServer.CSharp.dll' + 'FScript.LanguageServer.dll' ); if (!hasDotnetSdkOnPath()) { From a3e1921514da7a5107546b51f64bef2bcb5dd13f Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:36:29 +0100 Subject: [PATCH 06/14] Fix qualified imported type annotations --- CHANGELOG.md | 1 + src/FScript.Language/Parser.fs | 23 +++++++++-- src/FScript.Language/TypeInfer.fs | 39 +++++++++++++++---- .../IncludeResolverTests.fs | 15 +++++++ tests/FScript.Language.Tests/ParserTests.fs | 7 ++++ 5 files changed, 74 insertions(+), 11 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2d376e1..ae3a880 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,6 +11,7 @@ All notable changes to FScript are documented in this file. - Extended the native C# LSP core with diagnostics publishing and `viewAst`/`viewInferredAst` command handling. - Switched C# LSP host to full-method dispatch parity via shared handlers, made it the default test target, and updated extension/tag packaging to use `FScript.LanguageServer.dll`. - Replaced the F# LSP server executable with `FScript.LanguageServer` (C#) and moved F# LSP logic into `FScript.LanguageServer.Core`. +- Fixed imported qualified type annotations (for example `common.ProjectInfo`) in parser/type inference to prevent false type mismatches. ## [0.33.0] diff --git a/src/FScript.Language/Parser.fs b/src/FScript.Language/Parser.fs index c9977c4..7c51146 100644 --- a/src/FScript.Language/Parser.fs +++ b/src/FScript.Language/Parser.fs @@ -183,12 +183,29 @@ module Parser = let mutable allowIndentedApplication = true let mutable allowBinaryNewlineSkipping = true + let parseQualifiedTypeName () : string = + let first = stream.ExpectIdent("Expected type name") + let firstName = + match first.Kind with + | Ident n -> n + | _ -> "" + let parts = ResizeArray() + parts.Add(firstName) + let mutable keepGoing = true + while keepGoing && stream.Match(Dot) do + let next = stream.ExpectIdent("Expected identifier after '.' in qualified type name") + match next.Kind with + | Ident n -> parts.Add(n) + | _ -> () + keepGoing <- true + String.concat "." parts + let rec parseTypeRefAtom () : TypeRef = stream.SkipNewlines() match stream.Peek().Kind with - | Ident name -> - stream.Next() |> ignore - TRName name + | Ident _ -> + let qualified = parseQualifiedTypeName() + TRName qualified | LBrace -> stream.Next() |> ignore let isStructural = stream.Match(Bar) diff --git a/src/FScript.Language/TypeInfer.fs b/src/FScript.Language/TypeInfer.fs index ce4ff8d..86f89e2 100644 --- a/src/FScript.Language/TypeInfer.fs +++ b/src/FScript.Language/TypeInfer.fs @@ -269,6 +269,26 @@ module TypeInfer = let names = String.concat ", " many raise (TypeException { Message = $"Ambiguous declared record type for fields {shapeText}: {names}"; Span = span }) + let private resolveReferencedTypeName (knownNames: seq) (name: string) (span: Span) : string = + let nameSet = knownNames |> Set.ofSeq + if nameSet.Contains(name) then + name + elif name.Contains(".") then + let shortName = name.Split('.') |> Array.last + let matches = + knownNames + |> Seq.filter (fun candidate -> candidate = shortName || candidate.EndsWith("." + shortName, System.StringComparison.Ordinal)) + |> Seq.distinct + |> Seq.toList + match matches with + | [ single ] -> single + | [] -> name + | many -> + let options = String.concat ", " many + raise (TypeException { Message = $"Ambiguous type reference '{name}'. Candidates: {options}"; Span = span }) + else + name + let rec private annotationTypeFromRef (typeDefs: Map) (span: Span) (tref: TypeRef) : Type = match tref with | TRName "unit" -> TUnit @@ -276,7 +296,9 @@ module TypeInfer = | TRName "float" -> TFloat | TRName "bool" -> TBool | TRName "string" -> TString - | TRName name -> TNamed name + | TRName name -> + let resolvedName = resolveReferencedTypeName typeDefs.Keys name span + TNamed resolvedName | TRTuple ts -> ts |> List.map (annotationTypeFromRef typeDefs span) |> TTuple | TRFun (a, b) -> TFun(annotationTypeFromRef typeDefs span a, annotationTypeFromRef typeDefs span b) | TRPostfix (inner, "list") -> TList (annotationTypeFromRef typeDefs span inner) @@ -302,25 +324,26 @@ module TypeInfer = match builtinType name with | Some t -> t | None -> - match decls.TryFind name with + let resolvedName = resolveReferencedTypeName decls.Keys name unknownSpan + match decls.TryFind resolvedName with | Some def -> - match stack |> List.tryFindIndex ((=) name) with + match stack |> List.tryFindIndex ((=) resolvedName) with | Some 0 -> if def.IsRecursive then - TNamed name + TNamed resolvedName else - raise (TypeException { Message = $"Recursive type '{name}' requires 'type rec'"; Span = unknownSpan }) + raise (TypeException { Message = $"Recursive type '{resolvedName}' requires 'type rec'"; Span = unknownSpan }) | Some _ -> raise (TypeException { Message = "Mutual recursive types are not supported"; Span = unknownSpan }) | None -> if not def.Cases.IsEmpty then - TNamed name + TNamed resolvedName else def.Fields - |> List.map (fun (field, t) -> field, typeFromRef decls (name :: stack) t) + |> List.map (fun (field, t) -> field, typeFromRef decls (resolvedName :: stack) t) |> Map.ofList |> TRecord - | None -> TNamed name + | None -> TNamed resolvedName | TRTuple ts -> ts |> List.map (typeFromRef decls stack) |> TTuple | TRFun (a, b) -> diff --git a/tests/FScript.Language.Tests/IncludeResolverTests.fs b/tests/FScript.Language.Tests/IncludeResolverTests.fs index 01a2de2..79eb03f 100644 --- a/tests/FScript.Language.Tests/IncludeResolverTests.fs +++ b/tests/FScript.Language.Tests/IncludeResolverTests.fs @@ -186,3 +186,18 @@ type IncludeResolverTests () = let act () = IncludeResolver.parseProgramFromFile dir mainPath |> ignore act |> should throw typeof) + + [] + member _.``Import inference resolves qualified type annotation to imported type`` () = + withTempDir (fun dir -> + let commonPath = Path.Combine(dir, "common.fss") + let mainPath = Path.Combine(dir, "main.fss") + + File.WriteAllText(commonPath, "type ProjectInfo = { Name: string; Language: string }\nlet describe_project (project: ProjectInfo) = project.Name") + File.WriteAllText(mainPath, "import \"common.fss\"\nlet summary (project: common.ProjectInfo) = common.describe_project project\nsummary { Name = \"Terrabuild\"; Language = \"F#\" }") + + let program = IncludeResolver.parseProgramFromFile dir mainPath + let typed = TypeInfer.inferProgram program + match typed |> List.last with + | TypeInfer.TSExpr expr -> expr.Type |> should equal TString + | _ -> Assert.Fail("Expected expression")) diff --git a/tests/FScript.Language.Tests/ParserTests.fs b/tests/FScript.Language.Tests/ParserTests.fs index 3650b04..4cfefd2 100644 --- a/tests/FScript.Language.Tests/ParserTests.fs +++ b/tests/FScript.Language.Tests/ParserTests.fs @@ -324,6 +324,13 @@ type ParserTests () = | SLet ("format_address", [ { Name = "address"; Annotation = Some (TRStructuralRecord [ ("City", TRName "string"); ("Zip", TRName "int") ]) } ], _, _, _, _) -> () | _ -> Assert.Fail("Expected annotated let parameter with structural inline record type") + [] + member _.``Parses annotated parameter with qualified type name`` () = + let p = Helpers.parse "let summary (project: common.ProjectInfo) = project.Name" + match p.[0] with + | SLet ("summary", [ { Name = "project"; Annotation = Some (TRName "common.ProjectInfo") } ], _, _, _, _) -> () + | _ -> Assert.Fail("Expected annotated let parameter with qualified type name") + [] member _.``Parses structural record literal expression`` () = let p = Helpers.parse "let officeAddress = {| City = \"London\"; Zip = 12345 |}" From a774019c377b87a9b88cff494cc57537479b6926 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:41:02 +0100 Subject: [PATCH 07/14] allow build on feature branches --- .github/workflows/ci-main.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/ci-main.yml b/.github/workflows/ci-main.yml index 6948614..ab5644e 100644 --- a/.github/workflows/ci-main.yml +++ b/.github/workflows/ci-main.yml @@ -4,6 +4,7 @@ on: push: branches: - main + - feature/* workflow_dispatch: permissions: From 6346992a51d18ef20eecfa99fa89d2c96ecfb6d3 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:43:40 +0100 Subject: [PATCH 08/14] update changelog --- CHANGELOG.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index ae3a880..7009156 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,7 @@ All notable changes to FScript are documented in this file. ## [Unreleased] +- Rewrite LanguageServer to C#. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup. From 37b7fd1014dd7b8544e2f1d7e089ab6c65d098b0 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 20:58:38 +0100 Subject: [PATCH 09/14] Move LS core modules into CSharpInterop --- CHANGELOG.md | 2 +- FScript.sln | 15 ------ docs/architecture/assemblies-and-roles.md | 13 +---- .../FScript.CSharpInterop.fsproj | 6 +++ .../LanguageServerLegacy}/AstJson.fs | 0 .../LanguageServerLegacy}/LspHandlers.fs | 0 .../LanguageServerLegacy}/LspModel.fs | 0 .../LanguageServerLegacy}/LspProtocol.fs | 0 .../LspRuntimeExterns.fs | 0 .../LanguageServerLegacy}/LspSymbols.fs | 0 .../FScript.LanguageServer.Core.fsproj | 23 --------- .../FScript.LanguageServer.csproj | 1 - .../LspTestClient.fs | 50 ++----------------- 13 files changed, 11 insertions(+), 99 deletions(-) rename src/{FScript.LanguageServer.Core => FScript.CSharpInterop/LanguageServerLegacy}/AstJson.fs (100%) rename src/{FScript.LanguageServer.Core => FScript.CSharpInterop/LanguageServerLegacy}/LspHandlers.fs (100%) rename src/{FScript.LanguageServer.Core => FScript.CSharpInterop/LanguageServerLegacy}/LspModel.fs (100%) rename src/{FScript.LanguageServer.Core => FScript.CSharpInterop/LanguageServerLegacy}/LspProtocol.fs (100%) rename src/{FScript.LanguageServer.Core => FScript.CSharpInterop/LanguageServerLegacy}/LspRuntimeExterns.fs (100%) rename src/{FScript.LanguageServer.Core => FScript.CSharpInterop/LanguageServerLegacy}/LspSymbols.fs (100%) delete mode 100644 src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj diff --git a/CHANGELOG.md b/CHANGELOG.md index 7009156..ac7d927 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,7 +4,7 @@ All notable changes to FScript are documented in this file. ## [Unreleased] -- Rewrite LanguageServer to C#. +- Removed F# sources from `src/FScript.LanguageServer*` by moving LSP semantic modules into `FScript.CSharpInterop` and keeping `FScript.LanguageServer` as C# host. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup. diff --git a/FScript.sln b/FScript.sln index df81c3d..05cf0ba 100644 --- a/FScript.sln +++ b/FScript.sln @@ -21,8 +21,6 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer.Test EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.CSharpInterop", "src\FScript.CSharpInterop\FScript.CSharpInterop.fsproj", "{8A28B784-F90B-469C-91BE-F96F63ACEA32}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer.Core", "src\FScript.LanguageServer.Core\FScript.LanguageServer.Core.fsproj", "{ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}" -EndProject Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "FScript.LanguageServer", "src\FScript.LanguageServer\FScript.LanguageServer.csproj", "{57518676-01F0-4D5B-A53B-7A06DBA9AA04}" EndProject Global @@ -119,18 +117,6 @@ Global {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x64.Build.0 = Release|Any CPU {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x86.ActiveCfg = Release|Any CPU {8A28B784-F90B-469C-91BE-F96F63ACEA32}.Release|x86.Build.0 = Release|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|Any CPU.ActiveCfg = Debug|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|Any CPU.Build.0 = Debug|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x64.ActiveCfg = Debug|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x64.Build.0 = Debug|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x86.ActiveCfg = Debug|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Debug|x86.Build.0 = Debug|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|Any CPU.ActiveCfg = Release|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|Any CPU.Build.0 = Release|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x64.ActiveCfg = Release|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x64.Build.0 = Release|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x86.ActiveCfg = Release|Any CPU - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736}.Release|x86.Build.0 = Release|Any CPU {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|Any CPU.ActiveCfg = Debug|Any CPU {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|Any CPU.Build.0 = Debug|Any CPU {57518676-01F0-4D5B-A53B-7A06DBA9AA04}.Debug|x64.ActiveCfg = Debug|Any CPU @@ -155,7 +141,6 @@ Global {1E2C7B34-04B8-42C9-880D-CC47DEC156A7} = {0AB3BF05-4346-4AA6-1389-037BE0695223} {B734E1E1-59C2-47E0-8D19-A9C5C95938F1} = {0AB3BF05-4346-4AA6-1389-037BE0695223} {8A28B784-F90B-469C-91BE-F96F63ACEA32} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} - {ABA1C90C-B66A-41FD-AE5C-8E83AFF31736} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} {57518676-01F0-4D5B-A53B-7A06DBA9AA04} = {827E0CD3-B72D-47B6-A68D-7590B98EB39B} EndGlobalSection EndGlobal diff --git a/docs/architecture/assemblies-and-roles.md b/docs/architecture/assemblies-and-roles.md index 356ccb1..d497f61 100644 --- a/docs/architecture/assemblies-and-roles.md +++ b/docs/architecture/assemblies-and-roles.md @@ -69,17 +69,6 @@ Use this when: - You integrate FScript from C# and want to avoid direct F# compiler/runtime internals. - You build tooling services (for example LSP hosts) with a stable boundary. -### `FScript.LanguageServer.Core` -Role: -- F# LSP analysis/core module library. - -Responsibilities: -- Keep LSP document state, analysis, symbol, and protocol helper modules. -- Provide reusable LSP method handlers consumed by the C# host. - -Use this when: -- You need the existing F# LSP analysis/handler implementation without running an F# server executable. - ### `FScript.LanguageServer` Role: - C# host executable for the Language Server process. @@ -110,7 +99,7 @@ Use this when: - `FScript.Language` has no dependency on `FScript.Runtime`. - `FScript.Runtime` depends on `FScript.Language` types. - `FScript.CSharpInterop` depends on both `FScript.Language` and `FScript.Runtime`. -- `FScript.LanguageServer` depends on `FScript.LanguageServer.Core`. +- `FScript.LanguageServer` depends on `FScript.CSharpInterop`. - `FScript` depends on both `FScript.Language` and `FScript.Runtime`. This keeps the language engine reusable while runtime capabilities remain host-configurable. diff --git a/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj b/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj index 1a366dd..13a6e1e 100644 --- a/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj +++ b/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj @@ -7,6 +7,12 @@ + + + + + + diff --git a/src/FScript.LanguageServer.Core/AstJson.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/AstJson.fs similarity index 100% rename from src/FScript.LanguageServer.Core/AstJson.fs rename to src/FScript.CSharpInterop/LanguageServerLegacy/AstJson.fs diff --git a/src/FScript.LanguageServer.Core/LspHandlers.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspHandlers.fs similarity index 100% rename from src/FScript.LanguageServer.Core/LspHandlers.fs rename to src/FScript.CSharpInterop/LanguageServerLegacy/LspHandlers.fs diff --git a/src/FScript.LanguageServer.Core/LspModel.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspModel.fs similarity index 100% rename from src/FScript.LanguageServer.Core/LspModel.fs rename to src/FScript.CSharpInterop/LanguageServerLegacy/LspModel.fs diff --git a/src/FScript.LanguageServer.Core/LspProtocol.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspProtocol.fs similarity index 100% rename from src/FScript.LanguageServer.Core/LspProtocol.fs rename to src/FScript.CSharpInterop/LanguageServerLegacy/LspProtocol.fs diff --git a/src/FScript.LanguageServer.Core/LspRuntimeExterns.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspRuntimeExterns.fs similarity index 100% rename from src/FScript.LanguageServer.Core/LspRuntimeExterns.fs rename to src/FScript.CSharpInterop/LanguageServerLegacy/LspRuntimeExterns.fs diff --git a/src/FScript.LanguageServer.Core/LspSymbols.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspSymbols.fs similarity index 100% rename from src/FScript.LanguageServer.Core/LspSymbols.fs rename to src/FScript.CSharpInterop/LanguageServerLegacy/LspSymbols.fs diff --git a/src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj b/src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj deleted file mode 100644 index d92a9a7..0000000 --- a/src/FScript.LanguageServer.Core/FScript.LanguageServer.Core.fsproj +++ /dev/null @@ -1,23 +0,0 @@ - - - - net10.0 - enable - - - - - - - - - - - - - - - - - - diff --git a/src/FScript.LanguageServer/FScript.LanguageServer.csproj b/src/FScript.LanguageServer/FScript.LanguageServer.csproj index 6630e7c..25b10a8 100644 --- a/src/FScript.LanguageServer/FScript.LanguageServer.csproj +++ b/src/FScript.LanguageServer/FScript.LanguageServer.csproj @@ -8,6 +8,5 @@ - diff --git a/tests/FScript.LanguageServer.Tests/LspTestClient.fs b/tests/FScript.LanguageServer.Tests/LspTestClient.fs index ca8519d..b122b43 100644 --- a/tests/FScript.LanguageServer.Tests/LspTestClient.fs +++ b/tests/FScript.LanguageServer.Tests/LspTestClient.fs @@ -29,32 +29,6 @@ module internal LspClient = found |> Option.defaultWith (fun () -> failwith "Unable to locate repository root from test base directory") - let private ensureServerDllBuilt = - lazy ( - let root = findRepoRoot () - let serverProject = Path.Combine(root, "src", "FScript.LanguageServer.Core", "FScript.LanguageServer.Core.fsproj") - let serverDll = Path.Combine(root, "src", "FScript.LanguageServer.Core", "bin", "Release", "net10.0", "FScript.LanguageServer.Core.dll") - - let buildPsi = - ProcessStartInfo( - FileName = "dotnet", - Arguments = $"build \"{serverProject}\" -c Release -nologo -v q", - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true) - - use buildProc = new Process(StartInfo = buildPsi) - if not (buildProc.Start()) then - failwith "Unable to start dotnet build for language server test setup." - buildProc.WaitForExit() - if buildProc.ExitCode <> 0 || not (File.Exists(serverDll)) then - let out = buildProc.StandardOutput.ReadToEnd() - let err = buildProc.StandardError.ReadToEnd() - failwith $"Failed to build language server test target. stdout: {out}\nstderr: {err}" - - serverDll) - let private ensureCSharpServerDllBuilt = lazy ( let root = findRepoRoot () @@ -81,27 +55,6 @@ module internal LspClient = serverDll) - let startFSharp () = - let serverDll = ensureServerDllBuilt.Value - - let psi = - ProcessStartInfo( - FileName = "dotnet", - Arguments = $"\"{serverDll}\"", - RedirectStandardInput = true, - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true) - - let proc = new Process(StartInfo = psi) - let started = proc.Start() - if not started then failwith "Unable to start FScript language server process" - - { Process = proc - Input = proc.StandardInput.BaseStream - Output = proc.StandardOutput.BaseStream } - let start () = let serverDll = ensureCSharpServerDllBuilt.Value @@ -126,6 +79,9 @@ module internal LspClient = let startCSharp () = start () + let startFSharp () = + start () + let stop (client: Client) = if not client.Process.HasExited then try From 2fadb83528e0d5ce0c276553fa65580dba31b66b Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 21:07:17 +0100 Subject: [PATCH 10/14] Convert LanguageServer tests project to C# --- CHANGELOG.md | 1 + FScript.sln | 2 +- .../CSharpServerCoreTests.cs | 209 ++++++++++++++++++ ...oj => FScript.LanguageServer.Tests.csproj} | 20 +- .../InteropServicesTests.cs | 27 +++ .../FScript.LanguageServer.Tests/LspClient.cs | 158 +++++++++++++ .../LspTestFixture.cs | 35 +++ tests/FScript.LanguageServer.Tests/LspWire.cs | 109 +++++++++ 8 files changed, 541 insertions(+), 20 deletions(-) create mode 100644 tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.cs rename tests/FScript.LanguageServer.Tests/{FScript.LanguageServer.Tests.fsproj => FScript.LanguageServer.Tests.csproj} (52%) create mode 100644 tests/FScript.LanguageServer.Tests/InteropServicesTests.cs create mode 100644 tests/FScript.LanguageServer.Tests/LspClient.cs create mode 100644 tests/FScript.LanguageServer.Tests/LspTestFixture.cs create mode 100644 tests/FScript.LanguageServer.Tests/LspWire.cs diff --git a/CHANGELOG.md b/CHANGELOG.md index ac7d927..221dd7e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,6 +5,7 @@ All notable changes to FScript are documented in this file. ## [Unreleased] - Removed F# sources from `src/FScript.LanguageServer*` by moving LSP semantic modules into `FScript.CSharpInterop` and keeping `FScript.LanguageServer` as C# host. +- Replaced `FScript.LanguageServer.Tests` project with a C# test project and C# LSP test harness to remove F# compile cost from LanguageServer test builds. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup. diff --git a/FScript.sln b/FScript.sln index 05cf0ba..c6937ec 100644 --- a/FScript.sln +++ b/FScript.sln @@ -17,7 +17,7 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.Runtime", "src\FScr EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.Runtime.Tests", "tests\FScript.Runtime.Tests\FScript.Runtime.Tests.fsproj", "{1E2C7B34-04B8-42C9-880D-CC47DEC156A7}" EndProject -Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.LanguageServer.Tests", "tests\FScript.LanguageServer.Tests\FScript.LanguageServer.Tests.fsproj", "{B734E1E1-59C2-47E0-8D19-A9C5C95938F1}" +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "FScript.LanguageServer.Tests", "tests\FScript.LanguageServer.Tests\FScript.LanguageServer.Tests.csproj", "{B734E1E1-59C2-47E0-8D19-A9C5C95938F1}" EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "FScript.CSharpInterop", "src\FScript.CSharpInterop\FScript.CSharpInterop.fsproj", "{8A28B784-F90B-469C-91BE-F96F63ACEA32}" EndProject diff --git a/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.cs b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.cs new file mode 100644 index 0000000..9551b3e --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.cs @@ -0,0 +1,209 @@ +using System.Text.Json.Nodes; +using NUnit.Framework; + +namespace FScript.LanguageServer.Tests; + +[TestFixture] +public sealed class CSharpServerCoreTests +{ + [Test] + public void CSharp_server_initialize_returns_capabilities() + { + var client = LspClient.StartCSharp(); + try + { + LspTestFixture.Initialize(client); + + var hoverReq = new JsonObject + { + ["textDocument"] = new JsonObject { ["uri"] = "file:///tmp/test.fss" }, + ["position"] = new JsonObject { ["line"] = 0, ["character"] = 0 } + }; + + LspClient.SendRequest(client, 42, "textDocument/hover", hoverReq); + var hoverResp = LspClient.ReadUntil(client, 10_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 42); + Assert.That(hoverResp["result"], Is.Null); + } + finally + { + try { LspTestFixture.Shutdown(client); } catch { } + LspClient.Stop(client); + } + } + + [Test] + public void CSharp_server_returns_stdlib_source() + { + var client = LspClient.StartCSharp(); + try + { + LspTestFixture.Initialize(client); + var requestParams = new JsonObject { ["uri"] = "fscript-stdlib:///Option.fss" }; + + LspClient.SendRequest(client, 43, "fscript/stdlibSource", requestParams); + var resp = LspClient.ReadUntil(client, 10_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 43); + + var result = resp["result"] as JsonObject ?? throw new Exception("Expected result object"); + Assert.That(result["ok"]?.GetValue(), Is.True); + var data = result["data"] as JsonObject ?? throw new Exception("Expected data object"); + var text = data["text"]?.GetValue() ?? string.Empty; + Assert.That(text.Contains("let", StringComparison.Ordinal), Is.True); + } + finally + { + try { LspTestFixture.Shutdown(client); } catch { } + LspClient.Stop(client); + } + } + + [Test] + public void CSharp_server_returns_method_not_found_for_unknown_request() + { + var client = LspClient.StartCSharp(); + try + { + LspTestFixture.Initialize(client); + LspClient.SendRequest(client, 44, "fscript/unknown", null); + var resp = LspClient.ReadUntil(client, 10_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 44); + var err = resp["error"] as JsonObject ?? throw new Exception("Expected error object"); + Assert.That(err["code"]?.GetValue(), Is.EqualTo(-32601)); + } + finally + { + try { LspTestFixture.Shutdown(client); } catch { } + LspClient.Stop(client); + } + } + + [Test] + public void CSharp_server_didOpen_publishes_parse_diagnostics() + { + var client = LspClient.StartCSharp(); + try + { + LspTestFixture.Initialize(client); + + var uri = "file:///tmp/csharp-diagnostics-test.fss"; + var didOpenParams = new JsonObject + { + ["textDocument"] = new JsonObject + { + ["uri"] = uri, + ["languageId"] = "fscript", + ["version"] = 1, + ["text"] = "let x =" + } + }; + LspClient.SendNotification(client, "textDocument/didOpen", didOpenParams); + + var diagMsg = LspClient.ReadUntil(client, 10_000, msg => + { + if (msg["method"]?.GetValue() != "textDocument/publishDiagnostics") + { + return false; + } + + var p = msg["params"] as JsonObject; + var u = p?["uri"]?.GetValue(); + var diagnostics = p?["diagnostics"] as JsonArray; + return u == uri && diagnostics is { Count: > 0 }; + }); + + var hasParseCode = false; + var paramsObj = diagMsg["params"] as JsonObject; + var diagnosticsArray = paramsObj?["diagnostics"] as JsonArray; + if (diagnosticsArray is not null) + { + foreach (var diag in diagnosticsArray) + { + if (diag is JsonObject d && d["code"]?.GetValue() == "parse") + { + hasParseCode = true; + break; + } + } + } + + Assert.That(hasParseCode, Is.True); + } + finally + { + try { LspTestFixture.Shutdown(client); } catch { } + LspClient.Stop(client); + } + } + + [Test] + public void CSharp_server_viewAst_returns_program_json() + { + var client = LspClient.StartCSharp(); + try + { + LspTestFixture.Initialize(client); + + var uri = "file:///tmp/csharp-view-ast-test.fss"; + var source = "let value = 42\nvalue\n"; + var didOpenParams = new JsonObject + { + ["textDocument"] = new JsonObject + { + ["uri"] = uri, + ["languageId"] = "fscript", + ["version"] = 1, + ["text"] = source + } + }; + LspClient.SendNotification(client, "textDocument/didOpen", didOpenParams); + _ = LspClient.ReadUntil(client, 10_000, msg => msg["method"]?.GetValue() == "textDocument/publishDiagnostics"); + + var requestParams = new JsonObject { ["textDocument"] = new JsonObject { ["uri"] = uri } }; + LspClient.SendRequest(client, 45, "fscript/viewAst", requestParams); + var response = LspClient.ReadUntil(client, 10_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 45); + + var kindValue = ((response["result"] as JsonObject)?["data"] as JsonObject)?["kind"]?.GetValue(); + Assert.That(kindValue, Is.EqualTo("program")); + } + finally + { + try { LspTestFixture.Shutdown(client); } catch { } + LspClient.Stop(client); + } + } + + [Test] + public void CSharp_server_viewInferredAst_returns_typed_program_json() + { + var client = LspClient.StartCSharp(); + try + { + LspTestFixture.Initialize(client); + + var uri = "file:///tmp/csharp-view-inferred-test.fss"; + var source = "let inc x = x + 1\ninc 1\n"; + var didOpenParams = new JsonObject + { + ["textDocument"] = new JsonObject + { + ["uri"] = uri, + ["languageId"] = "fscript", + ["version"] = 1, + ["text"] = source + } + }; + LspClient.SendNotification(client, "textDocument/didOpen", didOpenParams); + _ = LspClient.ReadUntil(client, 10_000, msg => msg["method"]?.GetValue() == "textDocument/publishDiagnostics"); + + var requestParams = new JsonObject { ["textDocument"] = new JsonObject { ["uri"] = uri } }; + LspClient.SendRequest(client, 46, "fscript/viewInferredAst", requestParams); + var response = LspClient.ReadUntil(client, 10_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 46); + + var kindValue = ((response["result"] as JsonObject)?["data"] as JsonObject)?["kind"]?.GetValue(); + Assert.That(kindValue, Is.EqualTo("typedProgram")); + } + finally + { + try { LspTestFixture.Shutdown(client); } catch { } + LspClient.Stop(client); + } + } +} diff --git a/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj b/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.csproj similarity index 52% rename from tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj rename to tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.csproj index 04196d9..7ae3b9b 100644 --- a/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.fsproj +++ b/tests/FScript.LanguageServer.Tests/FScript.LanguageServer.Tests.csproj @@ -1,30 +1,13 @@ - net10.0 false - false enable + enable - - - - - - - - - - - - - - - - @@ -35,5 +18,4 @@ - diff --git a/tests/FScript.LanguageServer.Tests/InteropServicesTests.cs b/tests/FScript.LanguageServer.Tests/InteropServicesTests.cs new file mode 100644 index 0000000..2da350a --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/InteropServicesTests.cs @@ -0,0 +1,27 @@ +using FScript.CSharpInterop; +using NUnit.Framework; + +namespace FScript.LanguageServer.Tests; + +[TestFixture] +public sealed class InteropServicesTests +{ + [Test] + public void Interop_loads_stdlib_virtual_source() + { + var source = InteropServices.tryLoadStdlibSourceText("fscript-stdlib:///Option.fss"); + Assert.That(source is not null, Is.True); + } + + [Test] + public void Interop_parses_and_infers_a_simple_script() + { + const string script = "let add x y = x + y"; + const string sourcePath = "/tmp/interop-test.fss"; + var externs = InteropServices.runtimeExternsForSourcePath(sourcePath); + var program = InteropServices.parseProgramFromSourceWithIncludes(sourcePath, script); + var inferred = InteropServices.inferProgramWithExternsAndLocalVariableTypes(externs, program); + var typed = inferred.Item1; + Assert.That(typed, Is.Not.Null); + } +} diff --git a/tests/FScript.LanguageServer.Tests/LspClient.cs b/tests/FScript.LanguageServer.Tests/LspClient.cs new file mode 100644 index 0000000..501978a --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/LspClient.cs @@ -0,0 +1,158 @@ +using System.Diagnostics; +using System.Text.Json.Nodes; + +namespace FScript.LanguageServer.Tests; + +internal static class LspClient +{ + internal sealed class Client + { + public required Process Process { get; init; } + public required Stream Input { get; init; } + public required Stream Output { get; init; } + } + + private static string FindRepoRoot() + { + DirectoryInfo? current = new(AppContext.BaseDirectory); + while (current is not null) + { + var candidate = Path.Combine(current.FullName, "FScript.sln"); + if (File.Exists(candidate)) + { + return current.FullName; + } + + current = current.Parent; + } + + throw new Exception("Unable to locate repository root from test base directory"); + } + + private static readonly Lazy EnsureServerDllBuilt = new(() => + { + var root = FindRepoRoot(); + var serverProject = Path.Combine(root, "src", "FScript.LanguageServer", "FScript.LanguageServer.csproj"); + var serverDll = Path.Combine(root, "src", "FScript.LanguageServer", "bin", "Release", "net10.0", "FScript.LanguageServer.dll"); + + var buildPsi = new ProcessStartInfo + { + FileName = "dotnet", + Arguments = $"build \"{serverProject}\" -c Release -nologo -v q", + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true + }; + + using var buildProc = new Process { StartInfo = buildPsi }; + if (!buildProc.Start()) + { + throw new Exception("Unable to start dotnet build for C# language server test setup."); + } + + buildProc.WaitForExit(); + if (buildProc.ExitCode != 0 || !File.Exists(serverDll)) + { + var output = buildProc.StandardOutput.ReadToEnd(); + var err = buildProc.StandardError.ReadToEnd(); + throw new Exception($"Failed to build C# language server test target. stdout: {output}\nstderr: {err}"); + } + + return serverDll; + }); + + public static Client Start() + { + var serverDll = EnsureServerDllBuilt.Value; + + var psi = new ProcessStartInfo + { + FileName = "dotnet", + Arguments = $"\"{serverDll}\"", + RedirectStandardInput = true, + RedirectStandardOutput = true, + RedirectStandardError = true, + UseShellExecute = false, + CreateNoWindow = true + }; + + var proc = new Process { StartInfo = psi }; + if (!proc.Start()) + { + throw new Exception("Unable to start FScript C# language server process"); + } + + return new Client + { + Process = proc, + Input = proc.StandardInput.BaseStream, + Output = proc.StandardOutput.BaseStream + }; + } + + public static Client StartCSharp() => Start(); + public static Client StartFSharp() => Start(); + + public static void Stop(Client client) + { + if (!client.Process.HasExited) + { + try + { + client.Process.Kill(true); + } + catch + { + // Ignore + } + } + + client.Process.Dispose(); + } + + public static void SendRequest(Client client, int id, string methodName, JsonNode? parameters) + { + var payload = new JsonObject + { + ["jsonrpc"] = "2.0", + ["id"] = id, + ["method"] = methodName, + ["params"] = parameters ?? new JsonObject() + }; + LspWire.WriteMessage(client.Input, payload.ToJsonString()); + } + + public static void SendNotification(Client client, string methodName, JsonNode? parameters) + { + var payload = new JsonObject + { + ["jsonrpc"] = "2.0", + ["method"] = methodName, + ["params"] = parameters ?? new JsonObject() + }; + LspWire.WriteMessage(client.Input, payload.ToJsonString()); + } + + public static JsonObject ReadUntil(Client client, int timeoutMs, Func predicate) + { + var deadline = DateTime.UtcNow.AddMilliseconds(timeoutMs); + while (DateTime.UtcNow < deadline) + { + var remaining = (int)(deadline - DateTime.UtcNow).TotalMilliseconds; + if (remaining <= 0) + { + break; + } + + var raw = LspWire.ReadMessageWithTimeout(client.Output, remaining); + var node = JsonNode.Parse(raw); + if (node is JsonObject obj && predicate(obj)) + { + return obj; + } + } + + throw new Exception("Timed out waiting for expected LSP message"); + } +} diff --git a/tests/FScript.LanguageServer.Tests/LspTestFixture.cs b/tests/FScript.LanguageServer.Tests/LspTestFixture.cs new file mode 100644 index 0000000..a1cd797 --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/LspTestFixture.cs @@ -0,0 +1,35 @@ +using System.Text.Json.Nodes; +using NUnit.Framework; + +namespace FScript.LanguageServer.Tests; + +internal static class LspTestFixture +{ + public static void InitializeWith(LspClient.Client client, JsonObject? initializationOptions) + { + var initializeParams = new JsonObject + { + ["processId"] = null, + ["rootUri"] = null, + ["capabilities"] = new JsonObject() + }; + if (initializationOptions is not null) + { + initializeParams["initializationOptions"] = initializationOptions; + } + + LspClient.SendRequest(client, 1, "initialize", initializeParams); + var response = LspClient.ReadUntil(client, 20_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 1); + Assert.That(response["result"], Is.Not.Null); + LspClient.SendNotification(client, "initialized", null); + } + + public static void Initialize(LspClient.Client client) => InitializeWith(client, null); + + public static void Shutdown(LspClient.Client client) + { + LspClient.SendRequest(client, 2, "shutdown", null); + _ = LspClient.ReadUntil(client, 10_000, msg => msg["id"] is JsonValue idv && idv.TryGetValue(out var id) && id == 2); + LspClient.SendNotification(client, "exit", null); + } +} diff --git a/tests/FScript.LanguageServer.Tests/LspWire.cs b/tests/FScript.LanguageServer.Tests/LspWire.cs new file mode 100644 index 0000000..805a1bb --- /dev/null +++ b/tests/FScript.LanguageServer.Tests/LspWire.cs @@ -0,0 +1,109 @@ +using System.Text; + +namespace FScript.LanguageServer.Tests; + +internal static class LspWire +{ + private static readonly Encoding Utf8 = new UTF8Encoding(false); + private static byte[] _pending = Array.Empty(); + + private static void ReadExactWithTimeout(Stream stream, byte[] buffer, int offset, int count, int timeoutMs) + { + using var cts = new CancellationTokenSource(timeoutMs); + var readTotal = 0; + while (readTotal < count) + { + var read = stream.ReadAsync(buffer.AsMemory(offset + readTotal, count - readTotal), cts.Token) + .GetAwaiter() + .GetResult(); + if (read <= 0) + { + throw new Exception("Unexpected end of stream while reading LSP message."); + } + + readTotal += read; + } + } + + public static string ReadMessageWithTimeout(Stream stream, int timeoutMs) + { + using var cts = new CancellationTokenSource(timeoutMs); + var headerBytes = new List(); + var one = new byte[1]; + var marker = new[] { (byte)'\r', (byte)'\n', (byte)'\r', (byte)'\n' }; + var matched = 0; + var doneHeader = false; + + if (_pending.Length > 0) + { + headerBytes.AddRange(_pending); + _pending = Array.Empty(); + } + + while (!doneHeader) + { + if (headerBytes.Count >= marker.Length) + { + var c = headerBytes.Count; + var tail = new[] { headerBytes[c - 4], headerBytes[c - 3], headerBytes[c - 2], headerBytes[c - 1] }; + if (tail.SequenceEqual(marker)) + { + doneHeader = true; + continue; + } + } + + var n = stream.ReadAsync(one.AsMemory(0, 1), cts.Token).GetAwaiter().GetResult(); + if (n <= 0) + { + throw new Exception("Unexpected end of stream while reading LSP headers."); + } + + var b = one[0]; + headerBytes.Add(b); + if (b == marker[matched]) + { + matched++; + if (matched == marker.Length) + { + doneHeader = true; + } + } + else + { + matched = b == marker[0] ? 1 : 0; + } + } + + var header = Encoding.ASCII.GetString(headerBytes.ToArray()); + var contentLength = header.Split(["\r\n"], StringSplitOptions.RemoveEmptyEntries) + .Select(line => + { + if (line.StartsWith("Content-Length:", StringComparison.OrdinalIgnoreCase)) + { + return int.Parse(line["Content-Length:".Length..].Trim()); + } + + return -1; + }) + .FirstOrDefault(x => x >= 0); + if (contentLength < 0) + { + throw new Exception("Missing Content-Length header"); + } + + var payload = new byte[contentLength]; + ReadExactWithTimeout(stream, payload, 0, contentLength, timeoutMs); + return Utf8.GetString(payload); + } + + public static void WriteMessage(Stream stream, string payload) + { + var payloadBytes = Utf8.GetBytes(payload); + var header = $"Content-Length: {payloadBytes.Length}\r\n\r\n"; + var headerBytes = Encoding.ASCII.GetBytes(header); + stream.Write(headerBytes, 0, headerBytes.Length); + stream.Write(payloadBytes, 0, payloadBytes.Length); + stream.Flush(); + } +} From 6ef92fdd630ff6abb556ccaf79124f046d787341 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 21:11:24 +0100 Subject: [PATCH 11/14] Remove obsolete F# LanguageServer test files --- CHANGELOG.md | 1 + .../CSharpServerCoreTests.fs | 268 ---- .../InteropServicesTests.fs | 29 - .../LspCompletionAndSignatureTests.fs | 937 -------------- .../LspCoreTests.fs | 109 -- .../LspCustomRequestsTests.fs | 186 --- .../LspHoverAndInlayTests.fs | 1090 ----------------- .../LspNavigationTests.fs | 981 --------------- .../LspSymbolsAndActionsTests.fs | 1022 ---------------- .../LspTestClient.fs | 123 -- .../LspTestFixture.fs | 46 - .../LspTestWire.fs | 92 -- tests/FScript.LanguageServer.Tests/Program.fs | 4 - 13 files changed, 1 insertion(+), 4887 deletions(-) delete mode 100644 tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/InteropServicesTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspCompletionAndSignatureTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspCoreTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspCustomRequestsTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspHoverAndInlayTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspNavigationTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspSymbolsAndActionsTests.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspTestClient.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspTestFixture.fs delete mode 100644 tests/FScript.LanguageServer.Tests/LspTestWire.fs delete mode 100644 tests/FScript.LanguageServer.Tests/Program.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index 221dd7e..85e29b5 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -6,6 +6,7 @@ All notable changes to FScript are documented in this file. - Removed F# sources from `src/FScript.LanguageServer*` by moving LSP semantic modules into `FScript.CSharpInterop` and keeping `FScript.LanguageServer` as C# host. - Replaced `FScript.LanguageServer.Tests` project with a C# test project and C# LSP test harness to remove F# compile cost from LanguageServer test builds. +- Deleted obsolete F# LanguageServer test sources after C# test project migration. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup. diff --git a/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs b/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs deleted file mode 100644 index 08974ea..0000000 --- a/tests/FScript.LanguageServer.Tests/CSharpServerCoreTests.fs +++ /dev/null @@ -1,268 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.Text.Json.Nodes -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type CSharpServerCoreTests () = - [] - member _.``CSharp server initialize returns capabilities`` () = - let client = LspClient.startCSharp () - try - initialize client - - let hoverReq = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create("file:///tmp/test.fss") - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(0) - hoverReq["textDocument"] <- textDocument - hoverReq["position"] <- position - - LspClient.sendRequest client 42 "textDocument/hover" (Some hoverReq) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 42 with _ -> false - | _ -> false) - - hoverResp["result"] |> should equal null - finally - try shutdown client with _ -> () - LspClient.stop client - - [] - member _.``CSharp server returns stdlib source`` () = - let client = LspClient.startCSharp () - try - initialize client - - let requestParams = JsonObject() - requestParams["uri"] <- JsonValue.Create("fscript-stdlib:///Option.fss") - - LspClient.sendRequest client 43 "fscript/stdlibSource" (Some requestParams) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 43 with _ -> false - | _ -> false) - - let result = - match resp["result"] with - | :? JsonObject as obj -> obj - | _ -> failwith "Expected result object" - - let ok = - match result["ok"] with - | :? JsonValue as value -> value.GetValue() - | _ -> false - ok |> should equal true - - let data = - match result["data"] with - | :? JsonObject as obj -> obj - | _ -> failwith "Expected data object" - - let text = - match data["text"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - text.Contains("let", StringComparison.Ordinal) |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - - [] - member _.``CSharp server returns method not found for unknown request`` () = - let client = LspClient.startCSharp () - try - initialize client - - LspClient.sendRequest client 44 "fscript/unknown" None - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 44 with _ -> false - | _ -> false) - - let err = - match resp["error"] with - | :? JsonObject as obj -> obj - | _ -> failwith "Expected error object" - let code = - match err["code"] with - | :? JsonValue as value -> value.GetValue() - | _ -> 0 - code |> should equal -32601 - finally - try shutdown client with _ -> () - LspClient.stop client - - [] - member _.``CSharp server didOpen publishes parse diagnostics`` () = - let client = LspClient.startCSharp () - try - initialize client - - let uri = "file:///tmp/csharp-diagnostics-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("let x =") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv when (try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false) -> - match msg["params"] with - | :? JsonObject as p -> - match p["uri"], p["diagnostics"] with - | :? JsonValue as u, (:? JsonArray as diagnosticsArray) -> - (try u.GetValue() = uri with _ -> false) && (diagnosticsArray.Count > 0) - | _ -> false - | _ -> false - | _ -> false) - - let hasParseCode = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as diagnostics -> - diagnostics - |> Seq.exists (fun diag -> - match diag with - | :? JsonObject as d -> - match d["code"] with - | :? JsonValue as codeValue -> - try codeValue.GetValue() = "parse" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - | _ -> false - - hasParseCode |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - - [] - member _.``CSharp server viewAst returns program JSON`` () = - let client = LspClient.startCSharp () - try - initialize client - - let uri = "file:///tmp/csharp-view-ast-test.fss" - let source = "let value = 42\nvalue\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let requestParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - requestParams["textDocument"] <- textDocument - - LspClient.sendRequest client 45 "fscript/viewAst" (Some requestParams) - let response = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 45 with _ -> false - | _ -> false) - - let kindValue = - match response["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonObject as data -> - match data["kind"] with - | :? JsonValue as value -> - try value.GetValue() with _ -> "" - | _ -> "" - | _ -> "" - | _ -> "" - - kindValue |> should equal "program" - finally - try shutdown client with _ -> () - LspClient.stop client - - [] - member _.``CSharp server viewInferredAst returns typed program JSON`` () = - let client = LspClient.startCSharp () - try - initialize client - - let uri = "file:///tmp/csharp-view-inferred-test.fss" - let source = "let inc x = x + 1\ninc 1\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let requestParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - requestParams["textDocument"] <- textDocument - - LspClient.sendRequest client 46 "fscript/viewInferredAst" (Some requestParams) - let response = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 46 with _ -> false - | _ -> false) - - let kindValue = - match response["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonObject as data -> - match data["kind"] with - | :? JsonValue as value -> - try value.GetValue() with _ -> "" - | _ -> "" - | _ -> "" - | _ -> "" - - kindValue |> should equal "typedProgram" - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/InteropServicesTests.fs b/tests/FScript.LanguageServer.Tests/InteropServicesTests.fs deleted file mode 100644 index e5a28fd..0000000 --- a/tests/FScript.LanguageServer.Tests/InteropServicesTests.fs +++ /dev/null @@ -1,29 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open NUnit.Framework -open FsUnit -open FScript.Language -open FScript.CSharpInterop - -[] -type InteropServicesTests () = - [] - member _.``Interop loads stdlib virtual source`` () = - let source = InteropServices.tryLoadStdlibSourceText "fscript-stdlib:///Option.fss" - source.IsSome |> should equal true - - [] - member _.``Interop parses and infers a simple script`` () = - let script = "let add x y = x + y" - let sourcePath = "/tmp/interop-test.fss" - let externs = InteropServices.runtimeExternsForSourcePath sourcePath - let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath script - let typed, _ = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs program - - let hasAddBinding = - typed - |> List.exists (function - | TypeInfer.TSLet(name, _, _, _, _, _) when name = "add" -> true - | _ -> false) - - hasAddBinding |> should equal true diff --git a/tests/FScript.LanguageServer.Tests/LspCompletionAndSignatureTests.fs b/tests/FScript.LanguageServer.Tests/LspCompletionAndSignatureTests.fs deleted file mode 100644 index 0e16036..0000000 --- a/tests/FScript.LanguageServer.Tests/LspCompletionAndSignatureTests.fs +++ /dev/null @@ -1,937 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type LspCompletionAndSignatureTests () = - [] - member _.``Inlay hints show map key union and unknown for unresolved map signature`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-map-unknown-test.fss" - let source = - "let remove k m =\n" - + " match m with\n" - + " | { [key] = _; ..rest } when key = k -> rest\n" - + " | _ -> m\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(0) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(0) - endPos["character"] <- JsonValue.Create(30) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 43 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 43 with _ -> false - | _ -> false) - - let labels = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.choose (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Seq.toList - | _ -> [] - - labels |> should contain ": int|string" - labels |> should contain ": unknown map" - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover shows signature for injected runtime extern function`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-injected-extern-test.fss" - let source = "let ok = Fs.exists \".\"\nok" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(13) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 70 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 70 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHover = - hoverValue.Contains("Fs.exists", StringComparison.Ordinal) - && hoverValue.Contains("string -> bool", StringComparison.Ordinal) - && hoverValue.Contains("injected-function", StringComparison.Ordinal) - - Assert.That(hasExpectedHover, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion includes local bindings and filters by prefix`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/completion-test.fss" - let source = "let alpha = 1\nlet beta = 2\nal" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - // Ignore diagnostics publish for this valid document. - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(2) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 4 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 4 with _ -> false - | _ -> false) - - let hasAlpha = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items -> - items - |> Seq.exists (fun item -> - match item with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as v -> - try v.GetValue() = "alpha" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - | _ -> false - - hasAlpha |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion supports module-qualified stdlib symbols`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/module-completion-test.fss" - let source = "List.ma" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(7) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 5 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 5 with _ -> false - | _ -> false) - - let hasListMap = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items -> - items - |> Seq.exists (fun item -> - match item with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as v -> - try v.GetValue() = "List.map" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - | _ -> false - - hasListMap |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion proposes record fields after dot`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/record-field-completion-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet home = { City = \"Paris\"; Zip = 75000 }\nhome.City" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(5) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 19 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 19 with _ -> false - | _ -> false) - - let labels = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items -> - items - |> Seq.choose (fun item -> - match item with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Seq.toList - | _ -> [] - | _ -> [] - - labels |> should contain "City" - labels |> should contain "Zip" - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion filters record fields by dotted member prefix`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/record-field-prefix-completion-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet home = { City = \"Paris\"; Zip = 75000 }\nhome.City" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(6) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 20 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 20 with _ -> false - | _ -> false) - - let labels = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items -> - items - |> Seq.choose (fun item -> - match item with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Seq.toList - | _ -> [] - | _ -> [] - - labels |> should equal [ "City" ] - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion proposes fields for annotated function parameters`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/record-param-completion-test.fss" - let source = - "type Address = { City: string; Zip: int }\nlet format (address: Address) =\n address.City" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(13) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 22 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 22 with _ -> false - | _ -> false) - - let labels = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items -> - items - |> Seq.choose (fun item -> - match item with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Seq.toList - | _ -> [] - | _ -> [] - - labels |> should equal [ "City" ] - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion ranks symbol matches before keywords for non-empty prefix`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/completion-ranking-test.fss" - let source = "let alpha = 1\nlet alphabet = 2\nal" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(2) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 24 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 24 with _ -> false - | _ -> false) - - let firstLabel = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items when items.Count > 0 -> - match items[0] with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None - | _ -> None - | _ -> None - - firstLabel |> should equal (Some "alpha") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Completion marks exact symbol match as preselected and provides sort metadata`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/completion-preselect-test.fss" - let source = "let alpha = 1\nalpha" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(5) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - - LspClient.sendRequest client 28 "textDocument/completion" (Some completionProbe) - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 28 with _ -> false - | _ -> false) - - let alphaMeta = - match completionResp["result"] with - | :? JsonObject as result -> - match result["items"] with - | :? JsonArray as items -> - items - |> Seq.tryPick (fun item -> - match item with - | :? JsonObject as o -> - match o["label"] with - | :? JsonValue as labelV when (try labelV.GetValue() = "alpha" with _ -> false) -> - let preselected = - match o["preselect"] with - | :? JsonValue as pv -> (try Some (pv.GetValue()) with _ -> None) - | _ -> None - let hasSortText = - match o["sortText"] with - | :? JsonValue as sv -> (try not (String.IsNullOrWhiteSpace(sv.GetValue())) with _ -> false) - | _ -> false - Some (preselected, hasSortText) - | _ -> None - | _ -> None) - | _ -> None - | _ -> None - - alphaMeta |> should equal (Some (Some true, true)) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Signature help returns function signature for call target`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/signature-help-test.fss" - let source = "let add x y = x + y\nadd(1, 2)" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let sigParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(4) - sigParams["textDocument"] <- textDocument - sigParams["position"] <- position - let ctx = JsonObject() - ctx["triggerCharacter"] <- JsonValue.Create("(") - sigParams["context"] <- ctx - - LspClient.sendRequest client 7 "textDocument/signatureHelp" (Some sigParams) - let sigResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 7 with _ -> false - | _ -> false) - - let hasAddSignature = - match sigResp["result"] with - | :? JsonObject as result -> - match result["signatures"] with - | :? JsonArray as signatures -> - signatures - |> Seq.exists (fun sigNode -> - match sigNode with - | :? JsonObject as sigObj -> - match sigObj["label"] with - | :? JsonValue as label -> - try label.GetValue().StartsWith("add", StringComparison.Ordinal) with _ -> false - | _ -> false - | _ -> false) - | _ -> false - | _ -> false - - hasAddSignature |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Signature help sets active parameter index from cursor position`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/signature-help-active-parameter-test.fss" - let source = "let add3 x y z = x + y + z\nadd3(1, 2, 3)" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let sigParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(11) - sigParams["textDocument"] <- textDocument - sigParams["position"] <- position - let ctx = JsonObject() - ctx["triggerCharacter"] <- JsonValue.Create(",") - sigParams["context"] <- ctx - - LspClient.sendRequest client 25 "textDocument/signatureHelp" (Some sigParams) - let sigResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 25 with _ -> false - | _ -> false) - - let activeParameter = - match sigResp["result"] with - | :? JsonObject as result -> - match result["activeParameter"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None - - activeParameter |> should equal (Some 2) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover returns markdown signature and kind`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-test.fss" - let source = "let double x = x * 2\nlet result = double 21" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(14) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 9 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 9 with _ -> false - | _ -> false) - - let hasExpectedHoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> - let text = value.GetValue() - text.Contains("double", StringComparison.Ordinal) - && text.Contains("function", StringComparison.Ordinal) - && text.Contains("defined at L", StringComparison.Ordinal) - | _ -> false - | _ -> false - | _ -> false - - hasExpectedHoverValue |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover shows typed signature for inferable function even when another binding has a type error`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-best-effort-type-signature-test.fss" - let source = - "type ActionContext = { Name: string }\n" - + "type ShellOperation = | Command of string\n" - + "let command_op command = Command command\n" - + "let bad = 1 + true\n" - + "let tool (context: ActionContext) (args: string option) =\n" - + " [command_op \"x\"]\n" - + "tool\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(6) - position["character"] <- JsonValue.Create(2) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 49 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 49 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("tool: (context: ActionContext) -> (args: string option) -> ShellOperation list", StringComparison.Ordinal) - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover shows typed signature for include-based script functions`` () = - let client = LspClient.start () - try - initialize client - - let tempRoot = Path.Combine(Path.GetTempPath(), $"fscript-lsp-hover-include-{Guid.NewGuid():N}") - Directory.CreateDirectory(tempRoot) |> ignore - let includeFile = Path.Combine(tempRoot, "_protocol.fss") - let mainFile = Path.Combine(tempRoot, "main.fss") - File.WriteAllText(includeFile, "type ActionContext = { Name: string }\ntype ProjectInfo = { Ok: bool }\n") - File.WriteAllText(mainFile, "import \"_protocol.fss\"\n[]\nlet defaults (context: ActionContext) =\n { Ok = true }\n") - - let uri = Uri(mainFile).AbsoluteUri - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(File.ReadAllText(mainFile)) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(8) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 46 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 46 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> - value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - let text = hoverValue - match hoverResp["result"] with - | :? JsonObject -> text.Contains("defaults: (context: ActionContext) -> ProjectInfo", StringComparison.Ordinal) - | _ -> false - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/LspCoreTests.fs b/tests/FScript.LanguageServer.Tests/LspCoreTests.fs deleted file mode 100644 index 8da2552..0000000 --- a/tests/FScript.LanguageServer.Tests/LspCoreTests.fs +++ /dev/null @@ -1,109 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type LspCoreTests () = - [] - member _.``Initialize returns capabilities`` () = - let client = LspClient.start () - try - initialize client - - let completionProbe = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create("file:///tmp/test.fss") - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(0) - completionProbe["textDocument"] <- textDocument - completionProbe["position"] <- position - LspClient.sendRequest client 3 "textDocument/completion" (Some completionProbe) - - let completionResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 3 with _ -> false - | _ -> false) - - completionResp["result"] |> should not' (equal null) - - let inlayReq = JsonObject() - let textDocument2 = JsonObject() - textDocument2["uri"] <- JsonValue.Create("file:///tmp/test.fss") - inlayReq["textDocument"] <- textDocument2 - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(0) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(0) - endPos["character"] <- JsonValue.Create(10) - range["start"] <- startPos - range["end"] <- endPos - inlayReq["range"] <- range - LspClient.sendRequest client 31 "textDocument/inlayHint" (Some inlayReq) - let inlayResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 31 with _ -> false - | _ -> false) - - inlayResp["result"] |> should not' (equal null) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Custom AST requests reject non-file URIs`` () = - let client = LspClient.start () - try - initialize client - - let requestParams = JsonObject() - requestParams["uri"] <- JsonValue.Create("untitled:ast-test") - - LspClient.sendRequest client 62 "fscript/viewAst" (Some requestParams) - let response = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 62 with _ -> false - | _ -> false) - - let okValue = - match response["result"] with - | :? JsonObject as result -> - match result["ok"] with - | :? JsonValue as okNode -> - try okNode.GetValue() with _ -> true - | _ -> true - | _ -> true - - let message = - match response["result"] with - | :? JsonObject as result -> - match result["error"] with - | :? JsonObject as error -> - match error["message"] with - | :? JsonValue as mv -> - try mv.GetValue() with _ -> "" - | _ -> "" - | _ -> "" - | _ -> "" - - Assert.That(okValue, Is.False) - Assert.That(message.Contains("file-based scripts only", StringComparison.Ordinal), Is.True) - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/LspCustomRequestsTests.fs b/tests/FScript.LanguageServer.Tests/LspCustomRequestsTests.fs deleted file mode 100644 index ff7ade2..0000000 --- a/tests/FScript.LanguageServer.Tests/LspCustomRequestsTests.fs +++ /dev/null @@ -1,186 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type LspCustomRequestsTests () = - [] - member _.``Custom request viewAst returns parsed program as JSON`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/view-ast-test.fss" - let source = "let value = 42\nvalue\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let requestParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - requestParams["textDocument"] <- textDocument - - LspClient.sendRequest client 60 "fscript/viewAst" (Some requestParams) - let response = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 60 with _ -> false - | _ -> false) - - let okValue = - match response["result"] with - | :? JsonObject as result -> - match result["ok"] with - | :? JsonValue as okNode -> - try okNode.GetValue() with _ -> false - | _ -> false - | _ -> false - - let kindValue = - match response["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonObject as data -> - match data["kind"] with - | :? JsonValue as k -> - try k.GetValue() with _ -> "" - | _ -> "" - | _ -> "" - | _ -> "" - - Assert.That(okValue, Is.True) - Assert.That(kindValue, Is.EqualTo("program")) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Custom request viewInferredAst returns typed program as JSON`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/view-inferred-ast-test.fss" - let source = "let inc x = x + 1\ninc 1\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let requestParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - requestParams["textDocument"] <- textDocument - - LspClient.sendRequest client 61 "fscript/viewInferredAst" (Some requestParams) - let response = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 61 with _ -> false - | _ -> false) - - let okValue = - match response["result"] with - | :? JsonObject as result -> - match result["ok"] with - | :? JsonValue as okNode -> - try okNode.GetValue() with _ -> false - | _ -> false - | _ -> false - - let kindValue = - match response["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonObject as data -> - match data["kind"] with - | :? JsonValue as k -> - try k.GetValue() with _ -> "" - | _ -> "" - | _ -> "" - | _ -> "" - - Assert.That(okValue, Is.True) - Assert.That(kindValue, Is.EqualTo("typedProgram")) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Custom request stdlibSource returns embedded source text`` () = - let client = LspClient.start () - try - initialize client - - let requestParams = JsonObject() - requestParams["uri"] <- JsonValue.Create("fscript-stdlib:///Option.fss") - - LspClient.sendRequest client 611 "fscript/stdlibSource" (Some requestParams) - let response = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 611 with _ -> false - | _ -> false) - - let okValue = - match response["result"] with - | :? JsonObject as result -> - match result["ok"] with - | :? JsonValue as okNode -> - try okNode.GetValue() with _ -> false - | _ -> false - | _ -> false - - let sourceText = - match response["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonObject as data -> - match data["text"] with - | :? JsonValue as textNode -> - try textNode.GetValue() with _ -> "" - | _ -> "" - | _ -> "" - | _ -> "" - - Assert.That(okValue, Is.True) - Assert.That(sourceText.Contains("let map mapper value", StringComparison.Ordinal), Is.True) - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/LspHoverAndInlayTests.fs b/tests/FScript.LanguageServer.Tests/LspHoverAndInlayTests.fs deleted file mode 100644 index eb973d9..0000000 --- a/tests/FScript.LanguageServer.Tests/LspHoverAndInlayTests.fs +++ /dev/null @@ -1,1090 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type LspHoverAndInlayTests () = - [] - member _.``Inlay hints return parameter labels for function calls`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-params-test.fss" - let source = "let add x y = x + y\nlet z = add(1, 2)" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(1) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(1) - endPos["character"] <- JsonValue.Create(20) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 32 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 32 with _ -> false - | _ -> false) - - let labels = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.choose (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Seq.toList - | _ -> [] - - labels |> should contain "x:" - labels |> should contain "y:" - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Inlay hints do not show parameter labels on typed function declarations`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-typed-declaration-test.fss" - let source = - "type ActionContext = { Name: string }\n" - + "let defaults (context: ActionContext) = context.Name\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(1) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(1) - endPos["character"] <- JsonValue.Create(50) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 45 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 45 with _ -> false - | _ -> false) - - let labels = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.choose (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Seq.toList - | _ -> [] - - labels |> should not' (contain "context:") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Inlay hints include inferred type for value bindings`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-types-test.fss" - let source = "let answer = 42\nanswer" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(0) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(0) - endPos["character"] <- JsonValue.Create(20) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 33 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 33 with _ -> false - | _ -> false) - - let hasTypeHint = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.exists (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try v.GetValue() = ": int" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - - hasTypeHint |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Inlay hints include inferred type for lambda parameter`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-lambda-param-test.fss" - let source = "let inc = fun x -> x + 1\ninc 2" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(0) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(0) - endPos["character"] <- JsonValue.Create(30) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 34 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 34 with _ -> false - | _ -> false) - - let hasLambdaParamTypeHint = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.exists (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try v.GetValue() = ": int" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - - hasLambdaParamTypeHint |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Inlay hints include inferred return type for function declarations`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-function-return-test.fss" - let source = "let is_empty values = values = []\nis_empty []" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(0) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(0) - endPos["character"] <- JsonValue.Create(40) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 48 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 48 with _ -> false - | _ -> false) - - let hasBoolReturnHint = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.exists (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try v.GetValue() = ": bool" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - - hasBoolReturnHint |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Inlay hints include inferred type for option pattern variable`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/inlay-hints-option-pattern-var-test.fss" - let source = - "let firstEven = Some 2\n" - + "match firstEven with\n" - + "| Some x -> x\n" - + "| None -> 0\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(2) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(2) - endPos["character"] <- JsonValue.Create(20) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 44 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 44 with _ -> false - | _ -> false) - - let hasPatternVarTypeHint = - match resp["result"] with - | :? JsonArray as hints -> - hints - |> Seq.exists (fun hint -> - match hint with - | :? JsonObject as h -> - match h["label"] with - | :? JsonValue as v -> - try v.GetValue() = ": int" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - - hasPatternVarTypeHint |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Inlay hints can be disabled through initialization options`` () = - let client = LspClient.start () - try - let options = JsonObject() - options["inlayHintsEnabled"] <- JsonValue.Create(false) - initializeWith client (Some options) - - let uri = "file:///tmp/inlay-hints-disabled-test.fss" - let source = "let add x y = x + y\nlet z = add(1, 2)" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(1) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(1) - endPos["character"] <- JsonValue.Create(20) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - - LspClient.sendRequest client 35 "textDocument/inlayHint" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 35 with _ -> false - | _ -> false) - - let isEmpty = - match resp["result"] with - | :? JsonArray as hints -> (hints |> Seq.length) = 0 - | _ -> false - - isEmpty |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover shows named arguments for injected stdlib function`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-injected-stdlib-test.fss" - let source = "let value = Option.map (fun x -> x + 1) (Some 1)\nvalue" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(21) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 71 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 71 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHover = - hoverValue.Contains("Option.map:", StringComparison.Ordinal) - && hoverValue.Contains("(mapper:", StringComparison.Ordinal) - && hoverValue.Contains("(value:", StringComparison.Ordinal) - && hoverValue.Contains("injected-function", StringComparison.Ordinal) - - Assert.That(hasExpectedHover, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover shows function parameters when type inference is unavailable`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-function-params-fallback-test.fss" - let source = - "let bad = 1 + true\n" - + "let with_batch_projects context create_command =\n" - + " create_command context\n" - + "with_batch_projects\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(3) - position["character"] <- JsonValue.Create(5) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 47 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 47 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("with_batch_projects:", StringComparison.Ordinal) - && hoverValue.Contains("->", StringComparison.Ordinal) - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover returns record field information for dotted access`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-record-field-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet home = { City = \"Paris\"; Zip = 75000 }\nhome.City" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(7) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 30 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 30 with _ -> false - | _ -> false) - - let hasFieldHover = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> - let text = value.GetValue() - text.Contains("City : string", StringComparison.Ordinal) - && text.Contains("record-field", StringComparison.Ordinal) - | _ -> false - | _ -> false - | _ -> false - - hasFieldHover |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover returns inferred type for local lambda variables`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-local-variables-test.fss" - let source = - "let rec fib n = if n < 2 then n else fib (n - 1) + fib (n - 2)\n" - + "let values =\n" - + " [0..9]\n" - + " |> List.map (fun i ->\n" - + " i |> fib |> fun x ->\n" - + " $\"{x}\")\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let requestHover (requestId: int) (line: int) (character: int) = - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(line) - position["character"] <- JsonValue.Create(character) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - LspClient.sendRequest client requestId "textDocument/hover" (Some hoverParams) - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = requestId with _ -> false - | _ -> false) - - let hoverText (resp: JsonNode) = - match resp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasLocalHoverType (text: string) (name: string) (typeText: string) = - text.Contains($"{name} : {typeText}", StringComparison.Ordinal) - && text.Contains("local-variable", StringComparison.Ordinal) - - let hoverI = requestHover 41 3 21 - let hoverX = requestHover 42 4 24 - let hoverIText = hoverText hoverI - let hoverXText = hoverText hoverX - - Assert.That(hasLocalHoverType hoverIText "i" "int", Is.True, $"Unexpected hover for i: {hoverIText}") - Assert.That(hasLocalHoverType hoverXText "x" "int", Is.True, $"Unexpected hover for x: {hoverXText}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover returns local binding type even when another top-level binding has a type error`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-local-binding-best-effort-test.fss" - let source = - "let bad = 1 + true\n" - + "let restore context =\n" - + " let locked = context = \"locked\"\n" - + " if locked then \"x\" else \"y\"\n" - + "restore \"u\"\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(3) - position["character"] <- JsonValue.Create(8) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 50 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 50 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("locked : bool", StringComparison.Ordinal) - && hoverValue.Contains("local-variable", StringComparison.Ordinal) - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover on top-level function is not shadowed by same-name local binding`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-top-level-not-shadowed-by-local-test.fss" - let source = - "let restore (context: string option) =\n" - + " let restore = context\n" - + " restore\n" - + "restore None\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(5) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 51 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 51 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("restore:", StringComparison.Ordinal) - && hoverValue.Contains("local-variable", StringComparison.Ordinal) |> not - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover resolves nearest local binding when name is reused across functions`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-nearest-local-reused-name-test.fss" - let source = - "let first args =\n" - + " let flag = args = \"x\"\n" - + " flag\n" - + "let second args =\n" - + " let flag = args = 42\n" - + " flag\n" - + "second 42\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(5) - position["character"] <- JsonValue.Create(6) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 52 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 52 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("flag : bool", StringComparison.Ordinal) - && hoverValue.Contains("local-variable", StringComparison.Ordinal) - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover resolves local let declaration identifier`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-local-let-declaration-test.fss" - let source = - "let defaults context =\n" - + " let dependencies =\n" - + " if context then [] else []\n" - + " dependencies\n" - + "defaults true\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(9) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 53 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 53 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("dependencies : unknown list", StringComparison.Ordinal) - && hoverValue.Contains("local-variable", StringComparison.Ordinal) - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Hover infers local let type from returned record field when best-effort falls back`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/hover-local-let-return-record-field-test.fss" - let source = - "type ProjectInfo = { Id: string option; Outputs: string list; Dependencies: string list }\n" - + "let external_call x = missing_function x\n" - + "let defaults context =\n" - + " let dependencies =\n" - + " context\n" - + " |> external_call\n" - + " |> Option.defaultValue []\n" - + " { Id = None; Outputs = []; Dependencies = dependencies }\n" - + "defaults \"ok\"\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hoverParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(3) - position["character"] <- JsonValue.Create(9) - hoverParams["textDocument"] <- textDocument - hoverParams["position"] <- position - - LspClient.sendRequest client 54 "textDocument/hover" (Some hoverParams) - let hoverResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 54 with _ -> false - | _ -> false) - - let hoverValue = - match hoverResp["result"] with - | :? JsonObject as result -> - match result["contents"] with - | :? JsonObject as contents -> - match contents["value"] with - | :? JsonValue as value -> value.GetValue() - | _ -> "" - | _ -> "" - | _ -> "" - - let hasExpectedHoverValue = - hoverValue.Contains("dependencies : string list", StringComparison.Ordinal) - && hoverValue.Contains("local-variable", StringComparison.Ordinal) - - Assert.That(hasExpectedHoverValue, Is.True, $"Unexpected hover text: {hoverValue}") - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/LspNavigationTests.fs b/tests/FScript.LanguageServer.Tests/LspNavigationTests.fs deleted file mode 100644 index 1252e16..0000000 --- a/tests/FScript.LanguageServer.Tests/LspNavigationTests.fs +++ /dev/null @@ -1,981 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type LspNavigationTests () = - [] - member _.``References returns all occurrences for a top-level binding`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/references-test.fss" - let source = "let alpha x = x + 1\nlet v = alpha 41\nalpha v" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let refsParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(9) - refsParams["textDocument"] <- textDocument - refsParams["position"] <- position - let ctx = JsonObject() - ctx["includeDeclaration"] <- JsonValue.Create(true) - refsParams["context"] <- ctx - - LspClient.sendRequest client 6 "textDocument/references" (Some refsParams) - let refsResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 6 with _ -> false - | _ -> false) - - let count = - match refsResp["result"] with - | :? JsonArray as items -> items |> Seq.length - | _ -> 0 - - count |> should be (greaterThanOrEqualTo 3) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``References returns occurrences across opened documents`` () = - let client = LspClient.start () - try - initialize client - - let openDoc (uri: string) (source: string) = - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let sourceUri = "file:///tmp/references-source.fss" - let usageUri = "file:///tmp/references-usage.fss" - openDoc sourceUri "let alpha x = x + 1" - openDoc usageUri "let one = alpha 1\nlet two = alpha 2" - - let refsParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(usageUri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(11) - refsParams["textDocument"] <- textDocument - refsParams["position"] <- position - let ctx = JsonObject() - ctx["includeDeclaration"] <- JsonValue.Create(true) - refsParams["context"] <- ctx - - LspClient.sendRequest client 23 "textDocument/references" (Some refsParams) - let refsResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 23 with _ -> false - | _ -> false) - - let uris = - match refsResp["result"] with - | :? JsonArray as items -> - items - |> Seq.choose (fun item -> - match item with - | :? JsonObject as o -> - match o["uri"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Set.ofSeq - | _ -> Set.empty - - uris.Contains(sourceUri) |> should equal true - uris.Contains(usageUri) |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``References honors includeDeclaration false across opened documents`` () = - let client = LspClient.start () - try - initialize client - - let openDoc (uri: string) (source: string) = - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let sourceUri = "file:///tmp/references-nodecl-source.fss" - let usageUri = "file:///tmp/references-nodecl-usage.fss" - openDoc sourceUri "let alpha x = x + 1" - openDoc usageUri "let value = alpha 41" - - let refsParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(usageUri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(12) - refsParams["textDocument"] <- textDocument - refsParams["position"] <- position - let ctx = JsonObject() - ctx["includeDeclaration"] <- JsonValue.Create(false) - refsParams["context"] <- ctx - - LspClient.sendRequest client 27 "textDocument/references" (Some refsParams) - let refsResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 27 with _ -> false - | _ -> false) - - let uris = - match refsResp["result"] with - | :? JsonArray as items -> - items - |> Seq.choose (fun item -> - match item with - | :? JsonObject as o -> - match o["uri"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None) - |> Set.ofSeq - | _ -> Set.empty - - uris.Contains(sourceUri) |> should equal false - uris.Contains(usageUri) |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition resolves top-level binding usage`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/definition-test.fss" - let source = "let inc x = x + 1\nlet y = inc 41" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(11) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 8 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 8 with _ -> false - | _ -> false) - - let isDefinitionOnFirstLine = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - - isDefinitionOnFirstLine |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition resolves injected stdlib function to virtual stdlib source`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/definition-injected-stdlib-test.fss" - let source = "let value = Option.map (fun x -> x + 1) (Some 1)\nvalue" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(21) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 81 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 81 with _ -> false - | _ -> false) - - let resolvedUri = - match defResp["result"] with - | :? JsonObject as loc -> - match loc["uri"] with - | :? JsonValue as u -> - try Some (u.GetValue()) with _ -> None - | _ -> None - | _ -> None - - resolvedUri |> should equal (Some "fscript-stdlib:///Option.fss") - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition resolves symbol across opened documents`` () = - let client = LspClient.start () - try - initialize client - - let openDoc (uri: string) (source: string) = - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defUri = "file:///tmp/definition-source.fss" - let useUri = "file:///tmp/definition-usage.fss" - openDoc defUri "let alpha x = x + 1" - openDoc useUri "let result = alpha 41" - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(useUri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(14) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 21 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 21 with _ -> false - | _ -> false) - - let resolvedUri = - match defResp["result"] with - | :? JsonObject as loc -> - match loc["uri"] with - | :? JsonValue as u -> - try Some (u.GetValue()) with _ -> None - | _ -> None - | _ -> None - - resolvedUri |> should equal (Some defUri) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition resolves include path to target file`` () = - let client = LspClient.start () - try - initialize client - - let tempRoot = Path.Combine(Path.GetTempPath(), $"fscript-lsp-include-{Guid.NewGuid():N}") - Directory.CreateDirectory(tempRoot) |> ignore - let includeFile = Path.Combine(tempRoot, "_helpers.fss") - let mainFile = Path.Combine(tempRoot, "main.fss") - File.WriteAllText(includeFile, "let helper = 42\n") - File.WriteAllText(mainFile, "import \"_helpers.fss\"\nlet x = helper\n") - - let uri = Uri(mainFile).AbsoluteUri - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(File.ReadAllText(mainFile)) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(13) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 36 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 36 with _ -> false - | _ -> false) - - let expectedUri = Uri(includeFile).AbsoluteUri - let resolvedUri = - match defResp["result"] with - | :? JsonObject as result -> - match result["uri"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None - - resolvedUri |> should equal (Some expectedUri) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition on included record field usage opens included file`` () = - let client = LspClient.start () - try - initialize client - - let tempRoot = Path.Combine(Path.GetTempPath(), $"fscript-lsp-include-field-{Guid.NewGuid():N}") - Directory.CreateDirectory(tempRoot) |> ignore - let includeFile = Path.Combine(tempRoot, "_protocol.fss") - let mainFile = Path.Combine(tempRoot, "main.fss") - - File.WriteAllText(includeFile, "type ActionContext = { Command: string }\n") - File.WriteAllText(mainFile, "import \"_protocol.fss\"\nlet dispatch (context: ActionContext) = context.Command\n") - - let uri = Uri(mainFile).AbsoluteUri - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(File.ReadAllText(mainFile)) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(52) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 360 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 360 with _ -> false - | _ -> false) - - let expectedUri = Uri(includeFile).AbsoluteUri - let resolvedUri = - match defResp["result"] with - | :? JsonObject as result -> - match result["uri"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None - - resolvedUri |> should equal (Some expectedUri) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Type definition resolves record value to declared record type`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/type-definition-record-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet home = { City = \"Paris\"; Zip = 75000 }\nlet zip = home.Zip" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(10) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 16 "textDocument/typeDefinition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 16 with _ -> false - | _ -> false) - - let pointsToTypeDecl = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - pointsToTypeDecl |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Type definition resolves inline nominal record annotation to declared type`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/type-definition-inline-annotation-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet format_address (address: { City: string; Zip: int }) = $\"{address.City} ({address.Zip})\"" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(30) // City in annotation - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 160 "textDocument/typeDefinition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 160 with _ -> false - | _ -> false) - - let pointsToTypeDecl = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - - pointsToTypeDecl |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Type definition resolves annotated parameter usage to declared type`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/type-definition-parameter-usage-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet format_address (address: { City: string; Zip: int }) = address.City" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(62) // address in address.City - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 161 "textDocument/typeDefinition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 161 with _ -> false - | _ -> false) - - let pointsToTypeDecl = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - - pointsToTypeDecl |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Type definition resolves record literal call-argument field label to declared type`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/type-definition-record-call-arg-field-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet make_office_address (address: Address) = address\nlet officeAddress = make_office_address { City = \"London\"; Zip = 12345 }" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(43) // City in literal argument - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 162 "textDocument/typeDefinition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 162 with _ -> false - | _ -> false) - - let pointsToTypeDecl = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - - pointsToTypeDecl |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition resolves record literal call-argument field label to declared type`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/definition-record-call-arg-field-test.fss" - let source = "type Address = { City: string; Zip: int }\nlet make_address (address: Address) = address\nlet office = make_address { City = \"London\"; Zip = 12345 }" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(33) // City in literal argument - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 163 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 163 with _ -> false - | _ -> false) - - let pointsToTypeDecl = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - - pointsToTypeDecl |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Type definition resolves record literal binding field label to declared type`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/type-definition-record-binding-field-test.fss" - let source = "type Contact = { Name: string; City: string; Zip: int; Country: string }\nlet contact = { Name = \"Ada\"; City = \"Paris\"; Zip = 75000; Country = \"FR\" }" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(30) // City in literal binding - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 164 "textDocument/typeDefinition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 164 with _ -> false - | _ -> false) - - let pointsToTypeDecl = - match defResp["result"] with - | :? JsonObject as result -> - let uriOk = - match result["uri"] with - | :? JsonValue as v -> (try v.GetValue() = uri with _ -> false) - | _ -> false - let startLineOk = - match result["range"] with - | :? JsonObject as rangeObj -> - match rangeObj["start"] with - | :? JsonObject as startObj -> - match startObj["line"] with - | :? JsonValue as v -> (try v.GetValue() = 0 with _ -> false) - | _ -> false - | _ -> false - | _ -> false - uriOk && startLineOk - | _ -> false - - pointsToTypeDecl |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Definition resolves function return record field label to declared type in include file`` () = - let client = LspClient.start () - try - initialize client - - let tempRoot = Path.Combine(Path.GetTempPath(), $"fscript-lsp-type-definition-return-field-{Guid.NewGuid():N}") - Directory.CreateDirectory(tempRoot) |> ignore - let includeFile = Path.Combine(tempRoot, "_protocol.fss") - let mainFile = Path.Combine(tempRoot, "main.fss") - - File.WriteAllText(includeFile, "type ActionContext = { Directory: string }\ntype ProjectInfo = { Id: string option; Outputs: string list; Dependencies: string list }\n") - File.WriteAllText(mainFile, "import \"_protocol.fss\"\n[] let defaults (context: ActionContext) =\n let id = None\n { Id = id; Outputs = [\"dist/**\"]; Dependencies = [] }\n") - - let uri = Uri(mainFile).AbsoluteUri - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(File.ReadAllText(mainFile)) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let defParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(3) - position["character"] <- JsonValue.Create(4) - defParams["textDocument"] <- textDocument - defParams["position"] <- position - - LspClient.sendRequest client 364 "textDocument/definition" (Some defParams) - let defResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 364 with _ -> false - | _ -> false) - - let expectedUri = Uri(includeFile).AbsoluteUri - let resolvedUri = - match defResp["result"] with - | :? JsonObject as result -> - match result["uri"] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - | _ -> None - - resolvedUri |> should equal (Some expectedUri) - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/LspSymbolsAndActionsTests.fs b/tests/FScript.LanguageServer.Tests/LspSymbolsAndActionsTests.fs deleted file mode 100644 index b17b466..0000000 --- a/tests/FScript.LanguageServer.Tests/LspSymbolsAndActionsTests.fs +++ /dev/null @@ -1,1022 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -open LspTestFixture - -[] -type LspSymbolsAndActionsTests () = - [] - member _.``Semantic tokens full returns token data`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/semantic-tokens-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("type User = { Name: string }\nlet user = { Name = \"Ada\" }\nlet x = 42") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - - LspClient.sendRequest client 17 "textDocument/semanticTokens/full" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 17 with _ -> false - | _ -> false) - - let hasTokenData = - match resp["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonArray as items -> - (items |> Seq.length) >= 5 - | _ -> false - | _ -> false - - hasTokenData |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Semantic tokens classify attribute keyword and module-qualified function`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/semantic-tokens-classification-test.fss" - let source = "[]\nlet values = List.map (fun n -> n + 1) [1]" - let lines = source.Split('\n') - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - - LspClient.sendRequest client 29 "textDocument/semanticTokens/full" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 29 with _ -> false - | _ -> false) - - let decodedTokens = - let mutable previousLine = 0 - let mutable previousStart = 0 - match resp["result"] with - | :? JsonObject as result -> - match result["data"] with - | :? JsonArray as data -> - data - |> Seq.toArray - |> Array.chunkBySize 5 - |> Array.choose (fun chunk -> - if chunk.Length <> 5 then None else - let readInt (n: JsonNode | null) = - match n with - | null -> None - | :? JsonValue as v -> (try Some (v.GetValue()) with _ -> None) - | _ -> None - - match readInt chunk[0], readInt chunk[1], readInt chunk[2], readInt chunk[3] with - | Some deltaLine, Some deltaStart, Some length, Some tokenType -> - let line = previousLine + deltaLine - let start = if deltaLine = 0 then previousStart + deltaStart else deltaStart - previousLine <- line - previousStart <- start - let text = - if line >= 0 && line < lines.Length && start >= 0 && start + length <= lines[line].Length then - lines[line].Substring(start, length) - else - "" - Some (line, start, text, tokenType) - | _ -> None) - | _ -> Array.empty - | _ -> Array.empty - - let hasExportKeyword = - decodedTokens - |> Array.exists (fun (_, _, text, tokenType) -> text = "export" && tokenType = 0) - let hasListMapFunction = - decodedTokens - |> Array.exists (fun (_, _, text, tokenType) -> text = "List.map" && tokenType = 3) - - hasExportKeyword |> should equal true - hasListMapFunction |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``DidOpen publishes diagnostics on parse error`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/diagnostic-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("let x =") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv when (try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false) -> - match msg["params"] with - | :? JsonObject as p -> - match p["uri"], p["diagnostics"] with - | :? JsonValue as u, diagnosticsNode -> - match diagnosticsNode with - | :? JsonArray as diagnosticsArray -> - (try u.GetValue() = uri with _ -> false) - && ((diagnosticsArray |> Seq.length) > 0) - | _ -> false - | _ -> false - | _ -> false - | _ -> false) - - diagMsg |> should not' (equal null) - - let hasExpectedDiagnosticMetadata = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as diagnostics -> - diagnostics - |> Seq.exists (fun diag -> - match diag with - | :? JsonObject as d -> - let sourceOk = - match d["source"] with - | :? JsonValue as v -> (try v.GetValue() = "fscript-lsp" with _ -> false) - | _ -> false - let codeOk = - match d["code"] with - | :? JsonValue as v -> (try v.GetValue() = "parse" with _ -> false) - | _ -> false - sourceOk && codeOk - | _ -> false) - | _ -> false - | _ -> false - - hasExpectedDiagnosticMetadata |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``DidOpen does not publish unused binding warning`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/unused-binding-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("let unused_value = 1\nlet used_value = 2\nused_value") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diag = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - - let hasUnusedWarning = - match diag["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as items -> - items - |> Seq.exists (fun item -> - match item with - | :? JsonObject as d -> - let codeOk = - match d["code"] with - | :? JsonValue as cv -> (try cv.GetValue() = "unused" with _ -> false) - | _ -> false - let severityOk = - match d["severity"] with - | :? JsonValue as sv -> (try sv.GetValue() = 2 with _ -> false) - | _ -> false - codeOk && severityOk - | _ -> false) - | _ -> false - | _ -> false - - hasUnusedWarning |> should equal false - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``DidOpen does not publish unused warning for exported binding`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/unused-exported-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("[]\nlet defaults = 42") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv when (try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false) -> - match msg["params"] with - | :? JsonObject as p -> - match p["uri"] with - | :? JsonValue as u -> - try u.GetValue() = uri with _ -> false - | _ -> false - | _ -> false - | _ -> false) - - let hasUnusedWarning = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as diagnosticsArray -> - diagnosticsArray - |> Seq.exists (fun d -> - match d with - | :? JsonObject as diag -> - let codeMatches = - match diag["code"] with - | :? JsonValue as codeValue -> - try codeValue.GetValue() = "unused" with _ -> false - | _ -> false - let messageMatches = - match diag["message"] with - | :? JsonValue as messageValue -> - try messageValue.GetValue().Contains("defaults", StringComparison.Ordinal) with _ -> false - | _ -> false - codeMatches && messageMatches - | _ -> false) - | _ -> false - | _ -> false - - hasUnusedWarning |> should equal false - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``DidOpen does not publish unused warnings from included files`` () = - let client = LspClient.start () - try - initialize client - - let tempRoot = Path.Combine(Path.GetTempPath(), $"fscript-lsp-unused-include-{Guid.NewGuid():N}") - Directory.CreateDirectory(tempRoot) |> ignore - let includeFile = Path.Combine(tempRoot, "_helpers.fss") - let mainFile = Path.Combine(tempRoot, "main.fss") - File.WriteAllText(includeFile, "let with_flag x = x\n") - File.WriteAllText(mainFile, "import \"_helpers.fss\"\nlet first_project_file x = x\nlet result = first_project_file 1\nresult\n") - - let uri = Uri(mainFile).AbsoluteUri - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(File.ReadAllText(mainFile)) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv when (try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false) -> - match msg["params"] with - | :? JsonObject as p -> - match p["uri"] with - | :? JsonValue as u -> - try u.GetValue() = uri with _ -> false - | _ -> false - | _ -> false - | _ -> false) - - let hasIncludedUnusedWarning = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as diagnosticsArray -> - diagnosticsArray - |> Seq.exists (fun d -> - match d with - | :? JsonObject as diag -> - let codeOk = - match diag["code"] with - | :? JsonValue as cv -> (try cv.GetValue() = "unused" with _ -> false) - | _ -> false - let messageMentionsIncludedBinding = - match diag["message"] with - | :? JsonValue as mv -> - try mv.GetValue().Contains("with_flag", StringComparison.Ordinal) with _ -> false - | _ -> false - codeOk && messageMentionsIncludedBinding - | _ -> false) - | _ -> false - | _ -> false - - hasIncludedUnusedWarning |> should equal false - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``DidOpen does not publish unused warnings for underscore helper files`` () = - let client = LspClient.start () - try - initialize client - - let helperFile = Path.Combine(Path.GetTempPath(), $"_helpers-{Guid.NewGuid():N}.fss") - File.WriteAllText(helperFile, "let append_part part acc = acc\n") - - let uri = Uri(helperFile).AbsoluteUri - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(File.ReadAllText(helperFile)) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv when (try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false) -> - match msg["params"] with - | :? JsonObject as p -> - match p["uri"] with - | :? JsonValue as u -> - try u.GetValue() = uri with _ -> false - | _ -> false - | _ -> false - | _ -> false) - - let hasUnusedWarning = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as diagnosticsArray -> - diagnosticsArray - |> Seq.exists (fun d -> - match d with - | :? JsonObject as diag -> - match diag["code"] with - | :? JsonValue as cv -> (try cv.GetValue() = "unused" with _ -> false) - | _ -> false - | _ -> false) - | _ -> false - | _ -> false - - hasUnusedWarning |> should equal false - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``DidOpen does not report unbound variable for intrinsic print`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/print-intrinsic-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("print \"hello\"") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - - let hasUnboundPrint = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as items -> - items - |> Seq.exists (fun item -> - match item with - | :? JsonObject as d -> - match d["message"] with - | :? JsonValue as m -> - try m.GetValue().Contains("Unbound variable 'print'", StringComparison.Ordinal) with _ -> false - | _ -> false - | _ -> false) - | _ -> false - | _ -> false - - hasUnboundPrint |> should equal false - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Code action suggests quick fix for unbound variable typo`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/code-action-typo-test.fss" - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create("let alpha = 1\nalph") - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - - let diagnostics = - match diagMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as items -> items - | _ -> JsonArray() - | _ -> JsonArray() - - let req = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - req["textDocument"] <- textDocument - let range = JsonObject() - let startPos = JsonObject() - startPos["line"] <- JsonValue.Create(1) - startPos["character"] <- JsonValue.Create(0) - let endPos = JsonObject() - endPos["line"] <- JsonValue.Create(1) - endPos["character"] <- JsonValue.Create(4) - range["start"] <- startPos - range["end"] <- endPos - req["range"] <- range - let context = JsonObject() - let diagnosticsCopy = JsonArray() - for d in diagnostics do - match d with - | null -> () - | node -> - diagnosticsCopy.Add(node.DeepClone()) - context["diagnostics"] <- diagnosticsCopy - req["context"] <- context - - LspClient.sendRequest client 18 "textDocument/codeAction" (Some req) - let resp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 18 with _ -> false - | _ -> false) - - let hasAlphaSuggestion = - match resp["result"] with - | :? JsonArray as items -> - items - |> Seq.exists (fun item -> - match item with - | :? JsonObject as action -> - match action["title"] with - | :? JsonValue as title -> - try title.GetValue().Contains("'alpha'", StringComparison.Ordinal) with _ -> false - | _ -> false - | _ -> false) - | _ -> false - - hasAlphaSuggestion |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Document highlight returns local occurrences for selected symbol`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/document-highlight-test.fss" - let source = "let alpha x = x + 1\nlet v = alpha 41\nalpha v" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let hParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(9) - hParams["textDocument"] <- textDocument - hParams["position"] <- position - - LspClient.sendRequest client 14 "textDocument/documentHighlight" (Some hParams) - let hResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 14 with _ -> false - | _ -> false) - - let count = - match hResp["result"] with - | :? JsonArray as items -> items |> Seq.length - | _ -> 0 - - count |> should be (greaterThanOrEqualTo 3) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Workspace symbol returns matches across opened documents`` () = - let client = LspClient.start () - try - initialize client - - let openDoc (uri: string) (source: string) = - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - openDoc "file:///tmp/workspace-symbol-1.fss" "let alpha x = x + 1" - openDoc "file:///tmp/workspace-symbol-2.fss" "let beta y = y + 2" - - let wsParams = JsonObject() - wsParams["query"] <- JsonValue.Create("alpha") - - LspClient.sendRequest client 15 "workspace/symbol" (Some wsParams) - let wsResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 15 with _ -> false - | _ -> false) - - let hasAlpha = - match wsResp["result"] with - | :? JsonArray as items -> - items - |> Seq.exists (fun item -> - match item with - | :? JsonObject as o -> - match o["name"] with - | :? JsonValue as v -> - try v.GetValue() = "alpha" with _ -> false - | _ -> false - | _ -> false) - | _ -> false - - hasAlpha |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Language server typing includes runtime externs`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/runtime-externs-typing-test.fss" - let source = "let ok = Fs.exists \".\"\nok\n" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - let diagnosticsMsg = - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - - let diagnosticsCount = - match diagnosticsMsg["params"] with - | :? JsonObject as p -> - match p["diagnostics"] with - | :? JsonArray as arr -> arr.Count - | _ -> -1 - | _ -> -1 - - Assert.That(diagnosticsCount, Is.EqualTo(0)) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Rename returns workspace edit for all symbol occurrences`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/rename-test.fss" - let source = "let value = 1\nlet x = value + 2\nvalue" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let renameParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(10) - renameParams["textDocument"] <- textDocument - renameParams["position"] <- position - renameParams["newName"] <- JsonValue.Create("count") - - LspClient.sendRequest client 10 "textDocument/rename" (Some renameParams) - let renameResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 10 with _ -> false - | _ -> false) - - let renameCount = - match renameResp["result"] with - | :? JsonObject as result -> - match result["changes"] with - | :? JsonObject as changes -> - match changes[uri] with - | :? JsonArray as edits -> - edits - |> Seq.filter (fun edit -> - match edit with - | :? JsonObject as o -> - match o["newText"] with - | :? JsonValue as v -> (try v.GetValue() = "count" with _ -> false) - | _ -> false - | _ -> false) - |> Seq.length - | _ -> 0 - | _ -> 0 - | _ -> 0 - - renameCount |> should be (greaterThanOrEqualTo 3) - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Rename returns workspace edits across opened documents`` () = - let client = LspClient.start () - try - initialize client - - let openDoc (uri: string) (source: string) = - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let sourceUri = "file:///tmp/rename-source.fss" - let usageUri = "file:///tmp/rename-usage.fss" - openDoc sourceUri "let value = 1" - openDoc usageUri "let a = value + 2\nvalue" - - let renameParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(usageUri) - let position = JsonObject() - position["line"] <- JsonValue.Create(0) - position["character"] <- JsonValue.Create(9) - renameParams["textDocument"] <- textDocument - renameParams["position"] <- position - renameParams["newName"] <- JsonValue.Create("count") - - LspClient.sendRequest client 26 "textDocument/rename" (Some renameParams) - let renameResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 26 with _ -> false - | _ -> false) - - let changedUris = - match renameResp["result"] with - | :? JsonObject as result -> - match result["changes"] with - | :? JsonObject as changes -> - changes - |> Seq.map (fun kv -> kv.Key) - |> Set.ofSeq - | _ -> Set.empty - | _ -> Set.empty - - changedUris.Contains(sourceUri) |> should equal true - changedUris.Contains(usageUri) |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Rename does not rename record field labels when renaming variable`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/rename-field-label-test.fss" - let source = "let value = 1\nlet recd = { value = value }\nvalue" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let renameParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(2) - position["character"] <- JsonValue.Create(2) - renameParams["textDocument"] <- textDocument - renameParams["position"] <- position - renameParams["newName"] <- JsonValue.Create("count") - - LspClient.sendRequest client 13 "textDocument/rename" (Some renameParams) - let renameResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 13 with _ -> false - | _ -> false) - - let editCount = - match renameResp["result"] with - | :? JsonObject as result -> - match result["changes"] with - | :? JsonObject as changes -> - match changes[uri] with - | :? JsonArray as edits -> edits |> Seq.length - | _ -> 0 - | _ -> 0 - | _ -> 0 - - // declaration + variable usage in record value + final usage - editCount |> should equal 3 - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``Rename rejects invalid identifier target`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/rename-invalid-test.fss" - let source = "let value = 1\nvalue" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let renameParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(2) - renameParams["textDocument"] <- textDocument - renameParams["position"] <- position - renameParams["newName"] <- JsonValue.Create("123bad") - - LspClient.sendRequest client 11 "textDocument/rename" (Some renameParams) - let renameResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 11 with _ -> false - | _ -> false) - - let hasInvalidParamsError = - match renameResp["error"] with - | :? JsonObject as err -> - let codeOk = - match err["code"] with - | :? JsonValue as v -> (try v.GetValue() = -32602 with _ -> false) - | _ -> false - let messageOk = - match err["message"] with - | :? JsonValue as v -> - let msg = v.GetValue() - msg.Contains("Invalid rename target", StringComparison.Ordinal) - | _ -> false - codeOk && messageOk - | _ -> false - - hasInvalidParamsError |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client - [] - member _.``PrepareRename returns placeholder and range for valid symbol`` () = - let client = LspClient.start () - try - initialize client - - let uri = "file:///tmp/prepare-rename-test.fss" - let source = "let total = 1\ntotal" - - let td = JsonObject() - td["uri"] <- JsonValue.Create(uri) - td["languageId"] <- JsonValue.Create("fscript") - td["version"] <- JsonValue.Create(1) - td["text"] <- JsonValue.Create(source) - - let didOpenParams = JsonObject() - didOpenParams["textDocument"] <- td - LspClient.sendNotification client "textDocument/didOpen" (Some didOpenParams) - - LspClient.readUntil client 10000 (fun msg -> - match msg["method"] with - | :? JsonValue as mv -> - try mv.GetValue() = "textDocument/publishDiagnostics" with _ -> false - | _ -> false) - |> ignore - - let prepareParams = JsonObject() - let textDocument = JsonObject() - textDocument["uri"] <- JsonValue.Create(uri) - let position = JsonObject() - position["line"] <- JsonValue.Create(1) - position["character"] <- JsonValue.Create(2) - prepareParams["textDocument"] <- textDocument - prepareParams["position"] <- position - - LspClient.sendRequest client 12 "textDocument/prepareRename" (Some prepareParams) - let prepareResp = - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 12 with _ -> false - | _ -> false) - - let hasPlaceholder = - match prepareResp["result"] with - | :? JsonObject as result -> - match result["placeholder"] with - | :? JsonValue as v -> (try v.GetValue() = "total" with _ -> false) - | _ -> false - | _ -> false - - hasPlaceholder |> should equal true - finally - try shutdown client with _ -> () - LspClient.stop client diff --git a/tests/FScript.LanguageServer.Tests/LspTestClient.fs b/tests/FScript.LanguageServer.Tests/LspTestClient.fs deleted file mode 100644 index b122b43..0000000 --- a/tests/FScript.LanguageServer.Tests/LspTestClient.fs +++ /dev/null @@ -1,123 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -module internal LspClient = - type Client = - { Process: Process - Input: Stream - Output: Stream } - - let private findRepoRoot () = - let mutable current : DirectoryInfo option = Some (DirectoryInfo(AppContext.BaseDirectory)) - let mutable found: string option = None - - while current.IsSome && found.IsNone do - let directory = current.Value - let candidate = Path.Combine(directory.FullName, "FScript.sln") - if File.Exists(candidate) then - found <- Some directory.FullName - else - current <- Option.ofObj directory.Parent - - found |> Option.defaultWith (fun () -> failwith "Unable to locate repository root from test base directory") - - let private ensureCSharpServerDllBuilt = - lazy ( - let root = findRepoRoot () - let serverProject = Path.Combine(root, "src", "FScript.LanguageServer", "FScript.LanguageServer.csproj") - let serverDll = Path.Combine(root, "src", "FScript.LanguageServer", "bin", "Release", "net10.0", "FScript.LanguageServer.dll") - - let buildPsi = - ProcessStartInfo( - FileName = "dotnet", - Arguments = $"build \"{serverProject}\" -c Release -nologo -v q", - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true) - - use buildProc = new Process(StartInfo = buildPsi) - if not (buildProc.Start()) then - failwith "Unable to start dotnet build for C# language server test setup." - buildProc.WaitForExit() - if buildProc.ExitCode <> 0 || not (File.Exists(serverDll)) then - let out = buildProc.StandardOutput.ReadToEnd() - let err = buildProc.StandardError.ReadToEnd() - failwith $"Failed to build C# language server test target. stdout: {out}\nstderr: {err}" - - serverDll) - - let start () = - let serverDll = ensureCSharpServerDllBuilt.Value - - let psi = - ProcessStartInfo( - FileName = "dotnet", - Arguments = $"\"{serverDll}\"", - RedirectStandardInput = true, - RedirectStandardOutput = true, - RedirectStandardError = true, - UseShellExecute = false, - CreateNoWindow = true) - - let proc = new Process(StartInfo = psi) - let started = proc.Start() - if not started then failwith "Unable to start FScript C# language server process" - - { Process = proc - Input = proc.StandardInput.BaseStream - Output = proc.StandardOutput.BaseStream } - - let startCSharp () = - start () - - let startFSharp () = - start () - - let stop (client: Client) = - if not client.Process.HasExited then - try - client.Process.Kill(true) - with _ -> () - client.Process.Dispose() - - let sendRequest (client: Client) (id: int) (methodName: string) (parameters: JsonNode option) = - let payload = JsonObject() - payload["jsonrpc"] <- JsonValue.Create("2.0") - payload["id"] <- JsonValue.Create(id) - payload["method"] <- JsonValue.Create(methodName) - payload["params"] <- (parameters |> Option.defaultValue (JsonObject())) - LspWire.writeMessage client.Input (payload.ToJsonString()) - - let sendNotification (client: Client) (methodName: string) (parameters: JsonNode option) = - let payload = JsonObject() - payload["jsonrpc"] <- JsonValue.Create("2.0") - payload["method"] <- JsonValue.Create(methodName) - payload["params"] <- (parameters |> Option.defaultValue (JsonObject())) - LspWire.writeMessage client.Input (payload.ToJsonString()) - - let readUntil (client: Client) (timeoutMs: int) (predicate: JsonObject -> bool) = - let deadline = DateTime.UtcNow.AddMilliseconds(float timeoutMs) - let mutable found: JsonObject option = None - - while found.IsNone && DateTime.UtcNow < deadline do - let remaining = int (deadline - DateTime.UtcNow).TotalMilliseconds - if remaining <= 0 then - () - else - let raw = LspWire.readMessageWithTimeout client.Output remaining - let node = JsonNode.Parse(raw) - match node with - | :? JsonObject as obj when predicate obj -> - found <- Some obj - | _ -> () - - found |> Option.defaultWith (fun () -> failwith "Timed out waiting for expected LSP message") diff --git a/tests/FScript.LanguageServer.Tests/LspTestFixture.fs b/tests/FScript.LanguageServer.Tests/LspTestFixture.fs deleted file mode 100644 index 53c2328..0000000 --- a/tests/FScript.LanguageServer.Tests/LspTestFixture.fs +++ /dev/null @@ -1,46 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -module internal LspTestFixture = - let initializeWith (client: LspClient.Client) (initializationOptions: JsonObject option) = - let initializeParams = JsonObject() - initializeParams["processId"] <- JsonValue.Create(None) - initializeParams["rootUri"] <- JsonValue.Create(None) - initializeParams["capabilities"] <- JsonObject() - match initializationOptions with - | Some options -> initializeParams["initializationOptions"] <- options - | None -> () - - LspClient.sendRequest client 1 "initialize" (Some initializeParams) - - let response = - LspClient.readUntil client 20000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 1 with _ -> false - | _ -> false) - - response["result"] |> should not' (equal null) - LspClient.sendNotification client "initialized" None - - let initialize (client: LspClient.Client) = - initializeWith client None - - let shutdown (client: LspClient.Client) = - LspClient.sendRequest client 2 "shutdown" None - LspClient.readUntil client 10000 (fun msg -> - match msg["id"] with - | :? JsonValue as idv -> - try idv.GetValue() = 2 with _ -> false - | _ -> false) - |> ignore - - LspClient.sendNotification client "exit" None diff --git a/tests/FScript.LanguageServer.Tests/LspTestWire.fs b/tests/FScript.LanguageServer.Tests/LspTestWire.fs deleted file mode 100644 index 664650b..0000000 --- a/tests/FScript.LanguageServer.Tests/LspTestWire.fs +++ /dev/null @@ -1,92 +0,0 @@ -namespace FScript.LanguageServer.Tests - -open System -open System.IO -open System.Text -open System.Text.Json -open System.Text.Json.Nodes -open System.Diagnostics -open System.Threading -open NUnit.Framework -open FsUnit -module internal LspWire = - let private utf8 = UTF8Encoding(false) - let mutable private pending = Array.empty - - let private readExactWithTimeout (stream: Stream) (buffer: byte[]) (offset: int) (count: int) (timeoutMs: int) = - use cts = new CancellationTokenSource(timeoutMs) - let mutable readTotal = 0 - while readTotal < count do - let read = - stream.ReadAsync(buffer.AsMemory(offset + readTotal, count - readTotal), cts.Token) - |> fun t -> t.GetAwaiter().GetResult() - - if read <= 0 then - failwith "Unexpected end of stream while reading LSP message." - - readTotal <- readTotal + read - - let readMessageWithTimeout (stream: Stream) (timeoutMs: int) : string = - use cts = new CancellationTokenSource(timeoutMs) - let headerBytes = ResizeArray() - let one = Array.zeroCreate 1 - let marker = [| byte '\r'; byte '\n'; byte '\r'; byte '\n' |] - let mutable matched = 0 - let mutable doneHeader = false - - if pending.Length > 0 then - for b in pending do - headerBytes.Add(b) - pending <- Array.empty - - while not doneHeader do - if headerBytes.Count >= marker.Length then - let tail = - [| headerBytes[headerBytes.Count - 4] - headerBytes[headerBytes.Count - 3] - headerBytes[headerBytes.Count - 2] - headerBytes[headerBytes.Count - 1] |] - if tail = marker then - doneHeader <- true - else - let n = stream.ReadAsync(one.AsMemory(0, 1), cts.Token).GetAwaiter().GetResult() - if n <= 0 then failwith "Unexpected end of stream while reading LSP headers." - let b = one[0] - headerBytes.Add(b) - if b = marker[matched] then - matched <- matched + 1 - if matched = marker.Length then doneHeader <- true - else - matched <- if b = marker[0] then 1 else 0 - else - let n = stream.ReadAsync(one.AsMemory(0, 1), cts.Token).GetAwaiter().GetResult() - if n <= 0 then failwith "Unexpected end of stream while reading LSP headers." - let b = one[0] - headerBytes.Add(b) - if b = marker[matched] then - matched <- matched + 1 - if matched = marker.Length then doneHeader <- true - else - matched <- if b = marker[0] then 1 else 0 - - let header = Encoding.ASCII.GetString(headerBytes.ToArray()) - let contentLength = - header.Split([| "\r\n" |], StringSplitOptions.RemoveEmptyEntries) - |> Array.tryPick (fun line -> - if line.StartsWith("Content-Length:", StringComparison.OrdinalIgnoreCase) then - Some (line.Substring("Content-Length:".Length).Trim() |> int) - else - None) - |> Option.defaultWith (fun () -> failwith "Missing Content-Length header") - - let payload = Array.zeroCreate contentLength - readExactWithTimeout stream payload 0 contentLength timeoutMs - utf8.GetString(payload) - - let writeMessage (stream: Stream) (payload: string) = - let payloadBytes = utf8.GetBytes(payload) - let header = $"Content-Length: {payloadBytes.Length}\r\n\r\n" - let headerBytes = Encoding.ASCII.GetBytes(header) - stream.Write(headerBytes, 0, headerBytes.Length) - stream.Write(payloadBytes, 0, payloadBytes.Length) - stream.Flush() diff --git a/tests/FScript.LanguageServer.Tests/Program.fs b/tests/FScript.LanguageServer.Tests/Program.fs deleted file mode 100644 index 9ee7eaf..0000000 --- a/tests/FScript.LanguageServer.Tests/Program.fs +++ /dev/null @@ -1,4 +0,0 @@ -module Program - -[] -let main _ = 0 From e1031d82aca7109636164c2dea2243c7980c79a4 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 21:15:25 +0100 Subject: [PATCH 12/14] Rename CSharpInterop LanguageServer folder --- CHANGELOG.md | 1 + .../FScript.CSharpInterop.fsproj | 12 +- .../LanguageServer/AstJson.fs | 102 + .../LanguageServer/LspHandlers.fs | 1329 ++++++++++ .../LanguageServer/LspModel.fs | 215 ++ .../LanguageServer/LspProtocol.fs | 97 + .../LanguageServer/LspRuntimeExterns.fs | 8 + .../LanguageServer/LspSymbols.fs | 2186 +++++++++++++++++ 8 files changed, 3944 insertions(+), 6 deletions(-) create mode 100644 src/FScript.CSharpInterop/LanguageServer/AstJson.fs create mode 100644 src/FScript.CSharpInterop/LanguageServer/LspHandlers.fs create mode 100644 src/FScript.CSharpInterop/LanguageServer/LspModel.fs create mode 100644 src/FScript.CSharpInterop/LanguageServer/LspProtocol.fs create mode 100644 src/FScript.CSharpInterop/LanguageServer/LspRuntimeExterns.fs create mode 100644 src/FScript.CSharpInterop/LanguageServer/LspSymbols.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index 85e29b5..d50816a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -7,6 +7,7 @@ All notable changes to FScript are documented in this file. - Removed F# sources from `src/FScript.LanguageServer*` by moving LSP semantic modules into `FScript.CSharpInterop` and keeping `FScript.LanguageServer` as C# host. - Replaced `FScript.LanguageServer.Tests` project with a C# test project and C# LSP test harness to remove F# compile cost from LanguageServer test builds. - Deleted obsolete F# LanguageServer test sources after C# test project migration. +- Renamed `FScript.CSharpInterop/LanguageServerLegacy` to `FScript.CSharpInterop/LanguageServer` to reflect the new primary architecture. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup. diff --git a/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj b/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj index 13a6e1e..2b6bf1c 100644 --- a/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj +++ b/src/FScript.CSharpInterop/FScript.CSharpInterop.fsproj @@ -7,12 +7,12 @@ - - - - - - + + + + + + diff --git a/src/FScript.CSharpInterop/LanguageServer/AstJson.fs b/src/FScript.CSharpInterop/LanguageServer/AstJson.fs new file mode 100644 index 0000000..4797285 --- /dev/null +++ b/src/FScript.CSharpInterop/LanguageServer/AstJson.fs @@ -0,0 +1,102 @@ +namespace FScript.LanguageServer + +#nowarn "3261" +#nowarn "3264" + +open System +open System.Collections +open System.Text.Json.Nodes +open Microsoft.FSharp.Reflection +open FScript.Language + +module AstJson = + let private jsonNull : JsonNode = JsonValue.Create(None) + + let private isOptionType (t: System.Type) = + t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> + + let rec private toJsonNodeInternal (value: objnull) : JsonNode = + match value with + | null -> jsonNull + | :? JsonNode as node -> node + | :? string as s -> JsonValue.Create(s) + | :? bool as b -> JsonValue.Create(b) + | :? int as i -> JsonValue.Create(i) + | :? int64 as i -> JsonValue.Create(i) + | :? float as f -> JsonValue.Create(f) + | :? decimal as d -> JsonValue.Create(d) + | :? char as c -> JsonValue.Create(string c) + | _ -> + let t = value.GetType() + + if isOptionType t then + let case, fields = FSharpValue.GetUnionFields(value, t, true) + if case.Name = "None" then + jsonNull + else + toJsonNodeInternal fields[0] + elif FSharpType.IsUnion(t, true) then + let case, fields = FSharpValue.GetUnionFields(value, t, true) + let result = JsonObject() + result["kind"] <- JsonValue.Create(case.Name) + let fieldInfos = case.GetFields() + for i = 0 to fields.Length - 1 do + result[fieldInfos[i].Name] <- toJsonNodeInternal fields[i] + result :> JsonNode + elif FSharpType.IsRecord(t, true) then + let result = JsonObject() + let fieldInfos = FSharpType.GetRecordFields(t, true) + let fieldValues = FSharpValue.GetRecordFields(value, true) + for i = 0 to fieldInfos.Length - 1 do + result[fieldInfos[i].Name] <- toJsonNodeInternal fieldValues[i] + result :> JsonNode + elif t.IsArray then + let result = JsonArray() + for item in value :?> IEnumerable do + result.Add(toJsonNodeInternal item) + result :> JsonNode + elif value :? IDictionary then + let result = JsonArray() + for item in value :?> IEnumerable do + let entry = item.GetType() + let keyProp = entry.GetProperty("Key") + let valueProp = entry.GetProperty("Value") + let pair = JsonObject() + let keyValue = + if isNull keyProp then null + else keyProp.GetValue(item) + let itemValue = + if isNull valueProp then null + else valueProp.GetValue(item) + pair["key"] <- toJsonNodeInternal keyValue + pair["value"] <- toJsonNodeInternal itemValue + result.Add(pair) + result :> JsonNode + elif value :? IEnumerable then + let result = JsonArray() + for item in value :?> IEnumerable do + result.Add(toJsonNodeInternal item) + result :> JsonNode + elif t.IsEnum then + JsonValue.Create(value.ToString()) + else + JsonValue.Create(value.ToString()) + + let toJsonNode (value: objnull) = + toJsonNodeInternal value + + let programToJson (sourcePath: string) (program: Program) = + let root = JsonObject() + root["version"] <- JsonValue.Create("1") + root["source"] <- JsonValue.Create(sourcePath) + root["kind"] <- JsonValue.Create("program") + root["items"] <- toJsonNode (box program) + root + + let typedProgramToJson (sourcePath: string) (typedProgram: TypeInfer.TypedProgram) = + let root = JsonObject() + root["version"] <- JsonValue.Create("1") + root["source"] <- JsonValue.Create(sourcePath) + root["kind"] <- JsonValue.Create("typedProgram") + root["items"] <- toJsonNode (box typedProgram) + root diff --git a/src/FScript.CSharpInterop/LanguageServer/LspHandlers.fs b/src/FScript.CSharpInterop/LanguageServer/LspHandlers.fs new file mode 100644 index 0000000..9b7d391 --- /dev/null +++ b/src/FScript.CSharpInterop/LanguageServer/LspHandlers.fs @@ -0,0 +1,1329 @@ +namespace FScript.LanguageServer + +open System +open System.IO +open System.Text.Json.Nodes +open FScript.Language +open FScript.CSharpInterop + +module LspHandlers = + open LspModel + open LspSymbols + + let handleInitialize (idNode: JsonNode) (paramsObj: JsonObject option) = + match paramsObj with + | Some p -> + match tryGetObject p "initializationOptions" with + | Some init -> + match init["inlayHintsEnabled"] with + | :? JsonValue as v -> + try inlayHintsEnabled <- v.GetValue() with _ -> () + | _ -> () + | None -> () + | None -> () + + let sync = JsonObject() + sync["openClose"] <- JsonValue.Create(true) + sync["change"] <- JsonValue.Create(1) + + let completionProvider = JsonObject() + completionProvider["resolveProvider"] <- JsonValue.Create(false) + let triggerChars = JsonArray() + triggerChars.Add(JsonValue.Create(".")) + triggerChars.Add(JsonValue.Create("[")) + completionProvider["triggerCharacters"] <- triggerChars + + let serverInfo = JsonObject() + serverInfo["name"] <- JsonValue.Create("FScript Language Server") + + let capabilities = JsonObject() + capabilities["textDocumentSync"] <- sync + capabilities["completionProvider"] <- completionProvider + capabilities["hoverProvider"] <- JsonValue.Create(true) + capabilities["definitionProvider"] <- JsonValue.Create(true) + capabilities["typeDefinitionProvider"] <- JsonValue.Create(true) + capabilities["referencesProvider"] <- JsonValue.Create(true) + capabilities["documentHighlightProvider"] <- JsonValue.Create(true) + let renameProvider = JsonObject() + renameProvider["prepareProvider"] <- JsonValue.Create(true) + capabilities["renameProvider"] <- renameProvider + let signatureHelpProvider = JsonObject() + let signatureTriggers = JsonArray() + signatureTriggers.Add(JsonValue.Create("(")) + signatureTriggers.Add(JsonValue.Create(",")) + signatureHelpProvider["triggerCharacters"] <- signatureTriggers + capabilities["signatureHelpProvider"] <- signatureHelpProvider + capabilities["documentSymbolProvider"] <- JsonValue.Create(true) + capabilities["workspaceSymbolProvider"] <- JsonValue.Create(true) + capabilities["codeActionProvider"] <- JsonValue.Create(true) + capabilities["inlayHintProvider"] <- JsonValue.Create(true) + let semanticLegend = JsonObject() + let tokenTypeNodes = JsonArray() + [| "keyword"; "string"; "number"; "function"; "type"; "variable" |] + |> Array.iter (fun s -> tokenTypeNodes.Add(JsonValue.Create(s))) + semanticLegend["tokenTypes"] <- tokenTypeNodes + semanticLegend["tokenModifiers"] <- JsonArray() + let semanticProvider = JsonObject() + semanticProvider["legend"] <- semanticLegend + semanticProvider["full"] <- JsonValue.Create(true) + capabilities["semanticTokensProvider"] <- semanticProvider + + let result = JsonObject() + result["capabilities"] <- capabilities + result["serverInfo"] <- serverInfo + + LspProtocol.sendResponse idNode (Some result) + + let private keywordSet = + [ "let"; "rec"; "and"; "if"; "then"; "elif"; "else"; "match"; "with"; "when" + "for"; "in"; "do"; "type"; "module"; "true"; "false"; "None"; "Some" + "fun"; "raise"; "import"; "export"; "qualified" ] + |> Set.ofList + + let private classifyToken (line: string) (startIndex: int) (token: string) = + let isFunctionCallToken () = + let mutable i = startIndex + token.Length + while i < line.Length && Char.IsWhiteSpace(line[i]) do + i <- i + 1 + i < line.Length && line[i] = '(' + + if keywordSet.Contains(token) then 0 + elif token.Length > 1 && token.StartsWith("\"") && token.EndsWith("\"") then 1 + elif token |> Seq.forall Char.IsDigit then 2 + elif isFunctionCallToken () then 3 + elif token.Contains('.') then + let tail = token.Split('.') |> Array.last + if tail.Length > 0 && Char.IsLower(tail[0]) then 3 else 4 + elif token.Length > 0 && Char.IsUpper(token[0]) then 4 + else 5 + + let private scanSemanticTokens (text: string) = + let lines = text.Split('\n') + let mutable previousLine = 0 + let mutable previousStart = 0 + let data = ResizeArray() + + for lineIndex = 0 to lines.Length - 1 do + let line = lines[lineIndex].TrimEnd('\r') + let mutable i = 0 + while i < line.Length do + let c = line[i] + if Char.IsWhiteSpace(c) then + i <- i + 1 + elif c = '/' && i + 1 < line.Length && line[i + 1] = '/' then + i <- line.Length + elif c = '"' then + let start = i + i <- i + 1 + while i < line.Length && line[i] <> '"' do + i <- i + 1 + if i < line.Length then i <- i + 1 + let length = i - start + let deltaLine = lineIndex - previousLine + let deltaStart = if deltaLine = 0 then start - previousStart else start + data.Add(deltaLine) + data.Add(deltaStart) + data.Add(length) + data.Add(1) + data.Add(0) + previousLine <- lineIndex + previousStart <- start + elif Char.IsLetter(c) || c = '_' then + let start = i + i <- i + 1 + while i < line.Length && (Char.IsLetterOrDigit(line[i]) || line[i] = '_' || line[i] = '.') do + i <- i + 1 + let token = line.Substring(start, i - start) + let tokenType = classifyToken line start token + let deltaLine = lineIndex - previousLine + let deltaStart = if deltaLine = 0 then start - previousStart else start + data.Add(deltaLine) + data.Add(deltaStart) + data.Add(token.Length) + data.Add(tokenType) + data.Add(0) + previousLine <- lineIndex + previousStart <- start + elif Char.IsDigit(c) then + let start = i + i <- i + 1 + while i < line.Length && (Char.IsDigit(line[i]) || line[i] = '.') do + i <- i + 1 + let length = i - start + let deltaLine = lineIndex - previousLine + let deltaStart = if deltaLine = 0 then start - previousStart else start + data.Add(deltaLine) + data.Add(deltaStart) + data.Add(length) + data.Add(2) + data.Add(0) + previousLine <- lineIndex + previousStart <- start + else + i <- i + 1 + + data + + let handleSemanticTokens (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | Some uri when documents.ContainsKey(uri) -> + let doc = documents[uri] + let data: JsonNode array = + scanSemanticTokens doc.Text + |> Seq.map (fun n -> JsonValue.Create(n) :> JsonNode) + |> Seq.toArray + let result = JsonObject() + result["data"] <- JsonArray(data) + LspProtocol.sendResponse idNode (Some result) + | _ -> + let result = JsonObject() + result["data"] <- JsonArray() + LspProtocol.sendResponse idNode (Some result) + + let private positionInRange (line: int) (character: int) (sl: int, sc: int, el: int, ec: int) = + let afterStart = line > sl || (line = sl && character >= sc) + let beforeEnd = line < el || (line = el && character <= ec) + afterStart && beforeEnd + + let private trimOuterParens (text: string) = + let rec trim (value: string) = + let trimmed = value.Trim() + if trimmed.Length >= 2 && trimmed[0] = '(' && trimmed[trimmed.Length - 1] = ')' then + let mutable depth = 0 + let mutable enclosesAll = true + let mutable i = 0 + while i < trimmed.Length && enclosesAll do + let c = trimmed[i] + if c = '(' then depth <- depth + 1 + elif c = ')' then + depth <- depth - 1 + if depth = 0 && i < trimmed.Length - 1 then + enclosesAll <- false + i <- i + 1 + if enclosesAll then trim (trimmed.Substring(1, trimmed.Length - 2)) + else trimmed + else + trimmed + trim text + + let private splitTopLevelArrows (typeText: string) = + let typeText = trimOuterParens typeText + let parts = ResizeArray() + let mutable depthParen = 0 + let mutable depthBrace = 0 + let mutable depthBracket = 0 + let mutable start = 0 + let mutable i = 0 + while i < typeText.Length do + let c = typeText[i] + match c with + | '(' -> depthParen <- depthParen + 1 + | ')' when depthParen > 0 -> depthParen <- depthParen - 1 + | '{' -> depthBrace <- depthBrace + 1 + | '}' when depthBrace > 0 -> depthBrace <- depthBrace - 1 + | '[' -> depthBracket <- depthBracket + 1 + | ']' when depthBracket > 0 -> depthBracket <- depthBracket - 1 + | '-' when i + 1 < typeText.Length && typeText[i + 1] = '>' && depthParen = 0 && depthBrace = 0 && depthBracket = 0 -> + let chunk = typeText.Substring(start, i - start).Trim() + if chunk <> "" then + parts.Add(chunk) + i <- i + 1 + start <- i + 1 + | _ -> () + i <- i + 1 + + if start <= typeText.Length then + let tail = typeText.Substring(start).Trim() + if tail <> "" then + parts.Add(tail) + + parts |> Seq.toList + + let private flattenArrowParts (typeText: string) = + let rec flatten (text: string) = + let parts = splitTopLevelArrows text + match parts with + | [] -> [] + | [ single ] -> + let trimmed = trimOuterParens single + if String.Equals(trimmed, single, StringComparison.Ordinal) then + [ trimmed ] + else + flatten trimmed + | first :: rest when rest.Length = 1 -> + first :: flatten rest[0] + | _ -> + parts + flatten typeText + + let private formatNamedArrowSignature (names: string list) (typeText: string) = + let parts = flattenArrowParts typeText + if parts.Length = (names.Length + 1) then + let args = + [ 0 .. names.Length - 1 ] + |> List.map (fun i -> $"({names[i]}: {parts[i]})") + String.concat " -> " (args @ [ parts[parts.Length - 1] ]) + else + typeText + + let private formatFunctionSignature (doc: DocumentState) (sym: TopLevelSymbol) = + let paramNames = doc.FunctionParameters |> Map.tryFind sym.Name |> Option.defaultValue [] + + match sym.TypeText with + | Some typeText when sym.Kind = 12 && not paramNames.IsEmpty -> + let parts = flattenArrowParts typeText + if parts.Length = (paramNames.Length + 1) then + let effectiveParts = + match sym.TypeTargetName with + | Some returnName when parts.Length > 0 -> + (parts |> List.take (parts.Length - 1)) @ [ returnName ] + | _ -> parts + let arrowText = + if effectiveParts.Length = (paramNames.Length + 1) then + let args = + [ 0 .. paramNames.Length - 1 ] + |> List.map (fun i -> $"({paramNames[i]}: {effectiveParts[i]})") + String.concat " -> " (args @ [ effectiveParts[effectiveParts.Length - 1] ]) + else + String.concat " -> " effectiveParts + $"{sym.Name}: {arrowText}" + else + $"{sym.Name} : {typeText}" + | Some typeText -> + $"{sym.Name} : {typeText}" + | None when sym.Kind = 12 && not paramNames.IsEmpty -> + match doc.FunctionAnnotationTypes |> Map.tryFind sym.Name with + | Some annotated when annotated.Length = paramNames.Length -> + let returnType = + doc.FunctionDeclaredReturnTargets + |> Map.tryFind sym.Name + |> Option.defaultValue "unknown" + let parts = annotated @ [ returnType ] + let arrowText = + if parts.Length = (paramNames.Length + 1) then + let args = + [ 0 .. paramNames.Length - 1 ] + |> List.map (fun i -> $"({paramNames[i]}: {parts[i]})") + String.concat " -> " (args @ [ parts[parts.Length - 1] ]) + else + String.concat " -> " parts + $"{sym.Name}: {arrowText}" + | _ -> + let args = paramNames |> List.map (fun name -> $"({name})") |> String.concat " " + $"{sym.Name} {args}" + | None -> + sym.Name + + let private formatInjectedFunctionSignature (doc: DocumentState) (name: string) (typeText: string) = + match doc.InjectedFunctionParameterNames |> Map.tryFind name with + | Some parameterNames when not parameterNames.IsEmpty -> + let namedSignature = formatNamedArrowSignature parameterNames typeText + $"{name}: {namedSignature}" + | _ -> + $"{name} : {typeText}" + + let handleInlayHints (idNode: JsonNode) (paramsObj: JsonObject) = + if not inlayHintsEnabled then + LspProtocol.sendResponse idNode (Some (JsonArray())) + else + match tryGetUriFromTextDocument paramsObj with + | Some uri when documents.ContainsKey(uri) -> + let doc = documents[uri] + let (startLine, startChar, endLine, endChar) = + tryGetRange paramsObj |> Option.defaultValue (0, 0, Int32.MaxValue, Int32.MaxValue) + + let hints = ResizeArray() + + // Type hints for value bindings based on inferred top-level symbol types. + doc.Symbols + |> List.iter (fun sym -> + if sym.Kind = 13 && not (sym.Name.Contains('.')) then + match sym.TypeText with + | Some typeText -> + let hintLine = max 0 (sym.Span.End.Line - 1) + let hintChar = max 0 (sym.Span.End.Column - 1) + if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then + let hint = JsonObject() + let pos = JsonObject() + pos["line"] <- JsonValue.Create(hintLine) + pos["character"] <- JsonValue.Create(hintChar) + hint["position"] <- pos + hint["label"] <- JsonValue.Create($": {typeText}") + hint["kind"] <- JsonValue.Create(1) + hint["paddingLeft"] <- JsonValue.Create(true) + hints.Add(hint :> JsonNode) + | None -> ()) + + // Type hints for function/lambda parameters inferred by the typechecker. + doc.ParameterTypeHints + |> List.iter (fun (span, label) -> + let hintLine = max 0 (span.End.Line - 1) + let hintChar = max 0 (span.End.Column - 1) + if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then + let hint = JsonObject() + let pos = JsonObject() + pos["line"] <- JsonValue.Create(hintLine) + pos["character"] <- JsonValue.Create(hintChar) + hint["position"] <- pos + hint["label"] <- JsonValue.Create(label) + hint["kind"] <- JsonValue.Create(1) + hint["paddingLeft"] <- JsonValue.Create(true) + hints.Add(hint :> JsonNode)) + + // Return type hints for function declarations. + doc.FunctionReturnTypeHints + |> List.iter (fun (span, label) -> + let hintLine = max 0 (span.End.Line - 1) + let hintChar = max 0 (span.End.Column - 1) + if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then + let hint = JsonObject() + let pos = JsonObject() + pos["line"] <- JsonValue.Create(hintLine) + pos["character"] <- JsonValue.Create(hintChar) + hint["position"] <- pos + hint["label"] <- JsonValue.Create(label) + hint["kind"] <- JsonValue.Create(1) + hint["paddingLeft"] <- JsonValue.Create(true) + hints.Add(hint :> JsonNode)) + + // Type hints for pattern-bound variables (for example: `Some x`). + doc.PatternTypeHints + |> List.iter (fun (span, label) -> + let hintLine = max 0 (span.End.Line - 1) + let hintChar = max 0 (span.End.Column - 1) + if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then + let hint = JsonObject() + let pos = JsonObject() + pos["line"] <- JsonValue.Create(hintLine) + pos["character"] <- JsonValue.Create(hintChar) + hint["position"] <- pos + hint["label"] <- JsonValue.Create(label) + hint["kind"] <- JsonValue.Create(1) + hint["paddingLeft"] <- JsonValue.Create(true) + hints.Add(hint :> JsonNode)) + + doc.CallArgumentHints + |> List.iter (fun (span, label) -> + let hintLine = max 0 (span.Start.Line - 1) + let hintChar = max 0 (span.Start.Column - 1) + if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then + let hint = JsonObject() + let pos = JsonObject() + pos["line"] <- JsonValue.Create(hintLine) + pos["character"] <- JsonValue.Create(hintChar) + hint["position"] <- pos + hint["label"] <- JsonValue.Create(label) + hint["kind"] <- JsonValue.Create(2) + hint["paddingRight"] <- JsonValue.Create(true) + hints.Add(hint :> JsonNode)) + + LspProtocol.sendResponse idNode (Some (JsonArray(hints.ToArray()))) + | _ -> + LspProtocol.sendResponse idNode (Some (JsonArray())) + + let handleDidOpen (paramsObj: JsonObject) = + match tryGetObject paramsObj "textDocument" with + | Some textDocument -> + match tryGetString textDocument "uri", tryGetString textDocument "text" with + | Some uri, Some text -> analyzeDocument uri text + | _ -> () + | None -> () + + let handleDidChange (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | None -> () + | Some uri -> + match paramsObj["contentChanges"] with + | :? JsonArray as changes -> + let mutable latest: string option = None + for change in changes do + match change with + | :? JsonObject as changeObj -> + match tryGetString changeObj "text" with + | Some text -> latest <- Some text + | None -> () + | _ -> () + + match latest with + | Some text -> analyzeDocument uri text + | None -> () + | _ -> () + + let handleDidClose (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | Some uri -> + documents.Remove(uri) |> ignore + publishDiagnostics uri [] + | None -> () + + let private tryGetCommandUri (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | Some uri -> Some uri + | None -> tryGetString paramsObj "uri" + + let private sendCommandError (idNode: JsonNode) (kind: string) (message: string) = + let errorObj = JsonObject() + errorObj["message"] <- JsonValue.Create(message) + errorObj["kind"] <- JsonValue.Create(kind) + let response = JsonObject() + response["ok"] <- JsonValue.Create(false) + response["error"] <- errorObj + LspProtocol.sendResponse idNode (Some response) + + let private tryLoadSourceForUri (uri: string) = + if documents.ContainsKey(uri) then + Some documents[uri].Text + else + try + let filePath = Uri(uri).LocalPath + if File.Exists(filePath) then + Some (File.ReadAllText(filePath)) + else + None + with _ -> + None + + let handleViewAst (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetCommandUri paramsObj with + | None -> + sendCommandError idNode "internal" "Missing document URI." + | Some uri -> + try + let uriObj = Uri(uri) + if not (String.Equals(uriObj.Scheme, "file", StringComparison.OrdinalIgnoreCase)) then + sendCommandError idNode "internal" "AST commands support file-based scripts only." + else + let sourcePath = uriObj.LocalPath + match tryLoadSourceForUri uri with + | None -> + sendCommandError idNode "internal" $"Unable to read source file '{sourcePath}'." + | Some sourceText -> + let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath sourceText + let response = JsonObject() + response["ok"] <- JsonValue.Create(true) + response["data"] <- AstJson.programToJson sourcePath program + LspProtocol.sendResponse idNode (Some response) + with + | :? ParseException as ex -> + sendCommandError idNode "parse" ex.Message + | ex -> + sendCommandError idNode "internal" ex.Message + + let handleViewInferredAst (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetCommandUri paramsObj with + | None -> + sendCommandError idNode "internal" "Missing document URI." + | Some uri -> + try + let uriObj = Uri(uri) + if not (String.Equals(uriObj.Scheme, "file", StringComparison.OrdinalIgnoreCase)) then + sendCommandError idNode "internal" "AST commands support file-based scripts only." + else + let sourcePath = uriObj.LocalPath + match tryLoadSourceForUri uri with + | None -> + sendCommandError idNode "internal" $"Unable to read source file '{sourcePath}'." + | Some sourceText -> + let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath sourceText + let runtimeExterns = LspRuntimeExterns.forSourcePath sourcePath + let typedProgram = InteropServices.inferProgramWithExterns runtimeExterns program + let response = JsonObject() + response["ok"] <- JsonValue.Create(true) + response["data"] <- AstJson.typedProgramToJson sourcePath typedProgram + LspProtocol.sendResponse idNode (Some response) + with + | :? ParseException as ex -> + sendCommandError idNode "parse" ex.Message + | :? TypeException as ex -> + sendCommandError idNode "type" ex.Message + | ex -> + sendCommandError idNode "internal" ex.Message + + let handleHover (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + match tryGetRecordFieldHoverInfo doc line character with + | Some (fieldName, fieldType) -> + let contents = JsonObject() + contents["kind"] <- JsonValue.Create("markdown") + contents["value"] <- JsonValue.Create($"```fscript\n{fieldName} : {fieldType}\n```\nrecord-field") + let result = JsonObject() + result["contents"] <- contents + LspProtocol.sendResponse idNode (Some result) + | None -> + match tryGetLocalVariableHoverInfo doc line character with + | Some (name, typeText) -> + let contents = JsonObject() + contents["kind"] <- JsonValue.Create("markdown") + contents["value"] <- JsonValue.Create($"```fscript\n{name} : {typeText}\n```\nlocal-variable") + let result = JsonObject() + result["contents"] <- contents + LspProtocol.sendResponse idNode (Some result) + | None -> + match tryResolveSymbol doc line character with + | Some sym -> + let signature = formatFunctionSignature doc sym + + let contents = JsonObject() + contents["kind"] <- JsonValue.Create("markdown") + let kindLine = symbolKindLabel sym.Kind + let locationLine = $"defined at L{sym.Span.Start.Line}:C{sym.Span.Start.Column}" + contents["value"] <- JsonValue.Create($"```fscript\n{signature}\n```\n{kindLine}\n\n{locationLine}") + + let result = JsonObject() + result["contents"] <- contents + LspProtocol.sendResponse idNode (Some result) + | None -> + match tryGetWordAtPosition doc.Text line character with + | Some word -> + let candidates = + if word.Contains('.') then + [ word + word.Split('.') |> Array.last ] + else + [ word ] + let injectedMatch = + candidates + |> List.tryPick (fun candidate -> + doc.InjectedFunctionSignatures + |> Map.tryFind candidate + |> Option.map (fun t -> candidate, t)) + match injectedMatch with + | Some (name, typeText) -> + let contents = JsonObject() + contents["kind"] <- JsonValue.Create("markdown") + let signature = formatInjectedFunctionSignature doc name typeText + contents["value"] <- JsonValue.Create($"```fscript\n{signature}\n```\ninjected-function") + let result = JsonObject() + result["contents"] <- contents + LspProtocol.sendResponse idNode (Some result) + | None -> + LspProtocol.sendResponse idNode None + | None -> + LspProtocol.sendResponse idNode None + | _ -> LspProtocol.sendResponse idNode None + + + let private tryResolveIncludeLocation (sourceUri: string) (doc: DocumentState) (line: int) (character: int) : JsonObject option = + match getLineText doc.Text line with + | None -> None + | Some lineText -> + let trimmed = lineText.TrimStart() + if not (trimmed.StartsWith("import", StringComparison.Ordinal)) then + None + else + let firstQuote = lineText.IndexOf('"') + if firstQuote < 0 then None + else + let secondQuote = lineText.IndexOf('"', firstQuote + 1) + if secondQuote <= firstQuote then None + else + let insideLiteral = character >= (firstQuote + 1) && character <= secondQuote + if not insideLiteral then + None + else + let includePath = lineText.Substring(firstQuote + 1, secondQuote - firstQuote - 1) + if String.IsNullOrWhiteSpace(includePath) then + None + else + try + let fullPath = + if Path.IsPathRooted(includePath) then + Path.GetFullPath(includePath) + else + if sourceUri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then + let sourcePath = Uri(sourceUri).LocalPath + match Path.GetDirectoryName(sourcePath) with + | null -> Path.GetFullPath(includePath) + | baseDir when String.IsNullOrWhiteSpace(baseDir) -> Path.GetFullPath(includePath) + | baseDir -> Path.GetFullPath(Path.Combine(baseDir, includePath)) + else + includePath + + if File.Exists(fullPath) then + let loc = JsonObject() + loc["uri"] <- JsonValue.Create(Uri(fullPath).AbsoluteUri) + let startPos = Span.pos 1 1 + loc["range"] <- toLspRange (Span.mk startPos startPos) + Some loc + else + None + with _ -> + None + + let private tryUriFromSpanFile (fallbackUri: string) (span: Span) = + match span.Start.File with + | Some filePath when not (String.IsNullOrWhiteSpace(filePath)) -> + try Some (Uri(filePath).AbsoluteUri) with _ -> Some fallbackUri + | _ -> + Some fallbackUri + + let handleDefinition (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + match tryResolveIncludeLocation uri doc line character with + | Some includeLoc -> + LspProtocol.sendResponse idNode (Some includeLoc) + | None -> + let localSymbol = tryResolveSymbol doc line character + let wordAtCursor = tryGetWordAtPosition doc.Text line character + + let symbolAndUri = + match localSymbol with + | Some sym -> + match tryUriFromSpanFile uri sym.Span with + | Some targetUri -> Some (targetUri, sym) + | None -> Some (uri, sym) + | None -> + match wordAtCursor with + | Some word -> + documents + |> Seq.tryPick (fun kv -> + kv.Value.Symbols + |> List.tryFind (fun s -> s.Name = word) + |> Option.map (fun s -> kv.Key, s)) + | None -> None + + match symbolAndUri with + | Some (targetUri, sym) -> + let loc = JsonObject() + loc["uri"] <- JsonValue.Create(targetUri) + loc["range"] <- toLspRange sym.Span + LspProtocol.sendResponse idNode (Some loc) + | None -> + let injectedDefinition = + match wordAtCursor with + | Some word -> + let candidates = + if word.Contains('.') then + [ word; word.Split('.') |> Array.last ] + else + [ word ] + + candidates + |> List.tryPick (fun candidate -> + doc.InjectedFunctionDefinitions + |> Map.tryFind candidate + |> Option.map (fun target -> candidate, target)) + | None -> + None + + match injectedDefinition with + | Some (_, (targetUri, targetSpan)) -> + let loc = JsonObject() + loc["uri"] <- JsonValue.Create(targetUri) + loc["range"] <- toLspRange targetSpan + LspProtocol.sendResponse idNode (Some loc) + | None -> + match tryResolveTypeTargetAtPosition doc line character with + | Some typeName -> + match doc.Symbols |> List.tryFind (fun s -> s.Kind = 5 && s.Name = typeName) with + | Some typeSym -> + let loc = JsonObject() + let targetUri = + tryUriFromSpanFile uri typeSym.Span + |> Option.defaultValue uri + loc["uri"] <- JsonValue.Create(targetUri) + loc["range"] <- toLspRange typeSym.Span + LspProtocol.sendResponse idNode (Some loc) + | None -> + LspProtocol.sendResponse idNode None + | None -> + LspProtocol.sendResponse idNode None + | _ -> LspProtocol.sendResponse idNode None + + let handleTypeDefinition (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + let targetTypeName = + match tryResolveSymbol doc line character with + | Some sym -> + match sym.TypeTargetName with + | Some name -> Some name + | None -> + sym.TypeText + |> Option.bind (fun t -> + doc.Symbols + |> List.tryFind (fun s -> s.Kind = 5 && s.Name = t) + |> Option.map (fun s -> s.Name)) + | None -> + tryResolveTypeTargetAtPosition doc line character + + match targetTypeName with + | Some typeName -> + match doc.Symbols |> List.tryFind (fun s -> s.Kind = 5 && s.Name = typeName) with + | Some typeSym -> + let loc = JsonObject() + let targetUri = + tryUriFromSpanFile uri typeSym.Span + |> Option.defaultValue uri + loc["uri"] <- JsonValue.Create(targetUri) + loc["range"] <- toLspRange typeSym.Span + LspProtocol.sendResponse idNode (Some loc) + | None -> + LspProtocol.sendResponse idNode None + | None -> + LspProtocol.sendResponse idNode None + | _ -> + LspProtocol.sendResponse idNode None + + let handleCompletion (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | Some uri when documents.ContainsKey(uri) -> + let doc = documents[uri] + let prefix = + match tryGetPosition paramsObj with + | Some (line, character) -> tryGetWordPrefixAtPosition doc.Text line character + | None -> None + + let items = makeCompletionItems doc prefix + let result = JsonObject() + result["isIncomplete"] <- JsonValue.Create(false) + result["items"] <- items + LspProtocol.sendResponse idNode (Some result) + | _ -> + let result = JsonObject() + result["isIncomplete"] <- JsonValue.Create(false) + result["items"] <- JsonArray() + LspProtocol.sendResponse idNode (Some result) + + let handleDocumentSymbol (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | Some uri when documents.ContainsKey(uri) -> + let symbols = + documents[uri].Symbols + |> List.map (fun s -> + let d = JsonObject() + d["name"] <- JsonValue.Create(s.Name) + d["kind"] <- JsonValue.Create(s.Kind) + d["range"] <- toLspRange s.Span + d["selectionRange"] <- toLspRange s.Span + d) + + let nodes = symbols |> List.map (fun s -> s :> JsonNode) |> List.toArray + LspProtocol.sendResponse idNode (Some (JsonArray(nodes))) + | _ -> LspProtocol.sendResponse idNode (Some (JsonArray())) + + let private resolveTargetNames (doc: DocumentState) line character = + match tryResolveSymbol doc line character with + | Some sym -> + let normalized = + if sym.Name.Contains('.') then sym.Name.Split('.') |> Array.last + else sym.Name + [ sym.Name; normalized ] + | None -> + match tryGetWordAtPosition doc.Text line character with + | Some word -> + let normalized = + if word.Contains('.') then word.Split('.') |> Array.last + else word + [ word; normalized ] + | None -> [] + + let handleReferences (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + let targetNames = resolveTargetNames doc line character + let includeDeclaration = + match tryGetObject paramsObj "context" with + | Some contextObj -> + match contextObj["includeDeclaration"] with + | :? JsonValue as v -> + try v.GetValue() with _ -> true + | _ -> true + | None -> true + + match targetNames with + | head :: _ -> + let normalized = + if head.Contains('.') then head.Split('.') |> Array.last + else head + + let declarationSpansByUri = + documents + |> Seq.map (fun kv -> + let docUri = kv.Key + let spans = + kv.Value.Symbols + |> List.choose (fun s -> + let symbolNormalized = + if s.Name.Contains('.') then s.Name.Split('.') |> Array.last + else s.Name + if s.Name = head || s.Name = normalized || symbolNormalized = normalized then + Some s.Span + else + None) + |> Set.ofList + docUri, spans) + |> Map.ofSeq + + let locations = + documents + |> Seq.collect (fun kv -> + let docUri = kv.Key + let candidateDoc = kv.Value + let fromOccurrences = + [ head; normalized ] + |> List.distinct + |> List.collect (fun n -> candidateDoc.VariableOccurrences |> Map.tryFind n |> Option.defaultValue []) + |> List.distinct + + let spans = + if fromOccurrences.IsEmpty then + findSymbolRangesInText candidateDoc.Text (targetNames @ [ normalized ]) + else + fromOccurrences + + let filteredSpans = + if includeDeclaration then + spans + else + let decls = declarationSpansByUri |> Map.tryFind docUri |> Option.defaultValue Set.empty + spans |> List.filter (fun span -> not (decls.Contains span)) + + filteredSpans + |> List.map (fun span -> + let loc = JsonObject() + loc["uri"] <- JsonValue.Create(docUri) + loc["range"] <- toLspRange span + loc :> JsonNode)) + |> Seq.toArray + + LspProtocol.sendResponse idNode (Some (JsonArray(locations))) + | [] -> + LspProtocol.sendResponse idNode (Some (JsonArray())) + | _ -> + LspProtocol.sendResponse idNode (Some (JsonArray())) + + let handleDocumentHighlight (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + let targetNames = resolveTargetNames doc line character + + match targetNames with + | head :: _ -> + let normalized = + if head.Contains('.') then head.Split('.') |> Array.last + else head + + let fromOccurrences = + [ head; normalized ] + |> List.distinct + |> List.collect (fun n -> doc.VariableOccurrences |> Map.tryFind n |> Option.defaultValue []) + |> List.distinct + + let spans = + if fromOccurrences.IsEmpty then + findSymbolRangesInText doc.Text (targetNames @ [ normalized ]) + else + fromOccurrences + + let highlights = + spans + |> List.map (fun span -> + let highlight = JsonObject() + highlight["range"] <- toLspRange span + highlight["kind"] <- JsonValue.Create(1) + highlight :> JsonNode) + |> List.toArray + + LspProtocol.sendResponse idNode (Some (JsonArray(highlights))) + | [] -> + LspProtocol.sendResponse idNode (Some (JsonArray())) + | _ -> + LspProtocol.sendResponse idNode (Some (JsonArray())) + + let handleSignatureHelp (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + let tryResolveCallTargetFromInvocation () = + match getLineText doc.Text line with + | None -> None + | Some lineText -> + let pos = max 0 (min character lineText.Length) + let mutable idx = pos - 1 + let mutable closeDepth = 0 + let mutable openIdx = -1 + + while idx >= 0 && openIdx < 0 do + match lineText[idx] with + | ')' -> closeDepth <- closeDepth + 1 + | '(' -> + if closeDepth = 0 then + openIdx <- idx + else + closeDepth <- closeDepth - 1 + | _ -> () + idx <- idx - 1 + + if openIdx <= 0 then None + else + let mutable finish = openIdx + while finish > 0 && Char.IsWhiteSpace(lineText[finish - 1]) do + finish <- finish - 1 + let mutable start = finish - 1 + while start >= 0 && isWordChar lineText[start] do + start <- start - 1 + let tokenStart = start + 1 + if tokenStart < finish then + Some (lineText.Substring(tokenStart, finish - tokenStart)) + else + None + + let computeActiveParameter () = + match getLineText doc.Text line with + | None -> 0 + | Some lineText -> + let pos = max 0 (min character lineText.Length) + let mutable idx = pos - 1 + let mutable closeDepth = 0 + let mutable openIdx = -1 + + while idx >= 0 && openIdx < 0 do + match lineText[idx] with + | ')' -> closeDepth <- closeDepth + 1 + | '(' -> + if closeDepth = 0 then + openIdx <- idx + else + closeDepth <- closeDepth - 1 + | _ -> () + idx <- idx - 1 + + if openIdx < 0 then 0 + else + let mutable depthParen = 0 + let mutable depthBracket = 0 + let mutable depthBrace = 0 + let mutable commas = 0 + let mutable i = openIdx + 1 + + while i < pos do + match lineText[i] with + | '(' -> depthParen <- depthParen + 1 + | ')' -> if depthParen > 0 then depthParen <- depthParen - 1 + | '[' -> depthBracket <- depthBracket + 1 + | ']' -> if depthBracket > 0 then depthBracket <- depthBracket - 1 + | '{' -> depthBrace <- depthBrace + 1 + | '}' -> if depthBrace > 0 then depthBrace <- depthBrace - 1 + | ',' when depthParen = 0 && depthBracket = 0 && depthBrace = 0 -> + commas <- commas + 1 + | _ -> () + i <- i + 1 + + commas + + let callTarget = + match tryGetContextTriggerCharacter paramsObj with + | Some "(" -> tryGetCallTargetPrefixAtPosition doc.Text line (character - 1) + | Some "," -> tryGetCallTargetPrefixAtPosition doc.Text line (character - 1) + | _ -> tryGetCallTargetPrefixAtPosition doc.Text line character + + let resolvedCallTarget = + match callTarget with + | Some c -> Some c + | None -> + match tryGetWordAtPosition doc.Text line (max 0 (character - 1)) with + | Some w -> Some w + | None -> tryResolveCallTargetFromInvocation () + + match resolvedCallTarget with + | Some target -> + let normalize (name: string) = + if name.Contains('.') then name.Split('.') |> Array.last + else name + + let targetNormalized = normalize target + let matched = + doc.Symbols + |> List.tryFind (fun s -> s.Name = target || normalize s.Name = targetNormalized) + + match matched with + | Some sym -> + let signatureLabel = + match sym.TypeText with + | Some t -> $"{sym.Name} : {t}" + | None -> sym.Name + + let sigInfo = JsonObject() + sigInfo["label"] <- JsonValue.Create(signatureLabel) + + let signatureHelp = JsonObject() + signatureHelp["signatures"] <- JsonArray([| sigInfo :> JsonNode |]) + signatureHelp["activeSignature"] <- JsonValue.Create(0) + signatureHelp["activeParameter"] <- JsonValue.Create(computeActiveParameter ()) + LspProtocol.sendResponse idNode (Some signatureHelp) + | None -> + let injectedSignature = + [ target; targetNormalized ] + |> List.tryPick (fun candidate -> + doc.InjectedFunctionSignatures |> Map.tryFind candidate) + + match injectedSignature with + | Some typeText -> + let signature = + let normalizedTarget = + if target.Contains('.') then target.Split('.') |> Array.last + else target + + if doc.InjectedFunctionSignatures.ContainsKey(target) then + formatInjectedFunctionSignature doc target typeText + elif doc.InjectedFunctionSignatures.ContainsKey(normalizedTarget) then + formatInjectedFunctionSignature doc normalizedTarget typeText + else + $"{target} : {typeText}" + + let sigInfo = JsonObject() + sigInfo["label"] <- JsonValue.Create(signature) + + let signatureHelp = JsonObject() + signatureHelp["signatures"] <- JsonArray([| sigInfo :> JsonNode |]) + signatureHelp["activeSignature"] <- JsonValue.Create(0) + signatureHelp["activeParameter"] <- JsonValue.Create(computeActiveParameter ()) + LspProtocol.sendResponse idNode (Some signatureHelp) + | None -> + LspProtocol.sendResponse idNode None + | None -> + LspProtocol.sendResponse idNode None + | _ -> + LspProtocol.sendResponse idNode None + + let handleStdlibSource (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetString paramsObj "uri" with + | None -> + sendCommandError idNode "internal" "Missing stdlib URI." + | Some uri -> + match InteropServices.tryLoadStdlibSourceText uri with + | Some sourceText -> + let response = JsonObject() + response["ok"] <- JsonValue.Create(true) + let data = JsonObject() + data["uri"] <- JsonValue.Create(uri) + data["text"] <- JsonValue.Create(sourceText) + data["languageId"] <- JsonValue.Create("fscript") + response["data"] <- data + LspProtocol.sendResponse idNode (Some response) + | None -> + sendCommandError idNode "internal" $"Unable to load stdlib source for '{uri}'." + + let handleRename (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj, tryGetString paramsObj "newName" with + | Some _, Some _, Some newName when not (isValidIdentifierName newName) -> + LspProtocol.sendError idNode -32602 $"Invalid rename target '{newName}'" + | Some uri, Some (line, character), Some newName when documents.ContainsKey(uri) -> + let doc = documents[uri] + + let targetNames = resolveTargetNames doc line character + + match targetNames with + | [] -> LspProtocol.sendResponse idNode None + | _ -> + let normalizedNames = + targetNames + |> List.collect (fun n -> + if n.Contains('.') then [ n; n.Split('.') |> Array.last ] else [ n ]) + |> List.distinct + + let changes = JsonObject() + + documents + |> Seq.iter (fun kv -> + let docUri = kv.Key + let candidateDoc = kv.Value + let fromOccurrences = + normalizedNames + |> List.collect (fun n -> candidateDoc.VariableOccurrences |> Map.tryFind n |> Option.defaultValue []) + |> List.distinct + + let spans = + if fromOccurrences.IsEmpty then + findSymbolRangesInText candidateDoc.Text targetNames + else + fromOccurrences + + if not spans.IsEmpty then + let edits = + spans + |> List.map (fun span -> + let edit = JsonObject() + edit["range"] <- toLspRange span + edit["newText"] <- JsonValue.Create(newName) + edit :> JsonNode) + |> List.toArray + changes[docUri] <- JsonArray(edits)) + + let workspaceEdit = JsonObject() + workspaceEdit["changes"] <- changes + LspProtocol.sendResponse idNode (Some workspaceEdit) + | _ -> + LspProtocol.sendResponse idNode None + + let handlePrepareRename (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with + | Some uri, Some (line, character) when documents.ContainsKey(uri) -> + let doc = documents[uri] + match tryGetWordAtPosition doc.Text line character with + | Some word when isValidIdentifierName word -> + let lineText = getLineText doc.Text line |> Option.defaultValue "" + let pos = max 0 (min character lineText.Length) + let mutable start = pos + while start > 0 && isWordChar lineText[start - 1] do + start <- start - 1 + let mutable finish = pos + while finish < lineText.Length && isWordChar lineText[finish] do + finish <- finish + 1 + + let span = + Span.mk + (Span.pos (line + 1) (start + 1)) + (Span.pos (line + 1) (finish + 1)) + + let result = JsonObject() + result["range"] <- toLspRange span + result["placeholder"] <- JsonValue.Create(word) + LspProtocol.sendResponse idNode (Some result) + | _ -> + LspProtocol.sendError idNode -32602 "Rename is not valid at this position" + | _ -> + LspProtocol.sendError idNode -32602 "Rename is not valid at this position" + + let handleWorkspaceSymbol (idNode: JsonNode) (paramsObj: JsonObject) = + let query = + tryGetString paramsObj "query" + |> Option.defaultValue "" + |> fun q -> q.Trim() + + let hasQuery = not (String.IsNullOrWhiteSpace(query)) + let queryLower = query.ToLowerInvariant() + + let symbols = + documents + |> Seq.collect (fun kv -> + let uri = kv.Key + kv.Value.Symbols + |> Seq.filter (fun s -> + if not hasQuery then true + else + s.Name.ToLowerInvariant().Contains(queryLower) + || (s.TypeText |> Option.exists (fun t -> t.ToLowerInvariant().Contains(queryLower)))) + |> Seq.map (fun s -> + let item = JsonObject() + item["name"] <- JsonValue.Create(s.Name) + item["kind"] <- JsonValue.Create(s.Kind) + let location = JsonObject() + location["uri"] <- JsonValue.Create(uri) + location["range"] <- toLspRange s.Span + item["location"] <- location + item :> JsonNode)) + |> Seq.toArray + + LspProtocol.sendResponse idNode (Some (JsonArray(symbols))) + + let private levenshteinDistance (a: string) (b: string) = + let m = a.Length + let n = b.Length + let d = Array2D.zeroCreate (m + 1) (n + 1) + + for i = 0 to m do d[i, 0] <- i + for j = 0 to n do d[0, j] <- j + + for i = 1 to m do + for j = 1 to n do + let cost = if a[i - 1] = b[j - 1] then 0 else 1 + d[i, j] <- List.min [ d[i - 1, j] + 1; d[i, j - 1] + 1; d[i - 1, j - 1] + cost ] + + d[m, n] + + let private tryExtractUnboundName (message: string) = + let prefix = "Unbound variable '" + if message.StartsWith(prefix, StringComparison.Ordinal) && message.EndsWith("'", StringComparison.Ordinal) then + let inner = message.Substring(prefix.Length, message.Length - prefix.Length - 1) + if String.IsNullOrWhiteSpace(inner) then None else Some inner + else + None + + let handleCodeAction (idNode: JsonNode) (paramsObj: JsonObject) = + match tryGetUriFromTextDocument paramsObj with + | Some uri when documents.ContainsKey(uri) -> + let doc = documents[uri] + let candidatePool = + [ for s in doc.Symbols -> s.Name + yield! stdlibNames + yield! builtinNames ] + |> List.distinct + + let actions = ResizeArray() + + match tryGetObject paramsObj "context" with + | Some contextObj -> + match contextObj["diagnostics"] with + | :? JsonArray as diagnostics -> + for diag in diagnostics do + match diag with + | :? JsonObject as diagObj -> + match diagObj["message"] with + | :? JsonValue as mv -> + let message = + try mv.GetValue() with _ -> "" + match tryExtractUnboundName message with + | Some missingName -> + let suggestion = + candidatePool + |> List.map (fun c -> c, levenshteinDistance missingName c) + |> List.sortBy snd + |> List.tryHead + |> Option.bind (fun (name, dist) -> + if dist <= 3 then Some name else None) + + match suggestion, diagObj["range"] with + | Some replacement, (:? JsonObject as rangeObjUntyped) -> + let rangeObj: JsonObject = rangeObjUntyped + let edit = JsonObject() + let copiedRange = + let mkPos (obj: JsonObject) = + let p = JsonObject() + p["line"] <- JsonValue.Create(tryGetInt obj "line" |> Option.defaultValue 0) + p["character"] <- JsonValue.Create(tryGetInt obj "character" |> Option.defaultValue 0) + p + + let r = JsonObject() + match rangeObj["start"], rangeObj["end"] with + | (:? JsonObject as s), (:? JsonObject as e) -> + r["start"] <- mkPos s + r["end"] <- mkPos e + | _ -> + r["start"] <- JsonObject() + r["end"] <- JsonObject() + r + + edit["range"] <- copiedRange + edit["newText"] <- JsonValue.Create(replacement) + + let changes = JsonObject() + changes[uri] <- JsonArray([| edit :> JsonNode |]) + + let workspaceEdit = JsonObject() + workspaceEdit["changes"] <- changes + + let action = JsonObject() + action["title"] <- JsonValue.Create($"Replace with '{replacement}'") + action["kind"] <- JsonValue.Create("quickfix") + action["edit"] <- workspaceEdit + action["isPreferred"] <- JsonValue.Create(true) + actions.Add(action) + | _ -> () + | None -> () + | _ -> () + | _ -> () + | _ -> () + | None -> () + + LspProtocol.sendResponse idNode (Some (JsonArray(actions.ToArray()))) + | _ -> + LspProtocol.sendResponse idNode (Some (JsonArray())) diff --git a/src/FScript.CSharpInterop/LanguageServer/LspModel.fs b/src/FScript.CSharpInterop/LanguageServer/LspModel.fs new file mode 100644 index 0000000..66240e6 --- /dev/null +++ b/src/FScript.CSharpInterop/LanguageServer/LspModel.fs @@ -0,0 +1,215 @@ +namespace FScript.LanguageServer + +open System +open System.Text.Json.Nodes +open System.Collections.Generic +open FScript.Language + +module LspModel = + let mutable inlayHintsEnabled = true + + let stdlibNames = Stdlib.reservedNames() |> Set.toList + let builtinNames = [ "ignore"; "nameof"; "typeof" ] + + let reservedKeywords = + [ "let"; "rec"; "and"; "if"; "then"; "elif"; "else"; "match"; "with"; "when" + "for"; "in"; "do"; "type"; "module"; "true"; "false"; "None"; "Some" ] + |> Set.ofList + + let asObject (node: JsonNode) : JsonObject option = + match node with + | :? JsonObject as o -> Some o + | _ -> None + + let tryGetObject (obj: JsonObject) (name: string) : JsonObject option = + match obj[name] with + | null -> None + | node -> asObject node + + let tryGetNode (obj: JsonObject) (name: string) : JsonNode option = + match obj[name] with + | null -> None + | node -> Some node + + let tryGetString (obj: JsonObject) (name: string) : string option = + match obj[name] with + | :? JsonValue as v -> + try Some (v.GetValue()) with _ -> None + | _ -> None + + let tryGetInt (obj: JsonObject) (name: string) : int option = + match obj[name] with + | :? JsonValue as v -> + try Some (v.GetValue()) with _ -> None + | _ -> None + + type TopLevelSymbol = + { Name: string + Kind: int + TypeText: string option + TypeTargetName: string option + Span: Span } + + type LocalBindingInfo = + { Name: string + DeclSpan: Span + ScopeSpan: Span + AnnotationType: string option } + + type DocumentState = + { Text: string + Symbols: TopLevelSymbol list + RecordParameterFields: Map + ParameterTypeTargets: Map + FunctionParameters: Map + FunctionAnnotationTypes: Map + FunctionDeclaredReturnTargets: Map + CallArgumentHints: (Span * string) list + FunctionReturnTypeHints: (Span * string) list + ParameterTypeHints: (Span * string) list + PatternTypeHints: (Span * string) list + LocalVariableTypeHints: (Span * string * string) list + LocalBindings: LocalBindingInfo list + InjectedFunctionSignatures: Map + InjectedFunctionParameterNames: Map + InjectedFunctionDefinitions: Map + // Variable occurrences keyed by identifier, sourced from AST spans. + // This avoids text-based false positives (for example record field labels). + VariableOccurrences: Map } + + let documents = Dictionary(StringComparer.Ordinal) + + let toLspRange (span: Span) = + let startLine = max 0 (span.Start.Line - 1) + let startChar = max 0 (span.Start.Column - 1) + let endLine = max 0 (span.End.Line - 1) + let endChar = max 0 (span.End.Column - 1) + + let startObj = JsonObject() + startObj["line"] <- JsonValue.Create(startLine) + startObj["character"] <- JsonValue.Create(startChar) + + let endObj = JsonObject() + endObj["line"] <- JsonValue.Create(endLine) + endObj["character"] <- JsonValue.Create(endChar) + + let rangeObj = JsonObject() + rangeObj["start"] <- startObj + rangeObj["end"] <- endObj + rangeObj + + let symbolKindLabel (kind: int) = + match kind with + | 5 -> "type" + | 12 -> "function" + | 13 -> "value" + | 22 -> "union-case" + | _ -> "symbol" + + let diagnostic (severity: int) (code: string) (span: Span) (message: string) = + let d = JsonObject() + d["range"] <- toLspRange span + d["severity"] <- JsonValue.Create(severity) + d["code"] <- JsonValue.Create(code) + d["source"] <- JsonValue.Create("fscript-lsp") + d["message"] <- JsonValue.Create(message) + d + + let publishDiagnostics (uri: string) (diags: JsonNode list) = + let p = JsonObject() + p["uri"] <- JsonValue.Create(uri) + p["diagnostics"] <- JsonArray(diags |> Seq.toArray) + LspProtocol.sendNotification "textDocument/publishDiagnostics" (Some p) + + let symbolKindForType (t: Type) = + match t with + | TFun _ -> 12 + | _ -> 13 + + let declarationKindFromArgs (args: Param list) = + if args.IsEmpty then 13 else 12 + + let getLineText (text: string) (line: int) : string option = + if line < 0 then None + else + let lines = text.Split('\n') + if line >= lines.Length then None + else Some (lines[line].TrimEnd('\r')) + + let isWordChar (c: char) = + Char.IsLetterOrDigit(c) || c = '_' || c = '.' + + let isValidIdentifierName (name: string) = + let startsValid c = Char.IsLetter(c) || c = '_' + let partValid c = Char.IsLetterOrDigit(c) || c = '_' + not (String.IsNullOrWhiteSpace(name)) + && startsValid name[0] + && (name |> Seq.forall partValid) + && not (reservedKeywords.Contains name) + + let tryGetWordAtPosition (text: string) (line: int) (character: int) : string option = + match getLineText text line with + | None -> None + | Some lineText -> + if lineText.Length = 0 then None + else + let pos = + if character < 0 then 0 + elif character > lineText.Length then lineText.Length + else character + + let mutable start = pos + while start > 0 && isWordChar lineText[start - 1] do + start <- start - 1 + + let mutable finish = pos + while finish < lineText.Length && isWordChar lineText[finish] do + finish <- finish + 1 + + if finish > start then Some (lineText.Substring(start, finish - start)) else None + + let tryGetWordPrefixAtPosition (text: string) (line: int) (character: int) : string option = + match getLineText text line with + | None -> None + | Some lineText -> + if lineText.Length = 0 then None + else + let pos = + if character < 0 then 0 + elif character > lineText.Length then lineText.Length + else character + + let mutable start = pos + while start > 0 && isWordChar lineText[start - 1] do + start <- start - 1 + + if pos > start then Some (lineText.Substring(start, pos - start)) else None + + let tryGetPosition (paramsObj: JsonObject) : (int * int) option = + match tryGetObject paramsObj "position" with + | None -> None + | Some posObj -> + match tryGetInt posObj "line", tryGetInt posObj "character" with + | Some line, Some character -> Some (line, character) + | _ -> None + + let tryGetRange (paramsObj: JsonObject) : (int * int * int * int) option = + match tryGetObject paramsObj "range" with + | Some rangeObj -> + match tryGetObject rangeObj "start", tryGetObject rangeObj "end" with + | Some startObj, Some endObj -> + match tryGetInt startObj "line", tryGetInt startObj "character", tryGetInt endObj "line", tryGetInt endObj "character" with + | Some sl, Some sc, Some el, Some ec -> Some (sl, sc, el, ec) + | _ -> None + | _ -> None + | None -> None + + let tryGetUriFromTextDocument (paramsObj: JsonObject) : string option = + match tryGetObject paramsObj "textDocument" with + | None -> None + | Some td -> tryGetString td "uri" + + let tryGetContextTriggerCharacter (paramsObj: JsonObject) : string option = + match tryGetObject paramsObj "context" with + | None -> None + | Some ctx -> tryGetString ctx "triggerCharacter" diff --git a/src/FScript.CSharpInterop/LanguageServer/LspProtocol.fs b/src/FScript.CSharpInterop/LanguageServer/LspProtocol.fs new file mode 100644 index 0000000..a5b8f6c --- /dev/null +++ b/src/FScript.CSharpInterop/LanguageServer/LspProtocol.fs @@ -0,0 +1,97 @@ +namespace FScript.LanguageServer + +open System +open System.IO +open System.Text +open System.Text.Json.Nodes + +module LspProtocol = + let private utf8 = UTF8Encoding(false) + let private stdin = Console.OpenStandardInput() + let private stdout = Console.OpenStandardOutput() + + let sendMessage (payload: string) = + let bytes = utf8.GetBytes(payload) + let header = $"Content-Length: {bytes.Length}\r\n\r\n" + let headerBytes = Encoding.ASCII.GetBytes(header) + stdout.Write(headerBytes, 0, headerBytes.Length) + stdout.Write(bytes, 0, bytes.Length) + stdout.Flush() + + let sendResponse (idNode: JsonNode) (resultNode: (JsonNode | null) option) = + let obj = JsonObject() + obj["jsonrpc"] <- JsonValue.Create("2.0") + obj["id"] <- idNode.DeepClone() + obj["result"] <- + match resultNode with + | Some node -> node + | None -> null + sendMessage (obj.ToJsonString()) + + let sendError (idNode: JsonNode) (code: int) (message: string) = + let err = JsonObject() + err["code"] <- JsonValue.Create(code) + err["message"] <- JsonValue.Create(message) + + let obj = JsonObject() + obj["jsonrpc"] <- JsonValue.Create("2.0") + obj["id"] <- idNode.DeepClone() + obj["error"] <- err + sendMessage (obj.ToJsonString()) + + let sendNotification (methodName: string) (paramsNode: (JsonNode | null) option) = + let obj = JsonObject() + obj["jsonrpc"] <- JsonValue.Create("2.0") + obj["method"] <- JsonValue.Create(methodName) + obj["params"] <- + match paramsNode with + | Some node -> node + | None -> null + sendMessage (obj.ToJsonString()) + + let rec private readExact (stream: Stream) (buffer: byte[]) (offset: int) (count: int) = + if count > 0 then + let read = stream.Read(buffer, offset, count) + if read <= 0 then + raise (EndOfStreamException("Unexpected end of stream while reading LSP payload.")) + readExact stream buffer (offset + read) (count - read) + + let tryReadMessage () : string option = + let headerBytes = ResizeArray() + let mutable matched = 0 + let marker = [| byte '\r'; byte '\n'; byte '\r'; byte '\n' |] + let mutable ended = false + + while not ended do + let b = stdin.ReadByte() + if b = -1 then + if headerBytes.Count = 0 then + ended <- true + else + raise (EndOfStreamException("Unexpected end of stream while reading LSP headers.")) + else + let bb = byte b + headerBytes.Add(bb) + if bb = marker[matched] then + matched <- matched + 1 + if matched = marker.Length then + ended <- true + else + matched <- if bb = marker[0] then 1 else 0 + + if headerBytes.Count = 0 then + None + else + let headerText = Encoding.ASCII.GetString(headerBytes.ToArray()) + let contentLength = + headerText.Split([| "\r\n" |], StringSplitOptions.RemoveEmptyEntries) + |> Array.tryPick (fun line -> + if line.StartsWith("Content-Length:", StringComparison.OrdinalIgnoreCase) then + line.Substring("Content-Length:".Length).Trim() |> int |> Some + else + None) + |> Option.defaultWith (fun () -> failwith "Missing Content-Length header") + + let payload = Array.zeroCreate contentLength + readExact stdin payload 0 contentLength + Some (utf8.GetString(payload)) diff --git a/src/FScript.CSharpInterop/LanguageServer/LspRuntimeExterns.fs b/src/FScript.CSharpInterop/LanguageServer/LspRuntimeExterns.fs new file mode 100644 index 0000000..93b4758 --- /dev/null +++ b/src/FScript.CSharpInterop/LanguageServer/LspRuntimeExterns.fs @@ -0,0 +1,8 @@ +namespace FScript.LanguageServer + +open FScript.Language +open FScript.CSharpInterop + +module LspRuntimeExterns = + let forSourcePath (sourcePath: string) : ExternalFunction list = + InteropServices.runtimeExternsForSourcePath sourcePath diff --git a/src/FScript.CSharpInterop/LanguageServer/LspSymbols.fs b/src/FScript.CSharpInterop/LanguageServer/LspSymbols.fs new file mode 100644 index 0000000..2968eee --- /dev/null +++ b/src/FScript.CSharpInterop/LanguageServer/LspSymbols.fs @@ -0,0 +1,2186 @@ +namespace FScript.LanguageServer + +open System +open System.Collections.Generic +open System.IO +open System.Text.Json.Nodes +open FScript.Language +open FScript.CSharpInterop + +module LspSymbols = + open LspModel + + let private collectMapKeyDomainVars (t: Type) = + let rec collect acc ty = + match ty with + | TMap (TVar v, valueType) -> + collect (Set.add v acc) valueType + | TMap (keyType, valueType) -> + collect (collect acc keyType) valueType + | TList inner + | TOption inner -> collect acc inner + | TTuple items -> + items |> List.fold collect acc + | TRecord fields -> + fields |> Map.values |> Seq.fold collect acc + | TFun (a, b) -> + collect (collect acc a) b + | _ -> acc + + collect Set.empty t + + let private lspTypeToStringWithKeyDomainVars (keyDomainVars: Set) (t: Type) = + let rec go t = + match t with + | TUnit -> "unit" + | TInt -> "int" + | TFloat -> "float" + | TBool -> "bool" + | TString -> "string" + | TList t1 -> sprintf "%s list" (postfixArg t1) + | TTuple ts -> ts |> List.map go |> String.concat " * " |> sprintf "(%s)" + | TRecord fields -> + fields + |> Map.toList + |> List.map (fun (name, fieldType) -> sprintf "%s: %s" name (go fieldType)) + |> String.concat "; " + |> sprintf "{ %s }" + | TMap (_, tv) -> + sprintf "%s map" (postfixArg tv) + | TOption t1 -> sprintf "%s option" (postfixArg t1) + | TFun (a, b) -> sprintf "(%s -> %s)" (go a) (go b) + | TNamed n -> n + | TUnion (name, _) -> name + | TTypeToken -> "type" + | TVar v when Set.contains v keyDomainVars -> "int|string" + | TVar _ -> "unknown" + and postfixArg t = + match t with + | TFun _ | TTuple _ | TRecord _ -> sprintf "(%s)" (go t) + | _ -> go t + go t + + let private lspTypeToString (t: Type) = + let keyDomainVars = collectMapKeyDomainVars t + lspTypeToStringWithKeyDomainVars keyDomainVars t + + let private schemeTypeToString (scheme: Scheme) = + match scheme with + | Forall (_, t) -> Types.typeToString t + + let private stdlibFunctionSignatures : Lazy> = + lazy + let typedStdlib = InteropServices.inferStdlibWithExternsRaw [] + typedStdlib + |> List.collect (function + | TypeInfer.TSLet(name, _, t, _, _, _) -> + match t with + | TFun _ -> [ name, Types.typeToString t ] + | _ -> [] + | TypeInfer.TSLetRecGroup(bindings, _, _) -> + bindings + |> List.choose (fun (name, _, t, _) -> + match t with + | TFun _ -> Some (name, Types.typeToString t) + | _ -> None) + | _ -> []) + |> Map.ofList + + let private tryStdlibVirtualUriFromSource (sourceFile: string option) = + match sourceFile with + | Some file when file.EndsWith("Stdlib.Option.fss", StringComparison.Ordinal) || file.EndsWith("Option.fss", StringComparison.Ordinal) -> Some "fscript-stdlib:///Option.fss" + | Some file when file.EndsWith("Stdlib.List.fss", StringComparison.Ordinal) || file.EndsWith("List.fss", StringComparison.Ordinal) -> Some "fscript-stdlib:///List.fss" + | Some file when file.EndsWith("Stdlib.Map.fss", StringComparison.Ordinal) || file.EndsWith("Map.fss", StringComparison.Ordinal) -> Some "fscript-stdlib:///Map.fss" + | _ -> None + + let private stdlibFunctionParameterNames : Lazy> = + lazy + InteropServices.stdlibProgram() + |> List.collect (function + | SLet(name, args, _, _, _, _) -> + [ name, (args |> List.map (fun p -> p.Name)) ] + | SLetRecGroup(bindings, _, _) -> + bindings + |> List.map (fun (name, args, _, _) -> name, (args |> List.map (fun p -> p.Name))) + | _ -> []) + |> Map.ofList + + let private stdlibFunctionDefinitions : Lazy> = + lazy + InteropServices.stdlibProgram() + |> List.collect (function + | SLet(name, _, _, _, _, span) -> + match tryStdlibVirtualUriFromSource span.Start.File with + | Some uri -> [ name, (uri, span) ] + | None -> [] + | SLetRecGroup(bindings, _, _) -> + bindings + |> List.collect (fun (name, _, _, span) -> + match tryStdlibVirtualUriFromSource span.Start.File with + | Some uri -> [ name, (uri, span) ] + | None -> []) + | _ -> []) + |> Map.ofList + + let private buildInjectedFunctionData (externs: ExternalFunction list) = + let fromExterns = + externs + |> List.map (fun ext -> ext.Name, schemeTypeToString ext.Scheme) + |> Map.ofList + + let builtinSignatures = + [ "ignore", "'a -> unit" + "print", "string -> unit" + "nameof", "string -> string" + "typeof", "string -> type" ] + |> Map.ofList + + let builtinParamNames = + [ "ignore", [ "value" ] + "print", [ "message" ] + "nameof", [ "name" ] + "typeof", [ "name" ] ] + |> Map.ofList + + let signatures = + stdlibFunctionSignatures.Value + |> Map.fold (fun acc name signature -> acc |> Map.add name signature) fromExterns + |> Map.fold (fun acc name signature -> acc |> Map.add name signature) builtinSignatures + + let paramNames = + stdlibFunctionParameterNames.Value + |> Map.fold (fun acc name names -> acc |> Map.add name names) builtinParamNames + + signatures, paramNames, stdlibFunctionDefinitions.Value + + let rec private typeRefToString (typeRef: TypeRef) = + match typeRef with + | TRName name -> name + | TRTuple parts -> parts |> List.map typeRefToString |> String.concat " * " |> sprintf "(%s)" + | TRFun (a, b) -> sprintf "%s -> %s" (typeRefToString a) (typeRefToString b) + | TRPostfix (inner, suffix) -> sprintf "%s %s" (typeRefToString inner) suffix + | TRRecord fields -> + fields + |> List.map (fun (name, t) -> sprintf "%s: %s" name (typeRefToString t)) + |> String.concat "; " + |> sprintf "{ %s }" + | TRStructuralRecord fields -> + fields + |> List.map (fun (name, t) -> sprintf "%s: %s" name (typeRefToString t)) + |> String.concat "; " + |> sprintf "{| %s |}" + + let private canonicalRecordSignatureFromFields (fields: (string * string) list) = + fields + |> List.sortBy fst + |> List.map (fun (name, t) -> $"{name}:{t}") + |> String.concat ";" + + let buildSymbolsFromProgram (program: Program) (typed: TypeInfer.TypedProgram option) : TopLevelSymbol list = + let typedByName = Dictionary(StringComparer.Ordinal) + let recordTypeDefsBySignature = Dictionary>(StringComparer.Ordinal) + + let canonicalRecordSignatureFromType (t: Type) = + match t with + | TRecord fields -> + fields + |> Map.toList + |> List.map (fun (name, ty) -> name, Types.typeToString ty) + |> canonicalRecordSignatureFromFields + |> Some + | _ -> None + + match typed with + | Some typedProgram -> + for stmt in typedProgram do + match stmt with + | TypeInfer.TSLet(name, _, _, _, _, _) -> + typedByName[name] <- stmt + | TypeInfer.TSLetRecGroup(bindings, _, _) -> + for (name, _, _, _) in bindings do + typedByName[name] <- stmt + | _ -> () + | None -> () + + for stmt in program do + match stmt with + | SType typeDef when typeDef.Cases.IsEmpty -> + let signature = + typeDef.Fields + |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) + |> canonicalRecordSignatureFromFields + + if not (recordTypeDefsBySignature.ContainsKey(signature)) then + recordTypeDefsBySignature[signature] <- ResizeArray() + recordTypeDefsBySignature[signature].Add(typeDef.Name) + | _ -> () + + let mkFromTyped (name: string) (span: Span) (fallbackKind: int) = + let tryResolveRecordTarget (t: Type) = + match canonicalRecordSignatureFromType t with + | Some signature when recordTypeDefsBySignature.ContainsKey(signature) -> + let candidates = recordTypeDefsBySignature[signature] |> Seq.distinct |> Seq.toList + match candidates with + | [ one ] -> Some one + | _ -> None + | _ -> None + + let rec typeTargetFromType (t: Type) = + match t with + | TNamed name -> Some name + | TUnion (name, _) -> Some name + | TRecord _ -> tryResolveRecordTarget t + | TFun (_, ret) -> typeTargetFromType ret + | _ -> None + + match typedByName.TryGetValue(name) with + | true, TypeInfer.TSLet(_, _, t, _, _, _) -> + { Name = name + Kind = symbolKindForType t + TypeText = Some (lspTypeToString t) + TypeTargetName = typeTargetFromType t + Span = span } + | true, TypeInfer.TSLetRecGroup(bindings, _, _) -> + match bindings |> List.tryFind (fun (n, _, _, _) -> n = name) with + | Some (_, _, t, _) -> + { Name = name + Kind = symbolKindForType t + TypeText = Some (lspTypeToString t) + TypeTargetName = typeTargetFromType t + Span = span } + | None -> + { Name = name + Kind = fallbackKind + TypeText = None + TypeTargetName = None + Span = span } + | _ -> + { Name = name + Kind = fallbackKind + TypeText = None + TypeTargetName = None + Span = span } + + program + |> List.collect (fun stmt -> + match stmt with + | SType typeDef -> + let typeText = + if typeDef.Cases.IsEmpty then + let fields = + typeDef.Fields + |> List.map (fun (name, t) -> $"{name}: {typeRefToString t}") + |> String.concat "; " + Some $"{{ {fields} }}" + else + Some typeDef.Name + + let typeSymbol = + { Name = typeDef.Name + Kind = 5 + TypeText = typeText + TypeTargetName = None + Span = typeDef.Span } + + let caseSymbols = + typeDef.Cases + |> List.collect (fun (caseName, payload) -> + let caseType = + match payload with + | Some payloadType -> Some (sprintf "%s -> %s" (typeRefToString payloadType) typeDef.Name) + | None -> Some typeDef.Name + + [ { Name = caseName + Kind = 22 + TypeText = caseType + TypeTargetName = Some typeDef.Name + Span = typeDef.Span } + { Name = $"{typeDef.Name}.{caseName}" + Kind = 22 + TypeText = caseType + TypeTargetName = Some typeDef.Name + Span = typeDef.Span } ]) + + typeSymbol :: caseSymbols + | SLet(name, args, _, _, _, span) -> + [ mkFromTyped name span (declarationKindFromArgs args) ] + | SLetRecGroup(bindings, _, _) -> + bindings + |> List.map (fun (name, args, _, span) -> mkFromTyped name span (declarationKindFromArgs args)) + | _ -> []) + + let private buildTopLevelTypeTargetFromProgram (program: Program) = + let recordTypeBySignature = + program + |> List.choose (function + | SType typeDef when typeDef.Cases.IsEmpty -> + let fields = + typeDef.Fields + |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) + Some (canonicalRecordSignatureFromFields fields, typeDef.Name) + | _ -> None) + |> List.groupBy fst + |> List.choose (fun (signature, entries) -> + let names = entries |> List.map snd |> List.distinct + match names with + | [ single ] -> Some (signature, single) + | _ -> None) + |> Map.ofList + + let canonicalRecordSignatureFromType (t: Type) = + match t with + | TRecord fields -> + fields + |> Map.toList + |> List.map (fun (name, ty) -> name, Types.typeToString ty) + |> canonicalRecordSignatureFromFields + |> Some + | _ -> None + + let rec resolveTypeTarget (t: Type) = + match t with + | TNamed name -> Some name + | TUnion (name, _) -> Some name + | TRecord _ -> + match canonicalRecordSignatureFromType t with + | Some signature -> recordTypeBySignature |> Map.tryFind signature + | None -> None + | TFun (_, ret) -> resolveTypeTarget ret + | _ -> None + + resolveTypeTarget + + let private inferTopLevelTypesBestEffort (externs: ExternalFunction list) (program: Program) : Map = + let mutable accepted: Program = [] + let mutable result: Map = Map.empty + + let tryInferWithCurrent (candidate: Program) = + try + let typed, _ = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs candidate + Some typed + with + | _ -> None + + let extractTypeForName (typed: TypeInfer.TypedProgram) (targetName: string) = + typed + |> List.tryPick (fun stmt -> + match stmt with + | TypeInfer.TSLet (name, _, t, _, _, _) when name = targetName -> + Some t + | TypeInfer.TSLetRecGroup (bindings, _, _) -> + bindings + |> List.tryPick (fun (name, _, t, _) -> + if name = targetName then Some t else None) + | _ -> None) + + for stmt in program do + match stmt with + | SType _ -> + accepted <- accepted @ [ stmt ] + | SLet (name, _, _, _, _, _) -> + let candidate = accepted @ [ stmt ] + match tryInferWithCurrent candidate with + | Some typed -> + accepted <- candidate + match extractTypeForName typed name with + | Some t -> result <- result |> Map.add name t + | None -> () + | None -> () + | SLetRecGroup (bindings, _, _) -> + let candidate = accepted @ [ stmt ] + match tryInferWithCurrent candidate with + | Some typed -> + accepted <- candidate + for (name, _, _, _) in bindings do + match extractTypeForName typed name with + | Some t -> result <- result |> Map.add name t + | None -> () + | None -> () + | SExpr _ -> + () + | SImport _ -> + () + + result + + let private inferLocalVariableTypesBestEffort (externs: ExternalFunction list) (program: Program) : TypeInfer.LocalVariableTypeInfo list = + let mutable accepted: Program = [] + let collected = Dictionary<(string * int * int * int * int * string), TypeInfer.LocalVariableTypeInfo>() + + let tryInferWithCurrent (candidate: Program) = + try + let _, localTypes = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs candidate + Some localTypes + with + | _ -> None + + let keyOf (entry: TypeInfer.LocalVariableTypeInfo) = + let file = entry.Span.Start.File |> Option.defaultValue "" + (entry.Name, entry.Span.Start.Line, entry.Span.Start.Column, entry.Span.End.Line, entry.Span.End.Column, file) + + for stmt in program do + match stmt with + | SType _ -> + accepted <- accepted @ [ stmt ] + | SLet _ + | SLetRecGroup _ -> + let candidate = accepted @ [ stmt ] + match tryInferWithCurrent candidate with + | Some localTypes -> + accepted <- candidate + for entry in localTypes do + collected[keyOf entry] <- entry + | None -> () + | SExpr _ -> + () + | SImport _ -> + () + + collected.Values |> Seq.toList + + let collectVariableOccurrences (program: Program) : Map = + let addOccurrence name span (acc: Map) = + let existing = acc |> Map.tryFind name |> Option.defaultValue [] + acc |> Map.add name (span :: existing) + + let rec collectExpr (acc: Map) (expr: Expr) = + match expr with + | EVar (name, span) -> addOccurrence name span acc + | EParen (inner, _) -> collectExpr acc inner + | ELambda (_, body, _) -> collectExpr acc body + | EApply (fn, arg, _) -> + let withFn = collectExpr acc fn + collectExpr withFn arg + | EIf (c, t, f, _) -> + let withCond = collectExpr acc c + let withThen = collectExpr withCond t + collectExpr withThen f + | ERaise (inner, _) -> collectExpr acc inner + | EFor (_, source, body, _) -> + let withSource = collectExpr acc source + collectExpr withSource body + | EMatch (scrutinee, cases, _) -> + let withScrutinee = collectExpr acc scrutinee + cases + |> List.fold (fun state (_, guard, body, _) -> + let withGuard = + match guard with + | Some g -> collectExpr state g + | None -> state + collectExpr withGuard body) withScrutinee + | ELet (_, value, body, _, _) -> + let withValue = collectExpr acc value + collectExpr withValue body + | ELetRecGroup (bindings, body, _) -> + let withBindings = + bindings + |> List.fold (fun state (_, _, value, _) -> collectExpr state value) acc + collectExpr withBindings body + | EList (items, _) -> + items |> List.fold collectExpr acc + | ERange (startExpr, endExpr, _) -> + let withStart = collectExpr acc startExpr + collectExpr withStart endExpr + | ETuple (items, _) -> + items |> List.fold collectExpr acc + | ERecord (fields, _) -> + fields |> List.fold (fun state (_, value) -> collectExpr state value) acc + | EStructuralRecord (fields, _) -> + fields |> List.fold (fun state (_, value) -> collectExpr state value) acc + | EMap (entries, _) -> + entries + |> List.fold (fun state entry -> + match entry with + | MEKeyValue (keyExpr, valueExpr) -> + let withKey = collectExpr state keyExpr + collectExpr withKey valueExpr + | MESpread spreadExpr -> + collectExpr state spreadExpr) acc + | ERecordUpdate (baseExpr, fields, _) -> + let withBase = collectExpr acc baseExpr + fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase + | EStructuralRecordUpdate (baseExpr, fields, _) -> + let withBase = collectExpr acc baseExpr + fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase + | EFieldGet (target, _, _) -> collectExpr acc target + | EIndexGet (target, key, _) -> + let withTarget = collectExpr acc target + collectExpr withTarget key + | ECons (head, tail, _) -> + let withHead = collectExpr acc head + collectExpr withHead tail + | EAppend (left, right, _) -> + let withLeft = collectExpr acc left + collectExpr withLeft right + | EBinOp (_, left, right, _) -> + let withLeft = collectExpr acc left + collectExpr withLeft right + | ESome (inner, _) -> collectExpr acc inner + | EInterpolatedString (parts, _) -> + parts + |> List.fold (fun state part -> + match part with + | IPText _ -> state + | IPExpr embedded -> collectExpr state embedded) acc + | EUnit _ + | ELiteral _ + | ENone _ + | ETypeOf _ + | ENameOf _ -> acc + + let withDeclsAndExprs = + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (name, _, expr, _, _, span) -> + let withDecl = addOccurrence name span state + collectExpr withDecl expr + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.fold (fun inner (name, _, expr, span) -> + let withDecl = addOccurrence name span inner + collectExpr withDecl expr) state + | SExpr expr -> + collectExpr state expr + | _ -> state) Map.empty + + withDeclsAndExprs + |> Map.map (fun _ spans -> spans |> List.rev) + + let private buildRecordParameterFields (program: Program) = + let typeRecordFields = + program + |> List.choose (function + | SType typeDef when typeDef.Cases.IsEmpty -> + let fields = + typeDef.Fields + |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) + Some (typeDef.Name, fields) + | _ -> None) + |> Map.ofList + + let fieldsFromAnnotation (annotation: TypeRef option) = + match annotation with + | Some (TRRecord fields) -> + Some (fields |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t)) + | Some (TRName typeName) -> + typeRecordFields |> Map.tryFind typeName + | _ -> + None + + let collectFromArgs (acc: Map) (args: Param list) = + args + |> List.fold (fun state arg -> + match fieldsFromAnnotation arg.Annotation with + | Some fields -> state |> Map.add arg.Name fields + | None -> state) acc + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (_, args, _, _, _, _) -> + collectFromArgs state args + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.fold (fun inner (_, args, _, _) -> collectFromArgs inner args) state + | _ -> + state) Map.empty + + let private buildParameterTypeTargets (program: Program) = + let namedRecordTypeBySignature = + program + |> List.choose (function + | SType typeDef when typeDef.Cases.IsEmpty -> + let fields = + typeDef.Fields + |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) + Some (canonicalRecordSignatureFromFields fields, typeDef.Name) + | _ -> None) + |> List.groupBy fst + |> List.choose (fun (sigText, entries) -> + let names = entries |> List.map snd |> List.distinct + match names with + | [ one ] -> Some (sigText, one) + | _ -> None) + |> Map.ofList + + let resolveAnnotationTarget (annotation: TypeRef option) = + match annotation with + | Some (TRName typeName) -> Some typeName + | Some (TRRecord fields) -> + fields + |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) + |> canonicalRecordSignatureFromFields + |> fun sigText -> namedRecordTypeBySignature |> Map.tryFind sigText + | _ -> None + + let collectFromArgs (acc: Map) (args: Param list) = + args + |> List.fold (fun state arg -> + match resolveAnnotationTarget arg.Annotation with + | Some typeName -> state |> Map.add arg.Name typeName + | None -> state) acc + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (_, args, _, _, _, _) -> + collectFromArgs state args + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.fold (fun inner (_, args, _, _) -> collectFromArgs inner args) state + | _ -> + state) Map.empty + + let private buildFunctionParameters (program: Program) = + let addBinding name (args: Param list) (acc: Map) = + let paramNames = + args + |> List.map (fun p -> p.Name) + |> List.filter (fun n -> not (String.IsNullOrWhiteSpace(n))) + if paramNames.IsEmpty then acc else acc |> Map.add name paramNames + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (name, args, _, _, _, _) -> + addBinding name args state + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.fold (fun inner (name, args, _, _) -> addBinding name args inner) state + | _ -> + state) Map.empty + + let private buildFunctionAnnotationTypes (program: Program) = + let addBinding name (args: Param list) (acc: Map) = + let hasAnnotation = args |> List.exists (fun p -> p.Annotation.IsSome) + if not hasAnnotation then acc + else + let annotated = + args + |> List.map (fun p -> + match p.Annotation with + | Some t -> typeRefToString t + | None -> "unknown") + acc |> Map.add name annotated + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (name, args, _, _, _, _) -> + addBinding name args state + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.fold (fun inner (name, args, _, _) -> addBinding name args inner) state + | _ -> + state) Map.empty + + let private buildFunctionDeclaredReturnTargets (program: Program) = + let recordTypeByFieldNames = + program + |> List.choose (function + | SType typeDef when typeDef.Cases.IsEmpty -> + let signature = + typeDef.Fields + |> List.map fst + |> List.sort + |> String.concat ";" + Some (signature, typeDef.Name) + | _ -> None) + |> List.groupBy fst + |> List.choose (fun (signature, entries) -> + let names = entries |> List.map snd |> List.distinct + match names with + | [ one ] -> Some (signature, one) + | _ -> None) + |> Map.ofList + + let rec terminalExpr (expr: Expr) = + match expr with + | ELet (_, _, body, _, _) -> terminalExpr body + | ELetRecGroup (_, body, _) -> terminalExpr body + | EParen (inner, _) -> terminalExpr inner + | _ -> expr + + let tryResolve expr = + match terminalExpr expr with + | ERecord (fields, _) + | EStructuralRecord (fields, _) -> + let signature = + fields + |> List.map fst + |> List.sort + |> String.concat ";" + recordTypeByFieldNames |> Map.tryFind signature + | _ -> None + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (name, args, expr, _, _, _) when not args.IsEmpty -> + match tryResolve expr with + | Some returnType -> state |> Map.add name returnType + | None -> state + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.fold (fun inner (name, args, expr, _) -> + if args.IsEmpty then inner + else + match tryResolve expr with + | Some returnType -> inner |> Map.add name returnType + | None -> inner) state + | _ -> state) Map.empty + + let private buildRecordTypeFieldTypeMap (program: Program) = + program + |> List.choose (function + | SType typeDef when typeDef.Cases.IsEmpty -> + let fields = + typeDef.Fields + |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) + |> Map.ofList + Some (typeDef.Name, fields) + | _ -> None) + |> Map.ofList + + let private spanContainsPosition1Based (span: Span) (line: int) (column: int) = + let sameFile = + match span.Start.File, span.End.File with + | Some sf, Some ef when not (String.Equals(sf, ef, StringComparison.OrdinalIgnoreCase)) -> false + | _ -> true + let startsBefore = + line > span.Start.Line + || (line = span.Start.Line && column >= span.Start.Column) + let endsAfter = + line < span.End.Line + || (line = span.End.Line && column <= span.End.Column) + sameFile && startsBefore && endsAfter + + let private spanStartAtOrBefore (candidate: Span) (line: int) (column: int) = + candidate.Start.Line < line + || (candidate.Start.Line = line && candidate.Start.Column <= column) + + let private inferLocalTypesFromReturnedRecordFields + (program: Program) + (functionDeclaredReturnTargets: Map) + (localBindings: LocalBindingInfo list) + : (Span * string * string) list = + + let recordFieldTypesByType = buildRecordTypeFieldTypeMap program + + let pickNearestBinding (name: string) (usageSpan: Span) = + localBindings + |> List.filter (fun binding -> + String.Equals(binding.Name, name, StringComparison.Ordinal) + && spanContainsPosition1Based binding.ScopeSpan usageSpan.Start.Line usageSpan.Start.Column + && spanStartAtOrBefore binding.DeclSpan usageSpan.Start.Line usageSpan.Start.Column) + |> List.sortByDescending (fun binding -> binding.DeclSpan.Start.Line, binding.DeclSpan.Start.Column) + |> List.tryHead + + let rec collectFieldVarUses (fieldTypes: Map) (expr: Expr) : (string * Span * string) list = + let nested = + match expr with + | EApply (f, a, _) -> collectFieldVarUses fieldTypes f @ collectFieldVarUses fieldTypes a + | EIf (c, t, f, _) -> + collectFieldVarUses fieldTypes c + @ collectFieldVarUses fieldTypes t + @ collectFieldVarUses fieldTypes f + | ERaise (inner, _) + | ESome (inner, _) + | EParen (inner, _) -> collectFieldVarUses fieldTypes inner + | EFor (_, source, body, _) -> + collectFieldVarUses fieldTypes source @ collectFieldVarUses fieldTypes body + | EMatch (scrutinee, cases, _) -> + let inScrutinee = collectFieldVarUses fieldTypes scrutinee + let inCases = + cases + |> List.collect (fun (_, guard, body, _) -> + let inGuard = + match guard with + | Some g -> collectFieldVarUses fieldTypes g + | None -> [] + inGuard @ collectFieldVarUses fieldTypes body) + inScrutinee @ inCases + | ELet (_, value, body, _, _) -> + collectFieldVarUses fieldTypes value @ collectFieldVarUses fieldTypes body + | ELetRecGroup (bindings, body, _) -> + let inBindings = + bindings + |> List.collect (fun (_, _, valueExpr, _) -> collectFieldVarUses fieldTypes valueExpr) + inBindings @ collectFieldVarUses fieldTypes body + | ELambda (_, body, _) -> + collectFieldVarUses fieldTypes body + | EList (items, _) + | ETuple (items, _) -> + items |> List.collect (collectFieldVarUses fieldTypes) + | ERange (a, b, _) -> + collectFieldVarUses fieldTypes a @ collectFieldVarUses fieldTypes b + | ERecord (fields, _) + | EStructuralRecord (fields, _) -> + fields |> List.collect (fun (_, valueExpr) -> collectFieldVarUses fieldTypes valueExpr) + | EMap (entries, _) -> + entries + |> List.collect (function + | MEKeyValue (k, v) -> collectFieldVarUses fieldTypes k @ collectFieldVarUses fieldTypes v + | MESpread e -> collectFieldVarUses fieldTypes e) + | ERecordUpdate (target, fields, _) + | EStructuralRecordUpdate (target, fields, _) -> + collectFieldVarUses fieldTypes target + @ (fields |> List.collect (fun (_, v) -> collectFieldVarUses fieldTypes v)) + | EFieldGet (target, _, _) -> + collectFieldVarUses fieldTypes target + | EIndexGet (a, b, _) + | ECons (a, b, _) + | EAppend (a, b, _) + | EBinOp (_, a, b, _) -> + collectFieldVarUses fieldTypes a @ collectFieldVarUses fieldTypes b + | EInterpolatedString (parts, _) -> + parts + |> List.collect (function + | IPText _ -> [] + | IPExpr embedded -> collectFieldVarUses fieldTypes embedded) + | EUnit _ + | ELiteral _ + | EVar _ + | ENone _ + | ETypeOf _ + | ENameOf _ -> [] + + let fromRecord = + match expr with + | ERecord (fields, _) + | EStructuralRecord (fields, _) -> + fields + |> List.choose (fun (fieldName, valueExpr) -> + match valueExpr, fieldTypes |> Map.tryFind fieldName with + | EVar (localName, usageSpan), Some fieldType -> + Some (localName, usageSpan, fieldType) + | _ -> None) + | _ -> [] + + fromRecord @ nested + + let fromBinding name expr = + match functionDeclaredReturnTargets |> Map.tryFind name with + | Some returnTypeName -> + match recordFieldTypesByType |> Map.tryFind returnTypeName with + | Some fieldTypes -> + collectFieldVarUses fieldTypes expr + |> List.choose (fun (localName, usageSpan, fieldType) -> + pickNearestBinding localName usageSpan + |> Option.map (fun binding -> binding.DeclSpan, binding.Name, fieldType)) + | None -> [] + | None -> [] + + program + |> List.collect (function + | SLet (name, args, expr, _, _, _) when not args.IsEmpty -> + fromBinding name expr + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.collect (fun (name, args, expr, _) -> + if args.IsEmpty then [] else fromBinding name expr) + | _ -> []) + |> List.distinctBy (fun (span, name, _) -> + let file = span.Start.File |> Option.defaultValue "" + name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column, file) + + let private buildLocalBindings (program: Program) = + let mkBinding (name: string) (declSpan: Span) (scopeSpan: Span) (annotation: string option) = + { Name = name + DeclSpan = declSpan + ScopeSpan = scopeSpan + AnnotationType = annotation } + + let rec collectPatternBindings (scopeSpan: Span) (pattern: Pattern) = + match pattern with + | PVar (name, span) -> + [ mkBinding name span scopeSpan None ] + | PCons (head, tail, _) -> + collectPatternBindings scopeSpan head @ collectPatternBindings scopeSpan tail + | PTuple (items, _) -> + items |> List.collect (collectPatternBindings scopeSpan) + | PRecord (fields, _) -> + fields |> List.collect (fun (_, p) -> collectPatternBindings scopeSpan p) + | PMap (clauses, tailOpt, _) -> + let fromClauses = + clauses + |> List.collect (fun (k, v) -> + collectPatternBindings scopeSpan k @ collectPatternBindings scopeSpan v) + let fromTail = + match tailOpt with + | Some tail -> collectPatternBindings scopeSpan tail + | None -> [] + fromClauses @ fromTail + | PSome (inner, _) -> + collectPatternBindings scopeSpan inner + | PUnionCase (_, _, payload, _) -> + match payload with + | Some p -> collectPatternBindings scopeSpan p + | None -> [] + | PWildcard _ + | PLiteral _ + | PNil _ + | PNone _ + | PTypeRef _ -> [] + + let rec collectExprBindings (expr: Expr) : LocalBindingInfo list = + match expr with + | ELambda (param, body, _) -> + let annotation = param.Annotation |> Option.map typeRefToString + mkBinding param.Name param.Span (Ast.spanOfExpr body) annotation + :: collectExprBindings body + | EFor (name, source, body, span) -> + mkBinding name span (Ast.spanOfExpr body) None + :: (collectExprBindings source @ collectExprBindings body) + | EMatch (scrutinee, cases, _) -> + let inScrutinee = collectExprBindings scrutinee + let inCases = + cases + |> List.collect (fun (pat, guard, body, _) -> + let scope = Ast.spanOfExpr body + let fromPattern = collectPatternBindings scope pat + let fromGuard = + match guard with + | Some g -> collectExprBindings g + | None -> [] + fromPattern @ fromGuard @ collectExprBindings body) + inScrutinee @ inCases + | ELet (name, value, body, _, span) -> + mkBinding name span (Ast.spanOfExpr body) None + :: (collectExprBindings value @ collectExprBindings body) + | ELetRecGroup (bindings, body, _) -> + let fromBindings = + bindings + |> List.collect (fun (name, args, valueExpr, bindingSpan) -> + let argBindings = + args + |> List.map (fun p -> + let annotation = p.Annotation |> Option.map typeRefToString + mkBinding p.Name p.Span (Ast.spanOfExpr valueExpr) annotation) + mkBinding name bindingSpan (Ast.spanOfExpr body) None + :: (argBindings @ collectExprBindings valueExpr)) + fromBindings @ collectExprBindings body + | EApply (f, a, _) -> + collectExprBindings f @ collectExprBindings a + | EIf (c, t, f, _) -> + collectExprBindings c @ collectExprBindings t @ collectExprBindings f + | ERaise (inner, _) + | ESome (inner, _) + | EParen (inner, _) -> + collectExprBindings inner + | EList (items, _) + | ETuple (items, _) -> + items |> List.collect collectExprBindings + | ERange (a, b, _) -> + collectExprBindings a @ collectExprBindings b + | ERecord (fields, _) + | EStructuralRecord (fields, _) -> + fields |> List.collect (fun (_, e) -> collectExprBindings e) + | EMap (entries, _) -> + entries + |> List.collect (function + | MEKeyValue (k, v) -> collectExprBindings k @ collectExprBindings v + | MESpread e -> collectExprBindings e) + | ERecordUpdate (target, fields, _) + | EStructuralRecordUpdate (target, fields, _) -> + collectExprBindings target @ (fields |> List.collect (fun (_, e) -> collectExprBindings e)) + | EFieldGet (target, _, _) -> + collectExprBindings target + | EIndexGet (a, b, _) + | ECons (a, b, _) + | EAppend (a, b, _) + | EBinOp (_, a, b, _) -> + collectExprBindings a @ collectExprBindings b + | EInterpolatedString (parts, _) -> + parts + |> List.collect (function + | IPText _ -> [] + | IPExpr embedded -> collectExprBindings embedded) + | EUnit _ + | ELiteral _ + | EVar _ + | ENone _ + | ETypeOf _ + | ENameOf _ -> [] + + let fromTopLevelFunction (args: Param list) (body: Expr) = + let argBindings = + args + |> List.map (fun p -> + let annotation = p.Annotation |> Option.map typeRefToString + mkBinding p.Name p.Span (Ast.spanOfExpr body) annotation) + argBindings @ collectExprBindings body + + program + |> List.collect (fun stmt -> + match stmt with + | SLet (_, args, body, _, _, _) -> + fromTopLevelFunction args body + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.collect (fun (_, args, body, _) -> fromTopLevelFunction args body) + | SExpr expr -> + collectExprBindings expr + | _ -> []) + + let private buildParameterTypeHints (program: Program) (typed: TypeInfer.TypedProgram option) = + let typedByName = Dictionary(StringComparer.Ordinal) + + match typed with + | Some typedProgram -> + for stmt in typedProgram do + match stmt with + | TypeInfer.TSLet(name, _, t, _, _, _) -> + typedByName[name] <- t + | TypeInfer.TSLetRecGroup(bindings, _, _) -> + for (name, _, t, _) in bindings do + typedByName[name] <- t + | _ -> () + | None -> () + + let rec collectLambdaParams (expr: Expr) = + match expr with + | ELambda (param, body, _) -> + param :: collectLambdaParams body + | EParen (inner, _) -> + collectLambdaParams inner + | _ -> + [] + + let rec takeParamTypes t count = + if count <= 0 then [] + else + match t with + | TFun (arg, rest) -> + arg :: takeParamTypes rest (count - 1) + | _ -> + [] + + let emitHints (name: string) (parameters: Param list) = + match typedByName.TryGetValue(name) with + | true, t when not parameters.IsEmpty -> + let argTypes = takeParamTypes t parameters.Length + let keyDomainVars = collectMapKeyDomainVars t + (parameters, argTypes) + ||> List.zip + |> List.choose (fun (param, argType) -> + if param.Annotation.IsSome then + None + else + Some (param.Span, $": {lspTypeToStringWithKeyDomainVars keyDomainVars argType}")) + | _ -> + [] + + program + |> List.collect (fun stmt -> + match stmt with + | SLet (name, args, expr, _, _, _) -> + let allParams = + if args.IsEmpty then collectLambdaParams expr else args + emitHints name allParams + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.collect (fun (name, args, expr, _) -> + let allParams = + if args.IsEmpty then collectLambdaParams expr else args + emitHints name allParams) + | _ -> + []) + + let private buildFunctionReturnTypeHints (program: Program) (typed: TypeInfer.TypedProgram option) = + let typedByName = Dictionary(StringComparer.Ordinal) + + match typed with + | Some typedProgram -> + for stmt in typedProgram do + match stmt with + | TypeInfer.TSLet(name, _, t, _, _, _) -> + typedByName[name] <- t + | TypeInfer.TSLetRecGroup(bindings, _, _) -> + for (name, _, t, _) in bindings do + typedByName[name] <- t + | _ -> () + | None -> () + + let rec collectLambdaParams (expr: Expr) = + match expr with + | ELambda (param, body, _) -> + param :: collectLambdaParams body + | EParen (inner, _) -> + collectLambdaParams inner + | _ -> + [] + + let rec takeReturnType t argCount = + if argCount <= 0 then t + else + match t with + | TFun (_, rest) -> takeReturnType rest (argCount - 1) + | _ -> t + + let emitHint (name: string) (parameters: Param list) = + if parameters.IsEmpty then + None + else + match typedByName.TryGetValue(name) with + | true, t -> + let returnType = takeReturnType t parameters.Length + let anchor = parameters[parameters.Length - 1].Span + Some (anchor, $": {lspTypeToString returnType}") + | _ -> + None + + let fromLet = + program + |> List.choose (fun stmt -> + match stmt with + | SLet (name, args, expr, _, _, _) -> + let allParams = + if args.IsEmpty then collectLambdaParams expr else args + emitHint name allParams + | _ -> + None) + + let fromLetRec = + program + |> List.collect (fun stmt -> + match stmt with + | SLetRecGroup (bindings, _, _) -> + bindings + |> List.choose (fun (name, args, expr, _) -> + let allParams = + if args.IsEmpty then collectLambdaParams expr else args + emitHint name allParams) + | _ -> + []) + + fromLet @ fromLetRec + + let private collectPatternVariableSpans (program: Program) = + let rec collectPattern (acc: (string * Span) list) (pattern: Pattern) = + match pattern with + | PVar (name, span) -> + (name, span) :: acc + | PCons (head, tail, _) -> + collectPattern (collectPattern acc head) tail + | PTuple (items, _) -> + items |> List.fold collectPattern acc + | PRecord (fields, _) -> + fields |> List.fold (fun state (_, p) -> collectPattern state p) acc + | PMap (clauses, tailOpt, _) -> + let withClauses = + clauses + |> List.fold (fun state (k, v) -> + let withKey = collectPattern state k + collectPattern withKey v) acc + match tailOpt with + | Some tail -> collectPattern withClauses tail + | None -> withClauses + | PSome (inner, _) -> + collectPattern acc inner + | PUnionCase (_, _, payload, _) -> + match payload with + | Some p -> collectPattern acc p + | None -> acc + | PWildcard _ + | PLiteral _ + | PNil _ + | PNone _ + | PTypeRef _ -> acc + + let rec collectExpr (acc: (string * Span) list) (expr: Expr) = + match expr with + | EMatch (scrutinee, cases, _) -> + let withScrutinee = collectExpr acc scrutinee + cases + |> List.fold (fun state (pat, guard, body, _) -> + let withPattern = collectPattern state pat + let withGuard = + match guard with + | Some g -> collectExpr withPattern g + | None -> withPattern + collectExpr withGuard body) withScrutinee + | ELambda (_, body, _) -> + collectExpr acc body + | EApply (f, a, _) -> + collectExpr (collectExpr acc f) a + | EIf (c, t, f, _) -> + collectExpr (collectExpr (collectExpr acc c) t) f + | ERaise (inner, _) -> + collectExpr acc inner + | EFor (_, source, body, _) -> + collectExpr (collectExpr acc source) body + | ELet (_, value, body, _, _) -> + collectExpr (collectExpr acc value) body + | ELetRecGroup (bindings, body, _) -> + let withBindings = + bindings |> List.fold (fun state (_, _, value, _) -> collectExpr state value) acc + collectExpr withBindings body + | EList (items, _) + | ETuple (items, _) -> + items |> List.fold collectExpr acc + | ERange (startExpr, endExpr, _) -> + collectExpr (collectExpr acc startExpr) endExpr + | ERecord (fields, _) + | EStructuralRecord (fields, _) -> + fields |> List.fold (fun state (_, value) -> collectExpr state value) acc + | EMap (entries, _) -> + entries + |> List.fold (fun state entry -> + match entry with + | MEKeyValue (k, v) -> + collectExpr (collectExpr state k) v + | MESpread spread -> + collectExpr state spread) acc + | ERecordUpdate (baseExpr, fields, _) + | EStructuralRecordUpdate (baseExpr, fields, _) -> + let withBase = collectExpr acc baseExpr + fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase + | EFieldGet (target, _, _) -> + collectExpr acc target + | EIndexGet (target, key, _) + | ECons (target, key, _) + | EAppend (target, key, _) + | EBinOp (_, target, key, _) -> + collectExpr (collectExpr acc target) key + | ESome (inner, _) + | EParen (inner, _) -> + collectExpr acc inner + | EInterpolatedString (parts, _) -> + parts + |> List.fold (fun state part -> + match part with + | IPText _ -> state + | IPExpr embedded -> collectExpr state embedded) acc + | EUnit _ + | ELiteral _ + | EVar _ + | ENone _ + | ETypeOf _ + | ENameOf _ -> acc + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (_, _, expr, _, _, _) -> + collectExpr state expr + | SLetRecGroup (bindings, _, _) -> + bindings |> List.fold (fun inner (_, _, expr, _) -> collectExpr inner expr) state + | SExpr expr -> + collectExpr state expr + | _ -> state) [] + |> List.rev + + let private buildPatternTypeHints (program: Program) (localTypes: TypeInfer.LocalVariableTypeInfo list) = + let localByNameAndSpan = + localTypes + |> List.map (fun entry -> (entry.Name, entry.Span.Start.Line, entry.Span.Start.Column, entry.Span.End.Line, entry.Span.End.Column), entry.Type) + |> Map.ofList + + collectPatternVariableSpans program + |> List.choose (fun (name, span) -> + let key = (name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column) + localByNameAndSpan + |> Map.tryFind key + |> Option.map (fun t -> span, $": {lspTypeToString t}")) + + let private buildCallArgumentHints (program: Program) (functionParameters: Map) = + let tryParameterNames (name: string) = + match functionParameters |> Map.tryFind name with + | Some names -> Some names + | None -> + let segments = name.Split('.') + if segments.Length > 1 then + functionParameters |> Map.tryFind segments[segments.Length - 1] + else + None + + let rec decomposeApply (expr: Expr) (argsRev: Expr list) = + match expr with + | EApply (fn, arg, _) -> decomposeApply fn (arg :: argsRev) + | _ -> expr, (argsRev |> List.rev) + + let tryCalledName (expr: Expr) = + match expr with + | EVar (name, _) -> Some name + | _ -> None + + let rec collectExpr (acc: (Span * string) list) (isApplySpineParent: bool) (expr: Expr) = + let withChildren = + match expr with + | EApply (f, a, _) -> + collectExpr (collectExpr acc true f) false a + | EIf (c, t, f, _) -> + collectExpr (collectExpr (collectExpr acc false c) false t) false f + | ERaise (inner, _) -> + collectExpr acc false inner + | EFor (_, source, body, _) -> + collectExpr (collectExpr acc false source) false body + | EMatch (scrutinee, cases, _) -> + let withScrutinee = collectExpr acc false scrutinee + cases + |> List.fold (fun state (_, guard, body, _) -> + let withGuard = + match guard with + | Some g -> collectExpr state false g + | None -> state + collectExpr withGuard false body) withScrutinee + | ELet (_, value, body, _, _) -> + collectExpr (collectExpr acc false value) false body + | ELetRecGroup (bindings, body, _) -> + let withBindings = + bindings |> List.fold (fun state (_, _, value, _) -> collectExpr state false value) acc + collectExpr withBindings false body + | ELambda (_, body, _) -> + collectExpr acc false body + | EList (items, _) + | ETuple (items, _) -> + items |> List.fold (fun state item -> collectExpr state false item) acc + | ERange (startExpr, endExpr, _) -> + collectExpr (collectExpr acc false startExpr) false endExpr + | ERecord (fields, _) + | EStructuralRecord (fields, _) -> + fields |> List.fold (fun state (_, value) -> collectExpr state false value) acc + | EMap (entries, _) -> + entries + |> List.fold (fun state entry -> + match entry with + | MEKeyValue (k, v) -> + collectExpr (collectExpr state false k) false v + | MESpread spread -> + collectExpr state false spread) acc + | ERecordUpdate (baseExpr, fields, _) + | EStructuralRecordUpdate (baseExpr, fields, _) -> + let withBase = collectExpr acc false baseExpr + fields |> List.fold (fun state (_, value) -> collectExpr state false value) withBase + | EFieldGet (target, _, _) -> + collectExpr acc false target + | EIndexGet (target, key, _) + | ECons (target, key, _) + | EAppend (target, key, _) + | EBinOp (_, target, key, _) -> + collectExpr (collectExpr acc false target) false key + | ESome (inner, _) + | EParen (inner, _) -> + collectExpr acc false inner + | EInterpolatedString (parts, _) -> + parts + |> List.fold (fun state part -> + match part with + | IPText _ -> state + | IPExpr embedded -> collectExpr state false embedded) acc + | EUnit _ + | ELiteral _ + | EVar _ + | ENone _ + | ETypeOf _ + | ENameOf _ -> acc + + if isApplySpineParent then + withChildren + else + match expr with + | EApply _ -> + let calledExpr, callArgs = decomposeApply expr [] + match tryCalledName calledExpr |> Option.bind tryParameterNames with + | Some parameterNames -> + let normalizedArgs = + match callArgs with + | [ ETuple (items, _) ] when parameterNames.Length > 1 && items.Length > 1 -> items + | _ -> callArgs + let count = min normalizedArgs.Length parameterNames.Length + [ 0 .. count - 1 ] + |> List.fold (fun state index -> + (Ast.spanOfExpr normalizedArgs[index], $"{parameterNames[index]}:") :: state) withChildren + | None -> + withChildren + | _ -> + withChildren + + program + |> List.fold (fun state stmt -> + match stmt with + | SLet (_, _, expr, _, _, _) -> + collectExpr state false expr + | SLetRecGroup (bindings, _, _) -> + bindings |> List.fold (fun inner (_, _, expr, _) -> collectExpr inner false expr) state + | SExpr expr -> + collectExpr state false expr + | _ -> + state) [] + |> List.rev + + let analyzeDocument (uri: string) (text: string) = + let sourceName = + if uri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then + Uri(uri).LocalPath + else + uri + let runtimeExterns = LspRuntimeExterns.forSourcePath sourceName + + let diagnostics = ResizeArray() + let mutable symbols : TopLevelSymbol list = [] + let mutable occurrences : Map = Map.empty + let mutable recordParamFields : Map = Map.empty + let mutable parameterTypeTargets : Map = Map.empty + let mutable functionParameters : Map = Map.empty + let mutable functionAnnotationTypes : Map = Map.empty + let mutable functionDeclaredReturnTargets : Map = Map.empty + let mutable callArgumentHints : (Span * string) list = [] + let mutable functionReturnTypeHints : (Span * string) list = [] + let mutable parameterTypeHints : (Span * string) list = [] + let mutable patternTypeHints : (Span * string) list = [] + let mutable localVariableTypeHints : (Span * string * string) list = [] + let mutable localBindings : LocalBindingInfo list = [] + let mutable injectedFunctionSignatures : Map = Map.empty + let mutable injectedFunctionParameterNames : Map = Map.empty + let mutable injectedFunctionDefinitions : Map = Map.empty + + let mutable parsedProgram : Program option = None + + try + let program = + if uri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then + InteropServices.parseProgramFromSourceWithIncludes sourceName text + else + FScript.parseWithSourceName (Some sourceName) text + parsedProgram <- Some program + let signatures, parameterNames, definitions = buildInjectedFunctionData runtimeExterns + injectedFunctionSignatures <- signatures + injectedFunctionParameterNames <- parameterNames + injectedFunctionDefinitions <- definitions + occurrences <- collectVariableOccurrences program + recordParamFields <- buildRecordParameterFields program + parameterTypeTargets <- buildParameterTypeTargets program + functionParameters <- buildFunctionParameters program + functionAnnotationTypes <- buildFunctionAnnotationTypes program + functionDeclaredReturnTargets <- buildFunctionDeclaredReturnTargets program + callArgumentHints <- buildCallArgumentHints program functionParameters + localBindings <- buildLocalBindings program + try + let typed, localTypes = InteropServices.inferProgramWithExternsAndLocalVariableTypes runtimeExterns program + symbols <- buildSymbolsFromProgram program (Some typed) + parameterTypeHints <- buildParameterTypeHints program (Some typed) + functionReturnTypeHints <- buildFunctionReturnTypeHints program (Some typed) + patternTypeHints <- buildPatternTypeHints program localTypes + localVariableTypeHints <- + localTypes + |> List.filter (fun entry -> + match entry.Span.Start.File with + | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase) + | None -> true) + |> List.map (fun entry -> entry.Span, entry.Name, lspTypeToString entry.Type) + with + | TypeException err -> + diagnostics.Add(diagnostic 1 "type" err.Span err.Message) + symbols <- buildSymbolsFromProgram program None + let bestEffortTypes = inferTopLevelTypesBestEffort runtimeExterns program + let bestEffortLocalTypes = inferLocalVariableTypesBestEffort runtimeExterns program + let localTypesFromReturnedRecords = + inferLocalTypesFromReturnedRecordFields program functionDeclaredReturnTargets localBindings + let resolveTypeTarget = buildTopLevelTypeTargetFromProgram program + symbols <- + symbols + |> List.map (fun sym -> + match bestEffortTypes |> Map.tryFind sym.Name with + | Some t -> + { sym with + Kind = symbolKindForType t + TypeText = Some (lspTypeToString t) + TypeTargetName = resolveTypeTarget t } + | None -> sym) + parameterTypeHints <- buildParameterTypeHints program None + functionReturnTypeHints <- [] + patternTypeHints <- buildPatternTypeHints program bestEffortLocalTypes + let baseLocalHints = + bestEffortLocalTypes + |> List.filter (fun entry -> + match entry.Span.Start.File with + | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase) + | None -> true) + |> List.map (fun entry -> entry.Span, entry.Name, lspTypeToString entry.Type) + + let refinedLocalHints = + localTypesFromReturnedRecords + |> List.filter (fun (span, _, _) -> + match span.Start.File with + | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase) + | None -> true) + + let keyOf (span: Span, name: string, _) = + let file = span.Start.File |> Option.defaultValue "" + name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column, file + + let merged = Dictionary() + + for hint in baseLocalHints do + merged[keyOf hint] <- hint + + for hint in refinedLocalHints do + let key = keyOf hint + match merged.TryGetValue(key) with + | true, (_, _, existingType) when existingType.Contains("unknown", StringComparison.Ordinal) -> + merged[key] <- hint + | false, _ -> + merged[key] <- hint + | _ -> + () + + localVariableTypeHints <- merged.Values |> Seq.toList + + with + | ParseException err -> + diagnostics.Add(diagnostic 1 "parse" err.Span err.Message) + + documents[uri] <- + { Text = text + Symbols = symbols + RecordParameterFields = recordParamFields + ParameterTypeTargets = parameterTypeTargets + FunctionParameters = functionParameters + FunctionAnnotationTypes = functionAnnotationTypes + FunctionDeclaredReturnTargets = functionDeclaredReturnTargets + CallArgumentHints = callArgumentHints + FunctionReturnTypeHints = functionReturnTypeHints + ParameterTypeHints = parameterTypeHints + PatternTypeHints = patternTypeHints + LocalVariableTypeHints = localVariableTypeHints + LocalBindings = localBindings + InjectedFunctionSignatures = injectedFunctionSignatures + InjectedFunctionParameterNames = injectedFunctionParameterNames + InjectedFunctionDefinitions = injectedFunctionDefinitions + VariableOccurrences = occurrences } + publishDiagnostics uri (diagnostics |> Seq.toList) + + let tryResolveSymbol (doc: DocumentState) (line: int) (character: int) : TopLevelSymbol option = + match tryGetWordAtPosition doc.Text line character with + | None -> None + | Some word -> + let candidates = + if word.Contains('.') then + let segments = word.Split('.') |> Array.toList + word :: segments + else + [ word ] + |> List.distinct + + candidates + |> List.tryPick (fun candidate -> + doc.Symbols |> List.tryFind (fun s -> s.Name = candidate)) + + let private splitTopLevelSemicolons (text: string) = + let parts = ResizeArray() + let mutable depthParen = 0 + let mutable depthBrace = 0 + let mutable depthBracket = 0 + let mutable start = 0 + + for i = 0 to text.Length - 1 do + match text[i] with + | '(' -> depthParen <- depthParen + 1 + | ')' -> if depthParen > 0 then depthParen <- depthParen - 1 + | '{' -> depthBrace <- depthBrace + 1 + | '}' -> if depthBrace > 0 then depthBrace <- depthBrace - 1 + | '[' -> depthBracket <- depthBracket + 1 + | ']' -> if depthBracket > 0 then depthBracket <- depthBracket - 1 + | ';' when depthParen = 0 && depthBrace = 0 && depthBracket = 0 -> + let chunk = text.Substring(start, i - start).Trim() + if chunk <> "" then + parts.Add(chunk) + start <- i + 1 + | _ -> () + + if start <= text.Length then + let tail = text.Substring(start).Trim() + if tail <> "" then + parts.Add(tail) + + parts |> Seq.toList + + let private tryParseRecordFields (typeText: string) = + let trimmed = typeText.Trim() + if trimmed.StartsWith("{", StringComparison.Ordinal) && trimmed.EndsWith("}", StringComparison.Ordinal) then + let inner = trimmed.Substring(1, trimmed.Length - 2).Trim() + if inner = "" then + Some [] + else + let fields = + splitTopLevelSemicolons inner + |> List.choose (fun part -> + let idx = part.IndexOf(':') + if idx <= 0 then None + else + let name = part.Substring(0, idx).Trim() + let fieldType = part.Substring(idx + 1).Trim() + if name = "" || fieldType = "" then None else Some (name, fieldType)) + + if fields.IsEmpty then None else Some fields + else + None + + let private tryRecordFieldsForQualifier (doc: DocumentState) (qualifier: string) = + let normalized = + if qualifier.Contains('.') then qualifier.Split('.') |> Array.last + else qualifier + + let sym = + doc.Symbols + |> List.tryFind (fun s -> s.Name = qualifier || s.Name = normalized) + + let tryFromTypeName (typeName: string) = + doc.Symbols + |> List.tryFind (fun s -> s.Kind = 5 && s.Name = typeName) + |> Option.bind (fun s -> s.TypeText) + |> Option.bind tryParseRecordFields + + match sym with + | None -> None + | Some s -> + match s.TypeText |> Option.bind tryParseRecordFields with + | Some fields -> Some fields + | None -> + match s.TypeTargetName with + | Some typeName -> + tryFromTypeName typeName + | None -> + s.TypeText |> Option.bind tryFromTypeName + |> function + | Some fields -> Some fields + | None -> doc.RecordParameterFields |> Map.tryFind normalized + + let private tryResolveNamedRecordTypeByFields (doc: DocumentState) (fields: (string * string) list) = + let wanted = canonicalRecordSignatureFromFields fields + let candidates = + doc.Symbols + |> List.choose (fun s -> + if s.Kind = 5 then + s.TypeText + |> Option.bind tryParseRecordFields + |> Option.map (fun typeFields -> s.Name, canonicalRecordSignatureFromFields typeFields) + else + None) + |> List.choose (fun (name, signature) -> if signature = wanted then Some name else None) + |> List.distinct + match candidates with + | [ one ] -> Some one + | _ -> None + + let private tryResolveTypeNameForQualifier (doc: DocumentState) (qualifier: string) = + let normalized = + if qualifier.Contains('.') then qualifier.Split('.') |> Array.last + else qualifier + + let fromSymbol = + doc.Symbols + |> List.tryFind (fun s -> s.Name = qualifier || s.Name = normalized) + |> Option.bind (fun s -> + match s.TypeTargetName with + | Some t -> Some t + | None -> + s.TypeText + |> Option.bind tryParseRecordFields + |> Option.bind (tryResolveNamedRecordTypeByFields doc)) + + match fromSymbol with + | Some typeName -> Some typeName + | None -> doc.ParameterTypeTargets |> Map.tryFind normalized + + let private tryFindSymbolByName (doc: DocumentState) (name: string) = + let normalized = + if name.Contains('.') then name.Split('.') |> Array.last + else name + doc.Symbols + |> List.tryFind (fun s -> s.Name = name || s.Name = normalized) + + let private tryResolveTypeNameFromSymbol (doc: DocumentState) (symbol: TopLevelSymbol) = + match symbol.TypeTargetName with + | Some typeName -> Some typeName + | None -> + symbol.TypeText + |> Option.bind tryParseRecordFields + |> Option.bind (tryResolveNamedRecordTypeByFields doc) + + let private trimWrappingParens (input: string) = + let mutable value = input.Trim() + let mutable changed = true + while changed && value.Length >= 2 && value[0] = '(' && value[value.Length - 1] = ')' do + changed <- false + let mutable depth = 0 + let mutable wraps = true + for i = 0 to value.Length - 1 do + match value[i] with + | '(' -> depth <- depth + 1 + | ')' -> + depth <- depth - 1 + if depth = 0 && i < value.Length - 1 then + wraps <- false + | _ -> () + if wraps then + value <- value.Substring(1, value.Length - 2).Trim() + changed <- true + value + + let private tryFirstArgumentTypeNameFromFunctionSymbol (doc: DocumentState) (symbol: TopLevelSymbol) = + let tryResolveTypeName (t: string) = + let trimmed = trimWrappingParens t + match doc.Symbols |> List.tryFind (fun s -> s.Kind = 5 && s.Name = trimmed) with + | Some _ -> Some trimmed + | None -> + tryParseRecordFields trimmed + |> Option.bind (tryResolveNamedRecordTypeByFields doc) + + symbol.TypeText + |> Option.bind (fun t -> + let normalizedTypeText = trimWrappingParens t + let arrowIndex = normalizedTypeText.IndexOf("->", StringComparison.Ordinal) + if arrowIndex <= 0 then None + else + let firstArg = normalizedTypeText.Substring(0, arrowIndex).Trim() + tryResolveTypeName firstArg) + + let private tryResolveRecordLiteralCallArgTypeTarget (doc: DocumentState) (line: int) (character: int) = + match getLineText doc.Text line with + | Some lineText -> + let pos = max 0 (min character lineText.Length) + let leftBrace = lineText.LastIndexOf('{', max 0 (pos - 1)) + let rightBrace = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 + if leftBrace < 0 || rightBrace <= leftBrace then + None + else + let segment = lineText.Substring(leftBrace, rightBrace - leftBrace + 1) + if not (segment.Contains('=')) + || segment.Contains(':') then + None + else + let callPrefix = lineText.Substring(0, leftBrace).TrimEnd() + if String.IsNullOrWhiteSpace(callPrefix) then + None + else + let mutable finish = callPrefix.Length - 1 + while finish >= 0 && Char.IsWhiteSpace(callPrefix[finish]) do + finish <- finish - 1 + let mutable start = finish + while start >= 0 && isWordChar callPrefix[start] do + start <- start - 1 + let tokenStart = start + 1 + if tokenStart > finish then + None + else + let callTarget = callPrefix.Substring(tokenStart, finish - tokenStart + 1) + tryFindSymbolByName doc callTarget + |> Option.bind (tryFirstArgumentTypeNameFromFunctionSymbol doc) + | None -> None + + let private tryResolveRecordLiteralBindingTypeTarget (doc: DocumentState) (line: int) (character: int) = + match getLineText doc.Text line with + | Some lineText -> + let pos = max 0 (min character lineText.Length) + let leftBrace = lineText.LastIndexOf('{', max 0 (pos - 1)) + let rightBrace = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 + if leftBrace < 0 || rightBrace <= leftBrace then + None + else + let segment = lineText.Substring(leftBrace, rightBrace - leftBrace + 1) + if not (segment.Contains('=')) + || segment.Contains(':') then + None + else + let prefix = lineText.Substring(0, leftBrace).TrimEnd() + let eqIndex = prefix.LastIndexOf('=') + if eqIndex <= 0 then + None + else + let lhs = prefix.Substring(0, eqIndex).Trim() + if not (lhs.StartsWith("let ", StringComparison.Ordinal)) then + None + else + let afterLet = lhs.Substring(4).Trim() + if String.IsNullOrWhiteSpace(afterLet) then + None + else + let mutable idx = 0 + while idx < afterLet.Length && isWordChar afterLet[idx] do + idx <- idx + 1 + if idx = 0 then + None + else + let bindingName = afterLet.Substring(0, idx) + tryFindSymbolByName doc bindingName + |> Option.bind (tryResolveTypeNameFromSymbol doc) + | None -> None + + let private tryResolveRecordLiteralFunctionReturnTypeTarget (doc: DocumentState) (line: int) (character: int) = + match getLineText doc.Text line with + | None -> None + | Some lineText -> + let pos = max 0 (min character lineText.Length) + let leftBrace = lineText.LastIndexOf('{', max 0 (pos - 1)) + let rightBrace = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 + if leftBrace < 0 || rightBrace <= leftBrace then + None + else + let segment = lineText.Substring(leftBrace, rightBrace - leftBrace + 1) + if not (segment.Contains('=')) + || segment.Contains(':') then + None + else + let isInsideSpan (span: Span) = + let line1 = line + 1 + let col1 = character + 1 + let startsBefore = + line1 > span.Start.Line + || (line1 = span.Start.Line && col1 >= span.Start.Column) + let endsAfter = + line1 < span.End.Line + || (line1 = span.End.Line && col1 <= span.End.Column) + startsBefore && endsAfter + + let spansContainingPosition = + doc.Symbols + |> List.filter (fun sym -> + sym.Kind = 12 + && isInsideSpan sym.Span) + |> List.sortByDescending (fun sym -> sym.Span.Start.Line, sym.Span.Start.Column) + + spansContainingPosition + |> List.tryPick (fun sym -> + match sym.TypeTargetName with + | Some typeName -> Some typeName + | None -> + doc.FunctionDeclaredReturnTargets + |> Map.tryFind sym.Name) + + let private tryExtractInlineRecordAnnotationAtPosition (doc: DocumentState) (line: int) (character: int) = + match getLineText doc.Text line with + | None -> None + | Some lineText -> + let pos = max 0 (min character lineText.Length) + let left = lineText.LastIndexOf('{', max 0 (pos - 1)) + let right = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 + if left < 0 || right <= left then + None + else + let segment = lineText.Substring(left, right - left + 1) + if segment.Contains(':', StringComparison.Ordinal) && not (segment.Contains('=', StringComparison.Ordinal)) then + tryParseRecordFields segment + else + None + + let tryResolveTypeTargetAtPosition (doc: DocumentState) (line: int) (character: int) : string option = + let fromWord = + match tryGetWordAtPosition doc.Text line character with + | Some word when word.Contains('.') -> + let idx = word.LastIndexOf('.') + if idx > 0 then + let qualifier = word.Substring(0, idx) + tryResolveTypeNameForQualifier doc qualifier + else + None + | Some word -> + tryResolveTypeNameForQualifier doc word + | None -> None + + match fromWord with + | Some typeName -> Some typeName + | None -> + match tryExtractInlineRecordAnnotationAtPosition doc line character with + | Some fields -> + tryResolveNamedRecordTypeByFields doc fields + | None -> + match tryResolveRecordLiteralCallArgTypeTarget doc line character with + | Some t -> Some t + | None -> + match tryResolveRecordLiteralBindingTypeTarget doc line character with + | Some t -> Some t + | None -> tryResolveRecordLiteralFunctionReturnTypeTarget doc line character + + let tryGetRecordFieldHoverInfo (doc: DocumentState) (line: int) (character: int) : (string * string) option = + match tryGetWordAtPosition doc.Text line character with + | Some word when word.Contains('.') -> + let idx = word.LastIndexOf('.') + if idx <= 0 || idx + 1 >= word.Length then + None + else + let qualifier = word.Substring(0, idx) + let fieldName = word.Substring(idx + 1) + tryRecordFieldsForQualifier doc qualifier + |> Option.bind (fun fields -> + fields + |> List.tryFind (fun (name, _) -> name = fieldName)) + | _ -> + None + + let private spanContainsPosition (span: Span) (line: int) (character: int) = + let line1 = line + 1 + let col1 = character + 1 + let startsBefore = + line1 > span.Start.Line + || (line1 = span.Start.Line && col1 >= span.Start.Column) + let endsAfter = + line1 < span.End.Line + || (line1 = span.End.Line && col1 <= span.End.Column) + startsBefore && endsAfter + + let tryGetLocalVariableHoverInfo (doc: DocumentState) (line: int) (character: int) : (string * string) option = + let bySpan = + doc.LocalVariableTypeHints + |> List.tryFind (fun (span, _, _) -> spanContainsPosition span line character) + |> Option.map (fun (_, name, typeText) -> name, typeText) + + match bySpan with + | Some _ -> bySpan + | None -> + match tryGetWordAtPosition doc.Text line character with + | Some word -> + let isOnTopLevelSymbol = + doc.Symbols + |> List.exists (fun sym -> + String.Equals(sym.Name, word, StringComparison.Ordinal) + && spanContainsPosition sym.Span line character) + + if isOnTopLevelSymbol then + None + else + let candidates = + doc.LocalBindings + |> List.filter (fun binding -> + String.Equals(binding.Name, word, StringComparison.Ordinal) + && (spanContainsPosition binding.ScopeSpan line character + || spanContainsPosition binding.DeclSpan line character)) + + let scoreBinding (binding: LocalBindingInfo) = + let line1 = line + 1 + let col1 = character + 1 + let lineDistance = abs (binding.DeclSpan.Start.Line - line1) + let colDistance = abs (binding.DeclSpan.Start.Column - col1) + let startsBefore = + binding.DeclSpan.Start.Line < line1 + || (binding.DeclSpan.Start.Line = line1 && binding.DeclSpan.Start.Column <= col1) + if startsBefore then (0, lineDistance, colDistance) else (1, lineDistance, colDistance) + + let nearestBinding = + candidates + |> List.sortBy scoreBinding + |> List.tryHead + + let inferredTypeForBinding (binding: LocalBindingInfo) = + let byDeclSpan = + doc.LocalVariableTypeHints + |> List.tryFind (fun (span, name, _) -> + String.Equals(name, binding.Name, StringComparison.Ordinal) + && span.Start.Line = binding.DeclSpan.Start.Line + && span.Start.Column = binding.DeclSpan.Start.Column + && span.End.Line = binding.DeclSpan.End.Line + && span.End.Column = binding.DeclSpan.End.Column) + |> Option.map (fun (_, _, t) -> t) + + match byDeclSpan with + | Some _ -> byDeclSpan + | None -> + doc.LocalVariableTypeHints + |> List.choose (fun (span, name, t) -> + if String.Equals(name, binding.Name, StringComparison.Ordinal) + && spanContainsPosition binding.ScopeSpan (span.Start.Line - 1) (span.Start.Column - 1) then + Some t + else + None) + |> List.distinct + |> function + | [ one ] -> Some one + | _ -> None + + nearestBinding + |> Option.map (fun binding -> + let typeText = + inferredTypeForBinding binding + |> Option.orElse binding.AnnotationType + |> Option.defaultValue "unknown" + binding.Name, typeText) + | None -> + None + + let private tryMemberCompletionItems (doc: DocumentState) (prefix: string option) = + match prefix with + | Some p when p.Contains('.') -> + let idx = p.LastIndexOf('.') + if idx <= 0 then None + else + let qualifier = p.Substring(0, idx) + let memberPrefix = + if idx + 1 < p.Length then p.Substring(idx + 1) else "" + + match tryRecordFieldsForQualifier doc qualifier with + | Some fields -> + let filtered = + fields + |> List.filter (fun (name, _) -> + memberPrefix = "" || name.StartsWith(memberPrefix, StringComparison.Ordinal)) + + let items = + filtered + |> List.map (fun (name, fieldType) -> + let item = JsonObject() + item["label"] <- JsonValue.Create(name) + item["kind"] <- JsonValue.Create(10) + item["detail"] <- JsonValue.Create(fieldType) + item["filterText"] <- JsonValue.Create(name) + item["sortText"] <- JsonValue.Create($"0_{name}") + if memberPrefix = name then + item["preselect"] <- JsonValue.Create(true) + item :> JsonNode) + |> List.toArray + + Some (JsonArray(items)) + | None -> + None + | _ -> None + + let makeCompletionItems (doc: DocumentState) (prefix: string option) = + match tryMemberCompletionItems doc prefix with + | Some memberItems -> memberItems + | None -> + let symbols = doc.Symbols + let keywords = + [ "let"; "rec"; "and"; "if"; "then"; "elif"; "else"; "match"; "with"; "when" + "for"; "in"; "do"; "type"; "module"; "true"; "false"; "None"; "Some" ] + + let keywordItems = + keywords + |> List.map (fun kw -> + let item = JsonObject() + item["label"] <- JsonValue.Create(kw) + item["kind"] <- JsonValue.Create(14) + item["filterText"] <- JsonValue.Create(kw) + item["sortText"] <- JsonValue.Create($"9_{kw}") + match prefix with + | Some p when p = kw -> item["preselect"] <- JsonValue.Create(true) + | _ -> () + item) + + let namePool = + [ for s in symbols -> s.Name + for kv in doc.InjectedFunctionSignatures -> kv.Key + yield! stdlibNames + yield! builtinNames ] + |> List.distinct + + let filteredNames = + namePool + |> List.filter (fun name -> + match prefix with + | Some p when p <> "" -> + if p.Contains('.') then + // When user types a dotted qualifier, avoid flooding with unrelated names. + name.StartsWith(p, StringComparison.Ordinal) + else + name.StartsWith(p, StringComparison.Ordinal) + | _ -> true) + |> List.sortBy (fun name -> + let localPriority = + if name.Contains('.') then 1 else 0 + (localPriority, name.Length, name)) + + let symbolItems = + filteredNames + |> List.map (fun name -> + let symbolType = symbols |> List.tryFind (fun s -> s.Name = name) |> Option.bind (fun s -> s.TypeText) + let injectedType = doc.InjectedFunctionSignatures |> Map.tryFind name + let kind = + match symbols |> List.tryFind (fun s -> s.Name = name) with + | Some s -> s.Kind + | None -> + if doc.InjectedFunctionSignatures.ContainsKey(name) then 12 else 3 + let item = JsonObject() + item["label"] <- JsonValue.Create(name) + item["kind"] <- JsonValue.Create(kind) + item["filterText"] <- JsonValue.Create(name) + let sortPrefix = if name.Contains('.') then "1" else "0" + item["sortText"] <- JsonValue.Create($"{sortPrefix}_{name}") + match prefix with + | Some p when p = name -> item["preselect"] <- JsonValue.Create(true) + | _ -> () + match symbolType with + | Some t -> item["detail"] <- JsonValue.Create(t) + | None -> + match injectedType with + | Some t -> item["detail"] <- JsonValue.Create(t) + | None -> () + item) + + let rankedItems = + match prefix with + | Some p when p <> "" -> + let keywordMatches = + keywordItems + |> List.filter (fun item -> + match item["label"] with + | :? JsonValue as label -> + try + let kw = label.GetValue() + if p.Contains('.') then false + else kw.StartsWith(p, StringComparison.Ordinal) + with _ -> false + | _ -> false) + symbolItems @ keywordMatches + | _ -> + keywordItems @ symbolItems + + let nodes = rankedItems |> List.map (fun n -> n :> JsonNode) + JsonArray(nodes |> List.toArray) + + let tryGetCallTargetPrefixAtPosition (text: string) (line: int) (character: int) : string option = + match getLineText text line with + | None -> None + | Some lineText -> + if lineText.Length = 0 then None + else + let pos = max 0 (min character lineText.Length) + let mutable idx = pos - 1 + + while idx >= 0 && Char.IsWhiteSpace(lineText[idx]) do + idx <- idx - 1 + + if idx < 0 then None + else + let mutable finish = idx + 1 + let mutable start = idx + + while start >= 0 && isWordChar lineText[start] do + start <- start - 1 + + let tokenStart = start + 1 + if tokenStart < finish then Some(lineText.Substring(tokenStart, finish - tokenStart)) else None + + let findSymbolRangesInText (text: string) (candidateNames: string list) = + let names = candidateNames |> List.distinct |> Set.ofList + let lines = text.Split('\n') + + lines + |> Array.mapi (fun lineIndex rawLine -> + let line = rawLine.TrimEnd('\r') + let mutable i = 0 + let found = ResizeArray() + + while i < line.Length do + if isWordChar line[i] then + let start = i + let mutable j = i + 1 + while j < line.Length && isWordChar line[j] do + j <- j + 1 + + let token = line.Substring(start, j - start) + if names.Contains token then + let span = + Span.mk + (Span.pos (lineIndex + 1) (start + 1)) + (Span.pos (lineIndex + 1) (j + 1)) + found.Add(span) + + i <- j + else + i <- i + 1 + + found |> Seq.toList) + |> Array.toList + |> List.concat From 80708d2da06c102f233a9968bd93b01f39e15847 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 21:15:33 +0100 Subject: [PATCH 13/14] Delete old LanguageServerLegacy directory --- .../LanguageServerLegacy/AstJson.fs | 102 - .../LanguageServerLegacy/LspHandlers.fs | 1329 ---------- .../LanguageServerLegacy/LspModel.fs | 215 -- .../LanguageServerLegacy/LspProtocol.fs | 97 - .../LanguageServerLegacy/LspRuntimeExterns.fs | 8 - .../LanguageServerLegacy/LspSymbols.fs | 2186 ----------------- 6 files changed, 3937 deletions(-) delete mode 100644 src/FScript.CSharpInterop/LanguageServerLegacy/AstJson.fs delete mode 100644 src/FScript.CSharpInterop/LanguageServerLegacy/LspHandlers.fs delete mode 100644 src/FScript.CSharpInterop/LanguageServerLegacy/LspModel.fs delete mode 100644 src/FScript.CSharpInterop/LanguageServerLegacy/LspProtocol.fs delete mode 100644 src/FScript.CSharpInterop/LanguageServerLegacy/LspRuntimeExterns.fs delete mode 100644 src/FScript.CSharpInterop/LanguageServerLegacy/LspSymbols.fs diff --git a/src/FScript.CSharpInterop/LanguageServerLegacy/AstJson.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/AstJson.fs deleted file mode 100644 index 4797285..0000000 --- a/src/FScript.CSharpInterop/LanguageServerLegacy/AstJson.fs +++ /dev/null @@ -1,102 +0,0 @@ -namespace FScript.LanguageServer - -#nowarn "3261" -#nowarn "3264" - -open System -open System.Collections -open System.Text.Json.Nodes -open Microsoft.FSharp.Reflection -open FScript.Language - -module AstJson = - let private jsonNull : JsonNode = JsonValue.Create(None) - - let private isOptionType (t: System.Type) = - t.IsGenericType && t.GetGenericTypeDefinition() = typedefof> - - let rec private toJsonNodeInternal (value: objnull) : JsonNode = - match value with - | null -> jsonNull - | :? JsonNode as node -> node - | :? string as s -> JsonValue.Create(s) - | :? bool as b -> JsonValue.Create(b) - | :? int as i -> JsonValue.Create(i) - | :? int64 as i -> JsonValue.Create(i) - | :? float as f -> JsonValue.Create(f) - | :? decimal as d -> JsonValue.Create(d) - | :? char as c -> JsonValue.Create(string c) - | _ -> - let t = value.GetType() - - if isOptionType t then - let case, fields = FSharpValue.GetUnionFields(value, t, true) - if case.Name = "None" then - jsonNull - else - toJsonNodeInternal fields[0] - elif FSharpType.IsUnion(t, true) then - let case, fields = FSharpValue.GetUnionFields(value, t, true) - let result = JsonObject() - result["kind"] <- JsonValue.Create(case.Name) - let fieldInfos = case.GetFields() - for i = 0 to fields.Length - 1 do - result[fieldInfos[i].Name] <- toJsonNodeInternal fields[i] - result :> JsonNode - elif FSharpType.IsRecord(t, true) then - let result = JsonObject() - let fieldInfos = FSharpType.GetRecordFields(t, true) - let fieldValues = FSharpValue.GetRecordFields(value, true) - for i = 0 to fieldInfos.Length - 1 do - result[fieldInfos[i].Name] <- toJsonNodeInternal fieldValues[i] - result :> JsonNode - elif t.IsArray then - let result = JsonArray() - for item in value :?> IEnumerable do - result.Add(toJsonNodeInternal item) - result :> JsonNode - elif value :? IDictionary then - let result = JsonArray() - for item in value :?> IEnumerable do - let entry = item.GetType() - let keyProp = entry.GetProperty("Key") - let valueProp = entry.GetProperty("Value") - let pair = JsonObject() - let keyValue = - if isNull keyProp then null - else keyProp.GetValue(item) - let itemValue = - if isNull valueProp then null - else valueProp.GetValue(item) - pair["key"] <- toJsonNodeInternal keyValue - pair["value"] <- toJsonNodeInternal itemValue - result.Add(pair) - result :> JsonNode - elif value :? IEnumerable then - let result = JsonArray() - for item in value :?> IEnumerable do - result.Add(toJsonNodeInternal item) - result :> JsonNode - elif t.IsEnum then - JsonValue.Create(value.ToString()) - else - JsonValue.Create(value.ToString()) - - let toJsonNode (value: objnull) = - toJsonNodeInternal value - - let programToJson (sourcePath: string) (program: Program) = - let root = JsonObject() - root["version"] <- JsonValue.Create("1") - root["source"] <- JsonValue.Create(sourcePath) - root["kind"] <- JsonValue.Create("program") - root["items"] <- toJsonNode (box program) - root - - let typedProgramToJson (sourcePath: string) (typedProgram: TypeInfer.TypedProgram) = - let root = JsonObject() - root["version"] <- JsonValue.Create("1") - root["source"] <- JsonValue.Create(sourcePath) - root["kind"] <- JsonValue.Create("typedProgram") - root["items"] <- toJsonNode (box typedProgram) - root diff --git a/src/FScript.CSharpInterop/LanguageServerLegacy/LspHandlers.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspHandlers.fs deleted file mode 100644 index 9b7d391..0000000 --- a/src/FScript.CSharpInterop/LanguageServerLegacy/LspHandlers.fs +++ /dev/null @@ -1,1329 +0,0 @@ -namespace FScript.LanguageServer - -open System -open System.IO -open System.Text.Json.Nodes -open FScript.Language -open FScript.CSharpInterop - -module LspHandlers = - open LspModel - open LspSymbols - - let handleInitialize (idNode: JsonNode) (paramsObj: JsonObject option) = - match paramsObj with - | Some p -> - match tryGetObject p "initializationOptions" with - | Some init -> - match init["inlayHintsEnabled"] with - | :? JsonValue as v -> - try inlayHintsEnabled <- v.GetValue() with _ -> () - | _ -> () - | None -> () - | None -> () - - let sync = JsonObject() - sync["openClose"] <- JsonValue.Create(true) - sync["change"] <- JsonValue.Create(1) - - let completionProvider = JsonObject() - completionProvider["resolveProvider"] <- JsonValue.Create(false) - let triggerChars = JsonArray() - triggerChars.Add(JsonValue.Create(".")) - triggerChars.Add(JsonValue.Create("[")) - completionProvider["triggerCharacters"] <- triggerChars - - let serverInfo = JsonObject() - serverInfo["name"] <- JsonValue.Create("FScript Language Server") - - let capabilities = JsonObject() - capabilities["textDocumentSync"] <- sync - capabilities["completionProvider"] <- completionProvider - capabilities["hoverProvider"] <- JsonValue.Create(true) - capabilities["definitionProvider"] <- JsonValue.Create(true) - capabilities["typeDefinitionProvider"] <- JsonValue.Create(true) - capabilities["referencesProvider"] <- JsonValue.Create(true) - capabilities["documentHighlightProvider"] <- JsonValue.Create(true) - let renameProvider = JsonObject() - renameProvider["prepareProvider"] <- JsonValue.Create(true) - capabilities["renameProvider"] <- renameProvider - let signatureHelpProvider = JsonObject() - let signatureTriggers = JsonArray() - signatureTriggers.Add(JsonValue.Create("(")) - signatureTriggers.Add(JsonValue.Create(",")) - signatureHelpProvider["triggerCharacters"] <- signatureTriggers - capabilities["signatureHelpProvider"] <- signatureHelpProvider - capabilities["documentSymbolProvider"] <- JsonValue.Create(true) - capabilities["workspaceSymbolProvider"] <- JsonValue.Create(true) - capabilities["codeActionProvider"] <- JsonValue.Create(true) - capabilities["inlayHintProvider"] <- JsonValue.Create(true) - let semanticLegend = JsonObject() - let tokenTypeNodes = JsonArray() - [| "keyword"; "string"; "number"; "function"; "type"; "variable" |] - |> Array.iter (fun s -> tokenTypeNodes.Add(JsonValue.Create(s))) - semanticLegend["tokenTypes"] <- tokenTypeNodes - semanticLegend["tokenModifiers"] <- JsonArray() - let semanticProvider = JsonObject() - semanticProvider["legend"] <- semanticLegend - semanticProvider["full"] <- JsonValue.Create(true) - capabilities["semanticTokensProvider"] <- semanticProvider - - let result = JsonObject() - result["capabilities"] <- capabilities - result["serverInfo"] <- serverInfo - - LspProtocol.sendResponse idNode (Some result) - - let private keywordSet = - [ "let"; "rec"; "and"; "if"; "then"; "elif"; "else"; "match"; "with"; "when" - "for"; "in"; "do"; "type"; "module"; "true"; "false"; "None"; "Some" - "fun"; "raise"; "import"; "export"; "qualified" ] - |> Set.ofList - - let private classifyToken (line: string) (startIndex: int) (token: string) = - let isFunctionCallToken () = - let mutable i = startIndex + token.Length - while i < line.Length && Char.IsWhiteSpace(line[i]) do - i <- i + 1 - i < line.Length && line[i] = '(' - - if keywordSet.Contains(token) then 0 - elif token.Length > 1 && token.StartsWith("\"") && token.EndsWith("\"") then 1 - elif token |> Seq.forall Char.IsDigit then 2 - elif isFunctionCallToken () then 3 - elif token.Contains('.') then - let tail = token.Split('.') |> Array.last - if tail.Length > 0 && Char.IsLower(tail[0]) then 3 else 4 - elif token.Length > 0 && Char.IsUpper(token[0]) then 4 - else 5 - - let private scanSemanticTokens (text: string) = - let lines = text.Split('\n') - let mutable previousLine = 0 - let mutable previousStart = 0 - let data = ResizeArray() - - for lineIndex = 0 to lines.Length - 1 do - let line = lines[lineIndex].TrimEnd('\r') - let mutable i = 0 - while i < line.Length do - let c = line[i] - if Char.IsWhiteSpace(c) then - i <- i + 1 - elif c = '/' && i + 1 < line.Length && line[i + 1] = '/' then - i <- line.Length - elif c = '"' then - let start = i - i <- i + 1 - while i < line.Length && line[i] <> '"' do - i <- i + 1 - if i < line.Length then i <- i + 1 - let length = i - start - let deltaLine = lineIndex - previousLine - let deltaStart = if deltaLine = 0 then start - previousStart else start - data.Add(deltaLine) - data.Add(deltaStart) - data.Add(length) - data.Add(1) - data.Add(0) - previousLine <- lineIndex - previousStart <- start - elif Char.IsLetter(c) || c = '_' then - let start = i - i <- i + 1 - while i < line.Length && (Char.IsLetterOrDigit(line[i]) || line[i] = '_' || line[i] = '.') do - i <- i + 1 - let token = line.Substring(start, i - start) - let tokenType = classifyToken line start token - let deltaLine = lineIndex - previousLine - let deltaStart = if deltaLine = 0 then start - previousStart else start - data.Add(deltaLine) - data.Add(deltaStart) - data.Add(token.Length) - data.Add(tokenType) - data.Add(0) - previousLine <- lineIndex - previousStart <- start - elif Char.IsDigit(c) then - let start = i - i <- i + 1 - while i < line.Length && (Char.IsDigit(line[i]) || line[i] = '.') do - i <- i + 1 - let length = i - start - let deltaLine = lineIndex - previousLine - let deltaStart = if deltaLine = 0 then start - previousStart else start - data.Add(deltaLine) - data.Add(deltaStart) - data.Add(length) - data.Add(2) - data.Add(0) - previousLine <- lineIndex - previousStart <- start - else - i <- i + 1 - - data - - let handleSemanticTokens (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | Some uri when documents.ContainsKey(uri) -> - let doc = documents[uri] - let data: JsonNode array = - scanSemanticTokens doc.Text - |> Seq.map (fun n -> JsonValue.Create(n) :> JsonNode) - |> Seq.toArray - let result = JsonObject() - result["data"] <- JsonArray(data) - LspProtocol.sendResponse idNode (Some result) - | _ -> - let result = JsonObject() - result["data"] <- JsonArray() - LspProtocol.sendResponse idNode (Some result) - - let private positionInRange (line: int) (character: int) (sl: int, sc: int, el: int, ec: int) = - let afterStart = line > sl || (line = sl && character >= sc) - let beforeEnd = line < el || (line = el && character <= ec) - afterStart && beforeEnd - - let private trimOuterParens (text: string) = - let rec trim (value: string) = - let trimmed = value.Trim() - if trimmed.Length >= 2 && trimmed[0] = '(' && trimmed[trimmed.Length - 1] = ')' then - let mutable depth = 0 - let mutable enclosesAll = true - let mutable i = 0 - while i < trimmed.Length && enclosesAll do - let c = trimmed[i] - if c = '(' then depth <- depth + 1 - elif c = ')' then - depth <- depth - 1 - if depth = 0 && i < trimmed.Length - 1 then - enclosesAll <- false - i <- i + 1 - if enclosesAll then trim (trimmed.Substring(1, trimmed.Length - 2)) - else trimmed - else - trimmed - trim text - - let private splitTopLevelArrows (typeText: string) = - let typeText = trimOuterParens typeText - let parts = ResizeArray() - let mutable depthParen = 0 - let mutable depthBrace = 0 - let mutable depthBracket = 0 - let mutable start = 0 - let mutable i = 0 - while i < typeText.Length do - let c = typeText[i] - match c with - | '(' -> depthParen <- depthParen + 1 - | ')' when depthParen > 0 -> depthParen <- depthParen - 1 - | '{' -> depthBrace <- depthBrace + 1 - | '}' when depthBrace > 0 -> depthBrace <- depthBrace - 1 - | '[' -> depthBracket <- depthBracket + 1 - | ']' when depthBracket > 0 -> depthBracket <- depthBracket - 1 - | '-' when i + 1 < typeText.Length && typeText[i + 1] = '>' && depthParen = 0 && depthBrace = 0 && depthBracket = 0 -> - let chunk = typeText.Substring(start, i - start).Trim() - if chunk <> "" then - parts.Add(chunk) - i <- i + 1 - start <- i + 1 - | _ -> () - i <- i + 1 - - if start <= typeText.Length then - let tail = typeText.Substring(start).Trim() - if tail <> "" then - parts.Add(tail) - - parts |> Seq.toList - - let private flattenArrowParts (typeText: string) = - let rec flatten (text: string) = - let parts = splitTopLevelArrows text - match parts with - | [] -> [] - | [ single ] -> - let trimmed = trimOuterParens single - if String.Equals(trimmed, single, StringComparison.Ordinal) then - [ trimmed ] - else - flatten trimmed - | first :: rest when rest.Length = 1 -> - first :: flatten rest[0] - | _ -> - parts - flatten typeText - - let private formatNamedArrowSignature (names: string list) (typeText: string) = - let parts = flattenArrowParts typeText - if parts.Length = (names.Length + 1) then - let args = - [ 0 .. names.Length - 1 ] - |> List.map (fun i -> $"({names[i]}: {parts[i]})") - String.concat " -> " (args @ [ parts[parts.Length - 1] ]) - else - typeText - - let private formatFunctionSignature (doc: DocumentState) (sym: TopLevelSymbol) = - let paramNames = doc.FunctionParameters |> Map.tryFind sym.Name |> Option.defaultValue [] - - match sym.TypeText with - | Some typeText when sym.Kind = 12 && not paramNames.IsEmpty -> - let parts = flattenArrowParts typeText - if parts.Length = (paramNames.Length + 1) then - let effectiveParts = - match sym.TypeTargetName with - | Some returnName when parts.Length > 0 -> - (parts |> List.take (parts.Length - 1)) @ [ returnName ] - | _ -> parts - let arrowText = - if effectiveParts.Length = (paramNames.Length + 1) then - let args = - [ 0 .. paramNames.Length - 1 ] - |> List.map (fun i -> $"({paramNames[i]}: {effectiveParts[i]})") - String.concat " -> " (args @ [ effectiveParts[effectiveParts.Length - 1] ]) - else - String.concat " -> " effectiveParts - $"{sym.Name}: {arrowText}" - else - $"{sym.Name} : {typeText}" - | Some typeText -> - $"{sym.Name} : {typeText}" - | None when sym.Kind = 12 && not paramNames.IsEmpty -> - match doc.FunctionAnnotationTypes |> Map.tryFind sym.Name with - | Some annotated when annotated.Length = paramNames.Length -> - let returnType = - doc.FunctionDeclaredReturnTargets - |> Map.tryFind sym.Name - |> Option.defaultValue "unknown" - let parts = annotated @ [ returnType ] - let arrowText = - if parts.Length = (paramNames.Length + 1) then - let args = - [ 0 .. paramNames.Length - 1 ] - |> List.map (fun i -> $"({paramNames[i]}: {parts[i]})") - String.concat " -> " (args @ [ parts[parts.Length - 1] ]) - else - String.concat " -> " parts - $"{sym.Name}: {arrowText}" - | _ -> - let args = paramNames |> List.map (fun name -> $"({name})") |> String.concat " " - $"{sym.Name} {args}" - | None -> - sym.Name - - let private formatInjectedFunctionSignature (doc: DocumentState) (name: string) (typeText: string) = - match doc.InjectedFunctionParameterNames |> Map.tryFind name with - | Some parameterNames when not parameterNames.IsEmpty -> - let namedSignature = formatNamedArrowSignature parameterNames typeText - $"{name}: {namedSignature}" - | _ -> - $"{name} : {typeText}" - - let handleInlayHints (idNode: JsonNode) (paramsObj: JsonObject) = - if not inlayHintsEnabled then - LspProtocol.sendResponse idNode (Some (JsonArray())) - else - match tryGetUriFromTextDocument paramsObj with - | Some uri when documents.ContainsKey(uri) -> - let doc = documents[uri] - let (startLine, startChar, endLine, endChar) = - tryGetRange paramsObj |> Option.defaultValue (0, 0, Int32.MaxValue, Int32.MaxValue) - - let hints = ResizeArray() - - // Type hints for value bindings based on inferred top-level symbol types. - doc.Symbols - |> List.iter (fun sym -> - if sym.Kind = 13 && not (sym.Name.Contains('.')) then - match sym.TypeText with - | Some typeText -> - let hintLine = max 0 (sym.Span.End.Line - 1) - let hintChar = max 0 (sym.Span.End.Column - 1) - if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then - let hint = JsonObject() - let pos = JsonObject() - pos["line"] <- JsonValue.Create(hintLine) - pos["character"] <- JsonValue.Create(hintChar) - hint["position"] <- pos - hint["label"] <- JsonValue.Create($": {typeText}") - hint["kind"] <- JsonValue.Create(1) - hint["paddingLeft"] <- JsonValue.Create(true) - hints.Add(hint :> JsonNode) - | None -> ()) - - // Type hints for function/lambda parameters inferred by the typechecker. - doc.ParameterTypeHints - |> List.iter (fun (span, label) -> - let hintLine = max 0 (span.End.Line - 1) - let hintChar = max 0 (span.End.Column - 1) - if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then - let hint = JsonObject() - let pos = JsonObject() - pos["line"] <- JsonValue.Create(hintLine) - pos["character"] <- JsonValue.Create(hintChar) - hint["position"] <- pos - hint["label"] <- JsonValue.Create(label) - hint["kind"] <- JsonValue.Create(1) - hint["paddingLeft"] <- JsonValue.Create(true) - hints.Add(hint :> JsonNode)) - - // Return type hints for function declarations. - doc.FunctionReturnTypeHints - |> List.iter (fun (span, label) -> - let hintLine = max 0 (span.End.Line - 1) - let hintChar = max 0 (span.End.Column - 1) - if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then - let hint = JsonObject() - let pos = JsonObject() - pos["line"] <- JsonValue.Create(hintLine) - pos["character"] <- JsonValue.Create(hintChar) - hint["position"] <- pos - hint["label"] <- JsonValue.Create(label) - hint["kind"] <- JsonValue.Create(1) - hint["paddingLeft"] <- JsonValue.Create(true) - hints.Add(hint :> JsonNode)) - - // Type hints for pattern-bound variables (for example: `Some x`). - doc.PatternTypeHints - |> List.iter (fun (span, label) -> - let hintLine = max 0 (span.End.Line - 1) - let hintChar = max 0 (span.End.Column - 1) - if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then - let hint = JsonObject() - let pos = JsonObject() - pos["line"] <- JsonValue.Create(hintLine) - pos["character"] <- JsonValue.Create(hintChar) - hint["position"] <- pos - hint["label"] <- JsonValue.Create(label) - hint["kind"] <- JsonValue.Create(1) - hint["paddingLeft"] <- JsonValue.Create(true) - hints.Add(hint :> JsonNode)) - - doc.CallArgumentHints - |> List.iter (fun (span, label) -> - let hintLine = max 0 (span.Start.Line - 1) - let hintChar = max 0 (span.Start.Column - 1) - if positionInRange hintLine hintChar (startLine, startChar, endLine, endChar) then - let hint = JsonObject() - let pos = JsonObject() - pos["line"] <- JsonValue.Create(hintLine) - pos["character"] <- JsonValue.Create(hintChar) - hint["position"] <- pos - hint["label"] <- JsonValue.Create(label) - hint["kind"] <- JsonValue.Create(2) - hint["paddingRight"] <- JsonValue.Create(true) - hints.Add(hint :> JsonNode)) - - LspProtocol.sendResponse idNode (Some (JsonArray(hints.ToArray()))) - | _ -> - LspProtocol.sendResponse idNode (Some (JsonArray())) - - let handleDidOpen (paramsObj: JsonObject) = - match tryGetObject paramsObj "textDocument" with - | Some textDocument -> - match tryGetString textDocument "uri", tryGetString textDocument "text" with - | Some uri, Some text -> analyzeDocument uri text - | _ -> () - | None -> () - - let handleDidChange (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | None -> () - | Some uri -> - match paramsObj["contentChanges"] with - | :? JsonArray as changes -> - let mutable latest: string option = None - for change in changes do - match change with - | :? JsonObject as changeObj -> - match tryGetString changeObj "text" with - | Some text -> latest <- Some text - | None -> () - | _ -> () - - match latest with - | Some text -> analyzeDocument uri text - | None -> () - | _ -> () - - let handleDidClose (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | Some uri -> - documents.Remove(uri) |> ignore - publishDiagnostics uri [] - | None -> () - - let private tryGetCommandUri (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | Some uri -> Some uri - | None -> tryGetString paramsObj "uri" - - let private sendCommandError (idNode: JsonNode) (kind: string) (message: string) = - let errorObj = JsonObject() - errorObj["message"] <- JsonValue.Create(message) - errorObj["kind"] <- JsonValue.Create(kind) - let response = JsonObject() - response["ok"] <- JsonValue.Create(false) - response["error"] <- errorObj - LspProtocol.sendResponse idNode (Some response) - - let private tryLoadSourceForUri (uri: string) = - if documents.ContainsKey(uri) then - Some documents[uri].Text - else - try - let filePath = Uri(uri).LocalPath - if File.Exists(filePath) then - Some (File.ReadAllText(filePath)) - else - None - with _ -> - None - - let handleViewAst (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetCommandUri paramsObj with - | None -> - sendCommandError idNode "internal" "Missing document URI." - | Some uri -> - try - let uriObj = Uri(uri) - if not (String.Equals(uriObj.Scheme, "file", StringComparison.OrdinalIgnoreCase)) then - sendCommandError idNode "internal" "AST commands support file-based scripts only." - else - let sourcePath = uriObj.LocalPath - match tryLoadSourceForUri uri with - | None -> - sendCommandError idNode "internal" $"Unable to read source file '{sourcePath}'." - | Some sourceText -> - let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath sourceText - let response = JsonObject() - response["ok"] <- JsonValue.Create(true) - response["data"] <- AstJson.programToJson sourcePath program - LspProtocol.sendResponse idNode (Some response) - with - | :? ParseException as ex -> - sendCommandError idNode "parse" ex.Message - | ex -> - sendCommandError idNode "internal" ex.Message - - let handleViewInferredAst (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetCommandUri paramsObj with - | None -> - sendCommandError idNode "internal" "Missing document URI." - | Some uri -> - try - let uriObj = Uri(uri) - if not (String.Equals(uriObj.Scheme, "file", StringComparison.OrdinalIgnoreCase)) then - sendCommandError idNode "internal" "AST commands support file-based scripts only." - else - let sourcePath = uriObj.LocalPath - match tryLoadSourceForUri uri with - | None -> - sendCommandError idNode "internal" $"Unable to read source file '{sourcePath}'." - | Some sourceText -> - let program = InteropServices.parseProgramFromSourceWithIncludes sourcePath sourceText - let runtimeExterns = LspRuntimeExterns.forSourcePath sourcePath - let typedProgram = InteropServices.inferProgramWithExterns runtimeExterns program - let response = JsonObject() - response["ok"] <- JsonValue.Create(true) - response["data"] <- AstJson.typedProgramToJson sourcePath typedProgram - LspProtocol.sendResponse idNode (Some response) - with - | :? ParseException as ex -> - sendCommandError idNode "parse" ex.Message - | :? TypeException as ex -> - sendCommandError idNode "type" ex.Message - | ex -> - sendCommandError idNode "internal" ex.Message - - let handleHover (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - match tryGetRecordFieldHoverInfo doc line character with - | Some (fieldName, fieldType) -> - let contents = JsonObject() - contents["kind"] <- JsonValue.Create("markdown") - contents["value"] <- JsonValue.Create($"```fscript\n{fieldName} : {fieldType}\n```\nrecord-field") - let result = JsonObject() - result["contents"] <- contents - LspProtocol.sendResponse idNode (Some result) - | None -> - match tryGetLocalVariableHoverInfo doc line character with - | Some (name, typeText) -> - let contents = JsonObject() - contents["kind"] <- JsonValue.Create("markdown") - contents["value"] <- JsonValue.Create($"```fscript\n{name} : {typeText}\n```\nlocal-variable") - let result = JsonObject() - result["contents"] <- contents - LspProtocol.sendResponse idNode (Some result) - | None -> - match tryResolveSymbol doc line character with - | Some sym -> - let signature = formatFunctionSignature doc sym - - let contents = JsonObject() - contents["kind"] <- JsonValue.Create("markdown") - let kindLine = symbolKindLabel sym.Kind - let locationLine = $"defined at L{sym.Span.Start.Line}:C{sym.Span.Start.Column}" - contents["value"] <- JsonValue.Create($"```fscript\n{signature}\n```\n{kindLine}\n\n{locationLine}") - - let result = JsonObject() - result["contents"] <- contents - LspProtocol.sendResponse idNode (Some result) - | None -> - match tryGetWordAtPosition doc.Text line character with - | Some word -> - let candidates = - if word.Contains('.') then - [ word - word.Split('.') |> Array.last ] - else - [ word ] - let injectedMatch = - candidates - |> List.tryPick (fun candidate -> - doc.InjectedFunctionSignatures - |> Map.tryFind candidate - |> Option.map (fun t -> candidate, t)) - match injectedMatch with - | Some (name, typeText) -> - let contents = JsonObject() - contents["kind"] <- JsonValue.Create("markdown") - let signature = formatInjectedFunctionSignature doc name typeText - contents["value"] <- JsonValue.Create($"```fscript\n{signature}\n```\ninjected-function") - let result = JsonObject() - result["contents"] <- contents - LspProtocol.sendResponse idNode (Some result) - | None -> - LspProtocol.sendResponse idNode None - | None -> - LspProtocol.sendResponse idNode None - | _ -> LspProtocol.sendResponse idNode None - - - let private tryResolveIncludeLocation (sourceUri: string) (doc: DocumentState) (line: int) (character: int) : JsonObject option = - match getLineText doc.Text line with - | None -> None - | Some lineText -> - let trimmed = lineText.TrimStart() - if not (trimmed.StartsWith("import", StringComparison.Ordinal)) then - None - else - let firstQuote = lineText.IndexOf('"') - if firstQuote < 0 then None - else - let secondQuote = lineText.IndexOf('"', firstQuote + 1) - if secondQuote <= firstQuote then None - else - let insideLiteral = character >= (firstQuote + 1) && character <= secondQuote - if not insideLiteral then - None - else - let includePath = lineText.Substring(firstQuote + 1, secondQuote - firstQuote - 1) - if String.IsNullOrWhiteSpace(includePath) then - None - else - try - let fullPath = - if Path.IsPathRooted(includePath) then - Path.GetFullPath(includePath) - else - if sourceUri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then - let sourcePath = Uri(sourceUri).LocalPath - match Path.GetDirectoryName(sourcePath) with - | null -> Path.GetFullPath(includePath) - | baseDir when String.IsNullOrWhiteSpace(baseDir) -> Path.GetFullPath(includePath) - | baseDir -> Path.GetFullPath(Path.Combine(baseDir, includePath)) - else - includePath - - if File.Exists(fullPath) then - let loc = JsonObject() - loc["uri"] <- JsonValue.Create(Uri(fullPath).AbsoluteUri) - let startPos = Span.pos 1 1 - loc["range"] <- toLspRange (Span.mk startPos startPos) - Some loc - else - None - with _ -> - None - - let private tryUriFromSpanFile (fallbackUri: string) (span: Span) = - match span.Start.File with - | Some filePath when not (String.IsNullOrWhiteSpace(filePath)) -> - try Some (Uri(filePath).AbsoluteUri) with _ -> Some fallbackUri - | _ -> - Some fallbackUri - - let handleDefinition (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - match tryResolveIncludeLocation uri doc line character with - | Some includeLoc -> - LspProtocol.sendResponse idNode (Some includeLoc) - | None -> - let localSymbol = tryResolveSymbol doc line character - let wordAtCursor = tryGetWordAtPosition doc.Text line character - - let symbolAndUri = - match localSymbol with - | Some sym -> - match tryUriFromSpanFile uri sym.Span with - | Some targetUri -> Some (targetUri, sym) - | None -> Some (uri, sym) - | None -> - match wordAtCursor with - | Some word -> - documents - |> Seq.tryPick (fun kv -> - kv.Value.Symbols - |> List.tryFind (fun s -> s.Name = word) - |> Option.map (fun s -> kv.Key, s)) - | None -> None - - match symbolAndUri with - | Some (targetUri, sym) -> - let loc = JsonObject() - loc["uri"] <- JsonValue.Create(targetUri) - loc["range"] <- toLspRange sym.Span - LspProtocol.sendResponse idNode (Some loc) - | None -> - let injectedDefinition = - match wordAtCursor with - | Some word -> - let candidates = - if word.Contains('.') then - [ word; word.Split('.') |> Array.last ] - else - [ word ] - - candidates - |> List.tryPick (fun candidate -> - doc.InjectedFunctionDefinitions - |> Map.tryFind candidate - |> Option.map (fun target -> candidate, target)) - | None -> - None - - match injectedDefinition with - | Some (_, (targetUri, targetSpan)) -> - let loc = JsonObject() - loc["uri"] <- JsonValue.Create(targetUri) - loc["range"] <- toLspRange targetSpan - LspProtocol.sendResponse idNode (Some loc) - | None -> - match tryResolveTypeTargetAtPosition doc line character with - | Some typeName -> - match doc.Symbols |> List.tryFind (fun s -> s.Kind = 5 && s.Name = typeName) with - | Some typeSym -> - let loc = JsonObject() - let targetUri = - tryUriFromSpanFile uri typeSym.Span - |> Option.defaultValue uri - loc["uri"] <- JsonValue.Create(targetUri) - loc["range"] <- toLspRange typeSym.Span - LspProtocol.sendResponse idNode (Some loc) - | None -> - LspProtocol.sendResponse idNode None - | None -> - LspProtocol.sendResponse idNode None - | _ -> LspProtocol.sendResponse idNode None - - let handleTypeDefinition (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - let targetTypeName = - match tryResolveSymbol doc line character with - | Some sym -> - match sym.TypeTargetName with - | Some name -> Some name - | None -> - sym.TypeText - |> Option.bind (fun t -> - doc.Symbols - |> List.tryFind (fun s -> s.Kind = 5 && s.Name = t) - |> Option.map (fun s -> s.Name)) - | None -> - tryResolveTypeTargetAtPosition doc line character - - match targetTypeName with - | Some typeName -> - match doc.Symbols |> List.tryFind (fun s -> s.Kind = 5 && s.Name = typeName) with - | Some typeSym -> - let loc = JsonObject() - let targetUri = - tryUriFromSpanFile uri typeSym.Span - |> Option.defaultValue uri - loc["uri"] <- JsonValue.Create(targetUri) - loc["range"] <- toLspRange typeSym.Span - LspProtocol.sendResponse idNode (Some loc) - | None -> - LspProtocol.sendResponse idNode None - | None -> - LspProtocol.sendResponse idNode None - | _ -> - LspProtocol.sendResponse idNode None - - let handleCompletion (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | Some uri when documents.ContainsKey(uri) -> - let doc = documents[uri] - let prefix = - match tryGetPosition paramsObj with - | Some (line, character) -> tryGetWordPrefixAtPosition doc.Text line character - | None -> None - - let items = makeCompletionItems doc prefix - let result = JsonObject() - result["isIncomplete"] <- JsonValue.Create(false) - result["items"] <- items - LspProtocol.sendResponse idNode (Some result) - | _ -> - let result = JsonObject() - result["isIncomplete"] <- JsonValue.Create(false) - result["items"] <- JsonArray() - LspProtocol.sendResponse idNode (Some result) - - let handleDocumentSymbol (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | Some uri when documents.ContainsKey(uri) -> - let symbols = - documents[uri].Symbols - |> List.map (fun s -> - let d = JsonObject() - d["name"] <- JsonValue.Create(s.Name) - d["kind"] <- JsonValue.Create(s.Kind) - d["range"] <- toLspRange s.Span - d["selectionRange"] <- toLspRange s.Span - d) - - let nodes = symbols |> List.map (fun s -> s :> JsonNode) |> List.toArray - LspProtocol.sendResponse idNode (Some (JsonArray(nodes))) - | _ -> LspProtocol.sendResponse idNode (Some (JsonArray())) - - let private resolveTargetNames (doc: DocumentState) line character = - match tryResolveSymbol doc line character with - | Some sym -> - let normalized = - if sym.Name.Contains('.') then sym.Name.Split('.') |> Array.last - else sym.Name - [ sym.Name; normalized ] - | None -> - match tryGetWordAtPosition doc.Text line character with - | Some word -> - let normalized = - if word.Contains('.') then word.Split('.') |> Array.last - else word - [ word; normalized ] - | None -> [] - - let handleReferences (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - let targetNames = resolveTargetNames doc line character - let includeDeclaration = - match tryGetObject paramsObj "context" with - | Some contextObj -> - match contextObj["includeDeclaration"] with - | :? JsonValue as v -> - try v.GetValue() with _ -> true - | _ -> true - | None -> true - - match targetNames with - | head :: _ -> - let normalized = - if head.Contains('.') then head.Split('.') |> Array.last - else head - - let declarationSpansByUri = - documents - |> Seq.map (fun kv -> - let docUri = kv.Key - let spans = - kv.Value.Symbols - |> List.choose (fun s -> - let symbolNormalized = - if s.Name.Contains('.') then s.Name.Split('.') |> Array.last - else s.Name - if s.Name = head || s.Name = normalized || symbolNormalized = normalized then - Some s.Span - else - None) - |> Set.ofList - docUri, spans) - |> Map.ofSeq - - let locations = - documents - |> Seq.collect (fun kv -> - let docUri = kv.Key - let candidateDoc = kv.Value - let fromOccurrences = - [ head; normalized ] - |> List.distinct - |> List.collect (fun n -> candidateDoc.VariableOccurrences |> Map.tryFind n |> Option.defaultValue []) - |> List.distinct - - let spans = - if fromOccurrences.IsEmpty then - findSymbolRangesInText candidateDoc.Text (targetNames @ [ normalized ]) - else - fromOccurrences - - let filteredSpans = - if includeDeclaration then - spans - else - let decls = declarationSpansByUri |> Map.tryFind docUri |> Option.defaultValue Set.empty - spans |> List.filter (fun span -> not (decls.Contains span)) - - filteredSpans - |> List.map (fun span -> - let loc = JsonObject() - loc["uri"] <- JsonValue.Create(docUri) - loc["range"] <- toLspRange span - loc :> JsonNode)) - |> Seq.toArray - - LspProtocol.sendResponse idNode (Some (JsonArray(locations))) - | [] -> - LspProtocol.sendResponse idNode (Some (JsonArray())) - | _ -> - LspProtocol.sendResponse idNode (Some (JsonArray())) - - let handleDocumentHighlight (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - let targetNames = resolveTargetNames doc line character - - match targetNames with - | head :: _ -> - let normalized = - if head.Contains('.') then head.Split('.') |> Array.last - else head - - let fromOccurrences = - [ head; normalized ] - |> List.distinct - |> List.collect (fun n -> doc.VariableOccurrences |> Map.tryFind n |> Option.defaultValue []) - |> List.distinct - - let spans = - if fromOccurrences.IsEmpty then - findSymbolRangesInText doc.Text (targetNames @ [ normalized ]) - else - fromOccurrences - - let highlights = - spans - |> List.map (fun span -> - let highlight = JsonObject() - highlight["range"] <- toLspRange span - highlight["kind"] <- JsonValue.Create(1) - highlight :> JsonNode) - |> List.toArray - - LspProtocol.sendResponse idNode (Some (JsonArray(highlights))) - | [] -> - LspProtocol.sendResponse idNode (Some (JsonArray())) - | _ -> - LspProtocol.sendResponse idNode (Some (JsonArray())) - - let handleSignatureHelp (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - let tryResolveCallTargetFromInvocation () = - match getLineText doc.Text line with - | None -> None - | Some lineText -> - let pos = max 0 (min character lineText.Length) - let mutable idx = pos - 1 - let mutable closeDepth = 0 - let mutable openIdx = -1 - - while idx >= 0 && openIdx < 0 do - match lineText[idx] with - | ')' -> closeDepth <- closeDepth + 1 - | '(' -> - if closeDepth = 0 then - openIdx <- idx - else - closeDepth <- closeDepth - 1 - | _ -> () - idx <- idx - 1 - - if openIdx <= 0 then None - else - let mutable finish = openIdx - while finish > 0 && Char.IsWhiteSpace(lineText[finish - 1]) do - finish <- finish - 1 - let mutable start = finish - 1 - while start >= 0 && isWordChar lineText[start] do - start <- start - 1 - let tokenStart = start + 1 - if tokenStart < finish then - Some (lineText.Substring(tokenStart, finish - tokenStart)) - else - None - - let computeActiveParameter () = - match getLineText doc.Text line with - | None -> 0 - | Some lineText -> - let pos = max 0 (min character lineText.Length) - let mutable idx = pos - 1 - let mutable closeDepth = 0 - let mutable openIdx = -1 - - while idx >= 0 && openIdx < 0 do - match lineText[idx] with - | ')' -> closeDepth <- closeDepth + 1 - | '(' -> - if closeDepth = 0 then - openIdx <- idx - else - closeDepth <- closeDepth - 1 - | _ -> () - idx <- idx - 1 - - if openIdx < 0 then 0 - else - let mutable depthParen = 0 - let mutable depthBracket = 0 - let mutable depthBrace = 0 - let mutable commas = 0 - let mutable i = openIdx + 1 - - while i < pos do - match lineText[i] with - | '(' -> depthParen <- depthParen + 1 - | ')' -> if depthParen > 0 then depthParen <- depthParen - 1 - | '[' -> depthBracket <- depthBracket + 1 - | ']' -> if depthBracket > 0 then depthBracket <- depthBracket - 1 - | '{' -> depthBrace <- depthBrace + 1 - | '}' -> if depthBrace > 0 then depthBrace <- depthBrace - 1 - | ',' when depthParen = 0 && depthBracket = 0 && depthBrace = 0 -> - commas <- commas + 1 - | _ -> () - i <- i + 1 - - commas - - let callTarget = - match tryGetContextTriggerCharacter paramsObj with - | Some "(" -> tryGetCallTargetPrefixAtPosition doc.Text line (character - 1) - | Some "," -> tryGetCallTargetPrefixAtPosition doc.Text line (character - 1) - | _ -> tryGetCallTargetPrefixAtPosition doc.Text line character - - let resolvedCallTarget = - match callTarget with - | Some c -> Some c - | None -> - match tryGetWordAtPosition doc.Text line (max 0 (character - 1)) with - | Some w -> Some w - | None -> tryResolveCallTargetFromInvocation () - - match resolvedCallTarget with - | Some target -> - let normalize (name: string) = - if name.Contains('.') then name.Split('.') |> Array.last - else name - - let targetNormalized = normalize target - let matched = - doc.Symbols - |> List.tryFind (fun s -> s.Name = target || normalize s.Name = targetNormalized) - - match matched with - | Some sym -> - let signatureLabel = - match sym.TypeText with - | Some t -> $"{sym.Name} : {t}" - | None -> sym.Name - - let sigInfo = JsonObject() - sigInfo["label"] <- JsonValue.Create(signatureLabel) - - let signatureHelp = JsonObject() - signatureHelp["signatures"] <- JsonArray([| sigInfo :> JsonNode |]) - signatureHelp["activeSignature"] <- JsonValue.Create(0) - signatureHelp["activeParameter"] <- JsonValue.Create(computeActiveParameter ()) - LspProtocol.sendResponse idNode (Some signatureHelp) - | None -> - let injectedSignature = - [ target; targetNormalized ] - |> List.tryPick (fun candidate -> - doc.InjectedFunctionSignatures |> Map.tryFind candidate) - - match injectedSignature with - | Some typeText -> - let signature = - let normalizedTarget = - if target.Contains('.') then target.Split('.') |> Array.last - else target - - if doc.InjectedFunctionSignatures.ContainsKey(target) then - formatInjectedFunctionSignature doc target typeText - elif doc.InjectedFunctionSignatures.ContainsKey(normalizedTarget) then - formatInjectedFunctionSignature doc normalizedTarget typeText - else - $"{target} : {typeText}" - - let sigInfo = JsonObject() - sigInfo["label"] <- JsonValue.Create(signature) - - let signatureHelp = JsonObject() - signatureHelp["signatures"] <- JsonArray([| sigInfo :> JsonNode |]) - signatureHelp["activeSignature"] <- JsonValue.Create(0) - signatureHelp["activeParameter"] <- JsonValue.Create(computeActiveParameter ()) - LspProtocol.sendResponse idNode (Some signatureHelp) - | None -> - LspProtocol.sendResponse idNode None - | None -> - LspProtocol.sendResponse idNode None - | _ -> - LspProtocol.sendResponse idNode None - - let handleStdlibSource (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetString paramsObj "uri" with - | None -> - sendCommandError idNode "internal" "Missing stdlib URI." - | Some uri -> - match InteropServices.tryLoadStdlibSourceText uri with - | Some sourceText -> - let response = JsonObject() - response["ok"] <- JsonValue.Create(true) - let data = JsonObject() - data["uri"] <- JsonValue.Create(uri) - data["text"] <- JsonValue.Create(sourceText) - data["languageId"] <- JsonValue.Create("fscript") - response["data"] <- data - LspProtocol.sendResponse idNode (Some response) - | None -> - sendCommandError idNode "internal" $"Unable to load stdlib source for '{uri}'." - - let handleRename (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj, tryGetString paramsObj "newName" with - | Some _, Some _, Some newName when not (isValidIdentifierName newName) -> - LspProtocol.sendError idNode -32602 $"Invalid rename target '{newName}'" - | Some uri, Some (line, character), Some newName when documents.ContainsKey(uri) -> - let doc = documents[uri] - - let targetNames = resolveTargetNames doc line character - - match targetNames with - | [] -> LspProtocol.sendResponse idNode None - | _ -> - let normalizedNames = - targetNames - |> List.collect (fun n -> - if n.Contains('.') then [ n; n.Split('.') |> Array.last ] else [ n ]) - |> List.distinct - - let changes = JsonObject() - - documents - |> Seq.iter (fun kv -> - let docUri = kv.Key - let candidateDoc = kv.Value - let fromOccurrences = - normalizedNames - |> List.collect (fun n -> candidateDoc.VariableOccurrences |> Map.tryFind n |> Option.defaultValue []) - |> List.distinct - - let spans = - if fromOccurrences.IsEmpty then - findSymbolRangesInText candidateDoc.Text targetNames - else - fromOccurrences - - if not spans.IsEmpty then - let edits = - spans - |> List.map (fun span -> - let edit = JsonObject() - edit["range"] <- toLspRange span - edit["newText"] <- JsonValue.Create(newName) - edit :> JsonNode) - |> List.toArray - changes[docUri] <- JsonArray(edits)) - - let workspaceEdit = JsonObject() - workspaceEdit["changes"] <- changes - LspProtocol.sendResponse idNode (Some workspaceEdit) - | _ -> - LspProtocol.sendResponse idNode None - - let handlePrepareRename (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj, tryGetPosition paramsObj with - | Some uri, Some (line, character) when documents.ContainsKey(uri) -> - let doc = documents[uri] - match tryGetWordAtPosition doc.Text line character with - | Some word when isValidIdentifierName word -> - let lineText = getLineText doc.Text line |> Option.defaultValue "" - let pos = max 0 (min character lineText.Length) - let mutable start = pos - while start > 0 && isWordChar lineText[start - 1] do - start <- start - 1 - let mutable finish = pos - while finish < lineText.Length && isWordChar lineText[finish] do - finish <- finish + 1 - - let span = - Span.mk - (Span.pos (line + 1) (start + 1)) - (Span.pos (line + 1) (finish + 1)) - - let result = JsonObject() - result["range"] <- toLspRange span - result["placeholder"] <- JsonValue.Create(word) - LspProtocol.sendResponse idNode (Some result) - | _ -> - LspProtocol.sendError idNode -32602 "Rename is not valid at this position" - | _ -> - LspProtocol.sendError idNode -32602 "Rename is not valid at this position" - - let handleWorkspaceSymbol (idNode: JsonNode) (paramsObj: JsonObject) = - let query = - tryGetString paramsObj "query" - |> Option.defaultValue "" - |> fun q -> q.Trim() - - let hasQuery = not (String.IsNullOrWhiteSpace(query)) - let queryLower = query.ToLowerInvariant() - - let symbols = - documents - |> Seq.collect (fun kv -> - let uri = kv.Key - kv.Value.Symbols - |> Seq.filter (fun s -> - if not hasQuery then true - else - s.Name.ToLowerInvariant().Contains(queryLower) - || (s.TypeText |> Option.exists (fun t -> t.ToLowerInvariant().Contains(queryLower)))) - |> Seq.map (fun s -> - let item = JsonObject() - item["name"] <- JsonValue.Create(s.Name) - item["kind"] <- JsonValue.Create(s.Kind) - let location = JsonObject() - location["uri"] <- JsonValue.Create(uri) - location["range"] <- toLspRange s.Span - item["location"] <- location - item :> JsonNode)) - |> Seq.toArray - - LspProtocol.sendResponse idNode (Some (JsonArray(symbols))) - - let private levenshteinDistance (a: string) (b: string) = - let m = a.Length - let n = b.Length - let d = Array2D.zeroCreate (m + 1) (n + 1) - - for i = 0 to m do d[i, 0] <- i - for j = 0 to n do d[0, j] <- j - - for i = 1 to m do - for j = 1 to n do - let cost = if a[i - 1] = b[j - 1] then 0 else 1 - d[i, j] <- List.min [ d[i - 1, j] + 1; d[i, j - 1] + 1; d[i - 1, j - 1] + cost ] - - d[m, n] - - let private tryExtractUnboundName (message: string) = - let prefix = "Unbound variable '" - if message.StartsWith(prefix, StringComparison.Ordinal) && message.EndsWith("'", StringComparison.Ordinal) then - let inner = message.Substring(prefix.Length, message.Length - prefix.Length - 1) - if String.IsNullOrWhiteSpace(inner) then None else Some inner - else - None - - let handleCodeAction (idNode: JsonNode) (paramsObj: JsonObject) = - match tryGetUriFromTextDocument paramsObj with - | Some uri when documents.ContainsKey(uri) -> - let doc = documents[uri] - let candidatePool = - [ for s in doc.Symbols -> s.Name - yield! stdlibNames - yield! builtinNames ] - |> List.distinct - - let actions = ResizeArray() - - match tryGetObject paramsObj "context" with - | Some contextObj -> - match contextObj["diagnostics"] with - | :? JsonArray as diagnostics -> - for diag in diagnostics do - match diag with - | :? JsonObject as diagObj -> - match diagObj["message"] with - | :? JsonValue as mv -> - let message = - try mv.GetValue() with _ -> "" - match tryExtractUnboundName message with - | Some missingName -> - let suggestion = - candidatePool - |> List.map (fun c -> c, levenshteinDistance missingName c) - |> List.sortBy snd - |> List.tryHead - |> Option.bind (fun (name, dist) -> - if dist <= 3 then Some name else None) - - match suggestion, diagObj["range"] with - | Some replacement, (:? JsonObject as rangeObjUntyped) -> - let rangeObj: JsonObject = rangeObjUntyped - let edit = JsonObject() - let copiedRange = - let mkPos (obj: JsonObject) = - let p = JsonObject() - p["line"] <- JsonValue.Create(tryGetInt obj "line" |> Option.defaultValue 0) - p["character"] <- JsonValue.Create(tryGetInt obj "character" |> Option.defaultValue 0) - p - - let r = JsonObject() - match rangeObj["start"], rangeObj["end"] with - | (:? JsonObject as s), (:? JsonObject as e) -> - r["start"] <- mkPos s - r["end"] <- mkPos e - | _ -> - r["start"] <- JsonObject() - r["end"] <- JsonObject() - r - - edit["range"] <- copiedRange - edit["newText"] <- JsonValue.Create(replacement) - - let changes = JsonObject() - changes[uri] <- JsonArray([| edit :> JsonNode |]) - - let workspaceEdit = JsonObject() - workspaceEdit["changes"] <- changes - - let action = JsonObject() - action["title"] <- JsonValue.Create($"Replace with '{replacement}'") - action["kind"] <- JsonValue.Create("quickfix") - action["edit"] <- workspaceEdit - action["isPreferred"] <- JsonValue.Create(true) - actions.Add(action) - | _ -> () - | None -> () - | _ -> () - | _ -> () - | _ -> () - | None -> () - - LspProtocol.sendResponse idNode (Some (JsonArray(actions.ToArray()))) - | _ -> - LspProtocol.sendResponse idNode (Some (JsonArray())) diff --git a/src/FScript.CSharpInterop/LanguageServerLegacy/LspModel.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspModel.fs deleted file mode 100644 index 66240e6..0000000 --- a/src/FScript.CSharpInterop/LanguageServerLegacy/LspModel.fs +++ /dev/null @@ -1,215 +0,0 @@ -namespace FScript.LanguageServer - -open System -open System.Text.Json.Nodes -open System.Collections.Generic -open FScript.Language - -module LspModel = - let mutable inlayHintsEnabled = true - - let stdlibNames = Stdlib.reservedNames() |> Set.toList - let builtinNames = [ "ignore"; "nameof"; "typeof" ] - - let reservedKeywords = - [ "let"; "rec"; "and"; "if"; "then"; "elif"; "else"; "match"; "with"; "when" - "for"; "in"; "do"; "type"; "module"; "true"; "false"; "None"; "Some" ] - |> Set.ofList - - let asObject (node: JsonNode) : JsonObject option = - match node with - | :? JsonObject as o -> Some o - | _ -> None - - let tryGetObject (obj: JsonObject) (name: string) : JsonObject option = - match obj[name] with - | null -> None - | node -> asObject node - - let tryGetNode (obj: JsonObject) (name: string) : JsonNode option = - match obj[name] with - | null -> None - | node -> Some node - - let tryGetString (obj: JsonObject) (name: string) : string option = - match obj[name] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - - let tryGetInt (obj: JsonObject) (name: string) : int option = - match obj[name] with - | :? JsonValue as v -> - try Some (v.GetValue()) with _ -> None - | _ -> None - - type TopLevelSymbol = - { Name: string - Kind: int - TypeText: string option - TypeTargetName: string option - Span: Span } - - type LocalBindingInfo = - { Name: string - DeclSpan: Span - ScopeSpan: Span - AnnotationType: string option } - - type DocumentState = - { Text: string - Symbols: TopLevelSymbol list - RecordParameterFields: Map - ParameterTypeTargets: Map - FunctionParameters: Map - FunctionAnnotationTypes: Map - FunctionDeclaredReturnTargets: Map - CallArgumentHints: (Span * string) list - FunctionReturnTypeHints: (Span * string) list - ParameterTypeHints: (Span * string) list - PatternTypeHints: (Span * string) list - LocalVariableTypeHints: (Span * string * string) list - LocalBindings: LocalBindingInfo list - InjectedFunctionSignatures: Map - InjectedFunctionParameterNames: Map - InjectedFunctionDefinitions: Map - // Variable occurrences keyed by identifier, sourced from AST spans. - // This avoids text-based false positives (for example record field labels). - VariableOccurrences: Map } - - let documents = Dictionary(StringComparer.Ordinal) - - let toLspRange (span: Span) = - let startLine = max 0 (span.Start.Line - 1) - let startChar = max 0 (span.Start.Column - 1) - let endLine = max 0 (span.End.Line - 1) - let endChar = max 0 (span.End.Column - 1) - - let startObj = JsonObject() - startObj["line"] <- JsonValue.Create(startLine) - startObj["character"] <- JsonValue.Create(startChar) - - let endObj = JsonObject() - endObj["line"] <- JsonValue.Create(endLine) - endObj["character"] <- JsonValue.Create(endChar) - - let rangeObj = JsonObject() - rangeObj["start"] <- startObj - rangeObj["end"] <- endObj - rangeObj - - let symbolKindLabel (kind: int) = - match kind with - | 5 -> "type" - | 12 -> "function" - | 13 -> "value" - | 22 -> "union-case" - | _ -> "symbol" - - let diagnostic (severity: int) (code: string) (span: Span) (message: string) = - let d = JsonObject() - d["range"] <- toLspRange span - d["severity"] <- JsonValue.Create(severity) - d["code"] <- JsonValue.Create(code) - d["source"] <- JsonValue.Create("fscript-lsp") - d["message"] <- JsonValue.Create(message) - d - - let publishDiagnostics (uri: string) (diags: JsonNode list) = - let p = JsonObject() - p["uri"] <- JsonValue.Create(uri) - p["diagnostics"] <- JsonArray(diags |> Seq.toArray) - LspProtocol.sendNotification "textDocument/publishDiagnostics" (Some p) - - let symbolKindForType (t: Type) = - match t with - | TFun _ -> 12 - | _ -> 13 - - let declarationKindFromArgs (args: Param list) = - if args.IsEmpty then 13 else 12 - - let getLineText (text: string) (line: int) : string option = - if line < 0 then None - else - let lines = text.Split('\n') - if line >= lines.Length then None - else Some (lines[line].TrimEnd('\r')) - - let isWordChar (c: char) = - Char.IsLetterOrDigit(c) || c = '_' || c = '.' - - let isValidIdentifierName (name: string) = - let startsValid c = Char.IsLetter(c) || c = '_' - let partValid c = Char.IsLetterOrDigit(c) || c = '_' - not (String.IsNullOrWhiteSpace(name)) - && startsValid name[0] - && (name |> Seq.forall partValid) - && not (reservedKeywords.Contains name) - - let tryGetWordAtPosition (text: string) (line: int) (character: int) : string option = - match getLineText text line with - | None -> None - | Some lineText -> - if lineText.Length = 0 then None - else - let pos = - if character < 0 then 0 - elif character > lineText.Length then lineText.Length - else character - - let mutable start = pos - while start > 0 && isWordChar lineText[start - 1] do - start <- start - 1 - - let mutable finish = pos - while finish < lineText.Length && isWordChar lineText[finish] do - finish <- finish + 1 - - if finish > start then Some (lineText.Substring(start, finish - start)) else None - - let tryGetWordPrefixAtPosition (text: string) (line: int) (character: int) : string option = - match getLineText text line with - | None -> None - | Some lineText -> - if lineText.Length = 0 then None - else - let pos = - if character < 0 then 0 - elif character > lineText.Length then lineText.Length - else character - - let mutable start = pos - while start > 0 && isWordChar lineText[start - 1] do - start <- start - 1 - - if pos > start then Some (lineText.Substring(start, pos - start)) else None - - let tryGetPosition (paramsObj: JsonObject) : (int * int) option = - match tryGetObject paramsObj "position" with - | None -> None - | Some posObj -> - match tryGetInt posObj "line", tryGetInt posObj "character" with - | Some line, Some character -> Some (line, character) - | _ -> None - - let tryGetRange (paramsObj: JsonObject) : (int * int * int * int) option = - match tryGetObject paramsObj "range" with - | Some rangeObj -> - match tryGetObject rangeObj "start", tryGetObject rangeObj "end" with - | Some startObj, Some endObj -> - match tryGetInt startObj "line", tryGetInt startObj "character", tryGetInt endObj "line", tryGetInt endObj "character" with - | Some sl, Some sc, Some el, Some ec -> Some (sl, sc, el, ec) - | _ -> None - | _ -> None - | None -> None - - let tryGetUriFromTextDocument (paramsObj: JsonObject) : string option = - match tryGetObject paramsObj "textDocument" with - | None -> None - | Some td -> tryGetString td "uri" - - let tryGetContextTriggerCharacter (paramsObj: JsonObject) : string option = - match tryGetObject paramsObj "context" with - | None -> None - | Some ctx -> tryGetString ctx "triggerCharacter" diff --git a/src/FScript.CSharpInterop/LanguageServerLegacy/LspProtocol.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspProtocol.fs deleted file mode 100644 index a5b8f6c..0000000 --- a/src/FScript.CSharpInterop/LanguageServerLegacy/LspProtocol.fs +++ /dev/null @@ -1,97 +0,0 @@ -namespace FScript.LanguageServer - -open System -open System.IO -open System.Text -open System.Text.Json.Nodes - -module LspProtocol = - let private utf8 = UTF8Encoding(false) - let private stdin = Console.OpenStandardInput() - let private stdout = Console.OpenStandardOutput() - - let sendMessage (payload: string) = - let bytes = utf8.GetBytes(payload) - let header = $"Content-Length: {bytes.Length}\r\n\r\n" - let headerBytes = Encoding.ASCII.GetBytes(header) - stdout.Write(headerBytes, 0, headerBytes.Length) - stdout.Write(bytes, 0, bytes.Length) - stdout.Flush() - - let sendResponse (idNode: JsonNode) (resultNode: (JsonNode | null) option) = - let obj = JsonObject() - obj["jsonrpc"] <- JsonValue.Create("2.0") - obj["id"] <- idNode.DeepClone() - obj["result"] <- - match resultNode with - | Some node -> node - | None -> null - sendMessage (obj.ToJsonString()) - - let sendError (idNode: JsonNode) (code: int) (message: string) = - let err = JsonObject() - err["code"] <- JsonValue.Create(code) - err["message"] <- JsonValue.Create(message) - - let obj = JsonObject() - obj["jsonrpc"] <- JsonValue.Create("2.0") - obj["id"] <- idNode.DeepClone() - obj["error"] <- err - sendMessage (obj.ToJsonString()) - - let sendNotification (methodName: string) (paramsNode: (JsonNode | null) option) = - let obj = JsonObject() - obj["jsonrpc"] <- JsonValue.Create("2.0") - obj["method"] <- JsonValue.Create(methodName) - obj["params"] <- - match paramsNode with - | Some node -> node - | None -> null - sendMessage (obj.ToJsonString()) - - let rec private readExact (stream: Stream) (buffer: byte[]) (offset: int) (count: int) = - if count > 0 then - let read = stream.Read(buffer, offset, count) - if read <= 0 then - raise (EndOfStreamException("Unexpected end of stream while reading LSP payload.")) - readExact stream buffer (offset + read) (count - read) - - let tryReadMessage () : string option = - let headerBytes = ResizeArray() - let mutable matched = 0 - let marker = [| byte '\r'; byte '\n'; byte '\r'; byte '\n' |] - let mutable ended = false - - while not ended do - let b = stdin.ReadByte() - if b = -1 then - if headerBytes.Count = 0 then - ended <- true - else - raise (EndOfStreamException("Unexpected end of stream while reading LSP headers.")) - else - let bb = byte b - headerBytes.Add(bb) - if bb = marker[matched] then - matched <- matched + 1 - if matched = marker.Length then - ended <- true - else - matched <- if bb = marker[0] then 1 else 0 - - if headerBytes.Count = 0 then - None - else - let headerText = Encoding.ASCII.GetString(headerBytes.ToArray()) - let contentLength = - headerText.Split([| "\r\n" |], StringSplitOptions.RemoveEmptyEntries) - |> Array.tryPick (fun line -> - if line.StartsWith("Content-Length:", StringComparison.OrdinalIgnoreCase) then - line.Substring("Content-Length:".Length).Trim() |> int |> Some - else - None) - |> Option.defaultWith (fun () -> failwith "Missing Content-Length header") - - let payload = Array.zeroCreate contentLength - readExact stdin payload 0 contentLength - Some (utf8.GetString(payload)) diff --git a/src/FScript.CSharpInterop/LanguageServerLegacy/LspRuntimeExterns.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspRuntimeExterns.fs deleted file mode 100644 index 93b4758..0000000 --- a/src/FScript.CSharpInterop/LanguageServerLegacy/LspRuntimeExterns.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace FScript.LanguageServer - -open FScript.Language -open FScript.CSharpInterop - -module LspRuntimeExterns = - let forSourcePath (sourcePath: string) : ExternalFunction list = - InteropServices.runtimeExternsForSourcePath sourcePath diff --git a/src/FScript.CSharpInterop/LanguageServerLegacy/LspSymbols.fs b/src/FScript.CSharpInterop/LanguageServerLegacy/LspSymbols.fs deleted file mode 100644 index 2968eee..0000000 --- a/src/FScript.CSharpInterop/LanguageServerLegacy/LspSymbols.fs +++ /dev/null @@ -1,2186 +0,0 @@ -namespace FScript.LanguageServer - -open System -open System.Collections.Generic -open System.IO -open System.Text.Json.Nodes -open FScript.Language -open FScript.CSharpInterop - -module LspSymbols = - open LspModel - - let private collectMapKeyDomainVars (t: Type) = - let rec collect acc ty = - match ty with - | TMap (TVar v, valueType) -> - collect (Set.add v acc) valueType - | TMap (keyType, valueType) -> - collect (collect acc keyType) valueType - | TList inner - | TOption inner -> collect acc inner - | TTuple items -> - items |> List.fold collect acc - | TRecord fields -> - fields |> Map.values |> Seq.fold collect acc - | TFun (a, b) -> - collect (collect acc a) b - | _ -> acc - - collect Set.empty t - - let private lspTypeToStringWithKeyDomainVars (keyDomainVars: Set) (t: Type) = - let rec go t = - match t with - | TUnit -> "unit" - | TInt -> "int" - | TFloat -> "float" - | TBool -> "bool" - | TString -> "string" - | TList t1 -> sprintf "%s list" (postfixArg t1) - | TTuple ts -> ts |> List.map go |> String.concat " * " |> sprintf "(%s)" - | TRecord fields -> - fields - |> Map.toList - |> List.map (fun (name, fieldType) -> sprintf "%s: %s" name (go fieldType)) - |> String.concat "; " - |> sprintf "{ %s }" - | TMap (_, tv) -> - sprintf "%s map" (postfixArg tv) - | TOption t1 -> sprintf "%s option" (postfixArg t1) - | TFun (a, b) -> sprintf "(%s -> %s)" (go a) (go b) - | TNamed n -> n - | TUnion (name, _) -> name - | TTypeToken -> "type" - | TVar v when Set.contains v keyDomainVars -> "int|string" - | TVar _ -> "unknown" - and postfixArg t = - match t with - | TFun _ | TTuple _ | TRecord _ -> sprintf "(%s)" (go t) - | _ -> go t - go t - - let private lspTypeToString (t: Type) = - let keyDomainVars = collectMapKeyDomainVars t - lspTypeToStringWithKeyDomainVars keyDomainVars t - - let private schemeTypeToString (scheme: Scheme) = - match scheme with - | Forall (_, t) -> Types.typeToString t - - let private stdlibFunctionSignatures : Lazy> = - lazy - let typedStdlib = InteropServices.inferStdlibWithExternsRaw [] - typedStdlib - |> List.collect (function - | TypeInfer.TSLet(name, _, t, _, _, _) -> - match t with - | TFun _ -> [ name, Types.typeToString t ] - | _ -> [] - | TypeInfer.TSLetRecGroup(bindings, _, _) -> - bindings - |> List.choose (fun (name, _, t, _) -> - match t with - | TFun _ -> Some (name, Types.typeToString t) - | _ -> None) - | _ -> []) - |> Map.ofList - - let private tryStdlibVirtualUriFromSource (sourceFile: string option) = - match sourceFile with - | Some file when file.EndsWith("Stdlib.Option.fss", StringComparison.Ordinal) || file.EndsWith("Option.fss", StringComparison.Ordinal) -> Some "fscript-stdlib:///Option.fss" - | Some file when file.EndsWith("Stdlib.List.fss", StringComparison.Ordinal) || file.EndsWith("List.fss", StringComparison.Ordinal) -> Some "fscript-stdlib:///List.fss" - | Some file when file.EndsWith("Stdlib.Map.fss", StringComparison.Ordinal) || file.EndsWith("Map.fss", StringComparison.Ordinal) -> Some "fscript-stdlib:///Map.fss" - | _ -> None - - let private stdlibFunctionParameterNames : Lazy> = - lazy - InteropServices.stdlibProgram() - |> List.collect (function - | SLet(name, args, _, _, _, _) -> - [ name, (args |> List.map (fun p -> p.Name)) ] - | SLetRecGroup(bindings, _, _) -> - bindings - |> List.map (fun (name, args, _, _) -> name, (args |> List.map (fun p -> p.Name))) - | _ -> []) - |> Map.ofList - - let private stdlibFunctionDefinitions : Lazy> = - lazy - InteropServices.stdlibProgram() - |> List.collect (function - | SLet(name, _, _, _, _, span) -> - match tryStdlibVirtualUriFromSource span.Start.File with - | Some uri -> [ name, (uri, span) ] - | None -> [] - | SLetRecGroup(bindings, _, _) -> - bindings - |> List.collect (fun (name, _, _, span) -> - match tryStdlibVirtualUriFromSource span.Start.File with - | Some uri -> [ name, (uri, span) ] - | None -> []) - | _ -> []) - |> Map.ofList - - let private buildInjectedFunctionData (externs: ExternalFunction list) = - let fromExterns = - externs - |> List.map (fun ext -> ext.Name, schemeTypeToString ext.Scheme) - |> Map.ofList - - let builtinSignatures = - [ "ignore", "'a -> unit" - "print", "string -> unit" - "nameof", "string -> string" - "typeof", "string -> type" ] - |> Map.ofList - - let builtinParamNames = - [ "ignore", [ "value" ] - "print", [ "message" ] - "nameof", [ "name" ] - "typeof", [ "name" ] ] - |> Map.ofList - - let signatures = - stdlibFunctionSignatures.Value - |> Map.fold (fun acc name signature -> acc |> Map.add name signature) fromExterns - |> Map.fold (fun acc name signature -> acc |> Map.add name signature) builtinSignatures - - let paramNames = - stdlibFunctionParameterNames.Value - |> Map.fold (fun acc name names -> acc |> Map.add name names) builtinParamNames - - signatures, paramNames, stdlibFunctionDefinitions.Value - - let rec private typeRefToString (typeRef: TypeRef) = - match typeRef with - | TRName name -> name - | TRTuple parts -> parts |> List.map typeRefToString |> String.concat " * " |> sprintf "(%s)" - | TRFun (a, b) -> sprintf "%s -> %s" (typeRefToString a) (typeRefToString b) - | TRPostfix (inner, suffix) -> sprintf "%s %s" (typeRefToString inner) suffix - | TRRecord fields -> - fields - |> List.map (fun (name, t) -> sprintf "%s: %s" name (typeRefToString t)) - |> String.concat "; " - |> sprintf "{ %s }" - | TRStructuralRecord fields -> - fields - |> List.map (fun (name, t) -> sprintf "%s: %s" name (typeRefToString t)) - |> String.concat "; " - |> sprintf "{| %s |}" - - let private canonicalRecordSignatureFromFields (fields: (string * string) list) = - fields - |> List.sortBy fst - |> List.map (fun (name, t) -> $"{name}:{t}") - |> String.concat ";" - - let buildSymbolsFromProgram (program: Program) (typed: TypeInfer.TypedProgram option) : TopLevelSymbol list = - let typedByName = Dictionary(StringComparer.Ordinal) - let recordTypeDefsBySignature = Dictionary>(StringComparer.Ordinal) - - let canonicalRecordSignatureFromType (t: Type) = - match t with - | TRecord fields -> - fields - |> Map.toList - |> List.map (fun (name, ty) -> name, Types.typeToString ty) - |> canonicalRecordSignatureFromFields - |> Some - | _ -> None - - match typed with - | Some typedProgram -> - for stmt in typedProgram do - match stmt with - | TypeInfer.TSLet(name, _, _, _, _, _) -> - typedByName[name] <- stmt - | TypeInfer.TSLetRecGroup(bindings, _, _) -> - for (name, _, _, _) in bindings do - typedByName[name] <- stmt - | _ -> () - | None -> () - - for stmt in program do - match stmt with - | SType typeDef when typeDef.Cases.IsEmpty -> - let signature = - typeDef.Fields - |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) - |> canonicalRecordSignatureFromFields - - if not (recordTypeDefsBySignature.ContainsKey(signature)) then - recordTypeDefsBySignature[signature] <- ResizeArray() - recordTypeDefsBySignature[signature].Add(typeDef.Name) - | _ -> () - - let mkFromTyped (name: string) (span: Span) (fallbackKind: int) = - let tryResolveRecordTarget (t: Type) = - match canonicalRecordSignatureFromType t with - | Some signature when recordTypeDefsBySignature.ContainsKey(signature) -> - let candidates = recordTypeDefsBySignature[signature] |> Seq.distinct |> Seq.toList - match candidates with - | [ one ] -> Some one - | _ -> None - | _ -> None - - let rec typeTargetFromType (t: Type) = - match t with - | TNamed name -> Some name - | TUnion (name, _) -> Some name - | TRecord _ -> tryResolveRecordTarget t - | TFun (_, ret) -> typeTargetFromType ret - | _ -> None - - match typedByName.TryGetValue(name) with - | true, TypeInfer.TSLet(_, _, t, _, _, _) -> - { Name = name - Kind = symbolKindForType t - TypeText = Some (lspTypeToString t) - TypeTargetName = typeTargetFromType t - Span = span } - | true, TypeInfer.TSLetRecGroup(bindings, _, _) -> - match bindings |> List.tryFind (fun (n, _, _, _) -> n = name) with - | Some (_, _, t, _) -> - { Name = name - Kind = symbolKindForType t - TypeText = Some (lspTypeToString t) - TypeTargetName = typeTargetFromType t - Span = span } - | None -> - { Name = name - Kind = fallbackKind - TypeText = None - TypeTargetName = None - Span = span } - | _ -> - { Name = name - Kind = fallbackKind - TypeText = None - TypeTargetName = None - Span = span } - - program - |> List.collect (fun stmt -> - match stmt with - | SType typeDef -> - let typeText = - if typeDef.Cases.IsEmpty then - let fields = - typeDef.Fields - |> List.map (fun (name, t) -> $"{name}: {typeRefToString t}") - |> String.concat "; " - Some $"{{ {fields} }}" - else - Some typeDef.Name - - let typeSymbol = - { Name = typeDef.Name - Kind = 5 - TypeText = typeText - TypeTargetName = None - Span = typeDef.Span } - - let caseSymbols = - typeDef.Cases - |> List.collect (fun (caseName, payload) -> - let caseType = - match payload with - | Some payloadType -> Some (sprintf "%s -> %s" (typeRefToString payloadType) typeDef.Name) - | None -> Some typeDef.Name - - [ { Name = caseName - Kind = 22 - TypeText = caseType - TypeTargetName = Some typeDef.Name - Span = typeDef.Span } - { Name = $"{typeDef.Name}.{caseName}" - Kind = 22 - TypeText = caseType - TypeTargetName = Some typeDef.Name - Span = typeDef.Span } ]) - - typeSymbol :: caseSymbols - | SLet(name, args, _, _, _, span) -> - [ mkFromTyped name span (declarationKindFromArgs args) ] - | SLetRecGroup(bindings, _, _) -> - bindings - |> List.map (fun (name, args, _, span) -> mkFromTyped name span (declarationKindFromArgs args)) - | _ -> []) - - let private buildTopLevelTypeTargetFromProgram (program: Program) = - let recordTypeBySignature = - program - |> List.choose (function - | SType typeDef when typeDef.Cases.IsEmpty -> - let fields = - typeDef.Fields - |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) - Some (canonicalRecordSignatureFromFields fields, typeDef.Name) - | _ -> None) - |> List.groupBy fst - |> List.choose (fun (signature, entries) -> - let names = entries |> List.map snd |> List.distinct - match names with - | [ single ] -> Some (signature, single) - | _ -> None) - |> Map.ofList - - let canonicalRecordSignatureFromType (t: Type) = - match t with - | TRecord fields -> - fields - |> Map.toList - |> List.map (fun (name, ty) -> name, Types.typeToString ty) - |> canonicalRecordSignatureFromFields - |> Some - | _ -> None - - let rec resolveTypeTarget (t: Type) = - match t with - | TNamed name -> Some name - | TUnion (name, _) -> Some name - | TRecord _ -> - match canonicalRecordSignatureFromType t with - | Some signature -> recordTypeBySignature |> Map.tryFind signature - | None -> None - | TFun (_, ret) -> resolveTypeTarget ret - | _ -> None - - resolveTypeTarget - - let private inferTopLevelTypesBestEffort (externs: ExternalFunction list) (program: Program) : Map = - let mutable accepted: Program = [] - let mutable result: Map = Map.empty - - let tryInferWithCurrent (candidate: Program) = - try - let typed, _ = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs candidate - Some typed - with - | _ -> None - - let extractTypeForName (typed: TypeInfer.TypedProgram) (targetName: string) = - typed - |> List.tryPick (fun stmt -> - match stmt with - | TypeInfer.TSLet (name, _, t, _, _, _) when name = targetName -> - Some t - | TypeInfer.TSLetRecGroup (bindings, _, _) -> - bindings - |> List.tryPick (fun (name, _, t, _) -> - if name = targetName then Some t else None) - | _ -> None) - - for stmt in program do - match stmt with - | SType _ -> - accepted <- accepted @ [ stmt ] - | SLet (name, _, _, _, _, _) -> - let candidate = accepted @ [ stmt ] - match tryInferWithCurrent candidate with - | Some typed -> - accepted <- candidate - match extractTypeForName typed name with - | Some t -> result <- result |> Map.add name t - | None -> () - | None -> () - | SLetRecGroup (bindings, _, _) -> - let candidate = accepted @ [ stmt ] - match tryInferWithCurrent candidate with - | Some typed -> - accepted <- candidate - for (name, _, _, _) in bindings do - match extractTypeForName typed name with - | Some t -> result <- result |> Map.add name t - | None -> () - | None -> () - | SExpr _ -> - () - | SImport _ -> - () - - result - - let private inferLocalVariableTypesBestEffort (externs: ExternalFunction list) (program: Program) : TypeInfer.LocalVariableTypeInfo list = - let mutable accepted: Program = [] - let collected = Dictionary<(string * int * int * int * int * string), TypeInfer.LocalVariableTypeInfo>() - - let tryInferWithCurrent (candidate: Program) = - try - let _, localTypes = InteropServices.inferProgramWithExternsAndLocalVariableTypes externs candidate - Some localTypes - with - | _ -> None - - let keyOf (entry: TypeInfer.LocalVariableTypeInfo) = - let file = entry.Span.Start.File |> Option.defaultValue "" - (entry.Name, entry.Span.Start.Line, entry.Span.Start.Column, entry.Span.End.Line, entry.Span.End.Column, file) - - for stmt in program do - match stmt with - | SType _ -> - accepted <- accepted @ [ stmt ] - | SLet _ - | SLetRecGroup _ -> - let candidate = accepted @ [ stmt ] - match tryInferWithCurrent candidate with - | Some localTypes -> - accepted <- candidate - for entry in localTypes do - collected[keyOf entry] <- entry - | None -> () - | SExpr _ -> - () - | SImport _ -> - () - - collected.Values |> Seq.toList - - let collectVariableOccurrences (program: Program) : Map = - let addOccurrence name span (acc: Map) = - let existing = acc |> Map.tryFind name |> Option.defaultValue [] - acc |> Map.add name (span :: existing) - - let rec collectExpr (acc: Map) (expr: Expr) = - match expr with - | EVar (name, span) -> addOccurrence name span acc - | EParen (inner, _) -> collectExpr acc inner - | ELambda (_, body, _) -> collectExpr acc body - | EApply (fn, arg, _) -> - let withFn = collectExpr acc fn - collectExpr withFn arg - | EIf (c, t, f, _) -> - let withCond = collectExpr acc c - let withThen = collectExpr withCond t - collectExpr withThen f - | ERaise (inner, _) -> collectExpr acc inner - | EFor (_, source, body, _) -> - let withSource = collectExpr acc source - collectExpr withSource body - | EMatch (scrutinee, cases, _) -> - let withScrutinee = collectExpr acc scrutinee - cases - |> List.fold (fun state (_, guard, body, _) -> - let withGuard = - match guard with - | Some g -> collectExpr state g - | None -> state - collectExpr withGuard body) withScrutinee - | ELet (_, value, body, _, _) -> - let withValue = collectExpr acc value - collectExpr withValue body - | ELetRecGroup (bindings, body, _) -> - let withBindings = - bindings - |> List.fold (fun state (_, _, value, _) -> collectExpr state value) acc - collectExpr withBindings body - | EList (items, _) -> - items |> List.fold collectExpr acc - | ERange (startExpr, endExpr, _) -> - let withStart = collectExpr acc startExpr - collectExpr withStart endExpr - | ETuple (items, _) -> - items |> List.fold collectExpr acc - | ERecord (fields, _) -> - fields |> List.fold (fun state (_, value) -> collectExpr state value) acc - | EStructuralRecord (fields, _) -> - fields |> List.fold (fun state (_, value) -> collectExpr state value) acc - | EMap (entries, _) -> - entries - |> List.fold (fun state entry -> - match entry with - | MEKeyValue (keyExpr, valueExpr) -> - let withKey = collectExpr state keyExpr - collectExpr withKey valueExpr - | MESpread spreadExpr -> - collectExpr state spreadExpr) acc - | ERecordUpdate (baseExpr, fields, _) -> - let withBase = collectExpr acc baseExpr - fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase - | EStructuralRecordUpdate (baseExpr, fields, _) -> - let withBase = collectExpr acc baseExpr - fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase - | EFieldGet (target, _, _) -> collectExpr acc target - | EIndexGet (target, key, _) -> - let withTarget = collectExpr acc target - collectExpr withTarget key - | ECons (head, tail, _) -> - let withHead = collectExpr acc head - collectExpr withHead tail - | EAppend (left, right, _) -> - let withLeft = collectExpr acc left - collectExpr withLeft right - | EBinOp (_, left, right, _) -> - let withLeft = collectExpr acc left - collectExpr withLeft right - | ESome (inner, _) -> collectExpr acc inner - | EInterpolatedString (parts, _) -> - parts - |> List.fold (fun state part -> - match part with - | IPText _ -> state - | IPExpr embedded -> collectExpr state embedded) acc - | EUnit _ - | ELiteral _ - | ENone _ - | ETypeOf _ - | ENameOf _ -> acc - - let withDeclsAndExprs = - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (name, _, expr, _, _, span) -> - let withDecl = addOccurrence name span state - collectExpr withDecl expr - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.fold (fun inner (name, _, expr, span) -> - let withDecl = addOccurrence name span inner - collectExpr withDecl expr) state - | SExpr expr -> - collectExpr state expr - | _ -> state) Map.empty - - withDeclsAndExprs - |> Map.map (fun _ spans -> spans |> List.rev) - - let private buildRecordParameterFields (program: Program) = - let typeRecordFields = - program - |> List.choose (function - | SType typeDef when typeDef.Cases.IsEmpty -> - let fields = - typeDef.Fields - |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) - Some (typeDef.Name, fields) - | _ -> None) - |> Map.ofList - - let fieldsFromAnnotation (annotation: TypeRef option) = - match annotation with - | Some (TRRecord fields) -> - Some (fields |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t)) - | Some (TRName typeName) -> - typeRecordFields |> Map.tryFind typeName - | _ -> - None - - let collectFromArgs (acc: Map) (args: Param list) = - args - |> List.fold (fun state arg -> - match fieldsFromAnnotation arg.Annotation with - | Some fields -> state |> Map.add arg.Name fields - | None -> state) acc - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (_, args, _, _, _, _) -> - collectFromArgs state args - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.fold (fun inner (_, args, _, _) -> collectFromArgs inner args) state - | _ -> - state) Map.empty - - let private buildParameterTypeTargets (program: Program) = - let namedRecordTypeBySignature = - program - |> List.choose (function - | SType typeDef when typeDef.Cases.IsEmpty -> - let fields = - typeDef.Fields - |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) - Some (canonicalRecordSignatureFromFields fields, typeDef.Name) - | _ -> None) - |> List.groupBy fst - |> List.choose (fun (sigText, entries) -> - let names = entries |> List.map snd |> List.distinct - match names with - | [ one ] -> Some (sigText, one) - | _ -> None) - |> Map.ofList - - let resolveAnnotationTarget (annotation: TypeRef option) = - match annotation with - | Some (TRName typeName) -> Some typeName - | Some (TRRecord fields) -> - fields - |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) - |> canonicalRecordSignatureFromFields - |> fun sigText -> namedRecordTypeBySignature |> Map.tryFind sigText - | _ -> None - - let collectFromArgs (acc: Map) (args: Param list) = - args - |> List.fold (fun state arg -> - match resolveAnnotationTarget arg.Annotation with - | Some typeName -> state |> Map.add arg.Name typeName - | None -> state) acc - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (_, args, _, _, _, _) -> - collectFromArgs state args - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.fold (fun inner (_, args, _, _) -> collectFromArgs inner args) state - | _ -> - state) Map.empty - - let private buildFunctionParameters (program: Program) = - let addBinding name (args: Param list) (acc: Map) = - let paramNames = - args - |> List.map (fun p -> p.Name) - |> List.filter (fun n -> not (String.IsNullOrWhiteSpace(n))) - if paramNames.IsEmpty then acc else acc |> Map.add name paramNames - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (name, args, _, _, _, _) -> - addBinding name args state - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.fold (fun inner (name, args, _, _) -> addBinding name args inner) state - | _ -> - state) Map.empty - - let private buildFunctionAnnotationTypes (program: Program) = - let addBinding name (args: Param list) (acc: Map) = - let hasAnnotation = args |> List.exists (fun p -> p.Annotation.IsSome) - if not hasAnnotation then acc - else - let annotated = - args - |> List.map (fun p -> - match p.Annotation with - | Some t -> typeRefToString t - | None -> "unknown") - acc |> Map.add name annotated - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (name, args, _, _, _, _) -> - addBinding name args state - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.fold (fun inner (name, args, _, _) -> addBinding name args inner) state - | _ -> - state) Map.empty - - let private buildFunctionDeclaredReturnTargets (program: Program) = - let recordTypeByFieldNames = - program - |> List.choose (function - | SType typeDef when typeDef.Cases.IsEmpty -> - let signature = - typeDef.Fields - |> List.map fst - |> List.sort - |> String.concat ";" - Some (signature, typeDef.Name) - | _ -> None) - |> List.groupBy fst - |> List.choose (fun (signature, entries) -> - let names = entries |> List.map snd |> List.distinct - match names with - | [ one ] -> Some (signature, one) - | _ -> None) - |> Map.ofList - - let rec terminalExpr (expr: Expr) = - match expr with - | ELet (_, _, body, _, _) -> terminalExpr body - | ELetRecGroup (_, body, _) -> terminalExpr body - | EParen (inner, _) -> terminalExpr inner - | _ -> expr - - let tryResolve expr = - match terminalExpr expr with - | ERecord (fields, _) - | EStructuralRecord (fields, _) -> - let signature = - fields - |> List.map fst - |> List.sort - |> String.concat ";" - recordTypeByFieldNames |> Map.tryFind signature - | _ -> None - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (name, args, expr, _, _, _) when not args.IsEmpty -> - match tryResolve expr with - | Some returnType -> state |> Map.add name returnType - | None -> state - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.fold (fun inner (name, args, expr, _) -> - if args.IsEmpty then inner - else - match tryResolve expr with - | Some returnType -> inner |> Map.add name returnType - | None -> inner) state - | _ -> state) Map.empty - - let private buildRecordTypeFieldTypeMap (program: Program) = - program - |> List.choose (function - | SType typeDef when typeDef.Cases.IsEmpty -> - let fields = - typeDef.Fields - |> List.map (fun (fieldName, t) -> fieldName, typeRefToString t) - |> Map.ofList - Some (typeDef.Name, fields) - | _ -> None) - |> Map.ofList - - let private spanContainsPosition1Based (span: Span) (line: int) (column: int) = - let sameFile = - match span.Start.File, span.End.File with - | Some sf, Some ef when not (String.Equals(sf, ef, StringComparison.OrdinalIgnoreCase)) -> false - | _ -> true - let startsBefore = - line > span.Start.Line - || (line = span.Start.Line && column >= span.Start.Column) - let endsAfter = - line < span.End.Line - || (line = span.End.Line && column <= span.End.Column) - sameFile && startsBefore && endsAfter - - let private spanStartAtOrBefore (candidate: Span) (line: int) (column: int) = - candidate.Start.Line < line - || (candidate.Start.Line = line && candidate.Start.Column <= column) - - let private inferLocalTypesFromReturnedRecordFields - (program: Program) - (functionDeclaredReturnTargets: Map) - (localBindings: LocalBindingInfo list) - : (Span * string * string) list = - - let recordFieldTypesByType = buildRecordTypeFieldTypeMap program - - let pickNearestBinding (name: string) (usageSpan: Span) = - localBindings - |> List.filter (fun binding -> - String.Equals(binding.Name, name, StringComparison.Ordinal) - && spanContainsPosition1Based binding.ScopeSpan usageSpan.Start.Line usageSpan.Start.Column - && spanStartAtOrBefore binding.DeclSpan usageSpan.Start.Line usageSpan.Start.Column) - |> List.sortByDescending (fun binding -> binding.DeclSpan.Start.Line, binding.DeclSpan.Start.Column) - |> List.tryHead - - let rec collectFieldVarUses (fieldTypes: Map) (expr: Expr) : (string * Span * string) list = - let nested = - match expr with - | EApply (f, a, _) -> collectFieldVarUses fieldTypes f @ collectFieldVarUses fieldTypes a - | EIf (c, t, f, _) -> - collectFieldVarUses fieldTypes c - @ collectFieldVarUses fieldTypes t - @ collectFieldVarUses fieldTypes f - | ERaise (inner, _) - | ESome (inner, _) - | EParen (inner, _) -> collectFieldVarUses fieldTypes inner - | EFor (_, source, body, _) -> - collectFieldVarUses fieldTypes source @ collectFieldVarUses fieldTypes body - | EMatch (scrutinee, cases, _) -> - let inScrutinee = collectFieldVarUses fieldTypes scrutinee - let inCases = - cases - |> List.collect (fun (_, guard, body, _) -> - let inGuard = - match guard with - | Some g -> collectFieldVarUses fieldTypes g - | None -> [] - inGuard @ collectFieldVarUses fieldTypes body) - inScrutinee @ inCases - | ELet (_, value, body, _, _) -> - collectFieldVarUses fieldTypes value @ collectFieldVarUses fieldTypes body - | ELetRecGroup (bindings, body, _) -> - let inBindings = - bindings - |> List.collect (fun (_, _, valueExpr, _) -> collectFieldVarUses fieldTypes valueExpr) - inBindings @ collectFieldVarUses fieldTypes body - | ELambda (_, body, _) -> - collectFieldVarUses fieldTypes body - | EList (items, _) - | ETuple (items, _) -> - items |> List.collect (collectFieldVarUses fieldTypes) - | ERange (a, b, _) -> - collectFieldVarUses fieldTypes a @ collectFieldVarUses fieldTypes b - | ERecord (fields, _) - | EStructuralRecord (fields, _) -> - fields |> List.collect (fun (_, valueExpr) -> collectFieldVarUses fieldTypes valueExpr) - | EMap (entries, _) -> - entries - |> List.collect (function - | MEKeyValue (k, v) -> collectFieldVarUses fieldTypes k @ collectFieldVarUses fieldTypes v - | MESpread e -> collectFieldVarUses fieldTypes e) - | ERecordUpdate (target, fields, _) - | EStructuralRecordUpdate (target, fields, _) -> - collectFieldVarUses fieldTypes target - @ (fields |> List.collect (fun (_, v) -> collectFieldVarUses fieldTypes v)) - | EFieldGet (target, _, _) -> - collectFieldVarUses fieldTypes target - | EIndexGet (a, b, _) - | ECons (a, b, _) - | EAppend (a, b, _) - | EBinOp (_, a, b, _) -> - collectFieldVarUses fieldTypes a @ collectFieldVarUses fieldTypes b - | EInterpolatedString (parts, _) -> - parts - |> List.collect (function - | IPText _ -> [] - | IPExpr embedded -> collectFieldVarUses fieldTypes embedded) - | EUnit _ - | ELiteral _ - | EVar _ - | ENone _ - | ETypeOf _ - | ENameOf _ -> [] - - let fromRecord = - match expr with - | ERecord (fields, _) - | EStructuralRecord (fields, _) -> - fields - |> List.choose (fun (fieldName, valueExpr) -> - match valueExpr, fieldTypes |> Map.tryFind fieldName with - | EVar (localName, usageSpan), Some fieldType -> - Some (localName, usageSpan, fieldType) - | _ -> None) - | _ -> [] - - fromRecord @ nested - - let fromBinding name expr = - match functionDeclaredReturnTargets |> Map.tryFind name with - | Some returnTypeName -> - match recordFieldTypesByType |> Map.tryFind returnTypeName with - | Some fieldTypes -> - collectFieldVarUses fieldTypes expr - |> List.choose (fun (localName, usageSpan, fieldType) -> - pickNearestBinding localName usageSpan - |> Option.map (fun binding -> binding.DeclSpan, binding.Name, fieldType)) - | None -> [] - | None -> [] - - program - |> List.collect (function - | SLet (name, args, expr, _, _, _) when not args.IsEmpty -> - fromBinding name expr - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.collect (fun (name, args, expr, _) -> - if args.IsEmpty then [] else fromBinding name expr) - | _ -> []) - |> List.distinctBy (fun (span, name, _) -> - let file = span.Start.File |> Option.defaultValue "" - name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column, file) - - let private buildLocalBindings (program: Program) = - let mkBinding (name: string) (declSpan: Span) (scopeSpan: Span) (annotation: string option) = - { Name = name - DeclSpan = declSpan - ScopeSpan = scopeSpan - AnnotationType = annotation } - - let rec collectPatternBindings (scopeSpan: Span) (pattern: Pattern) = - match pattern with - | PVar (name, span) -> - [ mkBinding name span scopeSpan None ] - | PCons (head, tail, _) -> - collectPatternBindings scopeSpan head @ collectPatternBindings scopeSpan tail - | PTuple (items, _) -> - items |> List.collect (collectPatternBindings scopeSpan) - | PRecord (fields, _) -> - fields |> List.collect (fun (_, p) -> collectPatternBindings scopeSpan p) - | PMap (clauses, tailOpt, _) -> - let fromClauses = - clauses - |> List.collect (fun (k, v) -> - collectPatternBindings scopeSpan k @ collectPatternBindings scopeSpan v) - let fromTail = - match tailOpt with - | Some tail -> collectPatternBindings scopeSpan tail - | None -> [] - fromClauses @ fromTail - | PSome (inner, _) -> - collectPatternBindings scopeSpan inner - | PUnionCase (_, _, payload, _) -> - match payload with - | Some p -> collectPatternBindings scopeSpan p - | None -> [] - | PWildcard _ - | PLiteral _ - | PNil _ - | PNone _ - | PTypeRef _ -> [] - - let rec collectExprBindings (expr: Expr) : LocalBindingInfo list = - match expr with - | ELambda (param, body, _) -> - let annotation = param.Annotation |> Option.map typeRefToString - mkBinding param.Name param.Span (Ast.spanOfExpr body) annotation - :: collectExprBindings body - | EFor (name, source, body, span) -> - mkBinding name span (Ast.spanOfExpr body) None - :: (collectExprBindings source @ collectExprBindings body) - | EMatch (scrutinee, cases, _) -> - let inScrutinee = collectExprBindings scrutinee - let inCases = - cases - |> List.collect (fun (pat, guard, body, _) -> - let scope = Ast.spanOfExpr body - let fromPattern = collectPatternBindings scope pat - let fromGuard = - match guard with - | Some g -> collectExprBindings g - | None -> [] - fromPattern @ fromGuard @ collectExprBindings body) - inScrutinee @ inCases - | ELet (name, value, body, _, span) -> - mkBinding name span (Ast.spanOfExpr body) None - :: (collectExprBindings value @ collectExprBindings body) - | ELetRecGroup (bindings, body, _) -> - let fromBindings = - bindings - |> List.collect (fun (name, args, valueExpr, bindingSpan) -> - let argBindings = - args - |> List.map (fun p -> - let annotation = p.Annotation |> Option.map typeRefToString - mkBinding p.Name p.Span (Ast.spanOfExpr valueExpr) annotation) - mkBinding name bindingSpan (Ast.spanOfExpr body) None - :: (argBindings @ collectExprBindings valueExpr)) - fromBindings @ collectExprBindings body - | EApply (f, a, _) -> - collectExprBindings f @ collectExprBindings a - | EIf (c, t, f, _) -> - collectExprBindings c @ collectExprBindings t @ collectExprBindings f - | ERaise (inner, _) - | ESome (inner, _) - | EParen (inner, _) -> - collectExprBindings inner - | EList (items, _) - | ETuple (items, _) -> - items |> List.collect collectExprBindings - | ERange (a, b, _) -> - collectExprBindings a @ collectExprBindings b - | ERecord (fields, _) - | EStructuralRecord (fields, _) -> - fields |> List.collect (fun (_, e) -> collectExprBindings e) - | EMap (entries, _) -> - entries - |> List.collect (function - | MEKeyValue (k, v) -> collectExprBindings k @ collectExprBindings v - | MESpread e -> collectExprBindings e) - | ERecordUpdate (target, fields, _) - | EStructuralRecordUpdate (target, fields, _) -> - collectExprBindings target @ (fields |> List.collect (fun (_, e) -> collectExprBindings e)) - | EFieldGet (target, _, _) -> - collectExprBindings target - | EIndexGet (a, b, _) - | ECons (a, b, _) - | EAppend (a, b, _) - | EBinOp (_, a, b, _) -> - collectExprBindings a @ collectExprBindings b - | EInterpolatedString (parts, _) -> - parts - |> List.collect (function - | IPText _ -> [] - | IPExpr embedded -> collectExprBindings embedded) - | EUnit _ - | ELiteral _ - | EVar _ - | ENone _ - | ETypeOf _ - | ENameOf _ -> [] - - let fromTopLevelFunction (args: Param list) (body: Expr) = - let argBindings = - args - |> List.map (fun p -> - let annotation = p.Annotation |> Option.map typeRefToString - mkBinding p.Name p.Span (Ast.spanOfExpr body) annotation) - argBindings @ collectExprBindings body - - program - |> List.collect (fun stmt -> - match stmt with - | SLet (_, args, body, _, _, _) -> - fromTopLevelFunction args body - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.collect (fun (_, args, body, _) -> fromTopLevelFunction args body) - | SExpr expr -> - collectExprBindings expr - | _ -> []) - - let private buildParameterTypeHints (program: Program) (typed: TypeInfer.TypedProgram option) = - let typedByName = Dictionary(StringComparer.Ordinal) - - match typed with - | Some typedProgram -> - for stmt in typedProgram do - match stmt with - | TypeInfer.TSLet(name, _, t, _, _, _) -> - typedByName[name] <- t - | TypeInfer.TSLetRecGroup(bindings, _, _) -> - for (name, _, t, _) in bindings do - typedByName[name] <- t - | _ -> () - | None -> () - - let rec collectLambdaParams (expr: Expr) = - match expr with - | ELambda (param, body, _) -> - param :: collectLambdaParams body - | EParen (inner, _) -> - collectLambdaParams inner - | _ -> - [] - - let rec takeParamTypes t count = - if count <= 0 then [] - else - match t with - | TFun (arg, rest) -> - arg :: takeParamTypes rest (count - 1) - | _ -> - [] - - let emitHints (name: string) (parameters: Param list) = - match typedByName.TryGetValue(name) with - | true, t when not parameters.IsEmpty -> - let argTypes = takeParamTypes t parameters.Length - let keyDomainVars = collectMapKeyDomainVars t - (parameters, argTypes) - ||> List.zip - |> List.choose (fun (param, argType) -> - if param.Annotation.IsSome then - None - else - Some (param.Span, $": {lspTypeToStringWithKeyDomainVars keyDomainVars argType}")) - | _ -> - [] - - program - |> List.collect (fun stmt -> - match stmt with - | SLet (name, args, expr, _, _, _) -> - let allParams = - if args.IsEmpty then collectLambdaParams expr else args - emitHints name allParams - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.collect (fun (name, args, expr, _) -> - let allParams = - if args.IsEmpty then collectLambdaParams expr else args - emitHints name allParams) - | _ -> - []) - - let private buildFunctionReturnTypeHints (program: Program) (typed: TypeInfer.TypedProgram option) = - let typedByName = Dictionary(StringComparer.Ordinal) - - match typed with - | Some typedProgram -> - for stmt in typedProgram do - match stmt with - | TypeInfer.TSLet(name, _, t, _, _, _) -> - typedByName[name] <- t - | TypeInfer.TSLetRecGroup(bindings, _, _) -> - for (name, _, t, _) in bindings do - typedByName[name] <- t - | _ -> () - | None -> () - - let rec collectLambdaParams (expr: Expr) = - match expr with - | ELambda (param, body, _) -> - param :: collectLambdaParams body - | EParen (inner, _) -> - collectLambdaParams inner - | _ -> - [] - - let rec takeReturnType t argCount = - if argCount <= 0 then t - else - match t with - | TFun (_, rest) -> takeReturnType rest (argCount - 1) - | _ -> t - - let emitHint (name: string) (parameters: Param list) = - if parameters.IsEmpty then - None - else - match typedByName.TryGetValue(name) with - | true, t -> - let returnType = takeReturnType t parameters.Length - let anchor = parameters[parameters.Length - 1].Span - Some (anchor, $": {lspTypeToString returnType}") - | _ -> - None - - let fromLet = - program - |> List.choose (fun stmt -> - match stmt with - | SLet (name, args, expr, _, _, _) -> - let allParams = - if args.IsEmpty then collectLambdaParams expr else args - emitHint name allParams - | _ -> - None) - - let fromLetRec = - program - |> List.collect (fun stmt -> - match stmt with - | SLetRecGroup (bindings, _, _) -> - bindings - |> List.choose (fun (name, args, expr, _) -> - let allParams = - if args.IsEmpty then collectLambdaParams expr else args - emitHint name allParams) - | _ -> - []) - - fromLet @ fromLetRec - - let private collectPatternVariableSpans (program: Program) = - let rec collectPattern (acc: (string * Span) list) (pattern: Pattern) = - match pattern with - | PVar (name, span) -> - (name, span) :: acc - | PCons (head, tail, _) -> - collectPattern (collectPattern acc head) tail - | PTuple (items, _) -> - items |> List.fold collectPattern acc - | PRecord (fields, _) -> - fields |> List.fold (fun state (_, p) -> collectPattern state p) acc - | PMap (clauses, tailOpt, _) -> - let withClauses = - clauses - |> List.fold (fun state (k, v) -> - let withKey = collectPattern state k - collectPattern withKey v) acc - match tailOpt with - | Some tail -> collectPattern withClauses tail - | None -> withClauses - | PSome (inner, _) -> - collectPattern acc inner - | PUnionCase (_, _, payload, _) -> - match payload with - | Some p -> collectPattern acc p - | None -> acc - | PWildcard _ - | PLiteral _ - | PNil _ - | PNone _ - | PTypeRef _ -> acc - - let rec collectExpr (acc: (string * Span) list) (expr: Expr) = - match expr with - | EMatch (scrutinee, cases, _) -> - let withScrutinee = collectExpr acc scrutinee - cases - |> List.fold (fun state (pat, guard, body, _) -> - let withPattern = collectPattern state pat - let withGuard = - match guard with - | Some g -> collectExpr withPattern g - | None -> withPattern - collectExpr withGuard body) withScrutinee - | ELambda (_, body, _) -> - collectExpr acc body - | EApply (f, a, _) -> - collectExpr (collectExpr acc f) a - | EIf (c, t, f, _) -> - collectExpr (collectExpr (collectExpr acc c) t) f - | ERaise (inner, _) -> - collectExpr acc inner - | EFor (_, source, body, _) -> - collectExpr (collectExpr acc source) body - | ELet (_, value, body, _, _) -> - collectExpr (collectExpr acc value) body - | ELetRecGroup (bindings, body, _) -> - let withBindings = - bindings |> List.fold (fun state (_, _, value, _) -> collectExpr state value) acc - collectExpr withBindings body - | EList (items, _) - | ETuple (items, _) -> - items |> List.fold collectExpr acc - | ERange (startExpr, endExpr, _) -> - collectExpr (collectExpr acc startExpr) endExpr - | ERecord (fields, _) - | EStructuralRecord (fields, _) -> - fields |> List.fold (fun state (_, value) -> collectExpr state value) acc - | EMap (entries, _) -> - entries - |> List.fold (fun state entry -> - match entry with - | MEKeyValue (k, v) -> - collectExpr (collectExpr state k) v - | MESpread spread -> - collectExpr state spread) acc - | ERecordUpdate (baseExpr, fields, _) - | EStructuralRecordUpdate (baseExpr, fields, _) -> - let withBase = collectExpr acc baseExpr - fields |> List.fold (fun state (_, value) -> collectExpr state value) withBase - | EFieldGet (target, _, _) -> - collectExpr acc target - | EIndexGet (target, key, _) - | ECons (target, key, _) - | EAppend (target, key, _) - | EBinOp (_, target, key, _) -> - collectExpr (collectExpr acc target) key - | ESome (inner, _) - | EParen (inner, _) -> - collectExpr acc inner - | EInterpolatedString (parts, _) -> - parts - |> List.fold (fun state part -> - match part with - | IPText _ -> state - | IPExpr embedded -> collectExpr state embedded) acc - | EUnit _ - | ELiteral _ - | EVar _ - | ENone _ - | ETypeOf _ - | ENameOf _ -> acc - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (_, _, expr, _, _, _) -> - collectExpr state expr - | SLetRecGroup (bindings, _, _) -> - bindings |> List.fold (fun inner (_, _, expr, _) -> collectExpr inner expr) state - | SExpr expr -> - collectExpr state expr - | _ -> state) [] - |> List.rev - - let private buildPatternTypeHints (program: Program) (localTypes: TypeInfer.LocalVariableTypeInfo list) = - let localByNameAndSpan = - localTypes - |> List.map (fun entry -> (entry.Name, entry.Span.Start.Line, entry.Span.Start.Column, entry.Span.End.Line, entry.Span.End.Column), entry.Type) - |> Map.ofList - - collectPatternVariableSpans program - |> List.choose (fun (name, span) -> - let key = (name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column) - localByNameAndSpan - |> Map.tryFind key - |> Option.map (fun t -> span, $": {lspTypeToString t}")) - - let private buildCallArgumentHints (program: Program) (functionParameters: Map) = - let tryParameterNames (name: string) = - match functionParameters |> Map.tryFind name with - | Some names -> Some names - | None -> - let segments = name.Split('.') - if segments.Length > 1 then - functionParameters |> Map.tryFind segments[segments.Length - 1] - else - None - - let rec decomposeApply (expr: Expr) (argsRev: Expr list) = - match expr with - | EApply (fn, arg, _) -> decomposeApply fn (arg :: argsRev) - | _ -> expr, (argsRev |> List.rev) - - let tryCalledName (expr: Expr) = - match expr with - | EVar (name, _) -> Some name - | _ -> None - - let rec collectExpr (acc: (Span * string) list) (isApplySpineParent: bool) (expr: Expr) = - let withChildren = - match expr with - | EApply (f, a, _) -> - collectExpr (collectExpr acc true f) false a - | EIf (c, t, f, _) -> - collectExpr (collectExpr (collectExpr acc false c) false t) false f - | ERaise (inner, _) -> - collectExpr acc false inner - | EFor (_, source, body, _) -> - collectExpr (collectExpr acc false source) false body - | EMatch (scrutinee, cases, _) -> - let withScrutinee = collectExpr acc false scrutinee - cases - |> List.fold (fun state (_, guard, body, _) -> - let withGuard = - match guard with - | Some g -> collectExpr state false g - | None -> state - collectExpr withGuard false body) withScrutinee - | ELet (_, value, body, _, _) -> - collectExpr (collectExpr acc false value) false body - | ELetRecGroup (bindings, body, _) -> - let withBindings = - bindings |> List.fold (fun state (_, _, value, _) -> collectExpr state false value) acc - collectExpr withBindings false body - | ELambda (_, body, _) -> - collectExpr acc false body - | EList (items, _) - | ETuple (items, _) -> - items |> List.fold (fun state item -> collectExpr state false item) acc - | ERange (startExpr, endExpr, _) -> - collectExpr (collectExpr acc false startExpr) false endExpr - | ERecord (fields, _) - | EStructuralRecord (fields, _) -> - fields |> List.fold (fun state (_, value) -> collectExpr state false value) acc - | EMap (entries, _) -> - entries - |> List.fold (fun state entry -> - match entry with - | MEKeyValue (k, v) -> - collectExpr (collectExpr state false k) false v - | MESpread spread -> - collectExpr state false spread) acc - | ERecordUpdate (baseExpr, fields, _) - | EStructuralRecordUpdate (baseExpr, fields, _) -> - let withBase = collectExpr acc false baseExpr - fields |> List.fold (fun state (_, value) -> collectExpr state false value) withBase - | EFieldGet (target, _, _) -> - collectExpr acc false target - | EIndexGet (target, key, _) - | ECons (target, key, _) - | EAppend (target, key, _) - | EBinOp (_, target, key, _) -> - collectExpr (collectExpr acc false target) false key - | ESome (inner, _) - | EParen (inner, _) -> - collectExpr acc false inner - | EInterpolatedString (parts, _) -> - parts - |> List.fold (fun state part -> - match part with - | IPText _ -> state - | IPExpr embedded -> collectExpr state false embedded) acc - | EUnit _ - | ELiteral _ - | EVar _ - | ENone _ - | ETypeOf _ - | ENameOf _ -> acc - - if isApplySpineParent then - withChildren - else - match expr with - | EApply _ -> - let calledExpr, callArgs = decomposeApply expr [] - match tryCalledName calledExpr |> Option.bind tryParameterNames with - | Some parameterNames -> - let normalizedArgs = - match callArgs with - | [ ETuple (items, _) ] when parameterNames.Length > 1 && items.Length > 1 -> items - | _ -> callArgs - let count = min normalizedArgs.Length parameterNames.Length - [ 0 .. count - 1 ] - |> List.fold (fun state index -> - (Ast.spanOfExpr normalizedArgs[index], $"{parameterNames[index]}:") :: state) withChildren - | None -> - withChildren - | _ -> - withChildren - - program - |> List.fold (fun state stmt -> - match stmt with - | SLet (_, _, expr, _, _, _) -> - collectExpr state false expr - | SLetRecGroup (bindings, _, _) -> - bindings |> List.fold (fun inner (_, _, expr, _) -> collectExpr inner false expr) state - | SExpr expr -> - collectExpr state false expr - | _ -> - state) [] - |> List.rev - - let analyzeDocument (uri: string) (text: string) = - let sourceName = - if uri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then - Uri(uri).LocalPath - else - uri - let runtimeExterns = LspRuntimeExterns.forSourcePath sourceName - - let diagnostics = ResizeArray() - let mutable symbols : TopLevelSymbol list = [] - let mutable occurrences : Map = Map.empty - let mutable recordParamFields : Map = Map.empty - let mutable parameterTypeTargets : Map = Map.empty - let mutable functionParameters : Map = Map.empty - let mutable functionAnnotationTypes : Map = Map.empty - let mutable functionDeclaredReturnTargets : Map = Map.empty - let mutable callArgumentHints : (Span * string) list = [] - let mutable functionReturnTypeHints : (Span * string) list = [] - let mutable parameterTypeHints : (Span * string) list = [] - let mutable patternTypeHints : (Span * string) list = [] - let mutable localVariableTypeHints : (Span * string * string) list = [] - let mutable localBindings : LocalBindingInfo list = [] - let mutable injectedFunctionSignatures : Map = Map.empty - let mutable injectedFunctionParameterNames : Map = Map.empty - let mutable injectedFunctionDefinitions : Map = Map.empty - - let mutable parsedProgram : Program option = None - - try - let program = - if uri.StartsWith("file://", StringComparison.OrdinalIgnoreCase) then - InteropServices.parseProgramFromSourceWithIncludes sourceName text - else - FScript.parseWithSourceName (Some sourceName) text - parsedProgram <- Some program - let signatures, parameterNames, definitions = buildInjectedFunctionData runtimeExterns - injectedFunctionSignatures <- signatures - injectedFunctionParameterNames <- parameterNames - injectedFunctionDefinitions <- definitions - occurrences <- collectVariableOccurrences program - recordParamFields <- buildRecordParameterFields program - parameterTypeTargets <- buildParameterTypeTargets program - functionParameters <- buildFunctionParameters program - functionAnnotationTypes <- buildFunctionAnnotationTypes program - functionDeclaredReturnTargets <- buildFunctionDeclaredReturnTargets program - callArgumentHints <- buildCallArgumentHints program functionParameters - localBindings <- buildLocalBindings program - try - let typed, localTypes = InteropServices.inferProgramWithExternsAndLocalVariableTypes runtimeExterns program - symbols <- buildSymbolsFromProgram program (Some typed) - parameterTypeHints <- buildParameterTypeHints program (Some typed) - functionReturnTypeHints <- buildFunctionReturnTypeHints program (Some typed) - patternTypeHints <- buildPatternTypeHints program localTypes - localVariableTypeHints <- - localTypes - |> List.filter (fun entry -> - match entry.Span.Start.File with - | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase) - | None -> true) - |> List.map (fun entry -> entry.Span, entry.Name, lspTypeToString entry.Type) - with - | TypeException err -> - diagnostics.Add(diagnostic 1 "type" err.Span err.Message) - symbols <- buildSymbolsFromProgram program None - let bestEffortTypes = inferTopLevelTypesBestEffort runtimeExterns program - let bestEffortLocalTypes = inferLocalVariableTypesBestEffort runtimeExterns program - let localTypesFromReturnedRecords = - inferLocalTypesFromReturnedRecordFields program functionDeclaredReturnTargets localBindings - let resolveTypeTarget = buildTopLevelTypeTargetFromProgram program - symbols <- - symbols - |> List.map (fun sym -> - match bestEffortTypes |> Map.tryFind sym.Name with - | Some t -> - { sym with - Kind = symbolKindForType t - TypeText = Some (lspTypeToString t) - TypeTargetName = resolveTypeTarget t } - | None -> sym) - parameterTypeHints <- buildParameterTypeHints program None - functionReturnTypeHints <- [] - patternTypeHints <- buildPatternTypeHints program bestEffortLocalTypes - let baseLocalHints = - bestEffortLocalTypes - |> List.filter (fun entry -> - match entry.Span.Start.File with - | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase) - | None -> true) - |> List.map (fun entry -> entry.Span, entry.Name, lspTypeToString entry.Type) - - let refinedLocalHints = - localTypesFromReturnedRecords - |> List.filter (fun (span, _, _) -> - match span.Start.File with - | Some file -> String.Equals(file, sourceName, StringComparison.OrdinalIgnoreCase) - | None -> true) - - let keyOf (span: Span, name: string, _) = - let file = span.Start.File |> Option.defaultValue "" - name, span.Start.Line, span.Start.Column, span.End.Line, span.End.Column, file - - let merged = Dictionary() - - for hint in baseLocalHints do - merged[keyOf hint] <- hint - - for hint in refinedLocalHints do - let key = keyOf hint - match merged.TryGetValue(key) with - | true, (_, _, existingType) when existingType.Contains("unknown", StringComparison.Ordinal) -> - merged[key] <- hint - | false, _ -> - merged[key] <- hint - | _ -> - () - - localVariableTypeHints <- merged.Values |> Seq.toList - - with - | ParseException err -> - diagnostics.Add(diagnostic 1 "parse" err.Span err.Message) - - documents[uri] <- - { Text = text - Symbols = symbols - RecordParameterFields = recordParamFields - ParameterTypeTargets = parameterTypeTargets - FunctionParameters = functionParameters - FunctionAnnotationTypes = functionAnnotationTypes - FunctionDeclaredReturnTargets = functionDeclaredReturnTargets - CallArgumentHints = callArgumentHints - FunctionReturnTypeHints = functionReturnTypeHints - ParameterTypeHints = parameterTypeHints - PatternTypeHints = patternTypeHints - LocalVariableTypeHints = localVariableTypeHints - LocalBindings = localBindings - InjectedFunctionSignatures = injectedFunctionSignatures - InjectedFunctionParameterNames = injectedFunctionParameterNames - InjectedFunctionDefinitions = injectedFunctionDefinitions - VariableOccurrences = occurrences } - publishDiagnostics uri (diagnostics |> Seq.toList) - - let tryResolveSymbol (doc: DocumentState) (line: int) (character: int) : TopLevelSymbol option = - match tryGetWordAtPosition doc.Text line character with - | None -> None - | Some word -> - let candidates = - if word.Contains('.') then - let segments = word.Split('.') |> Array.toList - word :: segments - else - [ word ] - |> List.distinct - - candidates - |> List.tryPick (fun candidate -> - doc.Symbols |> List.tryFind (fun s -> s.Name = candidate)) - - let private splitTopLevelSemicolons (text: string) = - let parts = ResizeArray() - let mutable depthParen = 0 - let mutable depthBrace = 0 - let mutable depthBracket = 0 - let mutable start = 0 - - for i = 0 to text.Length - 1 do - match text[i] with - | '(' -> depthParen <- depthParen + 1 - | ')' -> if depthParen > 0 then depthParen <- depthParen - 1 - | '{' -> depthBrace <- depthBrace + 1 - | '}' -> if depthBrace > 0 then depthBrace <- depthBrace - 1 - | '[' -> depthBracket <- depthBracket + 1 - | ']' -> if depthBracket > 0 then depthBracket <- depthBracket - 1 - | ';' when depthParen = 0 && depthBrace = 0 && depthBracket = 0 -> - let chunk = text.Substring(start, i - start).Trim() - if chunk <> "" then - parts.Add(chunk) - start <- i + 1 - | _ -> () - - if start <= text.Length then - let tail = text.Substring(start).Trim() - if tail <> "" then - parts.Add(tail) - - parts |> Seq.toList - - let private tryParseRecordFields (typeText: string) = - let trimmed = typeText.Trim() - if trimmed.StartsWith("{", StringComparison.Ordinal) && trimmed.EndsWith("}", StringComparison.Ordinal) then - let inner = trimmed.Substring(1, trimmed.Length - 2).Trim() - if inner = "" then - Some [] - else - let fields = - splitTopLevelSemicolons inner - |> List.choose (fun part -> - let idx = part.IndexOf(':') - if idx <= 0 then None - else - let name = part.Substring(0, idx).Trim() - let fieldType = part.Substring(idx + 1).Trim() - if name = "" || fieldType = "" then None else Some (name, fieldType)) - - if fields.IsEmpty then None else Some fields - else - None - - let private tryRecordFieldsForQualifier (doc: DocumentState) (qualifier: string) = - let normalized = - if qualifier.Contains('.') then qualifier.Split('.') |> Array.last - else qualifier - - let sym = - doc.Symbols - |> List.tryFind (fun s -> s.Name = qualifier || s.Name = normalized) - - let tryFromTypeName (typeName: string) = - doc.Symbols - |> List.tryFind (fun s -> s.Kind = 5 && s.Name = typeName) - |> Option.bind (fun s -> s.TypeText) - |> Option.bind tryParseRecordFields - - match sym with - | None -> None - | Some s -> - match s.TypeText |> Option.bind tryParseRecordFields with - | Some fields -> Some fields - | None -> - match s.TypeTargetName with - | Some typeName -> - tryFromTypeName typeName - | None -> - s.TypeText |> Option.bind tryFromTypeName - |> function - | Some fields -> Some fields - | None -> doc.RecordParameterFields |> Map.tryFind normalized - - let private tryResolveNamedRecordTypeByFields (doc: DocumentState) (fields: (string * string) list) = - let wanted = canonicalRecordSignatureFromFields fields - let candidates = - doc.Symbols - |> List.choose (fun s -> - if s.Kind = 5 then - s.TypeText - |> Option.bind tryParseRecordFields - |> Option.map (fun typeFields -> s.Name, canonicalRecordSignatureFromFields typeFields) - else - None) - |> List.choose (fun (name, signature) -> if signature = wanted then Some name else None) - |> List.distinct - match candidates with - | [ one ] -> Some one - | _ -> None - - let private tryResolveTypeNameForQualifier (doc: DocumentState) (qualifier: string) = - let normalized = - if qualifier.Contains('.') then qualifier.Split('.') |> Array.last - else qualifier - - let fromSymbol = - doc.Symbols - |> List.tryFind (fun s -> s.Name = qualifier || s.Name = normalized) - |> Option.bind (fun s -> - match s.TypeTargetName with - | Some t -> Some t - | None -> - s.TypeText - |> Option.bind tryParseRecordFields - |> Option.bind (tryResolveNamedRecordTypeByFields doc)) - - match fromSymbol with - | Some typeName -> Some typeName - | None -> doc.ParameterTypeTargets |> Map.tryFind normalized - - let private tryFindSymbolByName (doc: DocumentState) (name: string) = - let normalized = - if name.Contains('.') then name.Split('.') |> Array.last - else name - doc.Symbols - |> List.tryFind (fun s -> s.Name = name || s.Name = normalized) - - let private tryResolveTypeNameFromSymbol (doc: DocumentState) (symbol: TopLevelSymbol) = - match symbol.TypeTargetName with - | Some typeName -> Some typeName - | None -> - symbol.TypeText - |> Option.bind tryParseRecordFields - |> Option.bind (tryResolveNamedRecordTypeByFields doc) - - let private trimWrappingParens (input: string) = - let mutable value = input.Trim() - let mutable changed = true - while changed && value.Length >= 2 && value[0] = '(' && value[value.Length - 1] = ')' do - changed <- false - let mutable depth = 0 - let mutable wraps = true - for i = 0 to value.Length - 1 do - match value[i] with - | '(' -> depth <- depth + 1 - | ')' -> - depth <- depth - 1 - if depth = 0 && i < value.Length - 1 then - wraps <- false - | _ -> () - if wraps then - value <- value.Substring(1, value.Length - 2).Trim() - changed <- true - value - - let private tryFirstArgumentTypeNameFromFunctionSymbol (doc: DocumentState) (symbol: TopLevelSymbol) = - let tryResolveTypeName (t: string) = - let trimmed = trimWrappingParens t - match doc.Symbols |> List.tryFind (fun s -> s.Kind = 5 && s.Name = trimmed) with - | Some _ -> Some trimmed - | None -> - tryParseRecordFields trimmed - |> Option.bind (tryResolveNamedRecordTypeByFields doc) - - symbol.TypeText - |> Option.bind (fun t -> - let normalizedTypeText = trimWrappingParens t - let arrowIndex = normalizedTypeText.IndexOf("->", StringComparison.Ordinal) - if arrowIndex <= 0 then None - else - let firstArg = normalizedTypeText.Substring(0, arrowIndex).Trim() - tryResolveTypeName firstArg) - - let private tryResolveRecordLiteralCallArgTypeTarget (doc: DocumentState) (line: int) (character: int) = - match getLineText doc.Text line with - | Some lineText -> - let pos = max 0 (min character lineText.Length) - let leftBrace = lineText.LastIndexOf('{', max 0 (pos - 1)) - let rightBrace = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 - if leftBrace < 0 || rightBrace <= leftBrace then - None - else - let segment = lineText.Substring(leftBrace, rightBrace - leftBrace + 1) - if not (segment.Contains('=')) - || segment.Contains(':') then - None - else - let callPrefix = lineText.Substring(0, leftBrace).TrimEnd() - if String.IsNullOrWhiteSpace(callPrefix) then - None - else - let mutable finish = callPrefix.Length - 1 - while finish >= 0 && Char.IsWhiteSpace(callPrefix[finish]) do - finish <- finish - 1 - let mutable start = finish - while start >= 0 && isWordChar callPrefix[start] do - start <- start - 1 - let tokenStart = start + 1 - if tokenStart > finish then - None - else - let callTarget = callPrefix.Substring(tokenStart, finish - tokenStart + 1) - tryFindSymbolByName doc callTarget - |> Option.bind (tryFirstArgumentTypeNameFromFunctionSymbol doc) - | None -> None - - let private tryResolveRecordLiteralBindingTypeTarget (doc: DocumentState) (line: int) (character: int) = - match getLineText doc.Text line with - | Some lineText -> - let pos = max 0 (min character lineText.Length) - let leftBrace = lineText.LastIndexOf('{', max 0 (pos - 1)) - let rightBrace = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 - if leftBrace < 0 || rightBrace <= leftBrace then - None - else - let segment = lineText.Substring(leftBrace, rightBrace - leftBrace + 1) - if not (segment.Contains('=')) - || segment.Contains(':') then - None - else - let prefix = lineText.Substring(0, leftBrace).TrimEnd() - let eqIndex = prefix.LastIndexOf('=') - if eqIndex <= 0 then - None - else - let lhs = prefix.Substring(0, eqIndex).Trim() - if not (lhs.StartsWith("let ", StringComparison.Ordinal)) then - None - else - let afterLet = lhs.Substring(4).Trim() - if String.IsNullOrWhiteSpace(afterLet) then - None - else - let mutable idx = 0 - while idx < afterLet.Length && isWordChar afterLet[idx] do - idx <- idx + 1 - if idx = 0 then - None - else - let bindingName = afterLet.Substring(0, idx) - tryFindSymbolByName doc bindingName - |> Option.bind (tryResolveTypeNameFromSymbol doc) - | None -> None - - let private tryResolveRecordLiteralFunctionReturnTypeTarget (doc: DocumentState) (line: int) (character: int) = - match getLineText doc.Text line with - | None -> None - | Some lineText -> - let pos = max 0 (min character lineText.Length) - let leftBrace = lineText.LastIndexOf('{', max 0 (pos - 1)) - let rightBrace = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 - if leftBrace < 0 || rightBrace <= leftBrace then - None - else - let segment = lineText.Substring(leftBrace, rightBrace - leftBrace + 1) - if not (segment.Contains('=')) - || segment.Contains(':') then - None - else - let isInsideSpan (span: Span) = - let line1 = line + 1 - let col1 = character + 1 - let startsBefore = - line1 > span.Start.Line - || (line1 = span.Start.Line && col1 >= span.Start.Column) - let endsAfter = - line1 < span.End.Line - || (line1 = span.End.Line && col1 <= span.End.Column) - startsBefore && endsAfter - - let spansContainingPosition = - doc.Symbols - |> List.filter (fun sym -> - sym.Kind = 12 - && isInsideSpan sym.Span) - |> List.sortByDescending (fun sym -> sym.Span.Start.Line, sym.Span.Start.Column) - - spansContainingPosition - |> List.tryPick (fun sym -> - match sym.TypeTargetName with - | Some typeName -> Some typeName - | None -> - doc.FunctionDeclaredReturnTargets - |> Map.tryFind sym.Name) - - let private tryExtractInlineRecordAnnotationAtPosition (doc: DocumentState) (line: int) (character: int) = - match getLineText doc.Text line with - | None -> None - | Some lineText -> - let pos = max 0 (min character lineText.Length) - let left = lineText.LastIndexOf('{', max 0 (pos - 1)) - let right = if pos < lineText.Length then lineText.IndexOf('}', pos) else -1 - if left < 0 || right <= left then - None - else - let segment = lineText.Substring(left, right - left + 1) - if segment.Contains(':', StringComparison.Ordinal) && not (segment.Contains('=', StringComparison.Ordinal)) then - tryParseRecordFields segment - else - None - - let tryResolveTypeTargetAtPosition (doc: DocumentState) (line: int) (character: int) : string option = - let fromWord = - match tryGetWordAtPosition doc.Text line character with - | Some word when word.Contains('.') -> - let idx = word.LastIndexOf('.') - if idx > 0 then - let qualifier = word.Substring(0, idx) - tryResolveTypeNameForQualifier doc qualifier - else - None - | Some word -> - tryResolveTypeNameForQualifier doc word - | None -> None - - match fromWord with - | Some typeName -> Some typeName - | None -> - match tryExtractInlineRecordAnnotationAtPosition doc line character with - | Some fields -> - tryResolveNamedRecordTypeByFields doc fields - | None -> - match tryResolveRecordLiteralCallArgTypeTarget doc line character with - | Some t -> Some t - | None -> - match tryResolveRecordLiteralBindingTypeTarget doc line character with - | Some t -> Some t - | None -> tryResolveRecordLiteralFunctionReturnTypeTarget doc line character - - let tryGetRecordFieldHoverInfo (doc: DocumentState) (line: int) (character: int) : (string * string) option = - match tryGetWordAtPosition doc.Text line character with - | Some word when word.Contains('.') -> - let idx = word.LastIndexOf('.') - if idx <= 0 || idx + 1 >= word.Length then - None - else - let qualifier = word.Substring(0, idx) - let fieldName = word.Substring(idx + 1) - tryRecordFieldsForQualifier doc qualifier - |> Option.bind (fun fields -> - fields - |> List.tryFind (fun (name, _) -> name = fieldName)) - | _ -> - None - - let private spanContainsPosition (span: Span) (line: int) (character: int) = - let line1 = line + 1 - let col1 = character + 1 - let startsBefore = - line1 > span.Start.Line - || (line1 = span.Start.Line && col1 >= span.Start.Column) - let endsAfter = - line1 < span.End.Line - || (line1 = span.End.Line && col1 <= span.End.Column) - startsBefore && endsAfter - - let tryGetLocalVariableHoverInfo (doc: DocumentState) (line: int) (character: int) : (string * string) option = - let bySpan = - doc.LocalVariableTypeHints - |> List.tryFind (fun (span, _, _) -> spanContainsPosition span line character) - |> Option.map (fun (_, name, typeText) -> name, typeText) - - match bySpan with - | Some _ -> bySpan - | None -> - match tryGetWordAtPosition doc.Text line character with - | Some word -> - let isOnTopLevelSymbol = - doc.Symbols - |> List.exists (fun sym -> - String.Equals(sym.Name, word, StringComparison.Ordinal) - && spanContainsPosition sym.Span line character) - - if isOnTopLevelSymbol then - None - else - let candidates = - doc.LocalBindings - |> List.filter (fun binding -> - String.Equals(binding.Name, word, StringComparison.Ordinal) - && (spanContainsPosition binding.ScopeSpan line character - || spanContainsPosition binding.DeclSpan line character)) - - let scoreBinding (binding: LocalBindingInfo) = - let line1 = line + 1 - let col1 = character + 1 - let lineDistance = abs (binding.DeclSpan.Start.Line - line1) - let colDistance = abs (binding.DeclSpan.Start.Column - col1) - let startsBefore = - binding.DeclSpan.Start.Line < line1 - || (binding.DeclSpan.Start.Line = line1 && binding.DeclSpan.Start.Column <= col1) - if startsBefore then (0, lineDistance, colDistance) else (1, lineDistance, colDistance) - - let nearestBinding = - candidates - |> List.sortBy scoreBinding - |> List.tryHead - - let inferredTypeForBinding (binding: LocalBindingInfo) = - let byDeclSpan = - doc.LocalVariableTypeHints - |> List.tryFind (fun (span, name, _) -> - String.Equals(name, binding.Name, StringComparison.Ordinal) - && span.Start.Line = binding.DeclSpan.Start.Line - && span.Start.Column = binding.DeclSpan.Start.Column - && span.End.Line = binding.DeclSpan.End.Line - && span.End.Column = binding.DeclSpan.End.Column) - |> Option.map (fun (_, _, t) -> t) - - match byDeclSpan with - | Some _ -> byDeclSpan - | None -> - doc.LocalVariableTypeHints - |> List.choose (fun (span, name, t) -> - if String.Equals(name, binding.Name, StringComparison.Ordinal) - && spanContainsPosition binding.ScopeSpan (span.Start.Line - 1) (span.Start.Column - 1) then - Some t - else - None) - |> List.distinct - |> function - | [ one ] -> Some one - | _ -> None - - nearestBinding - |> Option.map (fun binding -> - let typeText = - inferredTypeForBinding binding - |> Option.orElse binding.AnnotationType - |> Option.defaultValue "unknown" - binding.Name, typeText) - | None -> - None - - let private tryMemberCompletionItems (doc: DocumentState) (prefix: string option) = - match prefix with - | Some p when p.Contains('.') -> - let idx = p.LastIndexOf('.') - if idx <= 0 then None - else - let qualifier = p.Substring(0, idx) - let memberPrefix = - if idx + 1 < p.Length then p.Substring(idx + 1) else "" - - match tryRecordFieldsForQualifier doc qualifier with - | Some fields -> - let filtered = - fields - |> List.filter (fun (name, _) -> - memberPrefix = "" || name.StartsWith(memberPrefix, StringComparison.Ordinal)) - - let items = - filtered - |> List.map (fun (name, fieldType) -> - let item = JsonObject() - item["label"] <- JsonValue.Create(name) - item["kind"] <- JsonValue.Create(10) - item["detail"] <- JsonValue.Create(fieldType) - item["filterText"] <- JsonValue.Create(name) - item["sortText"] <- JsonValue.Create($"0_{name}") - if memberPrefix = name then - item["preselect"] <- JsonValue.Create(true) - item :> JsonNode) - |> List.toArray - - Some (JsonArray(items)) - | None -> - None - | _ -> None - - let makeCompletionItems (doc: DocumentState) (prefix: string option) = - match tryMemberCompletionItems doc prefix with - | Some memberItems -> memberItems - | None -> - let symbols = doc.Symbols - let keywords = - [ "let"; "rec"; "and"; "if"; "then"; "elif"; "else"; "match"; "with"; "when" - "for"; "in"; "do"; "type"; "module"; "true"; "false"; "None"; "Some" ] - - let keywordItems = - keywords - |> List.map (fun kw -> - let item = JsonObject() - item["label"] <- JsonValue.Create(kw) - item["kind"] <- JsonValue.Create(14) - item["filterText"] <- JsonValue.Create(kw) - item["sortText"] <- JsonValue.Create($"9_{kw}") - match prefix with - | Some p when p = kw -> item["preselect"] <- JsonValue.Create(true) - | _ -> () - item) - - let namePool = - [ for s in symbols -> s.Name - for kv in doc.InjectedFunctionSignatures -> kv.Key - yield! stdlibNames - yield! builtinNames ] - |> List.distinct - - let filteredNames = - namePool - |> List.filter (fun name -> - match prefix with - | Some p when p <> "" -> - if p.Contains('.') then - // When user types a dotted qualifier, avoid flooding with unrelated names. - name.StartsWith(p, StringComparison.Ordinal) - else - name.StartsWith(p, StringComparison.Ordinal) - | _ -> true) - |> List.sortBy (fun name -> - let localPriority = - if name.Contains('.') then 1 else 0 - (localPriority, name.Length, name)) - - let symbolItems = - filteredNames - |> List.map (fun name -> - let symbolType = symbols |> List.tryFind (fun s -> s.Name = name) |> Option.bind (fun s -> s.TypeText) - let injectedType = doc.InjectedFunctionSignatures |> Map.tryFind name - let kind = - match symbols |> List.tryFind (fun s -> s.Name = name) with - | Some s -> s.Kind - | None -> - if doc.InjectedFunctionSignatures.ContainsKey(name) then 12 else 3 - let item = JsonObject() - item["label"] <- JsonValue.Create(name) - item["kind"] <- JsonValue.Create(kind) - item["filterText"] <- JsonValue.Create(name) - let sortPrefix = if name.Contains('.') then "1" else "0" - item["sortText"] <- JsonValue.Create($"{sortPrefix}_{name}") - match prefix with - | Some p when p = name -> item["preselect"] <- JsonValue.Create(true) - | _ -> () - match symbolType with - | Some t -> item["detail"] <- JsonValue.Create(t) - | None -> - match injectedType with - | Some t -> item["detail"] <- JsonValue.Create(t) - | None -> () - item) - - let rankedItems = - match prefix with - | Some p when p <> "" -> - let keywordMatches = - keywordItems - |> List.filter (fun item -> - match item["label"] with - | :? JsonValue as label -> - try - let kw = label.GetValue() - if p.Contains('.') then false - else kw.StartsWith(p, StringComparison.Ordinal) - with _ -> false - | _ -> false) - symbolItems @ keywordMatches - | _ -> - keywordItems @ symbolItems - - let nodes = rankedItems |> List.map (fun n -> n :> JsonNode) - JsonArray(nodes |> List.toArray) - - let tryGetCallTargetPrefixAtPosition (text: string) (line: int) (character: int) : string option = - match getLineText text line with - | None -> None - | Some lineText -> - if lineText.Length = 0 then None - else - let pos = max 0 (min character lineText.Length) - let mutable idx = pos - 1 - - while idx >= 0 && Char.IsWhiteSpace(lineText[idx]) do - idx <- idx - 1 - - if idx < 0 then None - else - let mutable finish = idx + 1 - let mutable start = idx - - while start >= 0 && isWordChar lineText[start] do - start <- start - 1 - - let tokenStart = start + 1 - if tokenStart < finish then Some(lineText.Substring(tokenStart, finish - tokenStart)) else None - - let findSymbolRangesInText (text: string) (candidateNames: string list) = - let names = candidateNames |> List.distinct |> Set.ofList - let lines = text.Split('\n') - - lines - |> Array.mapi (fun lineIndex rawLine -> - let line = rawLine.TrimEnd('\r') - let mutable i = 0 - let found = ResizeArray() - - while i < line.Length do - if isWordChar line[i] then - let start = i - let mutable j = i + 1 - while j < line.Length && isWordChar line[j] do - j <- j + 1 - - let token = line.Substring(start, j - start) - if names.Contains token then - let span = - Span.mk - (Span.pos (lineIndex + 1) (start + 1)) - (Span.pos (lineIndex + 1) (j + 1)) - found.Add(span) - - i <- j - else - i <- i + 1 - - found |> Seq.toList) - |> Array.toList - |> List.concat From 7d0243c3cbd144c5665c15ebafd8cf72bfebcba0 Mon Sep 17 00:00:00 2001 From: Pierre Chalamet Date: Sat, 14 Feb 2026 21:20:31 +0100 Subject: [PATCH 14/14] Adjust CI triggers for PR branch updates --- .github/workflows/ci-main.yml | 1 - .github/workflows/ci-pr.yml | 5 +++++ CHANGELOG.md | 1 + 3 files changed, 6 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci-main.yml b/.github/workflows/ci-main.yml index ab5644e..6948614 100644 --- a/.github/workflows/ci-main.yml +++ b/.github/workflows/ci-main.yml @@ -4,7 +4,6 @@ on: push: branches: - main - - feature/* workflow_dispatch: permissions: diff --git a/.github/workflows/ci-pr.yml b/.github/workflows/ci-pr.yml index f8bbf03..c253063 100644 --- a/.github/workflows/ci-pr.yml +++ b/.github/workflows/ci-pr.yml @@ -4,6 +4,11 @@ on: pull_request: branches: - main + types: + - opened + - reopened + - synchronize + - ready_for_review permissions: contents: read diff --git a/CHANGELOG.md b/CHANGELOG.md index d50816a..88ae809 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -8,6 +8,7 @@ All notable changes to FScript are documented in this file. - Replaced `FScript.LanguageServer.Tests` project with a C# test project and C# LSP test harness to remove F# compile cost from LanguageServer test builds. - Deleted obsolete F# LanguageServer test sources after C# test project migration. - Renamed `FScript.CSharpInterop/LanguageServerLegacy` to `FScript.CSharpInterop/LanguageServer` to reflect the new primary architecture. +- CI now runs branch update builds on PR `synchronize` events while keeping `ci-main` scoped to `main` pushes to avoid duplicate runs. - Enabled F# preview parallel compilation globally, disabled deterministic builds, and removed global RuntimeIdentifiers to reduce CI build latency. - Added `FScript.CSharpInterop` as a stable bridge for parse/infer/runtime-extern/stdlib-source services and wired LanguageServer through it. - Added `FScript.LanguageServer` host executable as the migration entrypoint for C#-owned LSP startup.