Adds settings for OpenTelemetry

Author: TheAngryByrd

src/FsAutoComplete.Core/Utils.fs

@@ -884,17 +884,17 @@ module Tracing =
     interface IActivityTracingStrategy with
       member this.ApplyInboundActivity(request: Protocol.JsonRpcRequest) : IDisposable =
         let tags =
-          [
-            "rpc.system", box "jsonrpc"
+          [ "rpc.system", box "jsonrpc"
             "rpc.jsonrpc.is_notification", box request.IsNotification
             "rpc.jsonrpc.is_response_expected", box request.IsResponseExpected
             "rpc.jsonrpc.version", box request.Version
             "rpc.jsonrpc.request_id", box request.RequestId
-            "rpc.method", box request.Method
-          ]
+            "rpc.method", box request.Method ]
           |> Seq.map KeyValuePair
 
-        let activity = activitySource.StartActivity(ActivityKind.Server, name = request.Method, tags = tags)
+        let activity =
+          activitySource.StartActivity(ActivityKind.Server, name = request.Method, tags = tags)
+
         if activity <> null then
           activity.TraceStateString <- request.TraceState
 

src/FsAutoComplete/LspHelpers.fs

@@ -600,6 +600,10 @@ type InlineValueDto =
   { Enabled: bool option
     Prefix: string option }
 
+type NotificationsDto =
+  { Trace: bool option
+    TraceNamespaces: string array option }
+
 type DebugDto =
   { DontCheckRelatedFiles: bool option
     CheckFileDebouncerTimeout: int option
@@ -643,6 +647,7 @@ type FSharpConfigDto =
     CodeLenses: CodeLensConfigDto option
     PipelineHints: InlineValueDto option
     InlayHints: InlayHintDto option
+    Notifications: NotificationsDto option
     Debug: DebugDto option }
 
 type FSharpConfigRequest = { FSharp: FSharpConfigDto }
@@ -673,6 +678,23 @@ type InlineValuesConfig =
     { Enabled = Some true
       Prefix = Some "//" }
 
+type NotificationsConfig =
+  { Trace: bool
+    TraceNamespaces: string array }
+
+  static member Default =
+    { Trace = false
+      TraceNamespaces = [||] }
+
+  static member FromDto(dto: NotificationsDto) : NotificationsConfig =
+    { Trace = defaultArg dto.Trace NotificationsConfig.Default.Trace
+      TraceNamespaces = defaultArg dto.TraceNamespaces NotificationsConfig.Default.TraceNamespaces }
+
+
+  member this.AddDto(dto: NotificationsDto) : NotificationsConfig =
+    { Trace = defaultArg dto.Trace this.Trace
+      TraceNamespaces = defaultArg dto.TraceNamespaces this.TraceNamespaces }
+
 type DebugConfig =
   { DontCheckRelatedFiles: bool
     CheckFileDebouncerTimeout: int
@@ -722,6 +744,7 @@ type FSharpConfig =
     CodeLenses: CodeLensConfig
     InlayHints: InlayHintsConfig
     InlineValues: InlineValuesConfig
+    Notifications: NotificationsConfig
     Debug: DebugConfig }
 
   static member Default: FSharpConfig =
@@ -761,6 +784,7 @@ type FSharpConfig =
       CodeLenses = CodeLensConfig.Default
       InlayHints = InlayHintsConfig.Default
       InlineValues = InlineValuesConfig.Default
+      Notifications = NotificationsConfig.Default
       Debug = DebugConfig.Default }
 
   static member FromDto(dto: FSharpConfigDto) : FSharpConfig =
@@ -825,7 +849,10 @@ type FSharpConfig =
         | Some ivDto ->
           { Enabled = ivDto.Enabled |> Option.defaultValue true |> Some
             Prefix = ivDto.Prefix |> Option.defaultValue "//" |> Some }
-
+      Notifications =
+        dto.Notifications
+        |> Option.map NotificationsConfig.FromDto
+        |> Option.defaultValue NotificationsConfig.Default
       Debug =
         match dto.Debug with
         | None -> DebugConfig.Default
@@ -908,6 +935,10 @@ type FSharpConfig =
       InlineValues =
         { Enabled = defaultArg (dto.PipelineHints |> Option.map (fun n -> n.Enabled)) x.InlineValues.Enabled
           Prefix = defaultArg (dto.PipelineHints |> Option.map (fun n -> n.Prefix)) x.InlineValues.Prefix }
+      Notifications =
+        dto.Notifications
+        |> Option.map x.Notifications.AddDto
+        |> Option.defaultValue NotificationsConfig.Default
       Debug =
         match dto.Debug with
         | None -> DebugConfig.Default

src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs

@@ -196,6 +196,16 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
   /// in the future
   let selectProject projs = projs |> List.tryHead
 
