R/createMakefiles.R

Defines functions createMakefiles createTopMakefile createCleanRule createShortcuts createMakeRunmakeRules createBlockMakefile getResourceIDs createResourcesMake createConfigCall createMakeMacros createMakeDirs createMakeBlockRules createMakeItem createMakeItem.default createMakeItem.fetch needsTimestampOld createMakeItem.process createMakeItem.parameter createMakeItem.visualize createMakeItem.publish createMakeItem.makefile createMakeRulePair createMakeEmptyRule createMakeBatchRule createMakeShellRule

Documented in createBlockMakefile createCleanRule createConfigCall createMakeBatchRule createMakeBlockRules createMakeDirs createMakeEmptyRule createMakefiles createMakeItem createMakeItem.default createMakeItem.fetch createMakeItem.makefile createMakeItem.parameter createMakeItem.process createMakeItem.publish createMakeItem.visualize createMakeMacros createMakeRulePair createMakeRunmakeRules createMakeShellRule createShortcuts createTopMakefile needsTimestampOld

#' Create fetch.make, etc. from the information in viz.yaml
#'
#' Uses information in the corresponding block of viz.yaml to create the
#' makefiles
#'
#' @param blocks character vector of names of blocks in the viz.yaml for which
#'   to make makefiles
#' @param display logical. [also] print the makefiles to the console?
#'
#' @export
createMakefiles <- function(blocks=c('parameter','fetch','process','visualize', 'publish'), display=FALSE) {
  makefiles <- c(
    list(makefile=createTopMakefile()),
    lapply(setNames(blocks, paste0(blocks, '.make')), function(block) {
      createBlockMakefile(block, outfile=paste0('vizlab/make/', block, '.make'))
    })
  )
  if(display) {
    lapply(names(makefiles), function(mfname) {
      cat('--- ', mfname, ' ---\n\n', makefiles[[mfname]], '\n\n', sep='')
    })
  }
  invisible(makefiles)
}

#' Create the top-level makefile, which runs/makes/updates the other makefiles
#'
#' Declares the dependency of the other makefiles on the viz.yaml
#'
#' @param outfile filename where the makefile should be written
#'
#' @export
createTopMakefile <- function(outfile='Makefile') {
  makefile <- paste(
    paste0('# Makefile for overall visualization project\n# Do not edit (autogenerated)'),
    createMakeMacros(),
    createShortcuts(),
    createMakeRunmakeRules(),
    createCleanRule(),
    sep='\n\n')
  writeLines(makefile, con=outfile)
  if(!dir.exists('vizlab/make/log/make')) dir.create('vizlab/make/log/make', recursive=TRUE)
  invisible(makefile)
}

#' Create the rules to clean out the make-relevant parts of the project
#'
#' All that's deleted should be re-makeable
#'
#' @keywords internal
createCleanRule <- function() {
  restoreCallFunction <- "file.copy(system.file('scripts/callFunction.R', package='vizlab'), './vizlab/make/callFunction.R')"
  createMakeShellRule(
    target='clean',
    cmd=c(
      'rm -r -f vizlab/make',
      'rm -r -f cache',
      'rm -r -f figures',
      'mkdir -p vizlab/make/log/make',
      sprintf('export R_LIBS_USER=$(RLIBSUSER); ${REXPR} "%s"', restoreCallFunction)
    )
  )
}

#' Create the top shortcuts
#'
#' This includes an internal step "content" which is needed for triggering
#' a rebuild if the viz.yaml file is changed.
#'
#' @keywords internal
createShortcuts <- function(){
  blocks <- c('parameter','fetch','process','visualize','publish')
  content.info <- lapply(setNames(blocks, paste0('top/', blocks)), function(block) {
    list(
      id=block,
      location=paste0('vizlab/make/', block, '.make'),
      depfiles=c('viz.yaml', if(file.exists(findProfileYaml())) findProfileYaml()),
      block='makefile'
    )
  })
  all <- createMakeEmptyRule(
    target='all',
    depends=paste0("\\\n\t", sapply(content.info, `[[`, 'id')))
  
  paste(c(list("# Rules", all)), collapse='\n\n')
}

