Refactoring of check_package() + return TRUE instead of package + tests

R/check_package.R

@@ -0,0 +1,74 @@
+#' Check validity camera trap data package
+#'
+#' Checks the validity of a camera trap data package.
+#' It checks whether the data package is a list containing an element called
+#' `data` with the following resources as tibble data frames:
+#' - `observations`
+#' - `media`
+#' - `deployments`
+#'
+#' @param package Camera trap data package
+#' @param datapkg Deprecated. Use `package` instead.
+#' @param media Has the `media` resource been loaded while reading the data
+#'   package? Default: `FALSE`.
+#' @return `TRUE` or error.
+#' @noRd
+check_package <- function(package = NULL,
+                          datapkg = NULL,
+                          function_name,
+                          media = FALSE) {
+  if (lifecycle::is_present(datapkg) & !is.null(datapkg)) {
+    lifecycle::deprecate_warn(
+      when = "0.16.0",
+      what = paste0(function_name, "(datapkg = )"),
+      with = paste0(function_name, "(package = )")
+    )
+    if (is.null(package)) {
+      package <- datapkg
+    }
+  }
+  # check media arg
+  assertthat::assert_that(
+    media %in% c(TRUE, FALSE),
+    msg = "`media` must be a logical: TRUE or FALSE"
+  )
+  # camera trap data package is a list
+  assertthat::assert_that(is.list(package),
+                          msg = "package is not a list.")
+  assertthat::assert_that(!is.data.frame(package),
+                          msg = "package is not a list.")
+  # check existence of an element called data
+  assertthat::assert_that("data" %in% names(package),
+                          msg = "data element is missing from package")
+  # check validity data element of package: does it contain deployments and
+  # observations?
+  elements <- c("deployments", "observations")
+  if (media) {
+    elements <- c(elements, "media")
+  }
+  tables_absent <- elements[
+    !elements %in% names(package$data)
+  ]
+  assertthat::assert_that(
+    length(tables_absent) == 0,
+    msg = glue::glue(
+      "Can't find {length(tables_absent)} elements in data package: {tables_absent*}",
+      .transformer = collapse_transformer(sep = ", ", last = " and ")
+    )
+  )
+  if (media) {
+    assertthat::assert_that(
+      !is.null(package$data$media),
+      msg = glue::glue("Can't find media in .$data.")
+    )
+  }
+  # check observations and deployments are data.frames
+  assertthat::assert_that(is.data.frame(package$data$observations))
+  assertthat::assert_that(is.data.frame(package$data$deployments))
+  # check media is a data.frame (if imported, i.e. if not NULL)
+  if (!is.null(package$data$media)) {
+    assertthat::assert_that(is.data.frame(package$data$media))
+  }
+  # If no errors are encountered, TRUE is returned
+  return(TRUE)
+}

R/check_species.R

