cleaned up shim system

Author: beanumber

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: fertile
 Title: Creating Optimal Conditions for Reproducibility
-Version: 1.1.9000
+Version: 1.1.9001
 Authors@R: c(
   person("Benjamin S.", "Baumer", email = "ben.baumer@gmail.com", role = c("aut"), 
            comment = c(ORCID = "0000-0002-3279-0516")),

NAMESPACE

@@ -2,6 +2,7 @@
 
 S3method(print,fertile)
 S3method(print,fertile_check)
+export(active_shims)
 export(add_all_possible_shims)
 export(add_shim)
 export(char_or_sym)
@@ -16,9 +17,7 @@ export(check_path_is_portable_shim)
 export(check_path_safe)
 export(check_path_shim)
 export(danger)
-export(disable_added_shims)
-export(edit_added_shims)
-export(enable_added_shims)
+export(edit_shims)
 export(find_all_shimmable_functions)
 export(find_pkg_shimmable_functions)
 export(find_pkgs_rec)
@@ -55,12 +54,14 @@ export(is_text_file)
 export(library)
 export(list_checks)
 export(load)
+export(load_shims)
 export(log_clear)
 export(log_push)
 export(log_report)
 export(log_touch)
 export(make_check)
 export(path_log)
+export(path_shims)
 export(print_one_check)
 export(proj_analyze)
 export(proj_analyze_files)
@@ -122,6 +123,7 @@ export(source)
 export(takes_path_arg)
 export(tbl)
 export(to_execute)
+export(unload_shims)
 export(write.csv)
 export(write_csv)
 import(fs)

R/fertile.R

@@ -955,61 +955,53 @@ add_shim <- function(func, package = "", path_arg = "") {
   func_lines <- get_shim_code(func, package, path_arg)
 
   # Write code to .Rprofile
-  path_shims <- file.path(Sys.getenv("HOME"), "fertile_shims.R")
+  shims <- path_shims()
 
-  cat("", file = path_shims, sep = "\n", append = TRUE)
+  cat("", file = shims, sep = "\n", append = TRUE)
 
   for (line in func_lines) {
-    cat(line, file = path_shims, sep = "\n", append = TRUE)
+    cat(line, file = shims, sep = "\n", append = TRUE)
   }
 
   # Execute file to make sure new shim is in environment
-  base::source(path_shims)
+  base::source(shims)
 
   msg("Shim created")
 }
 
 #' View/edit list of user created shims.
+#' @rdname add_shim
 #' @export
 
-edit_added_shims <- function() {
-  path_shims <- read_shims()
+edit_shims <- function() {
+  shims <- path_shims()
 
   msg("Viewing list of user-added shims")
 
   # Open Rprofile in editing window
-  utils::file.edit(path_shims)
+  utils::file.edit(shims)
 }
 
 #' Remove all user-added shims from the global environment
+#' @rdname add_shim
 #' @export
 
-disable_added_shims <- function() {
-  path_shims <- read_shims()
-
-  # Get names of functions from inside the shims file
-  file_parsed <- parse(path_shims)
-  functions <- Filter(is_function, file_parsed)
-  function_names <- unlist(Map(function_name, functions))
-
+unload_shims <- function() {
   # Remove them from the global environment
-  rm(list = function_names, envir = .GlobalEnv)
+  rm(list = active_shims(), envir = .GlobalEnv)
 }
 
-
-
-
-#' Remove all user-added shims from the global environment
+#' @rdname add_shim
 #' @export
 
-enable_added_shims <- function() {
-  path_shims <- read_shims()
-
-  base::source(path_shims)
+load_shims <- function() {
+  shims <- path_shims()
+  base::source(shims)
 }
 
 
 #' Write shims for all possible shimmable functions
+#' @rdname add_shim
 #' @export
 
 add_all_possible_shims <- function() {
@@ -1075,25 +1067,9 @@ add_all_possible_shims <- function() {
   )
 
   # List of functions already shimmed by the user
-
-  path_shims <- read_shims()
-
-  # Get names of functions from inside the shims file
-  file_code <- readLines(path_shims)
-  indices <- grep("fertile::log_push", file_code)
-
-  lines <- file_code[indices]
-
-
-  user_shims <- c()
-  for (line in lines) {
-    indices_apostrophe <- gregexpr("'", line)[[1]][1:2]
-    user_shim <- substr(line, indices_apostrophe[1] + 1, indices_apostrophe[2] - 1)
-    user_shims <- user_shims %>% append(user_shim)
-  }
+  user_shims <- read_shims()
 
   # Only take ones that aren't shimmed by fertile or the user
-
   combined_fertile_shims <- unique(c(fertile_shims, user_shims))
 
   unwritten_shims <- shims_with_pkgs[!(shims_with_pkgs %in% combined_fertile_shims)]

R/utils.R

@@ -3,15 +3,15 @@
 #' @param pkgname a character string giving the name of the package
 .onAttach <- function(libname, pkgname) {
   if (Sys.getenv("IN_TESTTHAT") != TRUE & fs::dir_exists(Sys.getenv("HOME"))) {
-    enable_added_shims()
+    load_shims()
   }
 }
 
 #' Remove shims from environment when fertile is detached
 #' @param libpath a character string giving the complete path to the package
 .onDetach <- function(libpath) {
   if (Sys.getenv("IN_TESTTHAT") != TRUE) {
-    disable_added_shims()
+    unload_shims()
   }
 }
 
@@ -692,19 +692,51 @@ is_assign <- function(expr) {
 
 #' Check that shims file exists and return path
 #' @export
+#' @rdname add_shim
 #' @keywords internal
 
-read_shims <- function() {
+path_shims <- function() {
 
   # Get path to shim file
-  path_shims <- fs::path(Sys.getenv("HOME"), "fertile_shims.R")
+  x <- fs::path(Sys.getenv("HOME"), ".fertile_shims.R")
 
   # If file exists, return the path
   # Otherwise create the file then return the path
-  if (fs::file_exists(path_shims)) {
-    return(path_shims)
+  if (fs::file_exists(x)) {
+    return(x)
   } else {
-    fs:file_create(path_shims)
-    return(path_shims)
+    fs::file_create(x)
+    return(x)
   }
 }
+
+#' @rdname add_shim
+#' @export
+
+read_shims <- function() {
+  x <- path_shims()
+
+  # Get names of functions from inside the shims file
+  file_code <- readLines(x)
+
+  file_code %>%
+    stringr::str_subset("fertile::log_push") %>%
+    stringr::str_extract("'.+::.+'") %>%
+    stringr::str_remove_all("'")
+}
+
+#' @rdname add_shim
+#' @export
+
+active_shims <- function() {
+  shims <- read_shims() %>%
+    stringr::str_extract("::.+$") %>%
+    stringr::str_remove_all("::")
+
+  # doesn't work -- need to fix
+#  objects <- ls()
+#  funs <- objects[purrr::map_lgl(objects, is.function)]
+
+#  intersect(funs, shims)
+  shims
+}