dsROCrate v0.2.1

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dsROCrate
 Title: 'DataSHIELD' RO-Crate Governance Functions
-Version: 0.2.0
+Version: 0.2.1
 Authors@R: c(
     person(given = "Roberto",
            family = "Villegas-Diaz",

NAMESPACE

@@ -51,7 +51,6 @@ S3method(flatten_safe_project,default)
 S3method(flatten_safe_project,rocrate)
 S3method(flatten_safe_setting,default)
 S3method(flatten_safe_setting,rocrate)
-S3method(has_symbol,symbol_registry)
 S3method(init,ArmadilloCredentials)
 S3method(init,opal)
 S3method(init,rocrate)

NEWS.md

@@ -1,3 +1,22 @@
+# dsROCrate 0.2.1
+
+## Bug Fixes
+
+* Removed a duplicate, conflicting definition of `as.data.frame.safe_call()` (two files each defined this S3 method with different output columns; only one could ever take effect, silently). The `safe-call.R` version — timestamp, user, r_cmd, fx, args, session, profile — is now the sole implementation.
+* Fixed `print.safe_symbol()` referencing stale `column`/`parent` fields left over from before the 0.2.0 symbol-model refactor; it now correctly displays the symbol's `asset`, `expr`, and `session` (guarding on both `NULL` and `NA`, since these fields default to `NA_character_`).
+* Fixed `as.data.frame.symbol_registry()`, which previously iterated over the columns of the underlying tibble instead of its rows (via `lapply()` on a data frame), causing it to error whenever called on a non-empty registry. It also referenced non-existent `parent`/`column` fields. The method now simply returns `x$symbols` coerced to a data frame, which already carries the correct columns.
+* Fixed `register_symbol()` erroring on a brand-new, empty registry (the very first symbol registered in any session): the emptiness check compared `nrow()` of a plain, pre-tibble `list()` before checking `length()`, producing a zero-length logical passed to `||`. The `length()` check is now evaluated first, so it short-circuits correctly.
+* Fixed `as.data.frame.safe_call()`'s `args` column having an unstable name and shape depending on how many arguments the underlying call had (a single-argument call collapsed the column into one named after that argument, e.g. `x`; multiple arguments spread into several columns instead of one). The argument list is now wrapped with `I(list(...))` so it always appears as a single, reliably-named `args` list-column.
+* Added regression tests for `safe_call()`/`as.data.frame.safe_call()`, `print.safe_symbol()`, and `register_symbol()`/`as.data.frame.symbol_registry()`, none of which previously had any test coverage.
+
+## Internal Changes
+
+* Removed unused internal helpers: `has_symbol()`/`has_symbol.symbol_registry()` (and its S3 export) and `safe_symbol_reference()`/`new_safe_symbol_reference()`, none of which were called anywhere in the package.
+* Removed leftover commented-out code from `safe_symbol()` and `print.safe_call()`.
+* Added roxygen2 documentation (`@param`, `@returns`, `@keywords internal`, `@noRd`) and explanatory comments to the internal symbol-tracking functions introduced in 0.2.0 (`safe_call()`, `safe_symbol()`, `safe_reference()`, `symbol_registry()`, and their supporting utilities), with no change in behaviour.
+* Updated spell-check `WORDLIST`.
+* Re-rendered vignettes to refresh example output.
+
 # dsROCrate 0.2.0
 
 ## Breaking Changes

R/print.R

@@ -65,10 +65,6 @@ print.safe_call <- function(x, ...) {
         }
       })
     )
-    # msg <- c(
-    #   msg,
-    #   paste0("    ", names(x$args), " = ", unlist(x$args), collapse = "\n")
-    # )
   }
 
   message(paste0(msg, collapse = "\n"))
