Add check_downstream_deps()

R/compat-downstream-dep.R

@@ -0,0 +1,91 @@
+# nocov start --- compat-downstream-deps --- 2020-02-24 Mon 15:57 CET
+
+
+check_downstream_deps <- local({
+
+  # Keep in sync with compat-linked-version.R
+  howto_reinstall_msg <- function(pkg) {
+    os <- tolower(Sys.info()[["sysname"]])
+
+    if (os == "windows") {
+      url <- "https://github.com/jennybc/what-they-forgot/issues/62"
+      c(
+        i = sprintf("Please update %s to the latest version.", pkg),
+        i = sprintf("Updating packages on Windows requires precautions:\n  <%s>", url)
+      )
+    } else {
+      c(
+        i = sprintf("Please update %s with `install.packages(\"%s\")` and restart R.", pkg, pkg)
+      )
+    }
+  }
+
+  is_string <- function(x) is.character(x) && length(x) == 1 && !is.na(x)
+
+  check_downstream_dep <- function(pkg, dep_pkg, dep_data, with_rlang) {
+    min <- dep_data[["min"]]
+    from <- dep_data[["from"]]
+    stopifnot(
+      is_string(min),
+      is_string(from)
+    )
+
+    ver <- utils::packageVersion(dep_pkg)
+    if (ver >= min) {
+      return()
+    }
+
+    rlang_ver <- utils::packageVersion("rlang")
+
+    header <- sprintf("As of rlang %s, %s must be at least version %s.", from, dep_pkg, min)
+    body <- c(
+      x = sprintf("%s %s is too old for rlang %s.", dep_pkg, ver, rlang_ver),
+      howto_reinstall_msg(dep_pkg)
+    )
+
+    if (with_rlang) {
+      body <- rlang::format_error_bullets(body)
+      msg <- paste(c(header, body), collapse = "\n")
+      rlang::warn(msg)
+    } else {
+      body <- paste0("* ", body)
+      msg <- paste(c(header, body), collapse = "\n")
+      warning(msg, call. = FALSE)
+    }
+  }
+
+  on_package_load <- function(pkg, expr) {
+    if (isNamespaceLoaded(pkg)) {
+      expr
+    } else {
+      thunk <- function(...) expr
+      setHook(packageEvent(pkg, "onLoad"), thunk)
+    }
+  }
+
+  function(pkg, ..., with_rlang = requireNamespace("rlang")) {
+    deps <- list(...)
+    nms <- names(deps)
+
+    if (is.null(nms)) {
+      stop("Downstream dependencies should be named.", call. = FALSE)
+    }
+
+    Map(
+      function(dep_pkg, dep_data) {
+        force(dep_data)
+        on_package_load(dep_pkg, check_downstream_dep(
+          pkg,
+          dep_pkg,
+          dep_data,
+          with_rlang = with_rlang
+        ))
+      },
+      nms,
+      deps
+    )
+  }
+})
+
+
+#nocov end

R/compat-linked-version.R

@@ -1,8 +1,9 @@
-# nocov start --- compat-linked-version --- 2020-02-24 Mon 12:55 CET
+# nocov start --- compat-linked-version --- 2020-02-24 Mon 13:05 CET
 
 
 check_linked_version <- local({
 
+  # Keep in sync with compat-downstream-deps.R
   howto_reinstall_msg <- function(pkg) {
     os <- tolower(Sys.info()[["sysname"]])
 

R/rlang.R

@@ -5,58 +5,6 @@ NULL
 is_same_body <- NULL
 
 
-on_package_load <- function(pkg, expr) {
-  if (isNamespaceLoaded(pkg)) {
-    expr
-  } else {
-    thunk <- function(...) expr
-    setHook(packageEvent(pkg, "onLoad"), thunk)
-  }
-}
-
-
-downstream_deps <- list(
-  dplyr = c(min = "0.8.0", from = "0.4.0")
-)
-
-check_downstream_dep <- function(dep, pkg) {
-  min <- dep[["min"]]
-  from <- dep[["from"]]
-  stopifnot(
-    !is_null(min),
-    !is_null(from)
-  )
-
-  ver <- utils::packageVersion(pkg)
-  if (ver >= min) {
-    return()
-  }
-
-  rlang_ver <- utils::packageVersion("rlang")
-
-  msg <- c(
-    sprintf("As of rlang %s, %s must be at least version %s.", from, pkg, min),
-    x = sprintf("%s %s is too old for rlang %s.", pkg, ver, rlang_ver)
-  )
-
-  os <- tolower(Sys.info()[["sysname"]])
-  if (os == "windows") {
-    url <- "https://github.com/jennybc/what-they-forgot/issues/62"
-    howto <- c(
-      i = sprintf("Please update %s to the latest version.", pkg),
-      i = sprintf("Updating packages on Windows requires precautions:\n  <%s>", url)
-    )
-  } else {
-    howto <- c(
-      i = sprintf("Please update %s with `install.packages(\"%s\")` and restart R.", pkg, pkg)
-    )
-  }
-  msg <- c(msg, howto)
-
-  warn(msg)
-}
-
-
 base_ns_env <- NULL
 base_pkg_env <- NULL
 
@@ -68,6 +16,13 @@ base_pkg_env <- NULL
   }
 
   check_linked_version(pkg, with_rlang = FALSE)
+
+  check_downstream_deps(
+    pkg,
+    dplyr = c(min = "0.8.0", from = "0.4.0"),
+    with_rlang = FALSE
+  )
+
   on_package_load("glue", .Call(rlang_glue_is_there))
 
   .Call(r_init_library)
@@ -76,14 +31,18 @@ base_pkg_env <- NULL
   s3_register("pillar::pillar_shaft", "quosures", pillar_shaft.quosures)
   s3_register("pillar::type_sum", "quosures", type_sum.quosures)
 
-  map2(downstream_deps, names(downstream_deps), function(dep, pkg) {
-    force(dep)
-    on_package_load(pkg, check_downstream_dep(dep, pkg))
-  })
-
   base_ns_env <<- ns_env("base")
   base_pkg_env <<- baseenv()
 }
 .onUnload <- function(lib) {
   .Call(rlang_library_unload)
 }
+
+on_package_load <- function(pkg, expr) {
+  if (isNamespaceLoaded(pkg)) {
+    expr
+  } else {
+    thunk <- function(...) expr
+    setHook(packageEvent(pkg, "onLoad"), thunk)
+  }
+}