|
2 | 2 | projectScanPackages <- function(project = getwd(), verbose = TRUE, use.knitr = FALSE){ |
3 | 3 | # detect all package dependencies for a project |
4 | 4 | dir <- normalizePath(project, winslash='/', mustWork=FALSE) |
5 | | - pattern <- if(!use.knitr) "\\.[rR]$" else |
6 | | - "\\.[rR]$|\\.[rR]md$|\\.[rR]nw$|\\.[rR]pres$" |
| 5 | + pattern <- if(!use.knitr) "\\.[rR]$|\\.[rR]nw$" else |
| 6 | + "\\.[rR]$|\\.[rR]nw$|\\.[rR]md$|\\.[rR]pres$" |
7 | 7 |
|
8 | | - R_files <- list.files(dir, pattern = pattern, ignore.case = TRUE, recursive = TRUE) |
| 8 | + ext_r <- c("R", "Rnw") |
| 9 | + ext_k <- c("Rmd", "Rpres", "Rhmtl") # knitr / rmarkdown extensions |
9 | 10 |
|
10 | | - # ## ignore anything in the checkpoint directory |
11 | | - # R_files <- grep("^checkpoint", R_files, invert = TRUE, value = TRUE) |
| 11 | + makePtn <- function(x)sprintf("\\.(%s)$", paste(c(x, tolower(x)), collapse="|")) |
12 | 12 |
|
13 | | - pkgs <- unlist(unique(sapply(R_files, deps_by_ext, dir=dir))) |
14 | | - as.vector(pkgs) |
| 13 | + files_r <- list.files(dir, pattern = makePtn(ext_r), ignore.case = TRUE, recursive = TRUE) |
| 14 | + files_k <- list.files(dir, pattern = makePtn(ext_k), ignore.case = TRUE, recursive = TRUE) |
15 | 15 |
|
| 16 | + R_files <- files_r |
| 17 | + |
| 18 | + if(length(files_k) > 0) { |
| 19 | + if(use.knitr) { |
| 20 | + if(!require("knitr")) { |
| 21 | + warning("The knitr package is not available and Rmarkdown files will not be parsed") |
| 22 | + } else { |
| 23 | + R_files <- c(files_r, files_k) |
| 24 | + } |
| 25 | + } else { |
| 26 | + warning("rmarkdown files found and will not be parsed. Set use.knitr = TRUE") |
| 27 | + } |
| 28 | + } |
| 29 | + |
| 30 | + if(length(R_files) == 0){ |
| 31 | + list(pkgs = character(), error = character()) |
| 32 | + } else { |
| 33 | + if(interactive()){ |
| 34 | + z <- lapplyProgressBar(R_files, deps_by_ext, dir=dir, verbose=verbose) |
| 35 | + } else { |
| 36 | + z <- lapply(R_files, deps_by_ext, dir=dir, verbose=verbose) |
| 37 | + } |
| 38 | + |
| 39 | + pkgs <- sort(unique(do.call(c, lapply(z, "[[", "pkgs")))) |
| 40 | + error <- sort(unique(do.call(c, lapply(z, "[[", "error")))) |
| 41 | + error <- gsub(sprintf("%s[//|\\]*", dir), "", error) |
| 42 | + list(pkgs = pkgs, error = error) |
| 43 | + } |
| 44 | + |
| 45 | +} |
| 46 | + |
| 47 | +lapplyProgressBar <- function(X, FUN, ...){ |
| 48 | + env <- environment() |
| 49 | + N <- length(X) |
| 50 | + counter <- 0 |
| 51 | + pb <- txtProgressBar(min = 0, max = N, style = 3) |
| 52 | + on.exit(close(pb)) |
| 53 | + |
| 54 | + wrapper <- function(...){ |
| 55 | + curVal <- get("counter", envir = env) |
| 56 | + assign("counter", curVal + 1, envir = env) |
| 57 | + setTxtProgressBar(get("pb", envir = env), curVal + 1) |
| 58 | + FUN(...) |
| 59 | + } |
| 60 | + lapply(X, wrapper, ...) |
16 | 61 | } |
17 | 62 |
|
| 63 | +getFileExtension <- function(filename)tolower(gsub(".*\\.", "", filename)) |
| 64 | + |
18 | 65 |
|
19 | 66 |
|
20 | 67 | # ad-hoc dispatch based on the file extension |
21 | | -deps_by_ext <- function(file, dir) { |
| 68 | +deps_by_ext <- function(file, dir, verbose = TRUE) { |
22 | 69 | file <- file.path(dir, file) |
23 | | - fileext <- tolower(gsub(".*\\.", "", file)) |
| 70 | + fileext <- getFileExtension(file) |
24 | 71 | switch(fileext, |
25 | | - r = deps.R(file), |
26 | | - rmd = deps.Rmd(file), |
27 | | - rnw = deps.Rnw(file), |
28 | | - rpres = deps.Rpres(file), |
29 | | - txt = deps.txt(file), |
| 72 | + r = deps.R(file, verbose = verbose), |
| 73 | + rmd = deps.Rmd(file, verbose = verbose), |
| 74 | + rnw = deps.Rnw(file, verbose = verbose), |
| 75 | + rpres = deps.Rpres(file, verbose = verbose), |
| 76 | + txt = deps.txt(file, verbose = verbose), |
30 | 77 | stop("Unrecognized file type '", file, "'") |
31 | 78 | ) |
32 | 79 | } |
33 | 80 |
|
34 | 81 | deps.Rmd <- deps.Rpres <- function(file, verbose=TRUE) { |
35 | | - tempfile <- tempfile() |
| 82 | + tempfile <- tempfile(fileext = ".Rmd") |
36 | 83 | on.exit(unlink(tempfile)) |
37 | 84 | stopifnot(require("knitr")) |
38 | | - tryCatch(knitr::knit(file, output = tempfile, tangle = TRUE, quiet = TRUE), error = function(e) { |
39 | | - mssg(verbose, "Unable to knit file '", file, "'; cannot parse dependencies") |
40 | | - character() |
41 | | - }) |
42 | | - deps.R(tempfile) |
| 85 | + p <- tryCatch( |
| 86 | + suppressWarnings(suppressMessages( |
| 87 | + knitr::knit(file, output = tempfile, tangle = TRUE, quiet = TRUE) |
| 88 | + )), |
| 89 | + error = function(e) e |
| 90 | + ) |
| 91 | + |
| 92 | + if(inherits(p, "error")) { |
| 93 | + return(list(pkgs=character(), error=file)) |
| 94 | + } |
| 95 | + |
| 96 | + p <- deps.R(tempfile) |
| 97 | + if(length(p[["error"]]) != 0 ) { |
| 98 | + p[["error"]] <- file |
| 99 | + } |
| 100 | + p |
43 | 101 | } |
44 | 102 |
|
45 | 103 | deps.Rnw <- function(file, verbose=TRUE) { |
46 | | - tempfile <- tempfile() |
| 104 | + tempfile <- tempfile(fileext = ".Rnw") |
47 | 105 | on.exit(unlink(tempfile)) |
48 | | - tryCatch(Stangle(file, output = tempfile, quiet = TRUE), error = function(e) { |
49 | | - mssg(verbose, "Unable to stangle file '", file, "'; cannot parse dependencies") |
50 | | - character() |
51 | | - }) |
52 | | - deps.R(tempfile) |
| 106 | + p <- tryCatch( |
| 107 | + suppressWarnings(suppressMessages( |
| 108 | + Stangle(file, output = tempfile, quiet = TRUE) |
| 109 | + )), |
| 110 | + error = function(e) e |
| 111 | + ) |
| 112 | + if(inherits(p, "error")) { |
| 113 | + return(list(pkgs=character(), error=file)) |
| 114 | + } |
| 115 | + |
| 116 | + p <- deps.R(tempfile) |
| 117 | + if(length(p[["error"]]) != 0 ) { |
| 118 | + p[["error"]] <- file |
| 119 | + } |
| 120 | + p |
53 | 121 | } |
54 | 122 |
|
55 | 123 | deps.R <- deps.txt <- function(file, verbose=TRUE) { |
56 | 124 |
|
57 | 125 | if (!file.exists(file)) { |
58 | 126 | warning("No file at path '", file, "'.") |
59 | | - return(character()) |
| 127 | + return(list(pkgs=character(), error=file)) |
60 | 128 | } |
61 | 129 |
|
62 | 130 | # build a list of package dependencies to return |
63 | 131 | pkgs <- character() |
64 | 132 |
|
65 | 133 | # parse file and examine expressions |
66 | | - tryCatch({ |
| 134 | + p <- tryCatch({ |
67 | 135 | exprs <- suppressWarnings(parse(file, n = -1L)) |
68 | 136 | for (i in seq_along(exprs)) |
69 | 137 | pkgs <- append(pkgs, expressionDependencies(exprs[[i]])) |
70 | | - }, error = function(e) { |
71 | | - warning(paste("Failed to parse", file, "; dependencies in this file will", |
72 | | - "not be discovered.")) |
73 | | - }) |
74 | | - |
75 | | - # return packages |
76 | | - unique(pkgs) |
| 138 | + }, error = function(e) e |
| 139 | + ) |
| 140 | + if(inherits(p, "error")) { |
| 141 | + list(pkgs=character(), error=file) |
| 142 | + } else { |
| 143 | + list(pkgs=unique(pkgs), error=character()) |
| 144 | + } |
77 | 145 | } |
78 | 146 |
|
79 | 147 | expressionDependencies <- function(e) { |
|
0 commit comments