1# Supress R CMD check note 2#' @importFrom memoise memoise 3NULL 4 5check_for_rstudio_updates <- function(os = tolower(Sys.info()[["sysname"]]), version = rstudioapi::getVersion(), in_rstudio = rstudioapi::isAvailable()) { 6 7 if (!in_rstudio) { 8 return() 9 } 10 11 url <- sprintf("https://www.rstudio.org/links/check_for_update?version=%s&os=%s&format=%s", version, os, "kvp") 12 13 tmp <- file_temp() 14 on.exit(file_delete(tmp)) 15 utils::download.file(url, tmp, quiet = TRUE) 16 result <- readLines(tmp, warn = FALSE) 17 18 result <- strsplit(result, "&")[[1]] 19 20 result <- strsplit(result, "=") 21 22 # If no values then we are current 23 if (length(result[[1]]) == 1) { 24 return() 25 } 26 27 nms <- vcapply(result, `[[`, 1) 28 values <- vcapply(result, function(x) utils::URLdecode(x[[2]])) 29 30 result <- stats::setNames(values, nms) 31 32 if (!nzchar(result[["update-version"]])) { 33 return() 34 } 35 36 return( 37 sprintf("%s.\nDownload at: %s", 38 result[["update-message"]], 39 ui_field(result[["update-url"]]) 40 ) 41 ) 42} 43 44.r_release <- function() { 45 R_system_version(rversions::r_release()$version) 46} 47 48r_release <- memoise::memoise(.r_release) 49 50#' Report package development situation 51#' 52#' @template devtools 53#' @inheritParams pkgbuild::has_build_tools 54#' @description `dev_sitrep()` reports 55#' * If R is up to date 56#' * If RStudio is up to date 57#' * If compiler build tools are installed and available for use 58#' * If devtools and its dependencies are up to date 59#' * If the package's dependencies are up to date 60#' 61#' @description Call this function if things seem weird and you're not sure 62#' what's wrong or how to fix it. If this function returns no output 63#' everything should be ready for package development. 64#' 65#' @return A named list, with S3 class `dev_sitrep` (for printing purposes). 66#' @importFrom usethis ui_code ui_field ui_todo ui_value ui_done ui_path 67#' @export 68#' @examples 69#' \dontrun{ 70#' dev_sitrep() 71#' } 72dev_sitrep <- function(pkg = ".", debug = FALSE) { 73 pkg <- tryCatch(as.package(pkg), error = function(e) NULL) 74 75 has_build_tools <- !is_windows || pkgbuild::has_build_tools(debug = debug) 76 77 structure( 78 list( 79 pkg = pkg, 80 r_version = getRversion(), 81 r_path = path_real(R.home()), 82 r_release_version = r_release(), 83 has_build_tools = has_build_tools, 84 rtools_path = if (has_build_tools) pkgbuild::rtools_path(), 85 devtools_version = packageVersion("devtools"), 86 devtools_deps = remotes::package_deps("devtools", dependencies = NA), 87 pkg_deps = if (!is.null(pkg)) { remotes::dev_package_deps(pkg$path, dependencies = TRUE) }, 88 rstudio_version = if (rstudioapi::isAvailable()) rstudioapi::getVersion(), 89 rstudio_msg = check_for_rstudio_updates() 90 ), 91 class = "dev_sitrep" 92 ) 93} 94 95#' @export 96print.dev_sitrep <- function(x, ...) { 97 98 all_ok <- TRUE 99 100 hd_line("R") 101 kv_line("version", x$r_version) 102 kv_line("path", x$r_path, path = TRUE) 103 if (x$r_version < x$r_release_version) { 104 ui_todo(' 105 {ui_field("R")} is out of date ({ui_value(x$r_version)} vs {ui_value(x$r_release_version)}) 106 ') 107 all_ok <- FALSE 108 } 109 110 if (is_windows) { 111 hd_line("Rtools") 112 if (x$has_build_tools) { 113 kv_line("path", x$rtools_path, path = TRUE) 114 } else { 115 ui_todo(' 116 {ui_field("RTools")} is not installed: 117 Download and install it from: {ui_field("https://cloud.r-project.org/bin/windows/Rtools/")} 118 ') 119 } 120 all_ok <- FALSE 121 } 122 123 if (!is.null(x$rstudio_version)) { 124 hd_line("RStudio") 125 kv_line("version", x$rstudio_version) 126 127 if (!is.null(x$rstudio_msg)) { 128 ui_todo(x$rstudio_msg) 129 all_ok <- FALSE 130 } 131 } 132 133 134 hd_line("devtools") 135 kv_line("version", x$devtools_version) 136 137 devtools_deps_old <- x$devtools_deps$diff < 0 138 if (any(devtools_deps_old)) { 139 ui_todo(' 140 {ui_field("devtools")} or its dependencies out of date: 141 {paste(ui_value(x$devtools_deps$package[devtools_deps_old]), collapse = ", ")} 142 Update them with {ui_code("devtools::update_packages(\\"devtools\\")")} 143 ') 144 all_ok <- FALSE 145 } 146 147 hd_line("dev package") 148 kv_line("package", x$pkg$package) 149 kv_line("path", x$pkg$path, path = TRUE) 150 151 pkg_deps_old <- x$pkg_deps$diff < 0 152 if (any(pkg_deps_old)) { 153 ui_todo(' 154 {ui_field(x$pkg$package)} dependencies out of date: 155 {paste(ui_value(x$pkg_deps$package[pkg_deps_old]), collapse = ", ")} 156 Update them with {ui_code("devtools::install_dev_deps()")} 157 ') 158 all_ok <- FALSE 159 } 160 161 if (all_ok) { 162 ui_done(" 163 All checks passed 164 ") 165 } 166 167 invisible(x) 168} 169 170 171# Helpers ----------------------------------------------------------------- 172 173hd_line <- function(name) { 174 cat_rule(cli::style_bold(name)) 175} 176 177kv_line <- function (key, value, path = FALSE) { 178 if (is.null(value)) { 179 value <- cli::col_silver("<unset>") 180 } 181 else { 182 if (path) { 183 value <- ui_path(value, base = NA) 184 } else { 185 value <- ui_value(value) 186 } 187 } 188 cli::cat_line(cli::symbol$bullet, " ", key, ": ", value) 189} 190