#' Create the rules to run/make/update the non-top makefiles
#'
#' Each makefile gets a rule to run it and a rule to create the makefile
#'
#' @keywords internal
createMakeRunmakeRules <- function() {
  # create a list of info for each makefile in similar format to block info read
  # from viz.yaml
  blocks <- c('parameter','fetch','process','visualize','publish')
  content.info <- lapply(setNames(blocks, paste0('top/', blocks)), function(block) {
    list(
      id=block,
      location=paste0('vizlab/make/', block, '.make'),
      depfiles=c('viz.yaml', if(file.exists(findProfileYaml())) findProfileYaml()),
      block='makefile'
    )
  })

  # write the rules for each content item (i.e., a makefile)
  items <- sapply(content.info, function(item.info) {
    createMakeItem(item.info)
  })

  # combine all the targets into a single string
  paste(items, collapse='\n\n')
}

#' Create a single makefile from the information in viz.yaml
#'
#' Uses information in the corresponding block of viz.yaml to create the
#' makefiles
#'
#' @param block character name of the block in the viz.yaml for which to create a
#'   makefile
#' @param outfile filename where the makefile should be written
#'
#' @export
createBlockMakefile <- function(block=c('parameter','fetch','process','visualize','publish'), outfile) {
  block <- match.arg(block)
  makefile <- paste(
    paste0('# Makefile for ', block, ' phase of analysis\n# Do not edit (autogenerated from viz.yaml)'),
    createMakeMacros(),
    createConfigCall(),
    createMakeBlockRules(block),
    sep='\n\n')
  if(block == "parameter"){
    makefile <- paste(makefile,createResourcesMake(),sep="\n\n")
  }
  createMakeDirs(makefile)
  writeLines(makefile, con=outfile)
  invisible(makefile)
}

getResourceIDs <- function(){
  resources <- yaml::yaml.load_file(file.path(system.file(package="vizlab"),"resource.library.yaml"))
  ids <- unlist(lapply(resources, function(x)x[["id"]]))
  return(ids)
}

createResourcesMake <- function(){
  ids <-getResourceIDs()
  paste0(paste0(ids, ": vizlab/make/config/", ids,".rds"),collapse = "\n\n")
}

#' Create the rules for the content make file
#'
#' Content make file to re-build yaml files
#'
#' @keywords internal
createConfigCall <- function(){
  
  paste(c(
    "vizlab/make/config/%.rds : viz.yaml",
    # '\t@echo "$@: updateConfigInfoFile(\'$*\')"', # could be nice for debugging/optimizing, but for now be quiet about this
    '\t@export R_LIBS_USER=$(RLIBSUSER);\\',
    '\t${RSCRIPT}  -e "library(vizlab); updateConfigInfoFile(\'$*\')"\\',
    '\t> vizlab/make/log/config.Rout 2>&1'),
    # each target logfile overwrites the last b/c i don't expect to debug it
    # often, don't want a bazillion extra files
    collapse='\n')
}


#' Create the macros section
#'
#' Create a character string defining the macros to include in every makefile
#'
#' @export
createMakeMacros <- function() {
  # read user settings from profile.yaml
  profile <- getProfileInfo()
  userlib <- profile$R_LIBS_USER

  # write the macros
  macros <- c(
    if(!is.null(profile$SHELL)) paste0('SHELL=', profile$SHELL),
    paste0('RLIBSUSER=', if(!is.null(profile$R_LIBS_USER)) profile$R_LIBS_USER else '$(R_LIBS_USER)'),
    paste0('RARGS=--quiet --no-save --no-restore'), # R_LIBS_USER="',profile$R_LIBS_USER,'"
    paste0('RBATCH=', profile$R, ' CMD BATCH --no-timing $(RARGS)'),
    paste0('REXPR=', profile$R, ' $(RARGS) -e'),
    paste0('RSCRIPT=', profile$RSCRIPT, ' $(RARGS)'))

  # combine into a single string
  paste0('# Macros\n\n', paste(macros, collapse='\n'))
}

