added depracation warning (#95)

* added depracation warning

* added deprecation tests

NEWS.md

@@ -1,7 +1,8 @@
 # mapme.biodiversity (development version)
 
 ## Breaking changes
-* extensive renaming of resources and indicators:
+* extensive renaming of resources and indicators. These are handled gracefully
+until the next release (i.e. a warning is issued and names are replaced):
 
 * resources:
 * `treecover2000` -> `gfw_treecover`

R/calc_indicator.R

@@ -21,6 +21,9 @@
 #' @keywords function
 #' @export
 calc_indicators <- function(x, indicators, ...) {
+
+  # depreciation warining for old indicator names
+  indicators <- .depreciation_warning(indicators, resource = FALSE)
   # check if the requested resource is supported
   required_resources <- .check_requested_indicator(indicators)
   # check if any of the requested resources is already locally available
@@ -41,7 +44,6 @@ calc_indicators <- function(x, indicators, ...) {
     suppressMessages(sf_use_s2(FALSE))
     on.exit(suppressMessages(sf_use_s2(s2_org)))
   }
-
   for (indicator in indicators) x <- .get_single_indicator(x, indicator, ...)
   x
 }

R/get_resource.R

@@ -24,6 +24,9 @@ get_resources <- function(x, resources, ...) {
   if (!connection_available) {
     stop("There seems to be no internet connection. Cannot download resources.")
   }
+
+  # depreciation warining for old resource names
+  resources <- .depreciation_warning(resources, resource = TRUE)
   # check if the requested resource is supported
   .check_requested_resources(resources)
   # check if any of the requested resources is already locally available
@@ -32,6 +35,7 @@ get_resources <- function(x, resources, ...) {
   if (length(resources) == 0) {
     return(x)
   }
+
   # get the resources
   ## TODO: check if we can go parallel here. Problem is when errors occur
   # for one resource and it terminates the complete process. We would have

R/utils.R

@@ -27,7 +27,7 @@
     unsupported <- indicators[which(!indicators %in% names_indicators)]
     base_msg <- "The following requested %s not supported: %s."
     mid_msg <- ifelse(length(unsupported) == 1,
-      "indicator is", "indicators are"
+                      "indicator is", "indicators are"
     )
     end_msg <- paste(unsupported, collapse = ", ")
     stop(sprintf(base_msg, mid_msg, end_msg))
@@ -68,8 +68,8 @@
       nonexisting <- req_resources[which(!req_resources %in% ex_resources)]
       base_msg <- "The following required %s not available: %s."
       mid_msg <- ifelse(length(nonexisting) == 1,
-        "resource is",
-        "resources are"
+                        "resource is",
+                        "resources are"
       )
       end_msg <- paste(nonexisting, collapse = ", ")
       stop(sprintf(base_msg, mid_msg, end_msg))
@@ -105,8 +105,8 @@
     unspecified_args <- req_args_names[!req_args_names %in% names(args)]
   }
   base_msg <- paste("Argument '%s' for resource '%s' was not specified. ",
-    "Setting to default value of '%s'.",
-    sep = ""
+                    "Setting to default value of '%s'.",
+                    sep = ""
   )
   default_args <- as.list(sapply(unspecified_args, function(arg_name) {
     message(
@@ -200,7 +200,7 @@
   if (any(!target_years %in% available_years)) {
     target_years <- target_years[target_years %in% available_years]
     if(length(target_years) > 0 ){
-    message(sprintf("Some target years are not available for %s.", indicator))
+      message(sprintf("Some target years are not available for %s.", indicator))
     } else {
       stop(
         sprintf(
@@ -224,8 +224,8 @@
   if (!queried_engine %in% implemented_engines) {
     stop(sprintf(
       paste("Engine '%s' is not an available engine.",
-        "Please choose one of: %s",
-        collapse = " "
+            "Please choose one of: %s",
+            collapse = " "
       ),
       queried_engine, paste(implemented_engines, collapse = ", ")
     ))
@@ -301,8 +301,8 @@
         }
 
         status <- download.file(missing_urls[i], missing_filenames[i],
-          quiet = TRUE, "libcurl",
-          mode = ifelse(Sys.info()["sysname"] == "Windows", "wb", "w")
+                                quiet = TRUE, "libcurl",
+                                mode = ifelse(Sys.info()["sysname"] == "Windows", "wb", "w")
         )
         if (status != 0) {
           return(list(urls = missing_urls[i], filenames = missing_filenames[i]))
@@ -314,8 +314,8 @@
       unsuccessful <- unsuccessful[which(sapply(unsuccessful, function(x) !is.null(x)))]
       if (length(unsuccessful) > 0 & counter <= stubbornnes) {
         warning(paste("Some target files have not been downloaded correctly. ",
-          "Download will be retried.",
-          sep = ""
+                      "Download will be retried.",
+                      sep = ""
         ))
         missing_urls <- sapply(unsuccessful, function(x) x$missing_urls)
         missing_filenames <- sapply(unsuccessful, function(x) x$missing_filenames)
@@ -348,3 +348,86 @@
   }
   return(filenames)
 }
+
+
+.depreciation_warning <- function(names, resource){
+  resources <- tibble(
+    old = c("treecover2000",
+            "lossyear",
+            "greenhouse",
+            "traveltime",
+            "nasagrace",
+            "mintemperature",
+            "maxtemperature",
+            "precipitation",
+            "ecoregions",
+            "mangrove",
+            "srtmdem"),
+    new = c("gfw_treecover",
+            "gfw_lossyear",
+            "gfw_emissions",
+            "nelson_et_al",
+            "nasa_grace",
+            "worldclim_min_temperature",
+            "worldclim_max_temperature",
+            "worldclim_precipitation",
+            "teow",
+            "gmw",
+            "nasa_srtm")
+  )
+
+  indicators <- tibble(
+    old = c("treecover",
+            "emissions",
+            "treeloss",
+            "chirpsprec",
+            "accessibility",
+            "popcount",
+            "wctmin",
+            "wctmax",
+            "wcprec",
+            "gmw",
+            "teow"
+    ),
+    new = c("treecover_area",
+            "treecoverloss_emissions",
+            "treecover_area_and_emissions",
+            "precipitation_chirps",
+            "traveltime",
+            "population_count",
+            "temperature_min_wc",
+            "temperature_max_wc",
+            "precipitation_wc",
+            "mangroves_area",
+            "ecoregion")
+  )
+
+  if(resource){
+    basemsg <- paste("Resource '%s' has been renamed to '%s'. In the next release '%s'",
+                     "will no longer be supported.\nPlease adjust your scripts accordingly.", sep = " ")
+    for (name in names){
+      if(name %in% resources$old){
+        old <- name
+        new <- resources$new[which(resources$old == name)]
+        msg <- sprintf(basemsg, old, new, old)
+        warning(msg)
+        names[names == name] <- new
+      }
+    }
+  }
+
+  if(!resource){
+    basemsg <- paste("Indicator '%s' has been renamed to '%s'. In the next release '%s'",
+                     "will no longer be supported.\nPlease adjust your scripts accordingly.", sep = " ")
+    for (name in names){
+      if(name %in% indicators$old){
+        old <- name
+        new <- indicators$new[which(indicators$old == name)]
+        msg <- sprintf(basemsg, old, new, old)
+        warning(msg)
+        names[names == name] <- new
+      }
+    }
+  }
+  names
+}

tests/testthat/test-calc_indicator.R

@@ -61,4 +61,8 @@ test_that("calc_indicator works", {
   )$treecover_area[[1]]
 
   expect_snapshot(stat)
+
+  expect_warning(
+    calc_indicators(portfolio, "treecover")
+  )
 })

tests/testthat/test-get_resources.R

@@ -48,4 +48,8 @@ test_that("get_resources works", {
     ),
     "The following requested resources are already available: gfw_treecover, gfw_lossyear, gfw_emissions."
   )
+
+  expect_warning(
+    get_resources(portfolio, "treecover2000")
+  )
 })