redo with reformed wf

Author: matthewphamilton

.Rbuildignore

@@ -28,3 +28,4 @@
 ^data-raw/safety/R/imp_mthds\.R$
 ^data-raw/safety/R/ready4-package\.R$
 ^data-raw/fns/update\.R$
+^data-raw/safety/R/fn_update\.R$

NAMESPACE

@@ -68,9 +68,9 @@ importFrom(dplyr,mutate_if)
 importFrom(dplyr,pull)
 importFrom(dplyr,select)
 importFrom(fs,path_file)
-importFrom(lifecycle,deprecate_soft)
 importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%>%")
+importFrom(methods,className)
 importFrom(methods,getSlots)
 importFrom(methods,slot)
 importFrom(piggyback,pb_list)
@@ -91,15 +91,6 @@ importFrom(purrr,pmap_int)
 importFrom(purrr,reduce)
 importFrom(purrr,walk)
 importFrom(purrr,walk2)
-importFrom(ready4,get_from_lup_obj)
-importFrom(ready4,make_prompt)
-importFrom(ready4,remove_lbls_from_df)
-importFrom(ready4,write_fls_to_dv)
-importFrom(ready4,write_new_dirs)
-importFrom(ready4,write_new_files)
-importFrom(ready4,write_tb_to_csv)
-importFrom(ready4,write_to_delete_fls)
-importFrom(ready4,write_to_publish_dv_ds)
 importFrom(rlang,exec)
 importFrom(rlang,sym)
 importFrom(stats,setNames)

R/fn_add.R

@@ -7,17 +7,13 @@
 #' @return Combined (lookup tables)
 #' @rdname add_lups
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom testit assert
 #' @importFrom dplyr filter pull bind_rows arrange
 #' @importFrom rlang sym
 #' @importFrom Hmisc label
-#' @importFrom ready4 remove_lbls_from_df
 #' @keywords internal
 add_lups <- function (template_lup, new_lup, key_var_nm_1L_chr, priority_lup_for_dupls_1L_chr = "template") 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::add_lups()", 
