Put errors into list since there may be more than 1

Fixes #66

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: salesforcer
 Title: An Implementation of 'Salesforce' APIs Using Tidy Principles
-Version: 0.2.0.9001
-Date: 2020-07-22
+Version: 0.2.0.9002
+Date: 2020-07-26
 Description: Functions connecting to the 'Salesforce' Platform APIs (REST, SOAP, 
     Bulk 1.0, Bulk 2.0, Metadata, Reports and Dashboards) 
     <https://trailhead.salesforce.com/en/content/learn/modules/api_basics/api_basics_overview>. 

NAMESPACE

@@ -250,6 +250,8 @@ export(sf_write_csv)
 export(simplify_report_metadata)
 export(stop_w_errors_listed)
 export(token_available)
+export(unbox_list_elements)
+export(unbox_list_elements_recursively)
 export(unnest_col)
 export(valid_metadata_list)
 export(validate_get_all_jobs_params)
@@ -333,6 +335,7 @@ importFrom(mime,guess_type)
 importFrom(purrr,as_mapper)
 importFrom(purrr,compact)
 importFrom(purrr,discard)
+importFrom(purrr,list_modify)
 importFrom(purrr,map)
 importFrom(purrr,map_chr)
 importFrom(purrr,map_depth)
@@ -370,10 +373,8 @@ importFrom(xml2,url_escape)
 importFrom(xml2,xml_add_child)
 importFrom(xml2,xml_add_sibling)
 importFrom(xml2,xml_child)
-importFrom(xml2,xml_children)
 importFrom(xml2,xml_find_all)
 importFrom(xml2,xml_find_first)
-importFrom(xml2,xml_name)
 importFrom(xml2,xml_new_document)
 importFrom(xml2,xml_ns_strip)
 importFrom(xml2,xml_remove)

R/utils-query.R

@@ -5,14 +5,25 @@
 #' each record represents a row in the data frame.
 #' 
 #' @importFrom tibble as_tibble_row
+#' @importFrom purrr list_modify pluck
 #' @importFrom rlist list.flatten
 #' @param x \code{list}; a list to be extracted into a \code{tbl_df}.
 #' @return \code{tbl_df} parsed from the flattened list.
 #' @note This function is meant to be used internally. Only use when debugging.
 #' @keywords internal
 #' @export
 flatten_tbl_df <- function(x){
-  x %>% list.flatten() %>% as_tibble_row()
+  errors <- x %>% pluck("errors")
+  x_tbl <- x %>% 
+    list_modify("errors" = NULL) %>% 
+    list.flatten() %>% 
+    as_tibble_row()
+
+  if(!is.null(errors)){
+    x_tbl$errors <- list(errors) 
+  }
+
+  return(x_tbl)
 }
 
 #' Flatten list column
@@ -122,6 +133,46 @@ set_null_elements_to_na_recursively <- function(x) {
     set_null_elements_to_na()
 }
 
+#' Unlist all list elements of length 1 if they are not a list
+#' 
+#' This function wraps a simple \code{\link[purrr:modify]{modify_if}} function 
+#' to "unbox" list elements. This is helpful when the \code{\link[xml2]{as_list}} 
+#' returns elements of XML and the element value is kept as a list of length 1,
+#' even though it could be a single primitive data type (e.g. \code{logical},
+#' \code{character}, etc.).
+#' 
+#' @importFrom purrr modify_if
+#' @param x \code{list}; a list to be cleaned.
+#' @return \code{list} containing \code{NA} in place of \code{NULL} element values.
+#' @note This function is meant to be used internally. Only use when debugging.
+#' @keywords internal
+#' @export
+unbox_list_elements <- function(x){
+  x %>% 
+    modify_if(~((length(.x) == 1) && (!is.list(.x[[1]]))), 
+              .f = function(x){return(unlist(x))})  
+}
+
+#' Recursively unlist all list elements of length 1 if they are not a list
+#' 
+#' This function wraps a simple \code{\link[purrr:modify]{modify_if}} function 
+#' to recursively "unbox" list elements. This is helpful when the 
+#' \code{\link[xml2]{as_list}} returns elements of XML and the element value is 
+#' kept as a list of length 1, even though it could be a single primitive data 
+#' type (e.g. \code{logical}, \code{character}, etc.).
+#' 
+#' @importFrom purrr map_if
+#' @param x \code{list}; a list to be cleaned.
+#' @return \code{list} containing "unboxed" list elements.
+#' @note This function is meant to be used internally. Only use when debugging.
+#' @keywords internal
+#' @export
+unbox_list_elements_recursively <- function(x) {
+  x %>%
+    map_if(is.list, unbox_list_elements_recursively) %>% 
+    unbox_list_elements()
+}
+
 #' Remove Salesforce attributes data from list
 #' 
 #' This function removes elements from Salesforce data parsed to a list where 
