OpenTelemetry instrumentation concept

Author: shikokuchuo

DESCRIPTION

@@ -42,6 +42,8 @@ Suggests:
     digest (>= 0.6.33),
     gh,
     knitr,
+    otel,
+    otelsdk,
     rmarkdown,
     rstudioapi,
     S7,

R/otel.R

@@ -0,0 +1,53 @@
+otel_tracer_name <- "org.r-lib.testthat"
+otel_is_tracing <- FALSE
+otel_tracer <- NULL
+
+# generic otel helpers ---------------------------------------------------------
+
+# nocov start
+
+otel_cache_tracer <- function() {
+  requireNamespace("otel", quietly = TRUE) || return()
+  otel_tracer <<- otel::get_tracer(otel_tracer_name)
+  otel_is_tracing <<- tracer_enabled(otel_tracer)
+}
+
+# nocov end
+
+tracer_enabled <- function(tracer) {
+  .subset2(tracer, "is_enabled")()
+}
+
+otel_refresh_tracer <- function() {
+  requireNamespace("otel", quietly = TRUE) || return()
+  tracer <- otel::get_tracer()
+  modify_binding(
+    topenv(),
+    list(otel_tracer = tracer, otel_is_tracing = tracer_enabled(tracer))
+  )
+}
+
+modify_binding <- function(env, lst) {
+  lapply(names(lst), unlockBinding, env)
+  list2env(lst, envir = env)
+  lapply(names(lst), lockBinding, env)
+}
+
+otel_local_active_span <- function(
+  name,
+  label,
+  attributes = list(),
+  links = NULL,
+  options = NULL,
+  scope = parent.frame()
+) {
+  otel_is_tracing || return()
+  spn <- otel::start_local_active_span(
+    sprintf("%s %s", name, label),
+    attributes = otel::as_attributes(attributes),
+    links = links,
+    options = options,
+    tracer = otel_tracer,
+    activation_scope = scope
+  )
+}

R/test-that.R

@@ -35,6 +35,7 @@
 #' }
 test_that <- function(desc, code) {
   local_description_push(desc)
+  otel_local_active_span("test that", desc)
 
   code <- substitute(code)
   test_code(code, parent.frame())

R/testthat-package.R

@@ -30,3 +30,11 @@ the$in_check_reporter <- FALSE
 #' @importFrom lifecycle deprecated
 ## usethis namespace: end
 NULL
+
+# nocov start
+
+.onLoad <- function(libname, pkgname) {
+  otel_cache_tracer()
+}
+
+# nocov end

tests/testthat/test-otel.R

@@ -0,0 +1,18 @@
+test_that("otel instrumentation works", {
+  skip_if_not_installed("otelsdk")
+
+  record <- otelsdk::with_otel_record({
+    otel_refresh_tracer()
+    test_that("otel testing", {
+      expect_equal(1, 1)
+      expect_error(stop("otel error"))
+    })
+  })
+  # reset tracer after tests
+  otel_refresh_tracer()
+
+  traces <- record$traces
+  expect_length(traces, 1L)
+  expect_equal(traces[[1L]]$name, "test that otel testing")
+  expect_equal(traces[[1L]]$instrumentation_scope$name , "org.r-lib.testthat")
+})