#' Create directories mentioned in the makefile
#'
#' Seeks specific directories that are expected to appear in some or all
#' visualization projects. Creates those for which the makefile indicates a need
#'
#' @param makefile character string containing the makefile
createMakeDirs <- function(makefile) {
  # the vizlab/make directory needs to exist so we can put makefiles and other
  # internal documentation there
  if(!dir.exists('vizlab/make')) dir.create('vizlab/make', recursive=TRUE)

  # make log directories if specified
  logdirs <- unique(dirname(grep('^vizlab/make/log', strsplit(makefile, '[[:space:]]')[[1]], value=TRUE)))
  if(length(logdirs) > 0) sapply(logdirs, function(logdir) {
    if(!dir.exists(logdir)) dir.create(logdir, recursive=TRUE)
  })

  # make cache directories if specified
  cachedirs <- unique(dirname(grep('^cache/', strsplit(makefile, '[[:space:]]')[[1]], value=TRUE)))
  if(length(cachedirs) > 0) sapply(cachedirs, function(cachedir) {
    if(!dir.exists(cachedir)) dir.create(cachedir, recursive=TRUE)
  })

  # make figures directories if specified
  figdirs <- unique(dirname(grep('^figures/', strsplit(makefile, '[[:space:]]')[[1]], value=TRUE)))
  if(length(figdirs) > 0) sapply(figdirs, function(figdir) {
    if(!dir.exists(figdir)) dir.create(figdir, recursive=TRUE)
  })

  # create the timestamp file directory if specified
  timestampdir <- unique(dirname(grep('^vizlab/make/timestamps', strsplit(makefile, '[[:space:]|\\|=|:]')[[1]], value=TRUE)))
  if(length(timestampdir) > 0) {
    if(!dir.exists(timestampdir)) dir.create(timestampdir)
  }

  # create the config.rds file directory if specified
  configdir <- unique(dirname(grep('^vizlab/make/config', strsplit(makefile, '[[:space:]|\\|=|:]')[[1]], value=TRUE)))
  if(length(configdir) > 0) {
    if(!dir.exists(configdir)) dir.create(configdir)
  }
  
  # always copy callFunction.R into the vizlab/make directory, on the assumption
  # that even if there aren't currently any references to it in the makefiles,
  # there will be soon. this script allows us to call a single function via R
  # CMD BATCH
  file.copy(system.file('scripts/callFunction.R', package='vizlab'),
            './vizlab/make/callFunction.R', overwrite=TRUE)
}

