#' @include file.handler.R
#' @include filepath.R
#' the Maker class is responsible for making a file.
Maker <- R6::R6Class(
"Maker",
private = list(
#' the dir that this maker manages
dir = NULL,
#' the list of file nodes
nodes = list(),
#' the list of implicit make rules (i.e., the pattern of a rule contains %)
implicit = list(),
#' recipes, named by their recipe ID.
recipes = list(),
#' traverse the dependence graph
#' @param file the file to start from
#' @param path the path that has traversed
#' @param makelist the list of files that needs to be made before file
#' @return a new makelist including file and all its dependences
traverse = function(file, path, makelist) {
if (file %in% path)
stop("circular dependences: ",
paste(c(path, file), collapse = " -> "), call.=FALSE)
parent <- tail(path, 1)
# is file already requested for make?
entry <- makelist[[file]]
if (!is.null(entry)) {
# mark an extra parent and
if (length(parent) > 0) {
entry$parent = c(entry$parent, parent)
makelist[[file]] <- entry
}
return(makelist)
}
# traverse its dependences
path <- c(path, file)
nodes <- private$nodesForFile(file)
for (node in nodes) {
result <- makelist
private$scan(file, node)
deps <- node$dependences
for (dep in deps) {
result <- private$traverse(dep, path, result)
if (is.null(result)) {
if (dep %in% node$auto)
stop("File ", file, " cannot make dependence ", dep, call.=FALSE)
break
}
}
# add file to the makelist
if (!is.null(result)) {
result[[file]] <- list(parent=parent, depend=deps)
private$nodes[[file]] <-node
return(result)
}
}
NULL
},
#' scans for automatic dependences for a file
#' @param file the file to scan
#' @param node the dependence node of the file
scan = function(file, node) {
node$timestamp <- as.numeric(file.mtime(file))
# scan only if file exists
if (is.na(node$timestamp)) {
node$auto <- c()
} else {
auto.time <- attr(node$auto, "timestamp")
if (!is.null(auto.time) && auto.time > node$timestamp)
return()
scanner <- scanners$get(file)
if (is.null(scanner)) {
node$auto <- c()
} else {
node$auto <- scanner$scan(file)
attr(node$auto, "timestamp") <- node$timestamp
}
}
},
#' returns a list of nodes that can handle a file
#' @param file the file to make
#' @return a list of Node object, or NULL if file does not exist and there is no rule corresponding to the file.
nodesForFile = function(file) {
# search for a previously created node for the file
node <- private$nodes[[file]]
# if not found, search for an implicit rule
if (!is.null(node)) return(list(node))
nodes <- list()
for (r in private$implicit) {
node <- r$match(file)
if (!is.null(node)) nodes <- c(nodes, node)
}
if (length(nodes) == 0 && file.exists(file)) {
list(Node$new(c(), NULL))
} else nodes
},
#' build a file
#' @param file the file to build
#' @param timestamp the timestamp of the dependences
#' @return the timestamp of the file
build = function(file, timestamp) {
node <- private$nodes[[file]]
mtime <- as.numeric(file.mtime(file))
if (is.null(node)) {
if (!is.na(mtime)) return(mtime)
# this should not happen, i.e., the file does not exist,
# but there is no corresponding node.
stop("Internal error in making ", file, call.=FALSE)
}
if (is.null(node$timestamp) || is.na(node$timestamp) ||
is.na(mtime) || node$timestamp < mtime)
node$timestamp <- mtime
if (is.na(node$timestamp)) {
build <- TRUE
} else if (is.null(timestamp)) {
build <- FALSE
} else if (node$timestamp < timestamp) {
build <- TRUE
node$timestamp <- timestamp
} else build <- FALSE
if (!build)
return (node$timestamp)
recipeID <- node$recipe
recipe <- if (is.null(recipeID)) NULL else private$recipes[[recipeID]]
if (!is.null(recipe)) {
cat("building ", file, "\n", sep="", file=stderr())
tryCatch({
ok <- FALSE
tracker$push()
if (is.function(recipe)) {
recipe(file, node$dependences)
} else if (is(recipe, "Recipe")) {
recipe$run(file, node$dependences)
}
ok <- TRUE
}, finally = {
mtime <- file.mtime(file)
deps <- tracker$pop()
if (ok) {
node$timestamp <- if(is.na(mtime)) timestamp else mtime
if (length(deps) > 0) {
auto.time <- attr(node$auto, "timestamp")
if (is.null(auto.time) || auto.time < mtime)
private$scan(file, node)
node$auto <- c(node$auto, deps)
attr(node$auto, "timestamp") <- mtime
}
} else {
if (!is.na(mtime)) file.remove(file)
node$timestamp <- NA
}
})
}
node$timestamp
}
),
public = list(
#' check if the file can be handled by this maker
#' it checks if the file is in the dir (self$pattern)
#' @param file the file to check
#' @return
canHandle = function(file) {
return (substr(file, 1, nchar(private$dir)) == private$dir)
},
#' make a file
#' @param file the file to make
make = function(file) {
# if asked to make a list of files, make them one by one
if (length(file) > 1) {
for (f in file)
self$make(f)
return()
}
if (isAbsolutePath(file)) {
file <- substring(file, nchar(private$dir)+2)
}
# traverse the tree, while issuing make commands
makelist <- private$traverse(file, path=c(), makelist=list())
if (is.null(makelist))
stop("Do not know how to make ", file, call.=FALSE)
timestamp <- NULL
while (length(makelist) > 0) {
# make all the iles with no dependences
pick <- sapply(makelist, function(file) { length(file$depend) == 0 })
if (length(which(pick)) == 0) {
stop("No leaf in the dependence graph!", call.=FALSE)
}
leaves <- makelist[pick]
for (leaf in names(leaves)) {
timestamp <- private$build(leaf, timestamp)
# remove leaf from each parent's dependences
# and update the parent's timestamp
for (parent in leaves[[leaf]]$parent) {
p <- makelist[[parent]]
deps <- p$depend
p$depend <- deps[which(deps != leaf)]
if (is.null(p$timestamp) || p$timestamp < timestamp)
p$timestamp <- timestamp
makelist[[parent]] <- p
}
}
makelist <- makelist[!pick]
}
},
#' add a rule to the list of rules
#' @param target of the rule
#' @param depend the list of dependences of the target
#' @param recipe the recipe to make the target
#' @return the dependence node or the implicit rule
addRule = function(target, depend=c(), recipe=NULL) {
if (length(target) > 1) {
for (targ in target) self$addRule(targ, depend, recipe)
} else {
if (length(target) == 0 || target == "")
stop("A rule must have a target", call.=FALSE)
# compute the recipeID
recipeID <- paste(target, paste(depend, collapse="+"), sep="~")
if (!is.null(private$recipes[[recipeID]])) {
stop("The rule for ", recipeID, " already exists. Skipping it.")
}
private$recipes[[recipeID]] <- recipe
# check if this is an implicit rule.
if (grepl("%", target)) {
node <- ImplicitRule$new(target, depend, recipeID)
private$implicit[[recipeID]] <- node
} else {
node <- Node$new(depend, recipeID)
private$nodes[[target]] <- node
}
node
}
}
,
#' clear the rules
clear = function() {
private$nodes <- list()
private$implicit <- list()
private$recipes <- list()
}
,
#' initializer
#' @param dir the directory that this maker managers
initialize = function(dir) {
private$dir <- normalizePath(dir)
if (!file.exists(private$dir))
stop("The directory ", dir, " does not exist.", call.=FALSE)
self$clear()
},
#' load the rules from Makefile.R
load = function() {
makefile <- file.path(private$dir, "Makefile.R")
if (file.exists(makefile)) {
source(makefile, local=TRUE)
}
},
#' print the maker
print = function() {
cat("dir =", private$dir, "\n")
cat("explicit rules:\n")
for (r in names(private$nodes)) {
cat(r, "~ ")
print(private$nodes[[r]])
}
cat("\nimplicit rules:\n")
for (r in private$implicit) {
print(r)
}
cat("\nrecipes:\n")
for (r in names(private$recipes)) {
cat(r, "= ")
print(private$recipes[[r]])
}
}
)
)
pkg.env <- new.env()
#' clear the list of rules and load from Makefile.R
#' @export
resetRules <- function() {
pkg.env$maker <- Maker$new(getwd())
pkg.env$maker$load()
}
#' tracks the files being automatically opened.
MakeTracker <- R6::R6Class(
"MakeTracker",
private = list(
#' a stack of trackers
listeners = list()
),
public = list(
#' adding the current file to the top tracker
#' @param file the tracked file
track = function(file) {
if (length(private$listeners) != 0)
private$listeners[[1]] <- c(private$listeners[[1]], file)
},
#' starts a new tracker
push = function() {
private$listeners <- c(list(c()), private$listeners)
},
#' finish tracking and pop off the stack
#' @return the files being used
pop = function() {
l <- private$listeners[[1]]
private$listeners <- private$listeners[-1]
l
}
)
)
tracker <- MakeTracker$new()
#' make a file
#' @param file the file to make
#' @param force force to build the file regardless if it is stale or not.
#' @return none
#' @export
make <- function(file="all", force=FALSE) {
maker <- pkg.env$maker
if (is.null(maker)) return()
abs <- normalizePath(file)
if (force && file.exists(abs)) file.remove(abs)
if (maker$canHandle(abs)) {
tracker$track(file)
maker$make(file)
} else if (!file.exists(file))
stop("do not know how to make ", file)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.