Skip to content

Instantly share code, notes, and snippets.

@jakubsob
jakubsob / test_file.R
Created December 11, 2024 08:08
Run testthat tests with a filter argument as the first one and allow running in parallel using a flag
.test_file <- function(file = NULL, use_parallel = FALSE) {
if (use_parallel) {
testthat::with_mocked_bindings(
devtools::test(filter = file),
find_parallel = function(...) {
TRUE
},
.package = "testthat"
)
}
@jakubsob
jakubsob / on_inputs_initialized.R
Last active December 5, 2024 16:10
Wait for inputs to be updated from the server, then execute a callback
#' Run callback when all inputs are initialized
#'
#' @param ids A character vector of input ids to check.
#' @param callback A function to run after all inputs are initialized.
#' @param session A Shiny session
#' @importFrom shiny reactiveVal observe getDefaultReactiveDomain
#' @importFrom purrr map reduce
#' @importFrom checkmate test_null
on_inputs_initialized <- function(ids, callback, session = getDefaultReactiveDomain()) {
initialized_ <- reactiveVal(FALSE)
@jakubsob
jakubsob / download_ci_snaps.R
Last active December 12, 2024 19:19
Download test snapshots generated on CI
#' Download the latest snapshot artifacts from the CI and update local snapshots
#'
#' @details
#'
#' This function uses Github API to download the latest snapshot artifacts from the CI and update the local snapshots.
#'
#' In order for the API to work it needs to be authenticated.
#'
#' Run the following command in the terminal to authenticate the API:
#' ```
@jakubsob
jakubsob / expect_snapshot.R
Created November 28, 2024 16:39
Custom snapshot expectation
is_ci <- function() {
isTRUE(as.logical(Sys.getenv("CI")))
}
make_variant <- function(
platform = shinytest2::platform_variant(),
data_version = getOption("test_data_version", "simulated")) {
ci <- if (is_ci()) {
"ci"
} else {
@jakubsob
jakubsob / with_assert_collection.R
Created November 28, 2024 16:09
Report all {checkmate} assertions in the style of {withr}
#' Report all assertions
#'
#' @examples
#' with_assertion_collection(
#' assert_data_frame(df),
#' assert_numeric(nums),
#' assert_character(chars)
#' )
with_assert_collection <- function(...) {
add <- makeAssertCollection()