#' Create the make rules for a block of the viz.yaml
#'
#' Create the 'all' and specific targets for a makefile for a block of the
#' viz.yaml
#'
#' @param block character name of the block for which to create the make rules
#'
#' @export
createMakeBlockRules <- function(block=c('parameter','fetch','process','visualize','publish')) {
  block <- match.arg(block)

  # read information about this block from viz.yaml
  content.info <- getContentInfos(block=block)

  # check for and warn about dependencies on directories
  dir.deps <- unlist(lapply(content.info, function(cinfo) {
    is.dir <- sapply(cinfo$scripts, dir.exists)
    names(is.dir)[is.dir]
  }))
  if(length(dir.deps) > 0) {
    dir.deps.info <- sapply(unique(dir.deps), function(dependency) {
      dependers <- names(dir.deps)[dir.deps == dependency]
      sprintf("* Items depending on the %s directory: %s", dependency, paste(dependers, collapse=', '))
    }, USE.NAMES=FALSE)
    dir.deps.msg <- c(
      '-----WARNING-----',
      paste("Script dependencies should be specific files to avoid Making items too seldom or too often.",
            "You can override the default (a directory) by setting 'scripts' in each viz.yaml item."),
      paste0(dir.deps.info, collapse='\n'),
      '-----------------')
  } else {
    dir.deps.msg <- NULL
  }

  depends_text <- paste0("\\\n\t", c(sapply(content.info, `[[`, 'id'), 'MakeMessages'))
  if(block == "parameter"){
    resources_ids <- getResourceIDs()
    depends_text <- paste0("\\\n\t", c(sapply(content.info, `[[`, 'id'),
                                       resources_ids, 'MakeMessages'))
  }
  
  # set the 'all' target to include all content items
  all <- createMakeEmptyRule(
    target='all',
    depends=depends_text)

  # write the rules for each content item
  items <- sapply(content.info, function(item.info) {
    createMakeItem(item.info)
  })

  # write any messages the user should see on calling 'make' - so far this is
  # just the directory dependencies issues if present
  if(length(dir.deps.msg) == 0) dir.deps.msg <- paste0(block, ".make looks OK!")
  messages <- createMakeShellRule('MakeMessages', c(), paste0('@echo "', c('', dir.deps.msg, ''), '"'))

  # combine all the targets into a single string
  paste(c(list("# Rules", all), items, list(messages)), collapse='\n\n')
}

#' Make a collection of makefile rules appropriate to a data/figure item
#'
#' @param item.info viz.yaml item info as from \code{getContentInfo}
#' @param ... other args passed to makeMakeItem methods
#'
#' @export
createMakeItem <- function(item.info, ...) UseMethod("createMakeItem")

#' @rdname createMakeItem
#' @export
createMakeItem.default <- function(item.info, ...) {
  if(class(item.info) != 'list')
    stop('could not find createMakeItem method for item type =', class(item.info))

  class(item.info) <- item.info$block
  createMakeItem(item.info, ...)
}

#' \code{createMakeItem.fetch}: create makefile rules for an item in the fetch block
#' of viz.yaml
#'
#' @rdname createMakeItem
#' @importFrom utils methods
#' @export
createMakeItem.fetch <- function(item.info, ...) {

  rules <- list()

  # this is where we used to do something with a refetch argument from the
  # viz.yaml. Since we're taking that out, add a check & message here. A warning
  # might be more appropriate than an error but wouldn't always be seen by users
  # running this function via `make` (via Rscript or R CMD BATCH)
  if(!is.null(item.info$refetch)) {
    stop('refetch is deprecated and ignored')
  }
  if(!is.null(item.info$fetchTimestamp)) {
    stop('fetchTimestamp is deprecated and ignored')
  }
    
  # timestamp rules
  needs.timestamp <- needsTimestampOld(item.info)
  if(needs.timestamp) {
    squote <- function(x) paste0("'", x, "'")
    timestamp.id <- paste0(item.info$id, '_timestamp')
    timestamp.file <- paste0('vizlab/make/timestamps/', item.info$id)
    rules$file.timestamp <- createMakeEmptyRule(
      target=timestamp.file,
      depends=timestamp.id)
    phony.timestamp <- createMakeBatchRule(
      target=timestamp.id,
      fun='fetchTimestamp',
      funargs=c(viz=squote(item.info$id)),
      scripts=item.info$scripts,
      logfile=paste0('fetch/', timestamp.id, '.Rout'))
    # interleave a gnu make conditional (I hope it works on all systems!!) for exceedance of timetolive
    phony.timestamp.split <- strsplit(phony.timestamp, split='\n')[[1]]
    phony.timestamp.full <- c(phony.timestamp.split[1],
      sprintf("ifeq ($(shell echo $(shell Rscript -e \"vizlab::exceededTimeToLive('%s')\" 2> /dev/null)),TRUE)", item.info$id),
      phony.timestamp.split[-1],
      "else",
      sprintf("\t@echo \"%s: exceededTimeToLive('%s')=FALSE\"", timestamp.id, item.info$id),
      "endif")
    rules$phony.timestamp <- paste(phony.timestamp.full, collapse='\n')
  }
  
  # data rules
  item.info$depfiles <- if(needs.timestamp) timestamp.file else c()
  rules <- c(createMakeRulePair(item.info, block='fetch', concat=FALSE), rules)

  # return
  paste(unlist(unname(rules)), collapse='\n')
}

