update snippets

snippets.R

# You'll need to change {pkg} here for your package because I'm too lazy to generalize this right now
# I'll probably put this in jmbarbone/mark or jmbarbone/markExtra

#' Add code snippets
#'
#' Adds code snippets
#'
#' @export

add_pkg_snippets <- function() {
  if (.Platform[["OS.type"]] != "windows"()) {
    stop(err("Sorry, add_snippets() is only configured for windows"))
  }

  # Get the current ones in RStudio 
  old <- get_rstudio_snippets()
  new <- get_pkg_snippets()

  # remove our ones so that they can be updated
  original <- setdiff(names(old), names(new))

  # make a new list with the updates pkg snippets added to the end
  combined <- c(old[original], new)
  write_snippets(combined)
}

get_pkg_snippets <- function() {
  dir <- system.file("snippets", package = "pkg", mustWork = TRUE)
  snippets <- list.files(dir, full.names = TRUE)
  names(snippets) <- mark::file_name(snippets)
  sapply(snippets, function(x) readLines(x)[-1L], simplify = FALSE)
}

rstudio_snippet_path <- function() {
  path <- fs::path(
    # this probably isn't the best right?
    shell("echo %appdata%", intern = TRUE),
    "RStudio/snippets/r.snippets"
  )

  if (!file.exists(path)) {
    stop(err("Unable to locate current snippets"))
  }

  path
}

get_rstudio_snippets <- function() {
  snippets <- readLines(rstudio_snippet_path())
  iloc <- grep("^snippet\\s[A-Za-z[:punct:]]+$", snippets)
  names <- sub("snippet\\s", "", snippets[iloc])
  starts <- iloc + 1L
  ends <- c(iloc[-1L] - 1L, length(snippets))
  res <- mapply(function(x, y) snippets[x:y], starts, ends, SIMPLIFY = FALSE)
  names(res) <- names
  res
}

write_snippets <- function(x) {
  # Takes the list of snippets (with names) and combined them then writes them
  # to the snippet file

  stopifnot(
    is.list(x),
    !is.null(x),
    all(vapply(x, is.character, NA))
  )

  path <- rstudio_snippet_path()
  # intersects the values
  nm <- names(x)
  ind <- grep("^snippet\\s", nm, invert = TRUE)
  nm[ind] <- paste("snippet", nm[ind])
  lines <- unlist(mapply(c, nm, x, SIMPLIFY = TRUE), use.names = FALSE)
  invisible(writeLines(lines, path))
}