R/rstd.gen.R

In salim-b/rstd: Unofficial Utility Functions Around the RStudio IDE

# DO NOT EDIT THIS FILE BY HAND! Instead edit the R Markdown source file `Rmd/rstd.Rmd` and run `pkgpurl::purl_rmd()`.
# See `README.md#r-markdown-format` for more information on the literate programming approach used applying the R Markdown format.

# rstd: Unofficial Utility Functions Around the RStudio IDE
# Copyright (C) 2025 Salim Brüggemann
# 
# This program is free software: you can redistribute it and/or modify it under the terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or any later version.
# 
# This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
# A PARTICULAR PURPOSE. See the GNU Affero General Public License for more details.
# 
# You should have received a copy of the GNU Affero General Public License along with this program. If not, see <https://www.gnu.org/licenses/>.

.onLoad <- function(libname, pkgname) {
  
  # clear pkgpins cache
  tryCatch(expr = pkgpins::clear_cache(board = pkgpins::board(pkg = pkgname),
                                       max_age = funky::config_val(key = "global_max_cache_age",
                                                                     pkg = pkgname)),
           error = function(e) cli::cli_alert_warning(text = "Failed to clear pkgpins cache on load of {.pkg {pkgname}}. Error message: {e$message}"))
}

utils::globalVariables(names = c(".",
                                 # tidyselect fns
                                 "everything",
                                 # other
                                 "is_pro",
                                 "key",
                                 "last_modified",
                                 "name"))

this_pkg <- utils::packageName()

all_bundled_tools <- c("dart-sass",
                       "deno",
                       "esbuild",
                       "pandoc",
                       "quarto")

#' Test if RStudio is up to date
#'
#' @inheritParams latest_version
#' @param stable Set to `FALSE` in order to test against the latest [RStudio preview build](https://rstudio.com/products/rstudio/download/preview/) instead
#'   of the latest [stable build](https://rstudio.com/products/rstudio/download/).
#'
#' @return `TRUE` if the currently running RStudio version is greater or equal to the latest version, `FALSE` otherwise.
#' @export
is_latest <- function(stable = TRUE,
                      os = NULL) {
  
  rstudioapi::versionInfo()$version >= latest_version(type = rstudioapi::versionInfo()$mode,
                                                      stable = stable,
                                                      os = os)
}

#' Get latest RStudio version number
#'
#' @inheritParams releases
#' @param pro `TRUE` for the proprietary RStudio (Server) Pro edition and `FALSE` for the open-source RStudio (Server) edition.
#' @param os The OS _codename_ for which the RStudio version was built. If `NULL`, it will be auto-detected for the current system.
#'
#' @return `r pkgsnip::return_lbl("num_vrsn")`
#' @export
#'
#' @examples
#' latest_version(os = "macos",
#'                use_cache = FALSE)
latest_version <- function(type = c("desktop", "server"),
                           stable = TRUE,
                           pro = FALSE,
                           os = NULL,
                           use_cache = TRUE,
                           max_cache_age = "1 day") {
  
  type <- rlang::arg_match(type)
  checkmate::assert_flag(pro)
  
  data <-
    type |>
    releases(stable = stable,
             use_cache = use_cache,
             max_cache_age = max_cache_age) |>
    dplyr::filter(is_pro == pro)
  
  supported_os <-
    data[["os"]] |>
    unique() |>
    setdiff(NA)
  
  if (is.null(os)) {
    os <-
      if (xfun::is_linux()) {
        system2(command = "lsb_release",
                args = "-cs",
                stdout = TRUE,
                stderr = TRUE)
      } else if (xfun::is_macos()) {
        "macos"
      } else if (xfun::is_windows()) {
        "windows"
      } else {
        cli::cli_abort("Unknown operating system detected.")
      }
    
    if (!(os %in% supported_os)) {
      
      cli::cli_abort(paste0("The RStudio release suited to your Linux distribution {.field {utils::sessionInfo('base')$running}} codename {.field {os}} ",
                            "couldn't be auto-detected. Please set {.arg os} to one of {.or {.val {supported_os}}}."))
    }
  } else {
    os <- rlang::arg_match(arg = os,
                           values = supported_os)
  }
  
  data |>
    dplyr::filter(os == os) %$%
    version |>
    max() |>
    unique() |>
    as.numeric_version()
}

#' Get RStudio release metadata
#'
#' @param type Either `"desktop"` for [RStudio Desktop](https://rstudio.com/products/rstudio/#rstudio-desktop) or `"server"` for
#'   [RStudio Server](https://rstudio.com/products/rstudio/#rstudio-server) release metadata.
#' @param stable Set to `FALSE` to retrieve release metadata of [RStudio preview builds](https://rstudio.com/products/rstudio/download/preview/) instead of
#'   [stable builds](https://rstudio.com/products/rstudio/download/).
#' @param use_cache `r pkgsnip::param_lbl("use_cache")`
#' @param max_cache_age `r pkgsnip::param_lbl("max_cache_age")` Defaults to 1 day (24 hours).
#'
#' @return `r pkgsnip::return_lbl("tibble")`
#' @export
#'
#' @examples
#' releases(type = "server",
#'          max_cache_age = "1 year 2 months 3 weeks 4 days 5 hours 6 minutes 7 seconds")
releases <- function(type = c("desktop", "server"),
                     stable = TRUE,
                     use_cache = TRUE,
                     max_cache_age = "1 day") {
  
  type <- rlang::arg_match(type)
  checkmate::assert_flag(stable)
  
  pkgpins::with_cache(expr = get_releases(type = type,
                                          stable = stable),
                      pkg = this_pkg,
                      from_fn = "releases",
                      stable,
                      use_cache = use_cache,
                      max_cache_age = max_cache_age)
}

