Let extensions upgrade their own data via versioned @extensions (#403)

mizer could upgrade core slots across mizer versions, but extensions had
no hook to migrate their own data and no record of which extension version
last conformed an object. This adds per-extension version tracking and an
upgrade dispatch path so extensions can upgrade their objects independently
of the mizer version.

- The `@extensions` slot (now typed "ANY") may hold either the legacy named
  character vector of requirement strings or a named list of
  `c(requirement, version)` entries. `objectExtensions()` returns the
  requirement-only view, so all dispatch/suffix logic is unchanged. New
  helpers: `recordExtension()` (exported), `extensionRequirements()`,
  `extensionVersions()`, `extensionVersion()`, `makeExtensions()`.
- `upgradeParams()`/`upgradeSim()` are now the `upgrade.MizerParams()` /
  `upgrade.MizerSim()` methods of `utils::upgrade()`; the old names remain as
  thin internal wrappers.
- `validParams()` orchestrates upgrades: it runs the core upgrade when
  `@mizer_version` is stale, then `runExtensionUpgrades()` calls each
  out-of-date extension's `upgrade` method directly (no `NextMethod()`) and
  re-stamps it. `needs_upgrading()` now also fires on a missing or stale
  extension stamp.
- `registerExtensions()` / `readParams()` / `requiredExtensionPackages()`
  accept the versioned list form via the requirement view.
- Documented the pattern in the creating-extension-packages vignette and
  added tests in test-extension-versions.R.

Co-authored-by: Claude Opus 4.8 <noreply@anthropic.com>

Author: gustavdelius

NAMESPACE

@@ -238,6 +238,8 @@ S3method(summary,ArrayTimeBySpecies)
 S3method(summary,ArrayTimeBySpeciesBySize)
 S3method(summary,MizerParams)
 S3method(summary,MizerSim)
+S3method(utils::upgrade,MizerParams)
+S3method(utils::upgrade,MizerSim)
 S3method(validParams,MizerParams)
 S3method(validSim,MizerSim)
 export("catchability<-")
@@ -500,6 +502,7 @@ export(project_simple)
 export(psi)
 export(readParams)
 export(readSim)
+export(recordExtension)
 export(registerExtension)
 export(registerExtensions)
 export(removeBackgroundSpecies)

NEWS.md

@@ -1,5 +1,17 @@
 # mizer (development version)
 
+- Extension packages can now upgrade their own data in saved model objects
+  independently of the mizer version. The `@extensions` slot can record, for
+  each extension, the version of the extension package that the object conforms
+  to (write entries with the new `recordExtension()`). `needs_upgrading()` flags
+  an object when an extension's recorded version is missing or older than the
+  installed package version, and `validParams()` then calls the extension's own
+  `upgrade()` method (an S3 method on `utils::upgrade()`, registered with
+  `@exportS3Method utils::upgrade`). The core mizer upgrade is now itself the
+  `upgrade.MizerParams()` / `upgrade.MizerSim()` method. See the "Upgrading
+  objects across versions of your extension" section of
+  `vignette("creating-extension-packages")`.
+  
 - `getTrophicLevel()` and `getTrophicLevelBySpecies()` now assign the resource a
   size-dependent trophic level
   `T_R(w) = max(1, 1 + log(w / w_R) / log(beta_R))` instead of treating it as

R/MizerParams-class.R

@@ -288,11 +288,16 @@ validMizerParams <- function(object) {
 #' @slot metadata A list with metadata information. See [setMetadata()].
 #' @slot mizer_version The package version of mizer (as returned by
 #'   `packageVersion("mizer")`) that created or upgraded the model.
-#' @slot extensions A named vector of strings describing the extension chain
-#'   needed to run the model. The names are extension identifiers and S4 marker
-#'   class names. The order is the S3 dispatch order, from outermost to
-#'   innermost extension. The values are version strings, installation
-#'   specifications, or `NA_character_`. Extension subclasses are marker
+#' @slot extensions Describes the extension chain needed to run the model. The
+#'   entries are named by extension identifier (also the S4 marker class name)
+#'   and ordered in S3 dispatch order, from outermost to innermost extension.
+#'   It is either a named character vector whose values are requirement strings
+#'   (version strings, installation specifications, or `NA_character_`), or a
+#'   named list whose entries are length-2 character vectors
+#'   `c(requirement = ..., version = ...)`. The `version` records the version of
+#'   the extension package that last upgraded the object (`NA` if unknown) and
+#'   is used by [needs_upgrading()]. Use [recordExtension()] to write entries
+#'   rather than modifying the slot directly. Extension subclasses are marker
 #'   classes only and must not add slots.
 #' @slot time_created A POSIXct date-time object with the creation time.
 #' @slot time_modified A POSIXct date-time object with the last modified time.
@@ -426,7 +431,7 @@ setClass(
     slots = c(
         metadata = "list",
         mizer_version = "ANY",
-        extensions = "character",
+        extensions = "ANY",
         time_created = "POSIXct",
         time_modified = "POSIXct",
         w = "numeric",
@@ -918,12 +923,15 @@ validParams <- function(params, info_level = 3) {
 #' @export
 validParams.MizerParams <- function(params, info_level = 3) {
 
-    if (needs_upgrading(params)) {
-        params <- suppressWarnings(upgradeParams(params))
+    if (mizer_needs_upgrading(params)) {
+        params <- suppressWarnings(upgrade.MizerParams(params))
         if (info_level > 0) {
             warning("Your MizerParams object was created with an earlier version of mizer. You can upgrade it with `params <- validParams(params)` where you should replace `params` by the name of the variable that holds your MizerParams object.")
         }
     }
+    if (extension_needs_upgrading(params)) {
+        params <- suppressWarnings(runExtensionUpgrades(params))
+    }
 
     params@given_species_params <-
         validGivenSpeciesParams(params@given_species_params)

R/registerExtensions.R

@@ -175,14 +175,170 @@ coerceToExtensionClass <- function(object, extensions = objectExtensions(object)
 #' @keywords internal
 objectExtensions <- function(object) {
     if (is(object, "MizerParams")) {
-        return(object@extensions)
+        return(extensionRequirements(object@extensions))
     }
     if (is(object, "MizerSim")) {
-        return(object@params@extensions)
+        return(extensionRequirements(object@params@extensions))
     }
     stop("Can only get extensions for MizerParams or MizerSim objects.")
 }
 
+#' Extract the requirement view of an extension chain
+#'
+#' The `@extensions` slot may be stored either as a named character vector of
+#' requirement strings (the legacy/unversioned form) or as a named list whose
+#' entries are length-2 character vectors `c(requirement = ..., version = ...)`.
+#' This helper returns the requirement strings as a plain named character
+#' vector, which is the form used for dispatch and suffix comparison.
+#'
+#' @param ext The contents of an `@extensions` slot (character vector or list).
+#' @return A named character vector of requirement strings.
+#' @keywords internal
+extensionRequirements <- function(ext) {
+    if (is.null(ext) || length(ext) == 0) {
+        return(character())
+    }
+    if (is.list(ext)) {
+        req <- vapply(ext, function(e) {
+            if (!is.null(names(e)) && "requirement" %in% names(e)) {
+                as.character(e[["requirement"]])
+            } else {
+                as.character(e[[1]])
+            }
+        }, character(1))
+        names(req) <- names(ext)
+        return(req)
+    }
+    ext
+}
+
+#' Extract the version stamps of an extension chain
+#'
+#' Returns the version of the extension package that last upgraded the object
+#' for each extension, or `NA_character_` where no stamp is recorded (including
+#' the legacy character-vector form, which carries no versions).
+#'
+#' @param ext The contents of an `@extensions` slot (character vector or list).
+#' @return A named character vector of version strings (`NA` where unknown).
+#' @keywords internal
+extensionVersions <- function(ext) {
+    if (is.null(ext) || length(ext) == 0) {
+        return(character())
+    }
+    if (is.list(ext)) {
+        ver <- vapply(ext, function(e) {
+            if (!is.null(names(e)) && "version" %in% names(e)) {
+                as.character(e[["version"]])
+            } else {
+                NA_character_
+            }
+        }, character(1))
+        names(ver) <- names(ext)
+        return(ver)
+    }
+    setNames(rep(NA_character_, length(ext)), names(ext))
+}
+
+#' Build a versioned extension list from requirements and versions
+#'
+#' @param requirements A named character vector of requirement strings.
+#' @param versions A named character vector of version stamps. Names not present
+#'   default to `NA_character_`.
+#' @return A named list whose entries are
+#'   `c(requirement = ..., version = ...)`, or an empty character vector when
+#'   `requirements` is empty.
+#' @keywords internal
+makeExtensions <- function(requirements, versions = character()) {
+    if (length(requirements) == 0) {
+        return(character())
+    }
+    out <- lapply(names(requirements), function(name) {
+        version <- if (name %in% names(versions)) {
+            as.character(versions[[name]])
+        } else {
+            NA_character_
+        }
+        c(requirement = unname(as.character(requirements[[name]])),
+          version = version)
+    })
+    names(out) <- names(requirements)
+    out
+}
+
+#' Record an extension and its version stamp on a mizer object
+#'
+#' Writes an entry for `name` into the object's `@extensions` slot, converting
+#' the slot to the versioned list form. Existing entries (and their version
+#' stamps) are preserved. The requirement is taken from the existing entry if
+#' present, otherwise from the registered extension chain.
+#'
+#' Extension packages should call this instead of assigning to `@extensions`
+#' directly. Pass `version` (typically `packageVersion(name)`) only when the
+#' object has just been created or upgraded to conform to that version; leave it
+#' `NULL` for ordinary modifications so the existing stamp is preserved.
+#'
+#' @param params A `MizerParams` object.
+#' @param name The extension identifier (its S4 marker class name).
+#' @param version Optional version string to stamp. If `NULL` (default) the
+#'   existing stamp is preserved.
+#' @return The `params` object with the updated `@extensions` slot.
+#' @seealso "Creating a mizer extension package":
+#'   \code{vignette("creating-extension-packages", package = "mizer")}
+#' @export
+#' @family extension tools
+recordExtension <- function(params, name, version = NULL) {
+    assert_that(is(params, "MizerParams"), is.string(name))
+    ext <- params@extensions
+    reqs <- extensionRequirements(ext)
+    present <- name %in% names(reqs)
+
+    # Requirement: keep the existing one, else take it from the registry.
+    if (present) {
+        req <- unname(reqs[[name]])
+    } else {
+        registered <- getRegisteredExtensions()
+        req <- if (name %in% names(registered)) {
+            unname(registered[[name]])
+        } else {
+            NA_character_
+        }
+    }
+
+    if (is.null(version)) {
+        # Preserve the existing stamp. If the entry already exists, leave the
+        # slot exactly as it is so ordinary modifications do not perturb it.
+        if (present) return(params)
+        # Otherwise add an unversioned entry, keeping the slot's current form.
+        if (is.list(ext)) {
+            ext[[name]] <- c(requirement = req, version = NA_character_)
+        } else {
+            ext[[name]] <- req
+        }
+        params@extensions <- ext
+        return(params)
+    }
+
+    # Stamping a version requires the versioned list form for this entry.
+    if (!is.list(ext)) {
+        ext <- makeExtensions(reqs, extensionVersions(ext))
+        if (!is.list(ext)) ext <- setNames(list(), character())
+    }
+    ext[[name]] <- c(requirement = req, version = as.character(version))
+    params@extensions <- ext
+    params
+}
+
+#' Get the recorded version stamp for one extension on an object
+#'
+#' @param params A `MizerParams` object.
+#' @param name The extension identifier.
+#' @return The recorded version string, or `NA_character_` if none.
+#' @keywords internal
+extensionVersion <- function(params, name) {
+    vers <- extensionVersions(params@extensions)
+    if (name %in% names(vers)) vers[[name]] else NA_character_
+}
+
 #' Assert that an object's extension chain is compatible with the session
 #'
 #' Stops with an informative error if the object's extension chain is not a
@@ -259,6 +415,11 @@ validateExtensionsVector <- function(extensions) {
     if (is.null(extensions)) {
         extensions <- character()
     }
+    # Accept the versioned list form of an `@extensions` slot by reducing it to
+    # the requirement view that the registry and dispatch logic operate on.
+    if (is.list(extensions)) {
+        extensions <- extensionRequirements(extensions)
+    }
     if (!is.character(extensions)) {
         stop("`extensions` must be a named character vector.")
     }

R/saveParams.R

@@ -53,7 +53,8 @@ readParams <- function(file, install_extensions = FALSE) {
     }
 
     if (length(params@extensions) > 0) {
-        registerExtensions(params@extensions, install = install_extensions)
+        registerExtensions(extensionRequirements(params@extensions),
+                           install = install_extensions)
     }
 
     params <- coerceToExtensionClass(params)
@@ -117,7 +118,8 @@ readSim <- function(file, install_extensions = FALSE) {
     }
 
     if (length(sim@params@extensions) > 0) {
-        registerExtensions(sim@params@extensions, install = install_extensions)
+        registerExtensions(extensionRequirements(sim@params@extensions),
+                           install = install_extensions)
     }
 
     sim@params <- coerceToExtensionClass(sim@params)
@@ -178,7 +180,8 @@ checkCustomFunctions <- function(params) {
 }
 
 requiredExtensionPackages <- function(params) {
-    c("mizer", names(params@extensions)[!is.na(params@extensions)])
+    reqs <- extensionRequirements(params@extensions)
+    c("mizer", names(reqs)[!is.na(reqs)])
 }
 
 is_custom <- function(name, packages) {