@@ -38,7 +38,8 @@ check_species <- function(package = NULL,
                           arg_name = "species",
                           datapkg = lifecycle::deprecated()) {
   # Check camera trap data package
-  package <- check_package(package, datapkg, "check_species")
+  check_package(package, datapkg, "check_species")
+
   assertthat::assert_that(
     !is.null(species) & length(species) > 0,
     msg = "`species` parameter must be specified"

R/get_cam_op.R

@@ -47,10 +47,13 @@ get_cam_op <- function(package = NULL,
                        ...,
                        station_col = "locationName",
                        use_prefix = FALSE,
-                       datapkg = NULL) {
+                       datapkg = lifecycle::deprecated()) {
   # check camera trap data package
-  package <- check_package(package, datapkg, "get_cam_op")
-
+  check_package(package, datapkg, "get_cam_op")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # Check that station_col is a single string
   assertthat::assert_that(assertthat::is.string(station_col))
   # Check that station_col is one of the columns in deployments

R/get_custom_effort.R

@@ -91,7 +91,7 @@ get_custom_effort <- function(package = NULL,
                               end = NULL,
                               group_by = NULL,
                               unit = "hour",
-                              datapkg = NULL) {
+                              datapkg = lifecycle::deprecated()) {
   # define possible unit values
   units <- c("hour", "day")
 
@@ -116,8 +116,11 @@ get_custom_effort <- function(package = NULL,
   check_value(group_by, group_bys, "group_by", null_allowed = TRUE)
 
   # check camera trap data package
-  package <- check_package(package, datapkg, "get_custom_effort")
-
+  check_package(package, datapkg, "get_custom_effort")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # get deployments
   deployments <- package$data$deployments
 

R/get_effort.R

@@ -42,8 +42,11 @@ get_effort <- function(package = NULL,
   check_value(unit, units, "unit", null_allowed = FALSE)
 
   # check camera trap data package
-  package <- check_package(package, datapkg, "get_effort")
-
+  check_package(package, datapkg, "get_effort")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # apply filtering
   package$data$deployments <- apply_filter_predicate(
     df = package$data$deployments,

R/get_n_individuals.R

@@ -67,8 +67,11 @@ get_n_individuals <- function(package = NULL,
                               life_stage = NULL,
                               datapkg = lifecycle::deprecated()) {
   # check input data package
-  package <- check_package(package, datapkg, "get_n_individuals")
-
+  check_package(package, datapkg, "get_n_individuals")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # avoid to call variables like column names to make life easier using filter()
   sex_value <- sex
 

R/get_n_obs.R

@@ -64,8 +64,11 @@ get_n_obs <- function(package = NULL,
                       life_stage = NULL,
                       datapkg = lifecycle::deprecated()) {
   # check input data package
-  package <- check_package(package, datapkg, "get_n_obs")
-
+  check_package(package, datapkg, "get_n_obs")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # avoid to call variables like column names to make life easier using filter()
   sex_value <- sex
 

R/get_n_species.R

@@ -23,8 +23,10 @@ get_n_species <- function(package = NULL,
                           ...,
                           datapkg = lifecycle::deprecated()) {
   # check input data package
-  package <- check_package(package, datapkg, "get_n_species")
-
+  check_package(package, datapkg, "get_n_species")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
   # extract observations and deployments
   observations <- package$data$observations
   deployments <- package$data$deployments

R/get_rai.R

@@ -58,8 +58,11 @@ get_rai <- function(package = NULL,
                     life_stage = NULL,
                     datapkg = lifecycle::deprecated()) {
   # check camera trap data package
-  package <- check_package(package, datapkg, "get_rai")
-
+  check_package(package, datapkg, "get_rai")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   get_rai_primitive(package, ...,
     use = "n_obs",
     species = species,
@@ -135,7 +138,11 @@ get_rai_individuals <- function(package = NULL,
                                 life_stage = NULL,
                                 datapkg = lifecycle::deprecated()) {
   # check camera trap data package
-  package <- check_package(package, datapkg, "get_rai_individuals")
+  check_package(package, datapkg, "get_rai_individuals")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   get_rai_primitive(package, ...,
     use = "n_individuals",
     species = species,

R/get_record_table.R

@@ -102,8 +102,11 @@ get_record_table <- function(package = NULL,
                              removeDuplicateRecords = TRUE,
                              datapkg = lifecycle::deprecated()) {
   # check data package
-  package <- check_package(package, datapkg, "get_record_table", media = TRUE)
-
+  check_package(package, datapkg, "get_record_table", media = TRUE)
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # check stationCol is a valid column name
   assertthat::assert_that(
     stationCol %in% names(package$data$deployments),

R/get_scientific_name.R

@@ -35,7 +35,11 @@
 get_scientific_name <- function(package = NULL,
                                 vernacular_name,
                                 datapkg = lifecycle::deprecated()) {
-  package <- check_package(package, datapkg, "get_scientific_name")
+  check_package(package, datapkg, "get_scientific_name")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   all_sn_vn <- get_species(package)
 
   # get vernacular names for check

R/get_species.R

@@ -14,8 +14,11 @@
 #' get_species(mica)
 get_species <- function(package = NULL, datapkg = lifecycle::deprecated()) {
   # Check camera trap data package
-  package <- check_package(package, datapkg, "get_species", media = FALSE)
-
+  check_package(package, datapkg, "get_species", media = FALSE)
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # Get taxonomic information from package metadata
   if (!"taxonomic" %in% names(package)) {
     return(NULL)

R/map_dep.R

@@ -352,8 +352,11 @@ map_dep <- function(package = NULL,
                     datapkg = lifecycle::deprecated()) {
 
   # check camera trap data package
-  package <- check_package(package, datapkg, "map_dep")
-
+  check_package(package, datapkg, "map_dep")
+  if (is.null(package) & !is.name(datapkg)) {
+    package <- datapkg
+  }
+
   # define possible feature values
   features <- c(
     "n_species",

R/read_camtrap_dp.R

@@ -147,7 +147,7 @@ read_camtrap_dp <- function(file = NULL,
   }
 
   package$data <- data
-  package <- check_package(package, media = media)
+  check_package(package, media = media)
 
   package <- add_taxonomic_info(package)
 
@@ -165,7 +165,7 @@ read_camtrap_dp <- function(file = NULL,
     package$data$media <- order_cols_media(package$data$media)
   }
 
-  package <- check_package(package, media = media)
+  check_package(package, media = media)
 
   # Inherit parsing issues from reading
   attr(package$data$observations, which = "problems") <- issues_observations

R/zzz.R

@@ -1,73 +1,3 @@
-#' Check validity camera trap data package
-#'
-#' Checks the validity of a camera trap data package.
-#' It checks whether the data package is a list containing an element called
-#' `data` with the following resources as tibble data frames:
-#' - `observations`
-#' - `media`
-#' - `deployments`
-#'
-#' @param package Camera trap data package
-#' @param datapkg Deprecated. Use `package` instead.
-#' @param media Has the `media` resource been loaded while reading the data
-#'   package? Default: `FALSE`.
-#' @return A camera trap data package.
-#' @noRd
-check_package <- function(package = NULL,
-                          datapkg = NULL,
-                          function_name,
-                          media = FALSE) {
-  if (lifecycle::is_present(datapkg) & !is.null(datapkg)) {
-    lifecycle::deprecate_warn(
-      when = "0.16.0",
-      what = paste0(function_name, "(datapkg = )"),
-      with = paste0(function_name, "(package = )")
-    )
-    if (is.null(package)) {
-      package <- datapkg
-    }
-  }
-  # check media arg
-  assertthat::assert_that(
-    media %in% c(TRUE, FALSE),
-    msg = "`media` must be a logical: TRUE or FALSE"
-  )
-  # camera trap data package is a list
-  assertthat::assert_that(is.list(package))
-  assertthat::assert_that(!is.data.frame(package))
-  # check existence of an element called data
-  assertthat::assert_that("data" %in% names(package))
-  # check validity data element of package: does it contain deployments and
-  # observations?
-  elements <- c("deployments", "observations")
-  if (media) {
-    elements <- c(elements, "media")
-  }
-  tables_absent <- elements[
-    !elements %in% names(package$data)
-  ]
-  assertthat::assert_that(length(tables_absent) == 0,
-    msg = glue::glue(
-      "Can't find {tables_absent} elements in data package: {tables_absent*}",
-      .transformer = collapse_transformer(sep = ", ", last = " and ")
-    )
-  )
-  if (media) {
-    assertthat::assert_that(
-      !is.null(package$data$media),
-      msg = glue::glue("Can't find media in .$data.")
-    )
-  }
-  # check observations and deployments are data.frames
-  assertthat::assert_that(is.data.frame(package$data$observations))
-  assertthat::assert_that(is.data.frame(package$data$deployments))
-  # check media is a data.frame (if imported, i.e. if not NULL)
-  if (!is.null(package$data$media)) {
-    assertthat::assert_that(is.data.frame(package$data$media))
-  }
-  package
-}
-
 #' Check input value against list of provided values
 #'
 #' Will return error message if an input value cannot be found in list of
@@ -247,7 +177,7 @@ get_dep_no_obs <- function(package = NULL,
                            datapkg = lifecycle::deprecated()) {
 
   # check input camera trap data package
-  package <- check_package(package, datapkg, "get_dep_no_obs")
+  check_package(package, datapkg, "get_dep_no_obs")
 
   # extract observations and deployments
   observations <- package$data$observations