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