More fixing of editing of authors in edit_project().

ClevelandClinicQHS · Apr 15, 2019 · 79fe721 · 79fe721
1 parent 29359ce
commit 79fe721
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 9 deletions.
diff --git a/R/edit.R b/R/edit.R
@@ -67,7 +67,10 @@ edit_project <- function(project,
   ###########################################
   # Handling of current_owner, corresp_auth, and creator
   if (is.null(current_owner)) {
-    if (any(authors$remove == project$current_owner)) {
+    if (
+      !is.na(project$current_owner) &&
+      any(authors$remove == project$current_owner)
+    ) {
       current_owner <- new_projects_author(NA)
     }
   } else if (!is.na(current_owner)) {
@@ -99,7 +102,10 @@ edit_project <- function(project,
 
 
   if (is.null(corresp_auth)) {
-    if (any(authors$remove == project$corresp_auth)) {
+    if (
+      !is.na(project$corresp_auth) &&
+      any(authors$remove == project$corresp_auth)
+    ) {
       corresp_auth <- new_projects_author(NA)
     }
   } else if (!is.na(corresp_auth)) {
@@ -119,18 +125,18 @@ edit_project <- function(project,
     # author list of the user-specified project
     if (!any(authors$add == corresp_auth)) {
       validate_assoc(
-        x           = corresp_auth,
-        what        = "author",
+        x          = corresp_auth,
+        what       = "author",
         rds_table  = authors_table,
-        what2       = "project",
+        what2      = "project",
         rds_table2 = filtered_assoc
       )
     }
   }
 
 
   if (is.null(creator)) {
-    if (any(authors$remove == project$creator)) {
+    if (!is.na(project$creator) && any(authors$remove == project$creator)) {
       creator <- new_projects_author(NA)
     }
   } else if (!is.na(creator)) {
@@ -160,7 +166,7 @@ edit_project <- function(project,
       table_path = projects_path
     )
 
-  if (length(authors$remove) > 0) {
+  if (length(authors$remove) > 0L) {
     assoc_table <-
       delete_assoc(
         assoc_table = assoc_table,

diff --git a/R/validation.R b/R/validation.R
@@ -262,14 +262,18 @@ validate_assoc <- function(x, what, rds_table, what2, rds_table2) {
 
 validate_single_string <- function(x, null.ok = FALSE, tolower = FALSE) {
 
+  user_input <- rlang::as_label(rlang::enexpr(x))
+
   if (is.null(x) && null.ok) {
     return(NULL)
   }
 
-  what <- rlang::enexpr(x)
   x    <- as.character(x)
   if (!rlang::is_scalar_character(x)) {
-    stop(what, " must be coercible to a single character string")
+    stop(
+      user_input,
+      " must be coercible to a single character string"
+    )
   }
 
   if (tolower) {