get_releases <- function(type,
                         stable) {
  stable |>
    ifelse(yes = paste0("https://download", ifelse(type == "desktop", 1L, 2L), ".rstudio.org/"),
           no = paste0("https://s3.amazonaws.com/rstudio-ide-build/")) |>
    xml2::read_xml() |>
    xml2::as_list() |>
    purrr::keep(\(x) x[["Name"]] == ifelse(stable,
                                           glue::glue("rstudio-{type}"),
                                           "rstudio-ide-build")) |>
    purrr::chuck("ListBucketResult") |>
    purrr::imap(\(x, i) {
      if (i == "Contents") x else NULL
    }) |>
    purrr::compact() |>
    purrr::map_depth(.depth = 2L,
                     .f = unlist) |>
    purrr::map(tibble::as_tibble) |>
    purrr::list_rbind() |>
    dplyr::rename_with(.cols = everything(),
                       .fn = heck::to_snake_case) |>
    dplyr::mutate(last_modified =
                    last_modified |>
                    clock::naive_time_parse(format = "%Y-%m-%dT%H:%M:%SZ",
                                            precision = "millisecond") |>
                    clock::time_point_round(precision = "second") |>
                    clock::as_date_time(zone = "UTC"),
                  is_pro = stringr::str_detect(string = key,
                                               pattern = stringr::fixed("-pro-")),
                  os = stringr::str_extract(string = key,
                                            pattern = "(?<=^desktop/)[^/]+(?=/)"),
                  version = stringr::str_extract(string = key,
                                                 pattern = "(?i)(?<=rstudio-((pro|server)-)?)\\d+([\\.-]\\d+)*")) |>
    dplyr::filter(key != "current.ver")
}

#' Get path to CLI tool bundled with RStudio
#'
#' Returns the filesytem path to one of the command-line interface (CLI) tools bundled with RStudio, like [Quarto](https://quarto.org/),
#' [Pandoc](https://pandoc.org/), [Dart Sass](https://sass-lang.com/dart-sass/), etc.
#'
#' @param tool Tool name. One of `r pal::enum_fn_param_defaults(param = "tool", fn = bundled_cli_path)`.
#'
#' @return `r pkgsnip::return_lbl("path")`
#' @export
#'
#' @examples
#' rstd::bundled_cli_path(tool = "pandoc")
bundled_cli_path <- function(tool = all_bundled_tools) {
  
  tool <- rlang::arg_match(tool)
  
  dir_tools <- Sys.getenv("RSTUDIO_PANDOC")
  
  if (nchar(dir_tools) == 0L) {
    cli::cli_abort(paste0("The required {.href [environment variable](https://en.wikipedia.org/wiki/Environment_variable)} {.envvar RSTUDIO_PANDOC} is not ",
                          "set. Note that running this function outside of RStudio is not supported."))
  }
  
  switch(EXPR = tool,
         `dart-sass` = fs::dir_ls(path = dir_tools,
                                  recurse = TRUE,
                                  type = "file",
                                  regexp = "sass(\\.exe)?$"),
         deno = fs::dir_ls(path = dir_tools,
                           recurse = TRUE,
                           type = "file",
                           regexp = "deno(\\.exe)?$"),
         esbuild = fs::dir_ls(path = dir_tools,
                              recurse = TRUE,
                              type = "file",
                              regexp = "esbuild(\\.exe)?$"),
         pandoc = fs::dir_ls(path = dir_tools,
                             recurse = TRUE,
                             type = "file",
                             regexp = "pandoc(\\.exe)?$"),
         quarto = fs::dir_ls(path = fs::path_dir(fs::path_dir(dir_tools)),
                             recurse = TRUE,
                             type = "file",
                             regexp = "quarto(\\.exe)?$"),
         cli::cli_abort("Handling {.arg tool} {.val {tool}} is not yet implemented.",
                        .internal = TRUE)) |>
    dplyr::first()
}

#' Determine version of CLI tool bundled with RStudio
#'
#' Determines the version of one of the command-line interface (CLI) tools bundled with RStudio, like [Quarto](https://quarto.org/),
#' [Pandoc](https://pandoc.org/), [Dart Sass](https://sass-lang.com/dart-sass/), etc.
#'
#' @inheritParams bundled_cli_path
#'
#' @return `r pkgsnip::return_lbl("num_vrsn")`
#' @export
#'
#' @examples
#' rstd::bundled_cli_vrsn(tool = "dart-sass")
bundled_cli_vrsn <- function(tool = all_bundled_tools) {
  
  bundled_cli_path(tool = tool) |>
    system2(args = "--version",
            stdout = TRUE,
            stderr = TRUE) |>
    dplyr::first() |>
    stringr::str_extract("\\d+(\\.\\d+)*") |>
    as.numeric_version()
}

#' List RStudio's R package dependencies' installation status
#'
#' @return `r pkgsnip::return_lbl("tibble")`
#' @export
pkg_status <- function() {
  
  rstudioapi::getRStudioPackageDependencies() %$%
    pal::is_pkg_installed(pkg = name,
                          min_version = version) |>
    tibble::enframe(name = "package",
                    value = "is_installed")
}

#' `r this_pkg` package configuration metadata
#'
#' A [tibble][tibble::tbl_df] with metadata of all possible `r this_pkg` package configuration options. See [funky::config_val()] for more information.
#'
#' @format `r pkgsnip::return_lbl("tibble_cols", cols = colnames(funky_config))`
#' @export
#'
#' @examples
#' rstd::funky_config
"funky_config"