diff --git a/.Rhistory b/.Rhistory
index 5d4a3e6..d6e6434 100644
--- a/.Rhistory
+++ b/.Rhistory
@@ -1,399 +1,339 @@
-expect_false(is_incrementing(c(4, 3, 0)))
-expect_true(is_incrementing(1, NA, NA, 3))
-expect_true(is_incrementing(1, 3, NA, NA))
-sort(c(1, 3, NA))
-expect_false(is_incrementing(c(NA, 3, 5)))
-devtools::load_all(".")
-devtools::document()
-expect_true(nullable(c(1, NA, 4)))
-expect_true(is_incrementing(nullable(c(1, NA, 4))))
-nullable(is_incrementing)
-expect_true(nullable(is_incrementing)(c(1, NA, 3)))
-devtools::load_all(".")
-x <- c(1, NA, 3)
-is_incrementing(x)
-is_incrementing_null <- nullable(is_incrementing)
-is_incrementing_null(x)
-devtools::document()
-df <- data.frame()
-class(df)
-renv::install("tibble")
-class(tibble::tibble())
-inherits(tibble::tibble(), "data.frame")
-devtools::load_all(".")
-test_that("is_all_distinct", {
-expect_true(is_all_distinct(c(1:5)))
-expect_false(is_all_distinct(c(1, 1, 2)))
-})
-test_that("is_all_distinct", {
-expect_true(is_all_distinct(c(1:5)))
-expect_false(is_all_distinct(c(1, 1, 2)))
-expect_true(nullable(is_all_distinct)(c(1, 3, NA, NA)))
-})
-devtools::document()
-library(schematic)
-test_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA)
-)
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-age ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F"))
-)
-test_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA)
-)
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-age ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
-)
-test_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA),
-q_1 = c(TRUE, FALSE, FALSE, FALSE, TRUE),
-q_2 = c(FALSE, FALSE, TRUE, TRUE, TRUE),
-q_3 = c(TRUE, TRUE, TRUE, TRUE, FALSE)
-)
-survey_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA),
-q_1 = c(TRUE, FALSE, FALSE, FALSE, TRUE),
-q_2 = c(FALSE, FALSE, TRUE, TRUE, TRUE),
-q_3 = c(TRUE, TRUE, TRUE, TRUE, FALSE)
-)
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-survey_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA),
-q_1 = c(TRUE, FALSE, FALSE, FALSE, TRUE),
-q_2 = c(FALSE, FALSE, TRUE, TRUE, TRUE),
-q_3 = c(TRUE, TRUE, TRUE, TRUE, FALSE)
-)
-#| error: true
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-age ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
-)
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-devtools::load_all(".")
-devtools::load_all(".")
-devtools::load_all(".")
-#| error: true
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-age ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
-)
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-survey_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA),
-q_1 = c(TRUE, FALSE, FALSE, FALSE, TRUE),
-q_2 = c(FALSE, FALSE, TRUE, TRUE, TRUE),
-q_3 = c(TRUE, TRUE, TRUE, TRUE, FALSE)
-)
-#| error: true
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-age ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
-)
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-age ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
-)
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-c(id, age) ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
-)
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-survey_data <- data.frame(
-id = c(1:3, NA, 5),
-name = c("Emmett", "Billy", "Sally", "Woolley", "Duchess"),
-age = c(19.2, 10, 22.5, 19, 19),
-sex = c("M", "M", "F", "M", NA),
-q_1 = c(TRUE, FALSE, FALSE, FALSE, TRUE),
-q_2 = c(FALSE, FALSE, TRUE, TRUE, TRUE),
-q_3 = c(TRUE, TRUE, TRUE, TRUE, FALSE)
-)
-my_schema <- schema(
-id ~ is_incrementing,
-c(name, sex) ~ is.character,
-c(id, age) ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
+devtools::load_all(".")
+devtools::load_all(".")
+df <- mtcars
+sch <- schema(
+c(cyl, am) ~ as.character,
+disp ~ as.numeric
 )
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-NA %% 1
-my_schema <- schema(
-id ~ is_incrementing,
-id ~ is_all_distinct,
-c(name, sex) ~ is.character,
-c(id, age) ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical
+expect_error(
+expect_warning(check_schema(df, sch), "All predicate")
 )
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
+invalid_preds_list
+devtools::load_all(".")
+sch <- schema(
+c(cyl, am) ~ as.character,
+disp ~ as.numeric
+)
+expect_error(
+expect_warning(check_schema(df, sch), "All predicate")
 )
+check_schema(df, sch)
 devtools::load_all(".")
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
+expect_error(
+expect_warning(check_schema(df, sch), "All predicate")
 )
-my_schema <- schema(
-id ~ is_incrementing,
-id ~ is_all_distinct,
-c(name, sex) ~ is.character,
-c(id, age) ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical,
-final_score ~ is.numeric
-)
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-test_that("check_schema works on non-definite selector", {
-test_that("check_schema works on non-definite selector", {
-df <- mtcars
 sch <- schema(
-starts_with("blahblah") ~ as.character
+c(cyl, am) ~ as.character,
+disp ~ as.numeric
 )
-expect_invisible(check_schema(df, sch))
-})
-my_schema <- schema(
-id ~ is_incrementing,
-id ~ is_all_distinct,
-c(name, sex) ~ is.character,
-c(id, age) ~ is_whole_number,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical,
-final_score ~ is.numeric
-)
-my_schema <- schema(
-id ~ is_incrementing,
-id ~ is_all_distinct,
-c(name, sex) ~ is.character,
-c(id, age) ~ is_whole_number,
-education ~ is.factor,
-sex ~ function(x) all(x %in% c("M", "F")),
-starts_with("q_") ~ is.logical,
-final_score ~ is.numeric
-)
-#| error: true
-check_schema(
-data = survey_data,
-schema = my_schema
-)
-#| error: true
-my_helpful_schema <- schema(
-`values are increasing` = id ~ is_incrementing,
-`values are all distinct` = id ~ is_all_distinct,
-`is a string` = c(name, sex) ~ is.character,
-`is a whole number (no decimals)` = c(id, age) ~ is_whole_number,
-education ~ is.factor,
-`has only entries 'F' or 'M'` = sex ~ function(x) all(x %in% c("M", "F")),
-`includes only TRUE or FALSE` = starts_with("q_") ~ is.logical,
-`is a number` = final_score ~ is.numeric
-)
-check_schema(
-data = survey_data,
-schema = my_helpful_schema
-)
-#| error: true
-my_helpful_schema <- schema(
-"values are increasing" = id ~ is_incrementing,
-`values are all distinct` = id ~ is_all_distinct,
-`is a string` = c(name, sex) ~ is.character,
-`is a whole number (no decimals)` = c(id, age) ~ is_whole_number,
-education ~ is.factor,
-`has only entries 'F' or 'M'` = sex ~ function(x) all(x %in% c("M", "F")),
-`includes only TRUE or FALSE` = starts_with("q_") ~ is.logical,
-`is a number` = final_score ~ is.numeric
-)
-check_schema(
-data = survey_data,
-schema = my_helpful_schema
-)
-#| error: true
-my_helpful_schema <- schema(
-"values are increasing" = id ~ is_incrementing,
-"values are all distinct" = id ~ is_all_distinct,
-"is a string" = c(name, sex) ~ is.character,
-"is a whole number (no decimals)" = c(id, age) ~ is_whole_number,
-education ~ is.factor,
-"has only entries 'F' or 'M'" = sex ~ function(x) all(x %in% c("M", "F")),
-"includes only TRUE or FALSE" = starts_with("q_") ~ is.logical,
-"is a number" = final_score ~ is.numeric
-)
-check_schema(
-data = survey_data,
-schema = my_helpful_schema
-)
-#| error: true
-my_helpful_schema <- schema(
-"values are increasing" = id ~ is_incrementing,
-"values are all distinct" = id ~ is_all_distinct,
-"is a string" = c(name, sex) ~ is.character,
-"is a whole number (no decimals)" = c(id, age) ~ is_whole_number,
-"has only entries 'F' or 'M'" = sex ~ function(x) all(x %in% c("M", "F")),
-"includes only TRUE or FALSE" = starts_with("q_") ~ is.logical,
-"is a number" = final_score ~ is.numeric
-)
-check_schema(
-data = survey_data,
-schema = my_helpful_schema
-)
-devtools::document()
-is_whole_number(Inf)
-test_that("infinitable", {
-x <- c(1, Inf, 3)
-is_incrementing_null <- infinitable(is_incrementing)
-expect_true(is_incrementing_null(x))
-})
-devtools::load_all(".")
-test_that("infinitable", {
-x <- c(1, Inf, 3)
-is_incrementing_null <- infinitable(is_incrementing)
-expect_true(is_incrementing_null(x))
-})
+check_schema(df, sch)
 devtools::load_all(".")
-devtools::check()
-pkgdown::preview_site()
-pkgdown::build_site()
-devtools::document()
-pkgdown::build_site()
-pkgdown::build_site()
-pkgdown::build_site()
-devtools::document()
-devtools::check()
-devtools::check()
-renv::snapshot()
-renv::snapshot()
-devtools::check()
-devtools::check()
-devtools::check()
-schema(
-cyl
+sch <- schema(
+c(cyl, am) ~ as.character,
+disp ~ as.numeric
 )
+check_schema(df, sch)
+invalid_preds_list
 devtools::load_all(".")
-schema(
-cyl
-)
 devtools::load_all(".")
-schema(
-cyl
-)
-rules
-dots
+check_schema(df, sch)
+predicate_fm
+invalid_preds_list
+names(invalid_preds_list)
+append(invalid_preds_list, character()) |>
+purrr::set_names(rlang::as_label(predicate_fm))
+character()
+list(character())
+append(list(), character())
+append(list(), character())
+append(invalid_preds_list, character())
+append(invalid_preds_list, list(character()))
 devtools::load_all(".")
+check_schema(df, sch)
+invalid_preds_list
 devtools::load_all(".")
-?withCallingHandlers
+check_schema(df, sch)
+predicate_fm
+invalid_preds_list[[predicate_fm]]
+.x
+.x
+check_schema(df, sch)
+.x
+predicate_fm
+invalid_preds_list
 devtools::load_all(".")
-schema(
-cyl
+check_schema(df, sch)
+predicate_fm
+predicate_fm
+invalid_preds_list
+append(invalid_preds_list, list(character()))
+append(
+invalid_preds_list,
+list(character()) |>
+purrr::set_names(rlang::as_label(predicate_fm))
 )
 devtools::load_all(".")
-schema(
-cyl
-)
+check_schema(df, sch)
+invalid_preds_list
 devtools::load_all(".")
-schema(
-cyl
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+out_inv
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+devtools::load_all(".")
+check_schema(df, sch)
+test_that("check_schema errors on non TRUE/FALSE check", {
+df <- mtcars
+sch <- schema(
+c(cyl, am) ~ as.character,
+disp ~ as.numeric
+)
+expect_error(
+expect_warning(check_schema(df, sch), "All predicate")
 )
+})
+test_that("rules with an error are handled", {
+sch <- schema(
+cyl ~ stop()
+)
+expect_error(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+)
+})
+devtools::load_all(".")
 devtools::load_all(".")
-schema(
-cyl
+test_that("rules with an error are handled", {
+sch <- schema(
+cyl ~ stop()
+)
+expect_error(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
 )
+})
+errored_preds_list
 devtools::load_all(".")
-schema(
-cyl
+test_that("rules with an error are handled", {
+sch <- schema(
+cyl ~ stop()
+)
+expect_error(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
 )
 sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+)
+})
+errored_preds_list
+list(
+col = character(),
+msg = character()
+)
+list(
+col = character(),
+msg = character()
+) |>
+purrr::set_names(rlang::as_label(predicate_fm))
+devtools::load_all(".")
+test_that("rules with an error are handled", {
+sch <- schema(
 cyl ~ stop()
 )
+expect_error(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
 )
-devtools::load_all(".")
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
+)
 )
+})
+errored_preds_list
+errored_preds_list
+purrr::iwalk(errored_preds_list, ~{
+cols_ticked <- paste0("`", .x, "`")
+plural_prefix <- glue::glue(cli::pluralize("column{?s} {cols_ticked}"))
+msg <- glue::glue("`{.y}` on {plural_prefix}")
+out_inv <<- c(out_inv, msg)
+})
+out_err <- c()
+purrr::iwalk(errored_preds_list, ~{
+cols_ticked <- paste0("`", .x, "`")
+plural_prefix <- glue::glue(cli::pluralize("column{?s} {cols_ticked}"))
+msg <- glue::glue("`{.y}` on {plural_prefix}")
+out_err <<- c(out_err, msg)
+})
+out_err
+errored_preds_list
 devtools::load_all(".")
+test_that("rules with an error are handled", {
+sch <- schema(
+cyl ~ stop()
+)
+expect_error(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
 )
+)
+})
+e
+e$message
+r
 devtools::load_all(".")
+test_that("rules with an error are handled", {
+sch <- schema(
+cyl ~ stop()
+)
+expect_error(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
+)
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
 )
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+)
+})
+e
+data
+stop(data[[.x]])
 devtools::load_all(".")
+test_that("rules with an error are handled", {
+sch <- schema(
+cyl ~ stop()
+)
+expect_error(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+)
+})
 check_schema(
 mtcars,
 sch
@@ -403,22 +343,70 @@ check_schema(
 mtcars,
 sch
 )
+out_err
+errored_preds_list
+sch <- schema(
+cyl ~ stop,
+am ~ ~"a" + 3
+)
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+)
+out_err
+out_err
+glue::glue("Error in predicate{plural_pred}:\n"), paste("-", out_err)
+cli::cli_warn(
+glue::glue("Error in predicate{plural_pred}:\n"), paste("-", out_err)
+)
 devtools::load_all(".")
+expect_error(
+expect_warning(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
+)
 )
 devtools::load_all(".")
+expect_error(
+expect_warning(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
+)
 )
 devtools::load_all(".")
+expect_error(
+expect_warning(
 check_schema(
 mtcars,
 sch
+),
+regexp = "Error in predicate"
 )
+)
+out_err
+glue::glue("Error in predicate{plural_pred}:\n"), paste("-", out_err)
+devtools::load_all(".")
 devtools::load_all(".")
+expect_error(
+expect_warning(
+check_schema(
+mtcars,
+sch
+),
+regexp = "Error in predicate"
+)
+)
 check_schema(
 mtcars,
 sch
@@ -428,21 +416,40 @@ check_schema(
 mtcars,
 sch
 )
+.x
+predicate_fm
+errored_preds_list
+check_schema(
+mtcars,
+sch
+)
+errored_preds_list
+c(errored_preds_list[[predicate_fm]], .x)
+errored_preds_list[[predicate_fm]]
+errored_preds_list[[predicate_fm]] <<- c(errored_preds_list[[predicate_fm]], .x)
+errored_preds_list
+errored_preds_list
 devtools::load_all(".")
 check_schema(
 mtcars,
 sch
 )
+errored_preds_list
 devtools::load_all(".")
 check_schema(
 mtcars,
 sch
 )
+invalid_preds_list
+devtools::load_all(".")
 devtools::load_all(".")
 check_schema(
 mtcars,
 sch
 )
+check_pass
+invalid_preds_list
+devtools::load_all(".")
 devtools::load_all(".")
 check_schema(
 mtcars,
@@ -453,60 +460,53 @@ check_schema(
 mtcars,
 sch
 )
+out_err
+errored_preds_list
 devtools::load_all(".")
 check_schema(
 mtcars,
 sch
 )
+errored_preds_list
 devtools::load_all(".")
 check_schema(
 mtcars,
 sch
 )
+.x
+predicate_fm
+errored_preds_list[[predicate_fm]]
 devtools::load_all(".")
 check_schema(
 mtcars,
 sch
 )
-rlang::last_trace()
-rlang::last_trace(drop = FALSE)
+errored_preds_list
+check_schema(
+mtcars,
+sch
+)
+errored_preds_list
 devtools::load_all(".")
-df <- mtcars
-sch <- schema(
-c(cyl, am) ~ is.character
+devtools::load_all(".")
+check_schema(
+mtcars,
+sch
 )
-check_schema(df, sch)
-usethis::use_news_md()
+errored_preds_list[[pred_idx]]
+pred_idx
+as.character(predicate_fm)
+rlang::as_label(predicate_fm)
+predicate_fm
+rlang::as_character(predicate_fm)
 devtools::load_all(".")
-df <- iris
-sch <- schema(
-tidyselect::starts_with("Sepal") ~ is.numeric
+devtools::load_all(".")
+check_schema(
+mtcars,
+sch
 )
-df <- mtcars
-sch <- schema(
-c(cyl, am) ~ is.character
+devtools::load_all(".")
+check_schema(
+mtcars,
+sch
 )
-check_schema(df, sch)
-?cli::cli_abort
-devtools::check()
-devtools::check()
-devtools::check()
-renv::restore()
-renv::snapshot()
-renv::restore()
-renv::status()
-install.packages("usethis")
-usethis::use_cran_comments()
-install.packages("devtools")
-remotes::install_version("Rcpp", "1.0.14")
-install.packages("devtools")
-devtools::check()
-renv::install("quarto")
-devtools::check()
-devtools::submit_cran()
-renv::install("httr")
-devtools::submit_cran()
-devtools::check()
-devtools::check()
-devtools::submit_cran()
-install.packages("schematic")
diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION
index cc8b296..338dbe0 100644
--- a/CRAN-SUBMISSION
+++ b/CRAN-SUBMISSION
@@ -1,3 +1,3 @@
-Version: 0.1.0
-Date: 2025-04-22 11:50:32 UTC
-SHA: 8f6cff765c5088e0f5c350edcac00f80e456a452
+Version: 0.1.1
+Date: 2025-05-08 12:27:18 UTC
+SHA: e103f495638785f96e5673ab3747e4e95f05ac26
diff --git a/DESCRIPTION b/DESCRIPTION
index 9965eee..7f81ea2 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: schematic
 Title: Tidy Schema Validation for Data Frames
-Version: 0.1.1
+Version: 0.1.2
 Authors@R: person("Will", "Hipson", email = "will.e.hipson@gmail.com", role = c("aut", "cre", "cph"), comment = c(ORCID = "0000-0002-3931-2189"))
 Description: Validate data.frames against schemas to ensure that data matches expectations. Define schemas using 'tidyselect' and predicate functions for type consistency, nullability, and more. Schema failure messages can be tailored for non-technical users and are ideal for user-facing applications such as in 'shiny' or 'plumber'.  
 Maintainer: Will Hipson <will.e.hipson@gmail.com>
diff --git a/NAMESPACE b/NAMESPACE
index 7739983..5aaa692 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -8,6 +8,7 @@ export(is_non_null)
 export(is_positive_integer)
 export(is_text)
 export(is_whole_number)
+export(last_check_errors)
 export(mod_infinitable)
 export(mod_nullable)
 export(schema)
diff --git a/NEWS.md b/NEWS.md
index 923e581..12469bb 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,3 +1,13 @@
+# schematic 0.1.2
+
+### Minor changes
+
+- Check run time errors can be inspected using `last_check_errors()`.
+
+### Bug fixes
+
+- Predicates that produce errors are now distinguished between predicates that fail.
+
 # schematic 0.1.1
 
 ### Bug fixes
diff --git a/R/check_schema.R b/R/check_schema.R
index d0620d4..d8f0597 100644
--- a/R/check_schema.R
+++ b/R/check_schema.R
@@ -21,16 +21,29 @@ check_schema <- function(data, schema) {
   pred_names <- ifelse(trimws(pred_names) == "", NA, pred_names)
 
   missing_cols_vec <- c()
-  invalid_preds_list <- list(
-    col = character(),
-    pred = character()
-  )
+  invalid_preds_list <- list()
+  errored_preds_list <- list()
+  check_errors <- list()
 
   withCallingHandlers(
     results <- purrr::map(schema, ~{
 
       selector <- rlang::f_lhs(.x)
       predicate_fm <- rlang::f_rhs(.x)
+      predicate_label <- rlang::as_label(predicate_fm)
+
+      # Initialize some containers
+      invalid_preds_list <<- append(
+        invalid_preds_list,
+        list(character()) |>
+          purrr::set_names(predicate_label)
+      )
+
+      errored_preds_list <<- append(
+        errored_preds_list,
+        list(character()) |>
+          purrr::set_names(predicate_label)
+      )
 
       tryCatch({
         predicate <- predicate_fm |>
@@ -38,7 +51,7 @@ check_schema <- function(data, schema) {
           rlang::as_function()
       }, error = function(e) {
         cli::cli_abort(
-          glue::glue("Error in predicate `{rlang::as_label(predicate_fm)}`"),
+          glue::glue("Error in predicate `{predicate_label}`"),
           call = rlang::caller_env(n = 7)
         )
       })
@@ -61,10 +74,15 @@ check_schema <- function(data, schema) {
       purrr::map(cols, ~{
         actual_class <- class(data[[.x]])
         result <- tryCatch({
-          check_pass <- predicate(data[[.x]])
+          check_pass <- tryCatch({
+            predicate(data[[.x]])
+          }, error = function(e) {
+            errored_preds_list[[predicate_label]] <<- c(errored_preds_list[[predicate_label]], .x)
+            check_errors <<- append(check_errors, purrr::set_names(e$message, predicate_label))
+            FALSE
+          })
           if (!is.logical(check_pass)) {
-            invalid_preds_list$col <<- c(invalid_preds_list$col, .x)
-            invalid_preds_list$pred <<- c(invalid_preds_list$pred, rlang::as_label(predicate_fm))
+            invalid_preds_list[[predicate_label]] <<- c(invalid_preds_list[[predicate_label]], .x)
             FALSE
           }
           stopifnot(check_pass)
@@ -76,7 +94,7 @@ check_schema <- function(data, schema) {
         data.frame(
           col = .x,
           class = actual_class,
-          predicate = rlang::as_label(predicate_fm)
+          predicate = predicate_label
         )
       }) |>
         purrr::list_rbind()
@@ -87,6 +105,8 @@ check_schema <- function(data, schema) {
     }
   )
 
+  schematic_pkgenv$check_errors <- check_errors
+
   fail_idx <- which(purrr::map_lgl(results, ~nrow(.x) > 0))
   pred_names <- pred_names[fail_idx]
 
@@ -94,12 +114,48 @@ check_schema <- function(data, schema) {
 
   out_c <- c()
 
-  if (length(invalid_preds_list[[1]]) > 0) {
-    cols_ticked <- paste0("`", invalid_preds_list$col, "`")
-    plural_prefix <- glue::glue(cli::pluralize("Column{?s} {cols_ticked}"))
-    msg <- glue::glue("{plural_prefix} invalid predicate `{invalid_preds_list$pred[[1]]}`")
+  # Warn on errored predicates
+  errored_preds_list <- purrr::discard(errored_preds_list, ~length(.x) == 0)
+  if (length(errored_preds_list) > 0) {
+    out_err <- c()
+    purrr::iwalk(errored_preds_list, ~{
+      cols_ticked <- paste0("`", .x, "`")
+      plural_prefix <- glue::glue(cli::pluralize("column{?s} {cols_ticked}"))
+      msg <- glue::glue("`{.y}` on {plural_prefix}")
+      out_err <<- c(out_err, msg)
+    })
+    plural_pred <- ""
+    if (length(out_err) > 1) {
+      plural_pred <- "s"
+    }
+    cli::cli_warn(
+      c(
+        glue::glue("Error in predicate{plural_pred}:\n"),
+        paste("-", out_err),
+        "i" = "Run {.fn schematic::last_check_errors} to see where the error{plural_pred} occurred."
+      )
+    )
+  }
+
+  # Warn on invalid predicates (non TRUE/FALSE)
+  invalid_preds_list <- purrr::discard(invalid_preds_list, ~length(.x) == 0)
+  if (length(invalid_preds_list) > 0) {
+    out_inv <- c()
+    purrr::iwalk(invalid_preds_list, ~{
+      cols_ticked <- paste0("`", .x, "`")
+      plural_prefix <- glue::glue(cli::pluralize("column{?s} {cols_ticked}"))
+      msg <- glue::glue("`{.y}` on {plural_prefix}")
+      out_inv <<- c(out_inv, msg)
+    })
+    plural_pred <- ""
+    if (length(out_inv) > 1) {
+      plural_pred <- "s"
+    }
     cli::cli_warn(
-      c(msg, "i" = "All predicate functions must return a single TRUE/FALSE")
+      c(
+        glue::glue("Invalid predicate{plural_pred}:\n"), paste("-", out_inv),
+        "i" = "All predicate functions must return a single TRUE/FALSE"
+      )
     )
   }
 
@@ -119,7 +175,7 @@ check_schema <- function(data, schema) {
     out_c <<- c(out_c, msg)
   })
 
-  cli::cli_abort(c("Schema Error:\n", paste("-", out_c)))
+  cli::cli_abort(c("Schema Error:\n", paste("-", out_c)), call = NULL)
 
   invisible()
 }
diff --git a/R/last_check_errors.R b/R/last_check_errors.R
new file mode 100644
index 0000000..26819b1
--- /dev/null
+++ b/R/last_check_errors.R
@@ -0,0 +1,13 @@
+#' Retrieve latest schematic run time errors
+#'
+#' Predicates that error will store the error messages internally and these
+#' can be accessed here.
+#'
+#' @return error messages
+#' @export
+#' @examples
+#'
+#' last_check_errors()
+last_check_errors <- function() {
+  schematic_pkgenv$check_errors
+}
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..78eed2e
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,3 @@
+# Package environment for storing state
+# Currently used in error reporting scenarios like `last_check_errors`
+schematic_pkgenv <- new.env(parent = emptyenv())
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 8085507..6c7bdbf 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -18,3 +18,7 @@ reference:
   desc: Functions that modify predicates to make new predicates
   contents:
   - starts_with("mod_")
+- title: Other
+  desc: Mix bag of other functions
+  contents:
+  - last_check_errors
diff --git a/man/last_check_errors.Rd b/man/last_check_errors.Rd
new file mode 100644
index 0000000..827285a
--- /dev/null
+++ b/man/last_check_errors.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/last_check_errors.R
+\name{last_check_errors}
+\alias{last_check_errors}
+\title{Retrieve latest schematic run time errors}
+\usage{
+last_check_errors()
+}
+\value{
+error messages
+}
+\description{
+Predicates that error will store the error messages internally and these
+can be accessed here.
+}
+\examples{
+
+last_check_errors()
+}
diff --git a/tests/testthat/_snaps/check_schema.md b/tests/testthat/_snaps/check_schema.md
new file mode 100644
index 0000000..e5769a9
--- /dev/null
+++ b/tests/testthat/_snaps/check_schema.md
@@ -0,0 +1,12 @@
+# rules with an error are handled
+
+    Code
+      last_check_errors()
+    Output
+      $stop
+      [1] "66468684466888888444488884448684"
+      
+      $`~"a" + 3`
+      [1] "non-numeric argument to binary operator"
+      
+
diff --git a/tests/testthat/test-check_schema.R b/tests/testthat/test-check_schema.R
index ed28789..519a2bd 100644
--- a/tests/testthat/test-check_schema.R
+++ b/tests/testthat/test-check_schema.R
@@ -66,7 +66,8 @@ test_that("check_schema works with named args", {
 test_that("check_schema errors on non TRUE/FALSE check", {
   df <- mtcars
   sch <- schema(
-    c(cyl, am) ~ as.character
+    c(cyl, am) ~ as.character,
+    disp ~ as.numeric
   )
   expect_error(
     expect_warning(check_schema(df, sch), "All predicate")
@@ -93,6 +94,23 @@ test_that("rules with an error are handled", {
     ),
     regexp = "Error in predicate"
   )
+
+  sch <- schema(
+    cyl ~ stop,
+    am ~ ~"a" + 3
+  )
+
+  expect_error(
+    expect_warning(
+      check_schema(
+        mtcars,
+        sch
+      ),
+      regexp = "Error in predicate"
+    )
+  )
+
+  expect_snapshot(last_check_errors())
 })
 
 test_that("lots of columns in message are still reported", {