-        "ready4::add_lups()")
     testit::assert("Look up tables must have same column names", 
         names(template_lup) == names(new_lup))
     if (priority_lup_for_dupls_1L_chr == "template") {
@@ -31,8 +27,8 @@ add_lups <- function (template_lup, new_lup, key_var_nm_1L_chr, priority_lup_for
         labels_chr <- Hmisc::label(new_lup) %>% unname()
     }
     if (!all(labels_chr %>% unique() == "")) {
-        template_lup <- template_lup %>% ready4::remove_lbls_from_df()
-        new_lup <- new_lup %>% ready4::remove_lbls_from_df()
+        template_lup <- template_lup %>% remove_lbls_from_df()
+        new_lup <- new_lup %>% remove_lbls_from_df()
         Hmisc::label(template_lup) <- as.list(labels_chr %>% 
             unname())
         Hmisc::label(new_lup) <- as.list(labels_chr %>% unname())

R/fn_get.R

@@ -8,14 +8,11 @@
 #' @return Urls (a character vector)
 #' @rdname get_dv_fls_urls
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom dataverse dataset_files
 #' @importFrom purrr map_chr
 get_dv_fls_urls <- function (file_nms_chr, dv_ds_nm_1L_chr, dv_url_pfx_1L_chr = character(0), 
     server_1L_chr = Sys.getenv("DATAVERSE_SERVER"), key_1L_chr = NULL) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::get_dv_fls_urls()", 
-        "ready4::get_dv_fls_urls()")
     if (identical(dv_url_pfx_1L_chr, character(0))) 
         dv_url_pfx_1L_chr <- paste0("https://", server_1L_chr, 
             "/api/access/datafile/")
@@ -41,21 +38,17 @@ get_dv_fls_urls <- function (file_nms_chr, dv_ds_nm_1L_chr, dv_url_pfx_1L_chr =
 #' @return Identity (a character vector of length one)
 #' @rdname get_fl_id_from_dv_ls
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom purrr map2_chr
-#' @importFrom ready4 get_from_lup_obj
 #' @importFrom tibble as_tibble
 #' @keywords internal
 get_fl_id_from_dv_ls <- function (ds_ls, fl_nm_1L_chr, nms_chr = NA_character_) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::get_fl_id_from_dv_ls()", 
-        "ready4::get_fl_id_from_dv_ls()")
     if (is.na(nms_chr[1])) {
         nms_chr <- purrr::map2_chr(ds_ls$files$originalFileName, 
             ds_ls$files$filename, ~ifelse(is.na(.x), .y, .x))
     }
     if (fl_nm_1L_chr %in% nms_chr) {
-        id_1L_chr <- ready4::get_from_lup_obj(ds_ls$files[, names(ds_ls$files) %>% 
+        id_1L_chr <- get_from_lup_obj(ds_ls$files[, names(ds_ls$files) %>% 
             unique()] %>% tibble::as_tibble(), match_var_nm_1L_chr = ifelse(fl_nm_1L_chr %in% 
             ds_ls$files$originalFileName, "originalFileName", 
             "filename"), match_value_xx = fl_nm_1L_chr, target_var_nm_1L_chr = "id", 
@@ -72,19 +65,16 @@ get_fl_id_from_dv_ls <- function (ds_ls, fl_nm_1L_chr, nms_chr = NA_character_)
 #' @param match_value_xx Match value (an output object of multiple potential types)
 #' @param match_var_nm_1L_chr Match variable name (a character vector of length one)
 #' @param target_var_nm_1L_chr Target variable name (a character vector of length one)
-#' @param evaluate_1L_lgl Evaluate (a logical vector of length one), Default: TRUE
+#' @param evaluate_1L_lgl Evaluate (a logical vector of length one), Default: FALSE
 #' @return Return object (an output object of multiple potential types)
 #' @rdname get_from_lup_obj
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom dplyr filter select pull
 #' @importFrom rlang sym
 #' @importFrom stringr str_detect str_locate str_sub
 get_from_lup_obj <- function (data_lookup_tb, match_value_xx, match_var_nm_1L_chr, 
-    target_var_nm_1L_chr, evaluate_1L_lgl = TRUE) 
+    target_var_nm_1L_chr, evaluate_1L_lgl = FALSE) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::get_from_lup_obj()", 
-        "ready4::get_from_lup_obj()")
     return_object_ref <- data_lookup_tb %>% dplyr::filter(!!rlang::sym(match_var_nm_1L_chr) == 
         match_value_xx) %>% dplyr::select(!!target_var_nm_1L_chr) %>% 
         dplyr::pull()
@@ -126,16 +116,13 @@ get_from_lup_obj <- function (data_lookup_tb, match_value_xx, match_var_nm_1L_ch
 #' @return Slots (a character vector)
 #' @rdname get_r4_obj_slots
 #' @export 
-#' @importFrom lifecycle deprecate_soft
-#' @importFrom methods getSlots
+#' @importFrom methods className getSlots
 #' @importFrom purrr map_chr
 #' @keywords internal
 get_r4_obj_slots <- function (fn_name_1L_chr, package_1L_chr = "") 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::get_r4_obj_slots()", 
-        "ready4::get_r4_obj_slots()")
-    slots_ls <- className(fn_name_1L_chr, update_ns(package_1L_chr)) %>% 
-        methods::getSlots()
+    slots_ls <- methods::className(fn_name_1L_chr, ifelse(package_1L_chr == 
+        "", ".GlobalEnv", package_1L_chr)) %>% methods::getSlots()
     slots_chr <- purrr::map_chr(slots_ls, ~.x)
     return(slots_chr)
 }
@@ -149,14 +136,11 @@ get_r4_obj_slots <- function (fn_name_1L_chr, package_1L_chr = "")
 #' @return R object (an output object of multiple potential types)
 #' @rdname get_rds_from_dv
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom dataverse dataset_files
 #' @importFrom purrr map_chr
 get_rds_from_dv <- function (file_nm_1L_chr, dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/2Y9VF9", 
     dv_url_pfx_1L_chr = character(0), key_1L_chr = NULL, server_1L_chr = Sys.getenv("DATAVERSE_SERVER")) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::get_rds_from_dv()", 
-        "ready4::get_rds_from_dv()")
     if (identical(dv_url_pfx_1L_chr, character(0))) 
         dv_url_pfx_1L_chr <- paste0("https://", server_1L_chr, 
             "/api/access/datafile/")

R/fn_make.R

@@ -49,14 +49,11 @@ make_files_tb <- function (paths_to_dirs_chr, recode_ls, inc_fl_types_chr = NA_c
 #' @return List phrase (a character vector of length one)
 #' @rdname make_list_phrase
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom stringr str_c
 #' @importFrom stringi stri_replace_last
 #' @keywords internal
 make_list_phrase <- function (items_chr) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::make_list_phrase()", 
-        "ready4::make_list_phrase()")
     list_phrase_1L_chr <- items_chr %>% stringr::str_c(sep = "", 
         collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
         replacement = " and")
@@ -85,13 +82,9 @@ make_local_path_to_dv_data <- function (save_dir_path_1L_chr, fl_nm_1L_chr, save
 #' @return Response (a character vector of length one)
 #' @rdname make_prompt
 #' @export 
-#' @importFrom lifecycle deprecate_soft
-#' @importFrom ready4 make_prompt
 #' @keywords internal
 make_prompt <- function (prompt_1L_chr, options_chr = NULL, force_from_opts_1L_chr = F) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::make_prompt()", 
-        "ready4::make_prompt()")
     acknowledgement_1L_chr <- "This function is based on: https://debruine.github.io/posts/interactive-test/"
     con_conn <- getOption("prompt_opts.con", stdin())
     options_1L_chr <- paste(options_chr, collapse = "|")
@@ -101,8 +94,8 @@ make_prompt <- function (prompt_1L_chr, options_chr = NULL, force_from_opts_1L_c
     response_1L_chr <- readLines(con = con_conn, n = 1)
     if (!is.null(options_chr) & !response_1L_chr %in% options_chr & 
         force_from_opts_1L_chr) {
-        response_1L_chr <- ready4::make_prompt(prompt_1L_chr, 
-            options_chr, force_from_opts_1L_chr = T)
+        response_1L_chr <- make_prompt(prompt_1L_chr, options_chr, 
+            force_from_opts_1L_chr = T)
     }
     return(response_1L_chr)
 }

R/fn_remove.R

@@ -4,13 +4,10 @@
 #' @return Unlabelled data (a data.frame)
 #' @rdname remove_lbls_from_df
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom purrr reduce
 #' @keywords internal
 remove_lbls_from_df <- function (data_df) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::remove_lbls_from_df()", 
-        "ready4::remove_lbls_from_df()")
     unlabelled_data_df <- purrr::reduce(1:ncol(data_df), .init = data_df, 
         ~{
             class(.x[[.y]]) <- setdiff(class(.x[[.y]]), "labelled")

R/fn_rowbind.R

@@ -6,14 +6,11 @@
 #' @return Tibbles (a ready4 S4)
 #' @rdname rowbind_all_tbs_in_r4_obj
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom purrr reduce
 #' @importFrom methods getSlots
 #' @keywords internal
 rowbind_all_tbs_in_r4_obj <- function (tbs_r4, second_tbs_r4, r4_name_1L_chr) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::rowbind_all_tbs_in_r4_obj()", 
-        "ready4::rowbind_all_tbs_in_r4_obj()")
     tbs_r4 <- purrr::reduce(methods::getSlots(r4_name_1L_chr) %>% 
         names(), .init = tbs_r4, ~rowbind_tbs_in_r4_obj(tbs_r4 = .x, 
         slot_nm_1L_chr = .y, second_tbs_r4 = second_tbs_r4, r4_name_1L_chr = r4_name_1L_chr))
@@ -28,14 +25,11 @@ rowbind_all_tbs_in_r4_obj <- function (tbs_r4, second_tbs_r4, r4_name_1L_chr)
 #' @return Tibbles (a ready4 S4)
 #' @rdname rowbind_tbs_in_r4_obj
 #' @export 
-#' @importFrom lifecycle deprecate_soft
 #' @importFrom tibble is_tibble
 #' @importFrom methods slot
 #' @keywords internal
 rowbind_tbs_in_r4_obj <- function (tbs_r4, slot_nm_1L_chr, second_tbs_r4, r4_name_1L_chr) 
 {
-    lifecycle::deprecate_soft("0.0.0.9446", "ready4fun::rowbind_tbs_in_r4_obj()", 
-        "ready4::rowbind_tbs_in_r4_obj()")
     if (tibble::is_tibble(methods::slot(tbs_r4, slot_nm_1L_chr))) {
         slot(tbs_r4, slot_nm_1L_chr) <- rbind(methods::slot(tbs_r4, 
             slot_nm_1L_chr), methods::slot(second_tbs_r4, slot_nm_1L_chr))