Add create_location_io

DESCRIPTION

@@ -1,13 +1,13 @@
 Package: friendlyloader
-Title: What the Package Does (One Line, Title Case)
-Version: 0.0.0.9000
+Title: Helper functions for loading and saving data
+Version: 3.0.0
 Authors@R: 
     person("Rosalyn", "Pearson", , "rosalyn.pearson@phs.scot", role = c("aut", "cre"))
 Description: Helps routine loading of Excel and csv files with names that are subject to small changes.
 License: MIT + file LICENSE
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.1
+RoxygenNote: 7.2.3
 Suggests: 
     testthat (>= 3.0.0)
 Config/testthat/edition: 3
@@ -16,4 +16,5 @@ Imports:
     utils,
     openxlsx,
     readxl,
-    tibble
+    tibble,
+    rstudioapi

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(check_file)
 export(create_loader_with_options)
+export(create_location_io)
 export(filename_without_date)
 export(get_keywords)
 export(match_base_filename)

R/create_location_io.R

@@ -0,0 +1,208 @@
+#' Create a read/write (i/o) function with a given base location
+#'
+#' \code{create_location_io} creates a wrapper around a function such as
+#' \code{readRDS} or \code{readr::write_csv}, creating a new function where
+#' reading/writing is done relative to a specified \code{data_folder}, rather
+#' than the working directory. The new function is saved out with the same name
+#' as the input function prefixed by \code{prefix_}.
+#'
+#' This function is used for its side effects. It assigns a wrapped function
+#' to an \code{environment}, by default the \code{global environment}.
+#'
+#' The functions created by \code{create_location_io} can be used in just the
+#' same way as the functions they wrap, all the same arguments are available.
+#' The only difference is that the filepath that you pass to the wrapped
+#' function is appended to the \code{data_folder} that the function was
+#' created with. For instance, if \code{create_location_io} is used to wrap
+#' \code{fread}, as
+#' \code{create_location_io(data.table::fread, "/tmp/directory")}
+#' then a new function will be created in the \code{global environment}
+#' (your workspace), called \code{project_fread}. If you use this function to
+#' read a file, as \code{data <- project_fread("data/myfile.csv")},
+#' then the file will be read from \code{"/tmp/directory/data/myfile.csv"}.
+#'
+#' Even where \code{io} is specified, the function will try to deduce whether
+#' \code{startfun} is an input, or output, function. If this deduction fails then
+#' you will be warned. If the deduction doesn't match \code{io} then the
+#' function will ask the user if they want to continue.
+#'
+#' @param startfun \code{function} to create a wrapper around
+#' @param data_folder \code{character} string giving the filepath of the base
+#' location the new function will read/write from
+#' @param io \code{character} string taking values of either "read" or "write",
+#' indicating whether \code{startfun} reads or writes information. If \code{io}
+#' is missing then the function will try to deduce the correct value from the
+#' name of \code{startfun}. \code{io} can also be abbreviated to "r" or "w"
+#' @param prefix \code{character} string giving the prefix for the name of the
+#' new function. Defaults to 'project'
+#' @param useRstudio \code{bool} (TRUE/FALSE) for whether to use interactive R
+#' Studio prompts or to use the console instead
+#' @param env \code{environment} to add the new function to. Defaults to
+#' \code{globalenv()}
+#' @param ... other parameters to pass to \code{startfun}
+#'
+#' @return \code{create_location_io} returns its first argument invisibly
+#'
+#' @examples
+#' \dontrun{
+#'
+#' # Create a variable holding the path to the data folder.
+#' dat_folder <- "/path/to/chosen/data/folder/"
+#'
+#' # Create some wrapped i/o functions. That read/write to
+#' # 'dat_folder' as a base location.
+#' create_location_io(saveRDS, dat_folder, io = "write")
+#' create_location_io(readRDS, dat_folder, prefix = "custom")
+#'
+#' # Create some data.
+#' x <- 2
+#'
+#' # Save the data to 'dat_folder' using the wrapped function.
+#' project_saveRDS(x, "test.rds")
+#'
+#' # Read the saved file back into R.
+#' y <- custom_readRDS("test.rds")
+#'
+#' y
+#' }
+#'
+#' @export
+create_location_io <- function(startfun, data_folder, io = c("read", "write"),
+                              prefix = "project",
+                              useRstudio = TRUE,
+                              env = globalenv(), ...){
+
+  ## Argument testing
+
+  # Check that startfun and data_folder arguments have both been provided.
+  if (missing(startfun) | missing(data_folder)) {
+    stop("Arguments startfun and data_folder must both be provided")
+  }
+
+  # Check that startfun is a function that can be found.
+  if (!(tryCatch(is.function(startfun), error = function(cond) FALSE))) {
+    stop(paste("function", deparse(substitute(startfun)), "not found"))
+  }
+
+  # Check data_folder is a length one character string.
+  if (!(is.character(data_folder) & length(data_folder) == 1)) {
+    stop("data_folder must be a character string of length 1")
+  }
+
+  # Check that data_folder exists.
+  if (!dir.exists(data_folder)) {
+    stop(paste0("data_folder (", data_folder,
+                ") either doesn't exist or isn't a directory"))
+  }
+
+  # If io is not missing check it is a length one character string
+  # with a valid value.
+  if (!missing(io)) {
+
+    # Check that io is a length one character string.
+    if (!(is.character(io) & length(io) == 1)) {
+      stop("io must be a character string of length 1")
+    }
+
+    # Check that io has a valid value.
+    if (!(io %in% c("read", "r", "write", "w"))) {
+      stop(paste(io, "is not a valid value for io"))
+    }
+  }
+
+  # Check prefix is a length one character string.
+  if (!(is.character(prefix) & length(prefix) == 1)) {
+    stop("prefix must be a character string of length 1")
+  }
+
+  # Check that env is an environment.
+  if(!is.environment(env)) {
+    stop("env must be an environment")
+  }
+
+  ## Body of function
+
+  # Get the start function name e.g. "read_csv" from "readr::read_csv".
+  funname <- sub("^.*::", "", deparse(substitute(startfun)))
+
+  # Determine the value of io from the function argumnt.
+  if (!missing(io)) {
+    io <- match.arg(io)
+
+  } else {
+    io <- NULL
+
+  }
+
+  # Deduce an io by searching for keywords in the function name to determine
+  # whether the function is for input or output
+  if(grepl("read", funname)) {
+    io_derived <- "read"
+
+  } else if (grepl("write", funname) | grepl("save", funname)) {
+    io_derived <- "write"
+
+  } else {
+    warning(paste("Unclear from the name whether startfun is an i/o function.",
+                  "Proceeding anyway ..."))
+  }
+
+  # Make sure that io and io_derived are consistent and assign a final io.
+  if (is.null(io) & exists("io_derived")) {
+    io <- io_derived
+
+  } else if (!is.null(io) & exists("io_derived")) {
+
+    if(io != io_derived) {
+      # io disagrees with io_derived. Ask the user if they want to continue.
+      ask_user <- glue::glue("io is set to {io} but function {funname} ",
+                             "has {io_derived} in the name. ",
+                             "Do you wish to continue?")
+      if(useRstudio){
+        continue <- rstudioapi::showQuestion(
+          title = "Warning",
+          message = ask_user,
+          ok = "Yes", cancel = "No")
+      } else {
+          continue <- readline(
+            prompt= paste(ask_user, "Y/N:   ")
+          )
+          continue <- ifelse((continue %in% c("Y", "y")), TRUE, FALSE)
+        }
+
+      if(!continue){
+        stop("Terminating call to create_location_io. No io created.")
+      }
+    }
+
+  }
+
+  # Make a final check that we have a value for io.
+  if (is.null(io)) {
+    stop(paste("io is missing and couldn't be deduced from startfun.",
+               "Please re-run with io set to either 'read' or 'write'"))
+  }
+
+  # Create wrapped function and assign to env.
+  if(io == "read") {
+
+    assign(glue::glue("{prefix}_{funname}"),
+           function(filename, ...){
+             contents <- startfun(glue::glue("{data_folder}/{filename}"), ...)
+
+             return(contents)
+           }, envir = env)
+
+  } else if (io == "write"){
+
+    assign(glue::glue("{prefix}_{funname}"),
+           function(x, filename, ...){
+             startfun(x, glue::glue("{data_folder}/{filename}"), ...)
+
+             invisible()
+           }, envir = env)
+  }
+
+  # Return the first argument invisibly.
+  invisible(startfun)
+}