#' Determine whether an item should fetch a timestamp or not
#'
#' Looks in the dependency scripts and on the current search path (plus vizlab)
#' to determine whether the fetchTimestamp method for this fetcher is actually
#' available somewhere. DOESN'T currently look in any packages loaded via
#' `library` within the sourced scripts (to avoid altering the current
#' environment without the user's permission), which means we'll get confused if
#' some other package implements, say, fetchTimestamp.yadayada. That's an
#' unlikely situation, so if we need it, we can implement it then (or the user
#' can call `library()` on that package before calling `createMakefiles()`).
#'
#' Looks at the fetchTimestamp argument in this item's viz.yaml info to see what
#' the user expects.
#'
#' @return logical: TRUE if timestamp is needed (== a
#'   fetchTimestamp.fetcherforthisvizitem method is available), FALSE otherwise.
#'   Also produces an error if there's a mismatch between what's declared in the
#'   viz.yaml and whether a fetchTimestamp method appears to be available for
#'   this fetcher.
#' @importFrom utils getS3method
#' @md
#' @keywords internal
needsTimestampOld <- function(item.info) {
  
  # look for a fetchTimestamp method appropriate to this item's fetcher. this
  # code is a bit fragile, because we're not quite doing our darndest to
  # replicate the runtime environment. but it should work for the common cases,
  # and can be debugged/inspected by specifying a fetchTimestamp parameter in
  # the viz item (see next code block).
  FT_method <- paste0('fetchTimestamp.', item.info$fetcher)
  # (1) search through the text of the item's declared scripts
  scripts <- unlist(sapply(item.info$scripts, function(sdep) {
    if(dir.exists(sdep)) dir(sdep, full.names = TRUE) else sdep
  }))
  FT_in_scripts <- if(length(scripts) > 0) {
    script_text <- unlist(lapply(scripts, function(script) {
      deparse(parse(script)) # use deparse to get rid of commented-out code
    }))
    any(grep(FT_method, script_text, fixed=TRUE))
  } else FALSE
  # (2) search through the current global environment and
  FT_in_env <- !is.null(getS3method('fetchTimestamp', item.info$fetcher, optional=TRUE, envir=asNamespace('vizlab')))
  # accept the presence of a fetchTimestamp method in either location
  FT_method_exists <- FT_in_scripts || FT_in_env
  
  # enforce our current policy, which is to require the availability of a
  # fetchTimestamp method for every fetch item. this error is complemented by a
  # near-identical error in the fetchTimestamp.fetcher superclass method; we're
  # minimizing time to failure+understanding by giving this error in both places
  if(!FT_method_exists) {
    stop(paste0("fetchTimestamp.", item.info$fetcher, " must be implemented for ",
                item.info$id, ", probably in an R file in 'scripts:'"))
  }
  
  # return needsTimestamp = TRUE if and only if there is a matching
  # fetchTimestamp method for this item's fetcher
  return(FT_method_exists)
}

#' \code{createMakeItem.process}: create makefile rules for an item in the
#' process block of viz.yaml
#'
#' @rdname createMakeItem
#' @export
createMakeItem.process <- function(item.info, ...) {
  createMakeRulePair(item.info, block='process', concat=TRUE)
}

#' \code{createMakeItem.parameter}: create makefile rules for an item in the
#' parameter block of viz.yaml
#'
#' @rdname createMakeItem
#' @export
createMakeItem.parameter <- function(item.info, ...) {

  config.file <- file.path("vizlab/make/config",paste0(item.info$id,".rds"))
  paste0(item.info$id, ": ", config.file, "\n")

}

