Add R to JS mapping for dates and factors

inst/include/quickjsr/SEXP_to_JSValue.hpp

@@ -5,6 +5,18 @@
 #include <quickjs-libc.h>
 
 namespace quickjsr {
+  JSValue JS_NewDate(JSContext* ctx, double timestamp) {
+    static constexpr double milliseconds_day = 86400000;
+    JSValue global_obj = JS_GetGlobalObject(ctx);
+    JSValue date_ctor = JS_GetPropertyStr(ctx, global_obj, "Date");
+    JSValue timestamp_val = JS_NewFloat64(ctx, timestamp * milliseconds_day);
+    JSValue date = JS_CallConstructor(ctx, date_ctor, 1, &timestamp_val);
+
+    JS_FreeValue(ctx, global_obj);
+    JS_FreeValue(ctx, date_ctor);
+    JS_FreeValue(ctx, timestamp_val);
+    return date;
+  }
   // Forward declaration to allow for recursive calls
   JSValue SEXP_to_JSValue(JSContext* ctx, SEXP x, bool auto_unbox, bool auto_unbox_curr);
   JSValue SEXP_to_JSValue(JSContext* ctx, SEXP x, bool auto_unbox, bool auto_unbox_curr, int index);
@@ -51,17 +63,38 @@ namespace quickjsr {
     return arr;
   }
 
+  JSValue SEXP_to_JSValue_list(JSContext* ctx, SEXP x, bool auto_unbox, bool auto_unbox_curr) {
+    // Following jsonlite conventions:
+    //   - R list with names is an object, otherwise an array
+    if (Rf_getAttrib(x, R_NamesSymbol) != R_NilValue) {
+      return SEXP_to_JSValue_object(ctx, x, auto_unbox, auto_unbox_curr);
+    } else {
+      return SEXP_to_JSValue_array(ctx, x, auto_unbox, auto_unbox_curr);
+    }
+  }
+
   JSValue SEXP_to_JSValue(JSContext* ctx, SEXP x, bool auto_unbox, bool auto_unbox_curr, int index) {
     if (Rf_isNewList(x)) {
       return SEXP_to_JSValue(ctx, VECTOR_ELT(x, index), auto_unbox, auto_unbox_curr);
     }
     switch (TYPEOF(x)) {
       case LGLSXP:
         return JS_NewBool(ctx, LOGICAL(x)[index]);
-      case INTSXP:
-        return JS_NewInt32(ctx, INTEGER(x)[index]);
-      case REALSXP:
-        return JS_NewFloat64(ctx, REAL(x)[index]);
+      case INTSXP: {
+        if (Rf_inherits(x, "factor")) {
+          SEXP levels = Rf_getAttrib(x, R_LevelsSymbol);
+          return JS_NewString(ctx, CHAR(STRING_ELT(levels, INTEGER(x)[index] - 1)));
+        } else {
+          return JS_NewInt32(ctx, INTEGER(x)[index]);
+        }
+      }
+      case REALSXP: {
+        if (Rf_inherits(x, "Date")) {
+          return JS_NewDate(ctx, REAL(x)[index]);
+        } else {
+          return JS_NewFloat64(ctx, REAL(x)[index]);
+        }
+      }
       case STRSXP:
         return JS_NewString(ctx, Rf_translateCharUTF8(STRING_ELT(x, index)));
       case VECSXP:
@@ -80,20 +113,11 @@ namespace quickjsr {
     if (Rf_isFrame(x)) {
       return SEXP_to_JSValue_df(ctx, x, auto_unbox_inp, auto_unbox_curr);
     }
-    // Following jsonlite conventions:
-    //   - R list with names is an object, otherwise an array
     if (Rf_isNewList(x)) {
-      if (Rf_getAttrib(x, R_NamesSymbol) != R_NilValue) {
-        return SEXP_to_JSValue_object(ctx, x, auto_unbox_inp, auto_unbox_curr);
-      } else {
-        return SEXP_to_JSValue_array(ctx, x, auto_unbox_inp, auto_unbox_curr);
-      }
-    }
-    if (Rf_isArray(x)) {
-      return SEXP_to_JSValue_array(ctx, x, auto_unbox_inp, auto_unbox_curr);
+      return SEXP_to_JSValue_list(ctx, x, auto_unbox_inp, auto_unbox_curr);
     }
-    if (Rf_isVectorAtomic(x)) {
-      if (Rf_length(x) > 1 || !auto_unbox_curr) {
+    if (Rf_isVectorAtomic(x) || Rf_isArray(x)) {
+      if (Rf_length(x) > 1 || !auto_unbox_curr || Rf_isArray(x)) {
         return SEXP_to_JSValue_array(ctx, x, auto_unbox_inp, auto_unbox_curr);
       }
     }

inst/tinytest/test_data_conversion.R

@@ -5,29 +5,34 @@
 expect_eq_jsonlite <- function(x) {
   expect_equal(to_json(x), as.character(jsonlite::toJSON(x)))
 }
-expect_eq_jsonlite(1)
-expect_eq_jsonlite(1:3)
-expect_eq_jsonlite(c(1.5, 2.5))
-
-expect_eq_jsonlite("a")
-expect_eq_jsonlite(c("a", "b", "c"))
-
-expect_eq_jsonlite(TRUE)
-expect_eq_jsonlite(FALSE)
-expect_eq_jsonlite(c(TRUE, FALSE))
-
-expect_eq_jsonlite(list(1, 2, 3))
-expect_eq_jsonlite(list(a = 1, b = 2, c = 3))
-expect_eq_jsonlite(list(a = "d", b = "e", c = "f"))
-
-expect_eq_jsonlite(list(c(1, 2), c(3, 4)))
-expect_eq_jsonlite(list(list(1, 2), list(3, 4)))
-expect_eq_jsonlite(list(list(a = 1, b = 2), list(c = 3, d = 4)))
-
-expect_eq_jsonlite(list(c("e", "f"), c("g", "h")))
-expect_eq_jsonlite(list(list("e", "f"), list("g", "h")))
-expect_eq_jsonlite(list(list(a = "e", b = "f"), list(c = "g", d = "h")))
-
+expect_equal(to_json(1), "[1]")
+expect_equal(to_json(1:3), "[1,2,3]")
+expect_equal(to_json(c(1.5, 2.5)), "[1.5,2.5]")
+
+expect_equal(to_json("a"), "[\"a\"]")
+expect_equal(to_json(c("a", "b", "c")), "[\"a\",\"b\",\"c\"]")
+
+expect_equal(to_json(TRUE), "[true]")
+expect_equal(to_json(FALSE), "[false]")
+expect_equal(to_json(c(TRUE, FALSE)), "[true,false]")
+
+expect_equal(to_json(list(1, 2, 3)), "[[1],[2],[3]]")
+expect_equal(to_json(list(a = 1, b = 2, c = 3)),
+              "{\"a\":[1],\"b\":[2],\"c\":[3]}")
+expect_equal(to_json(list(a = "d", b = "e", c = "f")),
+              "{\"a\":[\"d\"],\"b\":[\"e\"],\"c\":[\"f\"]}")
+
+expect_equal(to_json(list(c(1, 2), c(3, 4))), "[[1,2],[3,4]]")
+expect_equal(to_json(list(list(1, 2), list(3, 4))), "[[[1],[2]],[[3],[4]]]")
+expect_equal(to_json(list(list(a = 1, b = 2), list(c = 3, d = 4))),
+              "[{\"a\":[1],\"b\":[2]},{\"c\":[3],\"d\":[4]}]")
+
+expect_equal(to_json(list(c("e", "f"), c("g", "h"))),
+              "[[\"e\",\"f\"],[\"g\",\"h\"]]")
+expect_equal(to_json(list(list("e", "f"), list("g", "h"))),
+              "[[[\"e\"],[\"f\"]],[[\"g\"],[\"h\"]]]")
+expect_equal(to_json(list(list(a = "e", b = "f"), list(c = "g", d = "h"))),
+              "[{\"a\":[\"e\"],\"b\":[\"f\"]},{\"c\":[\"g\"],\"d\":[\"h\"]}]")
 
 # Test that the full round-trip conversion is consistent.
 expect_eq_jsonlite_full <- function(x) {

inst/tinytest/test_to_json_date.R

@@ -0,0 +1,8 @@
+object <- as.Date("1985-06-18");
+
+expect_equal(to_json(object), "[\"1985-06-18T00:00:00.000Z\"]");
+expect_equal(to_json(list(object)), "[[\"1985-06-18T00:00:00.000Z\"]]");
+expect_equal(to_json(data.frame(foo=object)),
+              "[{\"foo\":\"1985-06-18T00:00:00.000Z\"}]");
+expect_equal(to_json(list(foo=data.frame(bar=object))),
+              "{\"foo\":[{\"bar\":\"1985-06-18T00:00:00.000Z\"}]}");

inst/tinytest/test_to_json_factor.R

@@ -0,0 +1,6 @@
+factor_var <- iris$Species
+factor_var_json <- paste0("[\"", paste0(as.character(factor_var), collapse="\",\""),
+                          "\"]")
+
+expect_equal(to_json(factor_var), factor_var_json)
+expect_equal(to_json(factor_var[1], auto_unbox=TRUE), "\"setosa\"")