Metadata

.github/workflows/R-CMD-check.yaml

@@ -57,4 +57,4 @@ jobs:
       - uses: r-lib/actions/check-r-package@v2
         with:
           upload-snapshots: true
-          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'
+          build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

DESCRIPTION

@@ -32,6 +32,7 @@ Imports:
     methods
 Suggests:
     flextable (>= 0.8.0),
+    jsonlite,
     ggplot2,
     gridGraphics,
     gt (>= 0.11.0),

NEWS.md

@@ -1,5 +1,18 @@
 # gridify 0.8.1.9000
 
+## New features
+
+* `export_to()` gains a `metadata` argument that records effective cell text
+  values, including layout defaults and values supplied via `set_cell()`,
+  alongside the exported output. The default is `metadata = "none"`; pass
+  `"sidecar"` to write a JSON sidecar `<file>.json` next to the output.
+  The sidecar identifies itself as `gridify.sidecar.metadata` and uses a
+  schema-versioned `pages` structure for both single-page and multi-page exports.
+  Re-exporting the same output without metadata, or with no effective cell text,
+  removes any stale sidecar for that output.
+  The default can be changed project-wide by setting
+  `options(gridify.export.metadata = "sidecar")`.
+
 # gridify 0.8.1
 
 ## New features
@@ -20,7 +33,8 @@
 
 ## Bug fixes
 
