Add optional convert argument to write_vc/read_vc for column transformations

.Rbuildignore

@@ -5,9 +5,11 @@
 ^LICENSE.md$
 ^Meta$
 ^README\.Rmd$
+^[.]?air[.]toml$
 ^\.Rproj\.user$
 ^\.github$
 ^\.httr-oauth$
+^\.vscode$
 ^\.zenodo\.json$
 ^_pkgdown.yml$
 ^checklist.yml$

.vscode/extensions.json

@@ -0,0 +1,5 @@
+{
+    "recommendations": [
+        "Posit.air-vscode"
+    ]
+}

.vscode/settings.json

@@ -0,0 +1,10 @@
+{
+    "[r]": {
+        "editor.formatOnSave": true,
+        "editor.defaultFormatter": "Posit.air-vscode"
+    },
+    "[quarto]": {
+        "editor.formatOnSave": true,
+        "editor.defaultFormatter": "quarto.quarto"
+    }
+}

DESCRIPTION

@@ -66,9 +66,9 @@ Collate:
     'datahash.R'
     'display_metadata.R'
     'git2rdata_package.R'
+    'is_git2rmeta.R'
     'write_vc.R'
     'is_git2rdata.R'
-    'is_git2rmeta.R'
     'list_data.R'
     'meta.R'
     'print.R'

NEWS.md

@@ -1,5 +1,11 @@
 # git2rdata 0.5.2
 
+* `write_vc()` gains an optional `convert` argument for specifying column 
+  conversions. Conversions are applied before storing and reversed when 
+  reading data back. The convert information is stored in the metadata 
+  and added to the data frame attributes.
+* `read_vc()` now applies conversions specified in the metadata and adds 
+  the convert information to the data frame attributes.
 * Bugfix in `rename_variable()` thanks to @florisvdh for finding and fixing the
   bug.
 

R/read_vc.R

@@ -176,6 +176,12 @@ read_vc.character <- function(file, root = ".") {
     optimize = optimize
   )
 
