Merge pull request #36 from jmbarbone/dev

dev updates

.Rbuildignore

@@ -6,3 +6,4 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^\.lintr$

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Rprofile
 Title: Functions to be loaded with Rprofile
-Version: 0.0.0.9006
+Version: 0.0.0.9007
 Authors@R: 
     person(given = "Jordan Mark",
            family = "Barbone",
@@ -16,11 +16,13 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Depends:
     R (>= 3.6.0)
 Imports: 
+    fuj (>= 0.2.1),
     magrittr,
+    rlang,
     utils
 Suggests:
     cli,
@@ -30,10 +32,9 @@ Suggests:
     devtools,
     fortunes,
     fs,
-    fuj,
     gh,
     lintr,
-    mark,
+    mark (>= 0.8.0),
     praise,
     prompt,
     readr,

NAMESPACE

@@ -9,12 +9,14 @@ export(.AddRprofileOptions)
 export(.AttachDevtools)
 export(.CharacterIndex)
 export(.CheckCranStatus)
+export(.FileOpen)
 export(.FindRprofile)
 export(.Fixmes)
 export(.FixmesHere)
 export(.GitBranchPrompt)
 export(.GitPrepareCommitMsg)
 export(.GithubRelease)
+export(.GlobalHandle)
 export(.LintFile)
 export(.NewsUrls)
 export(.NiceMessage)
@@ -34,4 +36,8 @@ export(.SpellCheckFile)
 export(.Todos)
 export(.TodosHere)
 export(.UtilMessage)
+importFrom(fuj,"%colons%")
+importFrom(fuj,"%out%")
+importFrom(fuj,"%wo%")
+importFrom(fuj,"%||%")
 importFrom(magrittr,"%>%")

NEWS.md

@@ -15,6 +15,15 @@
 * `@jmbarbone`'s preferred settings are now included as `.RprofileJordan()`, now a single command I can run in my `.Rprofile`
 * `.CheckCranStatus()` has simplified output when `{cli}` is available; linked included to packages [#8]
 * packing `lint`ing now included
+* `.CheckCranStatus()` specifically sets temporary file for check status results
+* `.CheckCranStatus()` outputs corrected
+* `.GlobalHandle()` added to call `rlang::global_handle()`; added into `.RprofileJordan()`
+* `.FileOpen()` now normalizes a path for a file before attempting to open
+* `.OpenFile()` added as an alias for `.FileOpen()`
+* `.RprofileJordan()` checks for additional library paths from envvars `R_LIBS_PAK` and `R_LIBS_SCRIBE`
+* `.GithubRelease()` now prompts for both `publish` and `pre-release` params when they are not set
+* `.NewsUrls()` paths corrected and no longer error in error
+* `{fuj}` is now imported
 
 ## Fixes
 
@@ -25,6 +34,7 @@
 
 * `.NewsUrls()` now has prettier print for differences; URLs detected are highlighted with `{crayon}` and only the changed lines (with line numbers) are printed
 * Improvements with package checking
+* Prompts via `utils::menu()` cleaned up
 
 # Rprofile 0.0.0.9000
 

R/Rprofile-package.R

@@ -1,4 +1,5 @@
 #' @keywords internal
+#' @importFrom fuj %||% %out% %colons% %wo%
 "_PACKAGE"
 
 # The following block is used by usethis to automatically manage
@@ -17,11 +18,16 @@ lockEnvironment(rprofile)
 #'
 #' @export
 .RprofileJordan <- function() {
-  .libPaths(c(.libPaths(), "~/R/pak-library", "~/R/scribe-library"))
+  .libPaths(c(
+    .libPaths(),
+    Sys.getenv("R_LIBS_PAK", "~/R/pak-library"),
+    Sys.getenv("R_LIBS_SCRIBE", "~/R/scribe-library")
+  ))
 
   .AttachDevtools()
   .AddAttachedPackagesToDefaultPackages()
   .GitBranchPrompt()
+  .GlobalHandle()
 
   if (interactive()) {
     .UtilMessage("source_rprofile")

R/check-cran-status.R

@@ -11,19 +11,22 @@
   }
 
   if (is.null(email) && !length(email)) {
-   email <- .try(get_description_emails())
-   if (inherits(email, "error")) {
-     return(invisible())
-   }
+    email <- .try(get_description_emails())
+    if (inherits(email, "error")) {
+      return(invisible())
+    }
   }
 
   cat("Checking CRAN status\n")
   success <- FALSE
   for (e in email) {
     if (success) cat("\n")
     cat("checking for", crayon_blue(e))
-    # shhhh
-    res <- fuj::wuffle(.try(utils::capture.output(dang::checkCRANStatus(e))))
+    res <- fuj::wuffle(.try(utils::capture.output(dang::checkCRANStatus(
+      email = e,
+      cache = tempfile("dang_check_cran_status__", fileext = ".rds"),
+      cache.life = 3600
+    ))))
     if (!inherits(res, "error")) {
       show_table()
       success <- TRUE
@@ -38,7 +41,7 @@
 
 show_table <- function() {
   res <- get_recent_cran_check()
-  time <- crayon_yellow(res[[1]])
+  time <- crayon_yellow(format(res[[1]], "%Y-%m-%d %H:%M:%S", usetz = TRUE))
   tab <- res[[2]]
 
   cat("\n")
@@ -47,7 +50,11 @@ show_table <- function() {
 }
 
 get_recent_cran_check <- function() {
-  files <- list.files(tempdir(), "^cran-status.*.rds$", full.names = TRUE)
+  files <- list.files(
+    tempdir(),
+    "^dang_check_cran_status__.*\\.rds$",
+    full.names = TRUE
+  )
   res <- files[which.max(file.mtime(files))]
   readRDS(res)
 }
@@ -94,7 +101,7 @@ print_cran_status <- function(x) {
           row[1L],
           row[1L]
         ),
-        paste0(row[-1L], collapse = " ")
+        paste0(row[crayon_strip(row) != ""][-1L], collapse = " ")
       )
     })
     return(invisible(xx))

R/github-release.R

@@ -6,7 +6,7 @@
 #'   `usethis::use_github_release()` is employed to create a prerelease.  This
 #'   assumes ...
 #'   - the package is hosted on **GitHub**
-#'   - the remote is named **origin**d
+#'   - the remote is named **origin**
 #'   - the branch is named **main**
 #'   - the package has a **DESCRIPTION** file which contains an appropriate
 #'   `Package` name and `Version`
@@ -18,32 +18,37 @@
 #'   `FALSE`.
 #' @param prerelease Whether to create prerelease.  Default is `FALSE`.
 #' @export
-.GithubRelease <- function(publish = NULL, prerelease = FALSE) {
+.GithubRelease <- function(publish = NULL, prerelease = NULL) {
   fuj::require_namespace("cli", "gh", "usethis")
   ask <- function() {
     if (!interactive()) {
       return(FALSE)
     }
 
-    switch(
-      utils::menu(
-        title = "\nWould you like to publish this release?",
-        choices = c(
-          "yeah, publish",
-          "no, continue as draft",
-          "nevermind, cancel"
-        )
-      ),
-      TRUE,
-      FALSE,
+    answer <- yes_no("Would you like to publish this release?", na = "CANCEL")
+
+    if (is.na(answer)) {
       force_exit()
-    )
+    }
+
+    answer
   }
 
   force_exit <- function() {
     stop(fuj::new_condition("...", "forced_exit"))
   }
 
+
+  if (is.null(prerelease)) {
+    if (ask()) {
+      prerelease <- yes_no("Is this a pre-release?")
+    } else {
+      prerelease <- FALSE
+    }
+  }
+
+  prerelease <- isTRUE(prerelease)
+
   if (!prerelease) {
     fuj::require_namespace("usethis")
     return(tryCatch(

R/handle.R

@@ -0,0 +1,9 @@
+#' Global handle
+#'
+#' See [rlang::global_handle()]
+#'
+#' @export
+.GlobalHandle <- function() {
+  fuj::require_namespace("rlang")
+  rlang::global_handle()
+}

R/news.R

@@ -22,10 +22,11 @@
     dir.exists(path)
   )
 
-  news <- file.path(news, "NEWS.md")
+  pkg <- normalizePath(path, "/", TRUE)
+  news <- file.path(pkg, "NEWS.md")
 
   if (!file.exists(news)) {
-    stop("NEWS.md not found: ", news)
+    stop("NEWS.md not found: ", path)
   }
 
   force(url)
@@ -56,15 +57,11 @@
   cat(new_copy[lines], fill = TRUE, labels = labels)
 
   if (!isFALSE(ask)) {
-    switch(
-      utils::menu(
-        title = "\nOkay to update?",
-        choices = c("yeah, sure", "no ..."
-        )
-      ),
-      `1` = message("cool"),
-      `2` = return(invisible())
-    )
+    if (yes_no("okay to update?")) {
+      message("cool")
+    } else {
+      return(invisible())
+    }
   }
 
   if (requireNamespace("urlchecker", quietly = TRUE)) {

R/open-file.R

@@ -11,11 +11,16 @@
   UseMethod(".OpenFile")
 }
 
+#' @export
+#' @rdname OpenFile
+.FileOpen <- .OpenFile
+
 #' @export
 #' @param force If `TRUE` ignores potential file path in `x`
 #' @rdname OpenFile
 .OpenFile.default <- function(x, force = FALSE, ...) {
   if (!force && isTRUE(.try(file.exists(x)))) {
+    x <- normalizePath(x, "/")
     requireNamespace("xopen")
     xopen::xopen(x)
     return(x)

R/utils.R

@@ -1,27 +1,3 @@
-`%||%` <- function(x, y) {
-  if (is.null(x)) y else x
-}
-
-`%colons%` <- function(package, name) {
-  # poor copy of fuj::`%colons%`
-  stopifnot(
-    length(package) == 1,
-    is.character(package),
-    length(name) == 1, is.character(name)
-  )
-
-  requireNamespace(package)
-  get(name, envir = asNamespace(package))
-}
-
-`%out%` <- function(...) {
-  ("fuj" %colons% "%out%")(...)
-}
-
-`%wo%` <- function(...) {
-  ("fuj" %colons% "%wo%")(...)
-}
-
 assign_ <- function(...) {
   ("base" %colons% "assign")(...)
 }
@@ -35,5 +11,37 @@ sf <- function(...) {
 }
 
 .try <- function(expr) {
-  tryCatch(expr, error = force)
+  tryCatch(expr, error = function(e) {
+    invisible(structure(list(condition = e), class = "rprofile_error"))
+  })
+}
+
+yes_no <- function(..., na = NULL) {
+  # basically a rewrite of yesno::yesno()
+  msg <- paste0(..., collapse = "")
+  yes <- c("Yes", "You betcha", "Certainly", "Absolutely", "Of course")
+  no <- c("No", "Absolutely not", "Certainly not", "No way", "Not a chance",
+          "Let me think about it", "Not sure", "I don't know")
+
+  choices <- c(
+    sample(c(sample(yes, 1), sample(no, 2))),
+    if (length(na)) sample(na, 1)
+  )
+
+  res <- utils::menu(title = msg, choices = choices)
+  if (res == 0) {
+    return(NA)
+  }
+
+  res <- choices[res]
+
+  if (res %in% yes) {
+    return(TRUE)
+  }
+
+  if (res %in% no) {
+    return(FALSE)
+  }
+
+  NA
 }