R/template_make.R

In sachserf/repres: A framework for project organisation

#' Write a predefined file make.R
#' 
#' @description Aside from scripts for analysis each framework project contain 
#'   two important files: 'make.R' and 'params.R'. All parameters should be 
#'   specified in params.R. These values will be passed to make.R
#' @seealso \code{\link{template_params}}
#' @author Frederik Sachser
#' @return A file named 'make.R'.
#' @export
template_make <- function() {
  if (file.exists('make.R')) {
    stop("File make.R exists. Choose another target directory and retry.")
  } else {
    writeLines(text = "#' NOTE: This file is dependent on parameters specified in external files (default: params.R)\n#' FRESH START\ncloseAllConnections()\ngrDevices::graphics.off()\ncat('\\014')\noptions(warn = 1)\nif ('package:framework' %in% search() == TRUE) detach(package:framework)\nif ('framework_params' %in% search() == TRUE) detach(framework_params)\nif ('framework_fun' %in% search() == TRUE) detach(framework_fun)\nrm(list = ls(all.names = TRUE, envir = .GlobalEnv))\n#' MESSAGE\nmessage(R.version.string, ' <<', version$nickname, '>> \\n', Sys.info()['effective_user'], ' @ ', version$platform, '.\\n')\nmessage('#############################################\\n################ PROCESSING #################\\n#############################################\\n')\n#' ENVIR\nframework_params <- new.env(parent = .GlobalEnv)\nframework_params$filepath_instructions <- c('params.R')\nsapply(framework_params$filepath_instructions, source, local = framework_params)\nif (framework_params$toplvl != basename(getwd())) stop('Check Working directory!')\nframework_params$toplvl <- getwd()\n#' FUN\nframework_fun <- new.env(parent = .GlobalEnv)\nsapply(\n  list.files(\n    path = framework_params$fun_dir,\n    pattern = '*.R$',\n    full.names = TRUE,\n    recursive = TRUE\n  ),\n  source,\n  local = framework_fun\n)\nattach(framework_fun)\nrm(framework_fun)\n#' ESCAPE\nif (file.exists('framework_escape_hook.R')) {\n  source('framework_escape_hook.R')\n  framework_escape_hook()\n  rm('framework_escape_hook')\n  unlink('framework_escape_hook.R')\n}\n#' PARAMS\nassign_missing_params(pos = framework_params)\nframework_params$ls_instructions <- lapply(ls(envir = framework_params), get, envir = framework_params)\nnames(framework_params$ls_instructions) <- as.list(ls(envir = framework_params))[-which(ls(envir = framework_params) == 'ls_instructions')]\nattach(framework_params)\nrm(framework_params)\n#' PKG\npkg_cran(pkg_names = pkg_cran_install, attach = FALSE)\npkg_gh(pkg_names = pkg_gh_install, attach = FALSE)\npkg_cran(pkg_names = pkg_cran_load)\npkg_gh(pkg_names = pkg_gh_load)\n#' INSTRUCTIONS\ninstructions_prepare(ls_instructions = get('ls_instructions', pos = 'framework_params'))\ninstructions_implement(ls_instructions = get('ls_instructions', pos = 'framework_params'))\ninstructions_check(ls_instructions = get('ls_instructions', pos = 'framework_params'), df_source_files = get('df_source_files', pos = 'framework_params'))\ninstructions_execute(ls_instructions = get('ls_instructions', pos = 'framework_params'), df_source_files = get('df_source_files', pos = 'framework_params'))\ninstructions_symlink(ls_instructions = get('ls_instructions', pos = 'framework_params'), df_source_files = get('df_source_files', pos = 'framework_params'))\ninstructions_supplement(ls_instructions = get('ls_instructions', pos = 'framework_params'))\nsuppressWarnings(rm(knit_hook_stderr))\nautosnapshot(repopath = get('ls_instructions', pos = 'framework_params')$toplvl, autobranch = get('ls_instructions', pos = 'framework_params')$autobranch)\n", con = 'make.R')
  }
}