PoC metrics implementation

DESCRIPTION

@@ -24,5 +24,5 @@ Suggests:
     utils,
     withr
 Remotes:
-    r-lib/otelsdk
+    r-lib/otelsdk@feature/metrics
 Config/testthat/edition: 3

NAMESPACE

@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
 export(get_default_logger_provider)
+export(get_default_meter_provider)
 export(get_default_tracer_provider)
+export(get_logger)
+export(get_meter)
 export(get_tracer)
 export(start_shiny_app)
 export(start_shiny_session)

R/api-dev.R

@@ -10,6 +10,28 @@ get_tracer_dev <- function(name = NULL) {
     invisible(trc)
 }
 
+get_logger_dev <- function(name = NULL) {
+    name <- name %||%
+      utils::packageName() %||%
+      get_env("OTEL_SERVICE_NAME") %||%
+      basename(getwd())
+    # does setup if necessary
+    tp <- get_default_logger_provider()
+    trc <- tp$get_logger(name)
+    invisible(trc)
+}
+
+get_meter_dev <- function(name = NULL) {
+    name <- name %||%
+      utils::packageName() %||%
+      get_env("OTEL_SERVICE_NAME") %||%
+      basename(getwd())
+    # does setup if necessary
+    tp <- get_default_meter_provider()
+    trc <- tp$get_meter(name)
+    invisible(trc)
+}
+
 start_span_dev <- function(name = NULL, session = NULL, ...,
                        scope = parent.frame()) {
     trc <- get_tracer()
@@ -36,6 +58,13 @@ get_default_logger_provider_dev <- function() {
     the$logger_provider
 }
 
+get_default_meter_provider_dev <- function() {
+    if (is.null(the$meter_provider)) {
+      setup_default_meter_provider()
+    }
+    the$meter_provider
+}
+
 start_shiny_app_dev <- function(service_name = NULL, ...) {
     service_name <- service_name %||%
       get_env("OTEL_SERVICE_NAME") %||%

R/api.R

@@ -33,6 +33,63 @@ get_tracer <- function(name = NULL) {
 
 get_tracer_safe <- get_tracer
 
+#' Get a logger from the default logger provider
+#'
+#' @param name Name of the new logger. This is typically the name of the
+#'   package or project. Defaults to the name of the calling package,
+#'   or the name of the current working directory if not called from a
+#'   package.
+#'
+#' @export
+
+# safe start
+get_logger <- function(name = NULL) {
+  tryCatch({                                                         # safe
+    name <- name %||%
+      utils::packageName() %||%
+      get_env("OTEL_SERVICE_NAME") %||%
+      basename(getwd())
+    # does setup if necessary
+    tp <- get_default_logger_provider()
+    trc <- tp$get_logger(name)
+    invisible(trc)
+  }, error = function(err) {                                         # safe
+    errmsg("OpenTelemetry error: ", conditionMessage(err))           # safe
+    logger_noop$new()                                                # safe
+  })                                                                 # safe
+}
+# safe end
+
+get_logger_safe <- get_logger
+
+#' Get a meter from the default meter provider
+#'
+#' @param name Name of the new meter. This is typically the name of the
+#'   package or project. Defaults to the name of the calling package,
+#'   or the name of the current working directory if not called from a
+#'   package.
+#' @export
+
+# safe start
+get_meter <- function(name = NULL) {
+  tryCatch({                                                         # safe
+    name <- name %||%
+      utils::packageName() %||%
+      get_env("OTEL_SERVICE_NAME") %||%
+      basename(getwd())
+    # does setup if necessary
+    tp <- get_default_meter_provider()
+    trc <- tp$get_meter(name)
+    invisible(trc)
+  }, error = function(err) {                                         # safe
+    errmsg("OpenTelemetry error: ", conditionMessage(err))           # safe
+    meter_noop$new()                                                # safe
+  })                                                                 # safe
+}
+# safe end
+
+get_meter_safe <- get_meter
+
 #' Start a new OpenTelemetry span, using the default tracer
 #'
 #' @param name Name of the span.

R/defaults.R

@@ -6,6 +6,10 @@ default_logs_exporter_envvar <- "OTEL_LOGS_EXPORTER"
 default_logs_exporter_envvar_r <-
   paste0("R_", default_logs_exporter_envvar)
 
+default_metrics_exporter_envvar <- "OTEL_METRICS_EXPORTER"
+default_metrics_exporter_envvar_r <-
+  paste0("R_", default_logs_exporter_envvar)
+
 #' Get the default tracer provider
 #'
 #' If there is no default set currently, then it creates and sets a
@@ -214,3 +218,93 @@ setup_default_logger_provider <- function() {
   the$logger_provider <- tp
   invisible(tp)
 }
+
+#' Get the default metrics provider
+#' TODO
+#'
+#' @export
+
+# safe start
+get_default_meter_provider <- function() {
+  tryCatch({                                                         # safe
+    if (is.null(the$meter_provider)) {
+      setup_default_meter_provider()
+    }
+    the$meter_provider
+  }, error = function(err) {                                         # safe
+    errmsg("OpenTelemetry error: ", conditionMessage(err))           # safe
+    meter_provider_noop$new()                                       # safe
+  })                                                                 # safe
+}
+# safe end
+
+setup_default_meter_provider <- function() {
+  evar <- default_metrics_exporter_envvar_r
+  ev <- Sys.getenv(evar, NA_character_)
+  if (is.na(ev)) {
+    evar <- default_metrics_exporter_envvar
+    ev <- Sys.getenv(evar, NA_character_)
+  }
+  tp <-  if (is.na(ev)) {
+    meter_provider_noop$new()
+  } else if (grepl("::", ev)) {
+    evx <- strsplit(ev, "::", fixed = TRUE)[[1]]
+    pkg <- evx[1]
+    prv <- evx[2]
+    if (!requireNamespace(pkg, quietly = TRUE)) {
+      stop(
+        "Cannot set metrics exporter ", ev, " from ", evar,
+        " environment variable, cannot load package ", pkg, "."
+      )
+    }
+    if (!prv %in% names(asNamespace(pkg))) {
+      stop(
+        "Cannot set metrics exporter ", ev, " from ", evar,
+        " environment variable, cannot find provider ", prv,
+        " in package ", pkg, "."
+      )
+    }
+    tp <- asNamespace(pkg)[[prv]]
+    if ((!is.list(tp) && !is.environment(tp)) || !"new" %in% names(tp)) {
+      stop(
+        "Cannot set metrics exporter ", ev, " from ", evar,
+        " environment variable, it is not a list or environment with ",
+        "a 'new' member."
+      )
+    }
+    tp$new()
+
+  } else {
+    switch(
+      ev,
+      "none" = {
+        meter_provider_noop$new()
+      },
+      "console" = ,
+      "stdout" = {
+        otelsdk::meter_provider_stdstream$new("stdout")
+      },
+      "stderr" = {
+        otelsdk::meter_provider_stdstream$new("stderr")
+      },
+      "otlp" = ,
+      "http" = {
+        otelsdk::meter_provider_http$new()
+      },
+      "prometheus" = {
+        warning("OpenTelemetry: Prometheus trace exporter is not supported yet")
+        meter_provider_noop$new()
+      },
+      stop(
+        "Unknown OpenTelemetry exporter from ", evar,
+        " environment variable: ", ev
+      )
+    )
+  }
+
+  if (Sys.getenv("OTEL_SERVICE_NAME") == "") {
+    Sys.setenv("OTEL_SERVICE_NAME" = "R")
+  }
+  the$meter_provider <- tp
+  invisible(tp)
+}

R/meter-provider-noop.R

@@ -0,0 +1,89 @@
+meter_provider_noop <- list(
+  new = function() {
+    self <- structure(
+      list(
+        get_meter = function(name = NULL, ...) {
+          meter_noop$new(name, ...)
+        },
+        flush = function(timeout = NULL, ...) {
+          # noop
+          invisible(self)
+        },
+        shutdown = function(timeout = NULL, ...) {
+          # noop
+          invisible(self)
+        }
+      ),
+      class = c(
+        "otel_meter_provider_noop",
+        "otel_meter_provider"
+      )
+    )
+    self
+  }
+)
+
+meter_noop <- list(
+  new = function(name = NULL, ...) {
+   self <- structure(
+      list(
+        create_counter = function(
+            name, description = NULL, unit = NULL) {
+          counter_noop$new(name, description, unit)
+        },
+        create_up_down_counter = function(
+            name, description = NULL, unit = NULL) {
+          up_down_counter_noop$new(name, description, unit)
+        },
+        create_histogram = function(
+            name, description = NULL, unit = NULL) {
+          histogram_noop$new(name, description, unit)
+        }
+      ),
+      class = c("otel_meter_noop", "otel_meter")
+    )
+    self
+  }
+)
+
+counter_noop <- list(
+  new = function(name = NULL, ...) {
+    self <- structure(
+      list(
+        add = function(value, attributes = NULL, context = NULL) {
+          invisible(self)
+        }
+      ),
+      class = c("otel_counter_noop", "otel_counter")
+    )
+    self
+  }
+)
+
+up_down_counter <- list(
+  new = function(name = NULL, ...) {
+    self <- structure(
+      list(
+        add = function(value, attributes = NULL, context = NULL) {
+          invisible(self)
+        }
+      ),
+      class = c("otel_up_down_counter_noop", "otel_up_down_counter")
+    )
+    self
+  }
+)
+
+histogram <- list(
+  new = function(name = NULL, ...) {
+    self <- structure(
+      list(
+        record = function(value, attributes = NULL, context = NULL) {
+          invisible(self)
+        }
+      ),
+      class = c("otel_histogram_noop", "otel_histogram")
+    )
+    self
+  }
+)

R/onload.R

@@ -24,6 +24,18 @@ setup_dev_env <- function() {
       envir = envir
     )
     assign("get_tracer", get_tracer_dev, envir = envir)
+    assign(
+      "get_default_logger_provider",
+      get_default_logger_provider_dev,
+      envir = envir
+    )
+    assign("get_logger", get_logger_dev, envir = envir)
+    assign(
+      "get_default_meter_provider",
+      get_default_meter_provider_dev,
+      envir = envir
+    )
+    assign("get_meter", get_meter_dev, envir = envir)
     assign(
       "start_shiny_app",
       start_shiny_app_dev,