Simplify Ryaml_yoink() and preserve class attributes so handlers work with column.major = FALSE

.gitignore

@@ -9,3 +9,4 @@ yaml_*.tar.gz
 *.Rproj
 docs
 inst/doc
+_codeql_detected_source_root

NEWS.md

@@ -1,5 +1,9 @@
 # yaml (development version)
 
+* Apply handlers also with `column.major = FALSE` (#164, @krlmlr).
+
+# yaml 2.3.12
+
 * Fixes for C API compliance.
 
 * Switched from `CHANGELOG` to `NEWS.md`.

src/r_emit.c

@@ -261,31 +261,18 @@ static yaml_scalar_style_t Ryaml_string_style(SEXP s_obj)
 /* Take a vector and an index and return another vector of size 1 */
 static SEXP Ryaml_yoink(SEXP s_vec, int index)
 {
-  SEXP s_tmp = NULL, s_levels = NULL;
-  int type = 0, factor = 0, level_idx = 0;
+  SEXP s_tmp = NULL;
+  int type = 0;
 
   type = TYPEOF(s_vec);
-  factor = type == INTSXP && Ryaml_has_class(s_vec, "factor");
-  PROTECT(s_tmp = allocVector(factor ? STRSXP : type, 1));
+  PROTECT(s_tmp = allocVector(type, 1));
 
   switch(type) {
     case LGLSXP:
       LOGICAL(s_tmp)[0] = LOGICAL(s_vec)[index];
       break;
     case INTSXP:
-      if (factor) {
-        s_levels = getAttrib(s_vec, R_LevelsSymbol);
-        level_idx = INTEGER(s_vec)[index];
-        if (level_idx == NA_INTEGER || level_idx < 1 || level_idx > LENGTH(s_levels)) {
-          SET_STRING_ELT(s_tmp, 0, NA_STRING);
-        }
-        else {
-          SET_STRING_ELT(s_tmp, 0, STRING_ELT(s_levels, level_idx - 1));
-        }
-      }
-      else {
-        INTEGER(s_tmp)[0] = INTEGER(s_vec)[index];
-      }
+      INTEGER(s_tmp)[0] = INTEGER(s_vec)[index];
       break;
     case REALSXP:
       REAL(s_tmp)[0] = REAL(s_vec)[index];
@@ -300,6 +287,7 @@ static SEXP Ryaml_yoink(SEXP s_vec, int index)
       RAW(s_tmp)[0] = RAW(s_vec)[index];
       break;
   }
+  copyMostAttrib(s_vec, s_tmp);
   UNPROTECT(1);
 
   return s_tmp;

tests/testthat/test-as_yaml.R

@@ -479,3 +479,40 @@ test_that("no dots at end", {
   result <- yaml::as.yaml(list(eol = "\n", a = 1), line.sep = "\n")
   expect_equal(result, "eol: |2+\n\na: 1.0\n")
 })
+
+test_that("Date handler works with column.major = FALSE", {
+  x <- data.frame(date = as.Date(c("2012-10-10", "2014-03-28")))
+  handler <- list(Date = function(x) as.character(x))
+
+  result_col <- as.yaml(x, handlers = handler, column.major = TRUE)
+  result_row <- as.yaml(x, handlers = handler, column.major = FALSE)
+
+  expect_equal(result_col, "date:\n- '2012-10-10'\n- '2014-03-28'\n")
+  expect_equal(result_row, "- date: '2012-10-10'\n- date: '2014-03-28'\n")
+})
+
+test_that("POSIXct handler works with column.major = FALSE", {
+  x <- data.frame(
+    time = as.POSIXct(c("2012-10-10", "2014-03-28"), tz = "UTC")
+  )
+  handler <- list(POSIXct = function(x) format(x, "%Y-%m-%d"))
+
+  result_col <- as.yaml(x, handlers = handler, column.major = TRUE)
+  result_row <- as.yaml(x, handlers = handler, column.major = FALSE)
+
+  expect_equal(result_col, "time:\n- '2012-10-10'\n- '2014-03-28'\n")
+  expect_equal(result_row, "- time: '2012-10-10'\n- time: '2014-03-28'\n")
+})
+
+test_that("factor column works with column.major = FALSE", {
+  x <- data.frame(x = factor(c("a", "b", "c")))
+  result <- as.yaml(x, column.major = FALSE)
+  expect_equal(result, "- x: a\n- x: b\n- x: c\n")
+})
+
+test_that("factor handler works with column.major = FALSE", {
+  x <- data.frame(x = factor(c("a", "b", "c")))
+  handler <- list(factor = function(x) paste0("level_", x))
+  result <- as.yaml(x, handlers = handler, column.major = FALSE)
+  expect_equal(result, "- x: level_a\n- x: level_b\n- x: level_c\n")
+})