From 0918bc14db398ae64bf269561843b060aa530e1d Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Sun, 12 Jan 2025 20:49:31 -0500 Subject: [PATCH 1/3] Better OTel and use Pull Diagnostics --- docker-compose.yml | 33 ++ .../CompilerServiceInterface.fs | 48 ++- src/FsAutoComplete.Logging/FsOpenTelemetry.fs | 11 +- .../LspServers/AdaptiveFSharpLspServer.fs | 37 +- .../LspServers/AdaptiveServerState.fs | 322 ++++++++++++------ .../LspServers/AdaptiveServerState.fsi | 4 + .../EmptyFileTests.fs | 2 - .../Expecto.OpenTelemetry.fs | 201 +++++++++++ .../ExtensionsTests.fs | 1 - .../FsAutoComplete.Tests.Lsp.fsproj | 1 + test/FsAutoComplete.Tests.Lsp/Helpers.fs | 1 - test/FsAutoComplete.Tests.Lsp/Program.fs | 50 ++- test/FsAutoComplete.Tests.Lsp/ScriptTests.fs | 2 - test/FsAutoComplete.Tests.Lsp/Utils/Server.fs | 70 ++-- 14 files changed, 617 insertions(+), 166 deletions(-) create mode 100644 docker-compose.yml create mode 100644 test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs diff --git a/docker-compose.yml b/docker-compose.yml new file mode 100644 index 000000000..1ca0fe2e2 --- /dev/null +++ b/docker-compose.yml @@ -0,0 +1,33 @@ +services: + seq: + profiles: + - seq + image: datalust/seq + ports: + - 5341:80 # http and collection + environment: + - ACCEPT_EULA=Y + # http://localhost:5341 + # OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:5341/ingest/otlp/v1/logs + # OTEL_EXPORTER_OTLP_PROTOCOL="http/protobuf" + # OTEL_EXPORTER_OTLP_HEADERS="X-Seq-ApiKey=your_api_key" + jaeger: + profiles: + - jaeger + image: jaegertracing/all-in-one + ports: + - 6831:6831/udp + - 6832:6832/udp + - 5778:5778 + - 16686:16686 + - 4317:4317 + - 4318:4318 + - 14250:14250 + - 14268:14268 + - 14269:14269 + - 9411:9411 + environment: + - COLLECTOR_ZIPKIN_HTTP_PORT=9411 + - COLLECTOR_OTLP_ENABLED=true + # http://localhost:16686/ + # OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:4317 diff --git a/src/FsAutoComplete.Core/CompilerServiceInterface.fs b/src/FsAutoComplete.Core/CompilerServiceInterface.fs index f901b9feb..70a437f0c 100644 --- a/src/FsAutoComplete.Core/CompilerServiceInterface.fs +++ b/src/FsAutoComplete.Core/CompilerServiceInterface.fs @@ -1,5 +1,7 @@ namespace FsAutoComplete +open FsAutoComplete.Utils.Tracing +open FsAutoComplete.Telemetry open System.IO open FSharp.Compiler.CodeAnalysis open Utils @@ -14,6 +16,7 @@ open System open FsToolkit.ErrorHandling open FSharp.Compiler.CodeAnalysis.ProjectSnapshot open System.Threading +open IcedTasks type Version = int @@ -108,6 +111,8 @@ type FSharpCompilerServiceChecker ?transparentCompilerCacheSizes = cacheSize ) + let thisType = typeof + let entityCache = EntityCache() // FCS can't seem to handle parallel project restores for script files @@ -337,15 +342,20 @@ type FSharpCompilerServiceChecker } member self.GetProjectSnapshotsFromScript(file: string, source, tfm: FSIRefs.TFM) = - async { - try - do! scriptLocker.WaitAsync() |> Async.AwaitTask + asyncEx { + let tags = + seq { + yield "file", box file + yield "tfm", tfm + } + + use _trace = Tracing.fsacActivitySource.StartActivityForType(thisType, tags = tags) + use! _l = scriptLocker.LockAsync() + + match tfm with + | FSIRefs.TFM.NetFx -> return! self.GetNetFxScriptSnapshot(file, source) + | FSIRefs.TFM.NetCore -> return! self.GetNetCoreScriptSnapshot(file, source) - match tfm with - | FSIRefs.TFM.NetFx -> return! self.GetNetFxScriptSnapshot(file, source) - | FSIRefs.TFM.NetCore -> return! self.GetNetCoreScriptSnapshot(file, source) - finally - scriptLocker.Release() |> ignore } @@ -418,15 +428,19 @@ type FSharpCompilerServiceChecker } member self.GetProjectOptionsFromScript(file: string, source, tfm) = - async { - try - do! scriptLocker.WaitAsync() |> Async.AwaitTask - - match tfm with - | FSIRefs.TFM.NetFx -> return! self.GetNetFxScriptOptions(file, source) - | FSIRefs.TFM.NetCore -> return! self.GetNetCoreScriptOptions(file, source) - finally - scriptLocker.Release() |> ignore + asyncEx { + let tags = + seq { + yield "file", box file + yield "tfm", box tfm + } + + use _trace = Tracing.fsacActivitySource.StartActivityForType(thisType, tags = tags) + use! _l = scriptLocker.LockAsync() + + match tfm with + | FSIRefs.TFM.NetFx -> return! self.GetNetFxScriptOptions(file, source) + | FSIRefs.TFM.NetCore -> return! self.GetNetCoreScriptOptions(file, source) } diff --git a/src/FsAutoComplete.Logging/FsOpenTelemetry.fs b/src/FsAutoComplete.Logging/FsOpenTelemetry.fs index 108cb912f..d1eb852db 100644 --- a/src/FsAutoComplete.Logging/FsOpenTelemetry.fs +++ b/src/FsAutoComplete.Logging/FsOpenTelemetry.fs @@ -574,13 +574,15 @@ type ActivityExtensions = let tags = ActivityTagsCollection( - [ yield KeyValuePair(SemanticConventions.General.Exceptions.exception_escaped, box escaped) + seq { + yield KeyValuePair(SemanticConventions.General.Exceptions.exception_escaped, box escaped) yield KeyValuePair(SemanticConventions.General.Exceptions.exception_type, box errorType) if Option.isSome stacktrace then yield KeyValuePair(SemanticConventions.General.Exceptions.exception_stacktrace, box stacktrace.Value) - yield KeyValuePair(SemanticConventions.General.Exceptions.exception_message, box errorMessage) ] + yield KeyValuePair(SemanticConventions.General.Exceptions.exception_message, box errorMessage) + } ) ActivityEvent(SemanticConventions.General.Exceptions.exception_, tags = tags) @@ -602,11 +604,12 @@ type ActivityExtensions = let tags = ActivityTagsCollection( - [ yield KeyValuePair(SemanticConventions.General.Exceptions.exception_escaped, box escaped) + seq { + yield KeyValuePair(SemanticConventions.General.Exceptions.exception_escaped, box escaped) yield KeyValuePair(SemanticConventions.General.Exceptions.exception_type, box exceptionType) yield KeyValuePair(SemanticConventions.General.Exceptions.exception_stacktrace, box exceptionStackTrace) if not <| String.IsNullOrEmpty(exceptionMessage) then - yield KeyValuePair(SemanticConventions.General.Exceptions.exception_message, box exceptionMessage) ] + yield KeyValuePair(SemanticConventions.General.Exceptions.exception_message, box exceptionMessage) } ) ActivityEvent(SemanticConventions.General.Exceptions.exception_, tags = tags) diff --git a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs index 3b1456821..93abbed5c 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveFSharpLspServer.fs @@ -166,6 +166,10 @@ module CallHierarchyHelpers = } open CallHierarchyHelpers +// type DiagnosticType = +// | FSharp of FSharp.Compiler.Diagnostics.FSharpDiagnostic +// | Analyzer of FSharp.Analyzers.SDK.Message +// | UnusedOpen type AdaptiveFSharpLspServer ( @@ -2500,7 +2504,38 @@ type AdaptiveFSharpLspServer override x.TextDocumentDeclaration p = x.logUnimplementedRequest p - override x.TextDocumentDiagnostic p = x.logUnimplementedRequest p + override x.TextDocumentDiagnostic p = + asyncResult { + let tags = [ "DocumentDiagnosticParams", box p ] + use trace = fsacActivitySource.StartActivityForType(thisType, tags = tags) + + try + logger.info ( + Log.setMessage "TextDocumentDiagnostic Request: {params}" + >> Log.addContextDestructured "params" p + ) + + let filePath = p.TextDocument.GetFilePath() |> Utils.normalizePath + + let! diags = state.GetDiagnostics filePath |> AsyncResult.ofStringErr + + return + DocumentDiagnosticReport.C1( + { Kind = "full" + ResultId = None + Items = diags + RelatedDocuments = None } + ) + + with e -> + trace |> Tracing.recordException e + + let logCfg = + Log.setMessage "TextDocumentDiagnostic Request Errored {p}" + >> Log.addContextDestructured "p" p + + return! returnException e logCfg + } override x.TextDocumentLinkedEditingRange p = x.logUnimplementedRequest p diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs index 3cc69ba21..d784a97cc 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs @@ -465,9 +465,9 @@ type AdaptiveState let filePath = file.FileName let filePathUntag = UMX.untag filePath let source = file.Source - let version = file.Version let fileName = Path.GetFileName filePathUntag - + let tags = seq { "filePath", box filePath } + use _t = fsacActivitySource.StartActivityForType(thisType, tags = tags) let inline getSourceLine lineNo = (source: ISourceText).GetLineString(lineNo - 1) @@ -483,9 +483,12 @@ type AdaptiveState UnusedOpens.getUnusedOpens (tyRes.GetCheckResults, getSourceLine) |> Async.withCancellation progress.CancellationToken - notifications.Trigger(NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray), file.Version), ct) + return + NotificationEvent.UnusedOpens(filePath, (unused |> List.toArray), file.Version) + |> Some with e -> logger.error (Log.setMessage "checkUnusedOpens failed" >> Log.addExn e) + return None } let checkUnusedDeclarations = @@ -504,9 +507,10 @@ type AdaptiveState let unused = unused |> Seq.toArray - notifications.Trigger(NotificationEvent.UnusedDeclarations(filePath, unused, file.Version), ct) + return NotificationEvent.UnusedDeclarations(filePath, unused, file.Version) |> Some with e -> logger.error (Log.setMessage "checkUnusedDeclarations failed" >> Log.addExn e) + return None } let checkSimplifiedNames = @@ -522,9 +526,10 @@ type AdaptiveState |> Async.withCancellation progress.CancellationToken let simplified = Array.ofSeq simplified - notifications.Trigger(NotificationEvent.SimplifyNames(filePath, simplified, file.Version), ct) + return NotificationEvent.SimplifyNames(filePath, simplified, file.Version) |> Some with e -> logger.error (Log.setMessage "checkSimplifiedNames failed" >> Log.addExn e) + return None } let checkUnnecessaryParentheses = @@ -553,12 +558,14 @@ type AdaptiveState | _ -> ranges) - notifications.Trigger( - NotificationEvent.UnnecessaryParentheses(filePath, Array.ofSeq unnecessaryParentheses, file.Version), - ct - ) + let! ct = Async.CancellationToken + + return + NotificationEvent.UnnecessaryParentheses(filePath, Array.ofSeq unnecessaryParentheses, file.Version) + |> Some with e -> logger.error (Log.setMessage "checkUnnecessaryParentheses failed" >> Log.addExn e) + return None } let inline isNotExcluded (exclusions: Regex array) = @@ -587,13 +594,10 @@ type AdaptiveState checkUnnecessaryParentheses ] async { - do! analyzers |> Async.parallel75 |> Async.Ignore + let! results = analyzers |> Async.parallel75 + return results |> Array.choose id + - do! - lspClient.NotifyDocumentAnalyzed - { TextDocument = - { Uri = filePath |> Path.LocalPathToUri - Version = version } } } let tryUriCreate (s: string) = @@ -610,10 +614,14 @@ type AdaptiveState (compilerOptions: CompilerProjectOption) = asyncEx { + use _t = + fsacActivitySource.StartActivityForType(thisType, tags = seq { "filePath", box volatileFile.FileName }) + if config.EnableAnalyzers then let file = volatileFile.FileName try + use! _l = analyzersLocker.LockAsync() use progress = new ServerProgressReport(lspClient) do! progress.Begin("Running analyzers...", message = UMX.untag file) @@ -666,20 +674,96 @@ type AdaptiveState analyzerPredicate ) - let! ct = Async.CancellationToken - notifications.Trigger(NotificationEvent.AnalyzerMessage(res, file, volatileFile.Version), ct) - Loggers.analyzers.info (Log.setMessageI $"end analysis of {file:file}") + return NotificationEvent.AnalyzerMessage(res, file, volatileFile.Version) |> Some | _ -> Loggers.analyzers.info (Log.setMessageI $"missing components of {file:file} to run analyzers, skipped them") - - () + return None with ex -> Loggers.analyzers.error (Log.setMessageI $"Run failed for {file:file}" >> Log.addExn ex) + return None + else + return None } + let fcsErrorToDiagnostic = fcsErrorToDiagnostic + + let unusedOpensToDiagnostic n = + { Range = fcsRangeToLsp n + Code = Some(U2.C2 "FSAC0001") + Severity = Some DiagnosticSeverity.Hint + Source = Some "FSAC" + Message = "Unused open statement" + RelatedInformation = None + Tags = Some [| DiagnosticTag.Unnecessary |] + Data = None + CodeDescription = None } + + let unusedDeclarationsToDiagnostic n = + { Range = fcsRangeToLsp n + Code = Some(U2.C2 "FSAC0003") + Severity = Some DiagnosticSeverity.Hint + Source = Some "FSAC" + Message = "This value is unused" + RelatedInformation = Some [||] + Tags = Some [| DiagnosticTag.Unnecessary |] + Data = None + CodeDescription = None } + + let simplifyNamesToDiagnostic (r: FSharp.Compiler.EditorServices.SimplifyNames.SimplifiableRange) = + { Diagnostic.Range = fcsRangeToLsp r.Range + Code = Some(U2.C2 "FSAC0002") + Severity = Some DiagnosticSeverity.Hint + Source = Some "FSAC" + Message = "This qualifier is redundant" + RelatedInformation = Some [||] + Tags = Some [| DiagnosticTag.Unnecessary |] + Data = None + CodeDescription = None } + + let unnecessaryParenthesesToDiagnostic r = + { Diagnostic.Range = fcsRangeToLsp r + Code = Some(U2.C2 "FSAC0004") + Severity = Some DiagnosticSeverity.Hint + Source = Some "FSAC" + Message = "Parentheses can be removed" + RelatedInformation = Some [||] + Tags = Some [| DiagnosticTag.Unnecessary |] + Data = None + CodeDescription = None } + + let analyzersToDiagnostic (m: FSharp.Analyzers.SDK.Message) = + let range = fcsRangeToLsp m.Range + + let severity = + match m.Severity with + | FSharp.Analyzers.SDK.Severity.Hint -> DiagnosticSeverity.Hint + | FSharp.Analyzers.SDK.Severity.Info -> DiagnosticSeverity.Information + | FSharp.Analyzers.SDK.Severity.Warning -> DiagnosticSeverity.Warning + | FSharp.Analyzers.SDK.Severity.Error -> DiagnosticSeverity.Error + + let fixes = + match m.Fixes with + | [] -> None + | fixes -> + fixes + |> List.map (fun fix -> + { Range = fcsRangeToLsp fix.FromRange + NewText = fix.ToText }) + |> Ionide.LanguageServerProtocol.Server.serialize + |> Some + + { Range = range + Code = Option.ofObj m.Code |> Option.map U2.C2 + Severity = Some severity + Source = Some $"F# Analyzers (%s{m.Type})" + Message = m.Message + RelatedInformation = None + Tags = None + CodeDescription = None + Data = fixes } let handleCommandEvents (n: NotificationEvent, ct: CancellationToken) = try @@ -715,76 +799,28 @@ type AdaptiveState | NotificationEvent.UnusedOpens(file, opens, version) -> let uri = Path.LocalPathToUri file - let diags = - opens - |> Array.map (fun n -> - { Range = fcsRangeToLsp n - Code = Some(U2.C2 "FSAC0001") - Severity = Some DiagnosticSeverity.Hint - Source = Some "FSAC" - Message = "Unused open statement" - RelatedInformation = None - Tags = Some [| DiagnosticTag.Unnecessary |] - Data = None - CodeDescription = None }) + let diags = opens |> Array.map unusedOpensToDiagnostic diagnosticCollections.SetFor(uri, "F# Unused opens", version, diags) | NotificationEvent.UnusedDeclarations(file, decls, version) -> let uri = Path.LocalPathToUri file - let diags = - decls - |> Array.map (fun n -> - { Range = fcsRangeToLsp n - Code = Some(U2.C2 "FSAC0003") - Severity = Some DiagnosticSeverity.Hint - Source = Some "FSAC" - Message = "This value is unused" - RelatedInformation = Some [||] - Tags = Some [| DiagnosticTag.Unnecessary |] - Data = None - CodeDescription = None }) + let diags = decls |> Array.map unusedDeclarationsToDiagnostic diagnosticCollections.SetFor(uri, "F# Unused declarations", version, diags) | NotificationEvent.SimplifyNames(file, decls, version) -> let uri = Path.LocalPathToUri file - let diags = - decls - |> Array.map - - (fun - ({ Range = range - RelativeName = _relName }) -> - { Diagnostic.Range = fcsRangeToLsp range - Code = Some(U2.C2 "FSAC0002") - Severity = Some DiagnosticSeverity.Hint - Source = Some "FSAC" - Message = "This qualifier is redundant" - RelatedInformation = Some [||] - Tags = Some [| DiagnosticTag.Unnecessary |] - Data = None - CodeDescription = None }) + let diags = decls |> Array.map simplifyNamesToDiagnostic diagnosticCollections.SetFor(uri, "F# simplify names", version, diags) | NotificationEvent.UnnecessaryParentheses(file, ranges, version) -> let uri = Path.LocalPathToUri file - let diags = - ranges - |> Array.map (fun range -> - { Diagnostic.Range = fcsRangeToLsp range - Code = Some(U2.C2 "FSAC0004") - Severity = Some DiagnosticSeverity.Hint - Source = Some "FSAC" - Message = "Parentheses can be removed" - RelatedInformation = Some [||] - Tags = Some [| DiagnosticTag.Unnecessary |] - Data = None - CodeDescription = None }) + let diags = ranges |> Array.map unnecessaryParenthesesToDiagnostic diagnosticCollections.SetFor(uri, "F# unnecessary parentheses", version, diags) @@ -837,38 +873,7 @@ type AdaptiveState match messages with | [||] -> diagnosticCollections.SetFor(uri, "F# Analyzers", version, [||]) | messages -> - let diags = - messages - |> Array.map (fun m -> - let range = fcsRangeToLsp m.Range - - let severity = - match m.Severity with - | FSharp.Analyzers.SDK.Severity.Hint -> DiagnosticSeverity.Hint - | FSharp.Analyzers.SDK.Severity.Info -> DiagnosticSeverity.Information - | FSharp.Analyzers.SDK.Severity.Warning -> DiagnosticSeverity.Warning - | FSharp.Analyzers.SDK.Severity.Error -> DiagnosticSeverity.Error - - let fixes = - match m.Fixes with - | [] -> None - | fixes -> - fixes - |> List.map (fun fix -> - { Range = fcsRangeToLsp fix.FromRange - NewText = fix.ToText }) - |> Ionide.LanguageServerProtocol.Server.serialize - |> Some - - { Range = range - Code = Option.ofObj m.Code |> Option.map U2.C2 - Severity = Some severity - Source = Some $"F# Analyzers (%s{m.Type})" - Message = m.Message - RelatedInformation = None - Tags = None - CodeDescription = None - Data = fixes }) + let diags = messages |> Array.map analyzersToDiagnostic diagnosticCollections.SetFor(uri, "F# Analyzers", version, diags) | NotificationEvent.TestDetected(file, tests) -> @@ -1300,11 +1305,31 @@ type AdaptiveState () // Don't analyze and error on an empty file else async { + let! ct = Async.CancellationToken let config = config |> AVal.force let analyzerPaths = analyzerPaths |> AVal.force - do! builtInCompilerAnalyzers config checkedFile.VolatileFile checkedFile.ParseAndCheckResults + // do! builtInCompilerAnalyzers config checkedFile.VolatileFile checkedFile.ParseAndCheckResults + + // do! + // runAnalyzers + // config + // analyzerPaths + // checkedFile.ParseAndCheckResults + // checkedFile.VolatileFile + // checkedFile.Options + // checkedFile.CompilerOptions + + + let! results = builtInCompilerAnalyzers config checkedFile.VolatileFile checkedFile.ParseAndCheckResults + results |> Array.iter (fun n -> notifications.Trigger(n, ct)) do! + lspClient.NotifyDocumentAnalyzed + { TextDocument = + { Uri = checkedFile.VolatileFile.FileName |> Path.LocalPathToUri + Version = checkedFile.VolatileFile.Version } } + + match! runAnalyzers config analyzerPaths @@ -1312,6 +1337,9 @@ type AdaptiveState checkedFile.VolatileFile checkedFile.Options checkedFile.CompilerOptions + with + | None -> () + | Some n -> notifications.Trigger(n, ct) } |> Async.StartWithCT checkedFile.CancellationToken) @@ -1457,11 +1485,7 @@ type AdaptiveState | CompilerProjectOption.TransparentCompiler snap -> taskResult { return! checker.ParseFile(file.FileName, snap) } | CompilerProjectOption.BackgroundCompiler opts -> - taskResult { - - - return! checker.ParseFile(file.FileName, file.Source, opts) - } + taskResult { return! checker.ParseFile(file.FileName, file.Source, opts) } let! ct = Async.CancellationToken @@ -1513,6 +1537,14 @@ type AdaptiveState let! projs = asyncResult { + let tags = + seq { + yield "filePath", box filePath + yield "version", file.Version + yield "lastTouched", file.LastTouched + } + + use _trace = fsacActivitySource.StartActivityForType(thisType, tags = tags) let cts = getOpenFileTokenOrDefault filePath use linkedCts = CancellationTokenSource.CreateLinkedTokenSource(ctok, cts) @@ -1660,6 +1692,23 @@ type AdaptiveState }) } + let getOpenFilesToProjectOptions () = + async { + let openFilesToChangesAndProjectOptions = openFilesToChangesAndProjectOptions + + return! + openFilesToChangesAndProjectOptions + // |> AMap.toASetValues + |> AMap.force + |> HashMap.toArray + |> Array.map (fun (sourceTextPath, projects) -> + async { + let! projs = AsyncAVal.forceAsync projects + return sourceTextPath, projs + }) + |> Async.parallel75 + } + let getAllFilesToProjectOptions () = async { let! allFilesToFSharpProjectOptions = allFilesToFSharpProjectOptions |> AsyncAVal.forceAsync @@ -1677,6 +1726,20 @@ type AdaptiveState |> Async.parallel75 } + let getOpenFilesToProjectOptionsSelected () = + async { + let! set = getOpenFilesToProjectOptions () + let selectProject = projectSelector |> AVal.force + let findProject file projects = selectProject.FindProject(file, projects) + + return + set + |> Array.choose (fun (k, (_, v)) -> + v + |> Result.bind (findProject k) + |> Result.toOption + |> Option.map (fun v -> k, v)) + } let getAllFilesToProjectOptionsSelected () = async { @@ -1964,7 +2027,12 @@ type AdaptiveState } let forceGetOpenFileTypeCheckResults (filePath: string) = - getOpenFileTypeCheckResults (filePath) |> AsyncAVal.forceAsync + async { + use _t = + fsacActivitySource.StartActivityForType(thisType, tags = seq { "filePath", box filePath }) + + return! getOpenFileTypeCheckResults (filePath) |> AsyncAVal.forceAsync + } @@ -2578,7 +2646,6 @@ type AdaptiveState } - member x.RootPath with get () = AVal.force rootPath and set v = transact (fun () -> rootPath.Value <- v) @@ -2864,6 +2931,37 @@ type AdaptiveState member x.CancelServerProgress(progressToken: ProgressToken) = progressLookup.Cancel progressToken + member x.GetDiagnostics(file: string) = + asyncResult { + let! check = forceGetOpenFileTypeCheckResults file + let! proj = forceGetProjectOptions file + let! file = x.GetOpenFileOrRead file + let config = x.Config + let analyzerPaths = analyzerPaths |> AVal.force + let! buildInAnalyzer = builtInCompilerAnalyzers config file check + + let! externalAnalyzer = + runAnalyzers config analyzerPaths check file proj (AVal.force proj.FSharpProjectCompilerOptions) + + let fcsDiags = + Array.append check.GetParseResults.Diagnostics check.GetCheckResults.Diagnostics + |> Array.map fcsErrorToDiagnostic + + let analyzerDiags = + [| yield! buildInAnalyzer; yield! externalAnalyzer |> Option.toArray |] + |> Array.collect (function + | NotificationEvent.AnalyzerMessage(diags, _, _) -> diags |> Array.map analyzersToDiagnostic + | NotificationEvent.UnnecessaryParentheses(_, ranges, _) -> + ranges |> Array.map unnecessaryParenthesesToDiagnostic + | NotificationEvent.UnusedOpens(_, ranges, _) -> ranges |> Array.map unusedOpensToDiagnostic + | NotificationEvent.UnusedDeclarations(_, ranges, _) -> ranges |> Array.map unusedDeclarationsToDiagnostic + | NotificationEvent.SimplifyNames(_, ranges, _) -> ranges |> Array.map simplifyNamesToDiagnostic + | _ -> [||]) + + let diags = [| yield! fcsDiags; yield! analyzerDiags |] + return diags + } + interface IDisposable with member this.Dispose() = diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi b/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi index 8fecbcfd1..34be22871 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi +++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fsi @@ -129,4 +129,8 @@ type AdaptiveState = /// See LSP Spec on WorkDoneProgress Cancel for more information. /// member CancelServerProgress: progressToken: ProgressToken -> unit + + member GetDiagnostics: + file: string + -> Async> interface IDisposable diff --git a/test/FsAutoComplete.Tests.Lsp/EmptyFileTests.fs b/test/FsAutoComplete.Tests.Lsp/EmptyFileTests.fs index 420b3f6c2..13fdedbb7 100644 --- a/test/FsAutoComplete.Tests.Lsp/EmptyFileTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/EmptyFileTests.fs @@ -83,8 +83,6 @@ let tests state = End = { Line = 0u; Character = 0u } } RangeLength = Some 0u Text = "c" } |] } - // wait for typechecking to propogate? - do! Async.Sleep 1000 let! completions = server.TextDocumentCompletion diff --git a/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs b/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs new file mode 100644 index 000000000..dd1839a0a --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs @@ -0,0 +1,201 @@ +namespace Expecto + +module OpenTelemetry = + open System + open System.Diagnostics + open System.Collections.Generic + open System.Threading + open Impl + open System.Runtime.CompilerServices + type Activity with + member inline x.SetSource( + ?name_space : string, + [] ?memberName: string, + [] ?path: string, + [] ?line: int) = + if not (isNull x) then + let name_space = + name_space + |> Option.defaultWith (fun () -> + Reflection.MethodBase.GetCurrentMethod().DeclaringType.FullName.Split("+") // F# has + in type names that refer to anonymous functions, we typically want the first named type + |> Seq.tryHead + |> Option.defaultValue "") + if x.GetTagItem "code.namespace" = null then x.SetTag("code.namespace", name_space) |> ignore + if x.GetTagItem "code.function" = null then x.SetTag("code.function", defaultArg memberName "") |> ignore + if x.GetTagItem "code.filepath" = null then x.SetTag("code.filepath", defaultArg path "") |> ignore + if x.GetTagItem "code.lineno" = null then x.SetTag("code.lineno", defaultArg line 0) |> ignore + + module internal Activity = + let inline isNotNull x = isNull x |> not + + let inline setStatus (status : ActivityStatusCode) (span : Activity) = + if isNotNull span then + span.SetStatus(status) |> ignore + + let inline setExn (e : exn) (span : Activity) = + if isNotNull span|> not then + let tags = + ActivityTagsCollection( + seq { + KeyValuePair("exception.type", box (e.GetType().Name)) + KeyValuePair("exception.stacktrace", box (e.ToString())) + if not <| String.IsNullOrEmpty(e.Message) then + KeyValuePair("exception.message", box e.Message) + } + ) + + ActivityEvent("exception", tags = tags) + |> span.AddEvent + |> ignore + + let inline setExnMarkFailed (e : exn) (span : Activity) = + if isNotNull span then + setExn e span + span |> setStatus ActivityStatusCode.Error + + let setSourceLocation (sourceLoc : SourceLocation) (span : Activity) = + if isNotNull span && sourceLoc <> SourceLocation.empty then + span.SetTag("code.lineno", sourceLoc.lineNumber) |> ignore + span.SetTag("code.filepath", sourceLoc.sourcePath) |> ignore + + let inline addOutcome (result : TestResult) (span : Activity) = + if isNotNull span then + let status = match result with + | Passed -> "Passed" + | Ignored _ -> "Ignored" + | Failed _ -> "Failed" + | Error _ -> "Error" + span.SetTag("test.result.status", status) |> ignore + span.SetTag("test.result.message", result) |> ignore + + let inline start (span : Activity) = + if isNotNull span then + span.Start() |> ignore + span + + let inline stop (span : Activity) = + if isNotNull span then + span.Stop() |> ignore + + let inline setEndTimeNow (span : Activity) = + if isNotNull span then + span.SetEndTime(DateTime.UtcNow) |> ignore + + let inline createActivity (name : string) (source : ActivitySource) = + if isNotNull source then + source.CreateActivity(name, ActivityKind.Internal) + else + null + + open Activity + open System.Runtime.ExceptionServices + + let inline internal reraiseAnywhere<'a> (e: exn) : 'a = + ExceptionDispatchInfo.Capture(e).Throw() + Unchecked.defaultof<'a> + + module TestResult = + let ofException (e:Exception) : TestResult = + match e with + | :? AssertException as e -> + let msg = + "\n" + e.Message + "\n" + + (e.StackTrace.Split('\n') + |> Seq.skipWhile (fun l -> l.StartsWith(" at Expecto.Expect.")) + |> Seq.truncate 5 + |> String.concat "\n") + Failed msg + + | :? FailedException as e -> + Failed ("\n"+e.Message) + | :? IgnoreException as e -> + Ignored e.Message + | :? AggregateException as e when e.InnerExceptions.Count = 1 -> + if e.InnerException :? IgnoreException then + Ignored e.InnerException.Message + else + Error e.InnerException + | e -> + Error e + + + let addExceptionOutcomeToSpan (span: Activity) (e: Exception) = + let testResult = TestResult.ofException e + + addOutcome testResult span + match testResult with + | Ignored _ -> + setExn e span + | _ -> + setExnMarkFailed e span + + let wrapCodeWithSpan (span: Activity) (test: TestCode) = + + let inline handleSuccess span = + setEndTimeNow span + addOutcome Passed span + setStatus ActivityStatusCode.Ok span + + let inline handleFailure span e = + setEndTimeNow span + addExceptionOutcomeToSpan span e + reraiseAnywhere e + + match test with + | Sync test -> + TestCode.Sync (fun () -> + use span = start span + try + test () + handleSuccess span + with + | e -> + handleFailure span e + ) + + | Async test -> + TestCode.Async (async { + use span = start span + try + do! test + handleSuccess span + with + | e -> + handleFailure span e + }) + + | AsyncFsCheck (testConfig, stressConfig, test) -> + TestCode.AsyncFsCheck (testConfig, stressConfig, fun fsCheckConfig -> async { + use span = start span + try + do! test fsCheckConfig + handleSuccess span + with + | e -> + handleFailure span e + }) + + | SyncWithCancel test-> + TestCode.SyncWithCancel (fun ct -> + use span = start span + try + test ct + handleSuccess span + with + | e -> + handleFailure span e + ) + + let addOpenTelemetry_SpanPerTest (config: ExpectoConfig) (activitySource: ActivitySource) (rootTest: Test) : Test = + rootTest + |> Test.toTestCodeList + |> List.map (fun test -> + let span = activitySource |> createActivity (config.joinWith.format test.name) + span |> setSourceLocation (config.locate test.test) + {test with test = wrapCodeWithSpan span test.test} + ) + |> Test.fromFlatTests config.joinWith.asString + + let serviceName = "FsAutoComplete.Tests.Lsp" + + let source = new ActivitySource(serviceName) diff --git a/test/FsAutoComplete.Tests.Lsp/ExtensionsTests.fs b/test/FsAutoComplete.Tests.Lsp/ExtensionsTests.fs index e3b7f7df3..1ef628d1d 100644 --- a/test/FsAutoComplete.Tests.Lsp/ExtensionsTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/ExtensionsTests.fs @@ -326,7 +326,6 @@ let analyzerTests state = let! (server, events) = serverInitialize path analyzerEnabledConfig state let scriptPath = Path.Combine(path, "Script.fsx") - do! Async.Sleep(TimeSpan.FromSeconds 5.) do! waitForWorkspaceFinishedParsing events do! server.TextDocumentDidOpen { TextDocument = loadDocument scriptPath } return server, events, path, scriptPath diff --git a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj index a5f99776a..ff44806a8 100644 --- a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj +++ b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj @@ -29,6 +29,7 @@ + diff --git a/test/FsAutoComplete.Tests.Lsp/Helpers.fs b/test/FsAutoComplete.Tests.Lsp/Helpers.fs index 31637936a..81ee04940 100644 --- a/test/FsAutoComplete.Tests.Lsp/Helpers.fs +++ b/test/FsAutoComplete.Tests.Lsp/Helpers.fs @@ -636,7 +636,6 @@ let parseProject projectFilePath (server: IFSharpLspServer) = let projectName = Path.GetFileNameWithoutExtension projectFilePath let! result = server.FSharpProject projectParams - do! Async.Sleep(TimeSpan.FromSeconds 3.) logger.Value.Debug("{project} parse result: {result}", projectName, result) } diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index 255a22711..57fdb5a7c 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -20,9 +20,52 @@ open System.IO open FsAutoComplete open Helpers open FsToolkit.ErrorHandling +open System.Diagnostics +open OpenTelemetry.Resources +open OpenTelemetry +open OpenTelemetry.Exporter +open OpenTelemetry.Trace Expect.defaultDiffPrinter <- Diff.colourisedDiff +let resourceBuilder version = + ResourceBuilder.CreateDefault().AddService(serviceName = serviceName, serviceVersion = version) + +type SpanFilter(filter: Activity -> bool) = + inherit BaseProcessor() + + override x.OnEnd(span: Activity) : unit = + if filter span then + span.ActivityTraceFlags <- span.ActivityTraceFlags &&& (~~~ActivityTraceFlags.Recorded) + else + base.OnEnd(span: Activity) + +type TracerProviderBuilder with + member x.AddSpanFilter(filter: Activity -> bool) = x.AddProcessor(new SpanFilter(filter)) + +let traceProvider () = + let version = FsAutoComplete.Utils.Version.info().Version + + Sdk + .CreateTracerProviderBuilder() + .AddSource(FsAutoComplete.Utils.Tracing.serviceName, Tracing.fscServiceName, serviceName) + .SetResourceBuilder(resourceBuilder version) + // .AddConsoleExporter() + // .AddOtlpExporter() + .AddSpanFilter((fun span -> span.DisplayName.Contains "DiagnosticsLogger")) // DiagnosticsLogger.StackGuard.Guard is too noisy + .AddOtlpExporter(fun opt -> opt.Endpoint <- Uri "http://localhost:4317") + // .AddOtlpExporter(fun opt -> + // opt.Endpoint <- Uri "http://localhost:5341/ingest/otlp/v1/traces" + // opt.Protocol <- OtlpExportProtocol.HttpProtobuf + // ) + .Build() + +do + let provider = traceProvider () + AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> provider.ForceFlush(3000) |> ignore + // provider.Dispose() + ) + let testTimeout = Environment.GetEnvironmentVariable "TEST_TIMEOUT_MINUTES" @@ -76,7 +119,11 @@ let compilers = | Some(EqIC "BackgroundCompiler") -> [ "BackgroundCompiler", false ] | _ -> [ "BackgroundCompiler", false; "TransparentCompiler", true ] +let otelTests = + OpenTelemetry.addOpenTelemetry_SpanPerTest Expecto.Impl.ExpectoConfig.defaultConfig source + let lspTests = + testSequenced <| testList "lsp" @@ -152,6 +199,7 @@ let generalTests = [] let tests = testList "FSAC" [ generalTests; lspTests; SnapshotTests.snapshotTests loaders toolsPath ] + |> otelTests open OpenTelemetry open OpenTelemetry.Resources @@ -177,6 +225,7 @@ let main args = .AddOtlpExporter() .Build() + let outputTemplate = "[{Timestamp:HH:mm:ss} {Level:u3}] [{SourceContext}] {Message:lj}{NewLine}{Exception}" @@ -278,7 +327,6 @@ let main args = let fixedUpArgs = args |> Array.except argsToRemove let cts = new CancellationTokenSource(testTimeout) - use activitySource = new ActivitySource(serviceName) let cliArgs = [ CLIArguments.Printer(Expecto.Impl.TestPrinters.summaryWithLocationPrinter defaultConfig.printer) diff --git a/test/FsAutoComplete.Tests.Lsp/ScriptTests.fs b/test/FsAutoComplete.Tests.Lsp/ScriptTests.fs index 7d1f585b4..fea1654c0 100644 --- a/test/FsAutoComplete.Tests.Lsp/ScriptTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/ScriptTests.fs @@ -189,8 +189,6 @@ let scriptProjectOptionsCacheTests state = (async { let! server, _events, _workingDir, testFilePath, allOpts = server do! server.TextDocumentDidOpen { TextDocument = loadDocument testFilePath } - do! Async.Sleep(TimeSpan.FromSeconds 3.) do! server.TextDocumentDidOpen { TextDocument = loadDocument testFilePath } - do! Async.Sleep(TimeSpan.FromSeconds 3.) Expect.hasLength allOpts 1 "should only have one event" }) ] ] diff --git a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs index 3705aed69..7b48236ad 100644 --- a/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs +++ b/test/FsAutoComplete.Tests.Lsp/Utils/Server.fs @@ -14,6 +14,7 @@ open FSharpx.Control open Expecto open Utils open Ionide.ProjInfo.Logging +open FsAutoComplete.Telemetry let private logger = LogProvider.getLoggerByName "Utils.Server" @@ -221,7 +222,7 @@ module Document = /// in ms - let private waitForLateDiagnosticsDelay = + let private _waitForLateDiagnosticsDelay = let envVar = "FSAC_WaitForLateDiagnosticsDelay" System.Environment.GetEnvironmentVariable envVar @@ -271,34 +272,53 @@ module Document = /// -> All past `documentAnalyzed` events and their diags are all received at once /// -> waiting a bit after a version-specific `documentAnalyzed` always returns latest diags. //ENHANCEMENT: Send `publishDiagnostics` with Doc Version (LSP `3.15.0`) -> can correlate `documentAnalyzed` and `publishDiagnostics` - let waitForLatestDiagnostics timeout (doc: Document) : Async = + let waitForLatestDiagnostics (timeout : TimeSpan) (doc: Document) : Async = async { + timeout |> ignore + let tags = seq { + "document.filepath", box doc.FilePath + "document.uri", doc.Uri + "document.version", doc.Version + } + use _trace = OpenTelemetry.source.StartActivityForFunc(tags = tags) logger.trace ( Log.setMessage "Waiting for diags for {uri} at version {version}" >> Log.addContext "uri" doc.Uri >> Log.addContext "version" doc.Version ) - - let tcs = TaskCompletionSource<_>() - - use _ = - doc - |> diagnosticsStream - |> Observable.takeUntilOther ( - doc - // `fsharp/documentAnalyzed` signals all checks & analyzers done - |> analyzedStream - |> Observable.filter (fun n -> n.TextDocument.Version = doc.Version) - // wait for late diagnostics - |> Observable.delay waitForLateDiagnosticsDelay - ) - |> Observable.bufferSpan (timeout) - // |> Observable.timeoutSpan timeout - |> Observable.subscribe (fun x -> tcs.SetResult x) - - let! result = tcs.Task |> Async.AwaitTask - - return result |> Seq.last + let p : DocumentDiagnosticParams = { + WorkDoneToken = None + PartialResultToken = None + TextDocument = { Uri = doc.Uri} + Identifier = None + PreviousResultId = None + } + match! doc.Server.Server.TextDocumentDiagnostic p with + | Ok (DocumentDiagnosticReport.C1 d) -> return d.Items + | Ok (DocumentDiagnosticReport.C2 _) -> return Array.empty + | Result.Error _e -> return Array.empty + + + // let tcs = TaskCompletionSource<_>(TaskCreationOptions.RunContinuationsAsynchronously) + + // use _ = + // doc + // |> diagnosticsStream + // |> Observable.takeUntilOther ( + // doc + // // `fsharp/documentAnalyzed` signals all checks & analyzers done + // |> analyzedStream + // |> Observable.filter (fun n -> n.TextDocument.Version = doc.Version) + // // wait for late diagnostics + // |> Observable.delay waitForLateDiagnosticsDelay + // ) + // |> Observable.bufferSpan (timeout) + // // |> Observable.timeoutSpan timeout + // |> Observable.subscribe (fun x -> tcs.SetResult x) + + // let! result = tcs.Task |> Async.AwaitTask + + // return result |> Seq.last } @@ -344,7 +364,7 @@ module Document = ContentChanges = [| U2.C2 { Text = text } |] } do! doc.Server.Server.TextDocumentDidChange p - do! Async.Sleep(TimeSpan.FromMilliseconds 250.) + // do! Async.Sleep(TimeSpan.FromMilliseconds 15.) return! doc |> waitForLatestDiagnostics Helpers.defaultTimeout } @@ -356,7 +376,7 @@ module Document = // Simulate the file being written to disk so we don't hit the typechecker cache IO.File.SetLastWriteTimeUtc(doc.FilePath, DateTime.UtcNow) do! doc.Server.Server.TextDocumentDidSave p - do! Async.Sleep(TimeSpan.FromMilliseconds 250.) + // do! Async.Sleep(TimeSpan.FromMilliseconds 15.) return! doc |> waitForLatestDiagnostics Helpers.defaultTimeout } From a37da744b3a3265a052ae7e1d518d264ee2e5dd1 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Thu, 18 Dec 2025 10:17:15 -0500 Subject: [PATCH 2/3] Update docker-compose and improve test structure with new features --- docker-compose.yml | 17 +- .../LspServers/AdaptiveServerState.fs | 4 +- .../FsAutoComplete.Tests.Lsp/CodeLensTests.fs | 302 ++++++++++-------- .../Expecto.OpenTelemetry.fs | 209 ++++++------ test/FsAutoComplete.Tests.Lsp/Program.fs | 2 +- 5 files changed, 292 insertions(+), 242 deletions(-) diff --git a/docker-compose.yml b/docker-compose.yml index 1ca0fe2e2..3699deb08 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -2,13 +2,13 @@ services: seq: profiles: - seq - image: datalust/seq + image: datalust/seq:2024.3 ports: - 5341:80 # http and collection environment: - ACCEPT_EULA=Y # http://localhost:5341 - # OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:5341/ingest/otlp/v1/logs + # OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:5341/ingest/otlp/v1/traces # OTEL_EXPORTER_OTLP_PROTOCOL="http/protobuf" # OTEL_EXPORTER_OTLP_HEADERS="X-Seq-ApiKey=your_api_key" jaeger: @@ -31,3 +31,16 @@ services: - COLLECTOR_OTLP_ENABLED=true # http://localhost:16686/ # OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:4317 + aspire: + profiles: + - aspire + image: mcr.microsoft.com/dotnet/nightly/aspire-dashboard + ports: + - 4317:18889 #otel + - 18888:18888 #http + environment: + - DOTNET_DASHBOARD_UNSECURED_ALLOW_ANONYMOUS=true + # - OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:4317 + # - OTEL_EXPORTER_OTLP_HEADERS=X-Seq-ApiKey=your_api_key + # http://localhost:18888/ + # OTEL_EXPORTER_OTLP_ENDPOINT=http://localhost:4317 diff --git a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs index d784a97cc..ab72fc56e 100644 --- a/src/FsAutoComplete/LspServers/AdaptiveServerState.fs +++ b/src/FsAutoComplete/LspServers/AdaptiveServerState.fs @@ -558,8 +558,6 @@ type AdaptiveState | _ -> ranges) - let! ct = Async.CancellationToken - return NotificationEvent.UnnecessaryParentheses(filePath, Array.ofSeq unnecessaryParentheses, file.Version) |> Some @@ -2682,6 +2680,8 @@ type AdaptiveState updateOpenFiles file + failwith "Something stupid happened" + do! forceGetOpenFileTypeCheckResults filePath |> Async.Ignore> diff --git a/test/FsAutoComplete.Tests.Lsp/CodeLensTests.fs b/test/FsAutoComplete.Tests.Lsp/CodeLensTests.fs index 8d77dd715..223339398 100644 --- a/test/FsAutoComplete.Tests.Lsp/CodeLensTests.fs +++ b/test/FsAutoComplete.Tests.Lsp/CodeLensTests.fs @@ -16,7 +16,8 @@ open Helpers.Expecto.ShadowedTimeouts open System.IO module private CodeLens = - let examples = Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "CodeLensProjectTests") + let examples = + Path.Combine(__SOURCE_DIRECTORY__, "TestCases", "CodeLensProjectTests") module CodeLensPositionStaysAccurate = let dir = examples "CodeLens_position_stays_accurate" @@ -64,164 +65,181 @@ module private CodeLens = let projectBasedTests state = - testList "ProjectBased" [ - serverTestList ("CodeLensPositionStaysAccurate") state defaultConfigDto (Some CodeLens.CodeLensPositionStaysAccurate.dir) (fun server -> [ - - testCaseAsync "can show codelens after adding newlines to code" - <| (asyncResult { - let program = CodeLens.CodeLensPositionStaysAccurate.programFile - let! (doc, _diags) = Server.openDocument program server - - let! unresolved = CodeLens.getLenses doc - let! resolved = CodeLens.getResolvedLenses doc unresolved - - let references = - resolved - |> List.filter (fun lens -> lens.Command |>Option.exists (fun c -> c.Title.EndsWith "References")) - |> List.sortBy (fun lens -> lens.Range.Start.Line) - - Expect.hasLength references 2 "should have a reference lens" - - let lens1 = references.[0] - let lens1Range : Range = { - Start = { Line = 1u; Character = 6u } - End = { Line = 1u; Character = 20u } - } - - Expect.equal lens1.Range lens1Range "Lens 1 should be at 1:6-1:20" - - let lens2 = references.[1] - let lens2Range : Range = { - Start = { Line = 3u; Character = 6u } - End = { Line = 3u; Character = 25u } - } - - Expect.equal lens2.Range lens2Range "Lens 2 should be at 3:6-3:25" - - do! doc.Server.Server.TextDocumentDidChange({ - TextDocument = doc.VersionedTextDocumentIdentifier - ContentChanges = [| U2.C1 { - Range = { Start = { Line = 2u; Character = 0u }; End = { Line = 2u; Character = 0u }; } - RangeLength = None - Text = "\n\n" - } |] - }) + testList + "ProjectBased" + [ serverTestList + ("CodeLensPositionStaysAccurate") + state + defaultConfigDto + (Some CodeLens.CodeLensPositionStaysAccurate.dir) + (fun server -> + [ + + testCaseAsync "can show codelens after adding newlines to code" + <| (asyncResult { + let program = CodeLens.CodeLensPositionStaysAccurate.programFile + let! (doc, _diags) = Server.openDocument program server + + let! unresolved = CodeLens.getLenses doc + let! resolved = CodeLens.getResolvedLenses doc unresolved + + let references = + resolved + |> List.filter (fun lens -> lens.Command |> Option.exists (fun c -> c.Title.EndsWith "References")) + |> List.sortBy (fun lens -> lens.Range.Start.Line) + + Expect.hasLength references 2 "should have a reference lens" + + let lens1 = references.[0] + + let lens1Range: Range = + { Start = { Line = 1u; Character = 6u } + End = { Line = 1u; Character = 20u } } + + Expect.equal lens1.Range lens1Range "Lens 1 should be at 1:6-1:20" + + let lens2 = references.[1] - let! nextLens = CodeLens.getLenses doc - let! resolvedNextLens = CodeLens.getResolvedLenses doc nextLens + let lens2Range: Range = + { Start = { Line = 3u; Character = 6u } + End = { Line = 3u; Character = 25u } } - let references = - resolvedNextLens - |> List.filter (fun lens -> lens.Command |>Option.exists (fun c -> c.Title.EndsWith "References")) - |> List.sortBy (fun lens -> lens.Range.Start.Line) + Expect.equal lens2.Range lens2Range "Lens 2 should be at 3:6-3:25" - let lens1 = references.[0] - let lens1Range : Range = { - Start = { Line = 1u; Character = 6u } - End = { Line = 1u; Character = 20u } - } + do! + doc.Server.Server.TextDocumentDidChange( + { TextDocument = doc.VersionedTextDocumentIdentifier + ContentChanges = + [| U2.C1 + { Range = + { Start = { Line = 2u; Character = 0u } + End = { Line = 2u; Character = 0u } } + RangeLength = None + Text = "\n\n" } |] } + ) - Expect.equal lens1.Range lens1Range "Lens 1 should be at 1:6-1:20" + let! nextLens = CodeLens.getLenses doc + let! resolvedNextLens = CodeLens.getResolvedLenses doc nextLens - let lens2 = references.[1] - let lens2Range : Range = { - Start = { Line = 5u; Character = 6u } - End = { Line = 5u; Character = 25u } - } + let references = + resolvedNextLens + |> List.filter (fun lens -> lens.Command |> Option.exists (fun c -> c.Title.EndsWith "References")) + |> List.sortBy (fun lens -> lens.Range.Start.Line) - Expect.equal lens2.Range lens2Range "Lens 2 should be at 5:6-5:25" + let lens1 = references.[0] - return () - } - |> AsyncResult.foldResult id (fun e -> failtest $"{e}" )) + let lens1Range: Range = + { Start = { Line = 1u; Character = 6u } + End = { Line = 1u; Character = 20u } } - ] - ) - ] + Expect.equal lens1.Range lens1Range "Lens 1 should be at 1:6-1:20" + + let lens2 = references.[1] + + let lens2Range: Range = + { Start = { Line = 5u; Character = 6u } + End = { Line = 5u; Character = 25u } } + + Expect.equal lens2.Range lens2Range "Lens 2 should be at 5:6-5:25" + + return () + } + |> AsyncResult.foldResult id (fun e -> failtest $"{e}")) + + ]) ] let tests state = - testList (nameof CodeLens) [ - projectBasedTests state - serverTestList "scriptTests" state defaultConfigDto None (fun server -> - [ testCaseAsync "can show codelens for type annotation" - <| CodeLens.check server """ + testList + (nameof CodeLens) + [ projectBasedTests state + serverTestList "scriptTests" state defaultConfigDto None (fun server -> + [ testCaseAsync "can show codelens for type annotation" + <| CodeLens.check server """ module X = $0let func x = x + 1$0 - """ (fun (_doc, lenses, _unresolved, _resolved) -> async { - Expect.hasLength lenses 2 "should have a type lens and a reference lens" - let typeLens = lenses[0] - Expect.equal typeLens.Command.Value.Title "int -> int" "first lens should be a type hint of int to int" - Expect.isNone typeLens.Command.Value.Arguments "No data required for type lenses" - Expect.equal typeLens.Command.Value.Command "" "No command for type lenses" }) - - testCaseAsync "can show codelens for 0 reference count" - <| CodeLens.check server """ + """ (fun (_doc, lenses, _unresolved, _resolved) -> + async { + Expect.hasLength lenses 2 "should have a type lens and a reference lens" + let typeLens = lenses[0] + Expect.equal typeLens.Command.Value.Title "int -> int" "first lens should be a type hint of int to int" + Expect.isNone typeLens.Command.Value.Arguments "No data required for type lenses" + Expect.equal typeLens.Command.Value.Command "" "No command for type lenses" + }) + + testCaseAsync "can show codelens for 0 reference count" + <| CodeLens.check server """ module X = $0let func x = x + 1$0 - """ (fun (_doc, lenses, _unresolved, _resolved) -> async { - Expect.hasLength lenses 2 "should have a type lens and a reference lens" - let referenceLens = lenses[1] - - let emptyCommand = - Some - { Title = "0 References" - Arguments = None - Command = "" } - - Expect.equal referenceLens.Command emptyCommand "There should be no command or args for zero references" }) - testCaseAsync "can show codelens for multi reference count" - <| CodeLens.check server """ + """ (fun (_doc, lenses, _unresolved, _resolved) -> + async { + Expect.hasLength lenses 2 "should have a type lens and a reference lens" + let referenceLens = lenses[1] + + let emptyCommand = + Some + { Title = "0 References" + Arguments = None + Command = "" } + + Expect.equal referenceLens.Command emptyCommand "There should be no command or args for zero references" + }) + testCaseAsync "can show codelens for multi reference count" + <| CodeLens.check server """ module X = $0let func x = x + 1$0 let doThing () = func 1 - """ (fun (doc, lenses, _unresolved, _resolved) -> async { - - - Expect.hasLength lenses 2 "should have a type lens and a reference lens" - let referenceLens = lenses[1] - Expect.isSome referenceLens.Command "There should be a command for multiple references" - let referenceCommand = referenceLens.Command.Value - Expect.equal referenceCommand.Title "1 References" "There should be a title for multiple references" - - Expect.equal - referenceCommand.Command - "fsharp.showReferences" - "There should be a command for multiple references" - - Expect.isSome referenceCommand.Arguments "There should be arguments for multiple references" - let args = referenceCommand.Arguments.Value - Expect.equal args.Length 3 "There should be 2 args" - - let filePath, triggerPos, referenceRanges = - args[0].Value(), - (args[1] :?> JObject).ToObject(), - (args[2] :?> JArray) - |> Seq.map (fun t -> (t :?> JObject).ToObject()) - |> Array.ofSeq - - Expect.equal filePath doc.Uri "File path should be the doc we're checking" - Expect.equal triggerPos { Line = 1u; Character = 6u } "Position should be 1:6" - Expect.hasLength referenceRanges 1 "There should be 1 reference range for the `func` function" - - Expect.equal - referenceRanges[0] - { Uri = doc.Uri - Range = - { Start = { Line = 3u; Character = 19u } - End = { Line = 3u; Character = 23u } } } - "Reference range should be 0:0"}) - testCaseAsync "can show reference counts for 1-character identifier" - <| CodeLens.check server """ + """ (fun (doc, lenses, _unresolved, _resolved) -> + async { + + + Expect.hasLength lenses 2 "should have a type lens and a reference lens" + let referenceLens = lenses[1] + Expect.isSome referenceLens.Command "There should be a command for multiple references" + let referenceCommand = referenceLens.Command.Value + Expect.equal referenceCommand.Title "1 References" "There should be a title for multiple references" + + Expect.equal + referenceCommand.Command + "fsharp.showReferences" + "There should be a command for multiple references" + + Expect.isSome referenceCommand.Arguments "There should be arguments for multiple references" + let args = referenceCommand.Arguments.Value + Expect.equal args.Length 3 "There should be 2 args" + + let filePath, triggerPos, referenceRanges = + args[0].Value(), + (args[1] :?> JObject).ToObject(), + (args[2] :?> JArray) + |> Seq.map (fun t -> (t :?> JObject).ToObject()) + |> Array.ofSeq + + Expect.equal filePath doc.Uri "File path should be the doc we're checking" + Expect.equal triggerPos { Line = 1u; Character = 6u } "Position should be 1:6" + Expect.hasLength referenceRanges 1 "There should be 1 reference range for the `func` function" + + Expect.equal + referenceRanges[0] + { Uri = doc.Uri + Range = + { Start = { Line = 3u; Character = 19u } + End = { Line = 3u; Character = 23u } } } + "Reference range should be 0:0" + }) + testCaseAsync "can show reference counts for 1-character identifier" + <| CodeLens.check server """ $0let f () = ""$0 - """ (fun (_doc, lenses, _unresolved, _resolved) -> async { - Expect.hasLength lenses 2 "should have a type lens and a reference lens" - let referenceLens = lenses[1] - Expect.isSome referenceLens.Command "There should be a command for multiple references" - let referenceCommand = referenceLens.Command.Value - Expect.equal referenceCommand.Title "0 References" "There should be a title for multiple references" - Expect.equal referenceCommand.Command "" "There should be no command for multiple references" - Expect.isNone referenceCommand.Arguments "There should be arguments for multiple references"}) ]) - - ] + """ (fun (_doc, lenses, _unresolved, _resolved) -> + async { + Expect.hasLength lenses 2 "should have a type lens and a reference lens" + let referenceLens = lenses[1] + Expect.isSome referenceLens.Command "There should be a command for multiple references" + let referenceCommand = referenceLens.Command.Value + Expect.equal referenceCommand.Title "0 References" "There should be a title for multiple references" + Expect.equal referenceCommand.Command "" "There should be no command for multiple references" + Expect.isNone referenceCommand.Arguments "There should be arguments for multiple references" + }) ]) + + ] diff --git a/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs b/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs index dd1839a0a..7c449e4db 100644 --- a/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs +++ b/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs @@ -7,81 +7,94 @@ module OpenTelemetry = open System.Threading open Impl open System.Runtime.CompilerServices + type Activity with - member inline x.SetSource( - ?name_space : string, - [] ?memberName: string, - [] ?path: string, - [] ?line: int) = - if not (isNull x) then - let name_space = - name_space - |> Option.defaultWith (fun () -> - Reflection.MethodBase.GetCurrentMethod().DeclaringType.FullName.Split("+") // F# has + in type names that refer to anonymous functions, we typically want the first named type - |> Seq.tryHead - |> Option.defaultValue "") - if x.GetTagItem "code.namespace" = null then x.SetTag("code.namespace", name_space) |> ignore - if x.GetTagItem "code.function" = null then x.SetTag("code.function", defaultArg memberName "") |> ignore - if x.GetTagItem "code.filepath" = null then x.SetTag("code.filepath", defaultArg path "") |> ignore - if x.GetTagItem "code.lineno" = null then x.SetTag("code.lineno", defaultArg line 0) |> ignore + member inline x.SetSource + ( + ?name_space: string, + [] ?memberName: string, + [] ?path: string, + [] ?line: int + ) = + if not (isNull x) then + let name_space = + name_space + |> Option.defaultWith (fun () -> + Reflection.MethodBase.GetCurrentMethod().DeclaringType.FullName.Split("+") // F# has + in type names that refer to anonymous functions, we typically want the first named type + |> Seq.tryHead + |> Option.defaultValue "") + + if x.GetTagItem "code.namespace" = null then + x.SetTag("code.namespace", name_space) |> ignore + + if x.GetTagItem "code.function" = null then + x.SetTag("code.function", defaultArg memberName "") |> ignore + + if x.GetTagItem "code.filepath" = null then + x.SetTag("code.filepath", defaultArg path "") |> ignore + + if x.GetTagItem "code.lineno" = null then + x.SetTag("code.lineno", defaultArg line 0) |> ignore module internal Activity = let inline isNotNull x = isNull x |> not - let inline setStatus (status : ActivityStatusCode) (span : Activity) = + let inline setStatus (status: ActivityStatusCode) (span: Activity) = if isNotNull span then span.SetStatus(status) |> ignore - let inline setExn (e : exn) (span : Activity) = - if isNotNull span|> not then + let inline setExn (e: exn) (span: Activity) = + if isNotNull span |> not then let tags = - ActivityTagsCollection( - seq { - KeyValuePair("exception.type", box (e.GetType().Name)) - KeyValuePair("exception.stacktrace", box (e.ToString())) - if not <| String.IsNullOrEmpty(e.Message) then - KeyValuePair("exception.message", box e.Message) - } - ) - - ActivityEvent("exception", tags = tags) - |> span.AddEvent - |> ignore - - let inline setExnMarkFailed (e : exn) (span : Activity) = + ActivityTagsCollection( + seq { + KeyValuePair("exception.type", box (e.GetType().Name)) + KeyValuePair("exception.stacktrace", box (e.ToString())) + + if not <| String.IsNullOrEmpty(e.Message) then + KeyValuePair("exception.message", box e.Message) + } + ) + + ActivityEvent("exception", tags = tags) |> span.AddEvent |> ignore + + let inline setExnMarkFailed (e: exn) (span: Activity) = if isNotNull span then setExn e span - span |> setStatus ActivityStatusCode.Error + span |> setStatus ActivityStatusCode.Error - let setSourceLocation (sourceLoc : SourceLocation) (span : Activity) = + let setSourceLocation (sourceLoc: SourceLocation) (span: Activity) = if isNotNull span && sourceLoc <> SourceLocation.empty then span.SetTag("code.lineno", sourceLoc.lineNumber) |> ignore span.SetTag("code.filepath", sourceLoc.sourcePath) |> ignore - let inline addOutcome (result : TestResult) (span : Activity) = + let inline addOutcome (result: TestResult) (span: Activity) = if isNotNull span then - let status = match result with - | Passed -> "Passed" - | Ignored _ -> "Ignored" - | Failed _ -> "Failed" - | Error _ -> "Error" + let status = + match result with + | Passed -> "Passed" + | Ignored _ -> "Ignored" + | Failed _ -> "Failed" + | Error _ -> "Error" + span.SetTag("test.result.status", status) |> ignore span.SetTag("test.result.message", result) |> ignore - let inline start (span : Activity) = + let inline start (span: Activity) = if isNotNull span then span.Start() |> ignore + span - let inline stop (span : Activity) = + let inline stop (span: Activity) = if isNotNull span then span.Stop() |> ignore - let inline setEndTimeNow (span : Activity) = + let inline setEndTimeNow (span: Activity) = if isNotNull span then span.SetEndTime(DateTime.UtcNow) |> ignore - let inline createActivity (name : string) (source : ActivitySource) = + let inline createActivity (name: string) (source: ActivitySource) = if isNotNull source then source.CreateActivity(name, ActivityKind.Internal) else @@ -91,43 +104,42 @@ module OpenTelemetry = open System.Runtime.ExceptionServices let inline internal reraiseAnywhere<'a> (e: exn) : 'a = - ExceptionDispatchInfo.Capture(e).Throw() - Unchecked.defaultof<'a> + ExceptionDispatchInfo.Capture(e).Throw() + Unchecked.defaultof<'a> module TestResult = - let ofException (e:Exception) : TestResult = + let ofException (e: Exception) : TestResult = match e with | :? AssertException as e -> let msg = - "\n" + e.Message + "\n" + - (e.StackTrace.Split('\n') - |> Seq.skipWhile (fun l -> l.StartsWith(" at Expecto.Expect.")) - |> Seq.truncate 5 - |> String.concat "\n") + "\n" + + e.Message + + "\n" + + (e.StackTrace.Split('\n') + |> Seq.skipWhile (fun l -> l.StartsWith(" at Expecto.Expect.")) + |> Seq.truncate 5 + |> String.concat "\n") + Failed msg - | :? FailedException as e -> - Failed ("\n"+e.Message) - | :? IgnoreException as e -> - Ignored e.Message + | :? FailedException as e -> Failed("\n" + e.Message) + | :? IgnoreException as e -> Ignored e.Message | :? AggregateException as e when e.InnerExceptions.Count = 1 -> if e.InnerException :? IgnoreException then Ignored e.InnerException.Message else Error e.InnerException - | e -> - Error e + | e -> Error e let addExceptionOutcomeToSpan (span: Activity) (e: Exception) = let testResult = TestResult.ofException e addOutcome testResult span + match testResult with - | Ignored _ -> - setExn e span - | _ -> - setExnMarkFailed e span + | Ignored _ -> setExn e span + | _ -> setExnMarkFailed e span let wrapCodeWithSpan (span: Activity) (test: TestCode) = @@ -143,57 +155,64 @@ module OpenTelemetry = match test with | Sync test -> - TestCode.Sync (fun () -> + TestCode.Sync(fun () -> use span = start span + try test () handleSuccess span - with - | e -> - handleFailure span e - ) + with e -> + handleFailure span e) | Async test -> - TestCode.Async (async { - use span = start span - try - do! test - handleSuccess span - with - | e -> - handleFailure span e - }) + TestCode.Async( + async { + use span = start span + + try + do! test + handleSuccess span + with e -> + handleFailure span e + } + ) - | AsyncFsCheck (testConfig, stressConfig, test) -> - TestCode.AsyncFsCheck (testConfig, stressConfig, fun fsCheckConfig -> async { - use span = start span - try - do! test fsCheckConfig - handleSuccess span - with - | e -> - handleFailure span e - }) + | AsyncFsCheck(testConfig, stressConfig, test) -> + TestCode.AsyncFsCheck( + testConfig, + stressConfig, + fun fsCheckConfig -> + async { + use span = start span + + try + do! test fsCheckConfig + handleSuccess span + with e -> + handleFailure span e + } + ) - | SyncWithCancel test-> - TestCode.SyncWithCancel (fun ct -> + | SyncWithCancel test -> + TestCode.SyncWithCancel(fun ct -> use span = start span + try test ct handleSuccess span - with - | e -> - handleFailure span e - ) + with e -> + handleFailure span e) + /// Span -> Activity let addOpenTelemetry_SpanPerTest (config: ExpectoConfig) (activitySource: ActivitySource) (rootTest: Test) : Test = rootTest |> Test.toTestCodeList |> List.map (fun test -> let span = activitySource |> createActivity (config.joinWith.format test.name) span |> setSourceLocation (config.locate test.test) - {test with test = wrapCodeWithSpan span test.test} - ) + + { test with + test = wrapCodeWithSpan span test.test }) |> Test.fromFlatTests config.joinWith.asString let serviceName = "FsAutoComplete.Tests.Lsp" diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index 57fdb5a7c..d193916b9 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -334,5 +334,5 @@ let main args = CLIArguments.Parallel ] // let trace = traceProvider.GetTracer("FsAutoComplete.Tests.Lsp") // use span = trace.StartActiveSpan("runTests", SpanKind.Internal) - use span = activitySource.StartActivity("runTests") + use span = source.StartActivity("runTests") runTestsWithCLIArgsAndCancel cts.Token cliArgs fixedUpArgs tests From ace4d4d3e426b580464108a15a94bb0dacfb6459 Mon Sep 17 00:00:00 2001 From: Jimmy Byrd Date: Thu, 18 Dec 2025 15:13:04 -0500 Subject: [PATCH 3/3] Add OpenTelemetry file exporter for failed test traces and update CI workflow --- .github/workflows/build.yml | 12 +- docs/Analyzing failed test traces.md | 262 +++++++++++++ .../Expecto.OpenTelemetry.fs | 29 +- .../FsAutoComplete.Tests.Lsp.fsproj | 1 + .../OpenTelemetry.Exporter.fs | 349 ++++++++++++++++++ test/FsAutoComplete.Tests.Lsp/Program.fs | 87 ++++- 6 files changed, 714 insertions(+), 26 deletions(-) create mode 100644 docs/Analyzing failed test traces.md create mode 100644 test/FsAutoComplete.Tests.Lsp/OpenTelemetry.Exporter.fs diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 4e4e9b379..a88452b4a 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -111,13 +111,23 @@ jobs: BuildNet10: ${{ matrix.build_net10 }} - name: Run and report tests - run: dotnet test -c Release -f ${{ matrix.test_tfm }} --no-restore --no-build --logger "console;verbosity=normal" --logger GitHubActions /p:AltCover=true /p:AltCoverAssemblyExcludeFilter="System.Reactive|FSharp.Compiler.Service|Ionide.ProjInfo|FSharp.Analyzers|Analyzer|Humanizer|FSharp.Core|FSharp.DependencyManager" -- Expecto.fail-on-focused-tests=true --blame-hang --blame-hang-timeout 1m + run: dotnet run -c Release -f ${{ matrix.test_tfm }} --no-build -- --fail-on-focused-tests --parallel working-directory: test/FsAutoComplete.Tests.Lsp env: BuildNet9: ${{ matrix.build_net9 }} BuildNet10: ${{ matrix.build_net10 }} USE_TRANSPARENT_COMPILER: ${{ matrix.use-transparent-compiler }} USE_WORKSPACE_LOADER: ${{ matrix.workspace-loader }} + FAILED_TRACES_DIR: ${{ github.workspace }}/failed_traces + + - name: Upload failed test traces + if: failure() + uses: actions/upload-artifact@v4 + with: + name: failed-test-traces-${{ matrix.os }}-${{ matrix.label }}-${{ matrix.workspace-loader }}-${{ matrix.use-transparent-compiler }} + path: failed_traces/ + if-no-files-found: ignore + retention-days: 7 analyze: runs-on: ubuntu-latest diff --git a/docs/Analyzing failed test traces.md b/docs/Analyzing failed test traces.md new file mode 100644 index 000000000..9aca2ea0a --- /dev/null +++ b/docs/Analyzing failed test traces.md @@ -0,0 +1,262 @@ +# Analyzing Failed Test Traces + +When tests fail in CI, FsAutoComplete exports OpenTelemetry traces for the failed tests in OTLP JSON format. These traces can be imported into observability tools like Jaeger, Aspire Dashboard, or Zipkin for detailed analysis. + +## Finding the Trace Files + +### GitHub Actions + +1. Navigate to the failed workflow run +2. Scroll to the **Artifacts** section at the bottom +3. Download the artifact named `failed-test-traces-{os}-{dotnet}-{loader}-{compiler}` +4. Extract the ZIP file to find `failed_tests_{timestamp}.otlp.json` + +### Local Development + +When running tests locally with `CI=true`: + +```bash +CI=true FAILED_TRACES_DIR=./traces dotnet run -c Release -f net8.0 +``` + +Trace files will be written to the specified directory (default: `failed_traces/`). + +## Viewing Traces + +### Option 1: Jaeger + +[Jaeger](https://www.jaegertracing.io/) is a popular open-source distributed tracing platform. + +#### Quick Start with Docker + +```bash +# Start Jaeger with OTLP support +docker run -d --name jaeger \ + -p 16686:16686 \ + -p 4317:4317 \ + -p 4318:4318 \ + jaegertracing/all-in-one:latest +``` + +#### Import Traces via OTLP HTTP + +```bash +# Send the trace file to Jaeger's OTLP HTTP endpoint +curl -X POST http://localhost:4318/v1/traces \ + -H "Content-Type: application/json" \ + -d @failed_tests_20251218_100000.otlp.json +``` + +#### View in Jaeger UI + +1. Open http://localhost:16686 +2. Select service `FsAutoComplete.Tests.Lsp` +3. Click "Find Traces" +4. Click on a trace to see the span details, including: + - Test name + - Duration + - Error status and message + - Exception details (type, message, stack trace) + - Source code location (file path, line number) + +### Option 2: Aspire Dashboard + +The [.NET Aspire Dashboard](https://learn.microsoft.com/en-us/dotnet/aspire/fundamentals/dashboard/overview) provides a standalone trace viewer. + +#### Quick Start with Docker + +```bash +# Start Aspire Dashboard +docker run -d --name aspire-dashboard \ + -p 18888:18888 \ + -p 4317:18889 \ + -p 4318:18890 \ + mcr.microsoft.com/dotnet/aspire-dashboard:latest +``` + +#### Import Traces + +```bash +# Send traces to Aspire's OTLP HTTP endpoint +curl -X POST http://localhost:18890/v1/traces \ + -H "Content-Type: application/json" \ + -d @failed_tests_20251218_100000.otlp.json +``` + +#### View in Aspire Dashboard + +1. Open http://localhost:18888 +2. Navigate to the "Traces" tab +3. Browse and filter traces by service name or status + +### Option 3: OpenTelemetry Collector + +For more flexibility, use the [OpenTelemetry Collector](https://opentelemetry.io/docs/collector/) to route traces to multiple backends. + +#### Collector Configuration + +Create `otel-collector-config.yaml`: + +```yaml +receivers: + otlp: + protocols: + grpc: + endpoint: 0.0.0.0:4317 + http: + endpoint: 0.0.0.0:4318 + +exporters: + # Export to Jaeger + otlp/jaeger: + endpoint: jaeger:4317 + tls: + insecure: true + + # Or export to console for debugging + debug: + verbosity: detailed + +service: + pipelines: + traces: + receivers: [otlp] + exporters: [otlp/jaeger, debug] +``` + +#### Run the Collector + +```bash +docker run -d --name otel-collector \ + -p 4317:4317 \ + -p 4318:4318 \ + -v $(pwd)/otel-collector-config.yaml:/etc/otelcol/config.yaml \ + otel/opentelemetry-collector:latest +``` + +### Option 4: Programmatic Analysis + +You can also analyze the JSON file programmatically: + +#### F# Example + +```fsharp +open System.Text.Json + +type AnyValue = { stringValue: string option; intValue: string option } +type KeyValue = { key: string; value: AnyValue } +type SpanStatus = { code: int; message: string option } +type OtlpSpan = { + traceId: string + spanId: string + name: string + startTimeUnixNano: string + endTimeUnixNano: string + attributes: KeyValue[] + status: SpanStatus +} +type ScopeSpans = { spans: OtlpSpan[] } +type ResourceSpans = { scopeSpans: ScopeSpans[] } +type TracesData = { resourceSpans: ResourceSpans[] } + +let traces = JsonSerializer.Deserialize(File.ReadAllText("failed_tests.otlp.json")) + +for rs in traces.resourceSpans do + for ss in rs.scopeSpans do + for span in ss.spans do + printfn "Test: %s" span.name + printfn "Status: %s" (if span.status.code = 2 then "FAILED" else "OK") + for attr in span.attributes do + match attr.value.stringValue with + | Some v -> printfn " %s: %s" attr.key v + | None -> () +``` + +#### PowerShell Example + +```powershell +$traces = Get-Content "failed_tests.otlp.json" | ConvertFrom-Json + +foreach ($rs in $traces.resourceSpans) { + foreach ($ss in $rs.scopeSpans) { + foreach ($span in $ss.spans) { + Write-Host "Test: $($span.name)" + Write-Host "Status: $(if ($span.status.code -eq 2) { 'FAILED' } else { 'OK' })" + foreach ($attr in $span.attributes) { + if ($attr.value.stringValue) { + Write-Host " $($attr.key): $($attr.value.stringValue)" + } + } + Write-Host "" + } + } +} +``` + +## Trace Structure + +The trace files follow the [OTLP JSON Protobuf Encoding](https://opentelemetry.io/docs/specs/otlp/#json-protobuf-encoding) specification. + +Each failed test span contains: + +| Field | Description | +|-------|-------------| +| `traceId` | Unique trace identifier (32-char lowercase hex string) | +| `spanId` | Unique span identifier (16-char lowercase hex string) | +| `name` | Full test name (e.g., `FSAC.lsp.CodeFix.TestName`) | +| `startTimeUnixNano` | Test start time in nanoseconds since Unix epoch | +| `endTimeUnixNano` | Test end time in nanoseconds since Unix epoch | +| `status.code` | `0` = Unset, `1` = OK, `2` = Error | +| `status.message` | Error description | + +### Common Attributes + +| Attribute | Description | +|-----------|-------------| +| `test.result.status` | `Passed`, `Failed`, `Error`, or `Ignored` | +| `test.result.message` | Detailed failure message | +| `code.filepath` | Source file path | +| `code.lineno` | Line number in source | +| `exception.type` | Exception type name | +| `exception.message` | Exception message | +| `exception.stacktrace` | Full stack trace | + +### Events + +Exception details are recorded as span events with the name `exception`, containing: +- `exception.type` +- `exception.message` +- `exception.stacktrace` + +## Troubleshooting + +### No trace file generated + +- Ensure `CI=true` environment variable is set +- Check that tests actually failed (traces are only generated for failures) +- Verify `FAILED_TRACES_DIR` points to a writable directory + +### Traces not appearing in Jaeger/Aspire + +- Verify the OTLP endpoint is accessible +- Check that the JSON file is valid: `jq . failed_tests.otlp.json` +- Ensure the Content-Type header is set to `application/json` + +### Large trace files + +If many tests fail, the trace file may be large. Consider: +- Filtering to specific test categories +- Using `--filter` to run a subset of tests +- Compressing before upload: `gzip failed_tests.otlp.json` + +## Implementation Notes + +The OTLP JSON serialization is implemented in `test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs`. + +While the `OpenTelemetry.Exporter.OpenTelemetryProtocol` NuGet package contains protobuf types (`OpenTelemetry.Proto.Trace.V1.Span`, etc.), these types are marked as **internal** and cannot be used directly by consuming code. Therefore, we implement our own JSON serialization following the OTLP specification. + +Key implementation details: +- Trace and span IDs use **lowercase hex encoding** (not base64) per OTLP JSON spec +- Timestamps are nanoseconds since Unix epoch as strings +- Enum values are serialized as integers (e.g., `status.code: 2` for Error) +- The `FailedTestFileExporter` processor filters spans by `test.result.status` tag diff --git a/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs b/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs index 7c449e4db..373861b9b 100644 --- a/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs +++ b/test/FsAutoComplete.Tests.Lsp/Expecto.OpenTelemetry.fs @@ -4,7 +4,6 @@ module OpenTelemetry = open System open System.Diagnostics open System.Collections.Generic - open System.Threading open Impl open System.Runtime.CompilerServices @@ -141,7 +140,18 @@ module OpenTelemetry = | Ignored _ -> setExn e span | _ -> setExnMarkFailed e span - let wrapCodeWithSpan (span: Activity) (test: TestCode) = + /// Wraps test code with a span that is created lazily when the test runs + /// This ensures the ActivitySource has a listener registered by the time tests execute + let wrapCodeWithLazySpan + (activitySource: ActivitySource) + (testName: string) + (sourceLoc: SourceLocation) + (test: TestCode) + = + let createAndConfigureSpan () = + let span = activitySource |> createActivity testName + span |> setSourceLocation sourceLoc + span let inline handleSuccess span = setEndTimeNow span @@ -156,7 +166,7 @@ module OpenTelemetry = match test with | Sync test -> TestCode.Sync(fun () -> - use span = start span + use span = createAndConfigureSpan () |> start try test () @@ -167,7 +177,7 @@ module OpenTelemetry = | Async test -> TestCode.Async( async { - use span = start span + use span = createAndConfigureSpan () |> start try do! test @@ -183,7 +193,7 @@ module OpenTelemetry = stressConfig, fun fsCheckConfig -> async { - use span = start span + use span = createAndConfigureSpan () |> start try do! test fsCheckConfig @@ -195,7 +205,7 @@ module OpenTelemetry = | SyncWithCancel test -> TestCode.SyncWithCancel(fun ct -> - use span = start span + use span = createAndConfigureSpan () |> start try test ct @@ -204,15 +214,16 @@ module OpenTelemetry = handleFailure span e) /// Span -> Activity + /// Activities are created lazily when tests run, ensuring the TracerProvider listener is registered let addOpenTelemetry_SpanPerTest (config: ExpectoConfig) (activitySource: ActivitySource) (rootTest: Test) : Test = rootTest |> Test.toTestCodeList |> List.map (fun test -> - let span = activitySource |> createActivity (config.joinWith.format test.name) - span |> setSourceLocation (config.locate test.test) + let testName = config.joinWith.format test.name + let sourceLoc = config.locate test.test { test with - test = wrapCodeWithSpan span test.test }) + test = wrapCodeWithLazySpan activitySource testName sourceLoc test.test }) |> Test.fromFlatTests config.joinWith.asString let serviceName = "FsAutoComplete.Tests.Lsp" diff --git a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj index ff44806a8..d705b7c85 100644 --- a/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj +++ b/test/FsAutoComplete.Tests.Lsp/FsAutoComplete.Tests.Lsp.fsproj @@ -29,6 +29,7 @@ + diff --git a/test/FsAutoComplete.Tests.Lsp/OpenTelemetry.Exporter.fs b/test/FsAutoComplete.Tests.Lsp/OpenTelemetry.Exporter.fs new file mode 100644 index 000000000..c78b1ae59 --- /dev/null +++ b/test/FsAutoComplete.Tests.Lsp/OpenTelemetry.Exporter.fs @@ -0,0 +1,349 @@ +/// OpenTelemetry File Exporter for OTLP JSON format +/// Exports traces to files in OTLP JSON format compatible with Jaeger, Aspire, and other OTLP-compatible backends +module OpenTelemetry.Exporter.OtlpFile + +open System +open System.Diagnostics +open System.IO +open System.Text.Json +open System.Text.Json.Serialization +open OpenTelemetry + +/// OTLP JSON format types following the OTLP specification +/// See: https://opentelemetry.io/docs/specs/otlp/#json-protobuf-encoding +[] +module OtlpJson = + + /// Convert nanoseconds since Unix epoch to string (OTLP JSON format) + let toUnixNano (dt: DateTime) : string = + let unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + let ticks = (dt.ToUniversalTime() - unixEpoch).Ticks + let nanos = ticks * 100L // 1 tick = 100 nanoseconds + string nanos + + /// Convert ActivityTraceId to lowercase hex string (OTLP JSON format) + /// Per OTLP spec: traceId and spanId are hex-encoded, NOT base64 + let traceIdToHex (traceId: ActivityTraceId) : string = traceId.ToHexString().ToLowerInvariant() + + /// Convert ActivitySpanId to lowercase hex string (OTLP JSON format) + let spanIdToHex (spanId: ActivitySpanId) : string = spanId.ToHexString().ToLowerInvariant() + + type KeyValue = + { [] + Key: string + [] + Value: AnyValue } + + and AnyValue = + { [] + [] + StringValue: string + [] + [] + IntValue: string + [] + [] + BoolValue: bool + [] + [] + DoubleValue: float } + + let toAnyValue (value: obj) : AnyValue = + match value with + | :? string as s -> + { StringValue = s + IntValue = null + BoolValue = false + DoubleValue = 0.0 } + | :? int as i -> + { StringValue = null + IntValue = string i + BoolValue = false + DoubleValue = 0.0 } + | :? int64 as i -> + { StringValue = null + IntValue = string i + BoolValue = false + DoubleValue = 0.0 } + | :? bool as b -> + { StringValue = null + IntValue = null + BoolValue = b + DoubleValue = 0.0 } + | :? float as f -> + { StringValue = null + IntValue = null + BoolValue = false + DoubleValue = f } + | _ -> + { StringValue = (if isNull value then "" else value.ToString()) + IntValue = null + BoolValue = false + DoubleValue = 0.0 } + + type SpanEvent = + { [] + TimeUnixNano: string + [] + Name: string + [] + Attributes: KeyValue[] } + + type SpanStatus = + { [] + Code: int + [] + [] + Message: string } + + type OtlpSpan = + { [] + TraceId: string + [] + SpanId: string + [] + [] + ParentSpanId: string + [] + Name: string + [] + Kind: int + [] + StartTimeUnixNano: string + [] + EndTimeUnixNano: string + [] + Attributes: KeyValue[] + [] + Events: SpanEvent[] + [] + Status: SpanStatus } + + type InstrumentationScope = + { [] + Name: string + [] + [] + Version: string } + + type ScopeSpans = + { [] + Scope: InstrumentationScope + [] + Spans: OtlpSpan[] } + + type ResourceAttributes = + { [] + Attributes: KeyValue[] } + + type ResourceSpans = + { [] + Resource: ResourceAttributes + [] + ScopeSpans: ScopeSpans[] } + + type TracesData = + { [] + ResourceSpans: ResourceSpans[] } + + /// Convert an Activity to an OTLP JSON span + let fromActivity (activity: Activity) : OtlpSpan = + let attributes = + activity.Tags + |> Seq.map (fun kvp -> + { Key = kvp.Key + Value = toAnyValue kvp.Value }) + |> Seq.toArray + + let events = + activity.Events + |> Seq.map (fun evt -> + { TimeUnixNano = toUnixNano evt.Timestamp.UtcDateTime + Name = evt.Name + Attributes = + evt.Tags + |> Seq.map (fun kvp -> + { Key = kvp.Key + Value = toAnyValue kvp.Value }) + |> Seq.toArray }) + |> Seq.toArray + + let statusCode = + match activity.Status with + | ActivityStatusCode.Error -> 2 + | ActivityStatusCode.Ok -> 1 + | _ -> 0 + + let parentSpanId = + if activity.ParentSpanId.ToHexString() = "0000000000000000" then + null + else + spanIdToHex activity.ParentSpanId + + { TraceId = traceIdToHex activity.TraceId + SpanId = spanIdToHex activity.SpanId + ParentSpanId = parentSpanId + Name = activity.DisplayName + Kind = int activity.Kind + StartTimeUnixNano = toUnixNano activity.StartTimeUtc + EndTimeUnixNano = toUnixNano (activity.StartTimeUtc + activity.Duration) + Attributes = attributes + Events = events + Status = + { Code = statusCode + Message = activity.StatusDescription } } + + /// Convert a collection of spans to OTLP TracesData format + let toTracesData (serviceName: string) (serviceVersion: string) (spans: OtlpSpan seq) : TracesData = + { ResourceSpans = + [| { Resource = + { Attributes = + [| { Key = "service.name" + Value = toAnyValue serviceName } + { Key = "service.version" + Value = toAnyValue serviceVersion } |] } + ScopeSpans = + [| { Scope = + { Name = serviceName + Version = serviceVersion } + Spans = spans |> Seq.toArray } |] } |] } + + +/// Configuration options for the OTLP File Exporter +type OtlpFileExporterOptions() = + /// Directory to write trace files to + member val OutputDirectory: string = "traces" with get, set + + /// Service name to include in resource attributes + member val ServiceName: string = "unknown" with get, set + + /// Service version to include in resource attributes + member val ServiceVersion: string = "0.0.0" with get, set + + /// Optional filter predicate - only export activities that match this filter + /// If None, all activities are exported + member val Filter: (Activity -> bool) option = None with get, set + + /// File name prefix for trace files + member val FilePrefix: string = "traces" with get, set + + /// Whether to pretty-print the JSON output + member val PrettyPrint: bool = true with get, set + + +/// An OpenTelemetry processor that collects spans and writes them to files in OTLP JSON format. +/// This is compatible with Jaeger, Aspire Dashboard, and other OTLP-compatible backends. +type OtlpFileExportProcessor(options: OtlpFileExporterOptions) = + inherit BaseProcessor() + + let collectedSpans = Collections.Concurrent.ConcurrentBag() + let mutable exportedFileCount = 0 + + let shouldExport (activity: Activity) = + match options.Filter with + | Some filter -> filter activity + | None -> true + + let writeToFile () = + if not (collectedSpans.IsEmpty) then + if not (Directory.Exists(options.OutputDirectory)) then + Directory.CreateDirectory(options.OutputDirectory) |> ignore + + let timestamp = DateTime.UtcNow.ToString("yyyyMMdd_HHmmss_fff") + + let filename = + Path.Combine(options.OutputDirectory, $"{options.FilePrefix}_{timestamp}.otlp.json") + + let jsonOptions = JsonSerializerOptions(WriteIndented = options.PrettyPrint) + + let spans = collectedSpans.ToArray() + + let tracesData = + OtlpJson.toTracesData options.ServiceName options.ServiceVersion spans + + let json = JsonSerializer.Serialize(tracesData, jsonOptions) + File.WriteAllText(filename, json) + exportedFileCount <- exportedFileCount + 1 + + // Clear the bag after writing + while not (collectedSpans.IsEmpty) do + collectedSpans.TryTake() |> ignore + + Some(filename, spans.Length) + else + None + + /// Called when a span ends - collect spans that match the filter + override _.OnEnd(activity: Activity) = + if shouldExport activity then + collectedSpans.Add(OtlpJson.fromActivity activity) + + base.OnEnd(activity) + + /// Get the number of spans currently collected (not yet written) + member _.CollectedSpanCount = collectedSpans.Count + + /// Get the number of files exported so far + member _.ExportedFileCount = exportedFileCount + + /// Manually trigger writing collected spans to a file + /// Returns the filename and span count if successful, None if no spans to write + member _.WriteToFile() = writeToFile () + + interface IDisposable with + member this.Dispose() = + this.WriteToFile() |> ignore + base.Dispose() + + +/// A specialized processor that only exports failed test spans to OTLP JSON files +type FailedTestOtlpFileExportProcessor(options: OtlpFileExporterOptions) = + inherit + OtlpFileExportProcessor( + OtlpFileExporterOptions( + OutputDirectory = options.OutputDirectory, + ServiceName = options.ServiceName, + ServiceVersion = options.ServiceVersion, + FilePrefix = + (if String.IsNullOrEmpty(options.FilePrefix) || options.FilePrefix = "traces" then + "failed_tests" + else + options.FilePrefix), + PrettyPrint = options.PrettyPrint, + Filter = + Some(fun activity -> + let status = activity.GetTagItem("test.result.status") + + match status with + | :? string as s -> s = "Failed" || s = "Error" + | _ -> activity.Status = ActivityStatusCode.Error) + ) + ) + + +/// Extension methods for TracerProviderBuilder to add the OTLP File Export Processor +[] +module TracerProviderBuilderExtensions = + open OpenTelemetry.Trace + + type TracerProviderBuilder with + + /// Adds the OTLP File Export Processor with default options + member this.AddOtlpFileExporter() = + let options = OtlpFileExporterOptions() + let processor = new OtlpFileExportProcessor(options) + this.AddProcessor(processor), processor + + /// Adds the OTLP File Export Processor with custom options + member this.AddOtlpFileExporter(configure: OtlpFileExporterOptions -> unit) = + let options = OtlpFileExporterOptions() + configure options + let processor = new OtlpFileExportProcessor(options) + this.AddProcessor(processor), processor + + /// Adds the Failed Test OTLP File Export Processor (only exports failed tests) + member this.AddFailedTestOtlpFileExporter(configure: OtlpFileExporterOptions -> unit) = + let options = OtlpFileExporterOptions() + configure options + let processor = new FailedTestOtlpFileExportProcessor(options) + this.AddProcessor(processor), processor diff --git a/test/FsAutoComplete.Tests.Lsp/Program.fs b/test/FsAutoComplete.Tests.Lsp/Program.fs index d193916b9..543938313 100644 --- a/test/FsAutoComplete.Tests.Lsp/Program.fs +++ b/test/FsAutoComplete.Tests.Lsp/Program.fs @@ -24,6 +24,7 @@ open System.Diagnostics open OpenTelemetry.Resources open OpenTelemetry open OpenTelemetry.Exporter +open OpenTelemetry.Exporter.OtlpFile open OpenTelemetry.Trace Expect.defaultDiffPrinter <- Diff.colourisedDiff @@ -31,6 +32,18 @@ Expect.defaultDiffPrinter <- Diff.colourisedDiff let resourceBuilder version = ResourceBuilder.CreateDefault().AddService(serviceName = serviceName, serviceVersion = version) +/// Check if we're running in GitHub Actions CI +let isCI = Environment.GetEnvironmentVariable("CI") = "true" + +/// Directory to write failed test traces to +let failedTracesDirectory = + let dir = + Environment.GetEnvironmentVariable("FAILED_TRACES_DIR") + |> Option.ofObj + |> Option.defaultValue "failed_traces" + + Path.GetFullPath(dir) + type SpanFilter(filter: Activity -> bool) = inherit BaseProcessor() @@ -43,7 +56,9 @@ type SpanFilter(filter: Activity -> bool) = type TracerProviderBuilder with member x.AddSpanFilter(filter: Activity -> bool) = x.AddProcessor(new SpanFilter(filter)) -let traceProvider () = +/// Create trace provider for local development (sends to localhost:4317) +/// This is NOT used in CI mode - see main function for CI trace configuration +let traceProviderForLocalDev () = let version = FsAutoComplete.Utils.Version.info().Version Sdk @@ -60,11 +75,12 @@ let traceProvider () = // ) .Build() +// Only initialize local dev trace provider if NOT in CI mode +// CI mode sets up its own trace provider in main() with failed test file export do - let provider = traceProvider () - AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> provider.ForceFlush(3000) |> ignore - // provider.Dispose() - ) + if not isCI then + let provider = traceProviderForLocalDev () + AppDomain.CurrentDomain.ProcessExit.Add(fun _ -> provider.ForceFlush(3000) |> ignore) let testTimeout = @@ -212,18 +228,38 @@ open FsAutoComplete.Telemetry [] let main args = let serviceName = "FsAutoComplete.Tests.Lsp" + let version = FsAutoComplete.Utils.Version.info().Version - use traceProvider = - let version = FsAutoComplete.Utils.Version.info().Version + // Create either a CI-specific failure-only exporter or the normal OTLP exporter + let traceProvider, failedTestExporter = + if isCI then + printfn $"Running in CI mode - failed test traces will be written to: {failedTracesDirectory}" + + let builder, exporter = + Sdk + .CreateTracerProviderBuilder() + .AddSource(FsAutoComplete.Utils.Tracing.serviceName, Tracing.fscServiceName, serviceName) + .SetResourceBuilder( + ResourceBuilder.CreateDefault().AddService(serviceName = serviceName, serviceVersion = version) + ) + .AddFailedTestOtlpFileExporter(fun opts -> + opts.OutputDirectory <- failedTracesDirectory + opts.ServiceName <- serviceName + opts.ServiceVersion <- version) + + builder.Build(), Some exporter + else + let provider = + Sdk + .CreateTracerProviderBuilder() + .AddSource(FsAutoComplete.Utils.Tracing.serviceName, Tracing.fscServiceName, serviceName) + .SetResourceBuilder( + ResourceBuilder.CreateDefault().AddService(serviceName = serviceName, serviceVersion = version) + ) + .AddOtlpExporter() + .Build() - Sdk - .CreateTracerProviderBuilder() - .AddSource(FsAutoComplete.Utils.Tracing.serviceName, Tracing.fscServiceName, serviceName) - .SetResourceBuilder( - ResourceBuilder.CreateDefault().AddService(serviceName = serviceName, serviceVersion = version) - ) - .AddOtlpExporter() - .Build() + provider, None let outputTemplate = @@ -335,4 +371,23 @@ let main args = // let trace = traceProvider.GetTracer("FsAutoComplete.Tests.Lsp") // use span = trace.StartActiveSpan("runTests", SpanKind.Internal) use span = source.StartActivity("runTests") - runTestsWithCLIArgsAndCancel cts.Token cliArgs fixedUpArgs tests + let result = runTestsWithCLIArgsAndCancel cts.Token cliArgs fixedUpArgs tests + + // Write out failed test traces if in CI mode + match failedTestExporter with + | Some exporter -> + let traceResult = exporter.WriteToFile() + + match traceResult with + | Some(file, count) -> + // Write the path to a known location for GitHub Actions to pick up + let summaryFile = Path.Combine(failedTracesDirectory, "summary.txt") + File.WriteAllText(summaryFile, $"Failed test traces: {file}\nFailed test count: {count}") + printfn $"::error::Found {count} failed test(s). Traces written to {file}" + | None -> printfn "No failed tests - no traces written" + | None -> () + + // Dispose the trace provider + traceProvider.Dispose() + + result