VS: show cache metrics in output pane when running a debug build vsix (#18939)

Author: majocha

vsintegration/src/FSharp.Editor/Common/DebugHelpers.fs

@@ -31,6 +31,7 @@ open Config
 open System.Diagnostics.Metrics
 open System.Text
 open Microsoft.VisualStudio.Threading
+open Microsoft.VisualStudio.FSharp.Editor.CancellableTasks
 
 module FSharpOutputPane =
 
@@ -56,29 +57,17 @@ module FSharpOutputPane =
     let private log logType msg =
         task {
             System.Diagnostics.Trace.TraceInformation(msg)
-            let time = DateTime.Now.ToString("hh:mm:ss tt")
-
             let! pane = pane.GetValueAsync()
 
             do! ThreadHelper.JoinableTaskFactory.SwitchToMainThreadAsync()
 
             match logType with
-            | LogType.Message ->
-                String.Format("[{0}{1}] {2}{3}", "", time, msg, Environment.NewLine)
-                |> pane.OutputStringThreadSafe
-                |> ignore
-            | LogType.Info ->
-                String.Format("[{0}{1}] {2}{3}", "INFO ", time, msg, Environment.NewLine)
-                |> pane.OutputStringThreadSafe
-                |> ignore
-            | LogType.Warn ->
-                String.Format("[{0}{1}] {2}{3}", "WARN ", time, msg, Environment.NewLine)
-                |> pane.OutputStringThreadSafe
-                |> ignore
-            | LogType.Error ->
-                String.Format("[{0}{1}] {2}{3}", "ERROR ", time, msg, Environment.NewLine)
-                |> pane.OutputStringThreadSafe
-                |> ignore
+            | LogType.Message -> $"{msg}"
+            | LogType.Info -> $"[INFO] {msg}"
+            | LogType.Warn -> $"[WARN] {msg}"
+            | LogType.Error -> $"[ERROR] {msg}"
+            |> pane.OutputStringThreadSafe
+            |> ignore
         }
         |> ignore
 
@@ -102,6 +91,7 @@ module FSharpOutputPane =
 
 module FSharpServiceTelemetry =
     open FSharp.Compiler.Caches
+    open System.Threading.Tasks
 
     let listen filter =
         let indent (activity: Activity) =
@@ -130,6 +120,15 @@ module FSharpServiceTelemetry =
 
         ActivitySource.AddActivityListener(listener)
 
+    let periodicallyDisplayCacheStats =
+        cancellableTask {
+            use _ = CacheMetrics.ListenToAll()
+
+            while true do
+                do! Task.Delay(TimeSpan.FromSeconds 10.0)
+                FSharpOutputPane.logMsg (CacheMetrics.StatsToString())
+        }
+
 #if DEBUG
     open OpenTelemetry.Resources
     open OpenTelemetry.Trace

vsintegration/src/FSharp.Editor/LanguageService/LanguageService.fs

@@ -411,6 +411,19 @@ type internal FSharpPackage() as this =
                 |> CancellableTask.startAsTask cancellationToken)
         )
 
+#if DEBUG
+    override _.RegisterOnAfterPackageLoadedAsyncWork(afterPackageLoadedTasks: PackageLoadTasks) =
+        afterPackageLoadedTasks.AddTask(
+            false,
+            fun _ _ ->
+                task {
+                    DebugHelpers.FSharpServiceTelemetry.periodicallyDisplayCacheStats
+                    |> CancellableTask.start this.DisposalToken
+                    |> ignore
+                }
+        )
+#endif
+
     override _.RoslynLanguageName = FSharpConstants.FSharpLanguageName
     (*override this.CreateWorkspace() = this.ComponentModel.GetService<VisualStudioWorkspaceImpl>() *)
     override this.CreateLanguageService() = FSharpLanguageService(this)