#' \code{createMakeItem.visualize}: create makefile rules for an item in the
#' visualize block of viz.yaml
#'
#' @rdname createMakeItem
#' @export
createMakeItem.visualize <- function(item.info, ...) {
  createMakeRulePair(item.info, block='visualize', concat=TRUE)
}

#' \code{createMakeItem.publish}: create makefile rules for an item in the
#' publish block of viz.yaml
#'
#' @rdname createMakeItem
#' @export
createMakeItem.publish <- function(item.info, ...) {
  createMakeRulePair(item.info, block='publish', concat=TRUE)
}

#' \code{createMakeItem.visualize}: create makefile rules for an item in the
#' visualize block of viz.yaml
#'
#' @rdname createMakeItem
#' @export
createMakeItem.makefile <- function(item.info, ...) {
  squote <- function(x) paste0("'", x, "'")
  rules <- list()
  rules$call.make <- createMakeShellRule(
    target=item.info$id,
    depends=item.info$location,
    cmd=paste0('make -f ', item.info$location))
  rules$file.make <- createMakeBatchRule(
    target=item.info$location,
    depends=item.info$depfiles,
    fun='createBlockMakefile',
    funargs=c(block=squote(item.info$id), outfile=squote(item.info$location)),
    logfile=paste0('make', '/', item.info$id, '.Rout'))

  paste(unlist(unname(rules)), collapse='\n')
}

#### General makefile-writing functions ####

#' Make the common rule pair relating IDs to files to commands
#'
#' Make the common rule pair where the item ID is a symbolic target that depends
#' on the file, and the file depends on the scripts, args, dependencies, etc.
#' listed in item.info
#'
#' @param item.info viz.yaml item info as from \code{getContentInfo}
#' @param block length 1 character designating the block for which to make the
#'   rule pair
#' @param concat logical. Should the rules be concatenated into a single string
#'   (TRUE) or left as a list of two rules (FALSE)?
#'
#' @export
createMakeRulePair <- function(item.info, block, concat=TRUE) {

  # arg prep
  squote <- function(x) paste0("'", x, "'")
  dquote <- function(x) paste0('"', x, '"')
  data.file <- item.info$location
  config.file <- file.path("vizlab/make/config",paste0(item.info$id,".rds"))

  if(!is.null(data.file) && grepl(" ", data.file)) data.file <- dquote(data.file)
  dep.location <- sapply(item.info$depends, function(dep) getContentInfo(dep)$location, USE.NAMES=FALSE)
  resource_ids <- getResourceIDs()
  if(any(item.info$depends %in% resource_ids)){
    dep.location[which(item.info$depends %in% resource_ids)] <- file.path(system.file(package="vizlab"),dep.location[which(item.info$depends %in% resource_ids)])
  }
  
  if(any(vapply(dep.location, is.null, TRUE))){
    glob_id <- which(vapply(dep.location, is.null, TRUE))
    config_dep <- file.path("vizlab/make/config",paste0(item.info$depends[glob_id],".rds"))
    dep.location[glob_id] <- config_dep
  }
  
  if(is.null(data.file)){
    data.file <- config.file
    dep.files <- c(
      item.info$depfiles, # depfiles get listed as dependencies but not read in or passed to the function
      dep.location
    )
  } else {
    dep.files <- c(
      item.info$depfiles, # depfiles get listed as dependencies but not read in or passed to the function
      dep.location,
      config.file
    )
  }
  
  # data args
  rules <- list()
  rules$phony.data <- createMakeEmptyRule(
    target=item.info$id,
    depends=data.file)
  rules$file.data <- createMakeBatchRule(
    target=data.file,
    depends=dep.files,
    fun=block,
    funargs=c(viz=squote(item.info$id)),
    scripts=item.info$scripts,
    logfile=paste0(block, '/', item.info$id, '.Rout'))

  # return
  if(concat) {
    paste(unlist(unname(rules)), collapse='\n')
  } else {
    rules
  }
}

