From 800268cc32e3121e73dfe4d8cf0ad44a0fb5dbcb Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Mon, 30 Oct 2023 09:55:48 +0100
Subject: [PATCH] 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 <52606734+olivroy@users.noreply.github.com>

---------

Co-authored-by: olivroy <52606734+olivroy@users.noreply.github.com>
---
 DESCRIPTION          |  4 +--
 R/utilities-checks.R | 71 ++++++++++----------------------------------
 2 files changed, 18 insertions(+), 57 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 0f931609d9..6b6bb41f3e 100644
--- 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
index 3d42703bb5..418268a832 100644
--- 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") {