feat(r/sedonadb): add CRS printing for sedonadb_dataframe

r/sedonadb/R/crs.R

@@ -0,0 +1,27 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+#' Parse CRS from GeoArrow metadata
+#'
+#' @param crs_json A JSON string representing the CRS (PROJJSON or authority code)
+#' @returns A list with components: authority_code (e.g., "EPSG:5070"), srid (integer),
+#'   name (character string with a human-readable CRS name), and proj_string (character
+#'   string with the PROJ representation of the CRS).
+#' @keywords internal
+sd_parse_crs <- function(crs_json) {
+  parse_crs_metadata(crs_json)
+}

r/sedonadb/R/dataframe.R

@@ -316,6 +316,54 @@ as_nanoarrow_array_stream.sedonadb_dataframe <- function(x, ..., schema = NULL)
 
 #' @export
 print.sedonadb_dataframe <- function(x, ..., width = NULL, n = NULL) {
+  # Print class header
+  schema <- nanoarrow::infer_nanoarrow_schema(x)
+  ncols <- length(schema$children)
+
+  cat(sprintf("# A sedonadb_dataframe: ? x %d\n", ncols))
+
+  # Print geometry column info
+  # we just use sd_parse_crs() to extract CRS info from ARROW:extension:metadata
+  geo_col_info <- character()
+  for (col_name in names(schema$children)) {
+    child <- schema$children[[col_name]]
+    ext_name <- child$metadata[["ARROW:extension:name"]]
+    if (!is.null(ext_name) && grepl("^geoarrow\\.", ext_name)) {
+      ext_meta <- child$metadata[["ARROW:extension:metadata"]]
+      crs_info <- ""
+      if (!is.null(ext_meta)) {
+        parsed <- tryCatch(
+          sd_parse_crs(ext_meta),
+          error = function(e) NULL
+        )
+        if (is.null(parsed)) {
+          crs_info <- " (CRS: parsing error)"
+        } else if (!is.null(parsed$authority_code)) {
+          crs_info <- sprintf(" (CRS: %s)", parsed$authority_code)
+        } else if (!is.null(parsed$srid)) {
+          crs_info <- sprintf(" (CRS: EPSG:%d)", parsed$srid)
+        } else if (!is.null(parsed$name)) {
+          crs_info <- sprintf(" (CRS: %s)", parsed$name)
+        } else {
+          crs_info <- " (CRS: available)"
+        }
+      }
+      geo_col_info <- c(geo_col_info, sprintf("%s%s", col_name, crs_info))
+    }
+  }
+
+  if (length(geo_col_info) > 0) {
+    if (is.null(width)) {
+      width <- getOption("width")
+    }
+
+    geo_line <- sprintf("# Geometry: %s", paste(geo_col_info, collapse = ", "))
+    if (nchar(geo_line) > width) {
+      geo_line <- paste0(substr(geo_line, 1, width - 3), "...")
+    }
+    cat(paste0(geo_line, "\n"))
+  }
+
   if (isTRUE(getOption("sedonadb.interactive", TRUE))) {
     sd_preview(x, n = n, width = width)
   } else {

r/sedonadb/src/rust/Cargo.toml

@@ -39,5 +39,6 @@ sedona-expr = { workspace = true }
 sedona-geoparquet = { workspace = true }
 sedona-proj = { workspace = true }
 sedona-schema = { workspace = true }
+serde_json = { workspace = true }
 thiserror = { workspace = true }
 tokio = { workspace = true }

r/sedonadb/src/rust/src/lib.rs

@@ -66,3 +66,57 @@ fn configure_proj_shared(
     configure_global_proj_engine(builder)?;
     Ok(())
 }
+
+#[savvy]
+fn parse_crs_metadata(crs_json: &str) -> savvy::Result<savvy::Sexp> {
+    use sedona_schema::crs::deserialize_crs_from_obj;
+
+    // The input is GeoArrow extension metadata, which is a JSON object like:
+    // {"crs": <PROJJSON or string>}
+    // We need to extract the "crs" field first.
+    let metadata: serde_json::Value = serde_json::from_str(crs_json)
+        .map_err(|e| savvy::Error::new(format!("Failed to parse metadata JSON: {e}")))?;
+
+    let crs_value = metadata.get("crs");
+    if crs_value.is_none() || crs_value.unwrap().is_null() {
+        return Ok(savvy::NullSexp.into());
+    }
+
+    let crs = deserialize_crs_from_obj(crs_value.unwrap())?;
+    match crs {
+        Some(crs_obj) => {
+            let auth_code = crs_obj.to_authority_code().ok().flatten();
+            let srid = crs_obj.srid().ok().flatten();
+            let name = crs_value.unwrap().get("name").and_then(|v| v.as_str());
+            let proj_string = crs_obj.to_crs_string();
+
+            let mut out = savvy::OwnedListSexp::new(4, true)?;
+            out.set_name(0, "authority_code")?;
+            out.set_name(1, "srid")?;
+            out.set_name(2, "name")?;
+            out.set_name(3, "proj_string")?;
+
+            if let Some(auth_code) = auth_code {
+                out.set_value(0, savvy::Sexp::try_from(auth_code.as_str())?)?;
+            } else {
+                out.set_value(0, savvy::NullSexp)?;
+            }
+
+            if let Some(srid) = srid {
+                out.set_value(1, savvy::Sexp::try_from(srid as i32)?)?;
+            } else {
+                out.set_value(1, savvy::NullSexp)?;
+            }
+
+            if let Some(name) = name {
+                out.set_value(2, savvy::Sexp::try_from(name)?)?;
+            } else {
+                out.set_value(2, savvy::NullSexp)?;
+            }
+            out.set_value(3, savvy::Sexp::try_from(proj_string.as_str())?)?;
+
+            Ok(out.into())
+        }
+        None => Ok(savvy::NullSexp.into()),
+    }
+}

r/sedonadb/tests/testthat/test-crs.R

@@ -0,0 +1,145 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+test_that("sd_parse_crs works for GeoArrow metadata with EPSG", {
+  meta <- '{"crs": {"id": {"authority": "EPSG", "code": 5070}, "name": "NAD83 / Conus Albers"}}'
+  parsed <- sedonadb:::sd_parse_crs(meta)
+  expect_identical(parsed$authority_code, "EPSG:5070")
+  expect_identical(parsed$srid, 5070L)
+  expect_identical(parsed$name, "NAD83 / Conus Albers")
+  # The proj_string is the *unwrapped* and *minified* PROJJSON content
+  expect_match(parsed$proj_string, '"authority":"EPSG"', fixed = TRUE)
+  expect_match(parsed$proj_string, '"code":5070', fixed = TRUE)
+})
+
+test_that("sd_parse_crs works for Engineering CRS (no EPSG ID)", {
+  # A realistic example of a local engineering CRS that wouldn't have an EPSG code
+  meta <- '{
+    "crs": {
+      "type": "EngineeringCRS",
+      "name": "Construction Site Local Grid",
+      "datum": {
+        "type": "EngineeringDatum",
+        "name": "Local Datum"
+      },
+      "coordinate_system": {
+        "subtype": "Cartesian",
+        "axis": [
+          {"name": "Northing", "abbreviation": "N", "direction": "north", "unit": "metre"},
+          {"name": "Easting", "abbreviation": "E", "direction": "east", "unit": "metre"}
+        ]
+      }
+    }
+  }'
+  parsed <- sedonadb:::sd_parse_crs(meta)
+  expect_null(parsed$authority_code)
+  expect_null(parsed$srid)
+  expect_identical(parsed$name, "Construction Site Local Grid")
+  expect_true(!is.null(parsed$proj_string))
+})
+
+test_that("sd_parse_crs returns NULL if crs field is missing", {
+  expect_null(sedonadb:::sd_parse_crs('{"something_else": 123}'))
+  expect_null(sedonadb:::sd_parse_crs('{}'))
+})
+
+test_that("sd_parse_crs handles invalid JSON gracefully", {
+  expect_error(
+    sedonadb:::sd_parse_crs('invalid json'),
+    "Failed to parse metadata JSON"
+  )
+})
+
+test_that("sd_parse_crs works with plain strings if that's what's in 'crs'", {
+  meta <- '{"crs": "EPSG:4326"}'
+  parsed <- sedonadb:::sd_parse_crs(meta)
+  # Note: PROJ/sedona normalizes EPSG:4326 (lat/lon) to OGC:CRS84 (lon/lat)
+  # for consistent axis order in WKT/GeoJSON contexts.
+  expect_identical(parsed$authority_code, "OGC:CRS84")
+  expect_identical(parsed$srid, 4326L)
+  expect_true(!is.null(parsed$proj_string))
+})
+
+# Tests for CRS display in print.sedonadb_dataframe (lines 325-360 of dataframe.R)
+
+test_that("print.sedonadb_dataframe shows CRS info for geometry column with EPSG", {
+  df <- sd_sql("SELECT ST_SetSRID(ST_Point(1, 2), 4326) as geom")
+  output <- capture.output(print(df, n = 0))
+
+  # Check that the Geometry line is present
+
+  geo_line <- grep("^# Geometry:", output, value = TRUE)
+  expect_length(geo_line, 1)
+
+  # Should show CRS information (OGC:CRS84 or EPSG:4326)
+  expect_match(geo_line, "geom .*(CRS: OGC:CRS84|CRS: EPSG:4326)")
+})
+
+test_that("print.sedonadb_dataframe shows CRS info with different SRID", {
+  df <- sd_sql("SELECT ST_SetSRID(ST_Point(1, 2), 5070) as geom")
+  output <- capture.output(print(df, n = 0))
+
+  geo_line <- grep("^# Geometry:", output, value = TRUE)
+  expect_length(geo_line, 1)
+  expect_match(geo_line, "geom .*(CRS: EPSG:5070|CRS:.*5070)")
+})
+
+test_that("print.sedonadb_dataframe shows multiple geometry columns with CRS", {
+  df <- sd_sql(
+    "
+    SELECT
+      ST_SetSRID(ST_Point(1, 2), 4326) as geom1,
+      ST_SetSRID(ST_Point(3, 4), 5070) as geom2
+  "
+  )
+  output <- capture.output(print(df, n = 0))
+
+  geo_line <- grep("^# Geometry:", output, value = TRUE)
+  expect_length(geo_line, 1)
+  # Should contain both geometry columns
+  expect_match(geo_line, "geom1")
+  expect_match(geo_line, "geom2")
+})
+
+test_that("print.sedonadb_dataframe handles geometry without explicit CRS", {
+  # ST_Point without ST_SetSRID may not have CRS metadata
+  df <- sd_sql("SELECT ST_Point(1, 2) as geom")
+  output <- capture.output(print(df, n = 0))
+
+  # May or may not have a Geometry line depending on extension metadata
+  # At least it should not error
+  expect_true(any(grepl("sedonadb_dataframe", output)))
+})
+
+test_that("print.sedonadb_dataframe respects width parameter for geometry line", {
+  df <- sd_sql(
+    "
+    SELECT
+      ST_SetSRID(ST_Point(1, 2), 4326) as very_long_geometry_column_name_1,
+      ST_SetSRID(ST_Point(3, 4), 4326) as very_long_geometry_column_name_2
+  "
+  )
+  # Use a narrow width to trigger truncation
+  output <- capture.output(print(df, n = 0, width = 60))
+
+  geo_line <- grep("^# Geometry:", output, value = TRUE)
+  if (length(geo_line) > 0) {
+    # Line should be truncated with "..."
+    expect_lte(nchar(geo_line), 60)
+    expect_match(geo_line, "\\.\\.\\.$")
+  }
+})