R/make_rules.R

In jchrom/datamake: Create Makefiles for data analysis in R

# Build rules out of I/O calls

#' Format calls
#'
#' Add commands ('script'), parse deps into bare file name, suffix.
#' @param io.calls Output of parse_io
#' @param script A named list of shell commands for specific file types
#' @importFrom dplyr data_frame

tidy_io = function(io.calls,
                   script = list(
                     R = "Rscript \"$(<)\"",
                     Rmd = "Rscript -e \"rmarkdown::render('$(<)')\"")) {

  # How will scripts be executed? By default, we only have commands for R, Rmd
  if (is.null(names(script)) | any(names(script) == ""))
    stop("Each script must have a unique name (a file suffix)",
         call. = FALSE)

  # Add: shell commands ('script'), dir names, bare file names, suffixes
  apply(
    X = io.calls,
    MARGIN = 1,
    FUN = function(this.call) {
      data_frame(
        full.file = this.call[["full.file"]],
        script = list(script[[file_suffix(full.file)]]),
        targets = list(this.call[["targets"]]),
        deps = list(this.call[["deps"]]),
        deps.file = list(file_bare(deps)),
        deps.type = list(file_suffix(deps)),
        deps.dir = list(file_path(deps)))
    })
}

# DETERMINE TARGET 'ALL' ----
# ===========================

# Pick a script, such that none of the targets it makes is a prerequisite for
# something else.

# Procedure:
# 1. Loop through I/O calls (returned by parse_io)
# 2. For each call's targets find a match within the other calls' deps
# 3. No match: break the loop and return that element
# 4. Match: go to next element
# 5. Keep looping until a "No match" situation happens
# 6. If match is always found, return NULL and issue a warning

find_all = function(io.calls) {

  for (i in seq_along(io.calls)) {

    i.targets = unlist(io.calls[[i]][["targets"]])
    i.pool = io.calls[-i]
    i.match = logical()

    for (j in seq_along(i.pool)) {
      j.deps = unlist(i.pool[[j]][["deps"]])
      # target is null - don't pick for 'all'
      if (is.null(i.targets))
        i.match[j] = TRUE
      # target not null and matched in deps - don't pick for 'all'
      else if (all(!is.null(j.deps), !is.null(i.targets)) && i.targets %in% j.deps)
        i.match[j] = TRUE
      else
        i.match[j] = FALSE
    }
    if (!any(i.match))
      return(io.calls[[i]])
  }
  message("No clear candidate for 'all' - returning NULL")
  NULL
}

# Prepare 'all' - since it will become a .PHONY, its command has to be NULL
tidy_all = function(io.call) {

  if (is.null(io.call[["targets"]]))
    stop("'all' (",  io.call[["full.file"]],
         ") has no targets (did you forget to name the 'file' argument?)",
         call. = FALSE)

  message("picking target(s) of '", io.call[["full.file"]],
          "' as prerequisites for 'all'")

  dplyr::data_frame(
    full.file = ".PHONY", script = list(NULL), targets = list("all"),
    deps = list(NULL), deps.file = list(unlist(io.call[["targets"]])),
    deps.type = list(NULL), deps.dir = list(NULL)
  )
}

#' Make rules
#'
#' Find a candidate for .PHONY all. Collapse a list of I/O calls into rules.
#' @param io.tidy The output od tidy_io
#' @param script.all Which script produces the ultimate target? By default a script that creates targets on which nothing else depends
#' @importFrom dplyr bind_rows
#' @importFrom MakefileR make_rule

as_Makefiler = function(io.tidy, script.all = NULL) {

  if (!is.null(script.all)) {
    stopifnot(file.exists(script.all))
    io.all = io.tidy[[script.all]]
  }
  else
    io.all = find_all(io.tidy)

  if (is.null(io.all))
    io.tidy = bind_rows(io.tidy)
  else
    io.tidy = bind_rows(tidy_all(io.all), io.tidy)

   c(vpath = list(make_vpath(io.tidy)),
    .PHONY = list(make_rule(".PHONY", "all", NULL)),
    rules = apply(io.tidy, 1, safe_rule))
}

#' Safely run make_rule
#'
#' If MakefileR::make_rule throws and error, make a comments instead
#' @param io.call Rule
#' @importFrom MakefileR make_rule make_comment

safe_rule = function(io.call)
  tryCatch(
    expr = make_rule(
      targets = io.call[["targets"]], deps = io.call[["deps.file"]],
      script = io.call[["script"]]
    ),
    error = function(e) {
      msg = paste0(io.call[["deps.file"]][[1]], ": ", e$message)
      warning(msg, call. = FALSE)
      make_comment(msg)
    })

#' Directive vpath
#'
#' Tell make where to look for deps
#' @param io.tidy Output of rule_io
#' @importFrom MakefileR make_text

make_vpath = function(io.tidy) {

  deps.type = unlist(io.tidy[["deps.type"]])
  deps.dir = unlist(io.tidy[["deps.dir"]])

  vpath.list = lapply(
    X = unique(deps.dir),
    FUN = function(this.dir) {
      this.file = unique(deps.type[deps.dir == this.dir])
      these.files = paste(this.file, collapse = ", ")
      message("make will search ", this.dir, " for: ", these.files)
      paste("vpath %.", this.file, " ", this.dir, sep = "")
    })

  make_text(unlist(vpath.list))
}