R/mcp_session.R

In Certara.Xpose.NLME: Enhances 'xpose' Diagnostics for Pharmacometric Models from 'Certara.RsNLME' and Phoenix NLME

# xpdb handle cache for the MCP tool layer.
#
# MCP tool calls are stateless across the wire, but the xpose workflow is
# inherently stateful: every plot/table needs an `xpdb` that an earlier call
# created. We therefore cache created `xpdb` objects in a package-private
# environment behind short string handles ("xpdb1", "xpdb2", ...) and hand the
# handle back to the client, which passes it to subsequent tools.
#
# The reproducible/audit R-script recorder is NOT here: it is a core MCP
# capability owned by the Certara.R host (see mcp_repro.R there). Tool handlers
# in mcp_tools.R record their code into that shared host script.

# Null-coalescing helper (base R only gained `%||%` in 4.4; this package
# supports R >= 4.0, so define it locally).
`%||%` <- function(a, b) if (is.null(a) || length(a) == 0) b else a

# Optional Certara.R MCP host hooks. Only hook in when Certara.R has already
# loaded itself (i.e. it is the one orchestrating this session) rather than
# merely being installed; this also keeps this package free of any declared
# dependency on Certara.R, since we never take responsibility for loading it.
.xpose_certara_fn <- function(name) {
  if (!isNamespaceLoaded("Certara.R")) return(NULL)
  if (!name %in% getNamespaceExports("Certara.R")) return(NULL)
  get(name, envir = asNamespace("Certara.R"), mode = "function")
}

.xpose_host <- function() !is.null(.xpose_certara_fn("mcp_repro_record"))

.xpose_state <- new.env(parent = emptyenv())

# Reset all session state. Exposed for tests and for a clean server start.
.xpose_state_reset <- function() {
  .xpose_state$sessions <- list()
  .xpose_state$counter <- 0L
  invisible(NULL)
}

# Lazily initialize on first use so the env is always in a known shape.
.xpose_state_ensure <- function() {
  if (is.null(.xpose_state$sessions)) .xpose_state_reset()
  invisible(NULL)
}

.xpose_new_handle <- function() {
  .xpose_state_ensure()
  .xpose_state$counter <- .xpose_state$counter + 1L
  paste0("xpdb", .xpose_state$counter)
}

# Store an xpdb under a fresh handle and return the handle.
.xpose_store <- function(xpdb, meta = list()) {
  handle <- .xpose_new_handle()
  .xpose_state$sessions[[handle]] <- list(xpdb = xpdb, meta = meta)
  handle
}

# Retrieve a stored xpdb by handle, with an actionable error.
.xpose_get <- function(handle) {
  .xpose_state_ensure()
  if (!is.character(handle) || length(handle) != 1L || !nzchar(handle)) {
    stop("`handle` must be a single non-empty string (e.g. \"xpdb1\").",
         call. = FALSE)
  }
  session <- .xpose_state$sessions[[handle]]
  if (is.null(session)) {
    active <- names(.xpose_state$sessions)
    stop(sprintf(
      "Unknown xpdb handle '%s'. %s Create one first with xpose_create_from_dir().",
      handle,
      if (length(active)) {
        paste0("Active handles: ", paste(active, collapse = ", "), ".")
      } else {
        "No xpdb has been created yet."
      }
    ), call. = FALSE)
  }
  session$xpdb
}

# Compact metadata for every active session (for xpose_list_sessions()).
.xpose_sessions_overview <- function() {
  .xpose_state_ensure()
  handles <- names(.xpose_state$sessions)
  if (!length(handles)) {
    return(data.frame(handle = character(0), model_name = character(0),
                      dir = character(0), stringsAsFactors = FALSE))
  }
  data.frame(
    handle = handles,
    model_name = vapply(handles, function(h) {
      .xpose_state$sessions[[h]]$meta$model_name %||% NA_character_
    }, character(1)),
    dir = vapply(handles, function(h) {
      .xpose_state$sessions[[h]]$meta$dir %||% NA_character_
    }, character(1)),
    stringsAsFactors = FALSE
  )
}