R functions for retrieving data, possibly from local files.

utils-get.R

import_andor_export <-
  function(...,
           data = NULL,
           f = NULL,
           .otherwise = NULL,
           file = NULL,
           ext = '.RData',
           dir = 'output',
           path = NULL,
           var = NULL,
           .envir = .GlobalEnv,
           overwrite = FALSE,
           export = TRUE,
           assign = TRUE,
           verbose = TRUE) {
    if(is.null(data) & is.null(f)) {
      .display_error(
        'Both `data` and `f` can\'t be null.',
        verbose = verbose
      )
      return(NULL)
    }

    if(is.null(path) & is.null(file)) {
      if(export) {
        .display_error(
         'Both `file` and `path` can\'t be null.',
          verbose = verbose
        )
        return(NULL)
      }
    }
    if (is.null(path)) {
      .display_info(
        'Generating `path` from `dir` ({dir}), `file` ({file}), and `ext` ({ext}).',
        verbose = verbose
      )
      path <- file.path(dir, paste0(file, ext))
    }
    if(is.null(file) & !is.null(path)) {
      basename <- basename(path)
      file <- tools::file_path_sans_ext(path)
      dir <- dirname(path)
      ext <- tools::file_ext(path)
    }
    if(is.null(var)) {
      var <- file
    }
    file_exists <- file.exists(path)
    if (!file_exists | overwrite) {
      if (file_exists & overwrite) {
        .display_info(
          'Ignoring `overwrite` because `path` ({path}) does not exist.',
          verbose = verbose
        )
      }
      data_is_null <- is.null(data)
      if(!data_is_null) {
        res <- data
      } else {
        f_safe <- purrr::safely(f, otherwise = .otherwise, quiet = !verbose)
        # res <- f_safe(...)
        res <- f_safe()
        if (is.null(res)) {
          .display_warning('Something went wrong with function call!', verbose = verbose)
          return(tibble())
        }
      }

      if (export) {
        .display_info('Exporting {var} to {path}.', verbose = verbose)
        # rio::export(res, file = path)
        rio::export(res, file = path, ...)
      }
    } else {
      .display_info('Importing data from {path}.', verbose = verbose)
      # res <- rio::import(path)
      res <- rio::import(path, ...)
    }
    if (assign) {
      .display_info('Assiging {var} to `.envir`.', verbose = verbose)
      .do_assign(x = res, .name = var, ...)
    }
    res
  }

import_andor_export_image <-
  function(...,
           path,
           .envir = .GlobalEnv,
           import = TRUE,
           overwrite = import,
           verbose = TRUE) {
    ext <- tools::file_ext(path)
    stopifnot(any(tolower(ext) %in% c('rda', 'rdata')))
    if (import) {
      import_andor_export(
        ...,
        path = path,
        overwrite = overwrite,
        assign = FALSE,
        export = FALSE,
        verbose = verbose
      )
      save.image(path)
    } else {
      .validate_path(path, strict = TRUE, verbose = verbose)
      load(path, envir = .GlobalEnv, verbose = verbose)
      config_get_safe <- purrr::safely(config::get)
      config <- config_get_safe()[['result']]
      if(!is.null(config)) {
        .do_assign(x = config, .name = 'config')
      }
      invisible(R.utils::sourceDirectory(file.path('R'), recursive = FALSE))
    }
  }

# NOTE: This is a generalization of some functions for my Austin real estate analysis project.

.get_data <-
  function(...,
           data = NULL,
           f = NULL,
           .otherwise = NULL,
           file = tempfile(),
           ext = '.rds',
           dir = 'output',
           path = NULL,
           var = file,
           .envir = .GlobalEnv,
           overwrite = FALSE,
           export = TRUE,
           assign = TRUE,
           verbose = TRUE) {
    if (is.null(path)) {
      path <- file.path(dir, paste0(file, ext))
    }
    file_exists <- file.exists(path)
    if (!file_exists | overwrite) {
      if (file_exists & overwrite) {
        if (verbose) {
          message(glue::glue('Ignoring `overwrite` because `path` ({path}) does not exist.'))
        }
      }
      data_is_null <- is.null(data)
      if(!data_is_null) {
        res <- data
      } else {
        f_safe <- purrr::safely(f, otherwise = .otherwise, quiet = !verbose)
        res <- f_safe(...)
        if (is.null(res)) {
          warning('Something went wrong with function call!', call. = FALSE)
          return(tibble())
        }
      }

      if (export) {
        if (verbose) {
          message(glue::glue('Exporting {var} to {path}.'))
        }
        rio::export(res, file = path)
      }
    } else {
      if (verbose) {
        message(glue::glue('Importing data from {path}.'))
      }
      res <- rio::import(path)
    }
    if (assign) {
      if (verbose) {
        message(glue::glue('Assiging {var} to `.envir`.'))
      }
      assign(x = var,
             value = res,
             envir = .envir)
    }
    res
  }

.get_data_wrapper <-
  function(x = NULL,
           ...,
           file = tempfile(),
           f_get_x,
           f_given_x) {
    stopifnot(is.function(f_given_x))
    if (is.null(x)) {
      stopifnot(is.function(f_get_x))
      x <- f_get_x()
    }
    .f <- function() {
      f_given_x(x, ...)
    }
    .get_data(f = .f, file = file, ...)
  }

get_data_wrapper <- function(file = 'file', ...) {
  .get_data_wrapper(..., file = file, f_given_data = realtR::listings)
}