more input assertion fuction usage

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: gtfsio
 Title: Read and Write General Transit Feed Specification (GTFS) Files
-Version: 0.2.0.9008
+Version: 0.2.0.9009
 Authors@R: 
     c(person(given = "Daniel",
              family = "Herszenhut",

R/assert_inputs.R

@@ -111,14 +111,14 @@ assert_vector <- function(x,
     )
 
   vector_name2 <- ifelse(class == "list", "list.", paste0(class, " vector."))
-  if (named && is.null(names(x)))
+  if (named && is.null(names(x)) && !is.null(x))
     gtfsio_error(
       paste0(input_name, " must be a named ", vector_name2),
       input_error_class,
       error_call
     )
 
-  non_empty_names <- setdiff(names(x), "")
+  non_empty_names <- names(x)[! names(x) %chin% ""]
   if (named && (!is.null(names(x)) && length(non_empty_names) != length(x)))
     gtfsio_error(
       paste0("Every element in ", input_name, " must be named."),
@@ -135,7 +135,7 @@ assert_vector <- function(x,
 #' @rdname assert_vector
 #' @family input assertion
 #' @keywords internal
-assert_list <- function(x, len = NULL, null_ok = FALSE) {
+assert_list <- function(x, len = NULL, null_ok = FALSE, named = FALSE) {
 
   # input checks are all conducted inside assert_vector()
 
@@ -148,6 +148,7 @@ assert_list <- function(x, len = NULL, null_ok = FALSE) {
     len = len,
     null_ok = null_ok,
     var_name = var_name,
+    named = named,
     n_call = -2L
   )
 

R/checks.R

@@ -25,11 +25,8 @@
 #' @export
 check_files_exist <- function(x, files) {
 
-  # input checking
-
-  if (!inherits(x, "gtfs")) stop("'x' must inherit from the 'gtfs' class.")
-
-  if (!is.character(files)) stop("'files' must be a character vector.")
+  assert_class(x, "gtfs")
+  assert_vector(files, "character")
 
   # actual checking
 
@@ -47,11 +44,8 @@ check_files_exist <- function(x, files) {
 #' @export
 assert_files_exist <- function(x, files) {
 
-  # input checking
-
-  if (!inherits(x, "gtfs")) stop("'x' must inherit from the 'gtfs' class.")
-
-  if (!is.character(files)) stop("'files' must be a character vector.")
+  assert_class(x, "gtfs")
+  assert_vector(files, "character")
 
   # actual checking
 
@@ -99,14 +93,9 @@ assert_files_exist <- function(x, files) {
 #' @export
 check_fields_exist <- function(x, file, fields) {
 
-  # input checking
-
-  if (!inherits(x, "gtfs")) stop("'x' must inherit from the 'gtfs' class.")
-
-  if (!is.character(file) | length(file) != 1)
-    stop("'file' must be a string (a character vector of length 1).")
-
-  if (!is.character(fields)) stop("'fields' must be a character vector.")
+  assert_class(x, "gtfs")
+  assert_vector(file, "character", len = 1L)
+  assert_vector(fields, "character")
 
   # check if 'file' exists, and return FALSE if it doesn't
 
@@ -128,17 +117,9 @@ check_fields_exist <- function(x, file, fields) {
 #' @export
 assert_fields_exist <- function(x, file, fields) {
 
-  # input checking
-
-  if (!inherits(x, "gtfs")) stop("'x' must inherit from the 'gtfs' class.")
-
-  if (!is.character(file) | length(file) != 1)
-    stop("'file' must be a string (a character vector of length 1).")
-
-  if (!is.character(fields)) stop("'fields' must be a character vector.")
-
-  # assert that 'file' exists
-
+  assert_class(x, "gtfs")
+  assert_vector(file, "character", len = 1L)
+  assert_vector(fields, "character")
   assert_files_exist(x, file)
 
   # actual checking
@@ -201,17 +182,15 @@ assert_fields_exist <- function(x, file, fields) {
 #' @export
 check_fields_types <- function(x, file, fields, types) {
 
-  # input checking
-
-  if (!inherits(x, "gtfs")) stop("'x' must inherit from the 'gtfs' class.")
-
-  if (!is.character(file) | length(file) != 1)
-    stop("'file' must be a string (a character vector of length 1).")
-
-  if (!is.character(fields)) stop("'fields' must be a character vector.")
+  assert_class(x, "gtfs")
+  assert_vector(file, "character", len = 1L)
+  assert_vector(fields, "character")
 
   if (!is.character(types) | length(types) != length(fields))
-    stop("'types' must be a character vector with the same length of 'fields'.")
+    gtfsio_error(
+      "'types' must be a character vector with the same length of 'fields'.",
+      subclass = "bad_types_argument"
+    )
 
   # check if 'fields' exists, and return FALSE if it doesn't
 
@@ -233,21 +212,16 @@ check_fields_types <- function(x, file, fields, types) {
 #' @export
 assert_fields_types <- function(x, file, fields, types) {
 
-  # input checking
-
-  if (!inherits(x, "gtfs")) stop("'x' must inherit from the 'gtfs' class.")
-
-  if (!is.character(file) | length(file) != 1)
-    stop("'file' must be a string (a character vector of length 1).")
-
-  if (!is.character(fields)) stop("'fields' must be a character vector.")
+  assert_class(x, "gtfs")
+  assert_vector(file, "character", len = 1L)
+  assert_vector(fields, "character")
+  assert_fields_exist(x, file, fields)
 
   if (!is.character(types) | length(types) != length(fields))
-    stop("'types' must be a character vector with the same length of 'fields'.")
-
-  # assert that 'fields' exist
-
-  assert_fields_exist(x, file, fields)
+    gtfsio_error(
+      "'types' must be a character vector with the same length of 'fields'.",
+      subclass = "bad_types_argument"
+    )
 
   # actual checking - compare the desired types to the actual types
 

R/export_gtfs.R

@@ -56,9 +56,7 @@ export_gtfs <- function(gtfs,
 
   # basic input checking
 
-  if (!inherits(gtfs, "gtfs"))
-    stop("'gtfs' must inherit from the 'gtfs' class.")
-
+  assert_class(gtfs, "gtfs")
   assert_vector(path, "character", len = 1L)
   assert_vector(files, "character", null_ok = TRUE)
   assert_vector(standard_only, "logical", len = 1L)
@@ -101,7 +99,7 @@ export_gtfs <- function(gtfs,
       paste0("'", extra_files, "'", collapse = ", ")
     )
 
- # if files is NULL then all 'gtfs' elements should be written
+  # if files is NULL then all 'gtfs' elements should be written
 
   if (is.null(files)) files <- names(gtfs)
 

R/import_gtfs.R

@@ -79,7 +79,7 @@ import_gtfs <- function(path,
 
   assert_vector(path, "character", len = 1L)
   assert_vector(quiet, "logical", len = 1L)
-  assert_list(extra_spec, null_ok = TRUE)
+  assert_list(extra_spec, null_ok = TRUE, named = TRUE)
   assert_vector(files, "character", null_ok = TRUE)
   assert_list(fields, null_ok = TRUE)
   assert_vector(skip, "character", null_ok = TRUE)

R/new_gtfs.R

@@ -49,14 +49,8 @@ new_gtfs <- function(x, subclass = character(), ...) {
 
   # input checking
 
-  if (!is.list(x)) stop("'x' must be a list.")
-
-  if (is.null(names(x))) stop("'x' must be a named list.")
-
-  x_names <- names(x)[! names(x) %chin% ""]
-  if (length(x_names) != length(x)) stop("Every element in 'x' must be named.")
-
-  if (!is.character(subclass)) stop("'subclass' must be a character vector.")
+  assert_list(x, named = TRUE)
+  assert_vector(subclass, "character")
 
   # append "gtfs" and "list" to 'subclass', so any objects created by
   # 'new_gtfs()' always inherit from gtfs and list classes

codemeta.json

@@ -10,7 +10,7 @@
   "codeRepository": "https://github.com/r-transit/gtfsio",
   "issueTracker": "https://github.com/r-transit/gtfsio/issues",
   "license": "https://spdx.org/licenses/MIT",
-  "version": "0.2.0.9008",
+  "version": "0.2.0.9009",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",
@@ -129,7 +129,7 @@
       "sameAs": "https://CRAN.R-project.org/package=zip"
     }
   ],
-  "fileSize": "268617.447KB",
+  "fileSize": "268617.776KB",
   "keywords": [
     "r",
     "gtfs"

inst/tinytest/test_assert_inputs.R

@@ -113,18 +113,24 @@ expect_error(another_fn("a", "integer"), class = c("another_fn_error"))
 
 # another setup function
 
-list_fn <- function(x, len = NULL, null_ok = FALSE) {
+list_fn <- function(x, len = NULL, null_ok = FALSE, named = FALSE) {
 
-  gtfsio:::assert_list(x, len, null_ok)
+  gtfsio:::assert_list(x, len, null_ok, named)
 
 }
 
 # check that info message is correct
 expect_error(list_fn(1), pattern = "'x' must be a list\\.")
+expect_error(
+  list_fn(list(1), named = TRUE),
+  pattern = "'x' must be a named list\\."
+)
 
 # check that error class is correct
 expect_error(list_fn(1), class = "list_fn_error")
 
+# check that error class is correct
+
 
 # assert_class() ----------------------------------------------------------