Simplify check_device() for {ragg}/{svglite} (#5476)

* Replace ragg/svglite checks with version checks * Increment suggested versions * Apply suggestions from code review Co-authored-by: olivroy <[email protected]> --------- Co-authored-by: olivroy <[email protected]>
tidyverse · Oct 30, 2023 · 800268c · 800268c
1 parent 5a61e2e
commit 800268c
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 57 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -59,12 +59,12 @@ Suggests:
     nlme,
     profvis,
     quantreg,
-    ragg,
+    ragg (>= 1.2.6),
     RColorBrewer,
     rmarkdown,
     rpart,
     sf (>= 0.7-3),
-    svglite (>= 1.2.0.9001),
+    svglite (>= 2.1.2),
     testthat (>= 3.1.2),
     vdiffr (>= 1.0.6),
     xml2

diff --git a/R/utilities-checks.R b/R/utilities-checks.R
@@ -247,6 +247,20 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE,
     dev_name <- names(dev_cur)
   }
 
+  # {ragg} and {svglite} report capabilities, but need specific version
+  if (dev_name %in% c("agg_jpeg", "agg_ppm", "agg_png", "agg_tiff")) {
+    check_installed(
+      "ragg", version = "1.2.6",
+      reason = paste0("for checking device support for ", feat_name, ".")
+    )
+  }
+  if (dev_name == "devSVG") {
+    check_installed(
+      "svglite", version = "2.1.2",
+      reason = paste0("for checking device support for ", feat_name, ".")
+    )
+  }
+
   # For blending/compositing, maybe test a specific operation
   if (!is.null(op) && feature %in% c("blending", "compositing")) {
     op <- arg_match0(op, c(.blend_ops, .compo_ops))
@@ -305,34 +319,8 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE,
     }
   }
 
-  # Test {ragg}'s capabilities
-  if (dev_name %in% c("agg_jpeg", "agg_ppm", "agg_png", "agg_tiff")) {
-    # We return ragg's version number if not installed, so we can suggest to
-    # install it.
-    capable <- switch(
-      feature,
-      clippingPaths =, alpha_masks =, gradients =,
-      patterns = if (is_installed("ragg", version = "1.2.0")) TRUE else "1.2.0",
-      FALSE
-    )
-    if (isTRUE(capable)) {
-      return(TRUE)
-    }
-    if (is.character(capable) && action != "test") {
-      check_installed(
-        "ragg", version = capable,
-        reason = paste0("for graphics support of ", feat_name, ".")
-      )
-    }
-    action_fun(paste0(
-      "The {.pkg ragg} package's {.field {dev_name}} device does not support ",
-      "{.emph {feat_name}}."
-    ), call = call)
-    return(FALSE)
-  }
-
-  # The vdiffr version of the SVG device is known to not support any newer
-  # features
+  # If vdiffr has neither confirmed nor denied its capabilities, the feature
+  # is assumed to be not supported.
   if (dev_name == "devSVG_vdiffr") {
     action_fun(
       "The {.pkg vdiffr} package's device does not support {.emph {feat_name}}.",
@@ -341,33 +329,6 @@ check_device = function(feature, action = "warn", op = NULL, maybe = FALSE,
     return(FALSE)
   }
 
-  # The same logic applies to {svglite} but is tested separately in case
-  # {ragg} and {svglite} diverge at some point.
-  if (dev_name == "devSVG") {
-    # We'll return a version number if not installed so we can suggest it
-    capable <- switch(
-      feature,
-      clippingPaths =, gradients =, alpha_masks =,
-      patterns = if (is_installed("svglite", version = "2.1.0")) TRUE else "2.1.0",
-      FALSE
-    )
-
-    if (isTRUE(capable)) {
-      return(TRUE)
-    }
-    if (is.character(capable) && action != "test") {
-      check_installed(
-        "svglite", version = capable,
-        reason = paste0("for graphics support of ", feat_name, ".")
-      )
-    }
-    action_fun(paste0(
-      "The {.pkg {pkg}} package's {.field {dev_name}} device does not ",
-      "support {.emph {feat_name}}."), call = call
-    )
-    return(FALSE)
-  }
-
   # Last resort: list of known support prior to R 4.2.0
   supported <- c("pdf", "cairo_pdf", "cairo_ps", "svg")
   if (feature == "compositing") {