+  let mutable traceNotifications: ProgressListener option = None
+
+  let replaceTraceNotification shouldTrace traceNamespaces =
+    traceNotifications |> Option.iter dispose
+
+    if shouldTrace then
+      traceNotifications <- Some(new ProgressListener(lspClient, traceNamespaces))
+    else
+      traceNotifications <- None
+
   let mutableConfigChanges =
     let toCompilerToolArgument (path: string) = sprintf "--compilertool:%s" path
 
@@ -204,6 +214,8 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
       and! checker = checker
       and! rootPath = rootPath
 
+      replaceTraceNotification config.Notifications.Trace config.Notifications.TraceNamespaces
+
       checker.SetFSIAdditionalArguments
         [| yield! config.FSICompilerToolLocations |> Array.map toCompilerToolArgument
            yield! config.FSIExtraParameters |]
@@ -307,8 +319,6 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
 
   let fileChecked = Event<ParseAndCheckResults * VolatileFile * CancellationToken>()
 
-  do disposables.Add <| new ProgressListener(lspClient)
-
   do
     disposables.Add
     <| fileParsed.Publish.Subscribe(fun (parseResults, proj, ct) ->
@@ -1703,8 +1713,9 @@ type AdaptiveFSharpLspServer(workspaceLoader: IWorkspaceLoader, lspClient: FShar
           percentage = percentage 0 checksToPerform.Length
         )
 
-      let maxConcurrency = 3
-      // Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75))
+      let maxConcurrency =
+        Math.Max(1.0, Math.Floor((float System.Environment.ProcessorCount) * 0.75))
+
       do! Async.Parallel(checksToPerform, int maxConcurrency) |> Async.Ignore<unit array>
 
     }

src/FsAutoComplete/LspServers/FSharpLspClient.fs

@@ -149,25 +149,30 @@ open Ionide.ProjInfo.Logging
 
 
 /// listener for the the events generated from the fsc ActivitySource
-type ProgressListener(lspClient: FSharpLspClient) =
+type ProgressListener(lspClient: FSharpLspClient, traceNamespace: string array) =
 
-  let isOneOf list string = list |> List.exists (fun f -> f string)
+  let isOneOf list string =
+    list |> Array.exists (fun f -> f string)
 
+  let strEquals (other: string) (this: string) =
+    this.Equals(other, StringComparison.InvariantCultureIgnoreCase)
 
   let strContains (substring: string) (str: string) = str.Contains(substring)
 
-  let interestingActivities =
-    [
-
-      strContains "BoundModel."
-      strContains "IncrementalBuild."
-      strContains "CheckDeclarations."
-      strContains "ParseAndCheckInputs."
-      strContains "BackgroundCompiler."
-      strContains "IncrementalBuildSyntaxTree."
-      strContains "ParseAndCheckFile."
-      strContains "ParseAndCheckInputs."
-      strContains "CheckDeclarations." ]
+  let interestingActivities = traceNamespace |> Array.map strContains
+  // [
+  //   strEquals "BoundModel.TypeCheck"
+  //   strContains "BackgroundCompiler."
+  //   // strContains "BoundModel."
+  //   // strContains "IncrementalBuild."
+  //   // strContains "CheckDeclarations."
+  //   // strContains "ParseAndCheckInputs."
+  //   // strContains "BackgroundCompiler."
+  //   // strContains "IncrementalBuildSyntaxTree."
+  //   // strContains "ParseAndCheckFile."
+  //   // strContains "ParseAndCheckInputs."
+  //   // strContains "CheckDeclarations."
+  // ]
 
   let logger = LogProvider.getLoggerByName "Compiler"
 
@@ -179,12 +184,14 @@ type ProgressListener(lspClient: FSharpLspClient) =
   let isStopped (activity: Activity) =
 #if NET6_0
     false
+    ||
 #else
     activity.IsStopped
+    ||
 #endif
     // giving this 1 seconds to report something, otherwise assume it's a dead activity
-    || ((DateTime.UtcNow - activity.StartTimeUtc) > TimeSpan.FromSeconds(1.)
-        && activity.Duration = TimeSpan.Zero)
+    ((DateTime.UtcNow - activity.StartTimeUtc) > TimeSpan.FromSeconds(5.)
+     && activity.Duration = TimeSpan.Zero)
 
   let getTagItemSafe key (a: Activity) = a.GetTagItem key |> Option.ofObj
 
@@ -200,7 +207,6 @@ type ProgressListener(lspClient: FSharpLspClient) =
     >> Option.map IO.Path.GetFileName
     >> Option.defaultValue String.Empty
 
-
   let getUserOpName =
     getTagItemSafe Tracing.SemanticConventions.FCS.userOpName
     >> Option.map string
