Merge pull request #785 from DyfanJones/transpose_list

Transpose list
paws-r · May 15, 2024 · 44a320c · 44a320c
2 parents d28c3e7 + 9470f3f
commit 44a320c
Show file tree

Hide file tree

Showing 5 changed files with 31 additions and 4 deletions.
diff --git a/paws.common/DESCRIPTION b/paws.common/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: paws.common
 Type: Package
 Title: Paws Low-Level Amazon Web Services API
-Version: 0.7.2
+Version: 0.7.3
 Authors@R: c(
         person("David", "Kretch", email = "david.kretch@gmail.com", role = "aut"),
         person("Adam", "Banker", email = "adam.banker39@gmail.com", role = "aut"),

diff --git a/paws.common/NEWS.md b/paws.common/NEWS.md
@@ -1,3 +1,6 @@
+# paws.common 0.7.3
+* fix `xml_parse` to correctly parse empty elements (#783) thanks to @stevepowell99 for raising issue
+
 # paws.common 0.7.2
 * improve performance of `restxml_unmarshal` by x3
 * fix `rest_unmarshal_location_elements` only skip header if location is not found (#761)

diff --git a/paws.common/R/xmlutil.R b/paws.common/R/xmlutil.R
@@ -289,7 +289,7 @@ xml_parse_structure <- function(xml_elts, interface_i, tags_i, tag_type = NULL,
   # the `is.list()` check is necessary because e.g. `CheckSumAlgorithm` has
   # a list interface though it isn't a list?!
   if (isTRUE(flattened) && is.list(result)) {
-    result <- .mapply(list, result, NULL)
+    result <- transpose(result)
   } else {
     result <- as.list(result)
   }
@@ -358,7 +358,7 @@ xml_parse_list <- function(xml_elts, interface_i, tags_i, tag_type = NULL, flatt
   # the `is.list()` check is necessary because e.g. `CheckSumAlgorithm` has
   # a list interface though it isn't a list?!
   if (isTRUE(flattened) && is.list(result)) {
-    result <- .mapply(list, result, NULL)
+    result <- transpose(result)
   }
 
   return(result)
@@ -460,3 +460,10 @@ default_parse_scalar <- function(interface_i, tag_type = NULL) {
   )
   return(result)
 }
+
+transpose <- function(x) {
+  if (any(found <- lengths(x) == 0)) {
+    x[found] <- list(rep(list(), length.out = length(x[[1]])))
+  }
+  .mapply(list, x, NULL)
+}
diff --git a/paws.common/cran-comments.md b/paws.common/cran-comments.md
@@ -1,5 +1,5 @@
 ## Submission
-This release contains bug fixes and minor performance enhancements
+This release contains a hotfix.
 
 ## Test environments
 

diff --git a/paws.common/tests/testthat/test_xmlutil.R b/paws.common/tests/testthat/test_xmlutil.R
@@ -70,3 +70,20 @@ test_that("check nested xml build with nested default parameters", {
   actual <- xml_build(params_nested)
   expect_equal(actual, list(nested = list(cho = list(""))))
 })
+
+test_that("check if list is transposed correctly", {
+  obj <- list(
+    var1 = c(1, 2, 3),
+    var2 = letters[1:3],
+    var3 = list(),
+    var4 = list()
+  )
+  expected <- list(
+    list(var1 = 1, var2 = "a", var3 = NULL, var4 = NULL),
+    list(var1 = 2, var2 = "b", var3 = NULL, var4 = NULL),
+    list(var1 = 3, var2 = "c", var3 = NULL, var4 = NULL)
+  )
+  actual <- transpose(obj)
+
+  expect_equal(actual, expected)
+})