Extension config

src/FSharp.Compiler.LanguageServer/Common/CapabilitiesManager.fs

@@ -2,43 +2,62 @@
 
 open Microsoft.VisualStudio.LanguageServer.Protocol
 open Microsoft.CommonLanguageServerProtocol.Framework
+open FSharp.Compiler.LanguageServer
 
 type IServerCapabilitiesOverride =
-    abstract member OverrideServerCapabilities: ServerCapabilities -> ServerCapabilities
+    abstract member OverrideServerCapabilities: FSharpLanguageServerConfig * ServerCapabilities * ClientCapabilities -> ServerCapabilities
 
-type CapabilitiesManager(scOverrides: IServerCapabilitiesOverride seq) =
+type CapabilitiesManager(config: FSharpLanguageServerConfig, scOverrides: IServerCapabilitiesOverride seq) =
 
     let mutable initializeParams = None
 
-    let defaultCapabilities =
+    let getInitializeParams () =
+        match initializeParams with
+        | Some params' -> params'
+        | None -> failwith "InitializeParams is null"
+
+    let addIf (enabled: bool) (capability: 'a) =
+        if enabled then capability |> withNull else null
+
+    let defaultCapabilities (clientCapabilities: ClientCapabilities) =
+        // TODO: don't register if dynamic registraion is supported
         ServerCapabilities(
             TextDocumentSync = TextDocumentSyncOptions(OpenClose = true, Change = TextDocumentSyncKind.Full),
             DiagnosticOptions =
-                DiagnosticOptions(WorkDoneProgress = true, InterFileDependencies = true, Identifier = "potato", WorkspaceDiagnostics = true),
+                addIf
+                    config.EnabledFeatures.Diagnostics
+                    (DiagnosticOptions(
+                        WorkDoneProgress = true,
+                        InterFileDependencies = true,
+                        Identifier = "potato",
+                        WorkspaceDiagnostics = true
+                    )),
             //CompletionProvider = CompletionOptions(TriggerCharacters = [| "."; " " |], ResolveProvider = true, WorkDoneProgress = true),
             //HoverProvider = SumType<bool, HoverOptions>(HoverOptions(WorkDoneProgress = true))
             SemanticTokensOptions =
-                SemanticTokensOptions(
-                    Legend =
-                        SemanticTokensLegend(
-                            TokenTypes = (SemanticTokenTypes.AllTypes |> Seq.toArray), // XXX should be extended
-                            TokenModifiers = (SemanticTokenModifiers.AllModifiers |> Seq.toArray)
-                        ),
-                    Range = false
-                )
+                addIf
+                    config.EnabledFeatures.SemanticHighlighting
+
+                    (SemanticTokensOptions(
+                        Legend =
+                            SemanticTokensLegend(
+                                TokenTypes = (SemanticTokenTypes.AllTypes |> Seq.toArray), // XXX should be extended
+                                TokenModifiers = (SemanticTokenModifiers.AllModifiers |> Seq.toArray)
+                            ),
+                        Range = false
+                    ))
         )
 
     interface IInitializeManager<InitializeParams, InitializeResult> with
         member this.SetInitializeParams(request) = initializeParams <- Some request
 
+        member this.GetInitializeParams() = getInitializeParams ()
+
         member this.GetInitializeResult() =
+            let clientCapabilities = getInitializeParams().Capabilities
+
             let serverCapabilities =
-                (defaultCapabilities, scOverrides)
-                ||> Seq.fold (fun acc (x: IServerCapabilitiesOverride) -> x.OverrideServerCapabilities acc)
+                (defaultCapabilities clientCapabilities, scOverrides)
+                ||> Seq.fold (fun acc (x: IServerCapabilitiesOverride) -> x.OverrideServerCapabilities(config, acc, clientCapabilities))
 
             InitializeResult(Capabilities = serverCapabilities)
-
-        member this.GetInitializeParams() =
-            match initializeParams with
-            | Some params' -> params'
-            | None -> failwith "InitializeParams is null"

src/FSharp.Compiler.LanguageServer/FSharp.Compiler.LanguageServer.fsproj

@@ -34,6 +34,7 @@
 	<ItemGroup>
 		<Compile Include="..\..\vsintegration\src\FSharp.Editor\Common\CancellableTasks.fs" />
 		<Compile Include="Utils.fs" />
+		<Compile Include="FSharpLanguageServerConfig.fs" />
 		<Compile Include="Common\LifecycleManager.fs" />
 		<Compile Include="Common\CapabilitiesManager.fs" />
 		<Compile Include="Common\FSharpRequestContext.fs" />

src/FSharp.Compiler.LanguageServer/FSharpLanguageServer.fs

@@ -30,11 +30,18 @@ type Extensions =
         Async.StartAsTask(this, cancellationToken = ct)
 
 type FSharpLanguageServer
-    (jsonRpc: JsonRpc, logger: ILspLogger, ?initialWorkspace: FSharpWorkspace, ?addExtraHandlers: Action<IServiceCollection>) =
+    (
+        jsonRpc: JsonRpc,
+        logger: ILspLogger,
+        ?initialWorkspace: FSharpWorkspace,
+        ?addExtraHandlers: Action<IServiceCollection>,
+        ?config: FSharpLanguageServerConfig
+    ) =
 
     // TODO: Switch to SystemTextJsonLanguageServer
     inherit NewtonsoftLanguageServer<FSharpRequestContext>(jsonRpc, Newtonsoft.Json.JsonSerializer.CreateDefault(), logger)
 
+    let config = defaultArg config FSharpLanguageServerConfig.Default
     let initialWorkspace = defaultArg initialWorkspace (FSharpWorkspace())
 
     do
@@ -50,6 +57,7 @@ type FSharpLanguageServer
             serviceCollection
                 .AddSingleton(initialWorkspace)
                 .AddSingleton<ContextHolder>()
+                .AddSingleton<FSharpLanguageServerConfig>(config)
                 .AddSingleton<IMethodHandler, InitializeHandler<InitializeParams, InitializeResult, FSharpRequestContext>>()
                 .AddSingleton<IMethodHandler, InitializedHandler<InitializedParams, FSharpRequestContext>>()
                 .AddSingleton<IMethodHandler, DocumentStateHandler>()
@@ -77,7 +85,16 @@ type FSharpLanguageServer
     static member Create(initialWorkspace, addExtraHandlers: Action<IServiceCollection>) =
         FSharpLanguageServer.Create(LspLogger System.Diagnostics.Trace.TraceInformation, initialWorkspace, addExtraHandlers)
 
-    static member Create(logger: ILspLogger, initialWorkspace, ?addExtraHandlers: Action<IServiceCollection>) =
+    static member Create(initialWorkspace, config: FSharpLanguageServerConfig, addExtraHandlers: Action<IServiceCollection>) =
+        FSharpLanguageServer.Create(LspLogger System.Diagnostics.Trace.TraceInformation, initialWorkspace, addExtraHandlers, config)
+
+    static member Create
+        (
+            logger: ILspLogger,
+            initialWorkspace,
+            ?addExtraHandlers: Action<IServiceCollection>,
+            ?config: FSharpLanguageServerConfig
+        ) =
 
         let struct (clientStream, serverStream) = FullDuplexStream.CreatePair()
 
@@ -96,7 +113,7 @@ type FSharpLanguageServer
         jsonRpc.TraceSource.Switch.Level <- SourceLevels.All
 
         let server =
-            new FSharpLanguageServer(jsonRpc, logger, initialWorkspace, ?addExtraHandlers = addExtraHandlers)
+            new FSharpLanguageServer(jsonRpc, logger, initialWorkspace, ?addExtraHandlers = addExtraHandlers, ?config = config)
 
         jsonRpc.StartListening()
 

src/FSharp.Compiler.LanguageServer/FSharpLanguageServerConfig.fs

@@ -0,0 +1,23 @@
+namespace FSharp.Compiler.LanguageServer
+
+type FSharpLanguageServerFeatures =
+    {
+        Diagnostics: bool
+        SemanticHighlighting: bool
+    }
+
+    static member Default =
+        {
+            Diagnostics = true
+            SemanticHighlighting = true
+        }
+
+type FSharpLanguageServerConfig =
+    {
+        EnabledFeatures: FSharpLanguageServerFeatures
+    }
+
+    static member Default =
+        {
+            EnabledFeatures = FSharpLanguageServerFeatures.Default
+        }

src/FSharp.VisualStudio.Extension/ExtensionEntrypoint.cs

@@ -2,6 +2,8 @@
 
 using Microsoft.Extensions.DependencyInjection;
 using Microsoft.VisualStudio.Extensibility;
+using System.Threading;
+using System;
 using Extension = Microsoft.VisualStudio.Extensibility.Extension;
 
 /// <summary>

src/FSharp.VisualStudio.Extension/FSharp.VisualStudio.Extension.csproj

@@ -9,10 +9,10 @@
 	</PropertyGroup>
 
 	<ItemGroup>
-		<PackageReference Include="Microsoft.VisualStudio.Extensibility.Sdk" Version="17.13.39351" />
-		<PackageReference Include="Microsoft.VisualStudio.Extensibility.Build" Version="17.13.39351" />
-		<PackageReference Include="Microsoft.VisualStudio.LanguageServer.Protocol.Internal" Version="17.13.7-preview" />
-		<PackageReference Include="Microsoft.VisualStudio.ProjectSystem.Query" Version="17.13.53-pre-g2e2e7c24c7" />
+		<PackageReference Include="Microsoft.VisualStudio.Extensibility.Sdk" Version="17.13.39620" />
+		<PackageReference Include="Microsoft.VisualStudio.Extensibility.Build" Version="17.13.39620" />
+		<PackageReference Include="Microsoft.VisualStudio.LanguageServer.Protocol.Internal" Version="17.13.9" />
+		<PackageReference Include="Microsoft.VisualStudio.ProjectSystem.Query" Version="17.13.66" />
 		<PackageReference Include="Microsoft.VisualStudio.Threading" Version="17.13.2" />
 		<!--<PackageReference Include="Microsoft.VisualStudio.OpenTelemetry.ClientExtensions" Version="0.1.718-beta" />
 		<PackageReference Include="Microsoft.VisualStudio.OpenTelemetry.Collector" Version="0.1.718-beta" />

src/FSharp.VisualStudio.Extension/FSharpExtensionSettings.cs

@@ -0,0 +1,55 @@
+using Microsoft.VisualStudio.Extensibility;
+using Microsoft.VisualStudio.Extensibility.Settings;
+
+namespace FSharp.VisualStudio.Extension
+{
+#pragma warning disable VSEXTPREVIEW_SETTINGS // The settings API is currently in preview and marked as experimental
+
+    internal static class FSharpExtensionSettings
+    {
+        public const string OLD = "old";
+        public const string LSP = "lsp";
+        public const string BOTH = "both";
+        public const string UNSET = "unset";
+
+        public static EnumSettingEntry[] ExtensionChoice { get; } =
+        [
+            new(OLD, "%FSharpSettings.Old%"),
+            new(LSP, "%FSharpSettings.LSP%"),
+            new(BOTH, "%FSharpSettings.Both%"),
+            new(UNSET, "%FSharpSettings.Unset%"),
+        ];
+
+
+        [VisualStudioContribution]
+        public static SettingCategory FSharpCategory { get; } = new("fsharp", "%F#%");
+
+        [VisualStudioContribution]
+        public static Setting.Enum GetDiagnosticsFrom { get; } = new(
+            "getDiagnosticsFrom",
+            "%FSharpSettings.GetDiagnosticsFrom%",
+            FSharpCategory,
+            ExtensionChoice,
+            defaultValue: UNSET)
+        {
+            Description = "%Which extension should be used to provide diagnostics%",
+        };
+
+        [VisualStudioContribution]
+        public static Setting.Enum GetSemanticHighlightingFrom { get; } = new(
+            "getSemanticHighlightingFrom",
+            "%FSharpSettings.GetSemanticHighlightingFrom%",
+            FSharpCategory,
+            ExtensionChoice,
+            defaultValue: UNSET)
+        {
+            Description = "%Which extension should be used to provide semantic highlighting%",
+        };
+
+        public static Setting<string>[] AllStringSettings { get; } =
+        [
+            GetDiagnosticsFrom,
+            GetSemanticHighlightingFrom,
+        ];
+    }
+}

src/FSharp.VisualStudio.Extension/FSharpLanguageServerProvider.cs

@@ -22,6 +22,7 @@ namespace FSharp.VisualStudio.Extension;
 using Microsoft.VisualStudio.Extensibility;
 using Microsoft.VisualStudio.Extensibility.Editor;
 using Microsoft.VisualStudio.Extensibility.LanguageServer;
+using Microsoft.VisualStudio.Extensibility.Settings;
 using Microsoft.VisualStudio.LanguageServer.Protocol;
 using Microsoft.VisualStudio.ProjectSystem.Query;
 using Microsoft.VisualStudio.RpcContracts.LanguageServerProvider;
@@ -41,14 +42,17 @@ internal static class Extensions
 
 internal class VsServerCapabilitiesOverride : IServerCapabilitiesOverride
 {
-    public ServerCapabilities OverrideServerCapabilities(ServerCapabilities value)
+    public ServerCapabilities OverrideServerCapabilities(FSharpLanguageServerConfig config, ServerCapabilities value, ClientCapabilities clientCapabilities)
     {
         var capabilities = new VSInternalServerCapabilities
         {
             TextDocumentSync = value.TextDocumentSync,
             SupportsDiagnosticRequests = true,
             ProjectContextProvider = true,
-            DiagnosticProvider = new()
+            DiagnosticProvider =
+                config.EnabledFeatures.Diagnostics ?
+
+            new()
             {
                 SupportsMultipleContextsDiagnostics = true,
                 DiagnosticKinds = [
@@ -67,8 +71,8 @@ public ServerCapabilities OverrideServerCapabilities(ServerCapabilities value)
                         //new(PullDiagnosticCategories.DocumentAnalyzerSyntax),
                         //new(PullDiagnosticCategories.DocumentAnalyzerSemantic),
                     ]
-            },
-            SemanticTokensOptions = new()
+            } : null,
+            SemanticTokensOptions = config.EnabledFeatures.SemanticHighlighting ? new()
             {
                 Legend = new()
                 {
@@ -80,7 +84,7 @@ public ServerCapabilities OverrideServerCapabilities(ServerCapabilities value)
                     Delta = false
                 },
                 Range = false
-            }
+            } : null,
             //,
             //HoverProvider = new HoverOptions()
             //{
@@ -268,6 +272,41 @@ internal class FSharpLanguageServerProvider : LanguageServerProvider
 
         FSharp.Compiler.LanguageServer.Activity.listenToSome();
 
+#pragma warning disable VSEXTPREVIEW_SETTINGS // Type is for evaluation purposes only and is subject to change or removal in future updates. Suppress this diagnostic to proceed.
+
+        // Write default settings unless they're overridden. Otherwise users can't even find which settings exist.
+
+        var settingsReadResult = await this.Extensibility.Settings().ReadEffectiveValuesAsync(FSharpExtensionSettings.AllStringSettings, cancellationToken);
+
+        var settingValues = FSharpExtensionSettings.AllStringSettings.Select(
+            setting => (setting, settingsReadResult.ValueOrDefault(setting, defaultValue: FSharpExtensionSettings.UNSET)));
+
+        foreach (var (setting, value) in settingValues.Where(x => x.Item2 == FSharpExtensionSettings.UNSET))
+        {
+            await this.Extensibility.Settings().WriteAsync(batch =>
+                batch.WriteSetting(setting, FSharpExtensionSettings.BOTH), "write default settings", cancellationToken);
+        }
+
+        var enabled = new[] { FSharpExtensionSettings.LSP, FSharpExtensionSettings.BOTH };
+
+        var serverConfig = new FSharpLanguageServerConfig(
+            new FSharpLanguageServerFeatures(
+                diagnostics: enabled.Contains(settingsReadResult.ValueOrDefault(FSharpExtensionSettings.GetDiagnosticsFrom, defaultValue: FSharpExtensionSettings.BOTH)),
+                semanticHighlighting: enabled.Contains(settingsReadResult.ValueOrDefault(FSharpExtensionSettings.GetSemanticHighlightingFrom, defaultValue: FSharpExtensionSettings.BOTH))
+                ));
+
+        var disposeToEndSubscription =
+            this.Extensibility.Settings().SubscribeAsync(
+                [FSharpExtensionSettings.FSharpCategory],
+                cancellationToken,
+                changeHandler: result =>
+                {
+                    Trace.TraceInformation($"Settings update", result);
+                });
+
+#pragma warning restore VSEXTPREVIEW_SETTINGS // Type is for evaluation purposes only and is subject to change or removal in future updates. Suppress this diagnostic to proceed.
+
+
         //const string vsMajorVersion = "17.0";
 
         //var settings = OpenTelemetryExporterSettingsBuilder
@@ -333,8 +372,7 @@ internal class FSharpLanguageServerProvider : LanguageServerProvider
             // observer.ProcessProject(project);
         }
 
-
-        var ((inputStream, outputStream), _server) = FSharpLanguageServer.Create(workspace, (serviceCollection) =>
+        var ((inputStream, outputStream), _server) = FSharpLanguageServer.Create(workspace, serverConfig, (serviceCollection) =>
         {
             serviceCollection.AddSingleton<IServerCapabilitiesOverride, VsServerCapabilitiesOverride>();
             serviceCollection.AddSingleton<IMethodHandler, VsDiagnosticsHandler>();
@@ -357,7 +395,7 @@ internal class FSharpLanguageServerProvider : LanguageServerProvider
         return new DuplexPipe(
             PipeReader.Create(inputStream),
             PipeWriter.Create(outputStream));
-        }
+    }
 
     /// <inheritdoc/>
     public override Task OnServerInitializationResultAsync(ServerInitializationResult serverInitializationResult, LanguageServerInitializationFailureInfo? initializationFailureInfo, CancellationToken cancellationToken)

vsintegration/src/FSharp.Editor/Classification/ClassificationService.fs

@@ -32,6 +32,9 @@ type SemanticClassificationLookup = IReadOnlyDictionary<int, ResizeArray<Semanti
 [<Export(typeof<IFSharpClassificationService>)>]
 type internal FSharpClassificationService [<ImportingConstructor>] () =
 
+    static let shouldProduceClassification (document: Document) =
+        document.Project.Solution.GetFSharpExtensionConfig().ShouldProduceSemanticHighlighting()
+
     static let getLexicalClassifications (filePath: string, defines, text: SourceText, textSpan: TextSpan, ct: CancellationToken) =
 
         let text = text.GetSubText(textSpan)
@@ -155,6 +158,11 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                 result: List<ClassifiedSpan>,
                 cancellationToken: CancellationToken
             ) =
+
+            if not (document |> shouldProduceClassification) then
+                System.Threading.Tasks.Task.CompletedTask
+                else
+
             cancellableTask {
                 use _logBlock = Logger.LogBlock(LogEditorFunctionId.Classification_Syntactic)
 
@@ -207,6 +215,11 @@ type internal FSharpClassificationService [<ImportingConstructor>] () =
                 result: List<ClassifiedSpan>,
                 cancellationToken: CancellationToken
             ) =
+
+            if not (document |> shouldProduceClassification) then
+                System.Threading.Tasks.Task.CompletedTask
+                else
+
             cancellableTask {
                 use _logBlock = Logger.LogBlock(LogEditorFunctionId.Classification_Semantic)