GH-33390: [R] Field-level metadata

r/R/field.R

@@ -26,7 +26,18 @@
 #' @section Methods:
 #'
 #' - `f$ToString()`: convert to a string
-#' - `f$Equals(other)`: test for equality. More naturally called as `f == other`
+#' - `f$Equals(other, check_metadata = FALSE)`: test for equality.
+#'    More naturally called as `f == other`
+#' - `f$WithMetadata(metadata)`: returns a new `Field` with the key-value
+#'    `metadata` set. Note that all list elements in `metadata` will be coerced
+#'    to `character`.
+#' - `f$RemoveMetadata()`: returns a new `Field` without metadata.
+#'
+#' @section Active bindings:
+#'
+#' - `$HasMetadata`: logical: does this `Field` have extra metadata?
+#' - `$metadata`: returns the key-value metadata as a named list, or `NULL`
+#'    if no metadata is set.
 #'
 #' @name Field
 #' @rdname Field-class
@@ -38,8 +49,15 @@ Field <- R6Class(
     ToString = function() {
       prettier_dictionary_type(Field__ToString(self))
     },
-    Equals = function(other, ...) {
-      inherits(other, "Field") && Field__Equals(self, other)
+    Equals = function(other, check_metadata = FALSE, ...) {
+      inherits(other, "Field") && Field__Equals(self, other, isTRUE(check_metadata))
+    },
+    WithMetadata = function(metadata = NULL) {
+      metadata <- prepare_key_value_metadata(metadata)
+      Field__WithMetadata(self, metadata)
+    },
+    RemoveMetadata = function() {
+      Field__RemoveMetadata(self)
     },
     export_to_c = function(ptr) ExportField(self, ptr)
   ),
@@ -52,14 +70,27 @@ Field <- R6Class(
     },
     type = function() {
       Field__type(self)
+    },
+    HasMetadata = function() {
+      Field__HasMetadata(self)
+    },
+    metadata = function() {
+      if (self$HasMetadata) {
+        as.list(Field__metadata(self))
+      } else {
+        NULL
+      }
     }
   )
 )
-Field$create <- function(name, type, metadata, nullable = TRUE) {
+Field$create <- function(name, type, metadata = NULL, nullable = TRUE) {
   assert_that(inherits(name, "character"), length(name) == 1L)
   type <- as_type(type, name)
-  assert_that(missing(metadata), msg = "metadata= is currently ignored")
-  Field__initialize(enc2utf8(name), type, nullable)
+  f <- Field__initialize(enc2utf8(name), type, nullable)
+  if (!is.null(metadata)) {
+    f <- f$WithMetadata(metadata)
+  }
+  f
 }
 #' @include arrowExports.R
 Field$import_from_c <- ImportField
@@ -68,11 +99,13 @@ Field$import_from_c <- ImportField
 #'
 #' @param name field name
 #' @param type logical type, instance of [DataType]
-#' @param metadata currently ignored
+#' @param metadata a named character vector or list to attach as field metadata.
+#'   All values will be coerced to `character`.
 #' @param nullable TRUE if field is nullable
 #'
 #' @examples
 #' field("x", int32())
+#' field("x", int32(), metadata = list(key = "value"))
 #' @rdname Field
 #' @seealso [Field]
 #' @export

r/src/field.cpp

@@ -18,6 +18,7 @@
 #include "./arrow_types.h"
 
 #include <arrow/type.h>
+#include <arrow/util/key_value_metadata.h>
 
 // [[arrow::export]]
 std::shared_ptr<arrow::Field> Field__initialize(
@@ -38,8 +39,46 @@ std::string Field__name(const std::shared_ptr<arrow::Field>& field) {
 
 // [[arrow::export]]
 bool Field__Equals(const std::shared_ptr<arrow::Field>& field,
-                   const std::shared_ptr<arrow::Field>& other) {
-  return field->Equals(other);
+                   const std::shared_ptr<arrow::Field>& other, bool check_metadata) {
+  return field->Equals(other, check_metadata);
+}
+
+// [[arrow::export]]
+bool Field__HasMetadata(const std::shared_ptr<arrow::Field>& field) {
+  return field->HasMetadata();
+}
+
+// [[arrow::export]]
+cpp11::writable::list Field__metadata(const std::shared_ptr<arrow::Field>& field) {
+  auto meta = field->metadata();
+  int64_t n = 0;
+  if (field->HasMetadata()) {
+    n = meta->size();
+  }
+  cpp11::writable::list out(n);
+  std::vector<std::string> names_out(n);
+  for (int i = 0; i < n; i++) {
+    out[i] = cpp11::as_sexp(meta->value(i));
+    names_out[i] = meta->key(i);
+  }
+  out.names() = names_out;
+  return out;
+}
+
+// [[arrow::export]]
+std::shared_ptr<arrow::Field> Field__WithMetadata(
+    const std::shared_ptr<arrow::Field>& field, cpp11::strings metadata) {
+  auto values = cpp11::as_cpp<std::vector<std::string>>(metadata);
+  auto names = cpp11::as_cpp<std::vector<std::string>>(metadata.attr("names"));
+  auto kv =
+    std::make_shared<arrow::KeyValueMetadata>(std::move(names), std::move(values));
+  return field->WithMetadata(std::move(kv));
+}
+
+// [[arrow::export]]
+std::shared_ptr<arrow::Field> Field__RemoveMetadata(
+    const std::shared_ptr<arrow::Field>& field) {
+  return field->RemoveMetadata();
 }
 
 // [[arrow::export]]

r/tests/testthat/test-field.R

@@ -63,3 +63,30 @@ test_that("Field to C-interface", {
   # must clean up the pointer or we leak
   delete_arrow_schema(ptr)
 })
+
+test_that("Field metadata", {
+  x <- field("x", int32())
+  expect_false(x$HasMetadata)
+  expect_null(x$metadata)
+
+  x_meta <- field("x", int32(), metadata = list(key = "value"))
+  expect_true(x_meta$HasMetadata)
+  expect_identical(x_meta$metadata, list(key = "value"))
+
+  x_meta2 <- x$WithMetadata(list(key = "value"))
+  expect_true(x_meta2$HasMetadata)
+  expect_identical(x_meta2$metadata, list(key = "value"))
+
+  x_no_meta <- x_meta$RemoveMetadata()
+  expect_false(x_no_meta$HasMetadata)
+  expect_null(x_no_meta$metadata)
+})
+
+test_that("Field$Equals with check_metadata", {
+  x <- field("x", int32())
+  x_meta <- field("x", int32(), metadata = list(key = "value"))
+
+  expect_true(x$Equals(x_meta))
+  expect_false(x$Equals(x_meta, check_metadata = TRUE))
+  expect_true(x == x_meta)
+})