-* When `fill_empty` in the `paginate_table()` function is a character value, the final paginated table now coerces columns to character before filling empty cells (#20).
+* When `fill_empty` in the `paginate_table()` function is a character value, 
+  the final paginated table now coerces columns to character before filling empty cells (#20).
 
 ## Miscellaneous
 

R/gridify-methods.R

@@ -949,6 +949,25 @@ setMethod("show", "gridifyLayout", function(object) {
 #' The extension determines the output format.
 #' @param device a function for graphics device.
 #' By default a file name extension is used to choose a graphics device function. Default `NULL`
+#' @param metadata Controls writing of metadata derived from effective cell text
+#' values, including layout defaults and values supplied via [set_cell()].
+#' One of:
+#' \itemize{
+#'   \item `"sidecar"` - write a JSON sidecar file next to the output named `<to>.json`
+#'   containing `schema`, `schema_version` and `pages`. The `schema` value is
+#'   `"gridify.sidecar.metadata"`. Each page contains a `cells` object mapping
+#'   cell names to their text values. Single-page and multi-page exports use the
+#'   same structure; multi-page PDFs contain one page entry per exported object.
+#'   Any stale sidecar is removed when no effective cell text exists.
+#'   \item `"none"` (default) - do not produce any metadata and remove any existing
+#'   sidecar for the same output file.
+#' }
+#' Validated with [match.arg()] so it can be abbreviated.
+#' When `metadata = NULL` (the default), the value is taken from the
+#' `gridify.export.metadata` global option (see [options()]), falling back to
+#' `"none"` if unset. This makes it possible to enable the feature globally
+#' for a project via
+#' `options(gridify.export.metadata = "sidecar")`.
 #' @param ... Additional arguments passed to the graphics device functions
 #' (`pdf()`, `png()`, `tiff()`, `jpeg()` or your custom one).
 #' Default width and height for each export type, respectively:
@@ -1124,17 +1143,25 @@ setMethod("show", "gridifyLayout", function(object) {
 #' )
 #'
 #' @export
-setGeneric("export_to", function(x, to, device = NULL, ...) {
-  standardGeneric("export_to")
-})
+setGeneric(
+  "export_to",
+  function(x, to, device = NULL, metadata = NULL, ...) {
+    standardGeneric("export_to")
+  }
+)
 
 #' @rdname export_to
 #' @export
-setMethod("export_to", "gridifyClass", function(x, to, device = NULL, ...) {
+setMethod(
+  "export_to",
+  "gridifyClass",
+  function(x, to, device = NULL, metadata = NULL, ...) {
   if (!(length(to) == 1 && is.character(to))) {
     stop("`to` must be a single string (file path) for single gridify object.")
   }
 
+  metadata <- resolve_export_metadata(metadata)
+
   dir_name <- dirname(to)
   if (!(dir.exists(dir_name))) {
     stop(sprintf(
@@ -1159,6 +1186,12 @@ setMethod("export_to", "gridifyClass", function(x, to, device = NULL, ...) {
   }
 
   user_args <- list(...)
+  payload <- if (metadata == "none") NULL else gridify_metadata(x)
+  sidecar_json <- if (metadata == "sidecar" && has_metadata_payload(payload)) {
+    gridify_to_json(metadata_sidecar_payload(payload))
+  } else {
+    NULL
+  }
 
   if (ext %in% c("pdf")) {
     default_args <- list(width = 11.69, height = 8.27)
@@ -1170,8 +1203,9 @@ setMethod("export_to", "gridifyClass", function(x, to, device = NULL, ...) {
     }
 
     do.call(device, dev_args)
+    on.exit(grDevices::dev.off(), add = TRUE)
     print(x)
-    on.exit(grDevices::dev.off())
+    sync_metadata_sidecar(to, sidecar_json)
   } else if (ext %in% c("png", "jpeg", "jpg", "tiff", "tif")) {
     default_args <- list(width = 600, height = 400)
     dev_args <- utils::modifyList(default_args, user_args)
@@ -1190,21 +1224,26 @@ setMethod("export_to", "gridifyClass", function(x, to, device = NULL, ...) {
       device <- dev_func
     }
     do.call(device, dev_args)
+    on.exit(grDevices::dev.off(), add = TRUE)
     grid::grid.newpage()
     print(x)
-    on.exit(grDevices::dev.off())
+    sync_metadata_sidecar(to, sidecar_json)
   }
 })
 
 
 #' @rdname export_to
 #' @export
-setMethod("export_to", "list", function(x, to, device = NULL, ...) {
+setMethod(
+  "export_to",
+  "list",
+  function(x, to, device = NULL, metadata = NULL, ...) {
   if (
     !all(vapply(x, function(elem) inherits(elem, "gridifyClass"), logical(1)))
   ) {
     stop("All elements of the list must be 'gridifyClass' objects.")
   }
+  metadata <- resolve_export_metadata(metadata)
 
   to_dirs <- dirname(to)
   dir_exists <- dir.exists(to_dirs)
@@ -1239,18 +1278,30 @@ setMethod("export_to", "list", function(x, to, device = NULL, ...) {
         device <- grDevices::pdf
       }
 
-      do.call(
-        device,
-        utils::modifyList(
-          list(file = to, width = 11.69, height = 8.27, onefile = TRUE),
-          list(...)
-        )
+      payload <- if (metadata == "none") {
+        NULL
+      } else {
+        lapply(x, gridify_metadata)
+      }
+      sidecar_json <- if (metadata == "sidecar" && has_metadata_payload(payload)) {
+        gridify_to_json(metadata_sidecar_payload(payload))
+      } else {
+        NULL
+      }
+
+      user_args <- list(...)
+      dev_args <- utils::modifyList(
+        list(file = to, width = 11.69, height = 8.27, onefile = TRUE),
+        user_args
       )
+      do.call(device, dev_args)
       on.exit(grDevices::dev.off(), add = TRUE)
 
       for (obj in x) {
         print(obj)
       }
+
+      sync_metadata_sidecar(to, sidecar_json)
     } else {
       stop(
         "For a list of gridify objects and a single file path, the `to` extension has to be pdf."
@@ -1259,7 +1310,7 @@ setMethod("export_to", "list", function(x, to, device = NULL, ...) {
   } else if (length(to) == length(x)) {
     # Each plot goes to a separate file path in `to`
     for (i in seq_along(x)) {
-      export_to(x[[i]], to[[i]], ...)
+      export_to(x[[i]], to[[i]], device = device, metadata = metadata, ...)
     }
   } else {
     stop(
@@ -1271,7 +1322,7 @@ setMethod("export_to", "list", function(x, to, device = NULL, ...) {
 
 #' @rdname export_to
 #' @export
-setMethod("export_to", "ANY", function(x, to, ...) {
+setMethod("export_to", "ANY", function(x, to, device = NULL, metadata = NULL, ...) {
   stop(
     "export_to is supported for gridifyClass or list of gridifyClass objects."
   )

R/gridify-utils.R

@@ -48,6 +48,131 @@ gpar_call <- function(gpar) {
   as.call(c(quote(grid::gpar), gpar_args(gpar)))
 }
 
+#' Build the metadata payload for a `gridifyClass` object
+#'
+#' Extracts the effective text for each layout cell. Values set with
+#' [set_cell()] take precedence over layout default text. Cells with no
+#' effective text are skipped.
+#' @param x a `gridifyClass` object.
+#' @return a named list mapping cell name to its text value.
+#' @keywords internal
+gridify_metadata <- function(x) {
+  cells <- x@layout@cells@cells
+  if (length(cells) == 0) {
+    return(stats::setNames(list(), character(0)))
+  }
+  texts <- lapply(names(cells), function(cell) {
+    elem <- x@elements[[cell]]
+    cell_info <- cells[[cell]]
+    candidates <- c(elem[["text"]], cell_info@text)
+    if (length(candidates) == 0) NULL else candidates[1]
+  })
+  names(texts) <- names(cells)
+  texts[!vapply(texts, is.null, logical(1))]
+}
+
+#' Encode a metadata payload as JSON via `jsonlite`.
+#'
+#' Thin wrapper around `jsonlite::toJSON()` with the options used by gridify
+#' metadata: scalar character/numeric/logical values are unboxed, `NA` and
+#' `NULL` are serialised as `null`. Centralised so the encoder options live in
+#' one place.
+#' @param x value to encode.
+#' @return a length-one character vector with the JSON representation of `x`.
+#' @keywords internal
+gridify_to_json <- function(x) {
+  if (requireNamespace("jsonlite", quietly = TRUE)) {
+    as.character(jsonlite::toJSON(
+      x,
+      auto_unbox = TRUE,
+      null = "null",
+      na = "null"
+    ))
+  } else {
+    stop("Please install the 'jsonlite' package to use the gridify_to_json function")
+  }
+}
+
+#' Build the JSON sidecar metadata structure
+#'
+#' Wraps single-page and multi-page metadata in the same schema so consumers can
+#' always read metadata from `pages[[i]]$cells`.
+#'
+#' @param payload A named list (single page) or list of named lists (multi-page)
+#' of metadata values.
+#' @return A named list containing `schema`, `schema_version` and `pages`.
+#' @keywords internal
+metadata_sidecar_payload <- function(payload) {
+  pages <- if (is.list(payload) && is.null(names(payload))) {
+    payload
+  } else {
+    list(payload)
+  }
+
+  list(
+    schema = "gridify.sidecar.metadata",
+    schema_version = "1.0.0",
+    pages = lapply(pages, function(cells) list(cells = cells))
+  )
+}
+
+#' Check whether a metadata payload contains values
+#'
+#' @param payload A metadata payload.
+#' @return `TRUE` when the payload contains at least one metadata value.
+#' @keywords internal
+has_metadata_payload <- function(payload) {
+  if (is.null(payload) || length(payload) == 0) {
+    return(FALSE)
+  }
+  if (is.list(payload) && is.null(names(payload))) {
+    return(any(vapply(payload, has_metadata_payload, logical(1))))
+  }
+  TRUE
+}
+
+#' Synchronise the JSON metadata sidecar file
+#'
+#' Writes `json` to the sidecar when supplied. Otherwise removes any existing
+#' sidecar for `to`, preventing stale metadata from surviving later exports of
+#' the same output file.
+#'
+#' @param to A length-one character string with the path of the main output
+#' file.
+#' @param json Optional pre-encoded JSON metadata.
+#' @return Invisibly, the path of the sidecar file that was written or removed.
+#' @keywords internal
+sync_metadata_sidecar <- function(to, json = NULL) {
+  side <- paste0(to, ".json")
+  if (!is.null(json)) {
+    writeLines(json, con = side, useBytes = TRUE)
+  } else if (file.exists(side)) {
+    unlink(side)
+  }
+  invisible(side)
+}
+
+#' Resolve the effective `metadata` argument for `export_to()`
+#'
+#' Resolves the `metadata` argument from (in order of precedence):
+#' 1. the value passed by the caller,
+#' 2. the `gridify.export.metadata` global option,
+#' 3. the built-in default `"none"`.
+#'
+#' The result is then validated against the allowed choices via
+#' [match.arg()], so abbreviations are accepted.
+#'
+#' @param metadata the value passed by the user; may be `NULL`.
+#' @return one of `"none"`, `"sidecar"`.
+#' @keywords internal
+resolve_export_metadata <- function(metadata) {
+  choices <- c("none", "sidecar")
+  if (is.null(metadata)) {
+    metadata <- getOption("gridify.export.metadata", "none")
+  }
+  match.arg(metadata, choices)
+}
+
 #' Detect a "flexible" grob whose natural height is not meaningful
 #'
 #' A flexible grob is one designed to fill whatever container it is placed