From 9bf137b8f58d62a199e1eceb906f5b705030b75a Mon Sep 17 00:00:00 2001
From: Jack Davison <45171616+jack-davison@users.noreply.github.com>
Date: Wed, 7 Aug 2024 20:59:47 +0100
Subject: [PATCH] feat: check tile providers in `addProviderTiles()` (#929)

---
 NEWS.md                     |  2 ++
 R/plugin-providers.R        | 21 +++++++++++++++++----
 man/addProviderTiles.Rd     | 12 ++++++++----
 tests/testthat/test-tiles.R | 14 ++++++++++++++
 4 files changed, 41 insertions(+), 8 deletions(-)
 create mode 100644 tests/testthat/test-tiles.R

diff --git a/NEWS.md b/NEWS.md
index e1b4faf39..e7c376e4b 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -6,6 +6,8 @@
 
 * Updated vignettes to replace `{sp}`/`{raster}` usage with `{sf}`/`{terra} and their corresponding examples. (@jack-davison, #928)
 
+* `addProviderTiles()` will now error if the chosen `provider` does not match any currently loaded provider (by default, those in `providers`). This behaviour can be toggled off by setting the new `check` argument to `FALSE` (@jack-davison, #929)
+
 # leaflet 2.2.2
 
 * Fixed #893: Correctly call `terra::crs()` when checking the CRS of a `SpatVector` object in `pointData()` or `polygonData()` (thanks @mkoohafkan, #894).
diff --git a/R/plugin-providers.R b/R/plugin-providers.R
index c17f6397f..d1c7e7242 100644
--- a/R/plugin-providers.R
+++ b/R/plugin-providers.R
@@ -19,10 +19,12 @@ leafletProviderDependencies <- function() {
 #'   <https://github.com/leaflet-extras/leaflet-providers>)
 #' @param layerId the layer id to assign
 #' @param group the name of the group the newly created layers should belong to
-#'   (for [clearGroup()] and [addLayersControl()] purposes).
-#'   Human-friendly group names are permitted--they need not be short,
-#'   identifier-style names.
+#'   (for [clearGroup()] and [addLayersControl()] purposes). Human-friendly
+#'   group names are permitted--they need not be short, identifier-style names.
 #' @param options tile options
+#' @param check Check that the specified `provider` matches the available
+#'   currently loaded leaflet providers? Defaults to `TRUE`, but can be toggled
+#'   to `FALSE` for advanced users.
 #' @return modified map object
 #'
 #' @examples
@@ -36,8 +38,19 @@ addProviderTiles <- function(
   provider,
   layerId = NULL,
   group = NULL,
-  options = providerTileOptions()
+  options = providerTileOptions(),
+  check = TRUE
 ) {
+  if (check) {
+    loaded_providers <- leaflet.providers::providers_loaded()
+    if (!provider %in% names(loaded_providers$providers)) {
+      stop(
+        "Unknown tile provider '",
+        provider,
+        "'; either use a known provider or pass `check = FALSE` to `addProviderTiles()`"
+      )
+    }
+  }
   map$dependencies <- c(map$dependencies, leafletProviderDependencies())
   invokeMethod(map, getMapData(map), "addProviderTiles",
     provider, layerId, group, options)
diff --git a/man/addProviderTiles.Rd b/man/addProviderTiles.Rd
index 2228b7c6d..e9e8d5d71 100644
--- a/man/addProviderTiles.Rd
+++ b/man/addProviderTiles.Rd
@@ -10,7 +10,8 @@ addProviderTiles(
   provider,
   layerId = NULL,
   group = NULL,
-  options = providerTileOptions()
+  options = providerTileOptions(),
+  check = TRUE
 )
 
 providerTileOptions(
@@ -33,12 +34,15 @@ providerTileOptions(
 \item{layerId}{the layer id to assign}
 
 \item{group}{the name of the group the newly created layers should belong to
-(for \code{\link[=clearGroup]{clearGroup()}} and \code{\link[=addLayersControl]{addLayersControl()}} purposes).
-Human-friendly group names are permitted--they need not be short,
-identifier-style names.}
+(for \code{\link[=clearGroup]{clearGroup()}} and \code{\link[=addLayersControl]{addLayersControl()}} purposes). Human-friendly
+group names are permitted--they need not be short, identifier-style names.}
 
 \item{options}{tile options}
 
+\item{check}{Check that the specified \code{provider} matches the available
+currently loaded leaflet providers? Defaults to \code{TRUE}, but can be toggled
+to \code{FALSE} for advanced users.}
+
 \item{errorTileUrl, noWrap, opacity, zIndex, updateWhenIdle, detectRetina}{the tile layer options; see
 \url{https://web.archive.org/web/20220702182250/https://leafletjs.com/reference-1.3.4.html#tilelayer}}
 
diff --git a/tests/testthat/test-tiles.R b/tests/testthat/test-tiles.R
new file mode 100644
index 000000000..10c0dca90
--- /dev/null
+++ b/tests/testthat/test-tiles.R
@@ -0,0 +1,14 @@
+
+testthat::test_that("Checking of tile providers works correctly", {
+  expect_no_error(
+    leaflet() %>% addProviderTiles(providers[[1]])
+  )
+
+  expect_no_error(
+    leaflet() %>% addProviderTiles("FAKETILESET123", check = FALSE)
+  )
+
+  expect_error(
+    leaflet() %>% addProviderTiles("FAKETILESET123")
+  )
+})