propagate geodesicness of input for filters (#193)

paleolimbot · Aug 25, 2023 · 27cb7e8 · 27cb7e8
1 parent 97be741
commit 27cb7e8
Show file tree

Hide file tree

Showing 6 changed files with 36 additions and 4 deletions.
diff --git a/R/filter.R b/R/filter.R
@@ -14,7 +14,8 @@
 wk_identity <- function(handleable, ...) {
   result <- wk_handle(handleable, wk_identity_filter(wk_writer(handleable)), ...)
   result <- wk_restore(handleable, result, ...)
-  wk_set_crs(result, wk_crs(handleable))
+  result <- wk_set_crs(result, wk_crs(handleable))
+  wk_set_geodesic(result, wk_is_geodesic(handleable))
 }
 
 #' @rdname wk_identity

diff --git a/R/flatten.R b/R/flatten.R
@@ -33,7 +33,8 @@ wk_flatten <- function(handleable, ..., max_depth = 1) {
     result <- wk_restore(handleable, result, ...)
   }
 
-  wk_set_crs(result, wk_crs(handleable))
+  result <- wk_set_crs(result, wk_crs(handleable))
+  wk_set_geodesic(result, wk_is_geodesic(handleable))
 }
 
 #' @rdname wk_flatten

diff --git a/R/make.R b/R/make.R
@@ -66,7 +66,9 @@ wk_collection <- function(handleable, geometry_type = wk_geometry_type("geometry
     ),
     ...
   )
-  wk_set_crs(result, wk_crs(handleable))
+
+  result <- wk_set_crs(result, wk_crs(handleable))
+  wk_set_geodesic(result, wk_is_geodesic(handleable))
 }
 
 #' @rdname wk_linestring

diff --git a/tests/testthat/test-filter.R b/tests/testthat/test-filter.R
@@ -10,3 +10,12 @@ test_that("wk_identity() works", {
 
   expect_error(wk_identity(new_wk_wkt("NOT WKT")), "Expected")
 })
+
+test_that("wk_identity() propagates attributes", {
+  expect_identical(
+    wk_identity(
+      wkt("LINESTRING ZM (0 0 0 0, 1 0 0 0)", crs = 1234, geodesic = TRUE)
+    ),
+    wkt("LINESTRING ZM (0 0 0 0, 1 0 0 0)", crs = 1234, geodesic = TRUE)
+  )
+})
diff --git a/tests/testthat/test-flatten.R b/tests/testthat/test-flatten.R
@@ -23,6 +23,15 @@ test_that("wk_flatten() works", {
   expect_identical(xy_copy, c(xy(1:1025, 1), xy(0, 0)))
 })
 
+test_that("wk_flatten() propagates attributes", {
+  expect_identical(
+    wk_flatten(
+      wkt("LINESTRING ZM (0 0 0 0, 1 0 0 0)", crs = 1234, geodesic = TRUE)
+    ),
+    wkt("LINESTRING ZM (0 0 0 0, 1 0 0 0)", crs = 1234, geodesic = TRUE)
+  )
+})
+
 test_that("wk_flatten() works for polygons", {
   expect_identical(
     wk_flatten(wkt("POLYGON ((0 0, 0 1, 1 0, 0 0))")),

diff --git a/tests/testthat/test-make.R b/tests/testthat/test-make.R
@@ -283,6 +283,16 @@ test_that("wk_collection() works", {
   expect_error(wk_collection(new_wk_wkt("POINT ENTPY")), "EMPTY")
 })
 
+test_that("wk_collection() propagates attributes", {
+  expect_identical(
+    wk_collection(
+      wkt("LINESTRING ZM (0 0 0 0, 1 0 0 0)", crs = 1234, geodesic = TRUE),
+      wk_geometry_type("multilinestring")
+    ),
+    wkt("MULTILINESTRING ZM ((0 0 0 0, 1 0 0 0))", crs = 1234, geodesic = TRUE)
+  )
+})
+
 test_that("wk_collection_filter() errors for handlers that return WK_ABORT_FEATURE", {
   expect_error(
     wk_handle(wkt("POINT (0 1)"), wk_collection_filter(wk_meta_handler())),
@@ -292,7 +302,7 @@ test_that("wk_collection_filter() errors for handlers that return WK_ABORT_FEATU
 
 test_that("wk_collection() works with sfc", {
   skip_if_not_installed("sf")
-  
+
   points_xy <- xy(1:64, 1:64)
   points_sfc <- wk_handle(
     points_xy,