Skip to content

Commit

Permalink
Merge branch 'main' of github.com:ayogasekaram/standalone
Browse files Browse the repository at this point in the history
  • Loading branch information
@ayogasekaram
ayogasekaram committed May 30, 2024
2 parents 4daef5a + cf182c4 commit 6ce0b9d
Show file tree
Hide file tree
Showing 15 changed files with 695 additions and 52 deletions.
58 changes: 58 additions & 0 deletions .github/workflows/test-coverage.yaml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,58 @@
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
on:
push:
branches: [main, master]
pull_request:

name: test-coverage

jobs:
test-coverage:
runs-on: ubuntu-latest
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}

steps:
- uses: actions/checkout@v4

- uses: r-lib/actions/setup-r@v2
with:
use-public-rspm: true

- uses: r-lib/actions/setup-r-dependencies@v2
with:
extra-packages: any::covr, any::xml2
needs: coverage

- name: Test coverage
run: |
cov <- covr::package_coverage(
quiet = FALSE,
clean = FALSE,
install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
)
covr::to_cobertura(cov)
shell: Rscript {0}

- uses: codecov/codecov-action@v4
with:
fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }}
file: ./cobertura.xml
plugin: noop
disable_search: true
token: ${{ secrets.CODECOV_TOKEN }}

- name: Show testthat output
if: always()
run: |
## --------------------------------------------------------------------
find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
shell: bash

- name: Upload test results
if: failure()
uses: actions/upload-artifact@v4
with:
name: coverage-test-failures
path: ${{ runner.temp }}/package
3 changes: 3 additions & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,10 @@ Imports:
rlang,
tidyr
Suggests:
testthat (>= 3.2.0),
usethis
Config/testthat/edition: 3
Config/testthat/parallel: true
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
Expand Down
104 changes: 61 additions & 43 deletions R/standalone-checks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -16,11 +16,11 @@

#' Check Class
#'
#' @param x `(object)`\cr
#' object to check
#' @param cls (`character`)\cr
#' character vector or string indicating accepted classes.
#' Passed to `inherits(what=cls)`
#' @param x `(object)`\cr
#' object to check
#' @param message (`character`)\cr
#' string passed to `cli::cli_abort(message)`
#' @param allow_empty (`logical(1)`)\cr
Expand All @@ -29,6 +29,9 @@
#' @param arg_name (`string`)\cr
#' string indicating the label/symbol of the object being checked.
#' Default is `rlang::caller_arg(x)`
#' @param envir (`environment`)\cr
#' Environment to evaluate the glue expressions in passed in `cli::cli_abort(message)`.
#' Default is `rlang::current_env()`
#' @inheritParams cli::cli_abort
#' @inheritParams rlang::abort
#' @keywords internal
Expand All @@ -46,14 +49,15 @@ check_class <- function(x,
),
arg_name = rlang::caller_arg(x),
class = "check_class",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
}

if (!inherits(x, cls)) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call)
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}
invisible(x)
}
Expand All @@ -69,16 +73,17 @@ check_data_frame <- function(x,
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must be class
{.cls {cls}} or empty, not {.obj_type_friendly {x}}.",
{.cls data.frame} or empty, not {.obj_type_friendly {x}}.",
"The {.arg {arg_name}} argument must be class
{.cls {cls}}, not {.obj_type_friendly {x}}."
{.cls data.frame}, not {.obj_type_friendly {x}}."
),
arg_name = rlang::caller_arg(x),
class = "check_data_frame",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_class(
x = x, cls = "data.frame", allow_empty = allow_empty,
message = message, arg_name = arg_name, class = class, call = call
message = message, arg_name = arg_name, class = class, call = call, envir = envir
)
}

Expand All @@ -93,16 +98,17 @@ check_logical <- function(x,
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must be class
{.cls {cls}} or empty, not {.obj_type_friendly {x}}.",
{.cls logical} or empty, not {.obj_type_friendly {x}}.",
"The {.arg {arg_name}} argument must be class
{.cls {cls}}, not {.obj_type_friendly {x}}."
{.cls logical}, not {.obj_type_friendly {x}}."
),
arg_name = rlang::caller_arg(x),
class = "check_logical",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_class(
x = x, cls = "logical", allow_empty = allow_empty,
message = message, arg_name = arg_name, class = class, call = call
message = message, arg_name = arg_name, class = class, call = call, envir = envir
)
}

Expand All @@ -117,23 +123,24 @@ check_scalar_logical <- function(x,
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must be a scalar with class
{.cls {cls}} or empty, not {.obj_type_friendly {x}}.",
{.cls logical} or empty, not {.obj_type_friendly {x}}.",
"The {.arg {arg_name}} argument must be a scalar with class
{.cls {cls}}, not {.obj_type_friendly {x}}."
{.cls logical}, not {.obj_type_friendly {x}}."
),
arg_name = rlang::caller_arg(x),
class = "check_scalar_logical",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_logical(
x = x, allow_empty = allow_empty,
message = message, arg_name = arg_name,
class = class, call = call
class = class, call = call, envir = envir
)

check_scalar(
x = x, allow_empty = allow_empty,
message = message, arg_name = arg_name,
call = call
call = call, envir = envir
)
}