#' Create text for a make rule that has no commands
#'
#' The resulting rule will have only a target and maybe dependencies, no
#' commands
#'
#' @param target character: the target name
#' @param depends character vector: the dependencies
#' @keywords internal
createMakeEmptyRule <- function(target, depends=c()) {
  depends_chr <- paste(depends, collapse=' ')
  sprintf('%s: %s', target, depends_chr)
}

#' Create text for a make rule using RBATCH
#'
#' Create the text for a gnu make target that runs a function using R CMD BATCH
#' and callFunction.R
#'
#' @param target character: the target name
#' @param depends character vector: the dependencies (omit callFunction.R and
#'   scripts; these will be automatically added)
#' @param fun character: the function name, to be ultimately evaluated in an
#'   environment where the scripts have been sourced and library(vizlab) has
#'   been called. if fun is missing, the command section of the make target
#'   declaration will be omitted
#' @param scripts  character vector: the scripts or script directories to load.
#'   omit 'scripts' because this will be automatically preprended
#' @param logfile character: the filename where the R CMD BATCH logfile should
#'   be saved. omit 'vizlab/make/log' because this will be automatically
#'   prepended
#' @keywords internal
createMakeBatchRule <- function(target, depends=c(), fun, funargs=c(), scripts=c(), logfile) {
  # R CMD BATCH works fine, but note for future dev: Rscript and littlr can do
  # everything R CMD BATCH can do and are preferred by Dirk Eddelbuettel. See
  # http://stackoverflow.com/questions/21969145/why-or-when-is-rscript-or-littler-better-than-r-cmd-batch/22358976#22358976,
  # http://stackoverflow.com/questions/14008139/capturing-rscript-errors-in-an-output-file,
  # etc. "To put the output and error in the same file (assuming sh/bash):
  # RScript --no-save --no-restore --verbose myRfile.R > outputFile.Rout 2>&1"

  # modify the arguments to fill in some details
  scripts <- if(length(scripts) > 0) scripts else c()
  depends <- c(depends, scripts)

  # convert complex arguments into character strings
  mQuote <- function(x) if(grepl(' ', x)) sprintf('\\\"%s\\\"', x) else x
  scripts_chr <- if(length(scripts) > 0) {
    paste0(' scripts=', mQuote(paste0("c(", paste0("'", scripts, "'", collapse=','), ")")))
  } else ''
  funargs_inner <- if(length(funargs) > 0) {
    paste0(names(funargs), "=", funargs, collapse=",")
  } else ''
  funargs_chr <- if(length(funargs) > 0) {
    paste0(' funargs=', mQuote(paste0("list(", funargs_inner, ")")))
  } else ''

  # create a descriptive character string to summarize the recipe & bash command
  is_helper_target <- !is.null(target) && nchar(target) > 7 && substr(target, 1, 7) == 'vizlab/'
  echo_target <- if(is.null(target)) tools::file_path_sans_ext(basename(logfile)) else target
  
  # produce the final character string
  paste(c(
    createMakeEmptyRule(target, depends),
    sprintf('\t@echo "%s: %s(%s)"', echo_target, fun, funargs_inner),
    sprintf('\t@export R_LIBS_USER=$(RLIBSUSER);\\'),
    sprintf('\t${RBATCH} "--args fun=%s%s%s" \\', fun, funargs_chr, scripts_chr),
    sprintf('\tvizlab/make/callFunction.R vizlab/make/log/%s', logfile)),
    collapse='\n')
}

#' Create text for a make rule that calls a shell command
#'
#' The shell command will be called exactly as-is
#'
#' @inheritParams createMakeEmptyRule
#' @param cmd character vector of one or more shell commands
#' @keywords internal
createMakeShellRule <- function(target, depends=c(), cmd) {
  # produce the final character string
  paste(c(
    createMakeEmptyRule(target, depends),
    paste0('\t', cmd)),
    collapse='\n')
}
USGS-VIZLAB/vizlab documentation built on July 10, 2019, 12:08 a.m.