README.md

@@ -53,6 +53,34 @@ openxlsx::read.xlsx(match_base_filename("20220328_fruits_colours.xlsx"))
 
 Note that there can be only one file called \*fruits\*colours\*xlsx in the given directory or else the call to this function is ambiguous and it will fail.
 
+### Creating input/output functions that write/read from a designated folder
+
+Sometimes it is useful to keep a data folder separate from your working directory,
+but in this case reading and writing to this folder can be cumbersome. 
+
+You can use the `create_location_io()` function to create a version of a given 
+input/output function which is linked to a given location that is not your 
+working directory. For example
+
+```r
+# Create tmp directory
+system("mkdir tmp")
+# Make function
+create_location_io(readr::read_csv, "tmp", prefix="custom")
+```
+
+This generates a function called `custom_read_csv()` which acts just like 
+`readr::read_csv()` but reads from the `tmp` directory instead of the working
+directory. 
+
+The name of the generated function is composed of the `prefix` plus `_` plus the
+name of the function to be wrapped, not including the package - i.e. just
+`read_csv` rather than `readr::read_csv`.
+
+If the function you are wrapping contains "read", "write" or "save" in the name,
+you don't have to specify whether it's an input or an output function. If not,
+you can specify using the `io` argument.
+
 ### Using the terminal selector - when `useRstudio = FALSE`
 
 #### Loading a csv 
@@ -121,3 +149,4 @@ Same as above but use `read_all_excel_sheets()` rather than `read_excel_with_opt
 This uses the `openxlsx` package to read the information.
 
 
+