R/19_pack_helpers.R

In RSuite: Supports Developing, Building and Deploying R Solution

#----------------------------------------------------------------------------#
# RSuite
# Copyright (c) 2017, WLOG Solutions
#
# Utilities to support project packing.
#----------------------------------------------------------------------------#

#'
#' Exports project sources into folder passed.
#'
#' @param params parameters of project to export. (type: rsuite_project_params)
#' @param rver R version to pack project for. If NULL R version of project will
#'   not be altered (type: character)
#' @param pkgs names of project packages to include. (type: character)
#' @param dest_dir destination folder path to export project to. (type: character)
#'
#' @return parameters object of exported project or NULL if failed to export.
#'
#' @keywords internal
#' @noRd
#'
export_prj <- function(params, rver, pkgs, inc_master, dest_dir) {
  stopifnot(is.null(pkgs) || is.character(pkgs))
  stopifnot(is.logical(inc_master))

  pkg_loginfo("Exporting project from %s ...", params$prj_path)

  stopifnot(is_nonempty_char1(dest_dir))

  tocopy <- list.files(params$prj_path, all.files = TRUE, include.dirs = TRUE)

  base_dir <- file.path(dest_dir, params$get_safe_project_name())
  success <- dir.create(base_dir, recursive = TRUE, showWarnings = FALSE)
  if (!success) {
    pkg_logwarn("Failed to create base folder for project export")
    return()
  }

  excludes <- trimws(unlist(strsplit(params$excludes, ",")))

  tocopy <- tocopy[!grepl("^[.]$|^[.][.]$|^[.](git|svn|Rproj[.]user|Rhistory|RData)|deployment", tocopy)]
  tocopy <- tocopy[!(tocopy %in% excludes)]
  success <- file.copy(from = file.path(params$prj_path, tocopy),
                       to = base_dir,
                       recursive = TRUE)
  if (!all(success)) {
    pkg_logwarn("Failed to export some project folders: %s", paste(tocopy[!success], collapse = ", "))
    return()
  }

  success <- unlist(lapply(file.path(base_dir, "deployment", c("libs", "sbox")),
                           function(d) {
                             dir.create(d, recursive = TRUE, showWarnings = FALSE)
                           }))
  if (!all(success)) {
    pkg_logwarn("Failed to create deployment folder structure in export folder")
    return()
  }

  if (file.exists(params$lock_path)) {
    success <- file.copy(from = normalizePath(params$lock_path), to = file.path(base_dir, "deployment"))

    if (!all(success)) {
      pkg_logwarn("Failed to copy env.lock file to export folder")
      return()
    }
  }

  # cleanup: remove any .Rproj.user, .Rhistory, .RData, .log if exists in root_dir
  to_rem <- c(
    list.files(base_dir, pattern = "^[.]Rproj.user", recursive = TRUE, include.dirs = TRUE, all.files = TRUE),
    list.files(base_dir, pattern = "^[.]RData", recursive = TRUE, include.dirs = TRUE, all.files = TRUE),
    list.files(base_dir, pattern = "^[.]Rhistory", recursive = TRUE, include.dirs = TRUE, all.files = TRUE),
    list.files(base_dir, pattern = "^[.]svn", recursive = TRUE, include.dirs = TRUE, all.files = TRUE),
    list.files(base_dir, pattern = "^[.]git.*", recursive = TRUE, include.dirs = TRUE, all.files = TRUE),
    list.files(base_dir, pattern = ".*[.]log", recursive = TRUE, include.dirs = TRUE, all.files = TRUE)
  )
  unlink(file.path(base_dir, to_rem), recursive = TRUE, force = TRUE)

  # cleanup: removing excludes
  unlink(file.path(base_dir, excludes), recursive = TRUE, force = TRUE)

  out_prj <- prj_init(base_dir)
  if (!is.null(rver)) {
    RSuite::prj_config_set_rversion(rver, out_prj, validate = FALSE)
  }
  exp_params <- out_prj$load_params()

  # cleanup: clear packages not to be included
  pkgs_toremove <- list.dirs(exp_params$pkgs_path, recursive = FALSE, full.names = FALSE)
  pkgs_toremove <- pkgs_toremove[!(pkgs_toremove %in% pkgs)]
  success <- unlink(file.path(exp_params$pkgs_path, pkgs_toremove), recursive = TRUE, force = TRUE)
  if (success != 0) {
    pkg_logwarn("Failed to exclude some excluded packages.")
    return()
  }

  # cleanup: master scripts (if required)
  if (!any(inc_master)) {
    success <- unlink(file.path(exp_params$script_path, c("*.R", "*.r")), recursive = TRUE, force = TRUE)
    if (success != 0) {
      pkg_logwarn("Failed to remove master scripts as requested")
      return()
    }
  }

  # cleanup: clear man for packages processed with roxygen
  lapply(X = list.files(base_dir, pattern = "NAMESPACE", recursive = TRUE, full.names = TRUE),
         FUN = function(ns_file) {
           if (grepl("^# Generated by roxygen", readLines(ns_file, n = 1, warn = FALSE))) {
             unlink(file.path(dirname(ns_file), "man", "*.Rd"), recursive = TRUE, force = TRUE)
           }
         })

  pkg_loginfo("Exporting project from %s ... done", params$prj_path)

  return(exp_params)
}

#'
#' Creates .prjinfo file for the project.
#'
#' .prjinfo file includes revision number as tag and invormation to check project
#'   consistency.
#'
#' @param params parameters of project to create .prjinfo for. (type: rsuite_project_params)
#' @param verinfo named list of structure as detect_zip_version returns.
#'
#' @keywords internal
#' @noRd
#'
create_prjinfo <- function(params, verinfo) {
  prjinfo_fpath <- file.path(params$prj_path, ".prjinfo")

  rev <- "-"
  if (!is.null(verinfo$rev)) {
    rev <- verinfo$rev
  }

  prjinfo_lines <- c(sprintf("rev: %s", rev),
                     sprintf("ver: %s", verinfo$ver))

  # TODO: add project consistency info

  writeLines(prjinfo_lines, con = prjinfo_fpath)
}


#'
#' Checks if .prjinfo is present. If so, retrieves revision info from it checking
#'   associated consistency information.
#'
#' @param params parameters of project to retrieve revision for. (type: rsuite_project_params)
#'
#' @return revision retrieved and checked or NULL if no .prjinfo present or rev
#'   not specified in the .prjinfo file. (type: character)
#'
#' @keywords internal
#' @noRd
#'
retrieve_consistent_prjinfo <- function(params) {
  prjinfo_fpath <- file.path(params$prj_path, ".prjinfo")
  if (!file.exists(prjinfo_fpath)) {
    return(list(rev = NULL, ver = NULL))
  }

  prjinfo_lines <- readLines(prjinfo_fpath, warn = FALSE)

  rev_line <- prjinfo_lines[grepl("^rev:\\s*([0-9]+|-)\\s*$", prjinfo_lines)]
  assert(length(rev_line) == 1,
         "Invalid .prjinfo file format detected: no rev marker found")
  rev <- gsub("^rev:\\s*([0-9]+|-)\\s*$", "\\1", rev_line)
  if (rev == "-") {
    rev <- NULL
  }

  ver_line <- prjinfo_lines[grepl("^ver:\\s*(.+)\\s*$", prjinfo_lines)]
  if (length(ver_line) == 1) {
    ver <- gsub("^ver:\\s*(.+)\\s*$", "\\1", ver_line)
  } else {
    ver <- NULL
  }
  # TODO: check file consistency

  return(list(rev = rev, ver = ver))
}