@@ -257,10 +308,10 @@ xml_drop_and_unlist_recursively <- function(x) {
 #' This function accepts an \code{xml_node} assuming it already represents one 
 #' record and formats that node into a single row \code{tbl_df}.
 #' 
-#' @importFrom dplyr mutate_all as_tibble
+#' @importFrom dplyr tibble
 #' @importFrom tibble as_tibble_row
-#' @importFrom xml2 xml_find_all xml_text as_list xml_find_first xml_children xml_name xml_remove
-#' @importFrom purrr modify_if map_df
+#' @importFrom xml2 xml_find_all as_list xml_remove xml_find_first xml_text
+#' @importFrom purrr map
 #' @param node \code{xml_node}; the node to have records extracted into one row \code{tbl_df}.
 #' @param object_name_append \code{logical}; whether to include the object type
 #' (e.g. Account or Contact) as part of the column names (e.g. Account.Name).
@@ -277,15 +328,18 @@ extract_records_from_xml_node <- function(node,
   # TODO: Consider doing something with the duplicate match data because what is returned
   # in the duplicateResult element is very detailed. For now just remove it
   # if(length(xml_find_all(node, "//errors[@xsi:type='DuplicateError']")) > 0){
-  if(length(xml_find_first(node, "//errors | //error")) > 0){
-    children <- xml_find_first(node, "//errors | //error") %>% xml_children()
-    for(i in 1:length(children)){
-      if(!(xml_name(children[[i]]) %in% c("message", "statusCode", 
-                                          "errorMessage", "errorCode"))){
-        node_to_remove <- children[[i]]
-        xml_remove(node_to_remove)
-      }
-    }
+  error_nodes <- xml_find_all(node, ".//errors | .//error")
+  if(length(error_nodes) > 0){
+    errors_list <- error_nodes %>% 
+      # convert to list
+      as_list() %>%
+      # "unbox" length 1 list elements
+      map(unbox_list_elements_recursively) %>%
+      # return as a length 1 list, which is what the row requires (a single element)
+      list()
+    xml_remove(error_nodes)
+  } else {
+    errors_list <- list()
   }
 
   if(object_name_append | object_name_as_col){
@@ -308,6 +362,11 @@ extract_records_from_xml_node <- function(node,
   } else {
     x <- tibble()
   }
+
+  if(length(errors_list) == 1){
+    x$errors <- errors_list
+  }
+
   return(x)
 }
 

tests/testthat/test-rest.R

@@ -15,6 +15,33 @@ test_that("testing REST API Functionality", {
   expect_equal(nrow(created_records), n)
   expect_is(created_records$success, "logical")
 
+  # sf_create error ------------------------------------------------------------
+  new_campaign_members <- tibble(CampaignId = "",
+                                 ContactId = "0036A000002C6MbQAK")
+  created_records <- sf_create(new_campaign_members, 
+                               object_name = "CampaignMember", 
+                               api_type="REST")
+  expect_is(created_records, "tbl_df")
+  expect_equal(names(created_records), c("success", "errors"))
+  expect_equal(nrow(created_records), 1)
+  expect_is(created_records$errors, "list")
+  expect_equal(length(created_records$errors[1][[1]]), 2)
+  expect_equal(names(created_records$errors[1][[1]][[1]]), 
+               c("statusCode", "message", "fields"))
+
+  new_campaign_members <- tibble(CampaignId = "7013s000000j6n1AAA",
+                                 ContactId = "0036A000002C6MbQAK")
+  created_records <- sf_create(new_campaign_members, 
+                               object_name = "CampaignMember", 
+                               api_type="REST")
+  expect_is(created_records, "tbl_df")
+  expect_equal(names(created_records), c("success", "errors"))
+  expect_equal(nrow(created_records), 1)
+  expect_is(created_records$errors, "list")   
+  expect_equal(length(created_records$errors[1][[1]]), 1)
+  expect_equal(names(created_records$errors[1][[1]][[1]]), 
+               c("statusCode", "message", "fields"))
+
   # sf_retrieve ----------------------------------------------------------------  
   retrieved_records <- sf_retrieve(ids = created_records$id, 
                                    fields = c("FirstName", "LastName"), 

tests/testthat/test-soap.R

@@ -15,6 +15,33 @@ test_that("testing SOAP API Functionality", {
   expect_equal(nrow(created_records), n)
   expect_is(created_records$success, "logical")
 
+  # sf_create error ------------------------------------------------------------
+  new_campaign_members <- tibble(CampaignId = "",
+                                 ContactId = "0036A000002C6MbQAK")
+  created_records <- sf_create(new_campaign_members, 
+                               object_name = "CampaignMember", 
+                               api_type="SOAP")
+  expect_is(created_records, "tbl_df")
+  expect_equal(names(created_records), c("success", "errors"))
+  expect_equal(nrow(created_records), 1)
+  expect_is(created_records$errors, "list")
+  expect_equal(length(created_records$errors[1][[1]]), 2)
+  expect_equal(names(created_records$errors[1][[1]][[1]]), 
+               c("message", "statusCode"))
+
+  new_campaign_members <- tibble(CampaignId = "7013s000000j6n1AAA",
+                                 ContactId = "0036A000002C6MbQAK")
+  created_records <- sf_create(new_campaign_members, 
+                               object_name = "CampaignMember", 
+                               api_type="SOAP")
+  expect_is(created_records, "tbl_df")
+  expect_equal(names(created_records), c("success", "errors"))
+  expect_equal(nrow(created_records), 1)
+  expect_is(created_records$errors, "list")   
+  expect_equal(length(created_records$errors[1][[1]]), 1)
+  expect_equal(names(created_records$errors[1][[1]][[1]]), 
+               c("message", "statusCode"))  
+
   # sf_retrieve ----------------------------------------------------------------
   retrieved_records <- sf_retrieve(ids = created_records$id,
                                    fields = c("FirstName", "LastName"),