GH-33390: [R] Field-level metadata (#49631)

### Rationale for this change
- `field()` in R unlike Python does not support field-level metadata.

### What changes are included in this PR?
- New active bindings on `Field`: `$HasMetadata`, `$metadata`
- New methods on Field: `$WithMetadata()`, `$RemoveMetadata()`
- New `check_metadata` parameter in `Field$Equals()`, defaulting to FALSE
- Tests for the above

### Are these changes tested?
- Yes, unit tests have been added, the functionality was also tested locally in R

### Are there any user-facing changes?
- Yes, metadata= now works without throwing an error. 
- No breaking changes, since this was already included but errored before and parameter order was not changed in the implementation.

* GitHub Issue: #33390

Lead-authored-by: Max Romagnoli <massimiliano.romagnoli02@gmail.com>
Co-authored-by: Nic Crane <thisisnic@gmail.com>
Signed-off-by: Nic Crane <thisisnic@gmail.com>

Author: max-romagnoli

r/R/arrowExports.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/R/field.R

@@ -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/src/arrowExports.cpp

@@ -63,3 +63,58 @@ 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)
+})
+
+test_that("Field WithMetadata(NULL) removes metadata", {
+  x <- field("x", int32(), metadata = list(key = "value"))
+  x_empty <- x$WithMetadata(NULL)
+  expect_false(x_empty$HasMetadata)
+  expect_null(x_empty$metadata)
+})
+
+test_that("Field metadata IPC roundtrip", {
+  x <- field("x", int32(), metadata = list(key = "value"))
+  tab <- Table$create(x = 1L, schema = schema(x))
+  bytes <- write_to_raw(tab)
+  roundtripped <- read_ipc_stream(bytes, as_data_frame = FALSE)
+  expect_true(roundtripped$schema$GetFieldByName("x")$Equals(x, check_metadata = TRUE))
+})
+
+test_that("Field metadata with duplicate keys", {
+  x <- field("x", int32(), metadata = list(a = "1", a = "2"))
+  expect_true(x$HasMetadata)
+  expect_length(x$metadata, 2)
+  expect_equal(x$metadata, list(a = "1", a = "2"))
+})
+
+test_that("Field metadata on nested struct child fields", {
+  inner <- field("y", int32(), metadata = list(inner_key = "inner_value"))
+  outer <- field("outer", struct__(list(inner)))
+  expect_true(outer$type$GetFieldByName("y")$Equals(inner, check_metadata = TRUE))
+})