Merge pull request #10 from jhrcook/dev

Minor, user-focussed additions

.github/workflows/R-CMD-check.yaml

@@ -2,7 +2,7 @@ on:
   push:
     branches:
       - master
-      - devel
+      - dev
   pull_request:
     branches:
       - master

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: mustashe
 Title: Stash and Load Objects
-Version: 0.1.2
+Version: 0.1.3
 Authors@R: 
     c(person(given = c("Joshua", "H"),
             family = "Cook",
@@ -29,7 +29,8 @@ Imports:
     digest (>= 0.6.0),
     formatR (>= 1.7),
     qs (>= 0.21.2),
-    tibble (>= 2.1.0)
+    tibble (>= 2.1.0),
+    here (>= 0.1.0)
 Suggests: 
     covr (>= 3.3.0),
     knitr (>= 1.28),
@@ -42,4 +43,4 @@ VignetteBuilder:
 Encoding: UTF-8
 Language: en-US
 LazyData: true
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1

NAMESPACE

@@ -1,5 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(clear_stash)
+export(dont_use_here)
 export(stash)
 export(unstash)
+export(use_here)

NEWS.md

@@ -1,3 +1,9 @@
+# mustashe 0.1.3
+
+* An error is raised if the '.mustashe' directory cannot be created (#9).
+* Add an option to use the ['here'](https://CRAN.R-project.org/package=here) package for creating file paths for stashed objects.
+* Minor fixes for CRAN package checking process.
+
 # mustashe 0.1.2
 
 * Jimmy changed the reading and writing system from the base R RDS system to using the ['qs: Quick Serialization of R Objects'](https://CRAN.R-project.org/package=qs) package for faster reading and writing.

R/clear_stash.R

@@ -6,13 +6,12 @@
 #'
 #' @examples
 #' clear_stash()
-#'
 #' @export clear_stash
 clear_stash <- function() {
-    message("Clearing stash.")
-    file.remove(c(
-        list.files(.stash_dir, full.names = TRUE, pattern = "qs$"),
-        list.files(.stash_dir, full.names = TRUE, pattern = "hash$")
-    ))
-    invisible(NULL)
+  message("Clearing stash.")
+  file.remove(c(
+    list.files(get_stash_dir(), full.names = TRUE, pattern = "qs$"),
+    list.files(get_stash_dir(), full.names = TRUE, pattern = "hash$")
+  ))
+  invisible(NULL)
 }

R/stash.R

@@ -14,180 +14,220 @@
 #' @examples
 #' \donttest{
 #' # A value that is used to create `rnd_vals`.
-#' x <<- 1e6  # The `<<-` is not normally required, just for this example.
+#' x <<- 1e6 # The `<<-` is not normally required, just for this example.
 #'
 #' # Stash the results of the comuption of `rnd_vals`.
 #' stash("rnd_vals", depends_on = "x", {
-#'     # Some long running computation.
-#'     rnd_vals <- rnorm(x)
+#'   # Some long running computation.
+#'   rnd_vals <- rnorm(x)
 #' })
+#'
+#' # Remove directory for this example - do not do in real use.
+#' unlink(".mustashe", recursive = TRUE)
 #' }
 #'
 #' @export stash
 stash <- function(var, code, depends_on = NULL) {
-
-    check_stash_dir()
-
-    deparsed_code <- deparse(substitute(code))
-    formatted_code <- format_code(deparsed_code)
-
-    if (is.null(var)) stop("`var` cannot be NULL")
-    if (formatted_code == "NULL") stop("`code` cannot be NULL")
-
-    new_hash_tbl <- make_hash_table(formatted_code, depends_on)
-
-    # if the variable has been stashed:
-    #     if the hash tables are equivalent:
-    #         load the stored variable
-    #     else:
-    #         make a new stash
-    # else:
-    #     make a new stash
-    if (has_been_stashed(var)) {
-        old_hash_tbl <- get_hash_table(var)
-        if (hash_tables_are_equivalent(old_hash_tbl, new_hash_tbl)) {
-            message("Loading stashed object.")
-            load_variable(var)
-        } else {
-            message("Updating stash.")
-            new_stash(var, formatted_code, new_hash_tbl)
-        }
+  check_stash_dir()
+
+  deparsed_code <- deparse(substitute(code))
+  formatted_code <- format_code(deparsed_code)
+
+  if (is.null(var)) stop("`var` cannot be NULL")
+  if (formatted_code == "NULL") stop("`code` cannot be NULL")
+
+  new_hash_tbl <- make_hash_table(formatted_code, depends_on)
+
+  # if the variable has been stashed:
+  #     if the hash tables are equivalent:
+  #         load the stored variable
+  #     else:
+  #         make a new stash
+  # else:
+  #     make a new stash
+  if (has_been_stashed(var)) {
+    old_hash_tbl <- get_hash_table(var)
+    if (hash_tables_are_equivalent(old_hash_tbl, new_hash_tbl)) {
+      message("Loading stashed object.")
+      load_variable(var)
     } else {
-        message("Stashing object.")
-        new_stash(var, formatted_code, new_hash_tbl)
+      message("Updating stash.")
+      new_stash(var, formatted_code, new_hash_tbl)
     }
+  } else {
+    message("Stashing object.")
+    new_stash(var, formatted_code, new_hash_tbl)
+  }
 
-    invisible(NULL)
+  invisible(NULL)
 }
 
 # Make a new stash from a variable, code, and hash table.
 new_stash <- function(var, code, hash_tbl) {
-    val <- evaluate_code(code)
-    assign_value(var, val)
-    write_hash_table(var, hash_tbl)
-    write_val(var, val)
+  val <- evaluate_code(code)
+  assign_value(var, val)
+  write_hash_table(var, hash_tbl)
+  write_val(var, val)
 }
 
 
 # Format the code.
 format_code <- function(code) {
-    fmt_code <- formatR::tidy_source(
-        text = code,
-        comment = FALSE,
-        blank = FALSE,
-        arrow = TRUE,
-        brace.newline = FALSE,
-        indent = 4,
-        wrap = TRUE,
-        output = FALSE,
-        width.cutoff = 80
-    )$text.tidy
-    paste(fmt_code, sep="", collapse="\n")
+  fmt_code <- formatR::tidy_source(
+    text = code,
+    comment = FALSE,
+    blank = FALSE,
+    arrow = TRUE,
+    brace.newline = FALSE,
+    indent = 4,
+    wrap = TRUE,
+    output = FALSE,
+    width.cutoff = 80
+  )$text.tidy
+  paste(fmt_code, sep = "", collapse = "\n")
 }
 
 
 # Make a hash table for code and any variables in the dependencies.
 make_hash_table <- function(code, depends_on) {
-    code_hash <- make_hash("code", env = environment())
-    depends_on <- sort(depends_on)
-    dependency_hashes <- make_hash(depends_on, .TargetEnv)
-    tibble::tibble(
-        name = c("CODE", depends_on),
-        hash = c(code_hash, dependency_hashes)
-    )
-
+  code_hash <- make_hash("code", env = environment())
+  depends_on <- sort(depends_on)
+  dependency_hashes <- make_hash(depends_on, .TargetEnv)
+  tibble::tibble(
+    name = c("CODE", depends_on),
+    hash = c(code_hash, dependency_hashes)
+  )
 }
 
 
 # Make hash of an object.
 make_hash <- function(vars, env) {
-    if (is.null(vars)) return(NULL)
+  if (is.null(vars)) {
+    return(NULL)
+  }
 
-    missing <- !unlist(lapply(vars, exists, envir = env))
-    if (any(missing)) {
-        stop("Some dependencies are missing from the environment.")
-    }
+  missing <- !unlist(lapply(vars, exists, envir = env))
+  if (any(missing)) {
+    stop("Some dependencies are missing from the environment.")
+  }
 
-    hashes <- c()
-    for (var in vars) {
-        hashes <- c(hashes, digest::digest(get(var, envir = env)))
-    }
+  hashes <- c()
+  for (var in vars) {
+    hashes <- c(hashes, digest::digest(get(var, envir = env)))
+  }
 
-    return(hashes)
+  return(hashes)
 }
 
 
 # Are the two hash tables equivalent?
 hash_tables_are_equivalent <- function(tbl1, tbl2) {
-    isTRUE(all.equal(tbl1, tbl2, check.attributes = TRUE, use.names = TRUE))
+  isTRUE(all.equal(tbl1, tbl2, check.attributes = TRUE, use.names = TRUE))
 }
 
 
 # Has the `var` been stashed before?
 has_been_stashed <- function(var) {
-    paths <- stash_filename(var)
-    isTRUE(all(unlist(lapply(paths, file.exists))))
+  paths <- stash_filename(var)
+  isTRUE(all(unlist(lapply(paths, file.exists))))
 }
 
 
 # Retrieve the hash table as a `tibble`.
 get_hash_table <- function(var) {
-    dat <- qs::qread(stash_filename(var)$hash_name)
-    dat <- tibble::as_tibble(dat)
-    return(dat)
+  dat <- qs::qread(stash_filename(var)$hash_name)
+  dat <- tibble::as_tibble(dat)
+  return(dat)
 }
 
 
 # Write the hash table to file.
 write_hash_table <- function(var, tbl) {
-    qs::qsave(tbl, stash_filename(var)$hash_name)
+  qs::qsave(tbl, stash_filename(var)$hash_name)
 }
 
 
 # Write the value to disk.
 write_val <- function(var, val) {
-    path <- stash_filename(var)$data_name
-    qs::qsave(val, path)
+  path <- stash_filename(var)$data_name
+  qs::qsave(val, path)
 }
 
 
 # Load in a variable from disk and assign it to the global environment.
 load_variable <- function(var) {
-    path <- stash_filename(var)$data_name
-    val <- qs::qread(path)
-    assign_value(var, val)
+  path <- stash_filename(var)$data_name
+  val <- qs::qread(path)
+  assign_value(var, val)
 }
 
 
 # Evaluate the code in a new environment.
 evaluate_code <- function(code) {
-    eval(parse(text = code), envir = new.env())
+  eval(parse(text = code), envir = new.env())
 }
 
 
 # Assign the value `val` to the variable `var`.
 assign_value <- function(var, val) {
-    assign(var, val, envir = .TargetEnv)
+  assign(var, val, envir = .TargetEnv)
 }
 
 
 # Get the file names for staching
 stash_filename <- function(var) {
-    return(list(
-        data_name = file.path(.stash_dir, paste0(var, ".qs")),
-        hash_name = file.path(.stash_dir, paste0(var, ".hash"))
-    ))
+  stash_dir <- get_stash_dir()
+  return(list(
+    data_name = file.path(stash_dir, paste0(var, ".qs")),
+    hash_name = file.path(stash_dir, paste0(var, ".hash"))
+  ))
 }
 
 
 check_stash_dir <- function() {
-    if (!dir.exists(.stash_dir)) {
-        dir.create(.stash_dir, recursive = TRUE)
-    }
-    invisible(NULL)
+  stash_dir <- get_stash_dir()
+  if (!dir.exists(stash_dir)) {
+    tryCatch(
+      dir.create(stash_dir, showWarnings = TRUE, recursive = TRUE),
+      warning = stash_dir_warning
+    )
+  }
+  invisible(NULL)
 }
 
+stash_dir_warning <- function(w) {
+  warning(w)
+  # if (grep("cannot create dir", w) > 0 & grep("Permission denied", w) > 0) {
+  if (TRUE) {
+    stop_msg1 <- "
+'mustashe' is unable to create a directory to stash your objects.
+Please create the directory manually using:"
+
+    stop_msg2 <- paste0("\n  dir.create(", get_stash_dir(), ")")
+
+    stop_msg3 <- "
+If that does not work, please create the directory from the command line and open an issue at:
+  https://github.com/jhrcook/mustashe"
+
+    stop_msg <- paste(stop_msg1, stop_msg2, stop_msg3, sep = "\n")
+    stop(stop_msg)
+  }
+}
+
+
+get_stash_dir <- function() {
+  stash_dir <- ".mustashe"
+
+  use_here_option <- getOption("mustashe.here")
+  # print(use_here_option)
+  if (!is.null(use_here_option)) {
+    if (use_here_option == TRUE) {
+      return(here::here(stash_dir))
+    }
+  }
+  return(stash_dir)
+}
 
 # The environment where all code is evaluated and variables assigned.
 .TargetEnv <- .GlobalEnv
-.stash_dir <- ".mustashe"
+# .stash_dir <- ".mustashe"