@@ -218,9 +224,10 @@ type ProgressListener(lspClient: FSharpLspClient) =
               inflightEvents.TryRemove(a.Id) |> ignore
             else
               // FSC doesn't start their spans with tags so we have to see if it's been added later https://github.com/dotnet/fsharp/issues/14776
-              let fileName = getFileName a
-              let userOpName = getUserOpName a
-              do! p.Report(message = $"{fileName} - {userOpName}")
+              let message = String.Join(" - ", [ getFileName a; getProject a; getUserOpName a ])
+
+
+              do! p.Report(message = message)
 
           match! inbox.TryReceive(250) with
           | None ->
@@ -233,10 +240,10 @@ type ProgressListener(lspClient: FSharpLspClient) =
               let fileName = getFileName activity
               let userOpName = getUserOpName activity
 
-              logger.debug (
-                Log.setMessageI
-                  $"Started : {activity.DisplayName:DisplayName} - {userOpName:UserOpName} - {fileName:fileName}"
-              )
+              // logger.debug (
+              //   Log.setMessageI
+              //     $"Started : {activity.DisplayName:DisplayName} - {userOpName:UserOpName} - {fileName:fileName}"
+              // )
 
               if
                 activity.DisplayName |> isOneOf interestingActivities
@@ -253,10 +260,10 @@ type ProgressListener(lspClient: FSharpLspClient) =
               let userOpName = getUserOpName activity
               let duration = activity.Duration.ToString()
 
-              logger.debug (
-                Log.setMessageI
-                  $"Finished : {activity.DisplayName:DisplayName} - {userOpName:UserOpName} - {fileName:fileName} - took {duration:duration}"
-              )
+              // logger.debug (
+              //   Log.setMessageI
+              //     $"Finished : {activity.DisplayName:DisplayName} - {userOpName:UserOpName} - {fileName:fileName} - took {duration:duration}"
+              // )
 
               if activity.DisplayName |> isOneOf interestingActivities then
                 match inflightEvents.TryRemove(activity.Id) with

src/FsAutoComplete/Parser.fs

@@ -22,6 +22,8 @@ module Parser =
 
   let mutable tracerProvider = Unchecked.defaultof<_>
 
+
+
   [<Struct>]
   type Pos = { Line: int; Column: int }
 
@@ -95,6 +97,12 @@ module Parser =
       "Enable LSP Server based on FSharp.Data.Adaptive. Should be more stable, but is experimental."
     )
 
+  let otelTracingOption =
+    Option<bool>(
+      "--otel-exporter-enabled",
+      "Enabled OpenTelemetry exporter. See https://opentelemetry.io/docs/reference/specification/protocol/exporter/ for environment variables to configure for the exporter."
+    )
+
   let stateLocationOption =
     Option<DirectoryInfo>(
       "--state-directory",
@@ -115,6 +123,7 @@ module Parser =
     rootCommand.AddOption adaptiveLspServerOption
     rootCommand.AddOption logLevelOption
     rootCommand.AddOption stateLocationOption
+    rootCommand.AddOption otelTracingOption
 
 
 
@@ -178,20 +187,22 @@ module Parser =
 
   let configureOTel =
     Invocation.InvocationMiddleware(fun ctx next ->
-      let serviceName = FsAutoComplete.Utils.Tracing.serviceName
-      let version = FsAutoComplete.Utils.Version.info().Version
-
-      tracerProvider <-
-        Sdk
-          .CreateTracerProviderBuilder()
-          .AddSource(serviceName, Tracing.fscServiceName)
-          .SetResourceBuilder(
-            ResourceBuilder
-              .CreateDefault()
-              .AddService(serviceName = serviceName, serviceVersion = version)
-          )
-          .AddOtlpExporter()
-          .Build()
+
+      if ctx.ParseResult.HasOption otelTracingOption then
+        let serviceName = FsAutoComplete.Utils.Tracing.serviceName
+        let version = FsAutoComplete.Utils.Version.info().Version
+
+        tracerProvider <-
+          Sdk
+            .CreateTracerProviderBuilder()
+            .AddSource(serviceName, Tracing.fscServiceName)
+            .SetResourceBuilder(
+              ResourceBuilder
+                .CreateDefault()
+                .AddService(serviceName = serviceName, serviceVersion = version)
+            )
+            .AddOtlpExporter()
+            .Build()
 
       next.Invoke(ctx))
 

test/FsAutoComplete.Tests.Lsp/Helpers.fs

@@ -269,6 +269,7 @@ let defaultConfigDto: FSharpConfigDto =
       Some
         { Enabled = Some true
           Prefix = Some "//" }
+    Notifications = None
     Debug = None }
 
 let clientCaps: ClientCapabilities =