R/grab_and_attach.R

In Patrikios/grab_and_attach: Loading and attaching multiple packages to search path, if not installed attempts to install

.onAttach <- function(libname, pkgname) {
  packageStartupMessage("Package 'quickoad' version 0.0.1, use with caution.")
  }

#' messaging
#'
#' helper function for messaging
#'
#' @param msg A string message to display
#' @param msg_mode 2 baseline modes are available for displaying the 'msg' string: cat or message. They are the default options in case the user does not have 'cli' package installed that allows colored outputs.
#' @param color Color the 'msg' to be displayed in. Will be ignored if the 'cli' package, that allows colored outputs, is not installed.
#'
#' @return Nothing, just prints to stdout.
messaging <- function(msg, msg_mode = c('cat', 'message'), color){

  # helper function for printing the messages

  # use cli if available
  with_cli <- requireNamespace('cli', quietly = TRUE) # or 'cli' %in% installed.packages()[, 'Package'] ??
  if(!with_cli) cat("\n>Install package 'cli' for colored console outputs.<\n")

  m <- match.arg(msg_mode)

  # use cat or otherwise message R interface
  if(m == 'cat'){

    if(with_cli)
      cli::cat_line(msg, col = color)
    else
      cat(msg, '\n')

  } else if(m == 'message'){

    if(with_cli)
      cli::cat_line(msg, col = color)
    else
      message(msg)
  }
}

#' checkAndLoad
#'
#' function wrapping try catch that tries to load a package. If the loading process faills it will start installation procedure that fails gracefully,
#'
#' @param pckg Packages to install, can be character (e.g "data.table") or NSE label (data.table without paranthesis)
#' @param mirror Will be passed down to 'repos' argument of 'install.packages'
#' @param dependencies Will be passed down to 'dependencies' argument of 'install.packages'
#'
#' @return Nothing
#'
#' @importFrom utils installed.packages update.packages
checkAndLoad <- function(pckg, mirror, dependencies) {

  possibleError <- tryCatch({

    if(!requireNamespace(pckg, character.only = TRUE, quietly = TRUE)) {

      cat('\nDoing: ', sprintf("install.packages('%s', repos = '%s', dependencies = %s)", pckg, mirror, dependencies), '\n')
      eval(parse(text = sprintf("install.packages('%s', repos = '%s', dependencies = %s)", pckg, mirror, dependencies)))

      if(pckg %in% installed.packages()[, 'Package'] ){

        cat('Doing: ', sprintf("library('%s', character.only = TRUE)", pckg), '\n')
        library(pckg, character.only = TRUE, logical.return = TRUE)

      } else

        stop(sprintf('Package %s could not be installed', pckg))

      }

    },
  error = function(error_message) {

    messaging(msg = sprintf('Error: The package %s is most probably wrongly spelled, check the package\u00b4s name or check the error message above', pckg),
              msg_mode = 'm',
              color = 'red')

    return(error_message)

  },
  warning = function(warning_message) {

    messaging(msg = sprintf('Warning: The package %s is most probably wrongly spelled, check the package\u00b4s name or check the error message above', pckg),
              msg_mode = 'm',
              color = 'orange')

    return(warning_message)

  }
  )

  return(possibleError)

}


#' grab_and_attach
#'
#' grab stands for - try to to load package, if it fails attempt to install, attach stands for - attaching the grabbed package to the search path of the R session.
#'
#' @param ... List of packages to install (accepts NSE or standard string values)
#' @param mirror Will be passed down to 'repos' argument of 'install.packages'
#' @param dependencies Will be passed down to 'dependencies' argument of 'install.packages'
#' @param update_first Boolean, indicates if an update of the packages should be done first before the grabing procedure takes place.
#'
#' @return Does not have a return value, the successful outcome is that the indicated packages are loaded and attached.
#'
#' @export
#'
#' @examples
#' grab_and_attach('lubridate', data.table, 'cli')
grab_and_attach <- function(..., mirror = 'https://cloud.r-project.org/', dependencies = TRUE, update_first = FALSE) {

  # update first if the arg is TRUE
  if(update_first) update.packages(repos = mirror, ask = FALSE)

  # parse either character or nse args (packages to attach)
  if(all(lapply(match.call(expand.dots = FALSE)$..., class) == 'call')) {

    args <- eval(parse(text = paste0(match.call(expand.dots = FALSE)$...)))

  } else {

    args <- paste0(match.call(expand.dots = FALSE)$...)

  }

  cat('\n-------\n')

  # process libraries one by one in a loop
  for(i in args) {

    cat('\n')

    if(i %in% .packages()) {

      messaging(msg = sprintf('Package %s is already loaded', i), msg_mode = 'c', color = 'blue')
      cat('\n-------\n')

    } else if(i %in% installed.packages()[, 'Package']){

      messaging(msg = sprintf('Loading package: %s', i), msg_mode = 'c', color = 'blue')
      library(i, character.only = TRUE)
      messaging(msg = '...package loaded!', msg_mode = 'c', color = 'blue')
      cat('\n-------\n')

    } else {

      messaging(msg = sprintf('Installing package: %s', i), msg_mode = 'c', color = 'blue')
      skipRule <- checkAndLoad(i, mirror, dependencies)

      if(inherits(skipRule, 'error') || inherits(skipRule, 'warning')) {

        cat('\n-------\n')
        next

      } else {

        messaging(msg = '...package loaded!', msg_mode = 'c', color = 'blue')
        cat('\n-------\n')

      }
    }
  }
}