Expand All @@ -154,17 +161,18 @@ check_string <- function(x,
),
arg_name = rlang::caller_arg(x),
class = "check_string",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_class(
x = x, cls = "character", allow_empty = allow_empty,
message = message, arg_name = arg_name,
class = class, call = call
class = class, call = call, envir = envir
)

check_scalar(
x = x, allow_empty = allow_empty,
message = message, arg_name = arg_name,
class = class, call = call
class = class, call = call, envir = envir
)
}

Expand All @@ -177,9 +185,10 @@ check_not_missing <- function(x,
message = "The {.arg {arg_name}} argument cannot be missing.",
arg_name = rlang::caller_arg(x),
class = "check_not_missing",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
if (missing(x)) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call)
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

# can't return 'x' because it may be an unevaluable obj, eg a bare tidyselect
Expand All @@ -193,7 +202,8 @@ check_not_missing <- function(x,
#' @inheritParams check_class
#' @keywords internal
#' @noRd
check_length <- function(x, length,
check_length <- function(x,
length,
message =
ifelse(
allow_empty,
Expand All @@ -203,15 +213,16 @@ check_length <- function(x, length,
allow_empty = FALSE,
arg_name = rlang::caller_arg(x),
class = "check_length",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
}

# check length
if (length(x) != length) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call)
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

invisible(x)
Expand All @@ -227,16 +238,17 @@ check_scalar <- function(x,
message =
ifelse(
allow_empty,
"The {.arg {arg_name}} argument must be length {.val {length}} or empty.",
"The {.arg {arg_name}} argument must be length {.val {length}}."
"The {.arg {arg_name}} argument must be length {.val {1}} or empty.",
"The {.arg {arg_name}} argument must be length {.val {1}}."
),
arg_name = rlang::caller_arg(x),
class = "check_scalar",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_length(
x = x, length = 1L, message = message,
allow_empty = allow_empty, arg_name = arg_name,
class = class, call = call
class = class, call = call, envir = envir
)
}

Expand All @@ -249,15 +261,16 @@ check_scalar <- function(x,
check_n_levels <- function(x,
n_levels,
message =
"The {.arg {arg_name}} argument must have {.val {length}} levels.",
"The {.arg {arg_name}} argument must have {.val {n_levels}} levels.",
arg_name = rlang::caller_arg(x),
class = "check_n_levels",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_length(
x = stats::na.omit(x) |> unique(),
length = n_levels, message = message,
allow_empty = FALSE, arg_name = arg_name,
class = class, call = call
class = class, call = call, envir = envir
)
}

Expand All @@ -282,7 +295,8 @@ check_range <- function(x,
allow_empty = FALSE,
arg_name = rlang::caller_arg(x),
class = "check_range",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
Expand Down Expand Up @@ -312,7 +326,7 @@ check_range <- function(x,

# print error
if (print_error) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call)
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

invisible(x)
Expand Down Expand Up @@ -340,13 +354,14 @@ check_scalar_range <- function(x,
and length {.val {1}}.",
arg_name = rlang::caller_arg(x),
class = "check_scalar_range",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
check_scalar(x, message = message, arg_name = arg_name,
allow_empty = allow_empty, class = class, call = call)
allow_empty = allow_empty, class = class, call = call, envir = envir)

check_range(x = x, range = range, include_bounds = include_bounds,
message = message, allow_empty = allow_empty,
arg_name = arg_name, class = class, call = call)
arg_name = arg_name, class = class, call = call, envir = envir)
}

#' Check Binary
Expand All @@ -373,19 +388,21 @@ check_binary <- function(x,
),
arg_name = rlang::caller_arg(x),
class = "check_binary",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
}

# first check x is either logical or numeric
check_class(x, cls = c("logical", "numeric", "integer"),
arg_name = arg_name, message = message, class = class, call = call)
arg_name = arg_name, message = message, class = class,
call = call, envir = envir)

# if "numeric" or "integer", it must be coded as 0, 1
if (!is.logical(x) && !(rlang::is_integerish(x) && rlang::is_empty(setdiff(x, c(0, 1, NA))))) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call)
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}

invisible(x)
Expand Down Expand Up @@ -416,7 +433,8 @@ check_formula_list_selector <- function(x,
),
arg_name = rlang::caller_arg(x),
class = "check_formula_list_selector",
call = get_cli_abort_call()) {
call = get_cli_abort_call(),
envir = rlang::current_env()) {
# if empty, skip test
if (isTRUE(allow_empty) && rlang::is_empty(x)) {
return(invisible(x))
Expand All @@ -425,14 +443,14 @@ check_formula_list_selector <- function(x,
# first check the general structure; must be a list or formula
check_class(
x = x, cls = c("list", "formula"), allow_empty = allow_empty,
message = message, arg_name = arg_name, class = class, call = call
message = message, arg_name = arg_name, class = class, call = call, envir = envir
)

# if it's a list, then check each element is either named or a formula
if (inherits(x, "list")) {
for (i in seq_along(x)) {
if (!rlang::is_named(x[i]) && !inherits(x[[i]], "formula")) {
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call)
cli::cli_abort(message, class = c(class, "standalone-checks"), call = call, .envir = envir)
}
}
}
Expand Down
8 changes: 8 additions & 0 deletions R/standalone-package.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
#' @keywords internal
"_PACKAGE"

utils::globalVariables(c(".data", ".env"))

## usethis namespace: start
## usethis namespace: end
NULL
Loading

0 comments on commit 6ce0b9d

Please sign in to comment.