From 4940b36747564b1ac08e7dc3cac99d45d94b0643 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Saulius=20Menkevi=C4=8Dius?=
 <sauliusmenkevicius@fastmail.com>
Date: Tue, 20 Feb 2024 09:00:49 +0200
Subject: [PATCH] CSharpLanguageServer.Program: add logging to ILspClient (not
 functional yet)

---
 src/CSharpLanguageServer/Lsp/Server.fs | 21 ++++++++++----
 src/CSharpLanguageServer/Program.fs    |  6 +++-
 src/CSharpLanguageServer/Util.fs       | 39 +++++++++++++++++++++++++-
 3 files changed, 58 insertions(+), 8 deletions(-)

diff --git a/src/CSharpLanguageServer/Lsp/Server.fs b/src/CSharpLanguageServer/Lsp/Server.fs
index 4a2ae324..be561818 100644
--- a/src/CSharpLanguageServer/Lsp/Server.fs
+++ b/src/CSharpLanguageServer/Lsp/Server.fs
@@ -27,7 +27,11 @@ module LspUtils =
 
 open LspUtils
 
-type CSharpLspServer(lspClient: CSharpLspClient, settings: ServerSettings) =
+type CSharpLspServer(
+        lspClient: CSharpLspClient,
+        settings: ServerSettings,
+        lspClientLogEventSink: LspClientLogEventSink
+    ) =
 
     let logger = LogProvider.getLoggerByName "LSP"
 
@@ -148,6 +152,8 @@ type CSharpLspServer(lspClient: CSharpLspClient, settings: ServerSettings) =
         override __.Dispose() = ()
 
         override __.Initialize(p) =
+            lspClientLogEventSink.SetLspClient(Some lspClient)
+
             let serverCapabilities = getServerCapabilities p
             p |> withReadWriteScope (Initialization.handleInitialize setupTimer serverCapabilities)
 
@@ -155,7 +161,10 @@ type CSharpLspServer(lspClient: CSharpLspClient, settings: ServerSettings) =
             p |> withReadWriteScope (Initialization.handleInitialized lspClient stateActor)
               |> ignoreResult
 
-        override __.Shutdown() = ignoreNotification
+        override __.Shutdown() = async {
+            lspClientLogEventSink.SetLspClient(None)
+            ()
+        }
 
         override __.Exit() = ignoreNotification
 
@@ -363,12 +372,12 @@ module Server =
     let private requestHandlings =
         Map.union (defaultRequestHandlings ()) customRequestHandlings
 
-    let startCore settings =
+    let startCore settings lspClientLogEventSink =
         use input = Console.OpenStandardInput()
         use output = Console.OpenStandardOutput()
 
         let serverCreator client =
-            new CSharpLspServer(client, settings) :> ICSharpLspServer
+            new CSharpLspServer(client, settings, lspClientLogEventSink) :> ICSharpLspServer
 
         let clientCreator = CSharpLspClient
 
@@ -380,9 +389,9 @@ module Server =
             serverCreator
             createRpc
 
-    let start options =
+    let start options lspClientLogEventSink =
         try
-            let result = startCore options
+            let result = startCore options lspClientLogEventSink
             int result
         with ex ->
             logger.error (
diff --git a/src/CSharpLanguageServer/Program.fs b/src/CSharpLanguageServer/Program.fs
index 0283730f..47f2c45b 100644
--- a/src/CSharpLanguageServer/Program.fs
+++ b/src/CSharpLanguageServer/Program.fs
@@ -11,6 +11,7 @@ open Serilog.Events
 open CSharpLanguageServer.Types
 open CSharpLanguageServer.Lsp
 open CSharpLanguageServer.Logging
+open CSharpLanguageServer.Util
 
 [<EntryPoint>]
 let entry args =
@@ -35,10 +36,13 @@ let entry args =
                 | "log" -> LogEventLevel.Verbose
                 | _ -> LogEventLevel.Information
 
+        let lspClientLogEventSink = LspClientLogEventSink(formatProvider = null)
+
         let logConfig =
                 LoggerConfiguration()
                     .MinimumLevel.ControlledBy(LoggingLevelSwitch(logLevel))
                     .Enrich.FromLogContext()
+                    .WriteTo.Sink(lspClientLogEventSink)
                     .WriteTo.Async(fun conf ->
                         conf.Console(
                             outputTemplate =
@@ -56,7 +60,7 @@ let entry args =
             LogLevel = logLevelArg
         }
 
-        Server.start settings
+        Server.start settings lspClientLogEventSink
     with
     | :? ArguParseException as ex ->
         printfn "%s" ex.Message
diff --git a/src/CSharpLanguageServer/Util.fs b/src/CSharpLanguageServer/Util.fs
index 33c01f5b..be625015 100644
--- a/src/CSharpLanguageServer/Util.fs
+++ b/src/CSharpLanguageServer/Util.fs
@@ -3,7 +3,15 @@ module CSharpLanguageServer.Util
 open System
 open System.Runtime.InteropServices
 open System.IO
-open Microsoft.CodeAnalysis.Classification;
+
+open Ionide.LanguageServerProtocol
+open Ionide.LanguageServerProtocol.Types
+open Microsoft.CodeAnalysis.Classification
+open Serilog
+open Serilog.Core
+open Serilog.Sinks
+open Serilog.Events
+open Serilog.Configuration
 
 let parseFileUri s: string =
     Uri(s).LocalPath
@@ -121,3 +129,32 @@ let GetSemanticTokenModifierFlagFromClassification (classification: string) =
 
 let curry f x y = f (x, y)
 let uncurry f (x, y) = f x y
+
+
+type LspClientLogEventSink(formatProvider: IFormatProvider) =
+    let mutable lspClientMaybe: ILspClient option = None
+
+    let mapLogEventLevel lel =
+        match lel with
+        | LogEventLevel.Verbose -> MessageType.Log
+        | LogEventLevel.Debug -> MessageType.Log
+        | LogEventLevel.Information -> MessageType.Info
+        | LogEventLevel.Warning -> MessageType.Warning
+        | LogEventLevel.Error -> MessageType.Error
+        | LogEventLevel.Fatal -> MessageType.Error
+        | _ -> MessageType.Info
+
+    member __.SetLspClient(newLspClient: ILspClient option) =
+        lspClientMaybe <- newLspClient
+
+    interface ILogEventSink with
+        member __.Emit(logEvent: LogEvent) =
+            match lspClientMaybe with
+            | Some lspClient ->
+                let messageParams: LogMessageParams =
+                    { Type = mapLogEventLevel logEvent.Level
+                      Message = logEvent.RenderMessage(formatProvider) }
+
+                lspClient.WindowLogMessage(messageParams) |> Async.StartAsTask |> ignore
+
+            | None -> ()