Prepend https:// to url in use_course()

R/course.R

@@ -5,15 +5,21 @@
 #' Special-purpose function to download a folder of course materials. The only
 #' demand on the user is to confirm or specify where the new folder should be
 #' stored. Workflow:
-#' * User executes something like: `use_course("http://bit.ly/xxx-yyy-zzz")`.
+#' * User executes something like: `use_course("bit.ly/xxx-yyy-zzz")`.
 #' * User is asked to notice and confirm the location of the new folder. Specify
 #' `destdir` to skip this.
 #' * User is asked if they'd like to delete the ZIP file.
 #' * New folder is opened in the file manager, e.g. Finder or File Explorer.
 #'
+#' If `url` has no "http" prefix, "https://" is prepended, allowing for even
+#' less typing by the user. Most URL shorteners give HTTPS links and,
+#' anecdotally, we note this appears to work with [bit.ly](https://bitly.com/)
+#' links, even though they are nominally HTTP.
+#'
 #' @param url Link to a ZIP file containing the materials, possibly behind a
 #'   shortlink. Function developed with DropBox and GitHub in mind, but should
-#'   work for ZIP files generally. See [use_course_details] for more.
+#'   work for ZIP files generally. If no "http" prefix is found, "https://" is
+#'   prepended. See [use_course_details] for more.
 #' @param destdir The new folder is stored here. Defaults to user's Desktop.
 #'
 #' @return Path to the new directory holding the course materials, invisibly.
@@ -34,6 +40,7 @@
 #' use_course("https://api.github.com/repos/r-lib/rematch2/zipball/master")
 #' }
 use_course <- function(url, destdir = NULL) {
+  url <- normalize_url(url)
   zipfile <- download_zip(
     url,
     destdir = destdir %||% conspicuous_place(),
@@ -60,7 +67,7 @@ use_course <- function(url, destdir = NULL) {
 #'
 #' ## as called inside use_course()
 #' download_zip(
-#'   url,
+#'   url, ## after post-processing with normalize_url()
 #'   ## conspicuous_place() = Desktop or home directory or working directory
 #'   destdir = destdir \\%||\\% conspicuous_place(),
 #'   pedantic = is.null(destdir) && interactive()
@@ -241,6 +248,12 @@ tidy_unzip <- function(zipfile) {
   invisible(target)
 }
 
+normalize_url <- function(url) {
+  stopifnot(is.character(url))
+  has_scheme <- grepl("^http[s]?://", url)
+  ifelse(has_scheme, url, paste0("https://", url))
+}
+
 conspicuous_place <- function() {
   Filter(dir.exists, c(
     file.path(Sys.getenv("HOME"), "Desktop"), # typical macOS = ~/Desktop

tests/manual/manual-use-course.R

@@ -116,3 +116,7 @@ hadley <- use_course(
 )
 
 list.files(hadley, all.files = TRUE, recursive = TRUE)
+
+rematch2 <- use_course("github.com/r-lib/rematch2/archive/master.zip")
+use_course("rstd.io/usethis-src")
+use_course("bit.ly/uusseetthhiiss")

tests/testthat/test-use-course.R

@@ -1,5 +1,23 @@
 context("use_course")
 
+test_that("normalize_url() prepends https:// (or not)", {
+  expect_error(normalize_url(1), "is\\.character.*not TRUE")
+  expect_identical(normalize_url("http://bit.ly/aaa"), "http://bit.ly/aaa")
+  expect_identical(normalize_url("bit.ly/aaa"), "https://bit.ly/aaa")
+  expect_identical(
+    normalize_url("https://github.com/r-lib/rematch2/archive/master.zip"),
+    "https://github.com/r-lib/rematch2/archive/master.zip"
+  )
+  expect_identical(
+    normalize_url("https://rstd.io/usethis-src"),
+    "https://rstd.io/usethis-src"
+  )
+  expect_identical(
+    normalize_url("rstd.io/usethis-src"),
+    "https://rstd.io/usethis-src"
+  )
+})
+
 test_that("conspicuous_place() returns a writeable directory", {
   expect_error_free(x <- conspicuous_place())
   expect_true(is_dir(x))