diff --git a/.github/workflows/lint.yaml b/.github/workflows/lint.yaml new file mode 100644 index 0000000..7ce3fd6 --- /dev/null +++ b/.github/workflows/lint.yaml @@ -0,0 +1,34 @@ +# 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 + pull_request: + branches: main + +name: lint +permissions: + contents: read + +jobs: + lint: + runs-on: ubuntu-latest + env: + GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-r@bd49c52ffe281809afa6f0fecbf37483c5dd0b93 #v2.11.3 + with: + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@bd49c52ffe281809afa6f0fecbf37483c5dd0b93 #v2.11.3 + with: + extra-packages: any::lintr, local::. + needs: lint + + - name: Lint + run: lintr::lint_package() + shell: Rscript {0} + env: + LINTR_ERROR_ON_LINT: true diff --git a/R/imports-hubValidations.R b/R/imports-hubValidations.R index 278ff6c..3d17bc6 100644 --- a/R/imports-hubValidations.R +++ b/R/imports-hubValidations.R @@ -108,8 +108,8 @@ check_tbl_rows_unique <- function(tbl, file_path, hub_path) { #' @importFrom purrr imap check_tbl_value_col <- function(tbl, round_id, file_path, hub_path) { config_tasks <- read_config(hub_path, "tasks") - tbl <- dplyr::mutate(tbl, dplyr::across(-dplyr::contains("value"), - as.character)) + tbl <- dplyr::mutate(tbl, + dplyr::across(-dplyr::contains("value"), as.character)) details <- split(tbl, f = tbl$output_type) |> purrr::imap( \(.x, .y) { diff --git a/R/validate_submission.R b/R/validate_submission.R index 4b3a04a..78061db 100644 --- a/R/validate_submission.R +++ b/R/validate_submission.R @@ -47,6 +47,7 @@ run_all_validation <- function(df, path, js_def0, js_def, round_id, hub_path, all <- merge_sample_id(df, req_colnames, merge_sample_col, js_def0, js_def, checks, partition = partition, verbose = TRUE, verbose_col = verbose_col) + gc() df <- all$df pair <- all$msg if (!is.null(pair) && verbose) @@ -82,8 +83,10 @@ run_all_validation <- function(df, path, js_def0, js_def, round_id, hub_path, "tasks"), output_type_id_datatype = "from_config") + gc() tbl_chr <- dplyr::mutate_all(df, as.character) + gc() checks$valid_vals <- try_check(check_tbl_values(tbl_chr, round_id = round_id, file_path = file_path, hub_path = hub_path), @@ -92,26 +95,31 @@ run_all_validation <- function(df, path, js_def0, js_def, round_id, hub_path, return(checks) } + gc() checks$rows_unique <- try_check(check_tbl_rows_unique(tbl_chr, file_path = file_path, hub_path = hub_path), path) + gc() checks$req_vals <- try_check(check_df_values_required(df, js_def, file_path = file_path), path) # -- slow + gc() checks$value_col_valid <- try_check(check_tbl_value_col(df, round_id = round_id, file_path = file_path, hub_path = hub_path), path) - + gc() checks$value_col_non_desc <- try_check(check_tbl_value_col_ascending(tbl_chr, file_path = file_path, hub_path = hub_path, round_id = round_id, derived_task_ids = NULL), path) # -- slow + gc() checks <- sample_test(checks, tbl_chr, round_id, file_path, hub_path, path, pair, js_def) + gc() checks <- value_test(df, checks, file_path, n_decimal = n_decimal, pop = pop, obs = obs) diff --git a/tests/testthat/test_submission.R b/tests/testthat/test_submission.R index 95a08dd..c70345d 100644 --- a/tests/testthat/test_submission.R +++ b/tests/testthat/test_submission.R @@ -1,8 +1,18 @@ test_that("Test validation process", { - obs <- "../exp/target-data/time-series.csv" - hub_path <- "../exp/" - pop_path <- "../exp/auxiliary-data/location_census/locations.csv" + hub_path0 <- tempdir() + hub_path <- paste0(hub_path0, "/exp/") + all_dir <- c(hub_path, + grep("\\.", paste0(hub_path, dir("../exp", recursive = TRUE, + include.dirs = TRUE)), + value = TRUE, invert = TRUE)) + purrr::map(all_dir, dir.create, showWarnings = FALSE) + file.copy(dir("../exp", full.names = TRUE, recursive = TRUE), + gsub("^../exp", hub_path, dir("../exp", full.names = TRUE, + recursive = TRUE))) + + obs <- paste0(hub_path, "target-data/time-series.csv") + pop_path <- paste0(hub_path, "auxiliary-data/location_census/locations.csv") merge_sample_col <- c("run_grouping", "stochastic_run") partition <- round_id <- r_schema <- NULL n_decimal <- 1 @@ -463,4 +473,7 @@ test_that("Test validation process", { merge_sample_col = merge_sample_col)) expect_contains(attr(check$result$spl_compound_tid, "class"), c("error", "check_error")) + + unlink(hub_path0, recursive = TRUE) + })