+  # Apply read conversions if present
+  if (has_name(meta_data[["..generic"]], "convert")) {
+    convert <- meta_data[["..generic"]][["convert"]]
+    raw_data <- apply_convert(raw_data, convert, direction = "read")
+  }
+
   names(file) <- c(
     meta_data[["..generic"]][["data_hash"]],
     meta_data[["..generic"]][["hash"]]
@@ -209,6 +215,11 @@ read_vc.character <- function(file, root = ".") {
   attr(raw_data, "optimize") <- meta_data[["..generic"]][["optimize"]]
   attr(raw_data, "sorting") <- meta_data[["..generic"]][["sorting"]]
 
+  # Add convert to attributes if present
+  if (has_name(meta_data[["..generic"]], "convert")) {
+    attr(raw_data, "convert") <- meta_data[["..generic"]][["convert"]]
+  }
+
   class(raw_data) <- c("git2rdata", class(raw_data))
 
   return(raw_data)

R/utils.R

@@ -11,3 +11,190 @@ display <- function(verbose, message, linefeed = TRUE) {
   }
   return(invisible(NULL))
 }
+
+#' Validate the convert argument
+#' @noRd
+#' @importFrom assertthat assert_that
+validate_convert <- function(convert, colnames_x) {
+  if (is.null(convert) || length(convert) == 0) {
+    return(list())
+  }
+
+  validate_convert_structure(convert, colnames_x)
+
+  for (col_name in names(convert)) {
+    convert[[col_name]] <- validate_convert_element(
+      convert[[col_name]],
+      col_name
+    )
+  }
+
+  return(convert)
+}
+
+#' Validate convert structure
+#' @noRd
+#' @importFrom assertthat assert_that
+validate_convert_structure <- function(convert, colnames_x) {
+  assert_that(
+    is.list(convert),
+    msg = "convert must be a list"
+  )
+
+  assert_that(
+    !is.null(names(convert)),
+    msg = "convert must be a named list"
+  )
+
+  assert_that(
+    all(names(convert) != ""),
+    msg = "all elements of convert must be named"
+  )
+
+  assert_that(
+    all(names(convert) %in% colnames_x),
+    msg = paste(
+      "all names in convert must be present in colnames of x.",
+      "Missing:",
+      paste(names(convert)[!names(convert) %in% colnames_x], collapse = ", ")
+    )
+  )
+}
+
+#' Validate a single convert element
+#' @noRd
+#' @importFrom assertthat assert_that
+validate_convert_element <- function(conv, col_name) {
+  assert_that(
+    is.character(conv),
+    msg = sprintf(
+      "convert[['%s']] must be a character vector",
+      col_name
+    )
+  )
+  assert_that(
+    length(conv) == 2,
+    msg = sprintf(
+      "convert[['%s']] must have length 2",
+      col_name
+    )
+  )
+  assert_that(
+    !is.null(names(conv)),
+    msg = sprintf(
+      "convert[['%s']] must be a named vector",
+      col_name
+    )
+  )
+  assert_that(
+    all(names(conv) %in% c("write", "read")),
+    msg = sprintf(
+      "convert[['%s']] must have names 'write' and 'read'",
+      col_name
+    )
+  )
+  assert_that(
+    "write" %in% names(conv) && "read" %in% names(conv),
+    msg = sprintf(
+      "convert[['%s']] must have both 'write' and 'read' elements",
+      col_name
+    )
+  )
+
+  validate_convert_function(conv[["write"]], col_name, "write")
+  validate_convert_function(conv[["read"]], col_name, "read")
+  conv[c("write", "read")]
+}
+
+#' Validate a convert function specification
+#' @noRd
+#' @importFrom assertthat assert_that
+validate_convert_function <- function(func_spec, col_name, direction) {
+  assert_that(
+    grepl("::", func_spec, fixed = TRUE),
+    msg = sprintf(
+      "convert[['%s']][['%s']] must be in 'package::function' format",
+      col_name,
+      direction
+    )
+  )
+
+  parts <- strsplit(func_spec, "::", fixed = TRUE)[[1]]
+  assert_that(
+    length(parts) == 2,
+    msg = sprintf(
+      "convert[['%s']][['%s']] must have exactly one '::'",
+      col_name,
+      direction
+    )
+  )
+
+  pkg_name <- parts[1]
+  func_name <- parts[2]
+
+  assert_that(
+    nzchar(pkg_name) && nzchar(func_name),
+    msg = sprintf(
+      "convert[['%s']][['%s']] has empty package or function name",
+      col_name,
+      direction
+    )
+  )
+
+  if (!requireNamespace(pkg_name, quietly = TRUE)) {
+    stop(
+      sprintf(
+        paste(
+          "Package '%s' required for convert[['%s']][['%s']]",
+          "is not available"
+        ),
+        pkg_name,
+        col_name,
+        direction
+      ),
+      call. = FALSE
+    )
+  }
+
+  if (
+    !exists(
+      func_name,
+      where = asNamespace(pkg_name),
+      mode = "function"
+    )
+  ) {
+    stop(
+      sprintf(
+        paste(
+          "Function '%s' not found in package '%s'",
+          "for convert[['%s']][['%s']]"
+        ),
+        func_name,
+        pkg_name,
+        col_name,
+        direction
+      ),
+      call. = FALSE
+    )
+  }
+}
+
+#' Apply conversion functions to columns
+#' @noRd
+apply_convert <- function(x, convert, direction = "write") {
+  if (is.null(convert) || length(convert) == 0) {
+    return(x)
+  }
+
+  for (col_name in names(convert)) {
+    func_spec <- convert[[col_name]][[c(write = 1, read = 2)[direction]]]
+    parts <- strsplit(func_spec, "::", fixed = TRUE)[[1]]
+    pkg_name <- parts[1]
+    func_name <- parts[2]
+
+    func <- get(func_name, envir = asNamespace(pkg_name), mode = "function")
+    x[[col_name]] <- func(x[[col_name]])
+  }
+
+  return(x)
+}

R/write_vc.R

@@ -42,7 +42,8 @@ write_vc <- function(
   optimize = TRUE,
   na = "NA",
   ...,
-  split_by
+  split_by,
+  convert
 ) {
   UseMethod("write_vc", root)
 }
@@ -72,11 +73,18 @@ write_vc.default <- function(
 #' Either a single positive integer or a named vector where the names link to
 #' the variables in the `data.frame`.
 #' Defaults to `6` with a warning.
+#' @param convert An optional named list for column conversions.
+#' Names must be present in the column names of `x`.
+#' Each element must be a character vector of length 2 with names `write` and
+#' `read`, containing function names in the `package::function` format.
+#' The `write` function is applied before storing, and `read` function is
+#' applied when reading back the data.
 #' @export
 #' @importFrom assertthat assert_that is.string is.flag
 #' @importFrom yaml read_yaml write_yaml
 #' @importFrom utils write.table
 #' @importFrom git2r hash
+#' @include is_git2rmeta.R
 write_vc.character <- function(
   x,
   file,
@@ -88,7 +96,8 @@ write_vc.character <- function(
   ...,
   append = FALSE,
   split_by = character(0),
-  digits
+  digits,
+  convert = list()
 ) {
   assert_that(
     inherits(x, "data.frame"),
@@ -104,6 +113,9 @@ write_vc.character <- function(
     noNA(strict),
     noNA(optimize)
   )
+  # Validate and check packages for convert
+  convert <- validate_convert(convert, colnames(x))
+
   if (append) {
     x <- append_df(x = x, file = file, root = root)
   }
@@ -113,6 +125,10 @@ write_vc.character <- function(
     dir.create(showWarnings = FALSE, recursive = TRUE)
 
   if (!file.exists(file["meta_file"])) {
+    # Apply write conversions before calling meta() for new files
+    if (length(convert) > 0) {
+      x <- apply_convert(x, convert, direction = "write")
+    }
     raw_data <- meta(
       x,
       optimize = optimize,
@@ -137,6 +153,12 @@ write_vc.character <- function(
     )
     old <- read_yaml(file["meta_file"])
     class(old) <- "meta_list"
+
+    # Apply write conversions before calling meta() for existing files too
+    if (length(convert) > 0) {
+      x <- apply_convert(x, convert, direction = "write")
+    }
+
     raw_data <- meta(
       x,
       optimize = optimize,
@@ -147,7 +169,14 @@ write_vc.character <- function(
       split_by = split_by,
       digits = digits
     )
-    problems <- compare_meta(attr(raw_data, "meta"), old)
+
+    # Add convert to new metadata before comparing
+    new_meta <- attr(raw_data, "meta")
+    if (length(convert) > 0) {
+      new_meta[["..generic"]][["convert"]] <- convert
+    }
+
+    problems <- compare_meta(new_meta, old)
     if (length(problems)) {
       problems <- c(
         paste(
@@ -253,6 +282,12 @@ write_vc.character <- function(
     packageVersion("git2rdata")
   )
   meta_data[["..generic"]][["data_hash"]] <- datahash(file["raw_file"])
+  # Store convert information in metadata
+  if (length(convert) > 0) {
+    meta_data[["..generic"]][["convert"]] <- convert
+  }
+  # Recalculate metadata hash after adding convert
+  meta_data[["..generic"]][["hash"]] <- metadata_hash(meta_data)
   write_yaml(meta_data, file["meta_file"], fileEncoding = "UTF-8")
 
   hashes <- remove_root(file = file, root = root)
@@ -360,6 +395,28 @@ compare_meta <- function(new, old) {
     ) -> extra
     problems <- c(problems, extra)
   }
+  new_convert <- new[["..generic"]][["convert"]]
+  old_convert <- old[["..generic"]][["convert"]]
+  if (!isTRUE(all.equal(new_convert, old_convert))) {
+    new_convert_str <- if (is.null(new_convert)) {
+      "none"
+    } else {
+      paste(names(new_convert), collapse = ", ")
+    }
+    old_convert_str <- if (is.null(old_convert)) {
+      "none"
+    } else {
+      paste(names(old_convert), collapse = ", ")
+    }
+    sprintf(
+      "- The convert variables changed.
+    - Convert for the new data: %s.
+    - Convert for the old data: %s.",
+      new_convert_str,
+      old_convert_str
+    ) -> extra
+    problems <- c(problems, extra)
+  }
 
   new <- new[names(new) != "..generic"]
   old <- old[names(old) != "..generic"]