Add tree-sitter parser for TOML

.Rbuildignore

@@ -26,3 +26,6 @@
 ^LICENSE\.md$
 ^[\.]?air\.toml$
 ^\.vscode$
+^air[.]toml$
+^\.dev$
+^\.covrignore$

.covrignore

@@ -0,0 +1 @@
+R/aaa-rstudio-detect.R

.gitignore

@@ -18,3 +18,4 @@ Meta
 /src/*.gcda
 *.gcda
 *.gcno
+/.dev

R/aaa-rstudio-detect.R

@@ -1,6 +1,6 @@
 rstudio <- local({
   standalone_env <- environment()
-  parent.env(standalone_env) <- baseenv()
+  parent.env(standalone_env) <- globalenv()
 
   # -- Collect data ------------------------------------------------------
 
@@ -51,8 +51,12 @@ rstudio <- local({
     }
 
     # Cached?
-    if (clear_cache) data <<- NULL
-    if (!is.null(data)) return(get_caps(data))
+    if (clear_cache) {
+      data <<- NULL
+    }
+    if (!is.null(data)) {
+      return(get_caps(data))
+    }
 
     if (
       (rspid <- Sys.getenv("RSTUDIO_SESSION_PID")) != "" &&
@@ -86,7 +90,9 @@ rstudio <- local({
     pane <- Sys.getenv("RSTUDIO_CHILD_PROCESS_PANE")
 
     # this should not happen, but be defensive and fall back
-    if (pane == "") return(detect_old(clear_cache))
+    if (pane == "") {
+      return(detect_old(clear_cache))
+    }
 
     # direct subprocess
     new$type <- if (rspid == parentpid) {
@@ -175,7 +181,9 @@ rstudio <- local({
     }
 
     installing <- Sys.getenv("R_PACKAGE_DIR", "")
-    if (cache && installing == "") data <<- new
+    if (cache && installing == "") {
+      data <<- new
+    }
 
     get_caps(new)
   }

R/assertions.R

@@ -19,7 +19,9 @@ is_character <- function(x) {
 }
 
 is_string <- function(x) {
-  if (is.character(x) && length(x) == 1 && !is.na(x)) return(TRUE)
+  if (is.character(x) && length(x) == 1 && !is.na(x)) {
+    return(TRUE)
+  }
   if (is.character(x) && length(x) == 1 && is.na(x)) {
     structure(
       FALSE,
@@ -37,7 +39,9 @@ is_string <- function(x) {
 }
 
 is_optional_string <- function(x) {
-  if (is.null(x) || is_string(x)) return(TRUE)
+  if (is.null(x) || is_string(x)) {
+    return(TRUE)
+  }
   structure(
     FALSE,
     msg = "{.arg {(.arg)}} must be a path (character scalar),
@@ -47,7 +51,9 @@ is_optional_string <- function(x) {
 }
 
 is_flag <- function(x) {
-  if (is.logical(x) && length(x) == 1 && !is.na(x)) return(TRUE)
+  if (is.logical(x) && length(x) == 1 && !is.na(x)) {
+    return(TRUE)
+  }
   if (is.logical(x) && length(x) == 1 && is.na(x)) {
     structure(
       FALSE,
@@ -67,7 +73,9 @@ is_flag <- function(x) {
 ## To be refined
 
 is_path <- function(x) {
-  if (is_string(x)) return(TRUE)
+  if (is_string(x)) {
+    return(TRUE)
+  }
   structure(
     FALSE,
     msg = "{.arg {(.arg)}} must be a path (character scalar),
@@ -77,7 +85,9 @@ is_path <- function(x) {
 }
 
 is_optional_path <- function(x) {
-  if (is_optional_string(x)) return(TRUE)
+  if (is_optional_string(x)) {
+    return(TRUE)
+  }
   structure(
     FALSE,
     msg = "{.arg {(.arg)}} must be a path (character scalar) or {.code NULL},
@@ -87,7 +97,9 @@ is_optional_path <- function(x) {
 }
 
 all_named <- function(x) {
-  if (length(names(x)) == length(x) && all(names(x) != "")) return(TRUE)
+  if (length(names(x)) == length(x) && all(names(x) != "")) {
+    return(TRUE)
+  }
   structure(
     FALSE,
     msg = "All elements in {.arg {(.arg)}} must be named.",
@@ -202,7 +214,9 @@ is_r_version_list <- function(x) {
 }
 
 is_difftime <- function(x) {
-  if (inherits(x, "difftime")) return(TRUE)
+  if (inherits(x, "difftime")) {
+    return(TRUE)
+  }
   structure(
     FALSE,
     msg = "{.arg {(.arg)}} must be a {.cls difftime} object, but it is

R/assertthat.R

@@ -11,7 +11,9 @@ assert_that <- function(..., env = parent.frame(), msg = NULL) {
       }
     )
     check_result(res)
-    if (res) next
+    if (res) {
+      next
+    }
 
     if (is.null(msg)) {
       msg <- get_message(res, assertion, env)
@@ -55,8 +57,12 @@ assert_error <- function(
     )
   )
 
-  if (length(.data)) cnd[names(.data)] <- .data
-  if (length(class)) class(cnd) <- unique(c(.class, "assertError", class(cnd)))
+  if (length(.data)) {
+    cnd[names(.data)] <- .data
+  }
+  if (length(class)) {
+    class(cnd) <- unique(c(.class, "assertError", class(cnd)))
+  }
 
   cnd
 }
@@ -90,7 +96,9 @@ get_message <- function(res, call, env = parent.frame()) {
   }
 
   f <- eval(call[[1]], env)
-  if (is.call(call) && !is.primitive(f)) call <- match.call(f, call)
+  if (is.call(call) && !is.primitive(f)) {
+    call <- match.call(f, call)
+  }
   fname <- deparse(call[[1]])
 
   base_fs[[fname]] %||% fail_default(call, env)
@@ -110,7 +118,9 @@ fail_default <- function(call, env) {
 }
 
 has_attr <- function(x, which) {
-  if (!is.null(attr(x, which, exact = TRUE))) return(TRUE)
+  if (!is.null(attr(x, which, exact = TRUE))) {
+    return(TRUE)
+  }
   structure(
     FALSE,
     msg = "{.arg {(.arg)}} must have attribute {.code {which}}.",

R/config.R

@@ -117,7 +117,9 @@ config <- local({
   true <- function(...) TRUE
 
   is_config_name <- function(name) {
-    if (is_string(name)) return(TRUE)
+    if (is_string(name)) {
+      return(TRUE)
+    }
     structure(
       FALSE,
       msg = c(
@@ -129,7 +131,9 @@ config <- local({
   }
 
   is_config_check <- function(check) {
-    if (is_string(check) || is.function(check) || is.null(check)) return(TRUE)
+    if (is_string(check) || is.function(check) || is.null(check)) {
+      return(TRUE)
+    }
     structure(
       FALSE,
       msg = c(
@@ -183,8 +187,12 @@ config <- local({
     },
     flag = function(x, name, ...) {
       x <- tolower(x)
-      if (tolower(x) %in% c("yes", "true", "1", "on")) return(TRUE)
-      if (tolower(x) %in% c("no", "false", "0", "off")) return(FALSE)
+      if (tolower(x) %in% c("yes", "true", "1", "on")) {
+        return(TRUE)
+      }
+      if (tolower(x) %in% c("no", "false", "0", "off")) {
+        return(FALSE)
+      }
       throw(pkg_error(
         "Invalid value for the {.envvar {name}} environment variable.",
         i = "It must be either {.code true} or {.code false}."
@@ -218,13 +226,17 @@ config <- local({
     rec <- env$data[[name]]
 
     # was explicitly set?
-    if (!is.null(rec$value)) return(list("set", rec$value))
+    if (!is.null(rec$value)) {
+      return(list("set", rec$value))
+    }
 
     # set via options()
     optname <- paste0(env$prefix, name)
     opt <- getOption(optname)
     if (!is.null(opt)) {
-      if (!is.null(chk <- env$data[[name]]$check)) chk(opt)
+      if (!is.null(chk <- env$data[[name]]$check)) {
+        chk(opt)
+      }
       return(list("option", opt))
     }
 
@@ -365,11 +377,17 @@ config <- local({
         ))
       }
 
-      if (is_string(check)) check <- env$checks[[check]]
+      if (is_string(check)) {
+        check <- env$checks[[check]]
+      }
       check <- check %||% true
-      if (!is.null(default) && !is.function(default)) check(default)
+      if (!is.null(default) && !is.function(default)) {
+        check(default)
+      }
 
-      if (is_string(env_decode)) env_decode <- env$env_decode[[env_decode]]
+      if (is_string(env_decode)) {
+        env_decode <- env$env_decode[[env_decode]]
+      }
       env_decode <- env_decode %||% identity
 
       env$data[[name]] <- list(
@@ -454,7 +472,9 @@ config <- local({
           i = "See `$list()` for the list of all config entries."
         ))
       }
-      if (!is.null(chk <- env$data[[name]]$check)) chk(value)
+      if (!is.null(chk <- env$data[[name]]$check)) {
+        chk(value)
+      }
       env$data[[name]]$value <- value
       invisible(env)
     }

R/dep-utils.R

@@ -67,7 +67,9 @@ deps_from_desc <- function(deps, last) {
 parse_all_deps <- function(deps) {
   deps <- na.omit(deps)
   res <- do.call(rbind, parse_deps(deps, names(deps)))
-  if (is.null(res)) res <- parse_deps("", "")[[1]]
+  if (is.null(res)) {
+    res <- parse_deps("", "")[[1]]
+  }
   res$ref <- res$package
   res[, c("ref", setdiff(names(res), "ref"))]
 }

R/download-progress-bar.R

@@ -143,8 +143,9 @@ pkgplan__initial_pb_message <- function(bar) {
   } else {
     cli::cli_alert_info(c(
       "Getting",
-      if (bts > 0)
-        " {num-unk} pkg{?s} {.size ({format_bytes$pretty_bytes(bts)})}",
+      if (bts > 0) {
+        " {num-unk} pkg{?s} {.size ({format_bytes$pretty_bytes(bts)})}"
+      },
       if (bts > 0 && unk > 0) " and",
       if (unk > 0) " {unk} pkg{?s} with unknown size{?s}",
       if (nch > 0) ", {nch} ",
@@ -186,12 +187,15 @@ pkgplan__update_progress_bar <- function(bar, idx, event, data) {
     if (data$download_status == "Got") {
       bar$what$status[idx] <- "got"
       sz <- na.omit(file.size(c(data$fulltarget, data$fulltarget_tree)))[1]
-      if (!is.na(sz)) bar$what$filesize[idx] <- sz
+      if (!is.na(sz)) {
+        bar$what$filesize[idx] <- sz
+      }
       cli::cli_alert_success(c(
         "Got {.pkg {data$package}} ",
         "{.version {data$version}} ({data$platform})",
-        if (!is.na(sz) && bar$show_size)
+        if (!is.na(sz) && bar$show_size) {
           " {.size ({format_bytes$pretty_bytes(sz)})}"
+        }
       ))
       if (!is.na(bar$what$filesize[idx])) {
         bar$chunks[[sec]] <- (bar$chunks[[sec]] %||% 0) -
@@ -245,7 +249,9 @@ pkgplan__update_progress_bar <- function(bar, idx, event, data) {
 
   # Update current and total
   bar$what$current[idx] <- data$current
-  if (data$total > 0) bar$what$filesize[idx] <- bar$what$need[idx] <- data$total
+  if (data$total > 0) {
+    bar$what$filesize[idx] <- bar$what$need[idx] <- data$total
+  }
 
   TRUE
 }
@@ -257,10 +263,14 @@ pkgplan__update_progress_bar <- function(bar, idx, event, data) {
 #' @noRd
 
 pkgplan__show_progress_bar <- function(bar) {
-  if (is.null(bar$status)) return()
+  if (is.null(bar$status)) {
+    return()
+  }
 
   # Don't show if there is nothing to download
-  if (sum(!bar$what$skip) == 0) return()
+  if (sum(!bar$what$skip) == 0) {
+    return()
+  }
   parts <- calculate_progress_parts(bar)
 
   # Ready to update. We can't use the package emoji because its
@@ -284,7 +294,9 @@ calculate_rate <- function(start, now, chunks) {
   data <- unlist(mget(labels, envir = chunks, ifnotfound = 0L))
   fact <- time_at - max(time_at_s - 3, 0)
   rate <- sum(data) / fact
-  if (is.nan(rate)) rate <- 0
+  if (is.nan(rate)) {
+    rate <- 0
+  }
   if (rate == 0 && time_at < 4) {
     rstr <- strrep(" ", 8)
   } else {
@@ -329,7 +341,9 @@ calculate_progress_parts <- function(bar) {
   parts$bytes_total <- bytes_total
   bytes_percent <- bytes_done / bytes_total # could be NA
   percent <- if (!is.na(bytes_percent)) bytes_percent else pkg_percent
-  if (round(percent * 100) == 100 && percent < 1) percent <- 0.99
+  if (round(percent * 100) == 100 && percent < 1) {
+    percent <- 0.99
+  }
   parts$percent <- format(
     paste0(round(100 * percent), "%"),
     width = 4,
@@ -362,7 +376,9 @@ calculate_progress_parts <- function(bar) {
 }
 
 pkgplan__done_progress_bar <- function(bar) {
-  if (is.null(bar$status)) return()
+  if (is.null(bar$status)) {
+    return()
+  }
 
   end_at <- Sys.time()
   dt <- format_time$pretty_dt(Sys.time() - bar$start_at)