@@ -84,16 +80,16 @@ print.safe_symbol <- function(x, ...) {
   msg <- c(msg, paste("Symbol :", x$symbol))
   msg <- c(msg, paste("Kind   :", x$kind))
 
-  if (!is.null(x$asset)) {
+  if (!is.null(x$asset) && !is.na(x$asset)) {
     msg <- c(msg, paste("Asset  :", x$asset))
   }
 
-  if (!is.null(x$column)) {
-    msg <- c(msg, paste("Column :", x$column))
+  if (!is.null(x$expr) && !is.na(x$expr)) {
+    msg <- c(msg, paste("Expression :", x$expr))
   }
 
-  if (!is.null(x$parent)) {
-    msg <- c(msg, paste("Parent :", x$parent))
+  if (!is.null(x$session) && !is.na(x$session)) {
+    msg <- c(msg, paste("Session :", x$session))
   }
 
   message(paste0(msg, collapse = "\n"))

R/safe-call-utils.R

@@ -1,14 +1,14 @@
-#' @export
-as.data.frame.safe_call <- function(x, ...) {
-  data.frame(
-    package = x$package,
-    fx = x$fx,
-    argument = names(x$args),
-    value = vapply(x$args, toString, character(1)),
-    stringsAsFactors = FALSE
-  )
-}
-
+#' Enrich argument from function call
+#'
+#' @param arg String with argument.
+#' @param registry Symbol registry object.
+#' @param timestamp Timestamp to map the symbol details.
+#' @param session String with session ID.
+#'
+#' @returns `safe_reference` object.
+#' @keywords internal
+#'
+#' @noRd
 enrich_argument <- function(arg, registry, timestamp, session) {
   if (!is.character(arg) || length(arg) != 1) {
     return(arg)
@@ -31,8 +31,17 @@ enrich_argument <- function(arg, registry, timestamp, session) {
   )
 }
 
+#' Enrich function call
+#'
+#' @param call Function call.
+#' @param registry Symbol registry object.
+#'
+#' @returns Updated function call with enrich arguments.
+#' @keywords internal
+#'
+#' @noRd
 enrich_call <- function(call, registry) {
-  # call$args <- lapply(call$args, resolve_argument, registry = registry)
+  # call `enrich_argument` for each argument in the function call
   call$args <- purrr::map(
     call$args,
     enrich_argument,
@@ -44,6 +53,14 @@ enrich_call <- function(call, registry) {
   call
 }
 
+#' Get function details
+#'
+#' @param info List with details for function call.
+#'
+#' @returns Function invoked in function call.
+#' @keywords internal
+#'
+#' @noRd
 get_function <- function(info) {
   if (is.null(info$package)) {
     return(
@@ -57,6 +74,17 @@ get_function <- function(info) {
   )
 }
 
+#' Parse arguments from a function call
+#'
+#' @param fx_call R function call.
+#' @param info List with details from the function call.
+#' @param expand.dots Boolean flag. Should arguments matching `...` in the call
+#'     be included or left as a `...` argument?
+#'
+#' @returns List with simplified arguments.
+#' @keywords internal
+#'
+#' @noRd
 parse_arguments <- function(fx_call, info, expand.dots = FALSE) {
   supplied <- as.list(fx_call[-1])
   supplied_names <- names(supplied)
@@ -100,6 +128,14 @@ parse_arguments <- function(fx_call, info, expand.dots = FALSE) {
   matched
 }
 
+#' Parse function call
+#'
+#' @param fx_call R function call.
+#'
+#' @returns List with properties extracted from `fx_call`.
+#' @keywords internal
+#'
+#' @noRd
 parse_call <- function(fx_call) {
   fx <- fx_call[[1]]
 
@@ -118,6 +154,14 @@ parse_call <- function(fx_call) {
   )
 }
 
+#' Parse function
+#'
+#' @param fx R function call.
+#'
+#' @returns List with function properties
+#' @keywords internal
+#'
+#' @noRd
 parse_function <- function(fx) {
   if (is.call(fx) && identical(fx[[1]], as.name("::"))) {
     return(
@@ -136,6 +180,14 @@ parse_function <- function(fx) {
   )
 }
 
+#' Simplify argument
+#'
+#' @param x Object with argument from function call.
+#'
+#' @returns Simplified argument object.
+#' @keywords internal
+#'
+#' @noRd
 simplify_argument <- function(x) {
   if (is.atomic(x) || is.character(x)) {
     return(x)

R/safe-call.R

@@ -5,13 +5,26 @@ as.data.frame.safe_call <- function(x, ...) {
     user = x$user,
     r_cmd = x$original,
     fx = paste0(x$package, x$namespace, x$fx),
-    args = x$args,
+    args = I(list(x$args)),
     session = x$session,
     profile = x$profile,
     stringsAsFactors = FALSE
   )
 }
 
+#' Create new `safe_call` object
+#'
+#' @param original Original function call.
+#' @param package Function's package.
+#' @param namespace Function's namespace.
+#' @param fx Function's name.
+#' @param args List with arguments.
+#' @param ... Additional arguments.
+#'
+#' @returns New `safe_call` object.
+#' @keywords internal
+#'
+#' @noRd
 new_safe_call <- function(
   original,
   package,
@@ -40,6 +53,15 @@ new_safe_call <- function(
   )
 }
 
+#' Safe call details
+#'
+#' @param call Object with function call.
+#' @param ... Additional arguments.
+#'
+#' @returns Object with the class `safe_call`.
+#' @keywords internal
+#'
+#' @noRd
 safe_call <- function(call, ...) {
   UseMethod("safe_call")
 }

R/safe-reference.R

@@ -1,3 +1,13 @@
+#' Safe reference details
+#'
+#' @param symbol Symbol object.
+#' @param symbol_id String with symbol unique ID.
+#' @param column String with column name, when symbol is `symbol$column`.
+#'
+#' @returns Object with the class `safe_reference`
+#' @keywords internal
+#'
+#' @noRd
 safe_reference <- function(symbol, symbol_id, column = NULL) {
   structure(
     list(

R/safe-symbol-utils.R

@@ -1,20 +1,32 @@
+#' Find symbols in a given expression
+#'
+#' @param expr Object with R expression.
+#'
+#' @returns A list with a reference, if any is found.
+#' @keywords internal
+#'
+#' @noRd
 find_symbols <- function(expr) {
+  # parse expression if given value is a character
   if (is.character(expr)) {
     expr <- parse(text = expr)[[1]]
   }
 
   recurse <- function(x) {
+    # check if the given object is a symbol
     if (is.symbol(x)) {
       return(list(list(
         symbol = as.character(x),
         column = NA_character_
       )))
     }
 
+    # check if the given objects is NOT a call
     if (!is.call(x)) {
       return(list())
     }
 
+    # check if the given object is of the format `symbol$column`
     if (identical(x[[1]], quote(`$`))) {
       lhs <- x[[2]]
       out <- list(list(
@@ -25,31 +37,44 @@ find_symbols <- function(expr) {
       return(out)
     }
 
+    # return recursive call of the original subset
     unlist(
       lapply(as.list(x)[-1], recurse),
       recursive = FALSE
     )
   }
 
   refs <- recurse(expr)
+  # filter out symbols from base packages
   refs <- Filter(\(x) !(x$symbol %in% c("base", "stats", "utils")), refs)
   if (!length(refs)) {
     return(NULL)
   }
   refs
 }
 
+#' Resolve expression dependencies
+#'
+#' @param expr Object with R expression.
+#' @param registry Symbol registry object.
+#'
+#' @returns Tibble object with expression dependencies' details.
+#' @keywords internal
+#'
+#' @noRd
 resolve_dependencies <- function(expr, registry) {
   if (is.null(expr) || is.na(expr)) {
     return(tibble::tibble())
   }
 
+  # find symbols for the given expression
   refs <- find_symbols(expr)
 
   if (is.null(refs)) {
     return(tibble::tibble())
   }
 
+  # look up symbol details for each reference found previously
   purrr::map_dfr(refs, function(ref) {
     sym <- lookup_symbol(ref$symbol, registry)
 
@@ -63,6 +88,16 @@ resolve_dependencies <- function(expr, registry) {
   })
 }
 
+#' Resolve provenance of symbol
+#'
+#' @param symbol_id String with unique symbol ID.
+#' @param registry Symbol registry object.
+#' @param visited Vector with symbol IDs that have been processed.
+#'
+#' @returns Tibble object with details of provenance for symbol.
+#' @keywords internal
+#'
+#' @noRd
 resolve_provenance <- function(symbol_id, registry, visited = character()) {
   # local bindings
   id <- NULL
@@ -91,6 +126,15 @@ resolve_provenance <- function(symbol_id, registry, visited = character()) {
   dplyr::bind_rows(deps, children)
 }
 
+#' Resolve symbol's asset
+#'
+#' @param symbol_id String with unique symbol ID.
+#' @param registry Symbol registry object.
+#'
+#' @returns String with asset(s) linked to symbol ID.
+#' @keywords internal
+#'
+#' @noRd
 resolve_symbol_asset <- function(symbol_id, registry) {
   # local binding
   asset <- id <- kind <- NULL